diff --git a/SVN_EXTERNAL_DIRECTORIES b/SVN_EXTERNAL_DIRECTORIES
new file mode 100644
index 0000000000..e64ea2aceb
--- /dev/null
+++ b/SVN_EXTERNAL_DIRECTORIES
@@ -0,0 +1,4 @@
+chem_proc https://svn-ccsm-models.cgd.ucar.edu/tools/proc_atm/chem_proc/release_tags/chem_proc5_0_03_rel
+src/physics/carma/base https://svn-ccsm-models.cgd.ucar.edu/carma/release_tags/carma3_49_rel
+src/physics/clubb https://svn-ccsm-models.cgd.ucar.edu/clubb_core/release_tags/clubb_r8099_n02_rel
+src/physics/cosp2/src https://github.com/CFMIP/COSPv2.0/tags/v2.0.3cesm/src
diff --git a/bld/Makefile.in b/bld/Makefile.in
index 9f16f305b8..474719200c 100644
--- a/bld/Makefile.in
+++ b/bld/Makefile.in
@@ -110,19 +110,11 @@ CURDIR := $(shell pwd)
# Generate Make dependencies.
$(CURDIR)/Depends: $(CURDIR)/Srcfiles $(CURDIR)/Filepath
- if [ -d "${ROOTDIR}/components/cam" ]; then \
- $(ROOTDIR)/components/cam/bld/mkDepends Filepath Srcfiles > $@; \
- else \
- $(ROOTDIR)/bld/mkDepends Filepath Srcfiles > $@; \
- fi
+ $(ROOTDIR)/components/cam/bld/mkDepends Filepath Srcfiles > $@
# Generate list of source files.
$(CURDIR)/Srcfiles: $(CURDIR)/Filepath
- if [ -d "${ROOTDIR}/components/cam" ]; then \
- $(ROOTDIR)/components/cam/bld/mkSrcfiles -e $(EXCLUDE_SOURCES) > $@; \
- else \
- $(ROOTDIR)/bld/mkSrcfiles -e $(EXCLUDE_SOURCES) > $@; \
- fi
+ $(ROOTDIR)/components/cam/bld/mkSrcfiles -e $(EXCLUDE_SOURCES) > $@
OBJS := $(addsuffix .o, $(basename $(SOURCES)))
diff --git a/bld/build-namelist b/bld/build-namelist
index 8cffb24c6f..bba86bd15b 100755
--- a/bld/build-namelist
+++ b/bld/build-namelist
@@ -477,6 +477,7 @@ add_default($nl, 'ninst_driver', 'val'=>'1');
# namelist group: seq_cplflds_inparm #
######################################
add_default($nl, 'flds_co2_dmsa', 'val'=>'.false.');
+add_default($nl, 'flds_co2_dmsb', 'val'=>'.false.');
add_default($nl, 'flds_co2a', 'val'=>'.true.');
add_default($nl, 'flds_co2b', 'val'=>'.false.');
add_default($nl, 'flds_co2c', 'val'=>'.false.');
@@ -694,6 +695,11 @@ if ($cfg->get('debug')) {
my $prescribe_aerosols = $TRUE;
if ($simple_phys) {$prescribe_aerosols = $FALSE;}
+if( $chem =~ /_oslo/){
+$prescribe_aerosols = $FALSE;
+print " ==> Using Oslo aerosols: PRESCRIBED AERO = FALSE (not yet implemented) \n"
+}
+
# Chemistry deposition lists
if ( ($chem ne 'none') or ( $prog_species ) ){
my $chem_proc_src = $cfg->get('chem_proc_src');
@@ -1055,7 +1061,12 @@ else {
my $aer_model = 'bam';
if ($prescribed_aero_model eq 'modal' or $chem =~ /_mam/) {$aer_model = 'mam';}
-if ($aer_model eq 'mam' ) {
+if ($chem =~ /_mam_oslo/) {$aer_model = 'oslo';}
+
+if ($aer_model eq 'oslo') {
+ #do nothing here
+}
+elsif ($aer_model eq 'mam' ) {
my $aero_modes = '3mode';
if ($chem =~ /_mam7/) {$aero_modes = '7mode';}
@@ -1646,7 +1657,8 @@ elsif ($carma eq 'tholin') {
# turn on stratospheric aerosol forcings in CAM6 configurations
my $chem_has_ocs = chem_has_species($cfg, 'OCS');
-if ($phys =~ /cam6/) {
+# djlo
+if ($phys =~ /cam6/ and $chem ne 'trop_mam_oslo') {
# turn on volc forcings in cam6 -- prognostic or prescribed
if ( $chem_has_ocs ) {
# turn on prognostic stratospheric aerosols
@@ -2220,6 +2232,93 @@ if ($chem eq 'trop_mam3') {
}
}
+if ($chem eq 'trop_mam_oslo' ) {
+
+ my %species;
+
+ # Surface emission datasets:
+ %species = ();
+ %species = (%species,
+ 'DMS -> ' => 'dms_oslo_emis_file',
+ 'SO2 -> ' => 'so2_oslo_emis_file',
+ 'BC_AX -> ' => 'bc_ax_oslo_emis_file',
+ 'BC_N -> ' =>'bc_n_oslo_emis_file',
+ 'BC_NI -> ' =>'bc_ni_oslo_emis_file',
+ 'SO4_PR -> ' =>'so4_pr_oslo_emis_file',
+ 'OM_NI -> ' =>'om_ni_oslo_emis_file',
+ 'monoterp -> ' => 'monoterp_oslo_emis_file',
+ 'isoprene -> ' => 'isoprene_oslo_emis_file',
+ );
+
+ my $first = 1;
+ my $pre = "";
+ my $val = "";
+ foreach my $id (sort keys %species) {
+ my $rel_filepath = get_default_value($species{$id} );
+ my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir);
+ $val .= $pre . quote_string($id . $abs_filepath);
+ if ($first) {
+ $pre = ",";
+ $first = 0;
+ }
+ }
+ add_default($nl, 'srf_emis_specifier', 'val'=>$val);
+ unless (defined $nl->get_value('srf_emis_type')) {
+ add_default($nl, 'srf_emis_type', 'val'=>'CYCLICAL');
+ add_default($nl, 'srf_emis_cycle_yr', 'val'=>'2000');
+ }
+
+ # Vertical emission datasets:
+ %species = ();
+ %species = ('SO2 -> ' => 'so2_oslo_ext_file',
+ 'BC_AX -> ' => 'bc_ax_oslo_ext_file',
+ 'BC_N -> ' => 'bc_n_oslo_ext_file',
+ 'BC_NI -> ' => 'bc_ni_oslo_ext_file',
+ 'OM_NI -> ' => 'om_ni_oslo_ext_file',
+ 'SO4_PR -> ' => 'so4_pr_oslo_ext_file');
+
+ $first = 1;
+ $pre = "";
+ $val = "";
+ foreach my $id (sort keys %species) {
+ my $rel_filepath = get_default_value($species{$id} );
+ my $abs_filepath = set_abs_filepath($rel_filepath, $inputdata_rootdir);
+ $val .= $pre . quote_string($id . $abs_filepath);
+ if ($first) {
+ $pre = ",";
+ $first = 0;
+ }
+ }
+ add_default($nl, 'ext_frc_specifier', 'val'=>$val);
+ unless (defined $nl->get_value('ext_frc_type')) {
+ add_default($nl, 'ext_frc_type', 'val'=>"'CYCLICAL'");
+ add_default($nl, 'ext_frc_cycle_yr', 'val'=>'2000');
+ }
+
+ # Prescribed species
+ add_default($nl, 'tracer_cnst_specifier', 'val'=>"'O3','OH','NO3','HO2'");
+ unless (defined $nl->get_value('tracer_cnst_type')) {
+ add_default($nl, 'tracer_cnst_type', 'ver'=>'fixed_ox');
+ add_default($nl, 'tracer_cnst_cycle_yr','ver'=>'fixed_ox');
+ }
+
+ my @files = ('tracer_cnst_datapath', 'tracer_cnst_file', 'tracer_cnst_filelist');
+ foreach my $file (@files) {
+ add_default($nl, $file, 'ver'=>'fixed_ox');
+ }
+
+ add_default($nl, 'fstrat_list', 'val'=>"' '");
+ add_default($nl, 'flbc_list', 'val'=>"' '");
+ add_default($nl, 'xactive_prates', 'val'=>'.false.');
+
+ # Datasets
+ my @files = ('soil_erod_file',
+ 'xs_long_file', 'rsf_file', 'exo_coldens_file' );
+ foreach my $file (@files) {
+ add_default($nl, $file);
+ }
+}
+
# CMIP6 emissions
if ($chem =~ /_mam4/ and $phys =~ /cam6/) {
my %species;
@@ -2778,6 +2877,36 @@ $nl->set_variable_value('phys_ctl_nl', 'use_simple_phys', $use_simple_phys);
# WACCM-X runtime options
add_default($nl, 'waccmx_opt');
+#Cam-Oslo options
+#++djlo++
+add_default($nl, 'volc_fraction_coarse');
+add_default($nl, 'aerotab_table_dir');
+add_default($nl, 'ocean_filepath');
+add_default($nl, 'dms_source');
+add_default($nl, 'opom_source');
+#add_default($nl, 'dms_source_type');
+#add_default($nl, 'dms_cycle_year');
+#add_default($nl, 'ocean_filename');
+#add_default($nl, 'ocean_filepath');
+#add_default($nl, 'opom_source');
+unless (defined $nl->get_value('ocean_filename')) {
+ add_default($nl, 'ocean_filename');
+}
+unless (defined $nl->get_value('opom_source_type')) {
+ add_default($nl, 'opom_source_type');
+ add_default($nl, 'opom_cycle_year');
+}
+unless (defined $nl->get_value('dms_source_type')) {
+ add_default($nl, 'dms_source_type');
+ add_default($nl, 'dms_cycle_year');
+}
+#add_default($nl, 'opom_source_type');
+
+#add_default($nl, 'opom_cycle_year');
+#--djlo--
+
+if ($chem =~ /_mam_oslo/) {$nl->set_variable_value('phys_ctl_nl','use_hetfrz_classnuc','.true.');}
+
if ($waccmx) {
my $wmx_opt = $nl->get_value('waccmx_opt');
my $ionos = $cfg->get('ionosphere');
@@ -2892,6 +3021,7 @@ add_default($nl, 'srf_flux_avg', 'val'=>0);
add_default($nl, 'use_subcol_microp');
add_default($nl, 'microp_scheme');
+
if ($cfg->get('microphys') =~ /^mg/) {
add_default($nl, 'micro_mg_version');
add_default($nl, 'micro_mg_sub_version');
diff --git a/bld/config_files/definition.xml b/bld/config_files/definition.xml
index 656f62f152..8a7d59519d 100644
--- a/bld/config_files/definition.xml
+++ b/bld/config_files/definition.xml
@@ -11,10 +11,7 @@ CAM build directory; contains .o and .mod files.
Directory where CAM executable will be created.
-Root directory of CAM source distribution
-
-
-Root directory of CAM model source..
+Root directory of CAM source distribution.
User source directories to prepend to the filepath. Multiple directories
@@ -91,8 +88,8 @@ meteor_smoke (Meteor Smoke), mixed_sulfate (Meteor Smoke and Sulfate), pmc (Pola
sulfate (Sulfate Aerosols), tholin (early earth haze), test_detrain (Detrainment), test_growth (Particle Growth), test_passive (Passive Dust),
test_radiative (Radiatively Active Dust), test_swelling (Sea Salt), test_tracers (Asian Monsoon), test_tracers2 (Guam).
-
-Chemistry package: trop_mam3 trop_mam4 trop_mam7 trop_mozart trop_strat_mam4_vbs trop_strat_mam4_vbsext waccm_ma waccm_mad waccm_mad_mam4 waccm_ma_mam4 waccm_ma_sulfur waccm_sc waccm_sc_mam4 waccm_tsmlt_mam4 terminator none
+
+Chemistry package: trop_mam3 trop_mam4 trop_mam7 trop_mozart trop_strat_mam4_vbs trop_strat_mam4_vbsext waccm_ma waccm_mad waccm_mad_mam4 waccm_ma_mam4 waccm_ma_sulfur waccm_sc waccm_sc_mam4 waccm_tsmlt_mam4 terminator trop_mam_oslo none
Prognostic mozart species packages: list of any subset of the following: DST,SSLT,SO4,GHG,OC,BC,CARBON16
@@ -115,7 +112,7 @@ Chemistry source directory generated by the chemistry preprocessor; contains F90
Chemistry source directory; contains F90 files.
-
+
Use data ocean model (docn or dom), stub ocean (socn), or aqua planet ocean
(aquaplanet) in cam build. When built from the CESM scripts the value of
ocn may be set to pop. This doesn't impact how CAM is built, only how
diff --git a/bld/configure b/bld/configure
index e00e6ae57a..cdea30d292 100755
--- a/bld/configure
+++ b/bld/configure
@@ -124,7 +124,7 @@ OPTIONS
[ trop_mam3 | trop_mam4 | trop_mam7 | trop_mozart | trop_strat_mam4_vbs | trop_strat_mam4_vbsext |
waccm_ma | waccm_mad | waccm_mad_mam4 | waccm_ma_mam4 |
waccm_ma_sulfur | waccm_sc | waccm_sc_mam4 | waccm_tsmlt_mam4 |
- terminator | none ].
+ terminator | trop_mam_oslo | none ].
Default: trop_mam4 for cam6 and trop_mam3 for cam5.
-[no]clubb_sgs Switch on [off] CLUBB_SGS. Default: on for cam6, otherwise off.
-clubb_opts Comma separated list of CLUBB options to turn on/off. By default they are all off.
@@ -450,30 +450,17 @@ if (($ccsm_seq)) {
#-----------------------------------------------------------------------------------------------
# CAM root directory.
-# Check for standalone or CESM checkout
-my $cam_root = absolute_path("$cfgdir/..");
-my $cam_dir = $cam_root;
-if (! -d "$cam_root/cime") {
- $cam_root = absolute_path("$cfgdir/../../..");
-}
+my $cam_root = absolute_path("$cfgdir/../../..");
+
if (-d "$cam_root/components/cam/src") {
$cfg_ref->set('cam_root', $cam_root);
- $cam_dir = "$cam_root/components/cam";
- $cfg_ref->set('cam_dir', $cam_dir);
-}
-elsif (-d "$cam_root/src") {
- $cfg_ref->set('cam_root', $cam_root);
- $cfg_ref->set('cam_dir', $cam_dir);
} else {
die <<"EOF";
** Invalid CAM root directory: $cam_root
**
-** The CAM root directory must contain the subdirectory components/cam/src/
-** (CESM checkout) or the subdirectory src (standalone checkout).
-** For CESM checkouts, it is derived from "config_dir/../../..".
-** For CAM standalone checkouts, it is derived from"config_dir/..",
-** where config_dir is the directory in the CAM distribution that
-** contains the configuration scripts.
+** The CAM root directory must contain the subdirectory components/cam/src/.
+** It is derived from "config_dir/../../.." where config_dir is the
+** directory in the CAM distribution that contains the configuration
** scripts.
EOF
}
@@ -1386,7 +1373,7 @@ my $chem_cppdefs = '';
my $chem_src_dir = '';
if (!$prog_species) {
- $chem_src_dir = "$cam_dir/src/chemistry/pp_$chem_pkg";
+ $chem_src_dir = "$cam_root/components/cam/src/chemistry/pp_$chem_pkg";
$cfg_ref->set('chem_src_dir', $chem_src_dir);
}
@@ -1428,6 +1415,10 @@ if ($chem_pkg =~ '_mam3') {
$chem_cppdefs = ' -DMODAL_AERO -DMODAL_AERO_7MODE ';
}
+if ($chem_pkg =~ '_oslo') {
+ $chem_cppdefs = ' -DOSLO_AERO -DDIRIND'
+}
+
# CARMA sectional microphysics
#
# New CARMA models need to define the number of advected constituents.
@@ -2742,7 +2733,7 @@ sub write_filepath
my $inic_val = $cfg_ref->get('analytic_ic');
# Root directory
- my $camsrcdir = $cfg_ref->get('cam_dir');
+ my $camsrcdir = "$cam_root/components";
# Start writing paths to the file. *** Order is important *** The
# sequence of paths will be used to set the GNU Makefile's VPATH macro
@@ -2762,21 +2753,31 @@ sub write_filepath
print $fh "$CASEROOT/SourceMods/src.cam\n";
}
- # offline unit driver (defaults to stub)
- print $fh "$camsrcdir/src/unit_drivers\n";
- print $fh "$camsrcdir/src/unit_drivers/${offline_drv}\n";
+ #NorESM-specific:
+ #Any files in "NorESM"-folder go before the original CAM-files
+ #These files MUST give back standard CAM5.3 if a standard CAM5.3 compset is chosen
+ #Un-commenting this line will give back standard CAM 5.3 (unmodified).
+ #This is used for testing.
+ #++djlo (should be switched off when pure NCAR version is desired)
+ print $fh "$camsrcdir/cam/src/NorESM\n";
+ print $fh "$camsrcdir/cam/src/NorESM/$dyn\n";
+ #--djlo
+
+ # offline unit driver (defaults to stub)
+ print $fh "$camsrcdir/cam/src/unit_drivers\n";
+ print $fh "$camsrcdir/cam/src/unit_drivers/${offline_drv}\n";
if ($simple_phys) {
- print $fh "$camsrcdir/src/physics/simple\n";
+ print $fh "$camsrcdir/cam/src/physics/simple\n";
}
if ($carma ne 'none') {
# This directory needs to precede physics/cam/ to replace
# the CARMA stub package with CARMA. Putting it first allows
# any CAM file to be overridden by a particular CARMA model.
- print $fh "$camsrcdir/src/physics/carma/models/$carma\n";
- print $fh "$camsrcdir/src/physics/carma/cam\n";
- print $fh "$camsrcdir/src/physics/carma/base\n";
+ print $fh "$camsrcdir/cam/src/physics/carma/models/$carma\n";
+ print $fh "$camsrcdir/cam/src/physics/carma/cam\n";
+ print $fh "$camsrcdir/cam/src/physics/carma/base\n";
}
# CAM chemistry, dynamics, physics, control and shared utilities.
@@ -2786,59 +2787,65 @@ sub write_filepath
if ($chem_src_dir) {
print $fh "$chem_src_dir\n";
}
- if ($chem =~ /_mam/) {
- print $fh "$camsrcdir/src/chemistry/modal_aero\n";
- } else {
- print $fh "$camsrcdir/src/chemistry/bulk_aero\n";
+ if ($chem =~/_oslo/) {
+ print $fh "$camsrcdir/cam/src/chemistry/oslo_aero\n";
+ print $fh "$camsrcdir/cam/src/physics/cam_oslo\n";
+ }
+ else{
+ if ($chem =~ /_mam/) {
+ print $fh "$camsrcdir/cam/src/chemistry/modal_aero\n";
+ } else {
+ print $fh "$camsrcdir/cam/src/chemistry/bulk_aero\n";
+ }
}
- print $fh "$camsrcdir/src/chemistry/aerosol\n";
+ print $fh "$camsrcdir/cam/src/chemistry/aerosol\n";
if ($waccmx) {
- print $fh "$camsrcdir/src/physics/waccmx\n";
+ print $fh "$camsrcdir/cam/src/physics/waccmx\n";
if ($ionos =~ /wxi/) {
- print $fh "$camsrcdir/src/ionosphere/waccmx\n";
+ print $fh "$camsrcdir/cam/src/ionosphere/waccmx\n";
}
}
if ($waccm_phys) {
- print $fh "$camsrcdir/src/physics/waccm\n";
+ print $fh "$camsrcdir/cam/src/physics/waccm\n";
}
- print $fh "$camsrcdir/src/ionosphere\n";
+ print $fh "$camsrcdir/cam/src/ionosphere\n";
- print $fh "$camsrcdir/src/chemistry/mozart\n";
- print $fh "$camsrcdir/src/chemistry/utils\n";
+ print $fh "$camsrcdir/cam/src/chemistry/mozart\n";
+ print $fh "$camsrcdir/cam/src/chemistry/utils\n";
if ($rad eq 'rrtmg') {
- print $fh "$camsrcdir/src/physics/rrtmg\n";
- print $fh "$camsrcdir/src/physics/rrtmg/aer_src\n";
+ print $fh "$camsrcdir/cam/src/physics/rrtmg\n";
+ print $fh "$camsrcdir/cam/src/physics/rrtmg/aer_src\n";
}
elsif ($rad eq 'camrt') {
- print $fh "$camsrcdir/src/physics/camrt\n";
+ print $fh "$camsrcdir/cam/src/physics/camrt\n";
}
if ($clubb_sgs eq '1') {
- print $fh "$camsrcdir/src/physics/clubb\n";
+ print $fh "$camsrcdir/cam/src/physics/clubb\n";
}
# Superparameterization
if ($phys_pkg eq 'spcam_m2005' or $phys_pkg eq 'spcam_sam1mom') {
- print $fh "$camsrcdir/src/physics/spcam\n";
- print $fh "$camsrcdir/src/physics/spcam/crm\n";
+ print $fh "$camsrcdir/cam/src/physics/spcam\n";
+ print $fh "$camsrcdir/cam/src/physics/spcam/crm\n";
# add additional directories for sam6.10.4
- print $fh "$camsrcdir/src/physics/spcam/crm/ADV_MPDATA\n";
+ print $fh "$camsrcdir/cam/src/physics/spcam/crm/ADV_MPDATA\n";
if ($phys_pkg eq 'spcam_sam1mom') {
- print $fh "$camsrcdir/src/physics/spcam/crm/MICRO_SAM1MOM\n";
+ print $fh "$camsrcdir/cam/src/physics/spcam/crm/MICRO_SAM1MOM\n";
}
if ($phys_pkg eq 'spcam_m2005') {
- print $fh "$camsrcdir/src/physics/spcam/crm/MICRO_M2005\n";
- print $fh "$camsrcdir/src/physics/spcam/ecpp\n";
+ print $fh "$camsrcdir/cam/src/physics/spcam/crm/MICRO_M2005\n";
+ print $fh "$camsrcdir/cam/src/physics/spcam/ecpp\n";
}
if ( $spcam_clubb_sgs == 1 ) {
- print $fh "$camsrcdir/src/physics/spcam/crm/CLUBB\n";
- print $fh "$camsrcdir/src/physics/spcam/crm/SGS_CLUBBkvhkvm\n"
+ print $fh "$camsrcdir/cam/src/physics/spcam/crm/CLUBB\n";
+ print $fh "$camsrcdir/cam/src/physics/spcam/crm/SGS_CLUBBkvhkvm\n"
}
else {
- print $fh "$camsrcdir/src/physics/spcam/crm/SGS_TKE\n";
+ print $fh "$camsrcdir/cam/src/physics/spcam/crm/SGS_TKE\n";
}
}
@@ -2846,31 +2853,31 @@ sub write_filepath
# as well as the cam specific interface modules that may need to
# be overridden by modules from directories that occur earlier
# in the list of filepaths.
- print $fh "$camsrcdir/src/physics/cam\n";
+ print $fh "$camsrcdir/cam/src/physics/cam\n";
# Dynamics package and test utilities
- print $fh "$camsrcdir/src/dynamics/$dyn\n";
+ print $fh "$camsrcdir/cam/src/dynamics/$dyn\n";
if($dyn eq 'se') {
- print $fh "$camsrcdir/src/dynamics/se/dycore\n";
+ print $fh "$camsrcdir/cam/src/dynamics/se/dycore\n";
}
- print $fh "$camsrcdir/src/dynamics/tests\n";
+ print $fh "$camsrcdir/cam/src/dynamics/tests\n";
if($inic_val) {
- print $fh "$camsrcdir/src/dynamics/tests/initial_conditions\n";
+ print $fh "$camsrcdir/cam/src/dynamics/tests/initial_conditions\n";
}
# Parallelization utilies
if ($dyn eq 'fv' or $cppdefs =~ /MODCM_DP_TRANSPOSE/) {
- print $fh "$camsrcdir/src/utils/pilgrim\n";
+ print $fh "$camsrcdir/cam/src/utils/pilgrim\n";
}
# Advective transport
if ($dyn eq 'eul') {
- print $fh "$camsrcdir/src/advection/slt\n";
+ print $fh "$camsrcdir/cam/src/advection/slt\n";
}
- print $fh "$camsrcdir/src/cpl\n";
- print $fh "$camsrcdir/src/control\n";
- print $fh "$camsrcdir/src/utils\n";
+ print $fh "$camsrcdir/cam/src/cpl\n";
+ print $fh "$camsrcdir/cam/src/control\n";
+ print $fh "$camsrcdir/cam/src/utils\n";
if ($cam_build) {
@@ -2890,15 +2897,15 @@ sub write_filepath
# Ocean package.
if ($ocn eq 'dom') {
- print $fh "$camsrcdir/src/utils/cam_dom\n";
+ print $fh "$camsrcdir/cam/src/utils/cam_dom\n";
}
elsif ($ocn eq 'docn' or $ocn eq 'som') {
print $fh "$cam_root/cime/src/components/data_comps/docn\n";
print $fh "$cam_root/cime/src/components/data_comps/docn/mct\n";
}
elsif ($ocn eq 'aquaplanet') {
- print $fh "$camsrcdir/src/utils/cam_aqua\n";
- print $fh "$camsrcdir/src/utils/cam_aqua/cpl\n";
+ print $fh "$camsrcdir/cam/src/utils/cam_aqua\n";
+ print $fh "$camsrcdir/cam/src/utils/cam_aqua/cpl\n";
}
elsif ($ocn eq 'socn') {
print $fh "$cam_root/cime/src/components/stub_comps/socn/cpl\n";
@@ -3074,14 +3081,14 @@ sub write_cosp_makefile
print $fh_out <<"EOF";
CAM_BLD := $cam_bld
-COSP_PATH := $cam_dir/src/physics/cosp2
-ISCCP_PATH := $cam_dir/src/physics/cosp2/src/simulator/icarus
-RS_PATH := $cam_dir/src/physics/cosp2/src/simulator/quickbeam
-RT_PATH := $cam_dir/src/physics/cosp2/src/simulator/rttov
-CS_PATH := $cam_dir/src/physics/cosp2/src/simulator/actsim
-MISR_PATH := $cam_dir/src/physics/cosp2/src/simulator/MISR_simulator
-MODIS_PATH := $cam_dir/src/physics/cosp2/src/simulator/MODIS_simulator
-PARASOL_PATH := $cam_dir/src/physics/cosp2/src/simulator/parasol
+COSP_PATH := $cam_root/components/cam/src/physics/cosp2
+ISCCP_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/icarus
+RS_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/quickbeam
+RT_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/rttov
+CS_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/actsim
+MISR_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/MISR_simulator
+MODIS_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/MODIS_simulator
+PARASOL_PATH := $cam_root/components/cam/src/physics/cosp2/src/simulator/parasol
EOF
diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml
index 17ebec5ca6..3d4b25f34b 100644
--- a/bld/namelist_files/namelist_defaults_cam.xml
+++ b/bld/namelist_files/namelist_defaults_cam.xml
@@ -356,7 +356,13 @@
CYCLICAL
2000
aero_1.9x2.5_L26_list_c070514.txt
-
+
+atm/cam/chem/trop_mam/aero
+mam3_1.9x2.5_L30_2000clim_c130319.nc
+none
+CYCLICAL
+2000
+aero_1.9x2.5_L26_list_c070514.txt
atm/cam/chem/trop_mozart_aero/aero
aerosoldep_monthly_1849-2006_1.9x2.5_c090803.nc
@@ -366,6 +372,11 @@
mam3_1.9x2.5_L30_2000clim_c130319.nc
CYCLICAL
2000
+
+atm/cam/chem/trop_mam/aero
+mam3_1.9x2.5_L30_2000clim_c130319.nc
+CYCLICAL
+2000
atm/cam/rad/VolcanicMass_1870-1999_64x1_L18_c040115.nc
@@ -629,6 +640,25 @@
atm/cam/chem/trop_mozart_aero/emis/aerocom_SO2_vertical_2000.c080807.nc
atm/cam/chem/trop_mozart_aero/emis/aerocom_SO4_vertical_2000.c080807.nc
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/aerocom_mam3_dms_surf_1849-2006_c090804.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_so2_surf_1850-2005_c090804.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_BCFFX_surf_1850-2005_c090804.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_BCFFN_surf_1850-2005_c090804.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/BCBB_ZERO_dummy_surf.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_so4_pr_surf_1850-2005_c090804.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_surf_oslo_scaled_1850-2010_c20140421_v12.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_2000.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_2000.nc
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_so2_elev_1850-2005_c090804.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/BCFFX_ZERO_dummy_elev.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/BCFFN_ZERO_dummy_elev.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_bc_elev_1850-2005_c090804.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_elev_oslo_scaled_1850-2010_c20140421_v12.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/ipcc_ar5/ar5_mam3_so4_pr_elev_1850-2005_c090804.nc
+
+
atm/cam/chem/trop_mozart_aero/emis/emis_NH3_2000_c111014.nc
atm/cam/chem/trop_mozart_aero/emis/aerocom_mam3_dms_surf_2000_c120315.nc
@@ -1194,6 +1224,9 @@
1.0D0
1.0D0
+
+
+
1
3
@@ -1297,6 +1330,13 @@
0.24D0
0.9D0
+
+
+
+
+
+
+
1.35D0
@@ -1898,7 +1938,19 @@
share/domains/domain.ocn.ne60np4_gx1v6.121113.nc
share/domains/domain.ocn.ne120np4_gx1v6.121113.nc
share/domains/domain.ocn.ne240np4_gx1v6.111226.nc
-
atm/cam/ocnfrac/domain.aqua.fv1.9x2.5.nc
+
+.true.
+0.0
+noresm-only/atm/cam/camoslo/AeroTab_8jun17
+lana
+CYCLICAL
+2000
+odowd
+CYCLICAL
+2000
+Lana_ocean_1849_2006.nc
+noresm-only/atm/cam/camoslo
+
diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml
index 8d8acbafa4..8998be4684 100644
--- a/bld/namelist_files/namelist_definition.xml
+++ b/bld/namelist_files/namelist_definition.xml
@@ -563,6 +563,18 @@ Chooses level of velocity diffusion.
Default: 3.0e5
+
+Flag to extend standard 4th-order PPM scheme to model top.
+Default: .false.
+
+
+
+Flag to turn on corrections in FV geometry and/or pressure terms.
+Default: .false.
+
+
Flag to turn on corrections that improve angular momentum conservation.
@@ -944,6 +956,13 @@ Relaxation time (hours) applied to specified meteorology.
Default: 0.0
+
+if true, nudge only u, v and ps. If false, nudge other fields as well
+(T, Q, TS, SHOWH, TAUX, TAUY, SHFLX, QFLX)
+Default: true
+
+
switch to turn on/off mass fixer for offline driver
@@ -3906,7 +3925,7 @@ Default: set by build-namelist
+ terminator,trop_mam_oslo,none" >
Name of the CAM chemistry package. N.B. this variable may not be set by
the user. It is set by build-namelist via information in the configure
cache file to be consistent with how CAM was built.
@@ -4000,6 +4019,15 @@ Full pathname of AMIE inputs for southern hemisphere.
Default: NONE.
+
+
+
+Switch to use appropriate energy adjustment in dry-mass adjustment at the
+end of tphysac.
+Default: .false.
+
+
+
+
+Switch to use appropriate energy adjustment in dry-mass adjustment at the
+end of tphysac.
+Default: .false.
+
+
-
Full pathname of the directory that contains the files specified in
@@ -7037,6 +7072,10 @@ Default: FALSE
group="seq_cplflds_inparm" valid_values="" >
Default: FALSE
+
+Default: FALSE
+
Default:
@@ -7681,4 +7720,65 @@ List of filepaths for dataset for offline unit driver.
Default: none
+
+
+
+Fraction of volcanic aerosols which will end up in coarse mode
+Default: 0.0
+
+
+Directory where we will expect to find the CAM-Oslo tables
+created from AeroTab
+
+
+
+Type of DMS data source
+Default: emission_file
+
+
+
+Type of DMS data source type
+Default: CYCLICAL
+
+
+
+DMS cycle year
+Default: 2000
+
+
+
+Type of ocean POM data source
+Default: no_file
+
+
+
+Type of ocean POM data source type
+Default: CYCLICAL
+
+
+
+Ocean POM cycle year
+Default: 2000
+
+
+
+Filename for ocean concentration of DMS, chlorophyll and poc
+Default: name
+
+
+
+Path to ocean file
+Default: path
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam54_ptaero.xml b/bld/namelist_files/use_cases/1850_cam54_ptaero.xml
new file mode 100644
index 0000000000..0ea3a13972
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam54_ptaero.xml
@@ -0,0 +1,43 @@
+
+
+
+
+
+atm/cam/solar/SOLAR_SPECTRAL_Lean_1610-2008_annual_c090324.nc
+18500101
+FIXED
+
+
+284.7e-6
+791.6e-9
+275.68e-9
+12.48e-12
+0.0
+
+
+atm/cam/ozone
+ozone_1.9x2.5_L26_1850clim_c090420.nc
+O3
+CYCLICAL
+1850
+
+1850
+1850
+
+
+
+CYCLICAL
+1850
+oxid_1.9x2.5_L26_1850clim_c091123.nc
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam5_ptaero.xml b/bld/namelist_files/use_cases/1850_cam5_ptaero.xml
new file mode 100644
index 0000000000..3713d50ea4
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam5_ptaero.xml
@@ -0,0 +1,68 @@
+
+
+
+
+
+atm/cam/solar/SOLAR_SPECTRAL_Lean_1610-2008_annual_c090324.nc
+18500101
+FIXED
+
+
+284.7e-6
+791.6e-9
+275.68e-9
+12.48e-12
+0.0
+
+
+atm/cam/ozone
+ozone_1.9x2.5_L26_1850clim_c090420.nc
+O3
+CYCLICAL
+1850
+
+
+CYCLICAL
+atm/cam/chem/trop_mozart_aero/emis/aerocom_mam3_dms_surf_2000_c090129.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_surf_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_soag_1.5_surf_1850_c100217.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_oc_surf_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_surf_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_surf_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_surf_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_surf_1850_c090726.nc
+
+
+CYCLICAL
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so2_elev_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_elev_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_elev_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a1_elev_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_elev_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_oc_elev_1850_c090726.nc
+atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_elev_1850_c090726.nc
+
+1850
+1850
+
+
+
+CYCLICAL
+1850
+oxid_1.9x2.5_L26_1850clim_c091123.nc
+
+
+5
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm.xml b/bld/namelist_files/use_cases/1850_cam6_noresm.xml
new file mode 100644
index 0000000000..5a337518ad
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_aer2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_aer2014.xml
new file mode 100644
index 0000000000..71274136dc
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_aer2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_aeroxid2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_aeroxid2014.xml
new file mode 100644
index 0000000000..f0ea07927f
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_aeroxid2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'noresm-only/atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_aeroxidonly.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_aeroxidonly.xml
new file mode 100644
index 0000000000..a909cf7a60
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_aeroxidonly.xml
@@ -0,0 +1,159 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ INTERP_MISSING_MONTHS
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_date_0000_5000_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1849-2015_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_date_0000_5000_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1849-2015_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_anthro2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_anthro2014.xml
new file mode 100644
index 0000000000..a5fecfac5d
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_anthro2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 397.55e-6
+ 1831.47e-9
+ 326.99e-9
+ 809.19e-12
+ 520.58e-12
+
+
+ 1850
+ 'noresm-only/atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_2014_date1850_CMIP6ensAvg_c180923.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'noresm-only/atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/noresm-only/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/noresm-only/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_bc2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_bc2014.xml
new file mode 100644
index 0000000000..cfc7a258ce
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_bc2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_ch42014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_ch42014.xml
new file mode 100644
index 0000000000..5575f7fb96
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_ch42014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 1831.47e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/noresm-only/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/noresm-only/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_ch4noh2o2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_ch4noh2o2014.xml
new file mode 100644
index 0000000000..4c9b6329f5
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_ch4noh2o2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 1831.47e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_frc2.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_frc2.xml
new file mode 100644
index 0000000000..7c058095d6
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_frc2.xml
@@ -0,0 +1,142 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_surface_1850_0.9x1.25_version20190808.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_surface_1850_1.9x2.5_version20190808.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_vertical_1850_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_vertical_1850_0.9x1.25_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_NI_all_vertical_1850_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_vertical_1850_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_vertical_1850_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_vertical_1850_0.9x1.25_version20190808.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_vertical_1850_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_vertical_1850_1.9x2.5_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_NI_all_vertical_1850_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_vertical_1850_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_vertical_1850_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_vertical_1850_1.9x2.5_version20190808.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_ghg2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_ghg2014.xml
new file mode 100644
index 0000000000..db7bf880ab
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_ghg2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 397.55e-6
+ 1831.47e-9
+ 326.99e-9
+ 809.19e-12
+ 520.58e-12
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/noresm-only/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/noresm-only/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_ghgnoh2o2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_ghgnoh2o2014.xml
new file mode 100644
index 0000000000..e6d6b6c95b
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_ghgnoh2o2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 397.55e-6
+ 1831.47e-9
+ 326.99e-9
+ 809.19e-12
+ 520.58e-12
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_ghgonly.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_ghgonly.xml
new file mode 100644
index 0000000000..28d58c2726
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_ghgonly.xml
@@ -0,0 +1,163 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_1750-2015_CMIP6_GlobAnnAvg_c180926.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_ghgozone2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_ghgozone2014.xml
new file mode 100644
index 0000000000..804872caf1
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_ghgozone2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 397.55e-6
+ 1831.47e-9
+ 326.99e-9
+ 809.19e-12
+ 520.58e-12
+
+
+ 1850
+ 'noresm-only/atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_2014_date1850_CMIP6ensAvg_c180923.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/noresm-only/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/noresm-only/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_h2o2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_h2o2014.xml
new file mode 100644
index 0000000000..e9f144c51b
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_h2o2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/noresm-only/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/noresm-only/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_n2o2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_n2o2014.xml
new file mode 100644
index 0000000000..a0d118798f
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_n2o2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 326.99e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_natonly.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_natonly.xml
new file mode 100644
index 0000000000..0d72b3bf47
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_natonly.xml
@@ -0,0 +1,159 @@
+
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_ntcf2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_ntcf2014.xml
new file mode 100644
index 0000000000..4ae5b4d53e
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_ntcf2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'noresm-only/atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_2014_date1850_CMIP6ensAvg_c180923.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'noresm-only/atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_oc2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_oc2014.xml
new file mode 100644
index 0000000000..9572242cf6
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_oc2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_oxid2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_oxid2014.xml
new file mode 100644
index 0000000000..05b651cffc
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_oxid2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'noresm-only/atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_ozone2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_ozone2014.xml
new file mode 100644
index 0000000000..0edc300da1
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_ozone2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'noresm-only/atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_2014_date1850_CMIP6ensAvg_c180923.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_ozoneonly.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_ozoneonly.xml
new file mode 100644
index 0000000000..69692cb06c
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_ozoneonly.xml
@@ -0,0 +1,161 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_so22014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_so22014.xml
new file mode 100644
index 0000000000..de381cb15e
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_so22014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_noresm_so2oxid2014.xml b/bld/namelist_files/use_cases/1850_cam6_noresm_so2oxid2014.xml
new file mode 100644
index 0000000000..573abe0db2
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_noresm_so2oxid2014.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'noresm-only/atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_2014_date1850_CMIP6ensAvg_c180927.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2014_date_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_2014_date_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_2014_date_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/1850_cam6_oslo.xml b/bld/namelist_files/use_cases/1850_cam6_oslo.xml
new file mode 100644
index 0000000000..726fcd32f6
--- /dev/null
+++ b/bld/namelist_files/use_cases/1850_cam6_oslo.xml
@@ -0,0 +1,155 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0300D0
+ 0.0300D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+ 1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/2000_cam6_noclb.xml b/bld/namelist_files/use_cases/2000_cam6_noclb.xml
new file mode 100644
index 0000000000..fc971aa057
--- /dev/null
+++ b/bld/namelist_files/use_cases/2000_cam6_noclb.xml
@@ -0,0 +1,44 @@
+
+
+
+
+ .true.
+ .false.
+ .true.
+
+
+ 2000
+ atm/cam/ozone
+ oxid_ozone_WACCM_CCMI_REFC1_2000_cycle_3D_monthly.nc
+
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+
+ 2000
+ atm/cam/ozone
+ oxid_ozone_WACCM_CCMI_REFC1_2000_cycle_3D_monthly.nc
+ 'O3'
+ 'CYCLICAL'
+
+ .false.
+ .true.
+
+ 1
+
+ 2000
+
+
+ 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1950_2100_rcp6/IPCC_emissions_DMS_surface_1850-2100_1.9x2.5_c130814.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/ccmi_1950_2100_rcp6/IPCC_emissions_SO2_surface_1850-2100_1.9x2.5_c130814.nc',
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_soag_1.5_surf_1850-2005_c130424.nc',
+ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_bc_surf_1850-2005_c090804.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a1_surf_1850-2005_c150205.nc',
+ 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_num_a2_surf_1850-2005_c090804.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/ar5_mam4_num_a4_surf_1850-2005_c150205.nc',
+ 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_pom_surf_1850-2005_c130424.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a1_surf_1850-2005_c090804.nc',
+ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/trop_mozart_aero/emis/ar5_mam3_so4_a2_surf_1850-2005_c090804.nc'
+
+
+
+
diff --git a/bld/namelist_files/use_cases/2000_cam6_noclb_oslo.xml b/bld/namelist_files/use_cases/2000_cam6_noclb_oslo.xml
new file mode 100644
index 0000000000..21901195ad
--- /dev/null
+++ b/bld/namelist_files/use_cases/2000_cam6_noclb_oslo.xml
@@ -0,0 +1,44 @@
+
+
+
+
+ .true.
+ .false.
+ .true.
+
+ 2000
+ atm/cam/ozone
+ oxid_ozone_WACCM_CCMI_REFC1_2000_cycle_3D_monthly.nc
+
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+
+ 2000
+ atm/cam/ozone
+ oxid_ozone_WACCM_CCMI_REFC1_2000_cycle_3D_monthly.nc
+ 'O3'
+ 'CYCLICAL'
+
+
+ .false.
+ .true.
+
+ 1
+
+ 2000
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+' '
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/2000_cam6_noclb_oslonudge.xml b/bld/namelist_files/use_cases/2000_cam6_noclb_oslonudge.xml
new file mode 100644
index 0000000000..5c5a7c4467
--- /dev/null
+++ b/bld/namelist_files/use_cases/2000_cam6_noclb_oslonudge.xml
@@ -0,0 +1,49 @@
+
+
+
+
+ .true.
+ .false.
+ .true.
+ atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_160505.nc
+
+ 2000
+ atm/cam/ozone
+ oxid_ozone_WACCM_CCMI_REFC1_2000_cycle_3D_monthly.nc
+
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+
+ 2000
+ atm/cam/ozone
+ oxid_ozone_WACCM_CCMI_REFC1_2000_cycle_3D_monthly.nc
+ 'O3'
+ 'CYCLICAL'
+
+
+ .false.
+ .true.
+
+ 1
+
+ 2000
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+/work/shared/noresm/inputdata/noresm-only/inputForNudging/ERA_f09f09_32L_days/2010-01-01.nc
+/work/shared/noresm/inputdata/noresm-only/inputForNudging/ERA_f09f09_32L_days/fileList2001-2015.txt
+
+'xactive_atm'
+
+
diff --git a/bld/namelist_files/use_cases/2000_cam6_oslo.xml b/bld/namelist_files/use_cases/2000_cam6_oslo.xml
new file mode 100644
index 0000000000..10d2d9ba10
--- /dev/null
+++ b/bld/namelist_files/use_cases/2000_cam6_oslo.xml
@@ -0,0 +1,138 @@
+
+
+
+
+
+
+
+
+
+ 2000
+ atm/cam/ozone
+ tracer_cnst_CAM6chem_2000climo_3D_monthly_c171004.nc
+ ''
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+
+ 2000
+ atm/cam/ozone
+ ozone_strataero_CAM6chem_2000climo_zm_5day_c171004.nc
+ 'O3'
+ 'CYCLICAL'
+
+ 'atm/cam/solar/SolarForcing1995-2005avg_c160929.nc'
+ 20000101
+ FIXED
+
+
+ CYCLICAL
+ 2000
+
+
+ CYCLICAL
+ 2000
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_2000climo_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_2000climo_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_2000climo_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_2000climo_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_2000climo_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_2000climo_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_2000climo_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_2000climo_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_2000climo_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_2000climo_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3Dmonthly_L70_2000climo_c180511.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2000climo_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_2000climo_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3Dmonthly_L70_2000climo_c180511.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_2000climo_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_2000climo_1.9x2.5_version20180512.nc'
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_2000climo_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0300D0
+ 0.0300D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted_1995-2005_clim.nc
+2000
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+ 'atm/waccm/lb/LBC_2000climo_CMIP6_0p5degLat_c180227.nc'
+ 'CO2','CH4','N2O','CFC11eq','CFC12'
+ 'CYCLICAL'
+ 2000
+
+
diff --git a/bld/namelist_files/use_cases/2000_cam6_oslonudge.xml b/bld/namelist_files/use_cases/2000_cam6_oslonudge.xml
new file mode 100644
index 0000000000..28480657e0
--- /dev/null
+++ b/bld/namelist_files/use_cases/2000_cam6_oslonudge.xml
@@ -0,0 +1,46 @@
+
+
+
+
+ .true.
+ .false.
+ .true.
+ atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_160505.nc
+
+ 2000
+ atm/cam/ozone
+ oxid_ozone_WACCM_CCMI_REFC1_2000_cycle_3D_monthly.nc
+
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+
+ 2000
+ atm/cam/ozone
+ oxid_ozone_WACCM_CCMI_REFC1_2000_cycle_3D_monthly.nc
+ 'O3'
+ 'CYCLICAL'
+
+ .true.
+
+ .false.
+ .true.
+
+ 1
+
+ 2000
+
+ 0.29
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+/work/shared/noresm/inputdata/noresm-only/inputForNudging/ERA_f09f09_32L_days/2010-01-01.nc
+/work/shared/noresm/inputdata/noresm-only/inputForNudging/ERA_f09f09_32L_days/fileList2001-2015.txt
+
+'xactive_atm'
+
+
diff --git a/bld/namelist_files/use_cases/cam54_ptaero_up1.xml b/bld/namelist_files/use_cases/cam54_ptaero_up1.xml
new file mode 100644
index 0000000000..aad0f0ac98
--- /dev/null
+++ b/bld/namelist_files/use_cases/cam54_ptaero_up1.xml
@@ -0,0 +1,12 @@
+
+
+
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
diff --git a/bld/namelist_files/use_cases/cam5_nudge_ptaero_up1.xml b/bld/namelist_files/use_cases/cam5_nudge_ptaero_up1.xml
new file mode 100644
index 0000000000..5a886bdfc9
--- /dev/null
+++ b/bld/namelist_files/use_cases/cam5_nudge_ptaero_up1.xml
@@ -0,0 +1,19 @@
+
+
+
+
+
+/work/shared/noresm/inputdata/noresm-only/inputForNudging/FAMIPC5NudgeOut/atm/hist/FAMIPC5NudgeOut.cam.h1.1979-01-01-00000.nc
+/work/shared/noresm/inputdata/noresm-only/inputForNudging/FAMIPC5NudgeOut/atm/hist/fileList.txt
+
+
+5
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
diff --git a/bld/namelist_files/use_cases/cam5_ptaero_up1.xml b/bld/namelist_files/use_cases/cam5_ptaero_up1.xml
new file mode 100644
index 0000000000..b4378ac98b
--- /dev/null
+++ b/bld/namelist_files/use_cases/cam5_ptaero_up1.xml
@@ -0,0 +1,15 @@
+
+
+
+
+
+5
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
diff --git a/bld/namelist_files/use_cases/hist_cam6_noresm.xml b/bld/namelist_files/use_cases/hist_cam6_noresm.xml
new file mode 100644
index 0000000000..55bef46c0f
--- /dev/null
+++ b/bld/namelist_files/use_cases/hist_cam6_noresm.xml
@@ -0,0 +1,160 @@
+
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_1750-2015_CMIP6_GlobAnnAvg_c180926.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ INTERP_MISSING_MONTHS
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1849-2015_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1849-2015_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+ INTERP_MISSING_MONTHS
+ INTERP_MISSING_MONTHS
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/hist_cam6_noresm_frc2.xml b/bld/namelist_files/use_cases/hist_cam6_noresm_frc2.xml
new file mode 100644
index 0000000000..386e014c7a
--- /dev/null
+++ b/bld/namelist_files/use_cases/hist_cam6_noresm_frc2.xml
@@ -0,0 +1,140 @@
+
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_1750-2015_CMIP6_GlobAnnAvg_c180926.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ INTERP_MISSING_MONTHS
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_surface_1849-2015_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_surface_1849-2015_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_surface_1849-2015_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_surface_1849-2015_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_surface_1849-2015_0.9x1.25_version20190808.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_surface_1849-2015_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_surface_1849-2015_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_surface_1849-2015_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_surface_1849-2015_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_surface_1849-2015_1.9x2.5_version20190808.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_vertical_1849-2015_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_vertical_1849-2015_0.9x1.25_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_NI_all_vertical_1849-2015_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_vertical_1849-2015_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_vertical_1849-2015_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_vertical_1849-2015_0.9x1.25_version20190808.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_vertical_1849-2015_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_vertical_1849-2015_1.9x2.5_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_NI_all_vertical_1849-2015_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_vertical_1849-2015_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_vertical_1849-2015_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_vertical_1849-2015_1.9x2.5_version20190808.nc'
+
+
+
+
+
+
+
+
+ INTERP_MISSING_MONTHS
+ INTERP_MISSING_MONTHS
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/hist_cam6_noresm_piaer.xml b/bld/namelist_files/use_cases/hist_cam6_noresm_piaer.xml
new file mode 100644
index 0000000000..79ca5139be
--- /dev/null
+++ b/bld/namelist_files/use_cases/hist_cam6_noresm_piaer.xml
@@ -0,0 +1,161 @@
+
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_1750-2015_CMIP6_GlobAnnAvg_c180926.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+ INTERP_MISSING_MONTHS
+ INTERP_MISSING_MONTHS
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/hist_cam6_noresm_piaeroxid.xml b/bld/namelist_files/use_cases/hist_cam6_noresm_piaeroxid.xml
new file mode 100644
index 0000000000..25ea10020e
--- /dev/null
+++ b/bld/namelist_files/use_cases/hist_cam6_noresm_piaeroxid.xml
@@ -0,0 +1,162 @@
+
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_1750-2015_CMIP6_GlobAnnAvg_c180926.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+ INTERP_MISSING_MONTHS
+ INTERP_MISSING_MONTHS
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/hist_cam6_noresm_pintcf.xml b/bld/namelist_files/use_cases/hist_cam6_noresm_pintcf.xml
new file mode 100644
index 0000000000..f087902eae
--- /dev/null
+++ b/bld/namelist_files/use_cases/hist_cam6_noresm_pintcf.xml
@@ -0,0 +1,163 @@
+
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_1750-2015_CMIP6_GlobAnnAvg_c180926.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfAGRTRADOMSOLWSTSHP_surface_1850_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1850_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcCONTEXPL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofENEIND_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbAGRIBORFDEFOPEATSAVATEMF_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcCONTEXPL_vertical_1850_date_0000_5000_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO2_volcALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1850_date_0000_5000_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+ INTERP_MISSING_MONTHS
+ INTERP_MISSING_MONTHS
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/hist_cam6_oslo.xml b/bld/namelist_files/use_cases/hist_cam6_oslo.xml
new file mode 100644
index 0000000000..99179428cd
--- /dev/null
+++ b/bld/namelist_files/use_cases/hist_cam6_oslo.xml
@@ -0,0 +1,143 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_1750-2015_CMIP6_GlobAnnAvg_c180926.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ INTERP_MISSING_MONTHS
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1849-2015_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1849-2015_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+ INTERP_MISSING_MONTHS
+ INTERP_MISSING_MONTHS
+
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0300D0
+ 0.0300D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/sd_hist_cam6_noresm.xml b/bld/namelist_files/use_cases/sd_hist_cam6_noresm.xml
new file mode 100644
index 0000000000..d25e05bde8
--- /dev/null
+++ b/bld/namelist_files/use_cases/sd_hist_cam6_noresm.xml
@@ -0,0 +1,168 @@
+
+
+
+
+
+/work/olivie/topography-era/ERA_bnd_topo_noresm2_20191023.nc
+6
+.true.
+$INPUTDATA_ROOT/noresm-only/inputForNudging/ERA_f09f09_32L_days/2001-01-01.nc
+noresm-only/inputForNudging/ERA_f09f09_32L_days/fileList2001-2015.txt
+'xactive_atm'
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_1750-2015_CMIP6_GlobAnnAvg_c180926.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-20150103_CMIP6ensAvg_c180923.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ INTERP_MISSING_MONTHS
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1849-2015_0.9x1.25_version20180512.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthrosurfALL_surface_1849-2015_1.9x2.5_version20180512.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1849-2015_0.9x1.25_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1849-2015_0.9x1.25_version20180512.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2015_CMIP6ensAvg_c180927.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_AX_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_N_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_BC_NI_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_OM_NI_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO2_volcALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_airALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_anthroprofALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_bbALL_vertical_1849-2015_1.9x2.5_version20180512.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/emissions_cmip6_noresm2_SO4_PR_volcALL_vertical_1849-2015_1.9x2.5_version20180512.nc'
+
+
+
+
+
+
+
+
+ INTERP_MISSING_MONTHS
+ INTERP_MISSING_MONTHS
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/ssp126_cam6.xml b/bld/namelist_files/use_cases/ssp126_cam6.xml
new file mode 100644
index 0000000000..fbb281f3fd
--- /dev/null
+++ b/bld/namelist_files/use_cases/ssp126_cam6.xml
@@ -0,0 +1,94 @@
+
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014-2101_CMIP6-SSP1-2.6_c190307.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_num_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc'
+
+
+
+ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_DMS_bb_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-SSP_DMS_other_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_num_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_num_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_num_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_num_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_num_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_num_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_num_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SO2_anthro-ag-ship-res_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SO2_anthro-ene_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SO2_bb_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SOAGx1.5_anthro_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp126/emissions-cmip6-ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SOAGx1.5_bb_surface_mol_175001-210101_0.9x1.25_c20190225.nc',
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp/emissions-cmip6-SOAGx1.5_biogenic_surface_mol_175001-210101_0.9x1.25_c20190329.nc'
+
+
+
+ atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc
+
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_2014-2101_CMIP6-SSP1-2.6_c190307.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_2015-2100_SSP126_c190221.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ INTERP_MISSING_MONTHS
+ INTERP_MISSING_MONTHS
+
+ 'SERIAL'
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_2015-2100_SSP126_c190221.nc'
+ .true.
+
+
+
+
+
+ .true.
+ atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_ScenarioMIP_IAMC-IMAGE-ssp126_201401-210112_fv_0.9x1.25_c20190207.nc
+ atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_ScenarioMIP_IAMC-IMAGE-ssp126_201401-210112_fv_1.9x2.5_c20190207.nc
+
+ .true.
+ SERIAL
+ atm/cam/ggas
+ ac_CO2 -> emissions-cmip6_CO2_anthro_ac_ssp126_201401-210112_fv_0.9x1.25_c20190207.txt
+ atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_ScenarioMIP_IAMC-IMAGE-ssp126_201401-210112_fv_0.9x1.25_c20190207.nc
+ ac_CO2 -> emissions-cmip6_CO2_anthro_ac_ssp126_201401-210112_fv_1.9x2.5_c20190207.txt
+ atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_ScenarioMIP_IAMC-IMAGE-ssp126_201401-210112_fv_1.9x2.5_c20190207.nc
+
+
+
+ 'CHEM_LBC_FILE'
+ atm/waccm/lb/LBC_2014-2500_CMIP6_SSP126_0p5degLat_GlobAnnAvg_c190301.nc
+ 'SERIAL'
+ 'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+ 1850-2100
+
+
+
diff --git a/bld/namelist_files/use_cases/ssp126_cam6_noresm_frc2.xml b/bld/namelist_files/use_cases/ssp126_cam6_noresm_frc2.xml
new file mode 100644
index 0000000000..e17ba4cfc4
--- /dev/null
+++ b/bld/namelist_files/use_cases/ssp126_cam6_noresm_frc2.xml
@@ -0,0 +1,126 @@
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_2014-2500_CMIP6_SSP126_0p5degLat_GlobAnnAvg_c190301.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_2015-2100_SSP126_c190221_nc3.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_2014-2101_CMIP6-SSP1-2.6_c190307.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ INTERP_MISSING_MONTHS
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_BC_AX_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_BC_N_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_OM_NI_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SO2_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SO4_PR_all_surface_2014-2301_0.9x1.25_version20190808.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_BC_AX_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_BC_N_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_OM_NI_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SO2_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SO4_PR_all_surface_2014-2301_1.9x2.5_version20190808.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014-2101_CMIP6-SSP1-2.6_c190307.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_BC_AX_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_BC_N_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_BC_NI_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_OM_NI_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SO2_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SO4_PR_all_vertical_2014-2301_0.9x1.25_version20190808.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014-2101_CMIP6-SSP1-2.6_c190307.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_BC_AX_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_BC_N_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_BC_NI_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_OM_NI_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SO2_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-IMAGE-ssp126-1-1_SO4_PR_all_vertical_2014-2301_1.9x2.5_version20190808.nc'
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+'INTERP_MISSING_MONTHS'
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/ssp245_cam6.xml b/bld/namelist_files/use_cases/ssp245_cam6.xml
new file mode 100644
index 0000000000..93d19b279b
--- /dev/null
+++ b/bld/namelist_files/use_cases/ssp245_cam6.xml
@@ -0,0 +1,91 @@
+
+
+
+
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2101_CMIP6ensAvg_SSP2-4.5_c190403.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_num_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc'
+
+
+
+ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_DMS_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-SSP_DMS_other_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_num_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_num_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_num_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_num_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_num_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_num_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_num_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO2_anthro-ag-ship-res_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO2_anthro-ene_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO2_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190222.nc'
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SOAGx1.5_anthro_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp245/emissions-cmip6-ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SOAGx1.5_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp/emissions-cmip6-SOAGx1.5_biogenic_surface_mol_175001-210101_0.9x1.25_c20190329.nc'
+
+
+ INTERP_MISSING_MONTHS
+ INTERP_MISSING_MONTHS
+
+
+ atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_1849-2101_CMIP6ensAvg_SSP2-4.5_c190403.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-21010201_CMIP6histEnsAvg_SSP245_c190403.nc'
+ 'O3'
+ 'SERIAL'
+
+ 'SERIAL'
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-21010201_CMIP6histEnsAvg_SSP245_c190403.nc'
+ .true.
+
+
+.true.
+atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245_201401-210112_fv_0.9x1.25_c20190207.nc
+atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245_201401-210112_fv_1.9x2.5_c20190207.nc
+.true.
+
+ SERIAL
+ atm/cam/ggas
+ ac_CO2 -> emissions-cmip6_CO2_anthro_ac_GLOBIOM-ssp245_201401-210112_fv_0.9x1.25_c20190207.txt
+ atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245_201401-210112_fv_0.9x1.25_c20190207.nc
+ ac_CO2 -> emissions-cmip6_CO2_anthro_ac_GLOBIOM-ssp245_201401-210112_fv_1.9x2.5_c20190207.txt
+ atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245_201401-210112_fv_1.9x2.5_c20190207.nc
+
+
+
+
+ 'CHEM_LBC_FILE'
+ atm/waccm/lb/LBC_2014-2500_CMIP6_SSP245_0p5degLat_GlobAnnAvg_c190301.nc
+ 'SERIAL'
+ 'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+ 1850-2100
+
+
diff --git a/bld/namelist_files/use_cases/ssp245_cam6_noresm_aeroxidonly_frc2.xml b/bld/namelist_files/use_cases/ssp245_cam6_noresm_aeroxidonly_frc2.xml
new file mode 100644
index 0000000000..fb3dedec35
--- /dev/null
+++ b/bld/namelist_files/use_cases/ssp245_cam6_noresm_aeroxidonly_frc2.xml
@@ -0,0 +1,134 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_1849-2101_CMIP6ensAvg_SSP2-4.5_c190403.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ INTERP_MISSING_MONTHS
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_AX_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_N_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_OM_NI_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO2_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO4_PR_all_surface_2014-2301_0.9x1.25_version20190808.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_AX_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_N_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_OM_NI_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO2_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO4_PR_all_surface_2014-2301_1.9x2.5_version20190808.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_date_0000_5000_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_AX_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_N_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_NI_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_OM_NI_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO2_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO4_PR_all_vertical_2014-2301_0.9x1.25_version20190808.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20180512/perturbations/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_date_0000_5000_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_AX_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_N_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_NI_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_OM_NI_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO2_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO4_PR_all_vertical_2014-2301_1.9x2.5_version20190808.nc'
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/ssp245_cam6_noresm_frc2.xml b/bld/namelist_files/use_cases/ssp245_cam6_noresm_frc2.xml
new file mode 100644
index 0000000000..f11c1f9025
--- /dev/null
+++ b/bld/namelist_files/use_cases/ssp245_cam6_noresm_frc2.xml
@@ -0,0 +1,126 @@
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_2014-2500_CMIP6_SSP245_0p5degLat_GlobAnnAvg_c190301.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-21010201_CMIP6histEnsAvg_SSP245_c190403.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_1849-2101_CMIP6ensAvg_SSP2-4.5_c190403.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ INTERP_MISSING_MONTHS
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_AX_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_N_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_OM_NI_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO2_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO4_PR_all_surface_2014-2301_0.9x1.25_version20190808.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_AX_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_N_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_OM_NI_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO2_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO4_PR_all_surface_2014-2301_1.9x2.5_version20190808.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2101_CMIP6ensAvg_SSP2-4.5_c190403.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_AX_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_N_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_NI_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_OM_NI_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO2_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO4_PR_all_vertical_2014-2301_0.9x1.25_version20190808.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2101_CMIP6ensAvg_SSP2-4.5_c190403.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_AX_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_N_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_BC_NI_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_OM_NI_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO2_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-MESSAGE-GLOBIOM-ssp245-1-1_SO4_PR_all_vertical_2014-2301_1.9x2.5_version20190808.nc'
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+'INTERP_MISSING_MONTHS'
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/ssp245_cam6_noresm_ghgonly_frc2.xml b/bld/namelist_files/use_cases/ssp245_cam6_noresm_ghgonly_frc2.xml
new file mode 100644
index 0000000000..1ca7d147ca
--- /dev/null
+++ b/bld/namelist_files/use_cases/ssp245_cam6_noresm_ghgonly_frc2.xml
@@ -0,0 +1,136 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6piControl_c160921.nc'
+ 18500101
+ FIXED
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_2014-2500_CMIP6_SSP245_0p5degLat_GlobAnnAvg_c190301.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_surface_1850_0.9x1.25_version20190808.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_surface_1850_1.9x2.5_version20190808.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2101_CMIP6ensAvg_SSP2-4.5_c190403.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_BC_AX_all_vertical_1850_date_0000_5000_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_BC_N_all_vertical_1850_date_0000_5000_0.9x1.25_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_BC_NI_all_vertical_1850_date_0000_5000_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_OM_NI_all_vertical_1850_date_0000_5000_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_SO2_all_vertical_1850_date_0000_5000_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_SO4_PR_all_vertical_1850_date_0000_5000_0.9x1.25_version20190808.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2101_CMIP6ensAvg_SSP2-4.5_c190403.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_BC_AX_all_vertical_1850_date_0000_5000_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_BC_N_all_vertical_1850_date_0000_5000_1.9x2.5_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_BC_NI_all_vertical_1850_date_0000_5000_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_OM_NI_all_vertical_1850_date_0000_5000_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_SO2_all_vertical_1850_date_0000_5000_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/perturbations/emissions_cmip6_noresm2_SO4_PR_all_vertical_1850_date_0000_5000_1.9x2.5_version20190808.nc'
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+atm/cam/volc
+CMIP_CAM6_radiation_average_v3_reformatted.nc
+1850
+CYCLICAL
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/ssp245_cam6_noresm_natonly_frc2.xml b/bld/namelist_files/use_cases/ssp245_cam6_noresm_natonly_frc2.xml
new file mode 100644
index 0000000000..10640234f6
--- /dev/null
+++ b/bld/namelist_files/use_cases/ssp245_cam6_noresm_natonly_frc2.xml
@@ -0,0 +1,134 @@
+
+
+
+
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 284.32e-6
+ 808.25e-9
+ 273.02e-9
+ 32.11e-12
+ 0.0
+
+
+ 1850
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_cyclical_WACCM6_L70_CMIP6-piControl.001_y21-50avg_zm_5day_c180802.nc'
+ 'O3'
+ 'CYCLICAL'
+
+
+ 1850
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_WACCM6_halons_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc'
+ 'O3','OH','NO3','HO2'
+ 'CYCLICAL'
+ ''
+
+
+ CYCLICAL
+ 1850
+
+
+ CYCLICAL
+ 1850
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_surface_1850_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_surface_1850_0.9x1.25_version20190808.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_surface_1850_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_surface_1850_1.9x2.5_version20190808.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_vertical_1850_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_vertical_1850_0.9x1.25_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_NI_all_vertical_1850_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_vertical_1850_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_vertical_1850_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_vertical_1850_0.9x1.25_version20190808.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2O_emission_CH4_oxidationx2_elev_3DmonthlyL70_1850climoCMIP6piControl001_y21-50avg_c180802.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_AX_all_vertical_1850_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_N_all_vertical_1850_1.9x2.5_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_BC_NI_all_vertical_1850_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_OM_NI_all_vertical_1850_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO2_all_vertical_1850_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_SO4_PR_all_vertical_1850_1.9x2.5_version20190808.nc'
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+'INTERP_MISSING_MONTHS'
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/ssp370_cam6.xml b/bld/namelist_files/use_cases/ssp370_cam6.xml
new file mode 100644
index 0000000000..e3d6720a91
--- /dev/null
+++ b/bld/namelist_files/use_cases/ssp370_cam6.xml
@@ -0,0 +1,90 @@
+
+
+
+
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2101_CMIP6ensAvg_SSP3-7.0_c190403.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_num_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc'
+
+
+
+ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_DMS_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-SSP_DMS_other_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_num_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_num_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_num_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_num_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_num_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_num_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_num_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_SO2_anthro-ag-ship-res_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_SO2_anthro-ene_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_SO2_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190222.nc'
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_SOAGx1.5_anthro_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp370/emissions-cmip6-ScenarioMIP_IAMC-AIM-ssp370-1-1_SOAGx1.5_bb_surface_mol_175001-210101_0.9x1.25_c20190222.nc',
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp/emissions-cmip6-SOAGx1.5_biogenic_surface_mol_175001-210101_0.9x1.25_c20190329.nc'
+
+
+ INTERP_MISSING_MONTHS
+ INTERP_MISSING_MONTHS
+
+
+ atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_1849-2101_CMIP6ensAvg_SSP3-7.0_c190403.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-21010201_CMIP6histEnsAvg_SSP370_c190403.nc'
+ 'O3'
+ 'SERIAL'
+
+ 'SERIAL'
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-21010201_CMIP6histEnsAvg_SSP370_c190403.nc'
+ .true.
+
+
+ .true.
+ atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_ScenarioMIP_IAMC-AIM-ssp370_201401-210112_fv_0.9x1.25_c20190207.nc
+ atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_ScenarioMIP_IAMC-AIM-ssp370_201401-210112_fv_1.9x2.5_c20190207.nc
+ .true.
+
+ SERIAL
+ atm/cam/ggas
+ ac_CO2 -> emissions-cmip6_CO2_anthro_ac_ssp370_201401-210112_fv_0.9x1.25_c20190207.txt
+ atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_ScenarioMIP_IAMC-AIM-ssp370_201401-210112_fv_0.9x1.25_c20190207.nc
+ ac_CO2 -> emissions-cmip6_CO2_anthro_ac_ssp370_201401-210112_fv_1.9x2.5_c20190207.txt
+ atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_ScenarioMIP_IAMC-AIM-ssp370_201401-210112_fv_1.9x2.5_c20190207.nc
+
+
+
+ 'CHEM_LBC_FILE'
+ atm/waccm/lb/LBC_2014-2500_CMIP6_SSP370_0p5degLat_GlobAnnAvg_c190301.nc
+ 'SERIAL'
+ 'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+ 1850-2100
+
+
diff --git a/bld/namelist_files/use_cases/ssp370_cam6_noresm_frc2.xml b/bld/namelist_files/use_cases/ssp370_cam6_noresm_frc2.xml
new file mode 100644
index 0000000000..4e0fc8d31a
--- /dev/null
+++ b/bld/namelist_files/use_cases/ssp370_cam6_noresm_frc2.xml
@@ -0,0 +1,126 @@
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_2014-2500_CMIP6_SSP370_0p5degLat_GlobAnnAvg_c190301.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_18500101-21010201_CMIP6histEnsAvg_SSP370_c190403.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_1849-2101_CMIP6ensAvg_SSP3-7.0_c190403.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ INTERP_MISSING_MONTHS
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_BC_AX_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_BC_N_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_OM_NI_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_SO2_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_SO4_PR_all_surface_2014-2301_0.9x1.25_version20190808.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_BC_AX_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_BC_N_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_OM_NI_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_SO2_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_SO4_PR_all_surface_2014-2301_1.9x2.5_version20190808.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2101_CMIP6ensAvg_SSP3-7.0_c190403.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_BC_AX_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_BC_N_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_BC_NI_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_OM_NI_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_SO2_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_SO4_PR_all_vertical_2014-2301_0.9x1.25_version20190808.nc'
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_1849-2101_CMIP6ensAvg_SSP3-7.0_c190403.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_BC_AX_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_BC_N_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_BC_NI_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_OM_NI_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_SO2_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-AIM-ssp370-1-1_SO4_PR_all_vertical_2014-2301_1.9x2.5_version20190808.nc'
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+'INTERP_MISSING_MONTHS'
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/bld/namelist_files/use_cases/ssp585_cam6.xml b/bld/namelist_files/use_cases/ssp585_cam6.xml
new file mode 100644
index 0000000000..451a93671a
--- /dev/null
+++ b/bld/namelist_files/use_cases/ssp585_cam6.xml
@@ -0,0 +1,96 @@
+
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014-2101_CMIP6-SSP5-8.5_c190307.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a1_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_num_a2_so4_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_SO2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a1_anthro-ene_vertical_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a1_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc',
+ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/CMIP6_emissions_1750_2015/emissions-cmip6_so4_a2_contvolcano_vertical_850-5000_0.9x1.25_c20170724.nc'
+
+
+
+
+ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'bc_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_DMS_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'DMS -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-SSP_DMS_other_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'num_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'num_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_bc_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_bc_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'num_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_num_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_pom_a4_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'pom_a4 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_pom_a4_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_anthro-ag-ship-res_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_anthro-ene_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a1_anthro-ag-ship_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'so4_a1 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a1_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'so4_a2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_so4_a2_anthro-res_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SOAGx1.5_anthro_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SOAGx1.5_bb_surface_mol_175001-210101_0.9x1.25_c20190224.nc',
+ 'SOAG -> $INPUTDATA_ROOT/atm/cam/chem/emis/emissions_ssp585/emissions-cmip6-ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SOAGx1.5_biogenic_surface_mol_175001-210101_0.9x1.25_c20190226.nc'
+
+
+
+
+ atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_2014-2101_CMIP6-SSP5-8.5_c190307.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_2015-2100_SSP585_c190529.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ INTERP_MISSING_MONTHS
+ INTERP_MISSING_MONTHS
+
+
+ 'SERIAL'
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_2015-2100_SSP585_c190529.nc'
+ .true.
+
+
+.true.
+atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585_201401-210112_fv_0.9x1.25_c20190207.nc
+
+atm/cam/ggas/emissions-cmip6_CO2_anthro_surface_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585_201401-210112_fv_0.9x1.25_c20190207.nc
+
+
+.true.
+SERIAL
+atm/cam/ggas
+ac_CO2 -> emissions-cmip6_CO2_anthro_ac_MAGPIE-ssp585_201401-210112_fv_0.9x1.25_c20190207.txt
+atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585_201401-210112_fv_0.9x1.25_c20190207.nc
+
+
+ac_CO2 -> emissions-cmip6_CO2_anthro_ac_MAGPIE-ssp585_201401-210112_fv_0.9x1.25_c20190207.txt
+atm/cam/ggas/emissions-cmip6_CO2_anthro_ac_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585_201401-210112_fv_0.9x1.25_c20190207.nc
+
+ 'CHEM_LBC_FILE'
+ atm/waccm/lb/LBC_2014-2500_CMIP6_SSP585_0p5degLat_GlobAnnAvg_c190301.nc
+ 'SERIAL'
+ 'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+
+ 1850-2100
+
+
+
diff --git a/bld/namelist_files/use_cases/ssp585_cam6_noresm_frc2.xml b/bld/namelist_files/use_cases/ssp585_cam6_noresm_frc2.xml
new file mode 100644
index 0000000000..68b680c437
--- /dev/null
+++ b/bld/namelist_files/use_cases/ssp585_cam6_noresm_frc2.xml
@@ -0,0 +1,126 @@
+
+
+
+
+
+ 'atm/cam/solar/SolarForcingCMIP6_18491230-22991231_c171031.nc'
+
+
+ 'CHEM_LBC_FILE'
+
+atm/waccm/lb/LBC_2014-2500_CMIP6_SSP585_0p5degLat_GlobAnnAvg_c190301.nc
+'SERIAL'
+'CO2','CH4','N2O','CFC11eq','CFC12'
+
+
+ 'atm/cam/ozone_strataero'
+ 'ozone_strataero_WACCM_L70_zm5day_2015-2100_SSP585_c190529.nc'
+ 'O3'
+ 'SERIAL'
+
+
+ 'atm/cam/tracer_cnst'
+ 'tracer_cnst_halons_3D_L70_2014-2101_CMIP6-SSP5-8.5_c190307.nc'
+ 'O3','OH','NO3','HO2'
+ 'INTERP_MISSING_MONTHS'
+ ''
+
+
+ INTERP_MISSING_MONTHS
+
+
+ INTERP_MISSING_MONTHS
+
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BC_AX_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BC_N_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_OM_NI_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_all_surface_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO4_PR_all_surface_2014-2301_0.9x1.25_version20190808.nc'
+
+
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BC_AX_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BC_N_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_OM_NI_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_all_surface_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO4_PR_all_surface_2014-2301_1.9x2.5_version20190808.nc'
+
+
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014-2101_CMIP6-SSP5-8.5_c190307.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BC_AX_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BC_N_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BC_NI_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_OM_NI_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO4_PR_all_vertical_2014-2301_0.9x1.25_version20190808.nc',
+
+
+ 'H2O -> $INPUTDATA_ROOT/atm/cam/chem/emis/elev/H2OemissionCH4oxidationx2_3D_L70_2014-2101_CMIP6-SSP5-8.5_c190307.nc',
+ 'BC_AX -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BC_AX_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_N -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BC_N_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'BC_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_BC_NI_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'OM_NI -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_OM_NI_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO2 -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO2_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+ 'SO4_PR -> $INPUTDATA_ROOT/atm/cam/chem/emis/cmip6_emissions_version20190808/emissions_cmip6_noresm2_ScenarioMIP_IAMC-REMIND-MAGPIE-ssp585-1-1_SO4_PR_all_vertical_2014-2301_1.9x2.5_version20190808.nc',
+
+
+
+0.286
+0.264
+
+
+ .false.
+ .true.
+ .true.
+ .true.
+ .true.
+ .true.
+
+
+ .true.
+
+
+ .true.
+
+
+ 0.0200D0
+ 0.0200D0
+
+ 8.0E-6
+ 8.0E-6
+
+
+
+5.5e-4
+5.0e-4
+
+
+ .true.
+
+
+ 4
+
+
+0.90D0
+
+
+'isoprene = isoprene','monoterp = myrcene + sabinene + limonene+ carene_3 + ocimene_t_b + pinene_b + pinene_a'
+
+
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_isopr_1850_2000_zero.nc
+noresm-only/atm/cam/chem/trop_mozart_aero/emis/soanucl/bvocgcmFV19_monoterp_1850_2000_zero.nc
+
+
+1850
+
+
+
+'INTERP_MISSING_MONTHS'
+atm/cam/volc
+CMIP_CAM6_radiation_v3_reformatted.nc
+'A:Q:H2O','N:O2:O2','N:CO2:CO2','N:ozone:O3','N:N2O:N2O','N:CH4:CH4','N:CFC11:CFC11','N:CFC12:CFC12'
+
+
diff --git a/chem_proc/README b/chem_proc/README
new file mode 100644
index 0000000000..2b0e6b6938
--- /dev/null
+++ b/chem_proc/README
@@ -0,0 +1,34 @@
+
+This is the MOZART chemical preprocessor, which has been modified for the
+CAM framework.
+
+This tool creates CAM chemistry source code files (fortran) for a given
+chemical mechanism file (*.inp file).
+
+Here $PROC_DIR is the top level directory of the chemical preprocessor.
+
+To build:
+> cd $PROC_DIR/src
+> gmake
+This will biuld $PROC_DIR/bin/campp executable.
+
+Edit or create a chemical mechanism file in the $PROC_DIR/inputs
+directory. Example mechanisms files can be found in $PROC_DIR/inputs.
+More information the chemical mechanism inputs can be found at
+http://gctm.acd.ucar.edu/mozart/documents/mozart2_preprocessor.pdf
+
+To run:
+> cd $PROC_DIR/inputs
+> $PROC_DIR/bin/campp mechanism.inp
+> cd $PROC_DIR/output
+> cp cam.subs.tar $CAM_USRSRC
+> cd $CAM_USRSRC
+> tar -xvf cam.subs.tar
+
+Include the fortran source files extacted from cam.subs.tar in the
+source path of the CAM build by one of the follow methods.
+ 1) configure CAM with the -usr_src $CAM_USRSRC option
+or
+ 2) copy the new *.F90 files to the trop_mozart directory
+
+Configure and build the new CAM executable.
diff --git a/chem_proc/bkend/cam.mod.files.PP b/chem_proc/bkend/cam.mod.files.PP
new file mode 100644
index 0000000000..05ee37296b
--- /dev/null
+++ b/chem_proc/bkend/cam.mod.files.PP
@@ -0,0 +1,9 @@
+# include
+# include
+# include
+# include
+# include
+#if defined(MOZART)
+MODSPATH/mo_grid.mod
+#endif
+MODSPATH/mo_chem.mod
diff --git a/chem_proc/bkend/cam.src.files.PP b/chem_proc/bkend/cam.src.files.PP
new file mode 100644
index 0000000000..a6c6847467
--- /dev/null
+++ b/chem_proc/bkend/cam.src.files.PP
@@ -0,0 +1,11 @@
+# include
+# include
+# include
+# include
+# if defined(RXTNLOOKUP) && TDEPCNT != 0
+rxttab.F
+# endif
+SETRXTFILE
+ADJRXTFILE
+PHTADJFILE
+SETDATFILE
diff --git a/chem_proc/bkend/mozart.mat.files.PP b/chem_proc/bkend/mozart.mat.files.PP
new file mode 100644
index 0000000000..f00a5dc794
--- /dev/null
+++ b/chem_proc/bkend/mozart.mat.files.PP
@@ -0,0 +1,9 @@
+# include
+# include
+# include
+prd_loss.F
+indprd.F
+linmat.F
+nlnmat.F
+lu_fac.F
+lu_slv.F
diff --git a/chem_proc/bkend/mozart.mod.files.PP b/chem_proc/bkend/mozart.mod.files.PP
new file mode 100644
index 0000000000..0deac5ad98
--- /dev/null
+++ b/chem_proc/bkend/mozart.mod.files.PP
@@ -0,0 +1,7 @@
+# include
+# include
+# include
+# include
+# include
+MODSPATH/mo_grid.mod
+MODSPATH/mo_chem.mod
diff --git a/chem_proc/bkend/mozart.src.files.PP b/chem_proc/bkend/mozart.src.files.PP
new file mode 100644
index 0000000000..9b77ce4601
--- /dev/null
+++ b/chem_proc/bkend/mozart.src.files.PP
@@ -0,0 +1,12 @@
+# include
+# include
+# include
+# include
+# if defined(RXTNLOOKUP) && TDEPCNT != 0
+rxttab.F
+# endif
+SETRXTFILE
+ADJRXTFILE
+PHTADJFILE
+RXTMODFILE
+GRPVMRFILE
diff --git a/chem_proc/bkend/wrf.mod.files.PP b/chem_proc/bkend/wrf.mod.files.PP
new file mode 100644
index 0000000000..05ee37296b
--- /dev/null
+++ b/chem_proc/bkend/wrf.mod.files.PP
@@ -0,0 +1,9 @@
+# include
+# include
+# include
+# include
+# include
+#if defined(MOZART)
+MODSPATH/mo_grid.mod
+#endif
+MODSPATH/mo_chem.mod
diff --git a/chem_proc/inputs/cam_TP1.inp b/chem_proc/inputs/cam_TP1.inp
new file mode 100644
index 0000000000..d173facf4b
--- /dev/null
+++ b/chem_proc/inputs/cam_TP1.inp
@@ -0,0 +1,118 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_nosynoz.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_nosynoz.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ CO
+ COEA -> CO
+ COSA -> CO
+ COEU -> CO
+ CONA -> CO
+ COAVOC -> CO
+ COBVOC -> CO
+ COCH4 -> CO
+ CAVOC -> C
+ CBVOC -> C
+ PRO1 -> C3H8
+ BUT1 -> C4H10
+ ETH1 -> C2H6
+ PRO2 -> C3H8
+ BUT2 -> C4H10
+ ETH2 -> C2H6
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, CH4
+ End Fixed
+
+ Col-int
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CO
+ COEA
+ COSA
+ COEU
+ CONA
+ COAVOC
+ COBVOC
+ COCH4
+ CAVOC
+ CBVOC
+ PRO1
+ BUT1
+ ETH1
+ PRO2
+ BUT2
+ ETH2
+ End Explicit
+ Implicit
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ End Photolysis
+
+ Reactions
+ CO -> ; 4.62963e-07
+ COEA -> ; 4.62963e-07
+ COSA -> ; 4.62963e-07
+ COEU -> ; 4.62963e-07
+ CONA -> ; 4.62963e-07
+ COAVOC -> ; 4.62963e-07
+ COBVOC -> ; 4.62963e-07
+ COCH4 -> ; 4.62963e-07
+ CAVOC -> 0.7*COAVOC ; 1.65344e-06
+ CBVOC -> 0.4*COBVOC ; 1.15741e-05
+ CH4 -> 0.86*COCH4 ; 3.83142e-07
+ PRO1 -> ; 0.86e-7
+ BUT1 -> ; 2.05e-7
+ ETH1 -> ; 0.18e-7
+ PRO2 -> ; 1.72e-7
+ BUT2 -> ; 4.10e-7
+ ETH2 -> ; 0.36e-7
+ End Reactions
+
+ Heterogeneous
+ End Heterogeneous
+
+ Ext Forcing
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_TP1.v2.inp b/chem_proc/inputs/cam_TP1.v2.inp
new file mode 100644
index 0000000000..0ace862cf3
--- /dev/null
+++ b/chem_proc/inputs/cam_TP1.v2.inp
@@ -0,0 +1,147 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_nosynoz.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_nosynoz.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ CO
+ COEA -> CO
+ COSA -> CO
+ COEU -> CO
+ CONA -> CO
+ SCO -> CO
+ SCOEA -> CO
+ SCOSA -> CO
+ SCOEU -> CO
+ SCONA -> CO
+ COAVOC -> CO
+ COBVOC -> CO
+ COCH4 -> CO
+ CAVOC -> C
+ CBVOC -> C
+ PRO1 -> C3H8
+ BUT1 -> C4H10
+ ETH1 -> C2H6
+ PRO2 -> C3H8
+ BUT2 -> C4H10
+ ETH2 -> C2H6
+ LVOC -> C
+ MVOC -> C
+ SVOC -> C
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, CH4
+ End Fixed
+
+ Col-int
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CO
+ COEA
+ COSA
+ COEU
+ CONA
+ SCO
+ SCOEA
+ SCOSA
+ SCOEU
+ SCONA
+ COAVOC
+ COBVOC
+ COCH4
+ CAVOC
+ CBVOC
+ PRO1
+ BUT1
+ ETH1
+ PRO2
+ BUT2
+ ETH2
+ LVOC
+ MVOC
+ SVOC
+ End Explicit
+ Implicit
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ End Photolysis
+
+ Reactions
+ CO -> ; 2.3148e-07
+ COEA -> ; 2.3148e-07
+ COSA -> ; 2.3148e-07
+ COEU -> ; 2.3148e-07
+ CONA -> ; 2.3148e-07
+
+ SCO -> ; 2.3148e-07
+ SCOEA -> ; 2.3148e-07
+ SCOSA -> ; 2.3148e-07
+ SCOEU -> ; 2.3148e-07
+ SCONA -> ; 2.3148e-07
+
+ COAVOC -> ; 2.3148e-07
+ COBVOC -> ; 2.3148e-07
+ COCH4 -> ; 2.3148e-07
+
+ CAVOC -> 0.7*COAVOC ; 1.65344e-06
+ CBVOC -> 0.4*COBVOC ; 1.15741e-05
+ CH4 -> 0.86*COCH4 ; 3.73e-09
+ PRO1 -> ; 0.86e-07
+ BUT1 -> ; 2.05e-07
+ ETH1 -> ; 0.18e-07
+ PRO2 -> ; 1.72e-07
+ BUT2 -> ; 4.10e-07
+ ETH2 -> ; 0.36e-07
+
+ LVOC -> ; 1.80845E-07
+ MVOC -> ; 8.90313E-07
+ SVOC -> ; 2.0668E-06
+
+ End Reactions
+
+ Heterogeneous
+ End Heterogeneous
+
+ Ext Forcing
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_arctas_gfs.inp b/chem_proc/inputs/cam_arctas_gfs.inp
new file mode 100644
index 0000000000..1e4f42aa03
--- /dev/null
+++ b/chem_proc/inputs/cam_arctas_gfs.inp
@@ -0,0 +1,353 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_arctas_gfs.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = arctas_gfst42.dat
+
+Comments
+ "This is a cam-chem simulation with :"
+ "(1) NCEP/GFS meteorology inputs"
+ "(2) no SYNOZ"
+ "(3) CO tags for ARCTAS forecasts"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, DMS -> CH3SCH3, SO4, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ O3S -> O3, O3INERT -> O3
+ COnama -> CO, COnamb -> CO, COeura -> CO, COeurb -> CO
+ COnasa -> CO, COnasb -> CO, COsasa -> CO, COsasb -> CO
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, H2, O3INERT, O3S
+ COnama, COnamb, COeura, COeurb, COnasa, COnasb, COsasa, COsasb
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ SO2, DMS, SO4, NH3, NH4, NH4NO3, SOA
+ CB1, CB2, OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+* [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 4.4e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+* ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 1.52e-11, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+*30-day lifetime
+ COnama -> CO2 ; 3.8e-7
+ COnamb -> CO2 ; 3.8e-7
+ COeura -> CO2 ; 3.8e-7
+ COeurb -> CO2 ; 3.8e-7
+ COnasa -> CO2 ; 3.8e-7
+ COnasb -> CO2 ; 3.8e-7
+ COsasa -> CO2 ; 3.8e-7
+ COsasb -> CO2 ; 3.8e-7
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, SO4, SOA, NH3, NH4, NH4NO3, CB2, OC2, SSLT01, SSLT02, SSLT03, SSLT04
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_bc.inp b/chem_proc/inputs/cam_bc.inp
new file mode 100644
index 0000000000..be0fc12c10
--- /dev/null
+++ b/chem_proc/inputs/cam_bc.inp
@@ -0,0 +1,78 @@
+BEGSIM
+output_unit_number = 7
+output_file = bc.doc
+sim_dat_filename = sim.dat
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+
+Comments
+ "This is a mozart2 simulation with :"
+ "(1) The new Lin and Rood advection routine"
+End Comments
+
+ SPECIES
+
+ Solution
+ CB1 -> C, CB2 -> C
+ End Solution
+
+ Fixed
+ M, N2, O2
+ End Fixed
+
+ Col-int
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ CB1,CB2
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+
+ Reactions
+ CB1 -> CB2 ; 7.1e-6
+ End Reactions
+
+ Ext Forcing
+ End Ext Forcing
+
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = Intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/chem_proc/inputs/cam_co_prescribed.inp b/chem_proc/inputs/cam_co_prescribed.inp
new file mode 100644
index 0000000000..d943e742d7
--- /dev/null
+++ b/chem_proc/inputs/cam_co_prescribed.inp
@@ -0,0 +1,79 @@
+BEGSIM
+output_unit_number = 7
+output_file = co2.doc
+sim_dat_filename = sim.dat
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+
+Comments
+ "This is a mozart2 simulation with :"
+ "(1) The new Lin and Rood advection routine"
+End Comments
+
+ SPECIES
+
+ Solution
+ CO
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, OH
+ End Fixed
+
+ Col-int
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CO
+ End Explicit
+ Implicit
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+
+ Reactions
+[usr8] CO + OH -> CO2 + HO2
+ End Reactions
+
+ Ext Forcing
+ CO<-dataset
+ End Ext Forcing
+
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = Intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/chem_proc/inputs/cam_fixed_aerosols.inp b/chem_proc/inputs/cam_fixed_aerosols.inp
new file mode 100644
index 0000000000..5143d3b1b4
--- /dev/null
+++ b/chem_proc/inputs/cam_fixed_aerosols.inp
@@ -0,0 +1,70 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_fixed_oxidants.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_fixed_oxidants.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, SO4, CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ End Photolysis
+
+ Reactions
+ End Reactions
+
+ Ext Forcing
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_fixed_aerosols_ozone.inp b/chem_proc/inputs/cam_fixed_aerosols_ozone.inp
new file mode 100644
index 0000000000..653d868595
--- /dev/null
+++ b/chem_proc/inputs/cam_fixed_aerosols_ozone.inp
@@ -0,0 +1,71 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_fixed_oxidants.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_fixed_oxidants.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, SO4, CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ O3
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ End Photolysis
+
+ Reactions
+ End Reactions
+
+ Ext Forcing
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_fixed_aerosols_run6.inp b/chem_proc/inputs/cam_fixed_aerosols_run6.inp
new file mode 100644
index 0000000000..d924cc0a42
--- /dev/null
+++ b/chem_proc/inputs/cam_fixed_aerosols_run6.inp
@@ -0,0 +1,71 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_fixed_oxidants.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_fixed_oxidants.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, SO4, CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C,
+ SOA -> C12, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ End Photolysis
+
+ Reactions
+ End Reactions
+
+ Ext Forcing
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_fixed_ch4_2.inp b/chem_proc/inputs/cam_fixed_ch4_2.inp
new file mode 100644
index 0000000000..150304a916
--- /dev/null
+++ b/chem_proc/inputs/cam_fixed_ch4_2.inp
@@ -0,0 +1,354 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_ncep.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_ncep.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4, CH4CHML->CH4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, CH4
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD, CH4CHML
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+* CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+* CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ CH4 + OH -> CH3O2 + H2O + CH4CHML ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 + CH4CHML ; 1.5e-10
+ CH4CHML -> ; 7.1 e-6
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+* [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+* + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Numerical Control
+ Implicit Iterations = 11
+ End Numerical Control
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_fixed_oxidants.inp b/chem_proc/inputs/cam_fixed_oxidants.inp
new file mode 100644
index 0000000000..b7ce5b6b3f
--- /dev/null
+++ b/chem_proc/inputs/cam_fixed_oxidants.inp
@@ -0,0 +1,70 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_fixed_oxidants.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_fixed_oxidants.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ H2O2, SO2, SO4, DMS -> CH3SCH3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, O3, OH, NO3, HO2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ H2O2, SO2, SO4, DMS
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ End Photolysis
+
+ Reactions
+ End Reactions
+
+ Ext Forcing
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_fixed_oxidants_aerosols.inp b/chem_proc/inputs/cam_fixed_oxidants_aerosols.inp
new file mode 100644
index 0000000000..391fc794fb
--- /dev/null
+++ b/chem_proc/inputs/cam_fixed_oxidants_aerosols.inp
@@ -0,0 +1,85 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_fixed_oxidants.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_fixed_oxidants.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ H2O2, SO2, SO4, DMS -> CH3SCH3
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ O3, OH, NO3, HO2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ H2O2, SO2, SO4, DMS
+ CB1, CB2, OC1, OC2
+ SSLT01, SSLT02, SSLT03, SSLT04
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ End Photolysis
+
+ Reactions
+ CB1 -> CB2 ; 1.006e-05
+ OC1 -> OC2 ; 1.006e-05
+ End Reactions
+
+ Heterogeneous
+ H2O2, SO2
+ End Heterogeneous
+
+ Ext Forcing
+ SO2 <- dataset
+ SO4 <- dataset
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_fixed_oxidants_modal_aero_cw_3modes_0707.inp b/chem_proc/inputs/cam_fixed_oxidants_modal_aero_cw_3modes_0707.inp
new file mode 100644
index 0000000000..9bdef974e3
--- /dev/null
+++ b/chem_proc/inputs/cam_fixed_oxidants_modal_aero_cw_3modes_0707.inp
@@ -0,0 +1,101 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_fixed_oxidants_modal_aero_cw_3modes_0707.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_fixed_oxidants_modal_aero_cw_3modes_0707.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ H2O2, H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C
+ so4_a1 -> NH4HSO4
+ pom_a1 -> C, soa_a1 -> C, bc_a1 -> C
+ dst_a1 -> AlSiO5, ncl_a1 -> NaCl
+ num_a1 -> H
+ so4_a2 -> NH4HSO4
+ soa_a2 -> C, ncl_a2 -> NaCl
+ num_a2 -> H
+ dst_a3 -> AlSiO5, ncl_a3 -> NaCl
+ so4_a3 -> NH4HSO4
+ num_a3 -> H
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, O3, OH, NO3, HO2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ H2O2, H2SO4, SO2, DMS, SOAG
+ so4_a1, pom_a1
+ soa_a1, bc_a1, dst_a1, ncl_a1
+ num_a1
+ so4_a2, soa_a2, ncl_a2, num_a2
+ dst_a3, ncl_a3, so4_a3, num_a3
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jh2o2] H2O2 + hv ->
+ End Photolysis
+
+ Reactions
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ [usr23] SO2 + OH -> H2SO4
+ DMS + OH -> SO2 ; 9.6e-12, -234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ End Reactions
+
+ Heterogeneous
+ H2O2, SO2
+ End Heterogeneous
+
+ Ext Forcing
+ SO2 <- dataset
+ so4_a1 <- dataset
+ so4_a2 <- dataset
+ num_a1 <- dataset
+ num_a2 <- dataset
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_fixed_oxidants_modal_aero_cw_7modes_noaerwater.inp b/chem_proc/inputs/cam_fixed_oxidants_modal_aero_cw_7modes_noaerwater.inp
new file mode 100644
index 0000000000..679319cfe2
--- /dev/null
+++ b/chem_proc/inputs/cam_fixed_oxidants_modal_aero_cw_7modes_noaerwater.inp
@@ -0,0 +1,112 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_fixed_oxidants_modal_aero_cw_7modes_noaerwater.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_fixed_oxidants_modal_aero_cw_7modes_noaerwater.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ H2O2, H2SO4, SO2, DMS -> CH3SCH3, NH3, SOAG -> C
+ so4_a1 -> SO4, nh4_a1 -> NH4
+ pom_a1 -> C, soa_a1 -> C, bc_a1 -> C, ncl_a1 -> NaCl
+ num_a1 -> H
+ so4_a2 -> SO4, nh4_a2 -> NH4
+ soa_a2 -> C, ncl_a2 -> NaCl
+ num_a2 -> H
+ pom_a3 -> C, bc_a3 -> C
+ num_a3 -> H
+ ncl_a4 -> NaCl, so4_a4 -> SO4
+ nh4_a4 -> NH4, num_a4 -> H
+ dst_a5 -> AlSiO5, so4_a5 -> SO4
+ nh4_a5 -> NH4, num_a5 -> H
+ ncl_a6 -> NaCl, so4_a6 -> SO4
+ nh4_a6 -> NH4, num_a6 -> H
+ dst_a7 -> AlSiO5, so4_a7 -> SO4
+ nh4_a7 -> NH4, num_a7 -> H
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, O3, OH, NO3, HO2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ H2O2, H2SO4, SO2, DMS, NH3, SOAG
+ so4_a1, nh4_a1, pom_a1
+ soa_a1, bc_a1, ncl_a1, num_a1
+ so4_a2, nh4_a2, soa_a2, ncl_a2
+ num_a2
+ pom_a3, bc_a3, num_a3
+ ncl_a4, so4_a4, nh4_a4, num_a4
+ dst_a5, so4_a5, nh4_a5, num_a5
+ ncl_a6, so4_a6, nh4_a6, num_a6
+ dst_a7, so4_a7, nh4_a7, num_a7
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jh2o2] H2O2 + hv ->
+ End Photolysis
+
+ Reactions
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ [usr23] SO2 + OH -> H2SO4
+ DMS + OH -> SO2 ; 9.6e-12, -234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ End Reactions
+
+ Heterogeneous
+ H2O2, SO2
+ End Heterogeneous
+
+ Ext Forcing
+ SO2 <- dataset
+ so4_a1 <- dataset
+ so4_a2 <- dataset
+ num_a1 <- dataset
+ num_a2 <- dataset
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_newsulf.inp b/chem_proc/inputs/cam_full_mech_newsulf.inp
new file mode 100644
index 0000000000..e9677797c5
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_newsulf.inp
@@ -0,0 +1,347 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_newsulf.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_newsulf.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP/GFS inputs (T42, 42 levels)"
+ "(5) SYNOZ"
+ "(6) no N atom"
+ "(7) new treatment of: SO4, NH4, NH4NO3"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb, O3S -> O3, O3INERT -> O3, SYNOZ -> O3, O3RAD -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4, NH4NO3
+ OC1, OC2
+ SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_newsulf_fixed_ch4.inp b/chem_proc/inputs/cam_full_mech_newsulf_fixed_ch4.inp
new file mode 100644
index 0000000000..299e6ad002
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_newsulf_fixed_ch4.inp
@@ -0,0 +1,352 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_newsulf.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_newsulf.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP/GFS inputs (T42, 42 levels)"
+ "(5) SYNOZ"
+ "(6) no N atom"
+ "(7) new treatment of: SO4, NH4, NH4NO3"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4CHML->CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb, O3S -> O3, O3INERT -> O3, SYNOZ -> O3, O3RAD -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, CH4
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4CHML, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4, NH4NO3
+ OC1, OC2
+ SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+* CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+* CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ CH4 + OH -> CH3O2 + H2O + CH4CHML ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 + CH4CHML ; 1.5e-10
+ CH4CHML -> ; 7.1 e-6
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+* [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+* + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_newsulf_nosynoz.inp b/chem_proc/inputs/cam_full_mech_newsulf_nosynoz.inp
new file mode 100644
index 0000000000..0a90014256
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_newsulf_nosynoz.inp
@@ -0,0 +1,347 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_newsulf.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_newsulf.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP/GFS inputs (T42, 42 levels)"
+ "(5) No SYNOZ"
+ "(6) no N atom"
+ "(7) new treatment of: SO4, NH4, NH4NO3"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4, NH4NO3
+ OC1, OC2
+ SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_newsulf_table.in b/chem_proc/inputs/cam_full_mech_newsulf_table.in
new file mode 100644
index 0000000000..d6090ba2a2
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_newsulf_table.in
@@ -0,0 +1,328 @@
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4, NH4NO3
+ OC1, OC2
+ SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2->,jo2_b] O2 + hv -> 2*O
+ [jo1d->,jo3_a] O3 + hv -> O1D + O2
+ [jo3p->,jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5->,jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jno3_b] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2_a] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jho2no2_b] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan->,jpan] MPAN + hv -> MCO3 + NO2
+ [jmacr_a] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmacr_b] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh->,jch3ooh] XOOH + hv -> OH
+ [jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr_O_O2] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr_HO2_HO2] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M
+ [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M
+ [usr_N2O5_aer] N2O5 -> 2 * HNO3
+ [usr_NO3_aer] NO3 -> HNO3
+ [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr_CO_OH_a] CO + OH -> CO2 + HO2
+ [tag_C2H4_OH] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M
+ [usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr_XOOH_OH] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 7.1e-6
+ [usr_SO2_OH] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr_HO2_aer] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
diff --git a/chem_proc/inputs/cam_full_mech_newsulf_tagged.inp b/chem_proc/inputs/cam_full_mech_newsulf_tagged.inp
new file mode 100644
index 0000000000..57cb6bde8d
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_newsulf_tagged.inp
@@ -0,0 +1,368 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_newsulf.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_newsulf.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP/GFS inputs (T42, 42 levels)"
+ "(5) SYNOZ"
+ "(6) no N atom"
+ "(7) new treatment of: SO4, NH4, NH4NO3"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb, O3S -> O3, O3INERT -> O3, SYNOZ -> O3, O3RAD -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4, NH4NO3
+ OC1, OC2
+ SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+* [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jno3->,1.1236*jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+* [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jch3cho_a] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jch3cho_b] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jch3cho_c] CH3CHO + hv -> CH3O2 + CO + HO2
+* [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+* [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+* [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmpan->,jpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+* [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+* [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+* [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+* [jxooh] XOOH + hv -> OH
+ [jxooh->,jch3ooh] XOOH + hv -> OH
+* [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jonitr->,userdefined] ONITR + hv -> HO2 + CO + NO2 + CH2O
+* [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+* [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jhyac->,2.*jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+* [jmek] MEK + hv -> CH3CO3 + C2H5O2
+* [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+* [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+* [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+* [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+* [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+* [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_newsulf_tagged.nontransport.inp b/chem_proc/inputs/cam_full_mech_newsulf_tagged.nontransport.inp
new file mode 100644
index 0000000000..67cae7baee
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_newsulf_tagged.nontransport.inp
@@ -0,0 +1,372 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_newsulf.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_newsulf.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP/GFS inputs (T42, 42 levels)"
+ "(5) SYNOZ"
+ "(6) no N atom"
+ "(7) new treatment of: SO4, NH4, NH4NO3"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb, O3S -> O3, O3INERT -> O3, SYNOZ -> O3, O3RAD -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ Not-Transported
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Not-Transported
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4, NH4NO3
+ OC1, OC2
+ SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+* [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jno3->,1.1236*jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+* [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jch3cho_a] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jch3cho_b] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jch3cho_c] CH3CHO + hv -> CH3O2 + CO + HO2
+* [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+* [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+* [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmpan->,jpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+* [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+* [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+* [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+* [jxooh] XOOH + hv -> OH
+ [jxooh->,jch3ooh] XOOH + hv -> OH
+* [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jonitr->,userdefined] ONITR + hv -> HO2 + CO + NO2 + CH2O
+* [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+* [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jhyac->,2.*jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+* [jmek] MEK + hv -> CH3CO3 + C2H5O2
+* [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+* [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+* [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+* [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+* [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+* [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_newsulf_xnox.inp b/chem_proc/inputs/cam_full_mech_newsulf_xnox.inp
new file mode 100644
index 0000000000..81208ad13d
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_newsulf_xnox.inp
@@ -0,0 +1,454 @@
+BEGSIM
+output_unit_number = 7
+output_file = newsulf_xnox.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = newsulf_xnox.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP/GFS inputs (T42, 42 levels)"
+ "(5) SYNOZ"
+ "(6) no N atom"
+ "(7) new treatment of: SO4, NH4, NH4NO3"
+ "(8) XNOx for surface emissions"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb, O3S -> O3, O3INERT -> O3, SYNOZ -> O3, O3RAD -> O3
+ XNO -> NO, XNO2 -> NO2, XNO3 -> NO3, XHNO3 -> HNO3
+ XHO2NO2 -> HO2NO2, XNO2NO3 -> N2O5, NO2XNO3 -> N2O5
+ XPAN -> CH3CO3NO2, XONIT -> CH3COCH2ONO2, XMPAN -> CH2CCH3CO3NO2
+ XISOPNO3 -> CH2CHCCH3OOCH2ONO2, XONITR -> CH2CCH3CHONO2CH2OH
+ XNH4NO3 -> NH4NO3, OA -> O, O1DA -> O, O3A -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4, NH4NO3
+ OC1, OC2
+ SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ XNO, XNO2, XNO3, XHNO3, XHO2NO2, XNO2NO3, NO2XNO3
+ XPAN, XONIT, XMPAN, XISOPNO3, XONITR, XNH4NO3, O3A, O1DA, OA
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ [jo1da] O3A + hv ->O1DA
+ [jo3pa] O3A + hv -> OA
+ [jno2a] XNO2 + hv -> XNO + OA
+ [jn2o5a] XNO2NO3 + hv -> XNO2
+ [jn2o5b] NO2XNO3 + hv -> XNO3
+ [jhno3a] XHNO3 + hv -> XNO2
+ [jno3a] XNO3 + hv -> .89*XNO2 + .11*XNO +.89*O3A
+ [jpana] XPAN + hv -> .6*XNO2 + .4*XNO3
+ [jmpana] XMPAN + hv -> XNO2
+ [jho2no2a] XHO2NO2 + hv -> .33*XNO3 + .66*XNO2
+ [jonitra] XONITR + hv -> XNO2
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ [usr1a] OA + O2 + M -> O3A + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ OA + O3 -> O3 ; 8e-12, -2060
+ O3A+ O -> O ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ O1DA + N2 -> OA + N2 ; 2.1e-11, 115
+ O1DA + O2 -> OA + O2 ; 3.2e-11 , 70
+ O1DA + H2O -> H2O ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + O1DA -> H2 ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ OA + OH -> OH ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ HO2 + OA -> HO2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ OH + O3A -> OH ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ HO2 + O3A -> HO2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ N2O + O1DA -> N2O ; 6.7e-11
+ N2O + O1DA -> N2O ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ XNO + HO2 -> XNO2 + HO2 ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ XNO + O3 -> XNO2 + O3 ; 3e-12, -1500
+ NO + O3A -> NO ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + OA -> NO2 ; 5.6e-12, 180
+ XNO2 + O -> XNO + O ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ XNO2 + O3 -> XNO3 + O3 ; 1.2e-13, -2450
+ NO2 + O3A -> NO2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ XNO3 + HO2 -> HO2 + XNO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2a] XNO2 + NO3 + M -> XNO2NO3 + NO3 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2b] NO2 + XNO3 + M -> NO2XNO3 + NO2 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr3a] XNO2NO3 + M -> XNO2 + M
+ [usr3b] NO2XNO3 + M -> XNO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4a] XNO2 + OH + M -> XHNO3 + OH + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ [usr5a] XHNO3 + OH -> XNO3 + OH
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ XNO3 + NO -> XNO2 + NO ; 1.5e-11, 170
+ NO3 + XNO -> XNO2 + NO3 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ [usr6a] XNO2 + HO2 + M -> XHO2NO2 + HO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ XHO2NO2 + OH -> XNO2 + OH ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr7a] XHO2NO2 + M -> XNO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr16a] XNO2NO3 -> XHNO3
+ [usr16b] NO2XNO3 -> XHNO3
+ [usr17] NO3 -> HNO3
+ [usr17b] XNO3 -> XHNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ [usr17ab] XNO2 -> 0.5*XNO + 0.5*XHNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ CH4 + O1DA -> CH4 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + XNO -> CH3O2 + XNO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ [new3] CH2O + XNO3 -> CH2O + XHNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ O3A + C2H4 -> C2H4 ; 1.2e-14, -2630
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO2 + XNO -> EO2 + XNO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + XNO -> C2H5O2 + XNO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + O3A -> C3H6 ; 6.5e-15, -1900
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [new2] C3H6 + XNO3 -> XONIT +C3H6 ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + XNO -> PO2 + XNO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [new4] CH3CHO + XNO3 -> CH3CHO + XHNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ CH3CO3 + XNO -> CH3CO3 + XNO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ [usr11a] CH3CO3 + XNO2 + M -> XPAN + CH3CO3 + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ [usr12a] XPAN + M -> XNO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + XNO -> C3H7O2 + XNO2 ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + XNO -> RO2 + XNO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ ENEO2 + XNO -> ENEO2 + XNO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + XNO -> ALKO2 + .9*XNO2 + .1*XONIT ; 4.2e-12, 180
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ XONIT + OH -> XNO2 + OH ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + XNO -> MEKO2 + XNO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [new1] XOH + XNO2 -> XOH + .7*XNO2 ; 1.e-11
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + XNO -> TOLO2 + .9*XNO2 ; 4.2e-12, 180
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ ISOP + O3A -> ISOP + .1 * O3A ; 1.05e-14, -2000
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + XNO -> ISOPO2 + .92 * XNO2 +.08 * XONITR ; 2.2e-12, 180
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + XNO3 -> ISOPO2 + XNO2 ; 2.4e-12
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MVK + O3A -> MVK + .2 * O3A ; 7.52e-16,-1521
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ MACR + O3A -> MACR + .2 * O3A ; 4.4e-15, -2500
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + XNO -> XNO2 + MACRO2 ; 2.7e-12, 360
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + XNO -> 0.8*XONITR + MACRO2 ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + XNO3 -> XNO2 + MACRO2 ; 2.4e-12
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + XNO -> XNO2 + MCO3 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + XNO3 -> XNO2 + MCO3 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr14a] MCO3 + XNO2 + M -> XMPAN + M + MCO3
+ [usr15a] XMPAN + M -> XNO2 + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ C10H16 + O3A -> C10H16 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ C10H16 + XNO3 -> C10H16 + XNO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + XNO -> TERPO2 + XNO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ [new5] ISOP + XNO3 -> XISOPNO3 + ISOP ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ XISOPNO3 + NO -> .794 * XONITR + .206 * XNO2 + NO ; 2.7e-12, 360
+ ISOPNO3 + XNO -> 1.00 * XNO2 + ISOPNO3 ; 2.7e-12, 360
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ XISOPNO3 + NO3 -> .794 * XONITR + .206 * XNO2 + NO3 ; 2.4e-12
+ ISOPNO3 + XNO3 -> 1.00 * XNO2 + ISOPNO3 ; 2.4e-12
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ XISOPNO3 + HO2 -> .206 * XNO2 + .794 * XONITR + HO2 ; 8.e-13, 700
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ CH3COCHO + XNO3 -> XHNO3 + CH3COCHO ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ XONITR + OH -> OH + .4 *XNO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ XONITR + NO3 -> .5 * XNO2 + NO3 ; 1.4e-12, -1860
+ ONITR + XNO3 -> .5 * XNO2 + ONITR ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO -> XNO2 + XO2 ; 2.7e-12, 360
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO3 -> XNO2 + XO2 ; 2.4e-12
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ OH + XMPAN -> .5 * XNO3 + OH ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ OH + XPAN -> XNO3 + OH ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ DMS + XNO3 -> DMS + XHNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ XHNO3, XHO2NO2, XONIT, XONITR, XISOPNO3
+ SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_newsulf_xnox_fixed_ch4.inp b/chem_proc/inputs/cam_full_mech_newsulf_xnox_fixed_ch4.inp
new file mode 100644
index 0000000000..7014ed64a8
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_newsulf_xnox_fixed_ch4.inp
@@ -0,0 +1,460 @@
+BEGSIM
+output_unit_number = 7
+output_file = newsulf_xnox.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = newsulf_xnox.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP/GFS inputs (T42, 42 levels)"
+ "(5) SYNOZ"
+ "(6) no N atom"
+ "(7) new treatment of: SO4, NH4, NH4NO3"
+ "(8) XNOx for surface emissions"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4CHML->CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb, O3S -> O3, O3INERT -> O3, SYNOZ -> O3, O3RAD -> O3
+ XNO -> NO, XNO2 -> NO2, XNO3 -> NO3, XHNO3 -> HNO3
+ XHO2NO2 -> HO2NO2, XNO2NO3 -> N2O5, NO2XNO3 -> N2O5
+ XPAN -> CH3CO3NO2, XONIT -> CH3COCH2ONO2, XMPAN -> CH2CCH3CO3NO2
+ XISOPNO3 -> CH2CHCCH3OOCH2ONO2, XONITR -> CH2CCH3CHONO2CH2OH
+ XNH4NO3 -> NH4NO3, OA -> O, O1DA -> O, O3A -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, CH4
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4CHML, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4, NH4NO3
+ OC1, OC2
+ SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ XNO, XNO2, XNO3, XHNO3, XHO2NO2, XNO2NO3, NO2XNO3
+ XPAN, XONIT, XMPAN, XISOPNO3, XONITR, XNH4NO3, O3A, O1DA, OA
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ [jo1da] O3A + hv ->O1DA
+ [jo3pa] O3A + hv -> OA
+ [jno2a] XNO2 + hv -> XNO + OA
+ [jn2o5a] XNO2NO3 + hv -> XNO2
+ [jn2o5b] NO2XNO3 + hv -> XNO3
+ [jhno3a] XHNO3 + hv -> XNO2
+ [jno3a] XNO3 + hv -> .89*XNO2 + .11*XNO +.89*O3A
+ [jpana] XPAN + hv -> .6*XNO2 + .4*XNO3
+ [jmpana] XMPAN + hv -> XNO2
+ [jho2no2a] XHO2NO2 + hv -> .33*XNO3 + .66*XNO2
+ [jonitra] XONITR + hv -> XNO2
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ [usr1a] OA + O2 + M -> O3A + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ OA + O3 -> O3 ; 8e-12, -2060
+ O3A+ O -> O ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ O1DA + N2 -> OA + N2 ; 2.1e-11, 115
+ O1DA + O2 -> OA + O2 ; 3.2e-11 , 70
+ O1DA + H2O -> H2O ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + O1DA -> H2 ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ OA + OH -> OH ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ HO2 + OA -> HO2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ OH + O3A -> OH ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ HO2 + O3A -> HO2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ N2O + O1DA -> N2O ; 6.7e-11
+ N2O + O1DA -> N2O ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ XNO + HO2 -> XNO2 + HO2 ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ XNO + O3 -> XNO2 + O3 ; 3e-12, -1500
+ NO + O3A -> NO ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + OA -> NO2 ; 5.6e-12, 180
+ XNO2 + O -> XNO + O ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ XNO2 + O3 -> XNO3 + O3 ; 1.2e-13, -2450
+ NO2 + O3A -> NO2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ XNO3 + HO2 -> HO2 + XNO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2a] XNO2 + NO3 + M -> XNO2NO3 + NO3 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2b] NO2 + XNO3 + M -> NO2XNO3 + NO2 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr3a] XNO2NO3 + M -> XNO2 + M
+ [usr3b] NO2XNO3 + M -> XNO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4a] XNO2 + OH + M -> XHNO3 + OH + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ [usr5a] XHNO3 + OH -> XNO3 + OH
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ XNO3 + NO -> XNO2 + NO ; 1.5e-11, 170
+ NO3 + XNO -> XNO2 + NO3 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ [usr6a] XNO2 + HO2 + M -> XHO2NO2 + HO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ XHO2NO2 + OH -> XNO2 + OH ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr7a] XHO2NO2 + M -> XNO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr16a] XNO2NO3 -> XHNO3
+ [usr16b] NO2XNO3 -> XHNO3
+ [usr17] NO3 -> HNO3
+ [usr17b] XNO3 -> XHNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ [usr17ab] XNO2 -> 0.5*XNO + 0.5*XHNO3
+* CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+* CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ CH4 + OH -> CH3O2 + H2O + CH4CHML ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 + CH4CHML ; 1.5e-10
+* CH4 + O1DA -> CH4 ; 1.5e-10
+ CH4 + O1DA -> ; 1.5e-10
+ CH4CHML -> ; 7.1 e-6
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + XNO -> CH3O2 + XNO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ [new3] CH2O + XNO3 -> CH2O + XHNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ O3A + C2H4 -> C2H4 ; 1.2e-14, -2630
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO2 + XNO -> EO2 + XNO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + XNO -> C2H5O2 + XNO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+* [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+* + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + O3A -> C3H6 ; 6.5e-15, -1900
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [new2] C3H6 + XNO3 -> XONIT +C3H6 ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + XNO -> PO2 + XNO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [new4] CH3CHO + XNO3 -> CH3CHO + XHNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ CH3CO3 + XNO -> CH3CO3 + XNO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ [usr11a] CH3CO3 + XNO2 + M -> XPAN + CH3CO3 + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ [usr12a] XPAN + M -> XNO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + XNO -> C3H7O2 + XNO2 ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + XNO -> RO2 + XNO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ ENEO2 + XNO -> ENEO2 + XNO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + XNO -> ALKO2 + .9*XNO2 + .1*XONIT ; 4.2e-12, 180
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ XONIT + OH -> XNO2 + OH ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + XNO -> MEKO2 + XNO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [new1] XOH + XNO2 -> XOH + .7*XNO2 ; 1.e-11
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + XNO -> TOLO2 + .9*XNO2 ; 4.2e-12, 180
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ ISOP + O3A -> ISOP + .1 * O3A ; 1.05e-14, -2000
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + XNO -> ISOPO2 + .92 * XNO2 +.08 * XONITR ; 2.2e-12, 180
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + XNO3 -> ISOPO2 + XNO2 ; 2.4e-12
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MVK + O3A -> MVK + .2 * O3A ; 7.52e-16,-1521
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ MACR + O3A -> MACR + .2 * O3A ; 4.4e-15, -2500
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + XNO -> XNO2 + MACRO2 ; 2.7e-12, 360
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + XNO -> 0.8*XONITR + MACRO2 ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + XNO3 -> XNO2 + MACRO2 ; 2.4e-12
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + XNO -> XNO2 + MCO3 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + XNO3 -> XNO2 + MCO3 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr14a] MCO3 + XNO2 + M -> XMPAN + M + MCO3
+ [usr15a] XMPAN + M -> XNO2 + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ C10H16 + O3A -> C10H16 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ C10H16 + XNO3 -> C10H16 + XNO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + XNO -> TERPO2 + XNO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ [new5] ISOP + XNO3 -> XISOPNO3 + ISOP ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ XISOPNO3 + NO -> .794 * XONITR + .206 * XNO2 + NO ; 2.7e-12, 360
+ ISOPNO3 + XNO -> 1.00 * XNO2 + ISOPNO3 ; 2.7e-12, 360
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ XISOPNO3 + NO3 -> .794 * XONITR + .206 * XNO2 + NO3 ; 2.4e-12
+ ISOPNO3 + XNO3 -> 1.00 * XNO2 + ISOPNO3 ; 2.4e-12
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ XISOPNO3 + HO2 -> .206 * XNO2 + .794 * XONITR + HO2 ; 8.e-13, 700
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ CH3COCHO + XNO3 -> XHNO3 + CH3COCHO ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ XONITR + OH -> OH + .4 *XNO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ XONITR + NO3 -> .5 * XNO2 + NO3 ; 1.4e-12, -1860
+ ONITR + XNO3 -> .5 * XNO2 + ONITR ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO -> XNO2 + XO2 ; 2.7e-12, 360
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO3 -> XNO2 + XO2 ; 2.4e-12
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ OH + XMPAN -> .5 * XNO3 + OH ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ OH + XPAN -> XNO3 + OH ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ DMS + XNO3 -> DMS + XHNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ XHNO3, XHO2NO2, XONIT, XONITR, XISOPNO3
+ SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_newsulf_xnox_nosynoz.inp b/chem_proc/inputs/cam_full_mech_newsulf_xnox_nosynoz.inp
new file mode 100644
index 0000000000..c68e640772
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_newsulf_xnox_nosynoz.inp
@@ -0,0 +1,454 @@
+BEGSIM
+output_unit_number = 7
+output_file = newsulf_xnox_nosynoz.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = newsulf_xnox_nosynoz.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP/GFS inputs (T42, 42 levels)"
+ "(5) NO SYNOZ"
+ "(6) no N atom"
+ "(7) new treatment of: SO4, NH4, NH4NO3"
+ "(8) XNOx for surface emissions"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb
+ XNO -> NO, XNO2 -> NO2, XNO3 -> NO3, XHNO3 -> HNO3
+ XHO2NO2 -> HO2NO2, XNO2NO3 -> N2O5, NO2XNO3 -> N2O5
+ XPAN -> CH3CO3NO2, XONIT -> CH3COCH2ONO2, XMPAN -> CH2CCH3CO3NO2
+ XISOPNO3 -> CH2CHCCH3OOCH2ONO2, XONITR -> CH2CCH3CHONO2CH2OH
+ XNH4NO3 -> NH4NO3, OA -> O, O1DA -> O, O3A -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4, NH4NO3
+ OC1, OC2
+ SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ XNO, XNO2, XNO3, XHNO3, XHO2NO2, XNO2NO3, NO2XNO3
+ XPAN, XONIT, XMPAN, XISOPNO3, XONITR, XNH4NO3, O3A, O1DA, OA
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ [jo1da] O3A + hv ->O1DA
+ [jo3pa] O3A + hv -> OA
+ [jno2a] XNO2 + hv -> XNO + OA
+ [jn2o5a] XNO2NO3 + hv -> XNO2
+ [jn2o5b] NO2XNO3 + hv -> XNO3
+ [jhno3a] XHNO3 + hv -> XNO2
+ [jno3a] XNO3 + hv -> .89*XNO2 + .11*XNO +.89*O3A
+ [jpana] XPAN + hv -> .6*XNO2 + .4*XNO3
+ [jmpana] XMPAN + hv -> XNO2
+ [jho2no2a] XHO2NO2 + hv -> .33*XNO3 + .66*XNO2
+ [jonitra] XONITR + hv -> XNO2
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ [usr1a] OA + O2 + M -> O3A + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ OA + O3 -> O3 ; 8e-12, -2060
+ O3A+ O -> O ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ O1DA + N2 -> OA + N2 ; 2.1e-11, 115
+ O1DA + O2 -> OA + O2 ; 3.2e-11 , 70
+ O1DA + H2O -> H2O ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + O1DA -> H2 ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ OA + OH -> OH ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ HO2 + OA -> HO2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ OH + O3A -> OH ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ HO2 + O3A -> HO2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ N2O + O1DA -> N2O ; 6.7e-11
+ N2O + O1DA -> N2O ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ XNO + HO2 -> XNO2 + HO2 ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ XNO + O3 -> XNO2 + O3 ; 3e-12, -1500
+ NO + O3A -> NO ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + OA -> NO2 ; 5.6e-12, 180
+ XNO2 + O -> XNO + O ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ XNO2 + O3 -> XNO3 + O3 ; 1.2e-13, -2450
+ NO2 + O3A -> NO2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ XNO3 + HO2 -> HO2 + XNO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2a] XNO2 + NO3 + M -> XNO2NO3 + NO3 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2b] NO2 + XNO3 + M -> NO2XNO3 + NO2 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr3a] XNO2NO3 + M -> XNO2 + M
+ [usr3b] NO2XNO3 + M -> XNO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4a] XNO2 + OH + M -> XHNO3 + OH + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ [usr5a] XHNO3 + OH -> XNO3 + OH
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ XNO3 + NO -> XNO2 + NO ; 1.5e-11, 170
+ NO3 + XNO -> XNO2 + NO3 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ [usr6a] XNO2 + HO2 + M -> XHO2NO2 + HO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ XHO2NO2 + OH -> XNO2 + OH ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr7a] XHO2NO2 + M -> XNO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr16a] XNO2NO3 -> XHNO3
+ [usr16b] NO2XNO3 -> XHNO3
+ [usr17] NO3 -> HNO3
+ [usr17b] XNO3 -> XHNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ [usr17ab] XNO2 -> 0.5*XNO + 0.5*XHNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ CH4 + O1DA -> CH4 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + XNO -> CH3O2 + XNO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ [new3] CH2O + XNO3 -> CH2O + XHNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ O3A + C2H4 -> C2H4 ; 1.2e-14, -2630
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO2 + XNO -> EO2 + XNO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + XNO -> C2H5O2 + XNO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + O3A -> C3H6 ; 6.5e-15, -1900
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [new2] C3H6 + XNO3 -> XONIT +C3H6 ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + XNO -> PO2 + XNO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [new4] CH3CHO + XNO3 -> CH3CHO + XHNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ CH3CO3 + XNO -> CH3CO3 + XNO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ [usr11a] CH3CO3 + XNO2 + M -> XPAN + CH3CO3 + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ [usr12a] XPAN + M -> XNO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + XNO -> C3H7O2 + XNO2 ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + XNO -> RO2 + XNO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ ENEO2 + XNO -> ENEO2 + XNO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + XNO -> ALKO2 + .9*XNO2 + .1*XONIT ; 4.2e-12, 180
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ XONIT + OH -> XNO2 + OH ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + XNO -> MEKO2 + XNO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [new1] XOH + XNO2 -> XOH + .7*XNO2 ; 1.e-11
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + XNO -> TOLO2 + .9*XNO2 ; 4.2e-12, 180
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ ISOP + O3A -> ISOP + .1 * O3A ; 1.05e-14, -2000
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + XNO -> ISOPO2 + .92 * XNO2 +.08 * XONITR ; 2.2e-12, 180
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + XNO3 -> ISOPO2 + XNO2 ; 2.4e-12
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MVK + O3A -> MVK + .2 * O3A ; 7.52e-16,-1521
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ MACR + O3A -> MACR + .2 * O3A ; 4.4e-15, -2500
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + XNO -> XNO2 + MACRO2 ; 2.7e-12, 360
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + XNO -> 0.8*XONITR + MACRO2 ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + XNO3 -> XNO2 + MACRO2 ; 2.4e-12
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + XNO -> XNO2 + MCO3 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + XNO3 -> XNO2 + MCO3 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr14a] MCO3 + XNO2 + M -> XMPAN + M + MCO3
+ [usr15a] XMPAN + M -> XNO2 + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ C10H16 + O3A -> C10H16 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ C10H16 + XNO3 -> C10H16 + XNO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + XNO -> TERPO2 + XNO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ [new5] ISOP + XNO3 -> XISOPNO3 + ISOP ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ XISOPNO3 + NO -> .794 * XONITR + .206 * XNO2 + NO ; 2.7e-12, 360
+ ISOPNO3 + XNO -> 1.00 * XNO2 + ISOPNO3 ; 2.7e-12, 360
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ XISOPNO3 + NO3 -> .794 * XONITR + .206 * XNO2 + NO3 ; 2.4e-12
+ ISOPNO3 + XNO3 -> 1.00 * XNO2 + ISOPNO3 ; 2.4e-12
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ XISOPNO3 + HO2 -> .206 * XNO2 + .794 * XONITR + HO2 ; 8.e-13, 700
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ CH3COCHO + XNO3 -> XHNO3 + CH3COCHO ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ XONITR + OH -> OH + .4 *XNO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ XONITR + NO3 -> .5 * XNO2 + NO3 ; 1.4e-12, -1860
+ ONITR + XNO3 -> .5 * XNO2 + ONITR ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO -> XNO2 + XO2 ; 2.7e-12, 360
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO3 -> XNO2 + XO2 ; 2.4e-12
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ OH + XMPAN -> .5 * XNO3 + OH ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ OH + XPAN -> XNO3 + OH ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ DMS + XNO3 -> DMS + XHNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ XHNO3, XHO2NO2, XONIT, XONITR, XISOPNO3
+ SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_newsulf_xnox_nosynoz_soa_arom.inp b/chem_proc/inputs/cam_full_mech_newsulf_xnox_nosynoz_soa_arom.inp
new file mode 100644
index 0000000000..28f3b0d1a9
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_newsulf_xnox_nosynoz_soa_arom.inp
@@ -0,0 +1,465 @@
+BEGSIM
+output_unit_number = 7
+output_file = newsulf_xnox_nosynoz.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = newsulf_xnox_nosynoz.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP/GFS inputs (T42, 42 levels)"
+ "(5) NO SYNOZ"
+ "(6) no N atom"
+ "(7) new treatment of: SO4, NH4, NH4NO3"
+ "(8) XNOx for surface emissions"
+ "(6) updated hydrophob->hydrophil conversion rate to 1.15 days
+ "(7) added SOA classes with MW for pinonaldehyde, methyl-erythritol and TOLO2/BENO2/XYLO2
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ BENZENE -> C6H6, BENO2 -> C6H7O3, BENNO3 -> C6H7ONO3, BENOOH -> C6H8O3
+ XYLENE -> C8H10, XYLO2 -> C8H11O3, XYLNO3 -> C8H11ONO3, XYLOOH -> C8H12O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOAM -> C10H16O4
+ SOAI -> CH3C4H9O4, SOAT -> C7H9O3, SOAB -> C6H7O3, SOAX -> C8H11O3
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb
+ XNO -> NO, XNO2 -> NO2, XNO3 -> NO3, XHNO3 -> HNO3
+ XHO2NO2 -> HO2NO2, XNO2NO3 -> N2O5, NO2XNO3 -> N2O5
+ XPAN -> CH3CO3NO2, XONIT -> CH3COCH2ONO2, XMPAN -> CH2CCH3CO3NO2
+ XISOPNO3 -> CH2CHCCH3OOCH2ONO2, XONITR -> CH2CCH3CHONO2CH2OH
+ XNH4NO3 -> NH4NO3, OA -> O, O1DA -> O, O3A -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ BENZENE, BENO2, BENNO3, BENOOH, XYLENE, XYLO2, XYLNO3, XYLOOH
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4, NH4NO3
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOAM, SOAI, SOAT, SOAB, SOAX
+ DST01, DST02, DST03, DST04
+ XNO, XNO2, XNO3, XHNO3, XHO2NO2, XNO2NO3, NO2XNO3
+ XPAN, XONIT, XMPAN, XISOPNO3, XONITR, XNH4NO3, O3A, O1DA, OA
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ [jo1da] O3A + hv ->O1DA
+ [jo3pa] O3A + hv -> OA
+ [jno2a] XNO2 + hv -> XNO + OA
+ [jn2o5a] XNO2NO3 + hv -> XNO2
+ [jn2o5b] NO2XNO3 + hv -> XNO3
+ [jhno3a] XHNO3 + hv -> XNO2
+ [jno3a] XNO3 + hv -> .89*XNO2 + .11*XNO +.89*O3A
+ [jpana] XPAN + hv -> .6*XNO2 + .4*XNO3
+ [jmpana] XMPAN + hv -> XNO2
+ [jho2no2a] XHO2NO2 + hv -> .33*XNO3 + .66*XNO2
+ [jonitra] XONITR + hv -> XNO2
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ [usr1a] OA + O2 + M -> O3A + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ OA + O3 -> O3 ; 8e-12, -2060
+ O3A+ O -> O ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ O1DA + N2 -> OA + N2 ; 2.1e-11, 115
+ O1DA + O2 -> OA + O2 ; 3.2e-11 , 70
+ O1DA + H2O -> H2O ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + O1DA -> H2 ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ OA + OH -> OH ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ HO2 + OA -> HO2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ OH + O3A -> OH ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ HO2 + O3A -> HO2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ N2O + O1DA -> N2O ; 6.7e-11
+ N2O + O1DA -> N2O ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ XNO + HO2 -> XNO2 + HO2 ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ XNO + O3 -> XNO2 + O3 ; 3e-12, -1500
+ NO + O3A -> NO ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + OA -> NO2 ; 5.6e-12, 180
+ XNO2 + O -> XNO + O ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ XNO2 + O3 -> XNO3 + O3 ; 1.2e-13, -2450
+ NO2 + O3A -> NO2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ XNO3 + HO2 -> HO2 + XNO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2a] XNO2 + NO3 + M -> XNO2NO3 + NO3 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2b] NO2 + XNO3 + M -> NO2XNO3 + NO2 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr3a] XNO2NO3 + M -> XNO2 + M
+ [usr3b] NO2XNO3 + M -> XNO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4a] XNO2 + OH + M -> XHNO3 + OH + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ [usr5a] XHNO3 + OH -> XNO3 + OH
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ XNO3 + NO -> XNO2 + NO ; 1.5e-11, 170
+ NO3 + XNO -> XNO2 + NO3 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ [usr6a] XNO2 + HO2 + M -> XHO2NO2 + HO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ XHO2NO2 + OH -> XNO2 + OH ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr7a] XHO2NO2 + M -> XNO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr16a] XNO2NO3 -> XHNO3
+ [usr16b] NO2XNO3 -> XHNO3
+ [usr17] NO3 -> HNO3
+ [usr17b] XNO3 -> XHNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ [usr17ab] XNO2 -> 0.5*XNO + 0.5*XHNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ CH4 + O1DA -> CH4 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + XNO -> CH3O2 + XNO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ [new3] CH2O + XNO3 -> CH2O + XHNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ O3A + C2H4 -> C2H4 ; 1.2e-14, -2630
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO2 + XNO -> EO2 + XNO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + XNO -> C2H5O2 + XNO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + O3A -> C3H6 ; 6.5e-15, -1900
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [new2] C3H6 + XNO3 -> XONIT +C3H6 ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + XNO -> PO2 + XNO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [new4] CH3CHO + XNO3 -> CH3CHO + XHNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ CH3CO3 + XNO -> CH3CO3 + XNO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ [usr11a] CH3CO3 + XNO2 + M -> XPAN + CH3CO3 + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ [usr12a] XPAN + M -> XNO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + XNO -> C3H7O2 + XNO2 ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + XNO -> RO2 + XNO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ ENEO2 + XNO -> ENEO2 + XNO2 ; 4.2e-12, 180
+ BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + XNO -> ALKO2 + .9*XNO2 + .1*XONIT ; 4.2e-12, 180
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ XONIT + OH -> XNO2 + OH ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + XNO -> MEKO2 + XNO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.8e-12, 338
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [new1] XOH + XNO2 -> XOH + .7*XNO2 ; 1.e-11
+ [soa6] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 2.6e-12, 350
+ + .9*NO2 + .9*HO2
+ TOLO2 + XNO -> TOLO2 + .9*XNO2 ; 2.6e-12, 350
+ [soa5] TOLO2 + HO2 -> TOLOOH ; 1.4e-12, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ BENZENE + OH -> BENO2 ; 2.3e-12, -193
+ [soa7] BENO2 + NO -> BENNO3 ; 2.6e-12, 350
+ [soa8] BENO2 + HO2 -> BENOOH ; 1.4e-12, 700
+ XYLENE + OH -> XYLO2 ; 2.3e-11
+ [soa9] XYLO2 + NO -> XYLNO3 ; 2.6e-12, 350
+ [soa10] XYLO2 + HO2 -> XYLOOH ; 1.4e-12, 700
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ [soa4] ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ ISOP + O3A -> ISOP + .1 * O3A ; 1.05e-14, -2000
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + XNO -> ISOPO2 + .92 * XNO2 +.08 * XONITR ; 2.2e-12, 180
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + XNO3 -> ISOPO2 + XNO2 ; 2.4e-12
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MVK + O3A -> MVK + .2 * O3A ; 7.52e-16,-1521
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ MACR + O3A -> MACR + .2 * O3A ; 4.4e-15, -2500
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + XNO -> XNO2 + MACRO2 ; 2.7e-12, 360
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + XNO -> 0.8*XONITR + MACRO2 ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + XNO3 -> XNO2 + MACRO2 ; 2.4e-12
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + XNO -> XNO2 + MCO3 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + XNO3 -> XNO2 + MCO3 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr14a] MCO3 + XNO2 + M -> XMPAN + M + MCO3
+ [usr15a] XMPAN + M -> XNO2 + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ C10H16 + O3A -> C10H16 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ C10H16 + XNO3 -> C10H16 + XNO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + XNO -> TERPO2 + XNO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ [new5] ISOP + XNO3 -> XISOPNO3 + ISOP ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ XISOPNO3 + NO -> .794 * XONITR + .206 * XNO2 + NO ; 2.7e-12, 360
+ ISOPNO3 + XNO -> 1.00 * XNO2 + ISOPNO3 ; 2.7e-12, 360
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ XISOPNO3 + NO3 -> .794 * XONITR + .206 * XNO2 + NO3 ; 2.4e-12
+ ISOPNO3 + XNO3 -> 1.00 * XNO2 + ISOPNO3 ; 2.4e-12
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ XISOPNO3 + HO2 -> .206 * XNO2 + .794 * XONITR + HO2 ; 8.e-13, 700
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ CH3COCHO + XNO3 -> XHNO3 + CH3COCHO ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ XONITR + OH -> OH + .4 *XNO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ XONITR + NO3 -> .5 * XNO2 + NO3 ; 1.4e-12, -1860
+ ONITR + XNO3 -> .5 * XNO2 + ONITR ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO -> XNO2 + XO2 ; 2.7e-12, 360
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO3 -> XNO2 + XO2 ; 2.4e-12
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ OH + XMPAN -> .5 * XNO3 + OH ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ OH + XPAN -> XNO3 + OH ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 1.0e-5
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ DMS + XNO3 -> DMS + XHNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 1.0e-5
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, BENOOH, XYLOOH, TERPOOH, CH3COOH
+ XHNO3, XHO2NO2, XONIT, XONITR, XISOPNO3
+ SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_newsulf_xnox_nosynoz_soa_arom_sog.inp b/chem_proc/inputs/cam_full_mech_newsulf_xnox_nosynoz_soa_arom_sog.inp
new file mode 100644
index 0000000000..491ab93a74
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_newsulf_xnox_nosynoz_soa_arom_sog.inp
@@ -0,0 +1,469 @@
+BEGSIM
+output_unit_number = 7
+output_file = newsulf_xnox_nosynoz.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = newsulf_xnox_nosynoz.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP/GFS inputs (T42, 42 levels)"
+ "(5) NO SYNOZ"
+ "(6) no N atom"
+ "(7) new treatment of: SO4, NH4, NH4NO3"
+ "(8) XNOx for surface emissions"
+ "(6) updated hydrophob->hydrophil conversion rate to 1.15 days
+ "(7) added SOA classes with MW for pinonaldehyde, methyl-erythritol and TOLO2/BENO2/XYLO2
+ "(8) added SOG
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ BENZENE -> C6H6, BENO2 -> C6H7O3, BENNO3 -> C6H7ONO3, BENOOH -> C6H8O3
+ XYLENE -> C8H10, XYLO2 -> C8H11O3, XYLNO3 -> C8H11ONO3, XYLOOH -> C8H12O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C
+ SOAM -> C10H16O4, SOAI -> CH3C4H9O4, SOAT -> C7H9O3, SOAB -> C6H7O3, SOAX -> C8H11O3
+ SOGM -> C10H16O4, SOGI -> CH3C4H9O4, SOGT -> C7H9O3, SOGB -> C6H7O3, SOGX -> C8H11O3
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb
+ XNO -> NO, XNO2 -> NO2, XNO3 -> NO3, XHNO3 -> HNO3
+ XHO2NO2 -> HO2NO2, XNO2NO3 -> N2O5, NO2XNO3 -> N2O5
+ XPAN -> CH3CO3NO2, XONIT -> CH3COCH2ONO2, XMPAN -> CH2CCH3CO3NO2
+ XISOPNO3 -> CH2CHCCH3OOCH2ONO2, XONITR -> CH2CCH3CHONO2CH2OH
+ XNH4NO3 -> NH4NO3, OA -> O, O1DA -> O, O3A -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ BENZENE, BENO2, BENNO3, BENOOH, XYLENE, XYLO2, XYLNO3, XYLOOH
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4, NH4NO3
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04
+ SOAM, SOAI, SOAT, SOAB, SOAX
+ SOGM, SOGI, SOGT, SOGB, SOGX
+ DST01, DST02, DST03, DST04
+ XNO, XNO2, XNO3, XHNO3, XHO2NO2, XNO2NO3, NO2XNO3
+ XPAN, XONIT, XMPAN, XISOPNO3, XONITR, XNH4NO3, O3A, O1DA, OA
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ [jo1da] O3A + hv ->O1DA
+ [jo3pa] O3A + hv -> OA
+ [jno2a] XNO2 + hv -> XNO + OA
+ [jn2o5a] XNO2NO3 + hv -> XNO2
+ [jn2o5b] NO2XNO3 + hv -> XNO3
+ [jhno3a] XHNO3 + hv -> XNO2
+ [jno3a] XNO3 + hv -> .89*XNO2 + .11*XNO +.89*O3A
+ [jpana] XPAN + hv -> .6*XNO2 + .4*XNO3
+ [jmpana] XMPAN + hv -> XNO2
+ [jho2no2a] XHO2NO2 + hv -> .33*XNO3 + .66*XNO2
+ [jonitra] XONITR + hv -> XNO2
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ [usr1a] OA + O2 + M -> O3A + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ OA + O3 -> O3 ; 8e-12, -2060
+ O3A+ O -> O ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ O1DA + N2 -> OA + N2 ; 2.1e-11, 115
+ O1DA + O2 -> OA + O2 ; 3.2e-11 , 70
+ O1DA + H2O -> H2O ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + O1DA -> H2 ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ OA + OH -> OH ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ HO2 + OA -> HO2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ OH + O3A -> OH ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ HO2 + O3A -> HO2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ N2O + O1DA -> N2O ; 6.7e-11
+ N2O + O1DA -> N2O ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ XNO + HO2 -> XNO2 + HO2 ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ XNO + O3 -> XNO2 + O3 ; 3e-12, -1500
+ NO + O3A -> NO ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + OA -> NO2 ; 5.6e-12, 180
+ XNO2 + O -> XNO + O ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ XNO2 + O3 -> XNO3 + O3 ; 1.2e-13, -2450
+ NO2 + O3A -> NO2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ XNO3 + HO2 -> HO2 + XNO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2a] XNO2 + NO3 + M -> XNO2NO3 + NO3 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2b] NO2 + XNO3 + M -> NO2XNO3 + NO2 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr3a] XNO2NO3 + M -> XNO2 + M
+ [usr3b] NO2XNO3 + M -> XNO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4a] XNO2 + OH + M -> XHNO3 + OH + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ [usr5a] XHNO3 + OH -> XNO3 + OH
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ XNO3 + NO -> XNO2 + NO ; 1.5e-11, 170
+ NO3 + XNO -> XNO2 + NO3 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ [usr6a] XNO2 + HO2 + M -> XHO2NO2 + HO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ XHO2NO2 + OH -> XNO2 + OH ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr7a] XHO2NO2 + M -> XNO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr16a] XNO2NO3 -> XHNO3
+ [usr16b] NO2XNO3 -> XHNO3
+ [usr17] NO3 -> HNO3
+ [usr17b] XNO3 -> XHNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ [usr17ab] XNO2 -> 0.5*XNO + 0.5*XHNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ CH4 + O1DA -> CH4 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + XNO -> CH3O2 + XNO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ [new3] CH2O + XNO3 -> CH2O + XHNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ O3A + C2H4 -> C2H4 ; 1.2e-14, -2630
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO2 + XNO -> EO2 + XNO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + XNO -> C2H5O2 + XNO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + O3A -> C3H6 ; 6.5e-15, -1900
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [new2] C3H6 + XNO3 -> XONIT +C3H6 ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + XNO -> PO2 + XNO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [new4] CH3CHO + XNO3 -> CH3CHO + XHNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ CH3CO3 + XNO -> CH3CO3 + XNO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ [usr11a] CH3CO3 + XNO2 + M -> XPAN + CH3CO3 + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ [usr12a] XPAN + M -> XNO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + XNO -> C3H7O2 + XNO2 ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + XNO -> RO2 + XNO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ ENEO2 + XNO -> ENEO2 + XNO2 ; 4.2e-12, 180
+ BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + XNO -> ALKO2 + .9*XNO2 + .1*XONIT ; 4.2e-12, 180
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ XONIT + OH -> XNO2 + OH ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + XNO -> MEKO2 + XNO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.8e-12, 338
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [new1] XOH + XNO2 -> XOH + .7*XNO2 ; 1.e-11
+ [soa6] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 2.6e-12, 350
+ + .9*NO2 + .9*HO2
+ TOLO2 + XNO -> TOLO2 + .9*XNO2 ; 2.6e-12, 350
+ [soa5] TOLO2 + HO2 -> TOLOOH ; 1.4e-12, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ BENZENE + OH -> BENO2 ; 2.3e-12, -193
+ [soa7] BENO2 + NO -> BENNO3 ; 2.6e-12, 350
+ [soa8] BENO2 + HO2 -> BENOOH ; 1.4e-12, 700
+ XYLENE + OH -> XYLO2 ; 2.3e-11
+ [soa9] XYLO2 + NO -> XYLNO3 ; 2.6e-12, 350
+ [soa10] XYLO2 + HO2 -> XYLOOH ; 1.4e-12, 700
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ [soa4] ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ ISOP + O3A -> ISOP + .1 * O3A ; 1.05e-14, -2000
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + XNO -> ISOPO2 + .92 * XNO2 +.08 * XONITR ; 2.2e-12, 180
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + XNO3 -> ISOPO2 + XNO2 ; 2.4e-12
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MVK + O3A -> MVK + .2 * O3A ; 7.52e-16,-1521
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ MACR + O3A -> MACR + .2 * O3A ; 4.4e-15, -2500
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + XNO -> XNO2 + MACRO2 ; 2.7e-12, 360
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + XNO -> 0.8*XONITR + MACRO2 ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + XNO3 -> XNO2 + MACRO2 ; 2.4e-12
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + XNO -> XNO2 + MCO3 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + XNO3 -> XNO2 + MCO3 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr14a] MCO3 + XNO2 + M -> XMPAN + M + MCO3
+ [usr15a] XMPAN + M -> XNO2 + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ C10H16 + O3A -> C10H16 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ C10H16 + XNO3 -> C10H16 + XNO2 ; 1.2e-12, 490
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + XNO -> TERPO2 + XNO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ [new5] ISOP + XNO3 -> XISOPNO3 + ISOP ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ XISOPNO3 + NO -> .794 * XONITR + .206 * XNO2 + NO ; 2.7e-12, 360
+ ISOPNO3 + XNO -> 1.00 * XNO2 + ISOPNO3 ; 2.7e-12, 360
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ XISOPNO3 + NO3 -> .794 * XONITR + .206 * XNO2 + NO3 ; 2.4e-12
+ ISOPNO3 + XNO3 -> 1.00 * XNO2 + ISOPNO3 ; 2.4e-12
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ XISOPNO3 + HO2 -> .206 * XNO2 + .794 * XONITR + HO2 ; 8.e-13, 700
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ CH3COCHO + XNO3 -> XHNO3 + CH3COCHO ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ XONITR + OH -> OH + .4 *XNO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ XONITR + NO3 -> .5 * XNO2 + NO3 ; 1.4e-12, -1860
+ ONITR + XNO3 -> .5 * XNO2 + ONITR ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO -> XNO2 + XO2 ; 2.7e-12, 360
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO3 -> XNO2 + XO2 ; 2.4e-12
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ OH + XMPAN -> .5 * XNO3 + OH ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ OH + XPAN -> XNO3 + OH ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 1.0e-5
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ DMS + XNO3 -> DMS + XHNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 1.0e-5
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, BENOOH, XYLOOH, TERPOOH, CH3COOH
+ XHNO3, XHO2NO2, XONIT, XONITR, XISOPNO3
+ SO2, NH3, SOGM, SOGI, SOGT, SOGB, SOGX
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_nosynoz.inp b/chem_proc/inputs/cam_full_mech_nosynoz.inp
new file mode 100644
index 0000000000..283221e6f7
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_nosynoz.inp
@@ -0,0 +1,343 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_nosynoz.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_nosynoz.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH, SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_nosynoz_xfrc.inp b/chem_proc/inputs/cam_full_mech_nosynoz_xfrc.inp
new file mode 100644
index 0000000000..52487a2809
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_nosynoz_xfrc.inp
@@ -0,0 +1,361 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_nosynoz.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_nosynoz.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH, SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO <- dataset
+ CO <- dataset
+ BIGALK <- dataset
+ BIGENE <- dataset
+ C2H4 <- dataset
+ C2H5OH <- dataset
+ C2H6 <- dataset
+ C3H6 <- dataset
+ C3H8 <- dataset
+ CB1 <- dataset
+ CH2O <- dataset
+ CH3CHO <- dataset
+ CH3COCH3 <- dataset
+ CH3OH <- dataset
+ MEK <- dataset
+ NH3 <- dataset
+ OC1 <- dataset
+ SO2 <- dataset
+ TOLUENE <- dataset
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_synoz.inp b/chem_proc/inputs/cam_full_mech_synoz.inp
new file mode 100644
index 0000000000..b7bd2a58cd
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_synoz.inp
@@ -0,0 +1,343 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_synoz.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_synoz.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH, SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_synoz_h2so4.inp b/chem_proc/inputs/cam_full_mech_synoz_h2so4.inp
new file mode 100644
index 0000000000..ddc1ee57bc
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_synoz_h2so4.inp
@@ -0,0 +1,345 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_ncep.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_ncep.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_synoz_h2so4_soa_arom.inp b/chem_proc/inputs/cam_full_mech_synoz_h2so4_soa_arom.inp
new file mode 100644
index 0000000000..ddea932b04
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_synoz_h2so4_soa_arom.inp
@@ -0,0 +1,357 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_ncep.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_ncep.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom"
+ "(6) updated hydrophob->hydrophil conversion rate to 1.15 days
+ "(7) added SOA classes with MW for pinonaldehyde, methyl-erythritol and TOLO2/BENO2/XYLO2
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ BENZENE -> C6H6, BENO2 -> C6H7O3, BENNO3 -> C6H7ONO3, BENOOH -> C6H8O3
+ XYLENE -> C8H10, XYLO2 -> C8H11O3, XYLNO3 -> C8H11ONO3, XYLOOH -> C8H12O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOAM -> C10H16O4
+ SOAI -> CH3C4H9O4, SOAT -> C7H9O3, SOAB -> C6H7O3, SOAX -> C8H11O3
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ BENZENE, BENO2, BENNO3, BENOOH, XYLENE, XYLO2, XYLNO3, XYLOOH
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOAM, SOAI, SOAT, SOAB, SOAX
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.8e-12, 338
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [soa6] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 2.6e-12, 350
+ + .9*NO2 + .9*HO2
+ [soa5] TOLO2 + HO2 -> TOLOOH ; 1.4e-12, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ BENZENE + OH -> BENO2 ; 2.3e-12, -193
+ [soa7] BENO2 + NO -> BENNO3 ; 2.6e-12, 350
+ [soa8] BENO2 + HO2 -> BENOOH ; 1.4e-12, 700
+ XYLENE + OH -> XYLO2 ; 2.3e-11
+ [soa9] XYLO2 + NO -> XYLNO3 ; 2.6e-12, 350
+ [soa10] XYLO2 + HO2 -> XYLOOH ; 1.4e-12, 700
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ [soa4] ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 1.0e-5
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 1.0e-5
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, BENOOH, XYLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_synoz_h2so4_soa_arom_sog.inp b/chem_proc/inputs/cam_full_mech_synoz_h2so4_soa_arom_sog.inp
new file mode 100644
index 0000000000..220f39dc16
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_synoz_h2so4_soa_arom_sog.inp
@@ -0,0 +1,360 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_ncep.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_ncep.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom"
+ "(6) updated hydrophob->hydrophil conversion rate to 1.15 days
+ "(7) added SOA classes with MW for pinonaldehyde, methyl-erythritol and TOLO2/BENO2/XYLO2
+ "(8) added SOG
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ BENZENE -> C6H6, BENO2 -> C6H7O3, BENNO3 -> C6H7ONO3, BENOOH -> C6H8O3
+ XYLENE -> C8H10, XYLO2 -> C8H11O3, XYLNO3 -> C8H11ONO3, XYLOOH -> C8H12O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C
+ SOAM -> C10H16O4, SOAI -> CH3C4H9O4, SOAT -> C7H9O3, SOAB -> C6H7O3, SOAX -> C8H11O3
+ SOGM -> C10H16O4, SOGI -> CH3C4H9O4, SOGT -> C7H9O3, SOGB -> C6H7O3, SOGX -> C8H11O3
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ BENZENE, BENO2, BENNO3, BENOOH, XYLENE, XYLO2, XYLNO3, XYLOOH
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOAM, SOAI, SOAT, SOAB, SOAX
+ SOGM, SOGI, SOGT, SOGB, SOGX
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.8e-12, 338
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [soa6] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 2.6e-12, 350
+ + .9*NO2 + .9*HO2
+ [soa5] TOLO2 + HO2 -> TOLOOH ; 1.4e-12, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ BENZENE + OH -> BENO2 ; 2.3e-12, -193
+ [soa7] BENO2 + NO -> BENNO3 ; 2.6e-12, 350
+ [soa8] BENO2 + HO2 -> BENOOH ; 1.4e-12, 700
+ XYLENE + OH -> XYLO2 ; 2.3e-11
+ [soa9] XYLO2 + NO -> XYLNO3 ; 2.6e-12, 350
+ [soa10] XYLO2 + HO2 -> XYLOOH ; 1.4e-12, 700
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ [soa4] ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 1.0e-5
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 1.0e-5
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, BENOOH, XYLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4, SOGM, SOGI, SOGT, SOGB, SOGX
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_synoz_h2so4_stacy.inp b/chem_proc/inputs/cam_full_mech_synoz_h2so4_stacy.inp
new file mode 100644
index 0000000000..bc747cabd7
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_synoz_h2so4_stacy.inp
@@ -0,0 +1,347 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_ncep.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_ncep.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3->,1.1236*jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho_a] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jch3cho_b] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jch3cho_c] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan->,jpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh->,jch3ooh] XOOH + hv -> OH
+ [jonitr->,userdefined] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac->,2.*jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_synoz_h2so4_tagged.inp b/chem_proc/inputs/cam_full_mech_synoz_h2so4_tagged.inp
new file mode 100644
index 0000000000..e7ce0b9bc9
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_synoz_h2so4_tagged.inp
@@ -0,0 +1,353 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_ncep.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_ncep.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2->,jo2_b] O2 + hv -> 2*O
+ [jo1d->,jo3_a] O3 + hv -> O1D + O2
+ [jo3p->,jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5->,jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3->,1.1236*jno3_a] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+* [jno3->,1.1236*jno3_b] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2->,jho2no2_a] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+* [jho2no2_a] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+* [jho2no2_b] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+* [jch3cho_a] CH3CHO + hv -> CH3O2 + CO + HO2
+* [jch3cho_b] CH3CHO + hv -> CH3O2 + CO + HO2
+* [jch3cho_c] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan->,jpan] MPAN + hv -> MCO3 + NO2
+* [jmacr->,0.5*jmacr_a+0.5*jmacr_b] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmacr->,jmacr_a] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh->,jch3ooh] XOOH + hv -> OH
+* [jonitr->,userdefined] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac->,2.*jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_synoz_h2so4_tagged2.inp b/chem_proc/inputs/cam_full_mech_synoz_h2so4_tagged2.inp
new file mode 100644
index 0000000000..9c8eb7a859
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_synoz_h2so4_tagged2.inp
@@ -0,0 +1,354 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_ncep.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_ncep.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2->,jo2_b] O2 + hv -> 2*O
+ [jo1d->,jo3_a] O3 + hv -> O1D + O2
+ [jo3p->,jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5->,jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+* [jno3->,1.1236*jno3_a] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jno3_a] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jno3_b] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+* [jho2no2->,jho2no2_a] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jho2no2_a] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jho2no2_b] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+* [jch3cho_a] CH3CHO + hv -> CH3O2 + CO + HO2
+* [jch3cho_b] CH3CHO + hv -> CH3O2 + CO + HO2
+* [jch3cho_c] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan->,jpan] MPAN + hv -> MCO3 + NO2
+ [jmacr_a] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmacr_b] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh->,jch3ooh] XOOH + hv -> OH
+* [jonitr->,userdefined] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac->,2.*jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_synoz_h2so4_xnox.inp b/chem_proc/inputs/cam_full_mech_synoz_h2so4_xnox.inp
new file mode 100644
index 0000000000..858ec14abe
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_synoz_h2so4_xnox.inp
@@ -0,0 +1,458 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_ncep.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_ncep.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4
+ XNO -> NO,XNO2 -> NO2,XNO3 -> NO3,XHNO3 -> HNO3,XHO2NO2 -> HO2NO2, XNO2NO3 -> N2O5, NO2XNO3 -> N2O5,
+ XPAN -> CH3CO3NO2,XONIT -> CH3COCH2ONO2,XMPAN -> CH2CCH3CO3NO2,XISOPNO3 -> CH2CHCCH3OOCH2ONO2
+ XONITR -> CH2CCH3CHONO2CH2OH
+ XNH4NO3 -> NH4NO3, OA -> O, O1DA -> O, O3A -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ XNO, XNO2, XNO3, XHNO3, XHO2NO2, XNO2NO3, NO2XNO3
+ XPAN, XONIT, XMPAN, XISOPNO3, XONITR
+ XNH4NO3, O3A, O1DA, OA
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo1da] O3A + hv ->O1DA
+ [jo3p] O3 + hv -> O + O2
+ [jo3pa] O3A + hv -> OA
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2a] XNO2 + hv -> XNO + OA
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jn2o5a] XNO2NO3 + hv -> XNO2
+ [jn2o5b] NO2XNO3 + hv -> XNO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jhno3a] XHNO3 + hv -> XNO2
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jno3a] XNO3 + hv -> .89*XNO2 + .11*XNO +.89*O3A
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jho2no2a] XHO2NO2 + hv -> .33*XNO3 + .66*XNO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jpana] XPAN + hv -> .6*XNO2 + .4*XNO3
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmpana] XMPAN + hv -> XNO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jonitra] XONITR + hv -> XNO2
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ [usr1a] OA + O2 + M -> O3A + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ OA + O3 -> O3 ; 8e-12, -2060
+ O + O3A -> O ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ O1DA + N2 -> OA + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ O1DA + O2 -> OA + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ O1DA + H2O -> H2O ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + O1DA -> H ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ OA + OH -> OH ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ HO2 + OA -> HO2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ OH + O3A -> OH ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ HO2 + O3A -> HO2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1DA -> N2O ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ N2O + O1DA -> N2O ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ XNO + HO2 -> XNO2 + HO2 ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ XNO + O3 -> XNO2 + O3 ; 3e-12, -1500
+ NO + O3A -> NO ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + OA -> NO2 ; 5.6e-12, 180
+ XNO2 + O -> XNO + O ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ XNO2 + O3 -> XNO3 + O3 ; 1.2e-13, -2450
+ NO2 + O3A -> NO2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ XNO3 + HO2 -> HO2 + XNO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2a] XNO2 + NO3 + M -> XNO2NO3 + NO3 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2b] NO2 + XNO3 + M -> NO2XNO3 + NO2 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr3a] XNO2NO3 + M -> XNO2 + M
+ [usr3b] NO2XNO3 + M -> XNO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4a] XNO2 + OH + M -> XHNO3 + OH + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ [usr5a] XHNO3 + OH -> XNO3 + OH
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ XNO3 + NO -> XNO2 + NO ; 1.5e-11, 170
+ NO3 + XNO -> XNO2 + NO3 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ [usr6a] XNO2 + HO2 + M -> XHO2NO2 + HO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ XHO2NO2 + OH -> XNO2 + OH ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr7a] XHO2NO2 + M -> XNO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr16a] XNO2NO3 -> XHNO3
+ [usr16b] NO2XNO3 -> XHNO3
+ [usr17] NO3 -> HNO3
+ [usr17b] XNO3 -> XHNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ [usr17ab]XNO2 -> 0.5*XNO + 0.5*XHNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O ; 1.5e-10
+ + .4*HO2 + .05*H2
+ CH4 + O1DA -> CH4 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + XNO -> CH3O2 + XNO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH ; 3.8e-12, 200
+ + .3 * CH2O + H2O
+ [nacd1] CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ [nacd1a] CH2O + XNO3 -> CH2O + XHNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O ; 1.e-28,.8, 8.8e-12,0., .6
+ + .25*HO2 + M
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ C2H4 + O3A -> C2H4 ; 1.2e-14, -2630
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO2 + XNO -> EO2 + XNO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + XNO -> C2H5O2 + XNO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO ; 2.e-13
+ + HO2 + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 ; 6.8e-14
+ + .4 * C2H5OH
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO ; 3.8e-12, 200
+ + .5 * OH
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + O3A -> C3H6 ; 6.5e-15, -1900
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [new2] C3H6 + XNO3 -> XONIT +C3H6 ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + XNO -> PO2 + XNO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ [nacd2] CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [nacd2a] CH3CHO + XNO3 -> CH3CHO + XHNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ CH3CO3 + XNO -> CH3CO3 + XNO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ [usr11a] CH3CO3 + XNO2 + M -> XPAN + CH3CO3 + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH ; 4.3e-13, 1040
+ + .25*O3
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 ; 2.0e-12,500
+ + .9*CO2 + .1*CH3COOH
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O ; 1e-12
+ + .5*CO2 + H2O
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ [usr12a] XPAN + M -> XNO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + XNO -> C3H7O2 + XNO2 ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + XNO -> RO2 + XNO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ ENEO2 + XNO -> ENEO2 + XNO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + XNO -> ALKO2 + .9*XNO2 + .1*XONIT ; 4.2e-12, 180
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ XONIT + OH -> XNO2 + OH ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + XNO -> MEKO2 + XNO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [new1] XOH + XNO2 -> XOH + .7*XNO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + XNO -> TOLO2 + .9*XNO2 ; 4.2e-12, 180
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ ISOP + O3A -> ISOP + .1 * O3A ; 1.05e-14, -2000
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + XNO -> ISOPO2 + .92 * XNO2 +.08 * XONITR ; 2.2e-12, 180
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + XNO3 -> ISOPO2 + XNO2 ; 2.4e-12
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MVK + O3A -> MVK + .2 * O3A ; 7.52e-16,-1521
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ MACR + O3A -> MACR + .2 * O3A ; 4.4e-15, -2500
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + XNO -> XNO2 + MACRO2 ; 2.7e-12, 360
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + XNO -> 0.8*XONITR + MACRO2 ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + XNO3 -> XNO2 + MACRO2 ; 2.4e-12
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + XNO -> XNO2 + MCO3 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + XNO3 -> XNO2 + MCO3 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr14a] MCO3 + XNO2 + M -> XMPAN + M + MCO3
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [usr15a] XMPAN + M -> XNO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ C10H16 + O3A -> C10H16 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ C10H16 + XNO3 -> C10H16 + XNO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + XNO -> TERPO2 + XNO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ [new5] ISOP + XNO3 -> XISOPNO3 + ISOP ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ XISOPNO3 + NO -> .794 * XONITR + .206 * XNO2 + NO ; 2.7e-12, 360
+ ISOPNO3 + XNO -> 1.00 * XNO2 + ISOPNO3 ; 2.7e-12, 360
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ XISOPNO3 + NO3 -> .794 * XONITR + .206 * XNO2 + NO3 ; 2.4e-12
+ ISOPNO3 + XNO3 -> 1.00 * XNO2 + ISOPNO3 ; 2.4e-12
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ XISOPNO3 + HO2 -> .206 * XNO2 + .794 * XONITR + HO2 ; 8.e-13, 700
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ [nacd3] CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ [nacd3a] CH3COCHO + XNO3 -> XHNO3 + CH3COCHO ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ XONITR + OH -> OH + .4 *XNO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ XONITR + NO3 -> .5 * XNO2 + NO3 ; 1.4e-12, -1860
+ ONITR + XNO3 -> .5 * XNO2 + ONITR ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO -> XNO2 + XO2 ; 2.7e-12, 360
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO3 -> XNO2 + XO2 ; 2.4e-12
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ OH + XMPAN -> .5 * XNO3 + OH ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ OH + XPAN -> XNO3 + OH ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ [nacd4] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ [nacd4a] DMS + XNO3 -> DMS + XHNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4
+ XHNO3, XHO2NO2, XONIT, XONITR, XISOPNO3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, XNO
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_synoz_h2so4_xnox_fixed_ch4.inp b/chem_proc/inputs/cam_full_mech_synoz_h2so4_xnox_fixed_ch4.inp
new file mode 100644
index 0000000000..11395785b1
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_synoz_h2so4_xnox_fixed_ch4.inp
@@ -0,0 +1,465 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_ncep.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_ncep.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4CHML->CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4
+ XNO -> NO,XNO2 -> NO2,XNO3 -> NO3,XHNO3 -> HNO3,XHO2NO2 -> HO2NO2, XNO2NO3 -> N2O5, NO2XNO3 -> N2O5,
+ XPAN -> CH3CO3NO2,XONIT -> CH3COCH2ONO2,XMPAN -> CH2CCH3CO3NO2,XISOPNO3 -> CH2CHCCH3OOCH2ONO2
+ XONITR -> CH2CCH3CHONO2CH2OH
+ XNH4NO3 -> NH4NO3, OA -> O, O1DA -> O, O3A -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, CH4
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4CHML, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ XNO, XNO2, XNO3, XHNO3, XHO2NO2, XNO2NO3, NO2XNO3
+ XPAN, XONIT, XMPAN, XISOPNO3, XONITR
+ XNH4NO3, O3A, O1DA, OA
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo1da] O3A + hv ->O1DA
+ [jo3p] O3 + hv -> O + O2
+ [jo3pa] O3A + hv -> OA
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2a] XNO2 + hv -> XNO + OA
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jn2o5a] XNO2NO3 + hv -> XNO2
+ [jn2o5b] NO2XNO3 + hv -> XNO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jhno3a] XHNO3 + hv -> XNO2
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jno3a] XNO3 + hv -> .89*XNO2 + .11*XNO +.89*O3A
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jho2no2a] XHO2NO2 + hv -> .33*XNO3 + .66*XNO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jpana] XPAN + hv -> .6*XNO2 + .4*XNO3
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmpana] XMPAN + hv -> XNO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jonitra] XONITR + hv -> XNO2
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ [usr1a] OA + O2 + M -> O3A + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ OA + O3 -> O3 ; 8e-12, -2060
+ O + O3A -> O ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ O1DA + N2 -> OA + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ O1DA + O2 -> OA + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ O1DA + H2O -> H2O ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + O1DA -> H ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ OA + OH -> OH ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ HO2 + OA -> HO2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ OH + O3A -> OH ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ HO2 + O3A -> HO2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1DA -> N2O ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ N2O + O1DA -> N2O ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ XNO + HO2 -> XNO2 + HO2 ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ XNO + O3 -> XNO2 + O3 ; 3e-12, -1500
+ NO + O3A -> NO ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + OA -> NO2 ; 5.6e-12, 180
+ XNO2 + O -> XNO + O ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ XNO2 + O3 -> XNO3 + O3 ; 1.2e-13, -2450
+ NO2 + O3A -> NO2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ XNO3 + HO2 -> HO2 + XNO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2a] XNO2 + NO3 + M -> XNO2NO3 + NO3 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2b] NO2 + XNO3 + M -> NO2XNO3 + NO2 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr3a] XNO2NO3 + M -> XNO2 + M
+ [usr3b] NO2XNO3 + M -> XNO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4a] XNO2 + OH + M -> XHNO3 + OH + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ [usr5a] XHNO3 + OH -> XNO3 + OH
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ XNO3 + NO -> XNO2 + NO ; 1.5e-11, 170
+ NO3 + XNO -> XNO2 + NO3 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ [usr6a] XNO2 + HO2 + M -> XHO2NO2 + HO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ XHO2NO2 + OH -> XNO2 + OH ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr7a] XHO2NO2 + M -> XNO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr16a] XNO2NO3 -> XHNO3
+ [usr16b] NO2XNO3 -> XHNO3
+ [usr17] NO3 -> HNO3
+ [usr17b] XNO3 -> XHNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ [usr17ab]XNO2 -> 0.5*XNO + 0.5*XHNO3
+* CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + OH -> CH3O2 + H2O + CH4CHML ; 2.45e-12, -1775
+* CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O ; 1.5e-10
+* + .4*HO2 + .05*H2
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O ; 1.5e-10
+ + .4*HO2 + .05*H2 + CH4CHML
+* CH4 + O1DA -> CH4 ; 1.5e-10
+ CH4 + O1DA -> ; 1.5e-10
+ CH4CHML -> ; 7.1 e-6
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + XNO -> CH3O2 + XNO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH ; 3.8e-12, 200
+ + .3 * CH2O + H2O
+ [nacd1] CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ [nacd1a] CH2O + XNO3 -> CH2O + XHNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O ; 1.e-28,.8, 8.8e-12,0., .6
+ + .25*HO2 + M
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ C2H4 + O3A -> C2H4 ; 1.2e-14, -2630
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO2 + XNO -> EO2 + XNO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + XNO -> C2H5O2 + XNO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO ; 2.e-13
+ + HO2 + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 ; 6.8e-14
+ + .4 * C2H5OH
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO ; 3.8e-12, 200
+ + .5 * OH
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+* [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+* + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + O3A -> C3H6 ; 6.5e-15, -1900
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [new2] C3H6 + XNO3 -> XONIT +C3H6 ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + XNO -> PO2 + XNO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ [nacd2] CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [nacd2a] CH3CHO + XNO3 -> CH3CHO + XHNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ CH3CO3 + XNO -> CH3CO3 + XNO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ [usr11a] CH3CO3 + XNO2 + M -> XPAN + CH3CO3 + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH ; 4.3e-13, 1040
+ + .25*O3
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 ; 2.0e-12,500
+ + .9*CO2 + .1*CH3COOH
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O ; 1e-12
+ + .5*CO2 + H2O
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ [usr12a] XPAN + M -> XNO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + XNO -> C3H7O2 + XNO2 ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + XNO -> RO2 + XNO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ ENEO2 + XNO -> ENEO2 + XNO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + XNO -> ALKO2 + .9*XNO2 + .1*XONIT ; 4.2e-12, 180
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ XONIT + OH -> XNO2 + OH ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + XNO -> MEKO2 + XNO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [new1] XOH + XNO2 -> XOH + .7*XNO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + XNO -> TOLO2 + .9*XNO2 ; 4.2e-12, 180
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ ISOP + O3A -> ISOP + .1 * O3A ; 1.05e-14, -2000
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + XNO -> ISOPO2 + .92 * XNO2 +.08 * XONITR ; 2.2e-12, 180
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + XNO3 -> ISOPO2 + XNO2 ; 2.4e-12
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MVK + O3A -> MVK + .2 * O3A ; 7.52e-16,-1521
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ MACR + O3A -> MACR + .2 * O3A ; 4.4e-15, -2500
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + XNO -> XNO2 + MACRO2 ; 2.7e-12, 360
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + XNO -> 0.8*XONITR + MACRO2 ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + XNO3 -> XNO2 + MACRO2 ; 2.4e-12
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + XNO -> XNO2 + MCO3 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + XNO3 -> XNO2 + MCO3 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr14a] MCO3 + XNO2 + M -> XMPAN + M + MCO3
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [usr15a] XMPAN + M -> XNO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ C10H16 + O3A -> C10H16 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ C10H16 + XNO3 -> C10H16 + XNO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + XNO -> TERPO2 + XNO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ [new5] ISOP + XNO3 -> XISOPNO3 + ISOP ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ XISOPNO3 + NO -> .794 * XONITR + .206 * XNO2 + NO ; 2.7e-12, 360
+ ISOPNO3 + XNO -> 1.00 * XNO2 + ISOPNO3 ; 2.7e-12, 360
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ XISOPNO3 + NO3 -> .794 * XONITR + .206 * XNO2 + NO3 ; 2.4e-12
+ ISOPNO3 + XNO3 -> 1.00 * XNO2 + ISOPNO3 ; 2.4e-12
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ XISOPNO3 + HO2 -> .206 * XNO2 + .794 * XONITR + HO2 ; 8.e-13, 700
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ [nacd3] CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ [nacd3a] CH3COCHO + XNO3 -> XHNO3 + CH3COCHO ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ XONITR + OH -> OH + .4 *XNO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ XONITR + NO3 -> .5 * XNO2 + NO3 ; 1.4e-12, -1860
+ ONITR + XNO3 -> .5 * XNO2 + ONITR ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO -> XNO2 + XO2 ; 2.7e-12, 360
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO3 -> XNO2 + XO2 ; 2.4e-12
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ OH + XMPAN -> .5 * XNO3 + OH ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ OH + XPAN -> XNO3 + OH ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ [nacd4] DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ [nacd4a] DMS + XNO3 -> DMS + XHNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4
+ XHNO3, XHO2NO2, XONIT, XONITR, XISOPNO3
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, XNO
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_synoz_xfrc.inp b/chem_proc/inputs/cam_full_mech_synoz_xfrc.inp
new file mode 100644
index 0000000000..fe0793c8e6
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_synoz_xfrc.inp
@@ -0,0 +1,362 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_synoz.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_synoz.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH, SO2, NH3
+ End Heterogeneous
+
+ Ext Forcing
+ NO <- dataset
+ CO <- dataset
+ BIGALK <- dataset
+ BIGENE <- dataset
+ C2H4 <- dataset
+ C2H5OH <- dataset
+ C2H6 <- dataset
+ C3H6 <- dataset
+ C3H8 <- dataset
+ CB1 <- dataset
+ CH2O <- dataset
+ CH3CHO <- dataset
+ CH3COCH3 <- dataset
+ CH3OH <- dataset
+ MEK <- dataset
+ NH3 <- dataset
+ OC1 <- dataset
+ SO2 <- dataset
+ TOLUENE <- dataset
+ SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_full_mech_xnox.inp b/chem_proc/inputs/cam_full_mech_xnox.inp
new file mode 100644
index 0000000000..7fa083650c
--- /dev/null
+++ b/chem_proc/inputs/cam_full_mech_xnox.inp
@@ -0,0 +1,460 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_xnox.doc
+sim_dat_filename = cam_xnox.dat
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) NOx tags fire"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, N, NO, XNO -> NO, NO2, XNO2 -> NO2, NO3
+ XNO3 -> NO3, HNO3, XHNO3 -> HNO3
+ HO2NO2, XHO2NO2 -> HO2NO2, N2O5, XNO2NO3 -> N2O5, NO2XNO3 -> N2O5, CH4, CH3O2
+ CH3OOH, CH2O, CO, OH, HO2, H2O2, C3H6, ISOP -> C5H8, PO2 -> C3H6OHO2, CH3CHO
+ POOH -> C3H6OHOOH, CH3CO3, CH3COOOH, PAN -> CH3CO3NO2, XPAN -> CH3CO3NO2
+ ONIT -> CH3COCH2ONO2, XONIT -> CH3COCH2ONO2, C2H6, C2H4
+ MPAN -> CH2CCH3CO3NO2, XMPAN -> CH2CCH3CO3NO2
+ ISOPO2 -> HOCH2COOCH3CHCH2, MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, C2H5O2, C2H5OOH, C10H16
+ C3H8, C3H7O2, C3H7OOH, CH3COCH3, ROOH -> CH3COCH2OOH
+ CH3OH, C2H5OH, GLYALD -> HOCH2CHO, HYAC -> CH3COCH2OH, EO2 -> HOCH2CH2O2
+ EO -> HOCH2CH2O, HYDRALD -> HOCH2CCH3CHCHO
+ RO2 -> CH3COCH2O2, CH3COCHO, Rn, Pb
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, XISOPNO3 -> CH2CHCCH3OOCH2ONO2
+ ONITR -> CH2CCH3CHONO2CH2OH, XONITR -> CH2CCH3CHONO2CH2OH
+ XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH, ISOPOOH -> HOCH2COOHCH3CHCH2
+ BIGALK -> C5H12, BIGENE -> C4H8
+ ENEO2 -> C4H9O3, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2, MEK -> C4H8O
+ MEKO2 -> C4H7O3, MEKOOH -> C4H8O3, TOLUENE -> C7H8, CRESOL -> C7H8O
+ TOLO2 -> C7H9O3, TOLOOH -> C7H10O3, XOH -> C7H10O4, TERPO2 -> C10H17O3
+ TERPOOH -> C10H18O3, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2, CH3COOH
+ H2, O3S -> O3, O3INERT -> O3, OA -> O, O1DA -> O, O3A -> O3
+ CB1 -> C, CB2 -> C, SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3, NH4
+ OC1 -> C, OC2 -> C
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ SOA -> C12, H2SO4
+ O3RAD -> O3, SYNOZ -> O3
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, H2SO4, O3S, O3INERT, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, N, NO, XNO, NO2, XNO2, NO3,
+ XNO3, HNO3, XHNO3, HO2NO2, XHO2NO2
+ N2O5, XNO2NO3, NO2XNO3, CH3O2
+ CH3OOH, CH2O, OH, HO2, H2O2, C3H6, ISOP, PO2, CH3CHO
+ POOH, CH3CO3, CH3COOOH, XPAN, PAN, ONIT, XONIT, C2H6
+ C2H4, BIGALK, MPAN, XMPAN
+ ISOPO2, MVK, MACR, MACRO2, MACROOH
+ MCO3, C2H5O2, C2H5OOH, C10H16
+ C3H8, C3H7O2, C3H7OOH, CH3COCH3, ROOH
+ CH3OH, C2H5OH, GLYALD, HYAC, EO2
+ EO, HYDRALD, RO2, CH3COCHO, ISOPNO3, XISOPNO3, ONITR, XONITR
+ XO2, XOOH, ISOPOOH
+ BIGENE, ENEO2, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH, TOLUENE
+ CRESOL, TOLO2, TOLOOH, XOH, TERPO2, TERPOOH, BIGALD, GLYOXAL, CH3COOH
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4
+ OC1, OC2
+ SOA
+ O3A, O1DA, OA
+ DST01, DST02, DST03, DST04
+ SSLT01, SSLT02, SSLT03, SSLT04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno] NO + hv -> N + O
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+* [jho2no2] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+* [jh2o] H2O + hv -> OH + HO2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+* [jmacr_a] MACR -> 1.34 * HO2 + .66 * MCO3 + 1.34 * CH2O + 1.34 * CH3CO3
+* [jmacr_b] MACR -> .66 * OH + 1.34 * CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ [jo1da] O3A + hv ->O1DA
+ [jo3pa] O3A + hv -> OA
+ [jno2a] XNO2 + hv -> XNO + OA
+ [jn2o5a] XNO2NO3 + hv -> XNO2
+ [jn2o5b] NO2XNO3 + hv -> XNO3
+ [jhno3a] XHNO3 + hv -> XNO2
+ [jno3a] XNO3 + hv -> .89*XNO2 + .11*XNO +.89*O3A
+ [jpana] XPAN + hv -> .6*XNO2 + .4*XNO3
+ [jmpana] XMPAN + hv -> XNO2
+ [jho2no2a] XHO2NO2 + hv -> .33*XNO3 + .66*XNO2
+ [jonitra] XONITR + hv -> XNO2
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ [usr1a] OA + O2 + M -> O3A + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ OA + O3 -> O3 ; 8e-12, -2060
+ O3A+ O -> O ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 1.8e-11, 110
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ O1DA + N2 -> OA + N2 ; 1.8e-11, 110
+ O1DA + O2 -> OA + O2 ; 3.2e-11 , 70
+ O1DA + H2O -> H2O ; 2.2e-10
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ N2O + O1DA -> N2O ; 6.7e-11
+ N2O + O1DA -> N2O ; 4.9e-11
+[ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ XNO + HO2 -> XNO2 + HO2 ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ XNO + O3 -> XNO2 + O3 ; 3e-12, -1500
+ NO + O3A -> NO ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + OA -> NO2 ; 5.6e-12, 180
+ XNO2 + O -> XNO + O ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ XNO2 + O3 -> XNO3 + O3 ; 1.2e-13, -2450
+ NO2 + O3A -> NO2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ XNO3 + HO2 -> HO2 + XNO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2a] XNO2 + NO3 + M -> XNO2NO3 + NO3 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2b] NO2 + XNO3 + M -> NO2XNO3 + NO2 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr3a] XNO2NO3 + M -> XNO2 + M
+ [usr3b] NO2XNO3 + M -> XNO3 + M
+* N2O5 + H2O -> 2*HNO3 ; 0.
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4a] XNO2 + OH + M -> XHNO3 + OH + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ [usr5a] XHNO3 + OH -> XNO3 + OH
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ XNO3 + NO -> XNO2 + NO ; 1.5e-11, 170
+ NO3 + XNO -> XNO2 + NO3 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ [usr6a] XNO2 + HO2 + M -> XHO2NO2 + HO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ XHO2NO2 + OH -> XNO2 + OH ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr7a] XHO2NO2 + M -> XNO2 + M
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75 * CH3O2 + .75 * OH + .25 * CH2O + .4 * HO2 + .05 * H2 ; 1.5e-10
+ CH4 + O1DA -> CH4 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + XNO -> CH3O2 + XNO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ [new3] CH2O + XNO3 -> CH2O + XHNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + O1DA -> H2 ; 1.1e-10
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ OH + O3A -> OH ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ HO2 + O3A -> HO2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + O3A -> C3H6 ; 6.5e-15, -1900
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [new2] C3H6 + XNO3 -> XONIT +C3H6 ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + XNO -> PO2 + XNO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [new4] CH3CHO + XNO3 -> CH3CHO + XHNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ CH3CO3 + XNO -> CH3CO3 + XNO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ [usr11a] CH3CO3 + XNO2 + M -> XPAN + CH3CO3 + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ [usr12a] XPAN + M -> XNO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ ISOP + O3A -> ISOP + .1 * O3A ; 1.05e-14, -2000
+ OH + C2H6 -> C2H5O2 + H2O ; 8.7e-12, -1070
+ OH + BIGENE -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ ENEO2 + XNO -> ENEO2 + XNO2 ; 4.2e-12, 180
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + XNO -> ALKO2 + .9*XNO2 + .1*XONIT ; 4.2e-12, 180
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ OH + ALKOOH -> ALKO2 ; 3.8e-12, 200
+ OH + MEK -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + XNO -> MEKO2 + XNO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ OH + MEKOOH -> MEKO2 ; 3.8e-12, 200
+* [soa4] OH+ TOLUENE -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 5.5e-12
+ [soa4] OH + TOLUENE -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ OH + CRESOL -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [new1] XOH + XNO2 -> XOH + .7*XNO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + XNO -> TOLO2 + .9*XNO2 ; 4.2e-12, 180
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ OH + TOLOOH -> TOLO2 ; 3.8e-12, 200
+ OH + GLYOXAL -> HO2 + CO + CO2 ; 1.1e-11
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + XNO -> TERPO2 + XNO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ OH + TERPOOH -> TERPO2 ; 3.8e-12, 200
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + XNO -> C2H5O2 + XNO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr13] OH + C2H4 + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO2 + XNO -> EO2 + XNO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+ [ox_l6] O3 + C2H4 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ O3A + C2H4 -> C2H4 ; 1.2e-14, -2630
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + XNO -> ISOPO2 + .92 * XNO2 +.08 * XONITR ; 2.2e-12, 180
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + XNO3 -> ISOPO2 + XNO2 ; 2.4e-12
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MVK + O3A -> MVK + .2 * O3A ; 7.52e-16,-1521
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ MACR + O3A -> MACR + .2 * O3A ; 4.4e-15, -2500
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + XNO -> XNO2 + MACRO2 ; 2.7e-12, 360
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + XNO -> 0.8*XONITR + MACRO2 ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47 * HO2 + .25 * CH2O + .25 * CH3COCHO ; 2.4e-12
+ + .22 * CO + .53 * GLYALD + .22 * HYAC + .53 * CH3CO3
+ MACRO2 + XNO3 -> XNO2 + MACRO2 ; 2.4e-12
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73 * HO2 + .88 * CH2O + .11 * CO + .24 * CH3COCHO ; 5.e-13,400
+ + .26 * GLYALD + .26 * CH3CO3 + .25 * CH3OH + .23 * HYAC
+ MACRO2 + CH3CO3 -> .25 * CH3COCHO + CH3O2 + .22 * CO + .47 * HO2 ; 1.4e-11
+ + .53 * GLYALD + .22 * HYAC + .25 * CH2O + .53 * CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.3e-12, 360
+ MCO3 + XNO -> XNO2 + MCO3 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5.e-12
+ MCO3 + XNO3 -> XNO2 + MCO3 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr14a] MCO3 + XNO2 + M -> XMPAN + M + MCO3
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [usr15a] XMPAN + M -> XNO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ C10H16 + O3A -> C10H16 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ C10H16 + XNO3 -> C10H16 + XNO2 ; 1.2e-12, 490
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ [usr16] N2O5 -> 2 * HNO3
+ [usr16a] XNO2NO3 -> XHNO3
+ [usr16b] NO2XNO3 -> XHNO3
+ [usr17] NO3 -> HNO3
+ [usr17b] XNO3 -> XHNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ [usr17ab] XNO2 -> 0.5*XNO + 0.5*XHNO3
+ N + O2 -> NO + O ; 1.5e-11, -3600
+ N + NO -> N2 + O ; 2.1e-11, 100
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + XNO -> C3H7O2 + XNO2 ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + XNO -> RO2 + XNO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ XONIT + OH -> XNO2 + OH ; 6.8e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ [new5] ISOP + XNO3 -> XISOPNO3 + ISOP ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ XISOPNO3 + NO -> .794 * XONITR + .206 * XNO2 + NO ; 2.7e-12, 360
+ ISOPNO3 + XNO -> 1.00 * XNO2 + ISOPNO3 ; 2.7e-12, 360
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ XISOPNO3 + NO3 -> .794 * XONITR + .206 * XNO2 + NO3 ; 2.4e-12
+ ISOPNO3 + XNO3 -> 1.00 * XNO2 + ISOPNO3 ; 2.4e-12
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ XISOPNO3 + HO2 -> .206 * XNO2 + .794 * XONITR + HO2 ; 8.e-13, 700
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ CH3COCHO + XNO3 -> XHNO3 + CH3COCHO ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ XONITR + OH -> OH + .4 *XNO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ XONITR + NO3 -> .5 * XNO2 + NO3 ; 1.4e-12, -1860
+ ONITR + XNO3 -> .5 * XNO2 + ONITR ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO -> XNO2 + XO2 ; 2.7e-12, 360
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO3 -> XNO2 + XO2 ; 2.4e-12
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ OH + CH3OH -> HO2 + CH2O ; 7.3e-12,-620
+ OH + C2H5OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ OH + MPAN -> .5 * HYAC + .5 * NO3 + .5 * CH2O + .5 * HO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ OH + XMPAN -> .5 * XNO3 + OH ; 8.e-27,3.5,3.e-11,0.,.5
+ OH + PAN -> CH2O + NO3 ; 4.e-14
+ OH + XPAN -> XNO3 + OH ; 4.e-14
+ OH + HYAC -> CH3COCHO + HO2 ; 3.e-12
+ OH + GLYALD -> HO2 + .2*GLYOXAL + .8*CH2O ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ DMS + XNO3 -> DMS + XHNO3 ; 1.9e-13, 520.
+ [usr25] NH3 -> NH4
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ XHNO3, XHO2NO2, XONIT, XONITR, XISOPNO3
+ SO2, NH3, NH4, H2SO4
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, XNO
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ machine = scalar
+ model = cam
+ architecture = hybrid
+* vec_ftns = on
+ namemod = on
+ End Version Options
+
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_noaa_xnox.inp b/chem_proc/inputs/cam_noaa_xnox.inp
new file mode 100644
index 0000000000..54fa075df2
--- /dev/null
+++ b/chem_proc/inputs/cam_noaa_xnox.inp
@@ -0,0 +1,511 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_xnox.doc
+sim_dat_filename = cam_xnox.dat
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) NOx tags fire"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, N, NO, XNO -> NO, NO2, XNO2 -> NO2, NO3
+ XNO3 -> NO3, HNO3, XHNO3 -> HNO3
+ HO2NO2, XHO2NO2 -> HO2NO2, N2O5, XNO2NO3 -> N2O5, NO2XNO3 -> N2O5, CH4, CH3O2
+ CH3OOH, CH2O, CO, OH, HO2, H2O2, C3H6, ISOP -> C5H8, PO2 -> C3H6OHO2, CH3CHO
+ POOH -> C3H6OHOOH, CH3CO3, CH3COOOH, PAN -> CH3CO3NO2, XPAN -> CH3CO3NO2
+ ONIT -> CH3COCH2ONO2, XONIT -> CH3COCH2ONO2, C2H6, C2H4
+ MPAN -> CH2CCH3CO3NO2, XMPAN -> CH2CCH3CO3NO2
+ ISOPO2 -> HOCH2COOCH3CHCH2, MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, C2H5O2, C2H5OOH, C10H16
+ C3H8, C3H7O2, C3H7OOH, CH3COCH3, ROOH -> CH3COCH2OOH
+ CH3OH, C2H5OH, GLYALD -> HOCH2CHO, HYAC -> CH3COCH2OH, EO2 -> HOCH2CH2O2
+ EO -> HOCH2CH2O, HYDRALD -> HOCH2CCH3CHCHO
+ RO2 -> CH3COCH2O2, CH3COCHO, Rn, Pb
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, XISOPNO3 -> CH2CHCCH3OOCH2ONO2
+ ONITR -> CH2CCH3CHONO2CH2OH, XONITR -> CH2CCH3CHONO2CH2OH
+ XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH, ISOPOOH -> HOCH2COOHCH3CHCH2
+ BIGALK -> C5H12, BIGENE -> C4H8
+ ENEO2 -> C4H9O3, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2, MEK -> C4H8O
+ MEKO2 -> C4H7O3, MEKOOH -> C4H8O3, TOLUENE -> C7H8, CRESOL -> C7H8O
+ TOLO2 -> C7H9O3, TOLOOH -> C7H10O3, XOH -> C7H10O4, TERPO2 -> C10H17O3
+ TERPOOH -> C10H18O3, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2, CH3COOH
+ H2, O3S -> O3, O3INERT -> O3, OA -> O, O1DA -> O, O3A -> O3
+ CB1 -> C, CB2 -> C, SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3, NH4
+ OC1 -> C, OC2 -> C, SA1 -> NaCl, SA2 -> NaCl, SA3 -> NaCl, SA4 -> NaCl
+ SOA -> C12, H2SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, H2SO4, O3S, O3INERT
+ End Explicit
+ Implicit
+ O3, O1D, O, N, NO, XNO, NO2, XNO2, NO3,
+ XNO3, HNO3, XHNO3, HO2NO2, XHO2NO2
+ N2O5, XNO2NO3, NO2XNO3, CH3O2
+ CH3OOH, CH2O, OH, HO2, H2O2, C3H6, ISOP, PO2, CH3CHO
+ POOH, CH3CO3, CH3COOOH, XPAN, PAN, ONIT, XONIT, C2H6
+ C2H4, BIGALK, MPAN, XMPAN
+ ISOPO2, MVK, MACR, MACRO2, MACROOH
+ MCO3, C2H5O2, C2H5OOH, C10H16
+ C3H8, C3H7O2, C3H7OOH, CH3COCH3, ROOH
+ CH3OH, C2H5OH, GLYALD, HYAC, EO2
+ EO, HYDRALD, RO2, CH3COCHO, ISOPNO3, XISOPNO3, ONITR, XONITR
+ XO2, XOOH, ISOPOOH
+ BIGENE, ENEO2, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH, TOLUENE
+ CRESOL, TOLO2, TOLOOH, XOH, TERPO2, TERPOOH, BIGALD, GLYOXAL, CH3COOH
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4
+ OC1, OC2, SA1, SA2, SA3, SA4
+ SOA
+ O3A, O1DA, OA
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno] NO + hv -> N + O
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+* [jho2no2] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+* [jh2o] H2O + hv -> OH + HO2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+* [jmacr_a] MACR -> 1.34 * HO2 + .66 * MCO3 + 1.34 * CH2O + 1.34 * CH3CO3
+* [jmacr_b] MACR -> .66 * OH + 1.34 * CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ [jo1da] O3A + hv ->O1DA
+ [jo3pa] O3A + hv -> OA
+ [jno2a] XNO2 + hv -> XNO + OA
+ [jn2o5a] XNO2NO3 + hv -> XNO2
+ [jn2o5b] NO2XNO3 + hv -> XNO3
+ [jhno3a] XHNO3 + hv -> XNO2
+ [jno3a] XNO3 + hv -> .89*XNO2 + .11*XNO +.89*O3A
+ [jpana] XPAN + hv -> .6*XNO2 + .4*XNO3
+ [jmpana] XMPAN + hv -> XNO2
+ [jho2no2a] XHO2NO2 + hv -> .33*XNO3 + .66*XNO2
+ [jonitra] XONITR + hv -> XNO2
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ [usr1a] OA + O2 + M -> O3A + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ OA + O3 -> O3 ; 8e-12, -2060
+ O3A + O -> O ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 1.8e-11, 110
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ O1DA + N2 -> OA + N2 ; 1.8e-11, 110
+ O1DA + O2 -> OA + O2 ; 3.2e-11 , 70
+ O1DA + H2O -> H2O ; 2.2e-10
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ N2O + O1DA -> N2O ; 6.7e-11
+ N2O + O1DA -> N2O ; 4.9e-11
+[ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ XNO + HO2 -> XNO2 + HO2 ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ XNO + O3 -> XNO2 + O3 ; 3e-12, -1500
+ NO + O3A -> NO ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + OA -> NO2 ; 5.6e-12, 180
+ XNO2 + O -> XNO + O ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ XNO2 + O3 -> XNO3 + O3 ; 1.2e-13, -2450
+ NO2 + O3A -> NO2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ XNO3 + HO2 -> HO2 + XNO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2a] XNO2 + NO3 + M -> XNO2NO3 + NO3 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr2b] NO2 + XNO3 + M -> NO2XNO3 + NO2 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr3a] XNO2NO3 + M -> XNO2 + M
+ [usr3b] NO2XNO3 + M -> XNO3 + M
+* N2O5 + H2O -> 2*HNO3 ; 0.
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4a] XNO2 + OH + M -> XHNO3 + OH + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ [usr5a] XHNO3 + OH -> XNO3 + OH
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ XNO3 + NO -> XNO2 + NO ; 1.5e-11, 170
+ NO3 + XNO -> XNO2 + NO3 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ [usr6a] XNO2 + HO2 + M -> XHO2NO2 + HO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ XHO2NO2 + OH -> XNO2 + OH ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr7a] XHO2NO2 + M -> XNO2 + M
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75 * CH3O2 + .75 * OH + .25 * CH2O + .4 * HO2 + .05 * H2 ; 1.5e-10
+ CH4 + O1DA -> CH4 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + XNO -> CH3O2 + XNO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ [new3] CH2O + XNO3 -> CH2O + XHNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + O1DA -> H2 ; 1.1e-10
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ OH + O3A -> OH ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ HO2 + O3A -> HO2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + O3A -> C3H6 ; 6.5e-15, -1900
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [new2] C3H6 + XNO3 -> XONIT +C3H6 ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + XNO -> PO2 + XNO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [new4] CH3CHO + XNO3 -> CH3CHO + XHNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ CH3CO3 + XNO -> CH3CO3 + XNO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ [usr11a] CH3CO3 + XNO2 + M -> XPAN + CH3CO3 + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ [usr12a] XPAN + M -> XNO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ ISOP + O3A -> ISOP + .1 * O3A ; 1.05e-14, -2000
+ OH + C2H6 -> C2H5O2 + H2O ; 8.7e-12, -1070
+ OH + BIGENE -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ ENEO2 + XNO -> ENEO2 + XNO2 ; 4.2e-12, 180
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + XNO -> ALKO2 + .9*XNO2 + .1*XONIT ; 4.2e-12, 180
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ OH + ALKOOH -> ALKO2 ; 3.8e-12, 200
+ OH + MEK -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + XNO -> MEKO2 + XNO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ OH + MEKOOH -> MEKO2 ; 3.8e-12, 200
+* [soa4] OH+ TOLUENE -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 5.5e-12
+ [soa4] OH + TOLUENE -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ OH + CRESOL -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ [new1] XOH + XNO2 -> XOH + .7*XNO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + XNO -> TOLO2 + .9*XNO2 ; 4.2e-12, 180
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ OH + TOLOOH -> TOLO2 ; 3.8e-12, 200
+ OH + GLYOXAL -> HO2 + CO + CO2 ; 1.1e-11
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + XNO -> TERPO2 + XNO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ OH + TERPOOH -> TERPO2 ; 3.8e-12, 200
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + XNO -> C2H5O2 + XNO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr13] OH + C2H4 + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO2 + XNO -> EO2 + XNO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+ [ox_l6] O3 + C2H4 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ O3A + C2H4 -> C2H4 ; 1.2e-14, -2630
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + XNO -> ISOPO2 + .92 * XNO2 +.08 * XONITR ; 2.2e-12, 180
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + XNO3 -> ISOPO2 + XNO2 ; 2.4e-12
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MVK + O3A -> MVK + .2 * O3A ; 7.52e-16,-1521
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ MACR + O3A -> MACR + .2 * O3A ; 4.4e-15, -2500
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + XNO -> XNO2 + MACRO2 ; 2.7e-12, 360
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + XNO -> 0.8*XONITR + MACRO2 ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47 * HO2 + .25 * CH2O + .25 * CH3COCHO ; 2.4e-12
+ + .22 * CO + .53 * GLYALD + .22 * HYAC + .53 * CH3CO3
+ MACRO2 + XNO3 -> XNO2 + MACRO2 ; 2.4e-12
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73 * HO2 + .88 * CH2O + .11 * CO + .24 * CH3COCHO ; 5.e-13,400
+ + .26 * GLYALD + .26 * CH3CO3 + .25 * CH3OH + .23 * HYAC
+ MACRO2 + CH3CO3 -> .25 * CH3COCHO + CH3O2 + .22 * CO + .47 * HO2 ; 1.4e-11
+ + .53 * GLYALD + .22 * HYAC + .25 * CH2O + .53 * CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.3e-12, 360
+ MCO3 + XNO -> XNO2 + MCO3 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5.e-12
+ MCO3 + XNO3 -> XNO2 + MCO3 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr14a] MCO3 + XNO2 + M -> XMPAN + M + MCO3
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [usr15a] XMPAN + M -> XNO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ C10H16 + O3A -> C10H16 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ C10H16 + XNO3 -> C10H16 + XNO2 ; 1.2e-12, 490
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ [usr16] N2O5 -> 2 * HNO3
+ [usr16a] XNO2NO3 -> XHNO3
+ [usr16b] NO2XNO3 -> XHNO3
+ [usr17] NO3 -> HNO3
+ [usr17b] XNO3 -> XHNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ [usr17ab] XNO2 -> 0.5*XNO + 0.5*XHNO3
+ N + O2 -> NO + O ; 1.5e-11, -3600
+ N + NO -> N2 + O ; 2.1e-11, 100
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + XNO -> C3H7O2 + XNO2 ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + XNO -> RO2 + XNO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ XONIT + OH -> XNO2 + OH ; 6.8e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ [new5] ISOP + XNO3 -> XISOPNO3 + ISOP ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ XISOPNO3 + NO -> .794 * XONITR + .206 * XNO2 + NO ; 2.7e-12, 360
+ ISOPNO3 + XNO -> 1.00 * XNO2 + ISOPNO3 ; 2.7e-12, 360
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ XISOPNO3 + NO3 -> .794 * XONITR + .206 * XNO2 + NO3 ; 2.4e-12
+ ISOPNO3 + XNO3 -> 1.00 * XNO2 + ISOPNO3 ; 2.4e-12
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ XISOPNO3 + HO2 -> .206 * XNO2 + .794 * XONITR + HO2 ; 8.e-13, 700
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ CH3COCHO + XNO3 -> XHNO3 + CH3COCHO ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ XONITR + OH -> OH + .4 *XNO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ XONITR + NO3 -> .5 * XNO2 + NO3 ; 1.4e-12, -1860
+ ONITR + XNO3 -> .5 * XNO2 + ONITR ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO -> XNO2 + XO2 ; 2.7e-12, 360
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + XNO3 -> XNO2 + XO2 ; 2.4e-12
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ OH + CH3OH -> HO2 + CH2O ; 7.3e-12,-620
+ OH + C2H5OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ OH + MPAN -> .5 * HYAC + .5 * NO3 + .5 * CH2O + .5 * HO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ OH + XMPAN -> .5 * XNO3 + OH ; 8.e-27,3.5,3.e-11,0.,.5
+ OH + PAN -> CH2O + NO3 ; 4.e-14
+ OH + XPAN -> XNO3 + OH ; 4.e-14
+ OH + HYAC -> CH3COCHO + HO2 ; 3.e-12
+ OH + GLYALD -> HO2 + .2*GLYOXAL + .8*CH2O ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ DMS + XNO3 -> DMS + XHNO3 ; 1.9e-13, 520.
+ [usr25] NH3 -> NH4
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+ [usr27] CH2O ->
+ [usr28] O3 ->
+ [usr28a] O3A ->
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ XHNO3, XHO2NO2, XONIT, XONITR, XISOPNO3
+ SO2, SO4, CB2, NH3, NH4NO3, NH4, OC2, SA1, SA2, SA3, SA4, SOA, H2SO4
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Spatial Dimensions
+ Longitude points = 128
+ Latitude points = 64
+ Vertical points = 28
+ End Spatial Dimensions
+
+ Numerical Control
+ Implicit Iterations = 11
+ End Numerical Control
+
+ Version Options
+ machine = scalar
+ model = cam
+ architecture = hybrid
+* vec_ftns = on
+ namemod = on
+ End Version Options
+
+* Bndy Conds
+* Fixed Lower BC
+* CH4, N2O, H2
+* End Fixed Lower BC
+* End Bndy Conds
+*
+
+ Surface Flux
+ NO, N2O, CH4, CH2O, CO, C2H6, C2H4, C3H8, C3H6, BIGALK, BIGENE
+ ISOP, C10H16, TOLUENE, CH3OH, C2H5OH, CH3COCH3, CH3CHO, MEK, H2
+ CB1, CB2, OC1, OC2, SO2, DMS, NH3
+ End Surface Flux
+
+ Surface Deposition
+ O3, NO2, HNO3, CH3OOH, CH2O, CO, H2O2, POOH
+ CH3COOOH, PAN, MPAN, C2H5OOH, ONIT
+ C3H7OOH, ROOH, CH3COCHO, CH3COCH3, Pb, O3S, O3INERT
+ ONITR, MACROOH, XOOH, ISOPOOH
+ CH3CHO, NO, HO2NO2
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ CB1, CB2, SO2, SO4, NH3, NH4NO3, NH4, OC1, OC2, SA1, SA2, SA3, SA4, SOA
+ H2SO4, XNO, XNO2, XHNO3, XONIT, XONITR, XPAN, XMPAN, XHO2NO2, O3A
+ End Surface Deposition
+
+ Outputs
+ File
+ Transported Species = avrg
+ End Transported Species
+ Surface Flux = avrg
+ End Surface Flux
+ Deposition velocity = avrg
+ End Deposition velocity
+ Photorates = inst
+ End Photorates
+ Production = avrg
+ End Production
+ Loss = avrg
+ End Loss
+ Massdiags = avrg
+ End Massdiags
+ End File
+ End Outputs
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/cam_reduced_mech.inp b/chem_proc/inputs/cam_reduced_mech.inp
new file mode 100644
index 0000000000..d08863fa2b
--- /dev/null
+++ b/chem_proc/inputs/cam_reduced_mech.inp
@@ -0,0 +1,200 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_reduced_mech.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_reduced_mech.dat
+
+Comments
+ "Houweling et al. NMHC chemistry added to CO-CH4 chemistry"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O
+ N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH2O, CO
+ H2, OH, HO2, H2O2
+ CH3CHO, C2O3, PAN -> CH3CO3NO2, PAR -> C, ROR -> CH3O
+ OLE -> C2, C2H4, CH3COCHO, ISOP -> C5H8, ROOH -> CH3COCH2OOH
+ ONIT -> CH3COCH2ONO2, XO2 -> H, XO2N -> H, RXPAR -> H
+ CB1 -> C, CB2 -> C, SO2, SO4, DMS -> CH3SCH3, NH3, NH4, H2SO4, NH4NO3
+ OC1 -> C, OC2 -> C, SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, H2
+ End Explicit
+ Implicit
+ O3, O, O1D
+ NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, CH2O, HO2, H2O2
+ CH3CHO, C2O3, PAN, PAR, ROR
+ OLE, C2H4, CH3COCHO, ISOP, ROOH
+ ONIT, XO2, XO2N, RXPAR
+ SO2, SO4, DMS, NH3, NH4, H2SO4, NH4NO3
+ CB1, CB2, OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH2O + XO2 + CO + 2*HO2
+ [jpan] PAN + hv -> C2O3 + NO2
+ [jmgly] CH3COCHO + hv -> C2O3 + HO2 + CO
+ [jrooh] ROOH + hv -> OH
+ [jonitr] ONIT + hv -> NO2 + HO2
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75 * CH3O2 + .75 * OH + .25 * CH2O + .4 * HO2 + .05 * H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+*
+* NMHC reactions
+*
+* changed reaction to increase PAN production
+*
+* CH3CHO + OH -> HO2 ; 7.0e-12, 250
+ CH3CHO + OH -> 0.5 * HO2 + 0.5 * C2O3 ; 7.0e-12, 250
+ CH3CHO + NO3 -> C2O3 + HNO3 ; 2.5e-15
+ [ox_p3] C2O3 + NO -> CH2O + XO2 + HO2 + NO2 ; 3.5e-11, -180
+ [nmhc01] C2O3 + NO2 -> PAN
+ PAN -> C2O3 + NO2 ; 2e16, -13500
+ C2O3 + C2O3 -> 2*CH2O + 2*XO2 + 2*HO2 ; 2.e-12
+ C2O3 + HO2 -> CH2O + XO2 + HO2 + 0.79*OH + 0.21*ROOH ; 6.5e-12
+ PAR + OH -> 0.87*XO2 + 0.76*ROR + 0.13*XO2N + 0.11*HO2 ; 8.1e-13
+ + 0.11*CH3CHO + 0.11*RXPAR
+ ROR -> 1.1*CH3CHO + 0.96 * XO2 + 0.94*HO2 + 2.1*RXPAR ; 1.1e15, -8000
+ ROR -> HO2 ; 1.6e3
+ OLE + OH -> CH2O + CH3CHO + XO2 + HO2 + RXPAR ; 5.2e-12, 504
+ [ox_l7] OLE + O3 -> 0.44*CH3CHO + 0.64*CH2O + 0.37*CO + 0.25*HO2 + 0.29*XO2 ; 4.33e-15, -1800
+ + 0.4*OH + 0.9*RXPAR
+ OLE + NO3 -> 0.91*XO2 + CH2O + CH3CHO + 0.09*XO2N + NO2 + RXPAR ; 7.7e-15
+ [nmhc02] C2H4 + OH -> XO2 + HO2 + 1.56*CH2O + 0.22*CH3CHO
+ [ox_l6] C2H4 + O3 -> CH2O + 0.43*CO + 0.26*HO2 + 0.12*OH ; 9.1e-15, -2580
+ CH3COCHO + OH -> XO2 + C2O3 ; 1.7e-11
+ ISOP + OH -> 0.85*XO2 + 0.61*CH2O + 0.85*HO2 + 0.03*CH3COCHO + 0.58*OLE ; 2.54e-11, 410
+ + 0.15*XO2N + 0.63*PAR
+ [ox_l5] ISOP + O3 -> 0.9*CH2O + 0.55*OLE + 0.18*XO2 + 0.36*CO + 0.15*C2O3 ; 12.3e-15, -2013
+ + 0.03*CH3COCHO + 0.63*PAR + 0.3*HO2 + 0.28*OH
+ ISOP + NO3 -> 0.9*HO2 + 0.9*ONIT + 0.03*CH2O + 0.45*OLE + 0.12*CH3CHO ; 7.8e-13
+ + 0.1*NO2 + 0.08*CH3COCHO
+ ROOH + OH -> 0.7*XO2 + 0.3*OH ; 3.2e-12
+ ONIT + OH -> NO2 + XO2 ; 1.78e-12
+ [r63] XO2 + NO -> NO2 ; 4.2e-12, 180
+ XO2 + XO2 -> ; 1.7e-14, 1300
+ [r65] XO2N + NO -> ONIT ; 6.8e-13
+ [r66] XO2 + HO2 -> ROOH ; 3.5e-13, 1000
+ [nmhc03] XO2N + HO2 -> ROOH
+ RXPAR + PAR -> ; 8e-11
+*
+* aerosols
+*
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, HO2NO2, ONIT
+ ROOH, CH3COCHO, CH3CHO
+ SO2, NH3, NH4, H2SO4
+ End Heterogeneous
+* aer_wetdep_list = 'CB2', 'OC2', 'SOA', 'SO4', 'NH4NO3'
+
+ Ext Forcing
+ NO<-dataset, CO<-dataset
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/ghg_fixed_aerosols.inp b/chem_proc/inputs/ghg_fixed_aerosols.inp
new file mode 100644
index 0000000000..f159bb45e5
--- /dev/null
+++ b/chem_proc/inputs/ghg_fixed_aerosols.inp
@@ -0,0 +1,80 @@
+BEGSIM
+output_unit_number = 7
+output_file = ghg_fxd_aero.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = ghg_fxd_aero.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom; no NH4, no H2SO4"
+End Comments
+
+ SPECIES
+
+ Solution
+ CH4, N2O, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, SO4, CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ O3
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ CH4, N2O, CFC11, CFC12
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ End Photolysis
+
+ Reactions
+ [ch4_loss] CH4 ->
+ [n2o_loss] N2O ->
+ [cfc11_loss] CFC11 ->
+ [cfc12_loss] CFC12 ->
+ End Reactions
+
+ Heterogeneous
+ End Heterogeneous
+
+ Ext Forcing
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/halogen.inp b/chem_proc/inputs/halogen.inp
new file mode 100644
index 0000000000..20cecaa53e
--- /dev/null
+++ b/chem_proc/inputs/halogen.inp
@@ -0,0 +1,811 @@
+BEGSIM
+output_unit_number = 7
+output_file = halogen.doc
+procout_path = ../output/
+src_path = /home/fvitt/chem_proc_stacy/bkend/
+procfiles_path = /home/fvitt/chem_proc_stacy/procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = halogen.dat
+
+Comments
+ "This is a mozart3 simulation with :"
+ "(1) Detailed tropospheric, stratospheric and mesopheric chemistry"
+ "(2) New "merged" code version"
+ "(3) JPL-02 Kinetic and Photochemical Data"
+ "(4) New hydrocarbon chemistry (Tyndall and Orlando)"
+ "(5) Extended bromine (organic and inorganic) chemistry, photolysis, and wet and dry depos. from JPL06
+ "(6) New iodine (organic and inorganic) chemistry photolysis, and wet and dry depos. from JPL06 and others
+ "(7) Heterogeneous halogen recycle on sea-salt aerosol
+ "(8) Simplified sulphur chemistry scheme
+End Comments
+
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ H, OH, HO2, H2O2, H2
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, CLNO2 -> ClNO2
+ BR2 -> Br2, BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2, BRNO2 -> BrNO2, BRCL -> BrCl
+ CH2BR2 -> CH2Br2, CH2BRCL -> CH2BrCl, CHBR2CL -> CHBr2Cl, CHBRCL2 -> CHBrCl2, CHBR3 -> CHBr3
+ I -> I, I2 -> I2, IO -> IO, OIO -> OIO, INO -> INO, INO2 -> INO2, IONO2 -> IONO2, HI -> HI
+ HOI -> HOI, I2O2 -> I2O2, I2O3 -> I2O3, I2O4 -> I2O4, I2O5 -> I2O5, IBR -> IBr, ICL -> ICl
+ CH3I -> CH3I, CH2I2 -> CH2I2, CH2IBR -> CH2IBr, CH2ICL -> CH2ICl, CF3I -> CF3I
+ C2H5I -> C2H5I, CH3CHI2 -> CH2CHI2, C3H7I -> C3H7I, C4H9I -> C4H9I, CF2I2 -> CF2I2
+ C2F5I -> C2F5I, C3F7I -> C3F7I, C2F4BRI -> CF2BrCF2I
+ CH4, CH3O2, CH3OOH, CH3OH, CH2O, CO
+ C2H4, C2H6, C2H5O2, C2H5OOH, CH3CO3, CH3COOH, CH3CHO, C2H5OH, GLYALD -> HOCH2CHO
+ GLYOXAL -> C2H2O2, CH3COOOH, EO2 -> HOCH2CH2O2, EO -> HOCH2CH2O, PAN -> CH3CO3NO2
+ C3H6, C3H8, C3H7O2, C3H7OOH, CH3COCH3, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH, HYAC -> CH3COCH2OH
+ RO2 -> CH3COCH2O2, CH3COCHO, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, BIGALK -> C5H12, MEK -> C4H8O, ENEO2 -> C4H9O3, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ MCO3 -> CH2CCH3CO3, MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH, MPAN -> CH2CCH3CO3NO2, ONIT -> CH3COCHO2CH2OHNO
+ ISOP -> C5H8, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2, BIGALD -> C5H6O2, HYDRALD -> HOCH2CCH3CHCHO
+ ISOPO2 -> HOCH2COOCH3CHCH2, ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH, ISOPOOH -> HOCH2COOHCH3CHCH2
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3, XOH -> C7H10O4
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, H2O
+ DMS -> CH3SCH3, DMSO -> CH3SOCH3
+ SOA -> C12, CB1 -> C, CB2 -> C, SO2, SO4, NH3, NH4, NH4NO3
+ OC1 -> C, OC2 -> C
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ End Solution
+
+
+ Fixed
+ M, N2, N2D, O2
+ End Fixed
+
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+ End SPECIES
+
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2, CF3I, CF2I2
+ C2F5I, C3F7I, C2F4BRI
+ End Explicit
+ Implicit
+ O3, O, O1D, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ H, OH, HO2, H2O2, H2O, CH3O2, CH3OOH, CH2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, CLNO2, BRCL
+ BR2, BR, BRO, HBR, HOBR, BRONO2, BRNO2, CH2BR2, CH2BRCL, CHBR2CL, CHBRCL2, CHBR3
+ I, I2, IO, OIO, INO, INO2, IONO2, HI, HOI, I2O2, I2O3, I2O4, I2O5
+ IBR, ICL, CH3I, CH2I2, CH2IBR, CH2ICL, C2H5I, CH3CHI2, C3H7I, C4H9I
+ C3H6, ISOP, PO2, CH3CHO, CH3COOH
+ POOH, CH3CO3, CH3COOOH, PAN, ONIT, C2H6, C2H4, BIGALK, MPAN
+ BIGENE, ENEO2, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH, TOLUENE
+ CRESOL, TOLO2, TOLOOH, XOH, TERPO2, TERPOOH, BIGALD, GLYOXAL
+ ISOPO2, MVK, MACR, MACRO2, MACROOH
+ MCO3, C2H5O2, C2H5OOH, C10H16
+ C3H8, C3H7O2, C3H7OOH, CH3COCH3, ROOH
+ CH3OH, C2H5OH, GLYALD, HYAC, EO2
+ EO, HYDRALD, RO2, CH3COCHO, ISOPNO3, ONITR
+ XO2, XOOH, ISOPOOH
+ DMS, DMSO, SO2, SO4, NH3, NH4, NH4NO3
+ CB1, CB2, OC1, OC2, SOA
+ SSLT01, SSLT02, SSLT03, SSLT04
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+CHEMISTRY
+ Photolysis
+ [jo2_a] O2 + hv -> O + O1D
+ [jo2_b] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno] NO + hv -> N + O
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ *[jclno2] CLNO2 + hv -> CL + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jbr2] BR2 + hv -> 2*BR
+ [jbrno2] BRNO2 + hv -> BR + NO2
+ [jclo] CLO + hv -> CL + O
+*[jclno2] CLNO2 + hv -> CL + NO2
+*
+* ,userdefined
+*
+ [jchbr3] CHBR3 + hv -> 3*BR
+ [jch2br2] CH2BR2 + hv -> 2 * BR
+ [jch2brcl] CH2BRCL + hv -> BR + CL
+ [jchbr2cl] CHBR2CL + hv -> 2 * BR + CL
+ [jchbrcl2] CHBRCL2 + hv -> BR + 2 * CL
+ [ji2] I2 + hv -> 2*I
+ [jio] IO + hv -> I + O
+ [joio] OIO + hv -> I + O2
+ [jino] INO + hv -> I + NO
+ [jino2_a->,userdefined] INO2 + hv -> I + NO2
+ [jino2_b->,userdefined] INO2 + hv -> IO + NO
+ [jiono2] IONO2 + hv -> I + NO3
+ [jhoi] HOI + hv -> I + OH
+ [ji2o2_a->,jiono2] I2O2 + hv -> 2*IO
+ [ji2o2_b->,jiono2] I2O2 + hv -> OIO + I
+ [ji2o3->,jiono2] I2O3 + hv -> OIO + IO
+ [ji2o4->,jiono2] I2O4 + hv -> OIO + OIO
+ [ji2o5->,jiono2] I2O5 + hv -> OIO + IO + O2
+ [jibr] IBR + hv -> I + BR
+ [jicl] ICL + hv -> I + CL
+ [jch3i] CH3I + hv -> I + CH3
+ [jch2i2] CH2I2 + hv -> 2*I + CH2
+ [jch2ibr] CH2IBR + hv -> I + CH2BR
+*
+*[jcf3i->,userdefined] CF3I + hv -> I
+*[jcf2i2->,userdefined] CF2I2 + hv -> 2*I
+*[jc2f5i->,userdefined] C2F5I + hv -> I
+*[jc3f7i->,userdefined] C3F7I + hv -> I
+*[jcf2brcf2i->,userdefined] C2F4BRI + hv -> I
+*
+ [jch2icl] CH2ICL + hv -> I + CH2CL
+ [jc2h5i] C2H5I + hv -> I + C2H5
+ [jch3chi2] CH3CHI2 + hv -> 2*I
+ [jc3h7i] C3H7I + hv -> I
+ [jc4h9i] C4H9I + hv -> I
+*
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .44*H2 + .38*CO + .05*H2O
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3
+ [jmpan->,jpan] MPAN + hv -> MCO3 + NO2
+ [jmacr_a] MACR -> 1.34 * HO2 + .66 * MCO3 + 1.34 * CH2O + 1.34 * CH3CO3
+ [jmacr_b] MACR -> .66 * OH + 1.34 * CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh->,jch3ooh] XOOH + hv -> OH
+ [jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac->,2.*jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL +.56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+*==========================================
+* Ox Reactions
+*==========================================
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+[usr_o_o] O + O + M -> O2 + M
+[o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+[o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+[ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ O1D + N2O -> 2*NO ; 6.7e-11
+ O1D + N2O -> N2 + O2 ; 4.9e-11
+ O1D + O3 -> 2*O2 ; 1.20e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.0e-11
+ O1D + CH4 -> CH2O + H2 ; 7.5e-12
+ O1D + H2 -> H + OH ; 1.1e-10
+ O1D + HCL -> CL + OH ; 1.5e-10
+
+*==========================================
+* HOx Reactions
+*==========================================
+ H + O2 + M -> HO2 + M ; 5.7e-32,1.6, 7.5e-11,0., .6
+ H + O3 -> OH + O2 ; 1.40e-10, -470.0
+*JPL02
+*Change QY from 0.87 to 0.89; total QY now equals 1.0
+* H + HO2 -> 2*OH ; 7.05e-11
+ H + HO2 -> 2*OH ; 7.21e-11
+ H + HO2 -> H2 + O2 ; 7.29e-12
+ H + HO2 -> H2O + O ; 1.62e-12
+ OH + O -> H + O2 ; 2.2e-11, 120
+*JPL02
+*[ox_l2] OH + O3 -> HO2 + O2 ; 1.5e-12, -880
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ OH + H2O2 -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+*JPL02
+* OH + OH + M -> H2O2 + M ; 6.2e-31,1.0, 2.6e-11, 0., .6
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1.0, 2.6e-11, 0., .6
+ OH + H2 -> H2O + H ; 5.5e-12, -2000
+ HO2 + O -> OH + O2 ; 3e-11, 200
+*JPL02
+*[ox_l3] HO2 + O3 -> OH + 2*O2 ; 2e-14, -680
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.0e-14, -490.
+ [usr9] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.4e-12, -2000
+
+*==========================================
+* NOx Reactions
+*==========================================
+ N2D + O2 -> NO + O ; 5.e-12
+ N2D + O -> N + O ; 4.5e-13
+ N + O2 -> NO + O ; 1.5e-11, -3600
+ N + NO -> N2 + O ; 2.1e-11, 100
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O + M -> NO2 + M ; 9.0e-32, 1.5, 3.0e-11, 0., 0.6
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+*JPL02
+* NO2 + O + M -> NO3 + M ; 9.0e-32, 2., 2.2e-11, 0., .6
+ NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, .7, .6
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.0e-30,4.4,1.4e-12,.7,.6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ NO3 + O -> NO2 + O2 ; 1.e-11
+ NO3 + OH -> HO2 + NO2 ; 2.2e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12
+*JPL02
+*[usr6] NO2 + OH + M -> HNO3 + M ; 2.4e-30,3.1, 1.7e-11,2.1, 0.6
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0.0, 0.6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, 0.6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+
+*==========================================
+* ClOx Reactions
+*==========================================
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200
+ CL + H2 -> HCL + H ; 3.70e-11, -2300.0
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.0
+ CL + HO2 -> HCL + O2 ; 1.80e-11, +170.0
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.0
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.0
+ CL + CH4 -> CH3O2 + HCL ; 9.60e-12, -1360
+ CLO + O -> CL + O2 ; 3.00e-11, +70.0
+ CLO + OH -> CL + HO2 ; 7.40e-12, +270.0
+*JPL02
+* CLO + OH -> HCL + O2 ; 3.2e-13, 320
+ CLO + OH -> HCL + O2 ; 6.0e-13, 230
+*JPL02
+* CLO + HO2 -> O2 + HOCL ; 4.80e-13, +700.0
+ CLO + HO2 -> O2 + HOCL ; 2.7e-12, +220.0
+ CLO + NO -> NO2 + CL ; 6.40e-12, +290.0
+ CLO + NO2 + M -> CLONO2 + M ; 1.8e-31,3.4, 1.5e-11, 1.9, 0.6
+ CL + NO2 + M -> CLNO2 + M ; 1.8e-31,2, 1.0e-10, 1.0, 0.6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.0
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.0
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.0
+*JPL02; Bloss et al. in new jpl02; sander was jpl00
+*[usr10] CLO + CLO + M -> CL2O2 + M ; 2.2e-32,3.1, 3.5e-12, 1.0, 0.6
+[clo_clo] CLO + CLO + M -> CL2O2 + M ; 1.6e-32,4.5, 2.0e-12, 2.4, 0.6
+ [cl2o2] CL2O2 + M -> 2*CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350.
+ HCL + O -> CL + OH ; 1.00e-11, -3300.
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130.
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500.
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800.
+*JPL02
+* CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -333.
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330.
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+ CLNO2 + OH -> HOCL + NO2 ; 2.40e-12, -1250.
+ CL2 + OH -> HOCL + CL ; 1.4e-12,-900.
+
+*==========================================
+* BrOx Reactions
+*==========================================
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 1.50e-11, -600.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BR + CH3CHO -> CH3CO3 + HBR ; 1.30e-11,-360.
+ BR + NO3 -> BRO + NO2 ; 1.6e-11
+ BR + OH -> HOBR ; 4.2e-11
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 7.5e-11
+ BRO + HO2 -> HOBR + O2 ; 3.40e-12, 540.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.2e-31,3.2, 6.9e-12,2.9, .6
+ BR + NO2 + M -> BRNO2 + M ; 4.2e-31,2.4, 2.7e-11,0.0, .6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + CH3O2 -> BR + CH2O + HO2 ; 1.6e-12
+ BRO + CH3O2 -> HOBR + CH2O ; 4.10e-12
+ BRO + CH3CO3 -> BR + CH3O2 ; 1.7e-12
+ BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230.
+ HBR + OH -> BR + H2O ; 5.5e-12, 200.
+ HBR + O -> OH + BR ; 5.8e-12, -1500.
+ HBR + O1D -> 0.2 * O + 0.2 * HBR + 0.8 * OH + 0.8 * Br ; 1.5e-10
+ BR2 + OH -> HOBR + BR ; 2.1e-11, 240.
+ BRONO2 + O -> BRO + NO3 ; 1.91e-11,215.
+ BRONO2 + BR -> BR2 + NO3 ; 1.78e-11,365.
+ BRONO2 + CL -> BRCL + NO3 ; 6.28e-11,215.
+ BRO + DMS -> DMSO + BR ; 1.4e-14, 950.
+
+*==========================================
+* IOx Reactions, JPL06
+* oiofactor = 0.2
+*==========================================
+ I2 + O3 -> IO + I + O2 ; 3.80e-18
+ I2 + O3 -> OIO + IO ; 3.80e-18
+ I + O3 -> IO + O2 ; 2.3e-11, -870.
+ I + HO2 -> HI + O2 ; 1.5e-11, -1090.
+ IO + NO -> I + NO2 ; 9.1e-12, 240.
+ IO + HO2 -> HOI + O2 ; 8.4e-11
+ IO + IO -> OIO + I ; 1.8e-11
+ IO + IO -> I2O2 ; 7.2e-11
+ IO + OIO -> I2O3 ; 1.5e-10
+ OIO + OIO -> I2O4 ; 1.0e-10
+*=========================================================================================================
+* Thermal decomposition @ 265 K, calculated using RRKM theory
+*=========================================================================================================
+ I2O2 -> OIO + I ; 0.21
+ I2O2 -> IO + IO ; 1.3e-4
+ I2O4 -> 2*OIO ; 4.4e-4
+ BRONO2 -> BRO + NO2 ; 2.8e13, -12360.
+*=========================================================================================================
+ I2O3 + O3 -> I2O4 + O2 ; 1.0e-12
+ I2O4 + O3 -> I2O5 + O2 ; 1.0e-12
+ I2 + OH -> HOI + I ; 1.8e-10
+ I2 + NO3 -> IO + INO2 ; 1.5e-12
+ I + NO3 -> IO + NO2 ; 4.5e-10
+ OH + HI -> I + H2O ; 3.5e-11
+ HOI + OH -> IO + H2O ; 2.0e-13
+ IO + DMS -> DMSO + I ; 1.2e-14
+ I + NO2 + M -> INO2 + M ; 3.0e-31,1.0, 6.0e-11,0.0, .6
+ INO2 -> I + NO2 ; 993.6e15, -11859.
+ IO + NO2 + M -> IONO2 + M ; 6.5e-31,3.5, 7.6e-12,1.5, .6
+ I + NO + M -> INO + M ; 1.8e-32, 1.0, 1.7e-11, 0.0, .6
+ INO + INO -> I2 + 2*NO ; 8.4e-11, -2620.
+ INO2 + INO2 -> I2 + 2*NO2 ; 2.9e-11, -2600.
+ IO + BRO + M -> BR + I + O2 ; 0.45e-11, 510.
+* IO + BRO + M -> BR + OIO
+ I + BRO -> IO + BR ; 1.2e-11
+ IO + CLO -> I + OCLO ; 5.1e-12, 280.
+* What happens to CH2I ???????
+ OH + CH3I -> CH2I + H2O ; 2.9e-12, -1100.
+ OH + CF3I -> HOI + CF3 ; 2.5e-11, -2070.
+*
+* aerosols
+*
+ CB1 -> CB2 ; 7.1e-6
+ [usr23] SO2 + OH -> SO4
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 7.1e-6
+ [usr26] HO2 -> 0.5*H2O2
+
+*==========================================
+* DMS Reactions
+*==========================================
+ DMS + OH -> SO2 ; 1.1e-11,-240.
+[usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.0e-12, 500.
+
+*==========================================
+* Halogens Reactions with Cl, OH
+*==========================================
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 3.20e-11, -1250.0
+*JPL02
+* CH3CL + OH -> CL + H2O + HO2 ; 4.00e-12, -1400.0
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250.0
+*JPL02
+* CH3CCL3 + OH -> H2O + 3*CL ; 1.80e-12, -1550.0
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.60e-12, -1520.0
+*JPL02
+* HCFC22 + OH -> CL + H2O + CF2O ; 1.00e-12, -1600.0
+ HCFC22 + OH -> CL + H2O + CF2O ; 1.05e-12, -1600.0
+*JPL02
+* CH3BR + OH -> BR + H2O + HO2 ; 4.00e-12, -1470.0
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300.0
+*===============================================
+* additional reactions
+*===============================================
+ OH + C2H5I -> CH3CHO + IO + H2O ; 7.0e-13
+ OH + C3H7I -> CH3COCH3 + IO + H2O ; 1.4e-12
+ OH + C4H9I -> MEK + IO + H2O ; 3.0e-13
+
+ CL + C2H5I -> HCL + C2H4 + I ; 2.4e-11, -428.
+ CL + C2H5I -> HCL + IO + CH3CHO ; 4.1e-11, -428.
+ CL + C3H7I -> HCL + C3H6 + I ; 2.5e-11
+ CL + C3H7I -> HCL + IO + CH3COCH3 ; 2.0e-11
+ CL + C4H9I -> HCL + I ; 7.0e-11
+
+*================================================
+* Heterogeneous bromo reactions
+*================================================
+* [het1] BRONO2 -> HOBR + HNO3
+* [het2] HOBR -> BRCL
+* [het3] HOBR -> 0.5 * BR2
+
+*==========================================
+* C-1 Degradation
+*==========================================
+ [usr8] CO + OH -> CO2 + H
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH3OH + OH -> HO2 + CH2O ; 6.7e-12,-600
+*JPL02
+*[ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 3.e-12, 280
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+*JPL02
+* CH3O2 + HO2 -> CH3OOH + O2 ; 3.8e-13, 800
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+*JPL02
+* CH2O + OH -> CO + H2O + H ; 1e-11
+ CH2O + OH -> CO + H2O + H ; 9.0e-12
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.0
+
+*==========================================
+* C-2 Degradation
+*
+* EO2 = HOCH2CH2O2
+* EO = HOCH2CH2O
+* PAN = CH3CO3NO2
+* GLYALD = HOCH2CHO
+*
+*==========================================
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .32 * CH3COOH
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+*JPL02
+* CH3CO3 + HO2 -> .7 * CH3COOOH + .3 * CH3COOH + .3 * O3 ; 4.3e-13, 1040
+ CH3CO3 + HO2 -> .75 * CH3COOOH + .25 * CH3COOH + .25 * O3 ; 4.3e-13, 1040
+*JPL02
+* CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 1.3e-12, 640
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12, 500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.2e-12, 180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ PAN + OH -> CH2O + NO3 ; 4.e-14
+
+*==========================================
+* C-3 Degradation
+*
+* PO2 = C3H6OHO2
+* POOH = C3H6OHOOH
+* RO2 = CH3COCH2O2
+* ROOH = CH3COCH2OOH
+* HYAC = CH3COCH2OH
+*
+*==========================================
+ C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+*JPL02
+*[ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 4.2e-12, 180
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+*JPL02
+* RO2 + HO2 -> ROOH + O2 ; 7.5e-13, 700
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+*JPL02 (not in previous mechanism)
+ RO2 + CH3O2 -> .3*CH3CO3 + .8* CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+
+*==========================================
+* C-4 Degradation
+*
+* ENEO2 = C4H9O3
+* MEK = C4H8O
+* MEKO2 = C4H7O3
+* MEKOOH = C4H8O3
+* MVK = CH2CHCOCH3
+* MACR = CH2CCH3CHO
+* MACRO2 = CH3COCHO2CH2OH
+* MACROOH = CH3COCHOOHCH2OH
+* MCO3 = CH2CCH3CO3
+* MPAN = CH2CCH3CO3NO2
+* ONIT = CH3COCHO2CH2OHNO
+*
+*==========================================
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47 * HO2 + .25 * CH2O + .25 * CH3COCHO ; 2.4e-12
+ + .22 * CO + .53 * GLYALD + .22 * HYAC + .53 * CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73 * HO2 + .88 * CH2O + .11 * CO + .24 * CH3COCHO ; 5.e-13,400
+ + .26 * GLYALD + .26 * CH3CO3 + .25 * CH3OH + .23 * HYAC
+ MACRO2 + CH3CO3 -> .25 * CH3COCHO + CH3O2 + .22 * CO + .47 * HO2 ; 1.4e-11
+ + .53 * GLYALD + .22 * HYAC + .25 * CH2O + .53 * CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5.e-12
+*JPL02
+* MCO3 + HO2 -> .3 * O3 + .3 * CH3COOH + .7 * CH3COOOH + .7 * O2 ; 4.30e-13, 1040
+ MCO3 + HO2 -> .25 * O3 + .25 * CH3COOH + .75 * CH3COOOH + .75 * O2 ; 4.30e-13, 1040
+*JPL02
+* MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 1.3e-12,640
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ MPAN + OH -> .5 * HYAC + .5 * NO3 + .5 * CH2O + .5 * HO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+
+*==========================================
+* C-5 Degradation
+*
+* ALKO2 = C5H11O2
+* ALKOOH = C5H12O2
+* ISOPO2 = HOCH2COOCH3CHCH2
+* ISOPNO3 = CH2CHCCH3OOCH2ONO2
+* ISOPOOH = HOCH2COOHCH3CHCH2
+* ONITR = CH2CCH3CHONO2CH2OH
+* XO2 = HOCH2COOCH3CHCHOH
+* XOOH = HOCH2COOHCH3CHCHOH
+*
+*==========================================
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .51 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> XOOH + .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+*JPL02 (Different products)
+* ONITR + OH -> .5*CO + .5*CH2O ; 1.5e-11
+* + HYDRALD + NO2 + HO2
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HO2 + NO2 + HYDRALD ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+*JPL02
+* C2H5OH + OH-> HO2 + CH3CHO ; 7.e-12,-235
+ C2H5OH + OH-> HO2 + CH3CHO ; 6.9e-12,-230
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O ; 1.e-11
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .8*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+
+*==========================================
+* C-7 degradation
+*
+* CRESOL = C7H8O
+* TOLUENE = C7H8
+* TOLO2 = C7H9O3
+* TOLOOH = C7H10O3
+* XOH = C7H10O4
+*
+*==========================================
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 5.5e-12
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+
+*==========================================
+* C-10 degradation (3)
+*==========================================
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+
+*============================================================
+* NOTE: does the halogen recycle happen on these aerosols????
+* sea-salt aerosols to be included
+*=============================================================
+
+*==========================================
+* Sulfate aerosol reactions
+*==========================================
+ [het0] NO3 -> HNO3
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+
+*==========================================
+* Nitric acid Di-hydrate reactions
+*==========================================
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+
+*==========================================
+* Water-Ice aerosol reactions
+*==========================================
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+
+*===========================================================
+* NOTE: the 75/25 % is taken as a compromise between
+* reaction probability, halide content and halide depletion with time
+*=====================================================================
+*==========================================
+* Additional Sulfate aerosol reactions
+*==========================================
+*[het_add_0] CLNO2 -> .75*CL2 + .25*BRCL
+*[het_add_1] BRNO2 -> .75*BR2 + .25*BRCL
+*[het_add_2] IONO2 -> .5*IBR + .5*ICL
+*[het_add_3] INO2 -> .5*IBR + .5*ICL
+*[het_add_4] HOI + HBR -> .5*IBR + .5*ICL
+
+*==========================================
+* Sea-salt aerosol reactions
+*==========================================
+[het_ss_0] BRONO2 -> .75*BR2 + .25*BRCL
+[het_ss_1] BRNO2 -> .75*BR2 + .25*BRCL
+[het_ss_2] HOBR -> .75*BR2 + .25*BRCL
+[het_ss_3] CLONO2 -> .75*CL2 + .25*BRCL
+[het_ss_4] CLNO2 -> .75*CL2 + .25*BRCL
+[het_ss_5] HOCL -> .75*CL2 + .25*BRCL
+[het_ss_6] IONO2 -> .5*IBR + .5*ICL
+[het_ss_7] INO2 -> .5*IBR + .5*ICL
+[het_ss_8] HOI -> .5*IBR + .5*ICL
+
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR, C2H5OOH
+ C3H7OOH, ROOH, CH3COCHO, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3, ALKOOH, MEKOOH, TOLOOH, TERPOOH
+ CLONO2, CLNO2, BRONO2, BRNO2, INO2, IONO2, HI, HOI, HCL, HOCL, HOBR, HBR, CH3COOH
+ CH3I, CH2I2, CH2IBR, CF3I, CF2I2, C2F5I, C3F7I, C2F4BRI, CH2ICL, C2H5I, CH3CHI2, C3H7I, C4H9I
+ DMS, DMSO, SO2
+ End Heterogeneous
+
+
+ Ext Forcing
+ NO, CO, CH4
+ End Ext Forcing
+
+END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
+
diff --git a/chem_proc/inputs/kmg_CAM3_input_deck_T6_v4.inp b/chem_proc/inputs/kmg_CAM3_input_deck_T6_v4.inp
new file mode 100644
index 0000000000..0daebdba14
--- /dev/null
+++ b/chem_proc/inputs/kmg_CAM3_input_deck_T6_v4.inp
@@ -0,0 +1,156 @@
+BEGSIM
+output_unit_number = 7
+output_file = T6_LLNL_v4.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = T6_LLNL_v4.dat
+
+COMMENTS
+ "!======================================================================="
+ "!"
+ "! $Id: kmg_CAM3_input_deck.inp $"
+ "!"
+ "! CODE DEVELOPER"
+ "! Name and affiliation"
+ "! connell2@llnl.gov"
+ "!"
+ "! FILE"
+ "! kmg_CAM3_input_deck.inp"
+ "!"
+ "! DESCRIPTION"
+ "! This file is the mechanism input file."
+ "!"
+ "! Chemistry input file: T6 12:00PM 7/09/2008"
+ "! Reaction dictionary: Rxns_trop_strat_JPL06-2.db"
+ "! Setkin files generated: Thu Aug 21 18:18:20 2008"
+ "!"
+ "!======================================================================="
+End COMMENTS
+
+ SPECIES
+
+ Solution
+ O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH4, CH2O, CH3O2
+ CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S,
+ SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, OZONE, sulf, bcar1, bcar2, ocar1, ocar2,
+ sslt1, sslt2, sslt3, sslt4, dust1, dust2, dust3, dust4
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CO, CH4
+ End explicit
+ Implicit
+ O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH
+ DMS, SO2, SO4
+ End implicit
+ END Solution classes
+
+ CHEMISTRY
+ Photolysis
+[jo1d] O3 + hv -> 2*OH
+[jh2o2] H2O2 + hv -> 2*OH
+[jno2] NO2 + hv -> NO + O3
+[jch2o_a] CH2O + hv -> CO + 2*HO2
+[jch2o_b] CH2O + hv -> CO
+[jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ End Photolysis
+
+ Reactions
+ O3 + OH -> HO2 + O2 ; 1.700E-12, -940
+[out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490
+ HO2 + OH -> H2O + O2 ; 4.800E-11, 250
+[ho2_ho2] HO2 + HO2 -> H2O2 + O2
+ H2O2 + OH -> H2O + HO2 ; 1.800E-12
+ NO + O3 -> NO2 + O2 ; 3.000E-12, -1500
+ HO2 + NO -> NO2 + OH ; 3.500E-12, 250
+ NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6
+ CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775
+[oh_co] CO + OH -> HO2
+ CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200
+ CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200
+ CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300
+ CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390
+[het_no2_h2o] H2O + NO2 -> 0.50*HNO3
+ DMS + OH -> SO2 ; 1.100E-11, -240
+[oh_dms] DMS + OH -> 0.75*SO2
+[so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6
+[aq_so2_h2o2] H2O2 + SO2 -> SO4
+[aq_so2_o3] O3 + SO2 -> SO4
+ End reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, SO2
+ End heterogeneous
+
+ Ext forcing
+ NO2, CO
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+ Spatial Dimensions
+ Longitude points = 128
+ Latitude points = 64
+ Vertical points = 66
+ End Spatial Dimensions
+
+ Numerical Control
+ Implicit Iterations = 11
+ End Numerical Control
+
+ Surface Flux
+
+ End Surface Flux
+
+ Surface Deposition
+ O3, OH, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2, CH3OOH
+ SO4
+ End Surface Deposition
+
+ Version Options
+ machine = ibm
+ model = cam
+ model_architecture = SCALAR
+ architecture = hybrid
+* vec_ftns = on
+ namemod = on
+ End Version Options
+
+ Outputs
+ File
+ Transported Species = avrg
+ All
+ End Transported Species
+ Surface Flux = avrg
+
+ End Surface Flux
+ Deposition velocity = avrg
+ O3, OH, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2, CH3OOH
+ SO4
+ End Deposition velocity
+ External Forcing = avrg
+
+ End External Forcing
+ End File
+ End Outputs
+
+ End Simulation Parameters
+
+ENDSIM
diff --git a/chem_proc/inputs/modal_aerosols_3mode.in b/chem_proc/inputs/modal_aerosols_3mode.in
new file mode 100644
index 0000000000..a8d45c0bfe
--- /dev/null
+++ b/chem_proc/inputs/modal_aerosols_3mode.in
@@ -0,0 +1,83 @@
+ SPECIES
+
+ Solution
+ H2O2, H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C
+ so4_a1 -> NH4HSO4
+ pom_a1 -> C, soa_a1 -> C, bc_a1 -> C
+ dst_a1 -> AlSiO5, ncl_a1 -> NaCl
+ num_a1 -> H
+ so4_a2 -> NH4HSO4
+ soa_a2 -> C, ncl_a2 -> NaCl
+ num_a2 -> H
+ dst_a3 -> AlSiO5, ncl_a3 -> NaCl
+ so4_a3 -> NH4HSO4
+ num_a3 -> H
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, O3, OH, NO3, HO2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ H2O2, H2SO4, SO2, DMS, SOAG
+ so4_a1, pom_a1
+ soa_a1, bc_a1, dst_a1, ncl_a1
+ num_a1
+ so4_a2, soa_a2, ncl_a2, num_a2
+ dst_a3, ncl_a3, so4_a3, num_a3
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jh2o2] H2O2 + hv ->
+ End Photolysis
+
+ Reactions
+ [usr_HO2_HO2] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ [usr_SO2_OH] SO2 + OH -> H2SO4
+ DMS + OH -> SO2 ; 9.6e-12, -234.
+ [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ End Reactions
+
+ Heterogeneous
+ H2O2, SO2
+ End Heterogeneous
+
+ Ext Forcing
+ SO2 <- dataset
+ so4_a1 <- dataset
+ so4_a2 <- dataset
+ pom_a1 <- dataset
+ bc_a1 <- dataset
+ num_a1 <- dataset
+ num_a2 <- dataset
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
diff --git a/chem_proc/inputs/modal_aerosols_3mode_aerocom.in b/chem_proc/inputs/modal_aerosols_3mode_aerocom.in
new file mode 100644
index 0000000000..369746f634
--- /dev/null
+++ b/chem_proc/inputs/modal_aerosols_3mode_aerocom.in
@@ -0,0 +1,81 @@
+ SPECIES
+
+ Solution
+ H2O2, H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C
+ so4_a1 -> NH4HSO4
+ pom_a1 -> C, soa_a1 -> C, bc_a1 -> C
+ dst_a1 -> AlSiO5, ncl_a1 -> NaCl
+ num_a1 -> H
+ so4_a2 -> NH4HSO4
+ soa_a2 -> C, ncl_a2 -> NaCl
+ num_a2 -> H
+ dst_a3 -> AlSiO5, ncl_a3 -> NaCl
+ so4_a3 -> NH4HSO4
+ num_a3 -> H
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, O3, OH, NO3, HO2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ H2O2, H2SO4, SO2, DMS, SOAG
+ so4_a1, pom_a1
+ soa_a1, bc_a1, dst_a1, ncl_a1
+ num_a1
+ so4_a2, soa_a2, ncl_a2, num_a2
+ dst_a3, ncl_a3, so4_a3, num_a3
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jh2o2] H2O2 + hv ->
+ End Photolysis
+
+ Reactions
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ [usr23] SO2 + OH -> H2SO4
+ DMS + OH -> SO2 ; 9.6e-12, -234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ End Reactions
+
+ Heterogeneous
+ H2O2, SO2
+ End Heterogeneous
+
+ Ext Forcing
+ SO2 <- dataset
+ so4_a1 <- dataset
+ so4_a2 <- dataset
+ num_a1 <- dataset
+ num_a2 <- dataset
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
diff --git a/chem_proc/inputs/modal_aerosols_7mode.in b/chem_proc/inputs/modal_aerosols_7mode.in
new file mode 100644
index 0000000000..50fa66c36d
--- /dev/null
+++ b/chem_proc/inputs/modal_aerosols_7mode.in
@@ -0,0 +1,108 @@
+ SPECIES
+
+ Solution
+ H2O2, H2SO4, SO2, DMS -> CH3SCH3, NH3,
+ SOAG -> C
+ so4_a1 -> SO4,
+ nh4_a1 -> NH4
+ pom_a1 -> C,
+ soa_a1 -> C,
+ bc_a1 -> C,
+ ncl_a1 -> NaCl
+ num_a1 -> H
+ so4_a2 -> SO4,
+ nh4_a2 -> NH4
+ soa_a2 -> C,
+ ncl_a2 -> NaCl
+ num_a2 -> H
+ pom_a3 -> C,
+ bc_a3 -> C
+ num_a3 -> H
+ ncl_a4 -> NaCl,
+ so4_a4 -> SO4
+ nh4_a4 -> NH4,
+ num_a4 -> H
+ dst_a5 -> AlSiO5,
+ so4_a5 -> SO4
+ nh4_a5 -> NH4,
+ num_a5 -> H
+ ncl_a6 -> NaCl,
+ so4_a6 -> SO4
+ nh4_a6 -> NH4,
+ num_a6 -> H
+ dst_a7 -> AlSiO5,
+ so4_a7 -> SO4
+ nh4_a7 -> NH4,
+ num_a7 -> H
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, O3, OH, NO3, HO2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ H2O2, H2SO4, SO2, DMS, NH3, SOAG
+ so4_a1, nh4_a1, pom_a1
+ soa_a1, bc_a1, ncl_a1, num_a1
+ so4_a2, nh4_a2, soa_a2, ncl_a2
+ num_a2
+ pom_a3, bc_a3, num_a3
+ ncl_a4, so4_a4, nh4_a4, num_a4
+ dst_a5, so4_a5, nh4_a5, num_a5
+ ncl_a6, so4_a6, nh4_a6, num_a6
+ dst_a7, so4_a7, nh4_a7, num_a7
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jh2o2] H2O2 + hv ->
+ End Photolysis
+
+ Reactions
+ [usr_HO2_HO2] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ [usr_SO2_OH] SO2 + OH -> H2SO4
+ DMS + OH -> SO2 ; 9.6e-12, -234.
+ [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ End Reactions
+
+ Heterogeneous
+ H2O2, SO2
+ End Heterogeneous
+
+ Ext Forcing
+ SO2 <- dataset
+ so4_a1 <- dataset
+ so4_a2 <- dataset
+ num_a1 <- dataset
+ num_a2 <- dataset
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
diff --git a/chem_proc/inputs/prog_carbon_sulfate.inp b/chem_proc/inputs/prog_carbon_sulfate.inp
new file mode 100644
index 0000000000..34283bc489
--- /dev/null
+++ b/chem_proc/inputs/prog_carbon_sulfate.inp
@@ -0,0 +1,78 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_fixed_oxidants.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = prog_carbon_sulfate.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+End Comments
+
+ SPECIES
+
+ Solution
+ H2O2, SO2, SO4, DMS -> CH3SCH3
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ O3, OH, NO3, HO2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ H2O2, SO2, SO4, DMS
+ CB1, CB2, OC1, OC2
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ End Photolysis
+
+ Reactions
+ CB1 -> CB2 ; 1.006e-05
+ OC1 -> OC2 ; 1.006e-05
+ End Reactions
+
+ Heterogeneous
+ H2O2, SO2
+ End Heterogeneous
+
+ Ext Forcing
+ SO2 <- dataset
+ SO4 <- dataset
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/super_fast_LLNL.in b/chem_proc/inputs/super_fast_LLNL.in
new file mode 100644
index 0000000000..5ac9619bc3
--- /dev/null
+++ b/chem_proc/inputs/super_fast_LLNL.in
@@ -0,0 +1,88 @@
+ SPECIES
+
+ Solution
+ O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH4, CH2O, CH3O2
+ CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S,
+ SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CO, CH4
+ End explicit
+ Implicit
+ O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH
+ DMS, SO2, SO4
+ End implicit
+ END Solution classes
+
+ CHEMISTRY
+ Photolysis
+*[jo1d] O3 + hv -> 2*OH
+[jo1d->,jo3_a] O3 + hv -> 2*OH
+[jh2o2] H2O2 + hv -> 2*OH
+[jno2] NO2 + hv -> NO + O3
+[jch2o_a] CH2O + hv -> CO + 2*HO2
+[jch2o_b] CH2O + hv -> CO
+[jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ End Photolysis
+
+ Reactions
+ O3 + OH -> HO2 + O2 ; 1.700E-12, -940
+[out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490
+ HO2 + OH -> H2O + O2 ; 4.800E-11, 250
+[ho2_ho2] HO2 + HO2 -> H2O2 + O2
+ H2O2 + OH -> H2O + HO2 ; 1.800E-12
+ NO + O3 -> NO2 + O2 ; 3.000E-12, -1500
+ HO2 + NO -> NO2 + OH ; 3.500E-12, 250
+ NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6
+ CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775
+[oh_co] CO + OH -> HO2
+ CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200
+ CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200
+ CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300
+ CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390
+[het_no2_h2o] H2O + NO2 -> 0.50*HNO3
+ DMS + OH -> SO2 ; 1.100E-11, -240
+[oh_dms] DMS + OH -> 0.75*SO2
+[so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6
+[aq_so2_h2o2] H2O2 + SO2 -> SO4
+[aq_so2_o3] O3 + SO2 -> SO4
+ End reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, SO2
+ End heterogeneous
+
+ Ext forcing
+ NO2, CO
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ End Simulation Parameters
diff --git a/chem_proc/inputs/super_fast_LLNL.lut.fixed_ch4.in b/chem_proc/inputs/super_fast_LLNL.lut.fixed_ch4.in
new file mode 100644
index 0000000000..ce6d8b7e70
--- /dev/null
+++ b/chem_proc/inputs/super_fast_LLNL.lut.fixed_ch4.in
@@ -0,0 +1,89 @@
+ SPECIES
+
+ Solution
+ O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2
+ CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S,
+ SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, CH4
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CO
+ End explicit
+ Implicit
+ O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH
+ DMS, SO2, SO4
+ End implicit
+ END Solution classes
+
+ CHEMISTRY
+ Photolysis
+[jo1d->,jo3_a] O3 + hv -> 2*OH
+[jh2o2] H2O2 + hv -> 2*OH
+[jno2] NO2 + hv -> NO + O3
+[jch2o_a] CH2O + hv -> CO + 2*HO2
+[jch2o_b] CH2O + hv -> CO
+[jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ End Photolysis
+
+ Reactions
+ O3 + OH -> HO2 + O2 ; 1.700E-12, -940
+[out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490
+ HO2 + OH -> H2O + O2 ; 4.800E-11, 250
+[ho2_ho2] HO2 + HO2 -> H2O2 + O2
+ H2O2 + OH -> H2O + HO2 ; 1.800E-12
+ NO + O3 -> NO2 + O2 ; 3.000E-12, -1500
+ HO2 + NO -> NO2 + OH ; 3.500E-12, 250
+ NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6
+ CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775
+[oh_co] CO + OH -> HO2
+ CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200
+ CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200
+ CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300
+ CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390
+[het_no2_h2o] H2O + NO2 -> 0.50*HNO3
+ DMS + OH -> SO2 ; 1.100E-11, -240
+[oh_dms] DMS + OH -> 0.75*SO2
+[so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6
+[aq_so2_h2o2] H2O2 + SO2 -> SO4
+[aq_so2_o3] O3 + SO2 -> SO4
+ End reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, SO2
+ End heterogeneous
+
+ Ext forcing
+ NO2, CO
+ SO2 <- dataset
+ SO4 <- dataset
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ End Simulation Parameters
diff --git a/chem_proc/inputs/super_fast_LLNL.lut.fixed_ch4.isoprene+O3.in b/chem_proc/inputs/super_fast_LLNL.lut.fixed_ch4.isoprene+O3.in
new file mode 100644
index 0000000000..cf918d822b
--- /dev/null
+++ b/chem_proc/inputs/super_fast_LLNL.lut.fixed_ch4.isoprene+O3.in
@@ -0,0 +1,92 @@
+ SPECIES
+
+ Solution
+ O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2
+ CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S,
+ SO4, ISOP -> C5H8
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, CH4
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CO
+ End explicit
+ Implicit
+ O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH
+ DMS, SO2, SO4, ISOP
+ End implicit
+ END Solution classes
+
+ CHEMISTRY
+ Photolysis
+[jo1d->,jo3_a] O3 + hv -> 2*OH
+[jh2o2] H2O2 + hv -> 2*OH
+[jno2] NO2 + hv -> NO + O3
+[jch2o_a] CH2O + hv -> CO + 2*HO2
+[jch2o_b] CH2O + hv -> CO
+[jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ End Photolysis
+
+ Reactions
+ O3 + OH -> HO2 + O2 ; 1.700E-12, -940
+[out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490
+ HO2 + OH -> H2O + O2 ; 4.800E-11, 250
+[usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2
+ H2O2 + OH -> H2O + HO2 ; 1.800E-12
+ NO + O3 -> NO2 + O2 ; 3.000E-12, -1500
+ HO2 + NO -> NO2 + OH ; 3.500E-12, 250
+ NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6
+ CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775
+[usr_oh_co] CO + OH -> HO2
+ CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200
+ CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200
+ CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300
+ CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390
+[het_no2_h2o] H2O + NO2 -> 0.50*HNO3
+ DMS + OH -> SO2 ; 1.100E-11, -240
+[usr_oh_dms] DMS + OH -> 0.75*SO2
+[tag_so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6
+[aq_so2_h2o2] H2O2 + SO2 -> SO4
+[aq_so2_o3] O3 + SO2 -> SO4
+[isop_oh] ISOP + OH -> 2*CH3O2 -1.5*OH ; 2.700E-11, 390
+[isop_o3] ISOP + O3 -> 0.87*CH2O +1.86*CH3O2 +0.06*HO2 +0.05*CO ; 5.590E-15, -1814
+ End reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, SO2
+ End heterogeneous
+
+ Ext forcing
+ NO2 <- dataset
+ CO <- dataset
+ SO2 <- dataset
+ SO4 <- dataset
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ End Simulation Parameters
diff --git a/chem_proc/inputs/super_fast_LLNL.lut.in b/chem_proc/inputs/super_fast_LLNL.lut.in
new file mode 100644
index 0000000000..3dcbc44035
--- /dev/null
+++ b/chem_proc/inputs/super_fast_LLNL.lut.in
@@ -0,0 +1,87 @@
+ SPECIES
+
+ Solution
+ O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH4, CH2O, CH3O2
+ CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S,
+ SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CO, CH4
+ End explicit
+ Implicit
+ O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH
+ DMS, SO2, SO4
+ End implicit
+ END Solution classes
+
+ CHEMISTRY
+ Photolysis
+[jo1d->,jo3_a] O3 + hv -> 2*OH
+[jh2o2] H2O2 + hv -> 2*OH
+[jno2] NO2 + hv -> NO + O3
+[jch2o_a] CH2O + hv -> CO + 2*HO2
+[jch2o_b] CH2O + hv -> CO
+[jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ End Photolysis
+
+ Reactions
+ O3 + OH -> HO2 + O2 ; 1.700E-12, -940
+[out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490
+ HO2 + OH -> H2O + O2 ; 4.800E-11, 250
+[usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2
+ H2O2 + OH -> H2O + HO2 ; 1.800E-12
+ NO + O3 -> NO2 + O2 ; 3.000E-12, -1500
+ HO2 + NO -> NO2 + OH ; 3.500E-12, 250
+ NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6
+ CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775
+[usr_oh_co] CO + OH -> HO2
+ CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200
+ CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200
+ CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300
+ CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390
+[het_no2_h2o] H2O + NO2 -> 0.50*HNO3
+ DMS + OH -> SO2 ; 1.100E-11, -240
+[usr_oh_dms] DMS + OH -> 0.75*SO2
+[tag_so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6
+[aq_so2_h2o2] H2O2 + SO2 -> SO4
+[aq_so2_o3] O3 + SO2 -> SO4
+ End reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, SO2
+ End heterogeneous
+
+ Ext forcing
+ NO2, CO
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ End Simulation Parameters
diff --git a/chem_proc/inputs/super_fast_LLNL.tuv.in b/chem_proc/inputs/super_fast_LLNL.tuv.in
new file mode 100644
index 0000000000..852dcfe1cc
--- /dev/null
+++ b/chem_proc/inputs/super_fast_LLNL.tuv.in
@@ -0,0 +1,87 @@
+ SPECIES
+
+ Solution
+ O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH4, CH2O, CH3O2
+ CH3OOH -> CH4O2, DMS -> C2H6S, SO2 -> O2S,
+ SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CO, CH4
+ End explicit
+ Implicit
+ O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH
+ DMS, SO2, SO4
+ End implicit
+ END Solution classes
+
+ CHEMISTRY
+ Photolysis
+[jo1d] O3 + hv -> 2*OH
+[jh2o2] H2O2 + hv -> 2*OH
+[jno2] NO2 + hv -> NO + O3
+[jch2o_a] CH2O + hv -> CO + 2*HO2
+[jch2o_b] CH2O + hv -> CO
+[jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ End Photolysis
+
+ Reactions
+ O3 + OH -> HO2 + O2 ; 1.700E-12, -940
+[out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490
+ HO2 + OH -> H2O + O2 ; 4.800E-11, 250
+[usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2
+ H2O2 + OH -> H2O + HO2 ; 1.800E-12
+ NO + O3 -> NO2 + O2 ; 3.000E-12, -1500
+ HO2 + NO -> NO2 + OH ; 3.500E-12, 250
+ NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6
+ CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775
+[usr_oh_co] CO + OH -> HO2
+ CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200
+ CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200
+ CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300
+ CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390
+[het_no2_h2o] H2O + NO2 -> 0.50*HNO3
+ DMS + OH -> SO2 ; 1.100E-11, -240
+[usr_oh_dms] DMS + OH -> 0.75*SO2
+[tag_so2_oh_m] OH + SO2 + M -> SO4 ; 3.300E-31, 4.30, 1.600E-12, 0.00, 0.6
+[aq_so2_h2o2] H2O2 + SO2 -> SO4
+[aq_so2_o3] O3 + SO2 -> SO4
+ End reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, SO2
+ End heterogeneous
+
+ Ext forcing
+ NO2, CO
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ End Simulation Parameters
diff --git a/chem_proc/inputs/super_fast_modal_3modes.in b/chem_proc/inputs/super_fast_modal_3modes.in
new file mode 100644
index 0000000000..1538adb177
--- /dev/null
+++ b/chem_proc/inputs/super_fast_modal_3modes.in
@@ -0,0 +1,121 @@
+ SPECIES
+
+ Solution
+ O3, OH -> HO, HO2, H2O2, NO, NO2, HNO3, CO, CH2O, CH3O2
+ CH3OOH -> CH4O2, ISOP -> C5H8
+ H2SO4, SO2, DMS -> CH3SCH3, SOAG -> C
+ so4_a1 -> NH4HSO4
+ pom_a1 -> C
+ soa_a1 -> C
+ bc_a1 -> C
+ dst_a1 -> AlSiO5
+ ncl_a1 -> NaCl
+ num_a1 -> H
+ so4_a2 -> NH4HSO4
+ soa_a2 -> C
+ ncl_a2 -> NaCl
+ num_a2 -> H
+ dst_a3 -> AlSiO5
+ ncl_a3 -> NaCl
+ so4_a3 -> NH4HSO4
+ num_a3 -> H
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O, CH4
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CO, SOAG
+ so4_a1, pom_a1, soa_a1, bc_a1, dst_a1, ncl_a1, num_a1
+ so4_a2, soa_a2, ncl_a2, num_a2
+ dst_a3, ncl_a3, so4_a3, num_a3
+ End explicit
+ Implicit
+ O3, OH, HO2, H2O2, NO, NO2, HNO3, CH2O, CH3O2, CH3OOH
+ DMS, SO2, H2SO4, ISOP
+ End implicit
+ END Solution classes
+
+ CHEMISTRY
+ Photolysis
+*[jo1d] O3 + hv -> 2*OH
+[jo1d->,jo3_a] O3 + hv -> 2*OH
+[jh2o2] H2O2 + hv -> 2*OH
+[jno2] NO2 + hv -> NO + O3
+[jch2o_a] CH2O + hv -> CO + 2*HO2
+[jch2o_b] CH2O + hv -> CO
+[jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ End Photolysis
+
+ Reactions
+ O3 + OH -> HO2 + O2 ; 1.700E-12, -940
+[out6] HO2 + O3 -> 2*O2 + OH ; 1.000E-14, -490
+ HO2 + OH -> H2O + O2 ; 4.800E-11, 250
+*[ho2_ho2] HO2 + HO2 -> H2O2 + O2
+ [usr_HO2_HO2] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 1.800E-12
+ NO + O3 -> NO2 + O2 ; 3.000E-12, -1500
+ HO2 + NO -> NO2 + OH ; 3.500E-12, 250
+ NO2 + OH + M -> HNO3 ; 1.800E-30, 3.00, 2.800E-11, 0.00, 0.6
+ CH4 + OH -> CH3O2 + H2O ; 2.450E-12, -1775
+[usr_oh_co] CO + OH -> HO2
+ CH2O + OH -> CO + H2O + HO2 ; 5.500E-12, 125
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.100E-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 2.700E-12, 200
+ CH3OOH + OH -> CH2O + H2O + OH ; 1.100E-12, 200
+ CH3O2 + NO -> CH2O + HO2 + NO2 ; 2.800E-12, 300
+ CH3O2 + CH3O2 -> 2*CH2O + 0.80*HO2 ; 9.500E-14, 390
+[het_no2_h2o] H2O + NO2 -> 0.50*HNO3
+ DMS + OH -> SO2 ; 1.100E-11, -240
+*[oh_dms] DMS + OH -> 0.75*SO2
+[usr_oh_dms] DMS + OH -> 0.75*SO2
+*
+* was labeled usr23 in X. Liu's version
+*
+[usr_SO2_OH] SO2 + OH -> H2SO4
+*
+[tag_isop_oh] ISOP + OH -> 2*CH3O2 -1.5*OH ; 2.700E-11, 390
+[tag_isop_o3] ISOP + O3 -> 0.87*CH2O +1.86*CH3O2 +0.06*HO2 +0.05*CO ; 5.590E-15, -1814
+*
+ End reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, SO2
+ End heterogeneous
+
+ Ext forcing
+ NO2 <- dataset
+ CO <- dataset
+ SO2 <- dataset
+ so4_a1 <- dataset
+ so4_a2 <- dataset
+ pom_a1 <- dataset
+ bc_a1 <- dataset
+ num_a1 <- dataset
+ num_a2 <- dataset
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ End Simulation Parameters
diff --git a/chem_proc/inputs/trop_mozart_mech.in b/chem_proc/inputs/trop_mozart_mech.in
new file mode 100644
index 0000000000..069b9055c3
--- /dev/null
+++ b/chem_proc/inputs/trop_mozart_mech.in
@@ -0,0 +1,325 @@
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh] XOOH + hv -> OH
+ [jonitr] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
diff --git a/chem_proc/inputs/trop_mozart_table_tagged_mech.in b/chem_proc/inputs/trop_mozart_table_tagged_mech.in
new file mode 100644
index 0000000000..ee19829b62
--- /dev/null
+++ b/chem_proc/inputs/trop_mozart_table_tagged_mech.in
@@ -0,0 +1,328 @@
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2->,jo2_b] O2 + hv -> 2*O
+ [jo1d->,jo3_a] O3 + hv -> O1D + O2
+ [jo3p->,jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5->,jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jno3_b] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2_a] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jho2no2_b] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan->,jpan] MPAN + hv -> MCO3 + NO2
+ [jmacr_a] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmacr_b] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh->,jch3ooh] XOOH + hv -> OH
+ [jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
diff --git a/chem_proc/inputs/trop_mozart_xactive_tagged_mech.in b/chem_proc/inputs/trop_mozart_xactive_tagged_mech.in
new file mode 100644
index 0000000000..8b138a54c4
--- /dev/null
+++ b/chem_proc/inputs/trop_mozart_xactive_tagged_mech.in
@@ -0,0 +1,328 @@
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, N2O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, H2, OH, HO2, H2O2,
+ CH4,CO, CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHCHOH, XOOH -> HOCH2COOHCH3CHCHOH
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O3, TOLOOH -> C7H10O3
+ XOH -> C7H10O4, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, SO4, DMS -> CH3SCH3, NH3, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ Rn, Pb, O3S -> O3, O3INERT -> O3, O3RAD -> O3, SYNOZ -> O3
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ NH4, H2SO4
+ End Solution
+
+ Fixed
+ M, N2, O2, H2O
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ CH4, N2O, CO, Rn, Pb, H2, O3INERT, O3S, SYNOZ, O3RAD
+ End Explicit
+ Implicit
+ O3, O1D, O, NO, NO2, NO3, HNO3, HO2NO2, N2O5, OH, HO2, H2O2
+ CH3O2, CH3OOH, CH2O, CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ CB1, CB2, SO2, SO4, DMS, NH3, NH4NO3, NH4, H2SO4
+ OC1, OC2, SSLT01, SSLT02, SSLT03, SSLT04, SOA
+ DST01, DST02, DST03, DST04
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2] O2 + hv -> 2*O
+ [jo1d] O3 + hv -> O1D + O2
+ [jo3p] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5] N2O5 + hv -> NO2 + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3->,1.1236*jno3] NO3 + hv -> .89*NO2 + .11*NO + .89*O3
+ [jho2no2] HO2NO2 + hv -> .33*OH + .33*NO3 + .66*NO2 + .66*HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + HO2 + OH
+ [jch2o_a] CH2O + hv -> CO + 2 * HO2
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jch3cho_a] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jch3cho_b] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jch3cho_c] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan->,jpan] MPAN + hv -> MCO3 + NO2
+ [jmacr] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh->,jch3ooh] XOOH + hv -> OH
+ [jonitr->,userdefined] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac->,2.*jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+ End Photolysis
+
+ Reactions
+ [usr1] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8e-12, -2060
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.1e-11, 115
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.2e-11, 70
+ [ox_l1] O1D + H2O -> 2*OH ; 2.2e-10
+ H2 + O1D -> HO2 + OH ; 1.1e-10
+ H2 + OH -> H2O + HO2 ; 5.5e-12, -2000
+ O + OH -> HO2 + O2 ; 2.2e-11, 120
+ HO2 + O -> OH + O2 ; 3e-11, 200
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr9] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1., 2.6e-11,0., .6
+ N2O + O1D -> 2*NO ; 6.7e-11
+ N2O + O1D -> N2 + O2 ; 4.9e-11
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ NO3 + HO2 -> OH + NO2 ; 2.3e-12, 170.
+ [usr2] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3] N2O5 + M -> NO2 + NO3 + M
+ [usr4] NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr5] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ [usr6] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr7] HO2NO2 + M -> HO2 + NO2 + M
+ [usr16] N2O5 -> 2 * HNO3
+ [usr17] NO3 -> HNO3
+ [usr17a] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH4 + O1D -> .75*CH3O2 + .75*OH + .25*CH2O + .4*HO2 + .05*H2 ; 1.5e-10
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.e-13,-424
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.9e-14,706
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O +HO2 ; 9.e-12
+ [usr8] CO + OH -> CO2 + HO2
+ [usr13] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.e-28,.8, 8.8e-12,0., .6
+ [ox_l6] C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630
+ + .12 * OH + .25 * CH3COOH
+ EO2 + NO -> EO + NO2 ; 4.2e-12,180
+ EO + O2 -> GLYALD + HO2 ; 1.e-14
+ EO -> 2 * CH2O + HO2 ; 1.6e11,-4150
+
+ C2H6 + OH -> C2H5O2 + H2O ; 8.7e-12, -1070
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.6e-12, 365
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.5e-13, 700
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.8e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.8e-12, 200
+ [usr10] C3H6 + OH + M -> PO2 + M ; 8.e-27,3.5, 3.e-11,0, .5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH ; 6.5e-15, -1900
+ + .08*CH4 + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.6e-13,-1156
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.2e-12, 180
+ PO2 + HO2 -> POOH + O2 ; 7.5e-13, 700
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.8e-12, 200
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.6e-12, 270
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.4e-12, -1900
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.1e-12, 270
+ [usr11] CH3CO3 + NO2 + M -> PAN + M ; 8.5e-29,6.5, 1.1e-11,1., .6
+ CH3CO3 + HO2 -> .75*CH3COOOH + .25*CH3COOH + .25*O3 ; 4.3e-13, 1040
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 + .9*CO2 + .1*CH3COOH ; 2.0e-12,500
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1e-12
+ [usr12] PAN + M -> CH3CO3 + NO2 + M
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.5e-12, 500
+ C3H8 + OH -> C3H7O2 + H2O ; 1.0e-11, -660
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.2e-12, 180
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.5e-13, 700
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.8e-12, 200
+ [usr22] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.9e-12, 300
+ RO2 + HO2 -> ROOH + O2 ; 8.6e-13, 700
+ RO2 + CH3O2 -> .3*CH3CO3 + .8*CH2O + .3*HO2 + .2*HYAC ; 2.0e-12, 500
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.8e-12, 200
+ BIGENE + OH -> ENEO2 ; 5.4e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.2e-12, 180
+ [soa5] BIGALK + OH -> ALKO2 ; 3.5e-12
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 ; 4.2e-12, 180
+ + .75*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.5e-13, 700
+ ALKOOH + OH -> ALKO2 ; 3.8e-12, 200
+ ONIT + OH -> NO2 + CH3COCHO ; 6.8e-13
+ MEK + OH -> MEKO2 ; 2.3e-12, -170
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.2e-12, 180
+ MEKO2 + HO2 -> MEKOOH ; 7.5e-13, 700
+ MEKOOH + OH -> MEKO2 ; 3.8e-12, 200
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.7e-12, 352
+ CRESOL + OH -> XOH ; 3.e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.e-11
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.2e-12, 180
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.5e-13, 700
+ TOLOOH + OH -> TOLO2 ; 3.8e-12, 200
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.1e-11
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .55 * CH2O ; 2.2e-12, 180
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.4e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.e-13, 700
+ ISOPOOH + OH -> .5 * XO2 + .5 * ISOPO2 ; 3.8e-12, 200
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.e-13,400
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O + CO2 ; 1.4e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ MVK + OH -> MACRO2 ; 4.13e-12, 452
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH + .2 * O3 ; 7.52e-16,-1521
+ + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO + .2 * O3 ; 4.4e-15, -2500
+ + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.7e-12, 360
+ + .25 * CH3COCHO + .53 * CH3CO3 + .53 * GLYALD
+ + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.3e-13,360
+ MACRO2 + NO3 -> NO2 + .47*HO2 + .25*CH2O + .25*CH3COCHO ; 2.4e-12
+ + .22*CO + .53*GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.e-13, 700
+ MACRO2 + CH3O2 -> .73*HO2 + .88*CH2O + .11*CO + .24*CH3COCHO ; 5.e-13,400
+ + .26*GLYALD + .26*CH3CO3 + .25*CH3OH + .23*HYAC
+ MACRO2 + CH3CO3 -> .25*CH3COCHO + CH3O2 + .22*CO + .47*HO2 + CO2 ; 1.4e-11
+ + .53*GLYALD + .22*HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.3e-11, 200
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 + CO2 ; 5.3e-12, 360
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 + CO2 ; 5.e-12
+ MCO3 + HO2 -> .25*O3 + .25*CH3COOH + .75*CH3COOOH + .75*O2 ; 4.30e-13, 1040
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.0e-12,500
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.6e-12, 530
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.3e-12, 530
+ [usr14] MCO3 + NO2 + M -> MPAN + M
+ [usr15] MPAN + M -> MCO3 + NO2 + M
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.e-13
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12,-446
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O + .167 * MACR ; 2.7e-12, 360
+ + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR + .039 * MVK ; 2.4e-12
+ + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> .206 * NO2 + .794 * HO2 + .008 * CH2O ; 8.e-13, 700
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.4e-13,830
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.4e-12, -1860
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.5e-11
+ ONITR + NO3 -> HYDRALD + NO2 + HO2 ; 1.4e-12, -1860
+ HYDRALD + OH -> XO2 ; 1.86e-11,175
+ [ox_p11] XO2 + NO -> NO2 + 1.5*HO2 + CO ; 2.7e-12, 360
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + 1.5*HO2 + CO + .25*HYAC ; 2.4e-12
+ + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.e-13, 700
+ XO2 + CH3O2 -> .3 * CH3OH + HO2 + .7 * CH2O ; 5.e-13,400
+ + .4 * CO + .1 * HYAC
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> CO + CH3O2 + 1.5 * HO2 + CO2 ; 1.3e-12,640
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190
+ [usr21] XOOH + OH -> H2O + OH
+ CH3OH + OH -> HO2 + CH2O ; 7.3e-12,-620
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.9e-12,-230
+ MPAN + OH -> .5*HYAC + .5*NO3 + .5*CH2O + .5*HO2 + .5*CO2 ; 8.e-27,3.5,3.e-11,0.,.5
+ PAN + OH -> CH2O + NO3 + CO2 ; 4.e-14
+ HYAC + OH -> CH3COCHO + HO2 ; 3.e-12
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.e-11
+ Rn -> Pb ; 2.1e-6
+ CB1 -> CB2 ; 9.64506e-06
+ [usr23] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.6e-12,-234.
+ [usr24] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ NH3 + OH -> H2O ; 1.7e-12, -710.
+ OC1 -> OC2 ; 9.64506e-06
+ [usr26] HO2 -> 0.5*H2O2
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, POOH, CH3COOOH, HO2NO2, ONIT, MVK, MACR
+ C2H5OOH, C3H7OOH, ROOH, CH3COCHO, Pb, MACROOH, XOOH, ONITR, ISOPOOH
+ CH3OH, C2H5OH, GLYALD, HYAC, HYDRALD, CH3CHO, ISOPNO3
+ ALKOOH, MEKOOH, TOLOOH, TERPOOH, CH3COOH
+ SO2, NH4, NH3, H2SO4
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, SYNOZ
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
diff --git a/chem_proc/inputs/trop_strat_bam_v1.inp b/chem_proc/inputs/trop_strat_bam_v1.inp
new file mode 100644
index 0000000000..0fecc55dcf
--- /dev/null
+++ b/chem_proc/inputs/trop_strat_bam_v1.inp
@@ -0,0 +1,604 @@
+BEGSIM
+output_unit_number = 7
+output_file = trop_strat_bam_v1.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = trop_strat_bam_v1.dat
+
+Comments
+ " MOZART-4 mechanism (as in Emmons et al., 2010)"
+ " plus: HCN, CH3CN, C2H2, HCOOH, HOCH2OO"
+ " for use with photolysis lookup table"
+ " Nov 8, 2010: RO2+CH3O2 rate corrected"
+ " Jan 19, 2010: stratospheric species added (WACCM4)"
+ " April 26, 2011: sync 133spc to trop_mozart and JPL06"
+End Comments
+
+SPECIES
+
+ Solution
+ O3, O, O1D -> O
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH3OH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CLY, BRY
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, H2O
+ C2H5OH, C2H4, EO -> HOCH2CH2O, EO2 -> HOCH2CH2O2, CH3COOH, GLYALD -> HOCH2CHO
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH
+ CH3COCH3, RO2 -> CH3COCH2O2, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, ENEO2 -> C4H9O3
+ MEK -> C4H8O, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ BIGALK -> C5H12, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2
+ ISOP -> C5H8, ISOPO2 -> HOCH2COOCH3CHCH2, ISOPOOH -> HOCH2COOHCH3CHCH2
+ MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH
+ MCO3 -> CH2CCH3CO3, HYDRALD -> HOCH2CCH3CHCHO, HYAC -> CH3COCH2OH
+ CH3COCHO, XO2 -> HOCH2COOCH3CHOHCHO, XOOH -> HOCH2COOHCH3CHOHCHO
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O5, TOLOOH -> C7H10O5
+ XOH -> C7H10O6, BIGALD -> C5H6O2, GLYOXAL -> C2H2O2
+ PAN -> CH3CO3NO2, ONIT -> CH3COCH2ONO2, MPAN -> CH2CCH3CO3NO2
+ ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ CB1 -> C, CB2 -> C, OC1 -> C, OC2 -> C, SOA -> C12
+ SO2, DMS -> CH3SCH3, SO4, NH3, NH4, NH4NO3
+ SSLT01 -> NaCl, SSLT02 -> NaCl, SSLT03 -> NaCl, SSLT04 -> NaCl
+ DST01 -> AlSiO5, DST02 -> AlSiO5, DST03 -> AlSiO5, DST04 -> AlSiO5
+ Rn, Pb
+ CO2, HCN, CH3CN, C2H2, HCOOH, HOCH2OO
+ End Solution
+
+ Fixed
+ M, N2, O2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+End SPECIES
+
+Solution Classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2, CLY, BRY
+ Rn, Pb
+ End Explicit
+ Implicit
+ O3, O, O1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, HCN, CH3CN, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2
+ CH3OH, C2H5OH
+ C2H4, EO, EO2, CH3COOH, GLYALD
+ C2H6, C2H5O2, C2H5OOH, CH3CHO, CH3CO3, CH3COOOH
+ C3H6, C3H8, C3H7O2, C3H7OOH, PO2, POOH, CH3COCH3, RO2, ROOH
+ BIGENE, ENEO2, BIGALK, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH
+ ISOP, ISOPO2, ISOPOOH, MVK, MACR, MACRO2, MACROOH, MCO3
+ HYDRALD, HYAC, CH3COCHO, XO2, XOOH
+ C10H16, TERPO2, TERPOOH
+ TOLUENE, CRESOL, TOLO2, TOLOOH, XOH, BIGALD, GLYOXAL
+ PAN, ONIT, MPAN, ISOPNO3, ONITR
+ SO2, DMS, SO4, NH3, NH4, NH4NO3, SOA
+ CB1, CB2, OC1, OC2
+ C2H2, HCOOH, HOCH2OO
+ SSLT01, SSLT02, SSLT03, SSLT04
+ DST01, DST02, DST03, DST04
+ End Implicit
+End Solution Classes
+
+CHEMISTRY
+ Photolysis
+ [jo2_b=userdefined,] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno=userdefined,] NO + hv -> N + O
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h->,.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3 + .4*CO2
+ [jmpan->,jpan] MPAN + hv -> MCO3 + NO2
+ [jmacr_a] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmacr_b] MACR -> .67*HO2 + .33*MCO3 + .67*CH2O + .67*CH3CO3 + .33*OH + .67*CO
+ [jmvk] MVK + hv -> .7*C3H6 + .7*CO + .3*CH3O2 + .3*CH3CO3
+ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> .82 * CH3COCH3 + OH + HO2
+ [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh->,jch3ooh] XOOH + hv -> OH
+ [jonitr->,jch3cho] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald->,.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL + .56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+*
+* for stratospheric chemistry
+*
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr_O_O2] O + O2 + M -> O3 + M
+ O + O3 -> 2*O2 ; 8.00e-12, -2060.
+ [usr_O_O] O + O + M -> O2 + M
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions (O1D only)
+* --------------------------------------------------------------
+ [o1d_n2] O1D + N2 -> O + N2 ; 2.10e-11, 115.
+ [o1d_o2] O1D + O2 -> O + O2 ; 3.20e-11, 70.
+ [ox_l1] O1D + H2O -> 2*OH ; 2.20e-10
+ O1D + H2 -> HO2 + OH ; 1.10e-10
+ O1D + N2O -> N2 + O2 ; 4.90e-11
+ O1D + N2O -> 2*NO ; 6.70e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.00e-11
+ O1D + CH4 -> CH2O + H2 ; 7.50e-12
+ O1D + HCN -> OH ; 7.70e-11, 100.
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 4.70e-11, 0.2, 0.6
+ H + O3 -> OH + O2 ; 1.40e-10, -470.
+ H + HO2 -> 2*OH ; 7.20e-11
+ H + HO2 -> H2 + O2 ; 6.90e-12
+ H + HO2 -> H2O + O ; 1.60e-12
+ OH + O -> H + O2 ; 2.20e-11, 120.
+ [ox_l2] OH + O3 -> HO2 + O2 ; 1.70e-12, -940.
+ OH + HO2 -> H2O + O2 ; 4.80e-11, 250.
+ OH + OH -> H2O + O ; 1.80e-12
+ OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.60e-11, 0.0, 0.6
+ OH + H2 -> H2O + H ; 2.80e-12, -1800.
+ OH + H2O2 -> H2O + HO2 ; 1.80e-12
+ OH + HCN -> HO2 ; 4.28e-33, 0.0, 9.30e-15, -4.42, 0.8
+ OH + CH3CN -> HO2 ; 7.80e-13, -1050.
+ HO2 + O -> OH + O2 ; 3.00e-11, 200.
+ [ox_l3] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490.
+ [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.40e-12, -2000.
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ N + O2 -> NO + O ; 1.50e-11, -3600.
+ N + NO -> N2 + O ; 2.10e-11, 100.
+ N + NO2 -> N2O + O ; 5.80e-12, 220.
+ NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6
+ [ox_p1] NO + HO2 -> NO2 + OH ; 3.50e-12, 250.
+ NO + O3 -> NO2 + O2 ; 3.00e-12, -1500.
+ NO2 + O -> NO + O2 ; 5.10e-12, 210.
+ NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450.
+ [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6
+ [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M
+ [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6
+ [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.50e-11, 170.
+ NO3 + O -> NO2 + O2 ; 1.00e-11
+ NO3 + OH -> HO2 + NO2 ; 2.20e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12
+ [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380.
+ [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M
+* --------------------------------------------------------------
+* C-1 Degradation (Methane, CO, CH2O and derivatives)
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775.
+ [ox_p2] CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300.
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750.
+ CH3OOH + OH -> CH3O2 + H2O ; 3.80e-12, 200.
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.00e-13, -2058.
+ CH2O + OH -> CO + H2O + H ; 5.50e-12, 125.
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.
+ CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6
+ [usr_CO_OH_b] CO + OH -> CO2 + H
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.00e-13, -424.
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.90e-14, 706.
+ CH3OH + OH -> HO2 + CH2O ; 2.90e-12, -345.
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.80e-12, 200.
+ HCOOH + OH -> HO2 + CO2 + H2O ; 4.5e-13
+ CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625.
+ HOCH2OO -> CH2O + HO2 ; 2.4e12, -7000.
+ HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265.
+ HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700.
+* --------------------------------------------------------------
+* C-2 Degradation
+*
+* EO = HOCH2CH2O
+* EO2 = HOCH2CH2O2
+* PAN = CH3CO3NO2
+* GLYALD = HOCH2CHO
+* GLYOXAL= C2H2O2
+* C2H2 = C2H2
+* --------------------------------------------------------------
+ C2H2 + OH + M -> .65*GLYOXAL + .65*OH + .35*HCOOH + .35*HO2 ; 5.5e-30, 0.0, 8.3e-13, -2.0, 0.6
+ + .35*CO + M
+ C2H6 + OH -> C2H5O2 + H2O ; 8.70e-12, -1070.
+ [tag_C2H4_OH] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.00e-28, 0.8, 8.80e-12, 0.0, 0.6
+ [ox_l6] C2H4 + O3 -> CH2O + .12*HO2 + .5*CO + .12*OH + .5*HCOOH ; 1.2e-14, -2630.
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.00e-13
+ [ox_p5] C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.60e-12, 365.
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.50e-13, 700.
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.00e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.80e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.80e-12, 200.
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.60e-12, 270.
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.40e-12, -1900.
+ [ox_p4] CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.10e-12, 270.
+ [tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 8.50e-29, 6.5, 1.10e-11, 1.0, 0.6
+ CH3CO3 + HO2 -> .75 * CH3COOOH + .25 * CH3COOH + .25 * O3 ; 4.30e-13, 1040.
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 ; 2.00e-12, 500.
+ + .9*CO2 + .1*CH3COOH
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.50e-12, 500.
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1.00e-12
+ [ox_p16] EO2 + NO -> EO + NO2 ; 4.20e-12, 180.
+ EO + O2 -> GLYALD + HO2 ; 1.00e-14
+ EO -> 2 * CH2O + HO2 ; 1.60e11, -4150.
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.00e-11
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.10e-11
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.90e-12, -230.
+ [usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M
+ PAN + OH -> CH2O + NO3 ; 4.00e-14
+* --------------------------------------------------------------
+* C-3 Degradation
+*
+* PO2 = C3H6OHO2
+* POOH = C3H6OHOOH
+* RO2 = CH3COCH2O2
+* ROOH = CH3COCH2OOH
+* HYAC = CH3COCH2OH
+* ONIT = CH3COCH2ONO2
+* --------------------------------------------------------------
+ [tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8.00e-27, 3.5, 3.00e-11, 0.0, 0.5
+ [ox_l4] C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH + .08*CH4 ; 6.50e-15, -1900.
+ + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.60e-13, -1156.
+ [ox_p9] C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.20e-12, 180.
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.50e-13, 700.
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40.
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.80e-12, 200.
+ C3H8 + OH -> C3H7O2 + H2O ; 1.00e-11, -665.
+ [ox_p3] PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.20e-12, 180.
+ PO2 + HO2 -> POOH + O2 ; 7.50e-13, 700.
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.80e-12, 200.
+ [usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O
+ [ox_p10] RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.90e-12, 300.
+ RO2 + HO2 -> ROOH + O2 ; 8.60e-13, 700.
+ RO2 + CH3O2 -> .3*CH3CO3 + .8* CH2O + .3*HO2 + .2*HYAC ; 7.10e-13, 500.
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.80e-12, 200.
+ HYAC + OH -> CH3COCHO + HO2 ; 3.00e-12
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.40e-13, 830.
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.40e-12, -1860.
+ ONIT + OH -> NO2 + CH3COCHO ; 6.80e-13
+* --------------------------------------------------------------
+* C-4 Degradation
+* BIGENE -> C4H8
+* ENEO2 = C4H9O3
+* MEK = C4H8O
+* MEKO2 = C4H7O3
+* MEKOOH = C4H8O3
+* MVK = CH2CHCOCH3
+* MACR = CH2CCH3CHO
+* MACRO2 = CH3COCHO2CH2OH
+* MACROOH = CH3COCHOOHCH2OH
+* MCO3 = CH2CCH3CO3
+* MPAN = CH2CCH3CO3NO2
+* --------------------------------------------------------------
+ BIGENE + OH -> ENEO2 ; 5.40e-11
+ [ox_p15] ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.20e-12, 180.
+ MVK + OH -> MACRO2 ; 4.13e-12, 452.
+ [ox_l7] MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH ; 7.52e-16, -1521.
+ + .2 * O3 + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MEK + OH -> MEKO2 ; 2.30e-12, -170.
+ [ox_p17] MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.20e-12, 180.
+ MEKO2 + HO2 -> MEKOOH ; 7.50e-13, 700.
+ MEKOOH + OH -> MEKO2 ; 3.80e-12, 200.
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175.
+ [ox_l8] MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO ; 4.40e-15, -2500.
+ + .2 * O3 + .7 * CH2O + .215 * OH
+ [ox_p7] MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.70e-12, 360.
+ + .53 * GLYALD + .25 * CH3COCHO
+ + .53 * CH3CO3 + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.30e-13, 360.
+ MACRO2 + NO3 -> NO2 + .47 * HO2 + .25 * CH2O ; 2.40e-12
+ + .25 * CH3COCHO + .22 * CO
+ + .53 * GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.00e-13, 700.
+ MACRO2 + CH3O2 -> .73 * HO2 + .88 * CH2O + .11 * CO ; 5.00e-13, 400.
+ + .24 * CH3COCHO
+ + .26 * GLYALD + .26 * CH3CO3
+ + .25 * CH3OH + .23 * HYAC
+ MACRO2 + CH3CO3 -> .25 * CH3COCHO + CH3O2 + .22 * CO ; 1.40e-11
+ + .47 * HO2 + .53 * GLYALD
+ + .22 * HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.30e-11, 200.
+ [ox_p8] MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.30e-12, 360.
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5.00e-12
+ MCO3 + HO2 -> .25 * O3 + .25 * CH3COOH + .75 * CH3COOOH ; 4.30e-13, 1040.
+ + .75 * O2
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.00e-12, 500.
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.60e-12, 530.
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.30e-12, 530.
+ [usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M
+ [usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M
+ MPAN + OH -> .5 * HYAC + .5 * NO3 + .5 * CH2O + .5 *HO2 ; 8.00e-27, 3.5, 3.00e-11, 0.0, 0.5
+* --------------------------------------------------------------
+* C-5 Degradation
+*
+* ISOP = C5H8
+* ISOPO2 = HOCH2COOCH3CHCH2
+* ISOPNO3 = CH2CHCCH3OOCH2ONO2
+* ISOPOOH = HOCH2COOHCH3CHCH2
+* BIGALK = C5H12,
+* ALKO2 = C5H11O2
+* ALKOOH = C5H12O2
+* ONITR = CH2CCH3CHONO2CH2OH
+* XO2 = HOCH2COOCH3CHOHCHO
+* XOOH = HOCH2COOHCH3CHOHCHO
+* --------------------------------------------------------------
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410.
+ [ox_l5] ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000.
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446.
+ [ox_p6] ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .51 * CH2O ; 4.40e-12, 180.
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.40e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.00e-13, 700.
+ ISOPOOH + OH -> .8 * XO2 + .2 * ISOPO2 ; 1.52e-11, 200.
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.00e-13, 400.
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O ; 1.40e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O ; 2.70e-12, 360.
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR ; 2.40e-12
+ + .039 * MVK + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> XOOH + .206 * NO2 + .794 *HO2 + .008*CH2O ; 8.00e-13, 700.
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ [soa5] BIGALK + OH -> ALKO2 ; 3.50e-12
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.50e-11
+ ONITR + NO3 -> HO2 + NO2 + HYDRALD ; 1.40e-12, -1860.
+ HYDRALD + OH -> XO2 ; 1.86e-11, 175.
+ [ox_p14] ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 ; 4.20e-12, 180.
+ + .9*HO2 + .8*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.50e-13, 700.
+ ALKOOH + OH -> ALKO2 ; 3.80e-12, 200.
+ [ox_p11] XO2 + NO -> NO2 + HO2 + .5*CO + .25*GLYOXAL ; 2.7e-12, 360.
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + HO2 + 0.5*CO + .25*HYAC ; 2.40e-12
+ + 0.25*GLYOXAL + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.00e-13, 700.
+ XO2 + CH3O2 -> .3 * CH3OH + 0.8*HO2 + .7 * CH2O ; 5.00e-13, 400.
+ + .2 * CO + .1 * HYAC
+ + .1*GLYOXAL + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> 0.5*CO + CH3O2 + HO2 + CO2 + .25*GLYOXAL ; 1.30e-12, 640.
+ + .25 * HYAC + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190.
+ [usr_XOOH_OH] XOOH + OH -> H2O + OH
+* --------------------------------------------------------------
+* C-7 degradation
+*
+* TOLUENE = C7H8
+* CRESOL = C7H8O
+* TOLO2 = C7H9O5
+* TOLOOH = C7H10O5
+* XOH = C7H10O6
+* --------------------------------------------------------------
+ [soa4] TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.70e-12, 352.
+ [ox_p12] TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.20e-12, 180.
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.50e-13, 700.
+ TOLOOH + OH -> TOLO2 ; 3.80e-12, 200.
+ CRESOL + OH -> XOH ; 3.00e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.00e-11
+* --------------------------------------------------------------
+* C-10 degradation
+*
+* TERPO2 = C10H17O3
+* TERPOOH = C10H18O3
+* --------------------------------------------------------------
+ [soa2] C10H16 + OH -> TERPO2 ; 1.2e-11, 444.
+ [soa1] C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732.
+ [soa3] C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490.
+ [ox_p13] TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180.
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700.
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200.
+* --------------------------------------------------------------
+* Radon/Lead
+* --------------------------------------------------------------
+ Rn -> Pb ; 2.10e-6
+* --------------------------------------------------------------
+* Tropospheric Heterogeneous Reactions
+* --------------------------------------------------------------
+ [usr_N2O5_aer] N2O5 -> 2 * HNO3
+ [usr_NO3_aer] NO3 -> HNO3
+ [usr_NO2_aer] NO2 -> 0.5*OH + 0.5*NO + 0.5*HNO3
+ CB1 -> CB2 ; 7.10e-6
+ [usr_SO2_OH] SO2 + OH -> SO4
+ DMS + OH -> SO2 ; 9.60e-12, -234.
+ [usr_DMS_OH] DMS + OH -> .5 * SO2 + .5 * HO2
+ DMS + NO3 -> SO2 + HNO3 ; 1.90e-13, 520.
+ NH3 + OH -> H2O ; 1.70e-12, -710.
+ OC1 -> OC2 ; 7.10e-6
+ [usr_HO2_aer] HO2 -> 0.5*H2O2
+* --------------------------------------------------------------
+* O1D reactions with halogens
+* --------------------------------------------------------------
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CCL4 -> 4*CL ; 2.84e-10
+ O1D + CH3BR -> BR ; 1.80e-10
+ O1D + CF2CLBR -> BR ; 9.60e-11
+ O1D + CF3BR -> BR ; 4.10e-11
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200.
+ CL + H2 -> HCL + H ; 3.05e-11, -2270.
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.
+ CL + HO2 -> HCL + O2 ; 1.80e-11, 170.
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.
+ CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280.
+ CLO + O -> CL + O2 ; 2.80e-11, 85.
+ CLO + OH -> CL + HO2 ; 7.40e-12, 270.
+ CLO + OH -> HCL + O2 ; 6.00e-13, 230.
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220.
+ CLO + NO -> NO2 + CL ; 6.40e-12 , 290.
+ CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.
+ [tag_CLO_CLO] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 2.0e-12, 2.4, 0.6
+ [usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350.
+ HCL + O -> CL + OH ; 1.00e-11, -3300.
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130.
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500.
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800.
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330.
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 4.80e-12, -310.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 1.70e-11, 250.
+ BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230.
+ HBR + OH -> BR + H2O ; 5.50e-12, 200.
+ HBR + O -> BR + OH ; 5.80e-12, -1500.
+ HOBR + O -> BRO + OH ; 1.20e-10, -430.
+ BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215.
+* --------------------------------------------------------------
+* Organic Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130.
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250.
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520.
+ HCFC22 + OH -> CL + H2O + CF2O ; 1.05e-12, -1600.
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300.
+* --------------------------------------------------------------
+* Sulfate aerosol reactions (stratospheric)
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions (stratospheric)
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+* --------------------------------------------------------------
+* Ice aerosol reactions (stratospheric)
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+ End Reactions
+
+ Ext Forcing
+ NO <- dataset
+ NO2 <- dataset
+ CO <- dataset
+ SO2 <- dataset
+ CB1 <- dataset
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/wa3.tst.inp b/chem_proc/inputs/wa3.tst.inp
new file mode 100644
index 0000000000..8fc5017320
--- /dev/null
+++ b/chem_proc/inputs/wa3.tst.inp
@@ -0,0 +1,329 @@
+BEGSIM
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2
+ Np -> N, Op -> O, NOp -> NO, e, N2D -> N, H2O
+ End Solution
+
+ Fixed
+ M, N2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2
+ End explicit
+ Implicit
+ O3, O, O1D, O2, O2_1S, O2_1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e
+ End implicit
+ End Solution classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2_a=userdefined,] O2 + hv -> O + O1D
+ [jo2_b=userdefined,] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2_1D
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno=userdefined,] NO + hv -> N + O
+ [jno_i] NO + hv -> NOp + e
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+*------------------------------------------------------------------------------
+* photo-ionization
+*------------------------------------------------------------------------------
+ [jeuv_1=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_2=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_3=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_4=userdefined,userdefined] N + hv -> Np + e
+ [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+
+ [jeuv_14=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_15=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_16=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr1] O + O2 + M -> O3 + M
+ [cph1,cph] O + O3 -> 2*O2 ; 8e-12, -2060
+ [usr2] O + O + M -> O2 + M
+ [cph17,cph] O1D + N2 -> O + N2 ; 1.8e-11, 110
+ [cph16,cph] O1D + O2 -> O + O2_1S ; 3.04e-11, 70
+ [cph29,cph] O1D + O2 -> O + O2 ; 1.60e-12, 70
+ O1D + H2O -> 2*OH ; 2.2e-10
+ O1D + N2O -> 2*NO ; 6.7e-11
+ O1D + N2O -> N2 + O2 ; 4.9e-11
+ O1D + O3 -> O2 + O2 ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.0e-11
+ O1D + CH4 -> CH2O + H2 ; 7.5e-12
+ O1D + H2 -> H + OH ; 1.1e-10
+ O1D + HCL -> CL + OH ; 1.5e-10
+
+ [cph18,cph] O2_1S + O -> O2_1D + O ; 8.e-14
+ [cph19,cph] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17
+ [cph20,cph] O2_1S + N2 -> O2_1D + N2 ; 2.1e-15
+ [cph21,cph] O2_1S + O3 -> O2_1D + O3 ; 2.2e-11
+*new reaction
+ O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13
+ [ag2,cph] O2_1S -> O2 ; 8.5e-2
+
+ [cph22,cph] O2_1D + O -> O2 + O ; 1.3e-16
+ [cph23,cph] O2_1D + O2 -> 2 * O2 ; 3.6e-18,-220
+ [cph24,cph] O2_1D + N2 -> O2 + N2 ; 1.e-20
+ [ag1,cph] O2_1D -> O2 ; 2.58e-4
+
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ [cph25,cph] N2D + O2 -> NO + O1D ; 5.e-12
+*[cph26,cph] N2D + O -> N + O ; 4.5e-13
+ [cph26,cph] N2D + O -> N + O ; 7.e-13
+ [cph27,cph] N + O2 -> NO + O ; 1.5e-11, -3600
+ [cph28,cph] N + NO -> N2 + O ; 2.1e-11, 100
+ NO + O + M -> NO2 + M ; 9.0e-32, 1.5, 3.0e-11, 0., 0.6
+ [cph8,cph] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ [cph12,cph] NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ [cph13,cph] NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, .7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ [usr3] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3a] N2O5 + M -> NO2 + NO3 + M
+ NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ NO3 + O -> NO2 + O2 ; 1.e-11
+ NO3 + OH -> HO2 + NO2 ; 2.2e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12
+ [usr5] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr5a] HO2NO2 + M -> HO2 + NO2 + M
+
+* --------------------------------------------------------------
+* Methane, CO, CH2O and derivatives
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O + H ; 9.e-12
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.0
+ [usr6] CO + OH -> CO2 + H
+
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ [cph5,cph] H + O2 + M -> HO2 + M ; 5.7e-32,1.6, 7.5e-11,0., .6
+ [cph7,cph] H + O3 -> OH + O2 ; 1.40e-10, -470.0
+ H + HO2 -> 2*OH ; 7.21e-11
+ [cph15,cph] H + HO2 -> H2 + O2 ; 7.29e-12
+ H + HO2 -> H2O + O ; 1.62e-12
+ [cph3,cph] OH + O -> H + O2 ; 2.2e-11, 120
+ [cph11,cph] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [cph14,cph] OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1.0, 2.6e-11, 0., .6
+ OH + H2 -> H2O + H ; 5.5e-12, -2000
+ OH + H2O2 -> H2O + HO2 ; 2.9e-12, -160
+ [cph4,cph] HO2 + O -> OH + O2 ; 3e-11, 200
+ [cph9,cph] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr7] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.4e-12, -2000
+
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200
+ CL + H2 -> HCL + H ; 3.70e-11, -2300.0
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.0
+ CL + HO2 -> HCL + O2 ; 1.80e-11, +170.0
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.0
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.0
+ CL + CH4 -> CH3O2 + HCL ; 9.60e-12, -1360
+ CLO + O -> CL + O2 ; 3.00e-11, +70.0
+ CLO + OH -> CL + HO2 ; 7.4e-12, 270
+ CLO + OH -> HCL + O2 ; 6.0e-13, 230
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220
+ CLO + NO -> NO2 + CL ; 6.40e-12, +290.0
+ CLO + NO2 + M -> CLONO2 + M ; 1.8e-31,3.4, 1.5e-11,1.9, .6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.0
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.0
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.0
+ [usr8] CLO + CLO + M -> CL2O2 + M ; 1.6e-32,4.5, 2.0e-12,2.4, .6
+ [usr8a] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350
+ HCL + O -> CL + OH ; 1.00e-11, -3300
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 1.50e-11, -600.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 7.5e-11
+ BRO + HO2 -> HOBR + O2 ; 3.40e-12, 540.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.2e-31,3.2, 6.9e-12,2.9, .6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230.
+ HBR + OH -> BR + H2O ; 1.10e-11
+
+* --------------------------------------------------------------
+* Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 3.20e-11, -1250
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.60e-12, -1520
+ HCFC22 + OH -> CL + H2O + CF2O ; 4.00e-12, -1400
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300
+
+* --------------------------------------------------------------
+* Sulfate aerosol reactions
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+* --------------------------------------------------------------
+* Ice aerosol reactions
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Ion reactions
+* --------------------------------------------------------------
+ [ion1] Op + O2 -> O2p + O
+ [ion2] Op + N2 -> NOp + N
+ [ion3] N2p + O -> NOp + N2D
+ [ion4,cph] O2p + N -> NOp + O ; 1.e-10
+ [ion5,cph] O2p + NO -> NOp + O2 ; 4.4e-10
+ [ion6,cph] Np + O2 -> O2p + N ; 4.e-10
+ [ion7,cph] Np + O2 -> NOp + O ; 2.e-10
+ [ion8,cph] Np + O -> Op + N ; 1.e-12
+ [ion9,cph] N2p + O2 -> O2p + N2 ; 6.e-11
+ O2p + N2 -> NOp + NO ; 5.e-16
+ [ion11] N2p + O -> Op + N2
+ [elec1] NOp + e -> .2*N + .8*N2D + O
+ [elec2] O2p + e -> 1.15*O + .85*O1D
+ [elec3] N2p + e -> 1.1*N + .9*N2D
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, HO2NO2, CLONO2, BRONO2, HCL, N2O5, HOCL, HOBR, HBR
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, Op, O2p, Np, N2p, N2D, N, e
+ End Ext Forcing
+
+ END Chemistry
+
+ENDSIM
diff --git a/chem_proc/inputs/wa3.tst.spe.0.inp b/chem_proc/inputs/wa3.tst.spe.0.inp
new file mode 100644
index 0000000000..75b57e6ebc
--- /dev/null
+++ b/chem_proc/inputs/wa3.tst.spe.0.inp
@@ -0,0 +1,329 @@
+BEGSIM
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2
+ Np -> N, Op -> O, NOp -> NO, e, N2D -> N, H2O
+ End Solution
+
+ Fixed
+ M, N2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2
+ End explicit
+ Implicit
+ O3, O, O1D, O2, O2_1S, O2_1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e
+ End implicit
+ End Solution classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2_a=userdefined,] O2 + hv -> O + O1D
+ [jo2_b=userdefined,] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2_1D
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno=userdefined,] NO + hv -> N + O
+ [jno_i] NO + hv -> NOp + e
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+*------------------------------------------------------------------------------
+* photo-ionization
+*------------------------------------------------------------------------------
+ [jeuv_1=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_2=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_3=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_4=userdefined,userdefined] N + hv -> Np + e
+ [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+
+ [jeuv_14=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_15=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_16=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr1] O + O2 + M -> O3 + M
+ [cph1,cph] O + O3 -> 2*O2 ; 8e-12, -2060
+ [usr2] O + O + M -> O2 + M
+ [cph17,cph] O1D + N2 -> O + N2 ; 1.8e-11, 110
+ [cph16,cph] O1D + O2 -> O + O2_1S ; 3.04e-11, 70
+ [cph29,cph] O1D + O2 -> O + O2 ; 1.60e-12, 70
+ O1D + H2O -> 2*OH ; 2.2e-10
+ O1D + N2O -> 2*NO ; 6.7e-11
+ O1D + N2O -> N2 + O2 ; 4.9e-11
+ O1D + O3 -> O2 + O2 ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.0e-11
+ O1D + CH4 -> CH2O + H2 ; 7.5e-12
+ O1D + H2 -> H + OH ; 1.1e-10
+ O1D + HCL -> CL + OH ; 1.5e-10
+
+ [cph18,cph] O2_1S + O -> O2_1D + O ; 8.e-14
+ [cph19,cph] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17
+ [cph20,cph] O2_1S + N2 -> O2_1D + N2 ; 2.1e-15
+ [cph21,cph] O2_1S + O3 -> O2_1D + O3 ; 2.2e-11
+*new reaction
+ O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13
+ [ag2,cph] O2_1S -> O2 ; 8.5e-2
+
+ [cph22,cph] O2_1D + O -> O2 + O ; 1.3e-16
+ [cph23,cph] O2_1D + O2 -> 2 * O2 ; 3.6e-18,-220
+ [cph24,cph] O2_1D + N2 -> O2 + N2 ; 1.e-20
+ [ag1,cph] O2_1D -> O2 ; 2.58e-4
+
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ [cph25,cph] N2D + O2 -> NO + O1D ; 5.e-12
+*[cph26,cph] N2D + O -> N + O ; 4.5e-13
+ [cph26,cph] N2D + O -> N + O ; 7.e-13
+ [cph27,cph] N + O2 -> NO + O ; 1.5e-11, -3600
+ [cph28,cph] N + NO -> N2 + O ; 2.1e-11, 100
+ NO + O + M -> NO2 + M ; 9.0e-32, 1.5, 3.0e-11, 0., 0.6
+ [cph8,cph] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ [cph12,cph] NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ [cph13,cph] NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, .7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ [usr3] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3a] N2O5 + M -> NO2 + NO3 + M
+ NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ NO3 + O -> NO2 + O2 ; 1.e-11
+ NO3 + OH -> HO2 + NO2 ; 2.2e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12
+ [usr5] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr5a] HO2NO2 + M -> HO2 + NO2 + M
+
+* --------------------------------------------------------------
+* Methane, CO, CH2O and derivatives
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O + H ; 9.e-12
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.0
+ [usr6] CO + OH -> CO2 + H
+
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ [cph5,cph] H + O2 + M -> HO2 + M ; 5.7e-32,1.6, 7.5e-11,0., .6
+ [cph7,cph] H + O3 -> OH + O2 ; 1.40e-10, -470.0
+ H + HO2 -> 2*OH ; 7.21e-11
+ [cph15,cph] H + HO2 -> H2 + O2 ; 7.29e-12
+ H + HO2 -> H2O + O ; 1.62e-12
+ [cph3,cph] OH + O -> H + O2 ; 2.2e-11, 120
+ [cph11,cph] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [cph14,cph] OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1.0, 2.6e-11, 0., .6
+ OH + H2 -> H2O + H ; 5.5e-12, -2000
+ OH + H2O2 -> H2O + HO2 ; 2.9e-12, -160
+ [cph4,cph] HO2 + O -> OH + O2 ; 3e-11, 200
+ [cph9,cph] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr7] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.4e-12, -2000
+
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200
+ CL + H2 -> HCL + H ; 3.70e-11, -2300.0
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.0
+ CL + HO2 -> HCL + O2 ; 1.80e-11, +170.0
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.0
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.0
+ CL + CH4 -> CH3O2 + HCL ; 9.60e-12, -1360
+ CLO + O -> CL + O2 ; 3.00e-11, +70.0
+ CLO + OH -> CL + HO2 ; 7.4e-12, 270
+ CLO + OH -> HCL + O2 ; 6.0e-13, 230
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220
+ CLO + NO -> NO2 + CL ; 6.40e-12, +290.0
+ CLO + NO2 + M -> CLONO2 + M ; 1.8e-31,3.4, 1.5e-11,1.9, .6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.0
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.0
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.0
+ [usr8] CLO + CLO + M -> CL2O2 + M ; 1.6e-32,4.5, 2.0e-12,2.4, .6
+ [usr8a] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350
+ HCL + O -> CL + OH ; 1.00e-11, -3300
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 1.50e-11, -600.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 7.5e-11
+ BRO + HO2 -> HOBR + O2 ; 3.40e-12, 540.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.2e-31,3.2, 6.9e-12,2.9, .6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230.
+ HBR + OH -> BR + H2O ; 1.10e-11
+
+* --------------------------------------------------------------
+* Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 3.20e-11, -1250
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.60e-12, -1520
+ HCFC22 + OH -> CL + H2O + CF2O ; 4.00e-12, -1400
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300
+
+* --------------------------------------------------------------
+* Sulfate aerosol reactions
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+* --------------------------------------------------------------
+* Ice aerosol reactions
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Ion reactions
+* --------------------------------------------------------------
+ [ion1] Op + O2 -> O2p + O
+ [ion2] Op + N2 -> NOp + N
+ [ion3] N2p + O -> NOp + N2D
+ [ion4,cph] O2p + N -> NOp + O ; 1.e-10
+ [ion5,cph] O2p + NO -> NOp + O2 ; 4.4e-10
+ [ion6,cph] Np + O2 -> O2p + N ; 4.e-10
+ [ion7,cph] Np + O2 -> NOp + O ; 2.e-10
+ [ion8,cph] Np + O -> Op + N ; 1.e-12
+ [ion9,cph] N2p + O2 -> O2p + N2 ; 6.e-11
+ O2p + N2 -> NOp + NO ; 5.e-16
+ [ion11] N2p + O -> Op + N2
+ [elec1] NOp + e -> .2*N + .8*N2D + O
+ [elec2] O2p + e -> 1.15*O + .85*O1D
+ [elec3] N2p + e -> 1.1*N + .9*N2D
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, HO2NO2, CLONO2, BRONO2, HCL, N2O5, HOCL, HOBR, HBR
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, Op, O2p, Np, N2p, N2D, N, e, OH
+ End Ext Forcing
+
+ END Chemistry
+
+ENDSIM
diff --git a/chem_proc/inputs/wa3.tst.spe.inp b/chem_proc/inputs/wa3.tst.spe.inp
new file mode 100644
index 0000000000..c63b1c1b03
--- /dev/null
+++ b/chem_proc/inputs/wa3.tst.spe.inp
@@ -0,0 +1,360 @@
+BEGSIM
+output_unit_number = 7
+output_file = cam_aer_ncep.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = cam_aer_ncep.dat
+
+Comments
+ "This is a mozart4 simulation with :"
+ "(1) New hydrocarbon chemistry (lumped alkane, alkene, aromatic)"
+ "(2) New aerosol chemistry"
+ "(3) No groups"
+ "(4) NCEP inputs (28 levels)"
+ "(5) no N atom"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2
+ Np -> N, Op -> O, NOp -> NO, e, N2D -> N, H2O
+ End Solution
+
+ Fixed
+ M, N2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2
+ End explicit
+ Implicit
+ O3, O, O1D, O2, O2_1S, O2_1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e
+ End implicit
+ End Solution classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2_a=userdefined,] O2 + hv -> O + O1D
+ [jo2_b=userdefined,] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2_1D
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno=userdefined,] NO + hv -> N + O
+ [jno_i] NO + hv -> NOp + e
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+*------------------------------------------------------------------------------
+* photo-ionization
+*------------------------------------------------------------------------------
+ [jeuv_1=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_2=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_3=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_4=userdefined,userdefined] N + hv -> Np + e
+ [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+
+ [jeuv_14=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_15=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_16=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr1] O + O2 + M -> O3 + M
+ [cph1,cph] O + O3 -> 2*O2 ; 8e-12, -2060
+ [usr2] O + O + M -> O2 + M
+ [cph17,cph] O1D + N2 -> O + N2 ; 1.8e-11, 110
+ [cph16,cph] O1D + O2 -> O + O2_1S ; 3.04e-11, 70
+ [cph29,cph] O1D + O2 -> O + O2 ; 1.60e-12, 70
+ O1D + H2O -> 2*OH ; 2.2e-10
+ O1D + N2O -> 2*NO ; 6.7e-11
+ O1D + N2O -> N2 + O2 ; 4.9e-11
+ O1D + O3 -> O2 + O2 ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.0e-11
+ O1D + CH4 -> CH2O + H2 ; 7.5e-12
+ O1D + H2 -> H + OH ; 1.1e-10
+ O1D + HCL -> CL + OH ; 1.5e-10
+
+ [cph18,cph] O2_1S + O -> O2_1D + O ; 8.e-14
+ [cph19,cph] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17
+ [cph20,cph] O2_1S + N2 -> O2_1D + N2 ; 2.1e-15
+ [cph21,cph] O2_1S + O3 -> O2_1D + O3 ; 2.2e-11
+*new reaction
+ O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13
+ [ag2,cph] O2_1S -> O2 ; 8.5e-2
+
+ [cph22,cph] O2_1D + O -> O2 + O ; 1.3e-16
+ [cph23,cph] O2_1D + O2 -> 2 * O2 ; 3.6e-18,-220
+ [cph24,cph] O2_1D + N2 -> O2 + N2 ; 1.e-20
+ [ag1,cph] O2_1D -> O2 ; 2.58e-4
+
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ [cph25,cph] N2D + O2 -> NO + O1D ; 5.e-12
+*[cph26,cph] N2D + O -> N + O ; 4.5e-13
+ [cph26,cph] N2D + O -> N + O ; 7.e-13
+ [cph27,cph] N + O2 -> NO + O ; 1.5e-11, -3600
+ [cph28,cph] N + NO -> N2 + O ; 2.1e-11, 100
+ NO + O + M -> NO2 + M ; 9.0e-32, 1.5, 3.0e-11, 0., 0.6
+ [cph8,cph] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ [cph12,cph] NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ [cph13,cph] NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, .7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ [usr3] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3a] N2O5 + M -> NO2 + NO3 + M
+ NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ NO3 + O -> NO2 + O2 ; 1.e-11
+ NO3 + OH -> HO2 + NO2 ; 2.2e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12
+ [usr5] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr5a] HO2NO2 + M -> HO2 + NO2 + M
+
+* --------------------------------------------------------------
+* Methane, CO, CH2O and derivatives
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O + H ; 9.e-12
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.0
+ [usr6] CO + OH -> CO2 + H
+
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ [cph5,cph] H + O2 + M -> HO2 + M ; 5.7e-32,1.6, 7.5e-11,0., .6
+ [cph7,cph] H + O3 -> OH + O2 ; 1.40e-10, -470.0
+ H + HO2 -> 2*OH ; 7.21e-11
+ [cph15,cph] H + HO2 -> H2 + O2 ; 7.29e-12
+ H + HO2 -> H2O + O ; 1.62e-12
+ [cph3,cph] OH + O -> H + O2 ; 2.2e-11, 120
+ [cph11,cph] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [cph14,cph] OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1.0, 2.6e-11, 0., .6
+ OH + H2 -> H2O + H ; 5.5e-12, -2000
+ OH + H2O2 -> H2O + HO2 ; 2.9e-12, -160
+ [cph4,cph] HO2 + O -> OH + O2 ; 3e-11, 200
+ [cph9,cph] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr7] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.4e-12, -2000
+
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200
+ CL + H2 -> HCL + H ; 3.70e-11, -2300.0
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.0
+ CL + HO2 -> HCL + O2 ; 1.80e-11, +170.0
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.0
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.0
+ CL + CH4 -> CH3O2 + HCL ; 9.60e-12, -1360
+ CLO + O -> CL + O2 ; 3.00e-11, +70.0
+ CLO + OH -> CL + HO2 ; 7.4e-12, 270
+ CLO + OH -> HCL + O2 ; 6.0e-13, 230
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220
+ CLO + NO -> NO2 + CL ; 6.40e-12, +290.0
+ CLO + NO2 + M -> CLONO2 + M ; 1.8e-31,3.4, 1.5e-11,1.9, .6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.0
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.0
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.0
+ [usr8] CLO + CLO + M -> CL2O2 + M ; 1.6e-32,4.5, 2.0e-12,2.4, .6
+ [usr8a] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350
+ HCL + O -> CL + OH ; 1.00e-11, -3300
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 1.50e-11, -600.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 7.5e-11
+ BRO + HO2 -> HOBR + O2 ; 3.40e-12, 540.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.2e-31,3.2, 6.9e-12,2.9, .6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230.
+ HBR + OH -> BR + H2O ; 1.10e-11
+
+* --------------------------------------------------------------
+* Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 3.20e-11, -1250
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.60e-12, -1520
+ HCFC22 + OH -> CL + H2O + CF2O ; 4.00e-12, -1400
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300
+
+* --------------------------------------------------------------
+* Sulfate aerosol reactions
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+* --------------------------------------------------------------
+* Ice aerosol reactions
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Ion reactions
+* --------------------------------------------------------------
+ [ion1] Op + O2 -> O2p + O
+ [ion2] Op + N2 -> NOp + N
+ [ion3] N2p + O -> NOp + N2D
+ [ion4,cph] O2p + N -> NOp + O ; 1.e-10
+ [ion5,cph] O2p + NO -> NOp + O2 ; 4.4e-10
+ [ion6,cph] Np + O2 -> O2p + N ; 4.e-10
+ [ion7,cph] Np + O2 -> NOp + O ; 2.e-10
+ [ion8,cph] Np + O -> Op + N ; 1.e-12
+ [ion9,cph] N2p + O2 -> O2p + N2 ; 6.e-11
+ O2p + N2 -> NOp + NO ; 5.e-16
+ [ion11] N2p + O -> Op + N2
+ [elec1] NOp + e -> .2*N + .8*N2D + O
+ [elec2] O2p + e -> 1.15*O + .85*O1D
+ [elec3] N2p + e -> 1.1*N + .9*N2D
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, HO2NO2, CLONO2, BRONO2, HCL, N2O5, HOCL, HOBR, HBR
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, Op, O2p, Np, N2p, N2D, N, e, OH
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = ibm
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/waccm3_57spc_JPL06_ccmval.inp b/chem_proc/inputs/waccm3_57spc_JPL06_ccmval.inp
new file mode 100644
index 0000000000..35416798ad
--- /dev/null
+++ b/chem_proc/inputs/waccm3_57spc_JPL06_ccmval.inp
@@ -0,0 +1,370 @@
+BEGSIM
+output_unit_number = 7
+output_file = waccm3_57spc_JPL06_ccmval.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = waccm3_57spc_JPL06_ccmval.dat
+
+Comments
+ "This is a waccm3 simulation with:"
+ "(1) The new advection routine Lin Rood"
+ "(2) WACCM dynamical inputs"
+ "(3) Strat, Meso, and Thermospheric mechanism"
+ "(4) JPL06 Kinetics"
+ "(5) CCMVal Mechanism, 2008"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2
+ Np -> N, Op -> O, NOp -> NO, e, N2D -> N, H2O
+ End Solution
+
+ Fixed
+ M, N2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2
+ End explicit
+ Implicit
+ O3, O, O1D, O2, O2_1S, O2_1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e
+ End implicit
+ End Solution classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2_a=userdefined,] O2 + hv -> O + O1D
+ [jo2_b=userdefined,] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2_1D
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno=userdefined,] NO + hv -> N + O
+ [jno_i] NO + hv -> NOp + e
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [jclo] CLO + hv -> O + CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+*------------------------------------------------------------------------------
+* photo-ionization
+*------------------------------------------------------------------------------
+ [jeuv_1=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_2=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_3=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_4=userdefined,userdefined] N + hv -> Np + e
+ [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+
+ [jeuv_14=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_15=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_16=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr1] O + O2 + M -> O3 + M
+ [cph1,cph] O + O3 -> 2*O2 ; 8.00e-12, -2060.
+ [usr2] O + O + M -> O2 + M
+ [cph18,cph] O2_1S + O -> O2_1D + O ; 8.00e-14
+ [cph19,cph] O2_1S + O2 -> O2_1D + O2 ; 3.90e-17
+ [cph20,cph] O2_1S + N2 -> O2_1D + N2 ; 1.80e-15, 45.
+ [cph21,cph] O2_1S + O3 -> O2_1D + O3 ; 3.50e-11, -135.
+ O2_1S + CO2 -> O2_1D + CO2 ; 4.20e-13
+ [ag2,cph] O2_1S -> O2 ; 8.50e-2
+ [cph22,cph] O2_1D + O -> O2 + O ; 1.30e-16
+ [cph23,cph] O2_1D + O2 -> 2 * O2 ; 3.60e-18, -220.
+ [cph24,cph] O2_1D + N2 -> O2 + N2 ; 1.00e-20
+ [ag1,cph] O2_1D -> O2 ; 2.58e-04
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions (O1D only)
+* --------------------------------------------------------------
+ [cph17,cph] O1D + N2 -> O + N2 ; 2.15e-11, 110.
+ [cph16,cph] O1D + O2 -> O + O2_1S ; 3.135e-11, 55.
+ [cph29,cph] O1D + O2 -> O + O2 ; 1.65e-12, 55.
+ O1D + H2O -> 2*OH ; 1.63e-10, 60.
+ O1D + N2O -> 2*NO ; 6.70e-11, 20.
+ O1D + N2O -> N2 + O2 ; 4.70e-11, 20.
+ O1D + O3 -> O2 + O2 ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CCL4 -> 4CL ; 2.84e-10
+ O1D + CH3BR -> BR ; 1.80e-10
+ O1D + CF2CLBR -> BR ; 9.60e-11
+ O1D + CF3BR -> BR ; 4.10e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.00e-11
+ O1D + CH4 -> CH2O + H2 ; 7.50e-12
+ O1D + H2 -> H + OH ; 1.10e-10
+ O1D + HCL -> CL + OH ; 1.50e-10
+ O1D + HBR -> BR + OH ; 1.50e-10
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ [cph25,cph] N2D + O2 -> NO + O1D ; 5.00e-12
+*[cph26,cph] N2D + O -> N + O ; 4.50e-13
+ [cph26,cph] N2D + O -> N + O ; 7.00e-13
+ [cph27,cph] N + O2 -> NO + O ; 1.50e-11, -3600.
+ [cph28,cph] N + NO -> N2 + O ; 2.10e-11, 100.
+ N + NO2 -> N2O + O ; 5.80e-12, 220.
+ NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6
+ [cph8,cph] NO + HO2 -> NO2 + OH ; 3.50e-12, 250.
+ [cph12,cph] NO + O3 -> NO2 + O2 ; 3.00e-12, -1500.
+ [cph13,cph] NO2 + O -> NO + O2 ; 5.20e-12, 210.
+ NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450.
+ [usr3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6
+ [usr3a] N2O5 + M -> NO2 + NO3 + M
+ NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6
+ [usr4] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.50e-11, 170.
+ NO3 + O -> NO2 + O2 ; 1.00e-11
+ NO3 + OH -> HO2 + NO2 ; 2.20e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12
+ [usr5] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380.
+ [usr5a] HO2NO2 + M -> HO2 + NO2 + M
+
+* --------------------------------------------------------------
+* Methane, CO, CH2O and derivatives
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775.
+ CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300.
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750.
+ CH3OOH + OH -> CH3O2 + H2O ; 3.80e-12, 200.
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 5.80e-16
+ CH2O + OH -> CO + H2O + H ; 5.50e-12, 125.
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.
+ CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6
+ [usr6] CO + OH -> CO2 + H
+
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ [cph5,cph] H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 4.7e-11, 0.2, 0.6
+ [cph7,cph] H + O3 -> OH + O2 ; 1.40e-10, -470.
+ H + HO2 -> 2*OH ; 7.20e-11
+ [cph15,cph] H + HO2 -> H2 + O2 ; 6.90e-12
+ H + HO2 -> H2O + O ; 1.60e-12
+ [cph3,cph] OH + O -> H + O2 ; 2.20e-11, 120.
+ [cph11,cph] OH + O3 -> HO2 + O2 ; 1.70e-12, -940.
+ [cph14,cph] OH + HO2 -> H2O + O2 ; 4.80e-11, 250.
+ OH + OH -> H2O + O ; 1.80e-12
+ OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.6e-11, 0.0, 0.6
+ OH + H2 -> H2O + H ; 2.80e-12, -1800.
+ OH + H2O2 -> H2O + HO2 ; 1.80e-12
+ [cph4,cph] HO2 + O -> OH + O2 ; 3.00e-11, 200.
+ [cph9,cph] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490.
+ [usr7] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.40e-12, -2000.
+
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200.
+ CL + H2 -> HCL + H ; 3.05e-11, -2270.
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.
+ CL + HO2 -> HCL + O2 ; 1.80e-11, 170.
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.
+ CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280.
+ CLO + O -> CL + O2 ; 2.80e-11, 85.
+ CLO + OH -> CL + HO2 ; 7.40e-12, 270.
+ CLO + OH -> HCL + O2 ; 6.00e-13, 230.
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220.
+ CLO + NO -> NO2 + CL ; 6.40e-12 , 290.
+ CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.
+ [usr8] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 2.0e-12, 2.4, 0.6
+ [usr8a] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350.
+ HCL + O -> CL + OH ; 1.00e-11, -3300.
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130.
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500.
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800.
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330.
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 4.80e-12, -310.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 1.70e-11, 250.
+ BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230.
+ HBR + OH -> BR + H2O ; 5.50e-12, 200.
+ HBR + O -> BR + OH ; 5.80e-12, -1500.
+ HOBR + O -> BRO + OH ; 1.20e-10, -430.
+ BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215.
+
+* --------------------------------------------------------------
+* Organic Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130.
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250.
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520.
+ HCFC22 + OH -> CL + H2O + CF2O ; 1.05e-12, -1600.
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300.
+
+* --------------------------------------------------------------
+* Sulfate aerosol reactions
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+* --------------------------------------------------------------
+* Ice aerosol reactions
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Ion reactions
+* --------------------------------------------------------------
+ [ion1] Op + O2 -> O2p + O
+ [ion2] Op + N2 -> NOp + N
+ [ion3] N2p + O -> NOp + N2D
+ [ion4,cph] O2p + N -> NOp + O ; 1.e-10
+ [ion5,cph] O2p + NO -> NOp + O2 ; 4.4e-10
+ [ion6,cph] Np + O2 -> O2p + N ; 4.e-10
+ [ion7,cph] Np + O2 -> NOp + O ; 2.e-10
+ [ion8,cph] Np + O -> Op + N ; 1.e-12
+ [ion9,cph] N2p + O2 -> O2p + N2 ; 6.e-11
+ O2p + N2 -> NOp + NO ; 5.e-16
+ [ion11] N2p + O -> Op + N2
+ [elec1] NOp + e -> .2*N + .8*N2D + O
+ [elec2] O2p + e -> 1.15*O + .85*O1D
+ [elec3] N2p + e -> 1.1*N + .9*N2D
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, HO2NO2, CLONO2, BRONO2, HCL, N2O5, HOCL, HOBR, HBR
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, Op, O2p, Np, N2p, N2D, N, e, OH
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = ibm
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/waccm3_57spc_JPL06_ccmval_clbrfam.in b/chem_proc/inputs/waccm3_57spc_JPL06_ccmval_clbrfam.in
new file mode 100644
index 0000000000..3a4ca958bc
--- /dev/null
+++ b/chem_proc/inputs/waccm3_57spc_JPL06_ccmval_clbrfam.in
@@ -0,0 +1,351 @@
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CLY, BRY
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2
+ Np -> N, Op -> O, NOp -> NO, e, N2D -> N, H2O
+ End Solution
+
+ Fixed
+ M, N2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2, CLY, BRY
+ End explicit
+ Implicit
+ O3, O, O1D, O2, O2_1S, O2_1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e
+ End implicit
+ End Solution classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2_a=userdefined,] O2 + hv -> O + O1D
+ [jo2_b=userdefined,] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2_1D
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno=userdefined,] NO + hv -> N + O
+ [jno_i] NO + hv -> NOp + e
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [jclo] CLO + hv -> O + CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+*------------------------------------------------------------------------------
+* photo-ionization
+*------------------------------------------------------------------------------
+ [jeuv_1=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_2=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_3=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_4=userdefined,userdefined] N + hv -> Np + e
+ [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+
+ [jeuv_14=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_15=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_16=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr_O_O2] O + O2 + M -> O3 + M
+ [cph1,cph] O + O3 -> 2*O2 ; 8.00e-12, -2060.
+ [usr_O_O] O + O + M -> O2 + M
+ [cph18,cph] O2_1S + O -> O2_1D + O ; 8.00e-14
+ [cph19,cph] O2_1S + O2 -> O2_1D + O2 ; 3.90e-17
+ [cph20,cph] O2_1S + N2 -> O2_1D + N2 ; 1.80e-15, 45.
+ [cph21,cph] O2_1S + O3 -> O2_1D + O3 ; 3.50e-11, -135.
+ O2_1S + CO2 -> O2_1D + CO2 ; 4.20e-13
+ [ag2,cph] O2_1S -> O2 ; 8.50e-2
+ [cph22,cph] O2_1D + O -> O2 + O ; 1.30e-16
+ [cph23,cph] O2_1D + O2 -> 2 * O2 ; 3.60e-18, -220.
+ [cph24,cph] O2_1D + N2 -> O2 + N2 ; 1.00e-20
+ [ag1,cph] O2_1D -> O2 ; 2.58e-04
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions (O1D only)
+* --------------------------------------------------------------
+ [cph17,cph] O1D + N2 -> O + N2 ; 2.15e-11, 110.
+ [cph16,cph] O1D + O2 -> O + O2_1S ; 3.135e-11, 55.
+ [cph29,cph] O1D + O2 -> O + O2 ; 1.65e-12, 55.
+ O1D + H2O -> 2*OH ; 1.63e-10, 60.
+ O1D + N2O -> 2*NO ; 6.70e-11, 20.
+ O1D + N2O -> N2 + O2 ; 4.70e-11, 20.
+ O1D + O3 -> O2 + O2 ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CCL4 -> 4CL ; 2.84e-10
+ O1D + CH3BR -> BR ; 1.80e-10
+ O1D + CF2CLBR -> BR ; 9.60e-11
+ O1D + CF3BR -> BR ; 4.10e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.00e-11
+ O1D + CH4 -> CH2O + H2 ; 7.50e-12
+ O1D + H2 -> H + OH ; 1.10e-10
+ O1D + HCL -> CL + OH ; 1.50e-10
+ O1D + HBR -> BR + OH ; 1.50e-10
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ [cph25,cph] N2D + O2 -> NO + O1D ; 5.00e-12
+*[cph26,cph] N2D + O -> N + O ; 4.50e-13
+ [cph26,cph] N2D + O -> N + O ; 7.00e-13
+ [cph27,cph] N + O2 -> NO + O ; 1.50e-11, -3600.
+ [cph28,cph] N + NO -> N2 + O ; 2.10e-11, 100.
+ N + NO2 -> N2O + O ; 5.80e-12, 220.
+ NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6
+ [cph8,cph] NO + HO2 -> NO2 + OH ; 3.50e-12, 250.
+ [cph12,cph] NO + O3 -> NO2 + O2 ; 3.00e-12, -1500.
+ [cph13,cph] NO2 + O -> NO + O2 ; 5.20e-12, 210.
+ NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450.
+ [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6
+ [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M
+ NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6
+ [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.50e-11, 170.
+ NO3 + O -> NO2 + O2 ; 1.00e-11
+ NO3 + OH -> HO2 + NO2 ; 2.20e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12
+ [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380.
+ [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M
+
+* --------------------------------------------------------------
+* Methane, CO, CH2O and derivatives
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775.
+ CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300.
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750.
+ CH3OOH + OH -> CH3O2 + H2O ; 3.80e-12, 200.
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 5.80e-16
+ CH2O + OH -> CO + H2O + H ; 5.50e-12, 125.
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.
+ CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6
+ [usr_CO_OH_b] CO + OH -> CO2 + H
+
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ [cph5,cph] H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 4.7e-11, 0.2, 0.6
+ [cph7,cph] H + O3 -> OH + O2 ; 1.40e-10, -470.
+ H + HO2 -> 2*OH ; 7.20e-11
+ [cph15,cph] H + HO2 -> H2 + O2 ; 6.90e-12
+ H + HO2 -> H2O + O ; 1.60e-12
+ [cph3,cph] OH + O -> H + O2 ; 2.20e-11, 120.
+ [cph11,cph] OH + O3 -> HO2 + O2 ; 1.70e-12, -940.
+ [cph14,cph] OH + HO2 -> H2O + O2 ; 4.80e-11, 250.
+ OH + OH -> H2O + O ; 1.80e-12
+ OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.6e-11, 0.0, 0.6
+ OH + H2 -> H2O + H ; 2.80e-12, -1800.
+ OH + H2O2 -> H2O + HO2 ; 1.80e-12
+ [cph4,cph] HO2 + O -> OH + O2 ; 3.00e-11, 200.
+ [cph9,cph] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490.
+ [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.40e-12, -2000.
+
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200.
+ CL + H2 -> HCL + H ; 3.05e-11, -2270.
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.
+ CL + HO2 -> HCL + O2 ; 1.80e-11, 170.
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.
+ CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280.
+ CLO + O -> CL + O2 ; 2.80e-11, 85.
+ CLO + OH -> CL + HO2 ; 7.40e-12, 270.
+ CLO + OH -> HCL + O2 ; 6.00e-13, 230.
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220.
+ CLO + NO -> NO2 + CL ; 6.40e-12 , 290.
+ CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.
+ [tag_CLO_CLO] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 2.0e-12, 2.4, 0.6
+ [usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350.
+ HCL + O -> CL + OH ; 1.00e-11, -3300.
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130.
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500.
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800.
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330.
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 4.80e-12, -310.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 1.70e-11, 250.
+ BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230.
+ HBR + OH -> BR + H2O ; 5.50e-12, 200.
+ HBR + O -> BR + OH ; 5.80e-12, -1500.
+ HOBR + O -> BRO + OH ; 1.20e-10, -430.
+ BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215.
+
+* --------------------------------------------------------------
+* Organic Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130.
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250.
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520.
+ HCFC22 + OH -> CL + H2O + CF2O ; 1.05e-12, -1600.
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300.
+
+* --------------------------------------------------------------
+* Sulfate aerosol reactions
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+* --------------------------------------------------------------
+* Ice aerosol reactions
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Ion reactions
+* --------------------------------------------------------------
+ [ion1] Op + O2 -> O2p + O
+ [ion2] Op + N2 -> NOp + N
+ [ion3] N2p + O -> NOp + N2D
+ [ion4,cph] O2p + N -> NOp + O ; 1.e-10
+ [ion5,cph] O2p + NO -> NOp + O2 ; 4.4e-10
+ [ion6,cph] Np + O2 -> O2p + N ; 4.e-10
+ [ion7,cph] Np + O2 -> NOp + O ; 2.e-10
+ [ion8,cph] Np + O -> Op + N ; 1.e-12
+ [ion9,cph] N2p + O2 -> O2p + N2 ; 6.e-11
+ O2p + N2 -> NOp + NO ; 5.e-16
+ [ion11] N2p + O -> Op + N2
+ [elec1] NOp + e -> .2*N + .8*N2D + O
+ [elec2] O2p + e -> 1.15*O + .85*O1D
+ [elec3] N2p + e -> 1.1*N + .9*N2D
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, HO2NO2, CLONO2, BRONO2, HCL, N2O5, HOCL, HOBR, HBR
+ End Heterogeneous
+
+ Ext Forcing
+ NO<-dataset, NO2<-dataset, CO<-dataset, Op, O2p, Np, N2p, N2D, N, e, OH
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
diff --git a/chem_proc/inputs/waccm3_57spc_JPL06_ccmval_clbrfam.inp b/chem_proc/inputs/waccm3_57spc_JPL06_ccmval_clbrfam.inp
new file mode 100644
index 0000000000..f2038e2cd9
--- /dev/null
+++ b/chem_proc/inputs/waccm3_57spc_JPL06_ccmval_clbrfam.inp
@@ -0,0 +1,373 @@
+BEGSIM
+output_unit_number = 7
+output_file = waccm3_57spc_JPL06_ccmval_clbrfam.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = waccm3_57spc_JPL06_ccmval_clbrfam.dat
+
+Comments
+ "This is a waccm3 simulation with:"
+ "(1) The new advection routine Lin Rood"
+ "(2) WACCM dynamical inputs"
+ "(3) Strat, Meso, and Thermospheric mechanism"
+ "(4) JPL06 Kinetics"
+ "(5) CCMVal Mechanism, 2008"
+ "(6) Transporting total ClOY"
+ "(6) Transporting total BROY"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CLY, BRY
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2
+ Np -> N, Op -> O, NOp -> NO, e, N2D -> N, H2O
+ End Solution
+
+ Fixed
+ M, N2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2, CLY, BRY
+ End explicit
+ Implicit
+ O3, O, O1D, O2, O2_1S, O2_1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e
+ End implicit
+ End Solution classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2_a=userdefined,] O2 + hv -> O + O1D
+ [jo2_b=userdefined,] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2_1D
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno=userdefined,] NO + hv -> N + O
+ [jno_i] NO + hv -> NOp + e
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [jclo] CLO + hv -> O + CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+*------------------------------------------------------------------------------
+* photo-ionization
+*------------------------------------------------------------------------------
+ [jeuv_1=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_2=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_3=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_4=userdefined,userdefined] N + hv -> Np + e
+ [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+
+ [jeuv_14=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_15=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_16=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr_O_O2] O + O2 + M -> O3 + M
+ [cph1,cph] O + O3 -> 2*O2 ; 8.00e-12, -2060.
+ [usr_O_O] O + O + M -> O2 + M
+ [cph18,cph] O2_1S + O -> O2_1D + O ; 8.00e-14
+ [cph19,cph] O2_1S + O2 -> O2_1D + O2 ; 3.90e-17
+ [cph20,cph] O2_1S + N2 -> O2_1D + N2 ; 1.80e-15, 45.
+ [cph21,cph] O2_1S + O3 -> O2_1D + O3 ; 3.50e-11, -135.
+ O2_1S + CO2 -> O2_1D + CO2 ; 4.20e-13
+ [ag2,cph] O2_1S -> O2 ; 8.50e-2
+ [cph22,cph] O2_1D + O -> O2 + O ; 1.30e-16
+ [cph23,cph] O2_1D + O2 -> 2 * O2 ; 3.60e-18, -220.
+ [cph24,cph] O2_1D + N2 -> O2 + N2 ; 1.00e-20
+ [ag1,cph] O2_1D -> O2 ; 2.58e-04
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions (O1D only)
+* --------------------------------------------------------------
+ [cph17,cph] O1D + N2 -> O + N2 ; 2.15e-11, 110.
+ [cph16,cph] O1D + O2 -> O + O2_1S ; 3.135e-11, 55.
+ [cph29,cph] O1D + O2 -> O + O2 ; 1.65e-12, 55.
+ O1D + H2O -> 2*OH ; 1.63e-10, 60.
+ O1D + N2O -> 2*NO ; 6.70e-11, 20.
+ O1D + N2O -> N2 + O2 ; 4.70e-11, 20.
+ O1D + O3 -> O2 + O2 ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CCL4 -> 4CL ; 2.84e-10
+ O1D + CH3BR -> BR ; 1.80e-10
+ O1D + CF2CLBR -> BR ; 9.60e-11
+ O1D + CF3BR -> BR ; 4.10e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.00e-11
+ O1D + CH4 -> CH2O + H2 ; 7.50e-12
+ O1D + H2 -> H + OH ; 1.10e-10
+ O1D + HCL -> CL + OH ; 1.50e-10
+ O1D + HBR -> BR + OH ; 1.50e-10
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ [cph25,cph] N2D + O2 -> NO + O1D ; 5.00e-12
+*[cph26,cph] N2D + O -> N + O ; 4.50e-13
+ [cph26,cph] N2D + O -> N + O ; 7.00e-13
+ [cph27,cph] N + O2 -> NO + O ; 1.50e-11, -3600.
+ [cph28,cph] N + NO -> N2 + O ; 2.10e-11, 100.
+ N + NO2 -> N2O + O ; 5.80e-12, 220.
+ NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6
+ [cph8,cph] NO + HO2 -> NO2 + OH ; 3.50e-12, 250.
+ [cph12,cph] NO + O3 -> NO2 + O2 ; 3.00e-12, -1500.
+ [cph13,cph] NO2 + O -> NO + O2 ; 5.20e-12, 210.
+ NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450.
+ [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6
+ [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M
+ NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6
+ [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.50e-11, 170.
+ NO3 + O -> NO2 + O2 ; 1.00e-11
+ NO3 + OH -> HO2 + NO2 ; 2.20e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12
+ [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380.
+ [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M
+
+* --------------------------------------------------------------
+* Methane, CO, CH2O and derivatives
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775.
+ CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300.
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750.
+ CH3OOH + OH -> CH3O2 + H2O ; 3.80e-12, 200.
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 5.80e-16
+ CH2O + OH -> CO + H2O + H ; 5.50e-12, 125.
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.
+ CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6
+ [usr_CO_OH_b] CO + OH -> CO2 + H
+
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ [cph5,cph] H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 4.7e-11, 0.2, 0.6
+ [cph7,cph] H + O3 -> OH + O2 ; 1.40e-10, -470.
+ H + HO2 -> 2*OH ; 7.20e-11
+ [cph15,cph] H + HO2 -> H2 + O2 ; 6.90e-12
+ H + HO2 -> H2O + O ; 1.60e-12
+ [cph3,cph] OH + O -> H + O2 ; 2.20e-11, 120.
+ [cph11,cph] OH + O3 -> HO2 + O2 ; 1.70e-12, -940.
+ [cph14,cph] OH + HO2 -> H2O + O2 ; 4.80e-11, 250.
+ OH + OH -> H2O + O ; 1.80e-12
+ OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.6e-11, 0.0, 0.6
+ OH + H2 -> H2O + H ; 2.80e-12, -1800.
+ OH + H2O2 -> H2O + HO2 ; 1.80e-12
+ [cph4,cph] HO2 + O -> OH + O2 ; 3.00e-11, 200.
+ [cph9,cph] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490.
+ [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.40e-12, -2000.
+
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200.
+ CL + H2 -> HCL + H ; 3.05e-11, -2270.
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.
+ CL + HO2 -> HCL + O2 ; 1.80e-11, 170.
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.
+ CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280.
+ CLO + O -> CL + O2 ; 2.80e-11, 85.
+ CLO + OH -> CL + HO2 ; 7.40e-12, 270.
+ CLO + OH -> HCL + O2 ; 6.00e-13, 230.
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220.
+ CLO + NO -> NO2 + CL ; 6.40e-12 , 290.
+ CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.
+ [tag_CLO_CLO] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 2.0e-12, 2.4, 0.6
+ [usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350.
+ HCL + O -> CL + OH ; 1.00e-11, -3300.
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130.
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500.
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800.
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330.
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 4.80e-12, -310.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 1.70e-11, 250.
+ BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230.
+ HBR + OH -> BR + H2O ; 5.50e-12, 200.
+ HBR + O -> BR + OH ; 5.80e-12, -1500.
+ HOBR + O -> BRO + OH ; 1.20e-10, -430.
+ BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215.
+
+* --------------------------------------------------------------
+* Organic Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130.
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250.
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520.
+ HCFC22 + OH -> CL + H2O + CF2O ; 1.05e-12, -1600.
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300.
+
+* --------------------------------------------------------------
+* Sulfate aerosol reactions
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+* --------------------------------------------------------------
+* Ice aerosol reactions
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Ion reactions
+* --------------------------------------------------------------
+ [ion1] Op + O2 -> O2p + O
+ [ion2] Op + N2 -> NOp + N
+ [ion3] N2p + O -> NOp + N2D
+ [ion4,cph] O2p + N -> NOp + O ; 1.e-10
+ [ion5,cph] O2p + NO -> NOp + O2 ; 4.4e-10
+ [ion6,cph] Np + O2 -> O2p + N ; 4.e-10
+ [ion7,cph] Np + O2 -> NOp + O ; 2.e-10
+ [ion8,cph] Np + O -> Op + N ; 1.e-12
+ [ion9,cph] N2p + O2 -> O2p + N2 ; 6.e-11
+ O2p + N2 -> NOp + NO ; 5.e-16
+ [ion11] N2p + O -> Op + N2
+ [elec1] NOp + e -> .2*N + .8*N2D + O
+ [elec2] O2p + e -> 1.15*O + .85*O1D
+ [elec3] N2p + e -> 1.1*N + .9*N2D
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, HO2NO2, CLONO2, BRONO2, HCL, N2O5, HOCL, HOBR, HBR
+ End Heterogeneous
+
+ Ext Forcing
+ NO<-dataset, NO2<-dataset, CO<-dataset, Op, O2p, Np, N2p, N2D, N, e, OH
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/waccm3_57spc_JPL06_ccmval_cloytracer.inp b/chem_proc/inputs/waccm3_57spc_JPL06_ccmval_cloytracer.inp
new file mode 100644
index 0000000000..95a69d0ee6
--- /dev/null
+++ b/chem_proc/inputs/waccm3_57spc_JPL06_ccmval_cloytracer.inp
@@ -0,0 +1,371 @@
+BEGSIM
+output_unit_number = 7
+output_file = waccm3_57spc_JPL06_ccmval_cloytracer.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = waccm3_57spc_JPL06_ccmval_cloytracer.dat
+
+Comments
+ "This is a waccm3 simulation with:"
+ "(1) The new advection routine Lin Rood"
+ "(2) WACCM dynamical inputs"
+ "(3) Strat, Meso, and Thermospheric mechanism"
+ "(4) JPL06 Kinetics"
+ "(5) CCMVal Mechanism, 2008"
+ "(6) Transporting total ClOY"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2, CLY -> Cl13
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2
+ Np -> N, Op -> O, NOp -> NO, e, N2D -> N, H2O
+ End Solution
+
+ Fixed
+ M, N2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2, CLY
+ End explicit
+ Implicit
+ O3, O, O1D, O2, O2_1S, O2_1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e
+ End implicit
+ End Solution classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2_a=userdefined,] O2 + hv -> O + O1D
+ [jo2_b=userdefined,] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2_1D
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno=userdefined,] NO + hv -> N + O
+ [jno_i] NO + hv -> NOp + e
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [jclo] CLO + hv -> O + CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+*------------------------------------------------------------------------------
+* photo-ionization
+*------------------------------------------------------------------------------
+ [jeuv_1=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_2=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_3=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_4=userdefined,userdefined] N + hv -> Np + e
+ [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+
+ [jeuv_14=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_15=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_16=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr1] O + O2 + M -> O3 + M
+ [cph1,cph] O + O3 -> 2*O2 ; 8.00e-12, -2060.
+ [usr2] O + O + M -> O2 + M
+ [cph18,cph] O2_1S + O -> O2_1D + O ; 8.00e-14
+ [cph19,cph] O2_1S + O2 -> O2_1D + O2 ; 3.90e-17
+ [cph20,cph] O2_1S + N2 -> O2_1D + N2 ; 1.80e-15, 45.
+ [cph21,cph] O2_1S + O3 -> O2_1D + O3 ; 3.50e-11, -135.
+ O2_1S + CO2 -> O2_1D + CO2 ; 4.20e-13
+ [ag2,cph] O2_1S -> O2 ; 8.50e-2
+ [cph22,cph] O2_1D + O -> O2 + O ; 1.30e-16
+ [cph23,cph] O2_1D + O2 -> 2 * O2 ; 3.60e-18, -220.
+ [cph24,cph] O2_1D + N2 -> O2 + N2 ; 1.00e-20
+ [ag1,cph] O2_1D -> O2 ; 2.58e-04
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions (O1D only)
+* --------------------------------------------------------------
+ [cph17,cph] O1D + N2 -> O + N2 ; 2.15e-11, 110.
+ [cph16,cph] O1D + O2 -> O + O2_1S ; 3.135e-11, 55.
+ [cph29,cph] O1D + O2 -> O + O2 ; 1.65e-12, 55.
+ O1D + H2O -> 2*OH ; 1.63e-10, 60.
+ O1D + N2O -> 2*NO ; 6.70e-11, 20.
+ O1D + N2O -> N2 + O2 ; 4.70e-11, 20.
+ O1D + O3 -> O2 + O2 ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CCL4 -> 4CL ; 2.84e-10
+ O1D + CH3BR -> BR ; 1.80e-10
+ O1D + CF2CLBR -> BR ; 9.60e-11
+ O1D + CF3BR -> BR ; 4.10e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.00e-11
+ O1D + CH4 -> CH2O + H2 ; 7.50e-12
+ O1D + H2 -> H + OH ; 1.10e-10
+ O1D + HCL -> CL + OH ; 1.50e-10
+ O1D + HBR -> BR + OH ; 1.50e-10
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ [cph25,cph] N2D + O2 -> NO + O1D ; 5.00e-12
+*[cph26,cph] N2D + O -> N + O ; 4.50e-13
+ [cph26,cph] N2D + O -> N + O ; 7.00e-13
+ [cph27,cph] N + O2 -> NO + O ; 1.50e-11, -3600.
+ [cph28,cph] N + NO -> N2 + O ; 2.10e-11, 100.
+ N + NO2 -> N2O + O ; 5.80e-12, 220.
+ NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6
+ [cph8,cph] NO + HO2 -> NO2 + OH ; 3.50e-12, 250.
+ [cph12,cph] NO + O3 -> NO2 + O2 ; 3.00e-12, -1500.
+ [cph13,cph] NO2 + O -> NO + O2 ; 5.20e-12, 210.
+ NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450.
+ [usr3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6
+ [usr3a] N2O5 + M -> NO2 + NO3 + M
+ NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6
+ [usr4] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.50e-11, 170.
+ NO3 + O -> NO2 + O2 ; 1.00e-11
+ NO3 + OH -> HO2 + NO2 ; 2.20e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12
+ [usr5] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380.
+ [usr5a] HO2NO2 + M -> HO2 + NO2 + M
+
+* --------------------------------------------------------------
+* Methane, CO, CH2O and derivatives
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775.
+ CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300.
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750.
+ CH3OOH + OH -> CH3O2 + H2O ; 3.80e-12, 200.
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 5.80e-16
+ CH2O + OH -> CO + H2O + H ; 5.50e-12, 125.
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.
+ CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6
+ [usr6] CO + OH -> CO2 + H
+
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ [cph5,cph] H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 4.7e-11, 0.2, 0.6
+ [cph7,cph] H + O3 -> OH + O2 ; 1.40e-10, -470.
+ H + HO2 -> 2*OH ; 7.20e-11
+ [cph15,cph] H + HO2 -> H2 + O2 ; 6.90e-12
+ H + HO2 -> H2O + O ; 1.60e-12
+ [cph3,cph] OH + O -> H + O2 ; 2.20e-11, 120.
+ [cph11,cph] OH + O3 -> HO2 + O2 ; 1.70e-12, -940.
+ [cph14,cph] OH + HO2 -> H2O + O2 ; 4.80e-11, 250.
+ OH + OH -> H2O + O ; 1.80e-12
+ OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.6e-11, 0.0, 0.6
+ OH + H2 -> H2O + H ; 2.80e-12, -1800.
+ OH + H2O2 -> H2O + HO2 ; 1.80e-12
+ [cph4,cph] HO2 + O -> OH + O2 ; 3.00e-11, 200.
+ [cph9,cph] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490.
+ [usr7] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.40e-12, -2000.
+
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200.
+ CL + H2 -> HCL + H ; 3.05e-11, -2270.
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.
+ CL + HO2 -> HCL + O2 ; 1.80e-11, 170.
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.
+ CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280.
+ CLO + O -> CL + O2 ; 2.80e-11, 85.
+ CLO + OH -> CL + HO2 ; 7.40e-12, 270.
+ CLO + OH -> HCL + O2 ; 6.00e-13, 230.
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220.
+ CLO + NO -> NO2 + CL ; 6.40e-12 , 290.
+ CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.
+ [usr8] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 2.0e-12, 2.4, 0.6
+ [usr8a] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350.
+ HCL + O -> CL + OH ; 1.00e-11, -3300.
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130.
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500.
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800.
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330.
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 4.80e-12, -310.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 1.70e-11, 250.
+ BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230.
+ HBR + OH -> BR + H2O ; 5.50e-12, 200.
+ HBR + O -> BR + OH ; 5.80e-12, -1500.
+ HOBR + O -> BRO + OH ; 1.20e-10, -430.
+ BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215.
+
+* --------------------------------------------------------------
+* Organic Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130.
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250.
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520.
+ HCFC22 + OH -> CL + H2O + CF2O ; 1.05e-12, -1600.
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300.
+
+* --------------------------------------------------------------
+* Sulfate aerosol reactions
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+* --------------------------------------------------------------
+* Ice aerosol reactions
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Ion reactions
+* --------------------------------------------------------------
+ [ion1] Op + O2 -> O2p + O
+ [ion2] Op + N2 -> NOp + N
+ [ion3] N2p + O -> NOp + N2D
+ [ion4,cph] O2p + N -> NOp + O ; 1.e-10
+ [ion5,cph] O2p + NO -> NOp + O2 ; 4.4e-10
+ [ion6,cph] Np + O2 -> O2p + N ; 4.e-10
+ [ion7,cph] Np + O2 -> NOp + O ; 2.e-10
+ [ion8,cph] Np + O -> Op + N ; 1.e-12
+ [ion9,cph] N2p + O2 -> O2p + N2 ; 6.e-11
+ O2p + N2 -> NOp + NO ; 5.e-16
+ [ion11] N2p + O -> Op + N2
+ [elec1] NOp + e -> .2*N + .8*N2D + O
+ [elec2] O2p + e -> 1.15*O + .85*O1D
+ [elec3] N2p + e -> 1.1*N + .9*N2D
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, HO2NO2, CLONO2, BRONO2, HCL, N2O5, HOCL, HOBR, HBR
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, Op, O2p, Np, N2p, N2D, N, e, OH
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+
+ENDSIM
diff --git a/chem_proc/inputs/waccm_ions_spe.inp b/chem_proc/inputs/waccm_ions_spe.inp
new file mode 100644
index 0000000000..302128ce15
--- /dev/null
+++ b/chem_proc/inputs/waccm_ions_spe.inp
@@ -0,0 +1,392 @@
+BEGSIM
+output_unit_number = 7
+output_file = ions.marsh.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = ions.marsh.dat
+
+COMMENTS
+ "This is a waccm2 simulation with:"
+ "(1) The new advection routine Lin Rood"
+ "(2) WACCM dynamical inputs"
+ "(3) Strat, Meso, and Thermospheric mechanism"
+End COMMENTS
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2
+ Np -> N, Op -> O, NOp -> NO, e, N2D -> N, H2O
+ End Solution
+
+ Fixed
+ M, N2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2
+ End explicit
+ Implicit
+ O3, O, O1D, O2, O2_1S, O2_1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e
+ End implicit
+ End Solution classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2_a] O2 + hv -> O + O1D
+ [jo2_b] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2_1D
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno] NO + hv -> N + O
+ [jno_i] NO + hv -> NOp + e
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+*------------------------------------------------------------------------------
+* photo-ionization
+*------------------------------------------------------------------------------
+ [jeuv_1] O + hv -> Op + e
+ [jeuv_2] O + hv -> Op + e
+ [jeuv_3] O + hv -> Op + e
+ [jeuv_4] N + hv -> Np + e
+ [jeuv_5] O2 + hv -> O2p + e
+ [jeuv_6] N2 + hv -> N2p + e
+ [jeuv_7] O2 + hv -> O + Op + e
+ [jeuv_8] O2 + hv -> O + Op + e
+ [jeuv_9] O2 + hv -> O + Op + e
+ [jeuv_10] N2 + hv -> N + Np + e
+ [jeuv_11] N2 + hv -> N2D + Np + e
+ [jeuv_12] O2 + hv -> 2*O
+ [jeuv_13] N2 + hv -> 1.2*N2D + .8*N
+
+ [jeuv_14] O + hv -> Op + e
+ [jeuv_15] O + hv -> Op + e
+ [jeuv_16] O + hv -> Op + e
+ [jeuv_17] O2 + hv -> O2p + e
+ [jeuv_18] N2 + hv -> N2p + e
+ [jeuv_19] O2 + hv -> O + Op + e
+ [jeuv_20] O2 + hv -> O + Op + e
+ [jeuv_21] O2 + hv -> O + Op + e
+ [jeuv_22] N2 + hv -> N + Np + e
+ [jeuv_23] N2 + hv -> N2D + Np + e
+ [jeuv_24] O2 + hv -> 2*O
+ [jeuv_25] N2 + hv -> 1.2*N2D + .8*N
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr1] O + O2 + M -> O3 + M
+ [cph1,cph] O + O3 -> 2*O2 ; 8e-12, -2060
+ [usr2] O + O + M -> O2 + M
+ [cph17,cph] O1D + N2 -> O + N2 ; 1.8e-11, 110
+ [cph16,cph] O1D + O2 -> O + O2_1S ; 3.04e-11, 70
+ [cph29,cph] O1D + O2 -> O + O2 ; 1.60e-12, 70
+ O1D + H2O -> 2*OH ; 2.2e-10
+ O1D + N2O -> 2*NO ; 6.7e-11
+ O1D + N2O -> N2 + O2 ; 4.9e-11
+ O1D + O3 -> O2 + O2 ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.0e-11
+ O1D + CH4 -> CH2O + H2 ; 7.5e-12
+ O1D + H2 -> H + OH ; 1.1e-10
+ O1D + HCL -> CL + OH ; 1.5e-10
+
+ [cph18,cph] O2_1S + O -> O2_1D + O ; 8.e-14
+ [cph19,cph] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17
+ [cph20,cph] O2_1S + N2 -> O2_1D + N2 ; 2.1e-15
+ [cph21,cph] O2_1S + O3 -> O2_1D + O3 ; 2.2e-11
+*new reaction
+ O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13
+ [ag2,cph] O2_1S -> O2 ; 8.5e-2
+
+ [cph22,cph] O2_1D + O -> O2 + O ; 1.3e-16
+ [cph23,cph] O2_1D + O2 -> 2 * O2 ; 3.6e-18,-220
+ [cph24,cph] O2_1D + N2 -> O2 + N2 ; 1.e-20
+ [ag1,cph] O2_1D -> O2 ; 2.58e-4
+
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ [cph25,cph] N2D + O2 -> NO + O1D ; 5.e-12
+*[cph26,cph] N2D + O -> N + O ; 4.5e-13
+ [cph26,cph] N2D + O -> N + O ; 7.e-13
+ [cph27,cph] N + O2 -> NO + O ; 1.5e-11, -3600
+ [cph28,cph] N + NO -> N2 + O ; 2.1e-11, 100
+ NO + O + M -> NO2 + M ; 9.0e-32, 1.5, 3.0e-11, 0., 0.6
+ [cph8,cph] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ [cph12,cph] NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ [cph13,cph] NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, .7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ [usr3] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3a] N2O5 + M -> NO2 + NO3 + M
+ NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ NO3 + O -> NO2 + O2 ; 1.e-11
+ NO3 + OH -> HO2 + NO2 ; 2.2e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12
+ [usr5] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr5a] HO2NO2 + M -> HO2 + NO2 + M
+
+* --------------------------------------------------------------
+* Methane, CO, CH2O and derivatives
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O + H ; 9.e-12
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.0
+ [usr6] CO + OH -> CO2 + H
+
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ [cph5,cph] H + O2 + M -> HO2 + M ; 5.7e-32,1.6, 7.5e-11,0., .6
+ [cph7,cph] H + O3 -> OH + O2 ; 1.40e-10, -470.0
+ H + HO2 -> 2*OH ; 7.21e-11
+ [cph15,cph] H + HO2 -> H2 + O2 ; 7.29e-12
+ H + HO2 -> H2O + O ; 1.62e-12
+ [cph3,cph] OH + O -> H + O2 ; 2.2e-11, 120
+ [cph11,cph] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [cph14,cph] OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1.0, 2.6e-11, 0., .6
+ OH + H2 -> H2O + H ; 5.5e-12, -2000
+ OH + H2O2 -> H2O + HO2 ; 2.9e-12, -160
+ [cph4,cph] HO2 + O -> OH + O2 ; 3e-11, 200
+ [cph9,cph] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr7] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.4e-12, -2000
+
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200
+ CL + H2 -> HCL + H ; 3.70e-11, -2300.0
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.0
+ CL + HO2 -> HCL + O2 ; 1.80e-11, +170.0
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.0
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.0
+ CL + CH4 -> CH3O2 + HCL ; 9.60e-12, -1360
+ CLO + O -> CL + O2 ; 3.00e-11, +70.0
+ CLO + OH -> CL + HO2 ; 7.4e-12, 270
+ CLO + OH -> HCL + O2 ; 6.0e-13, 230
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220
+ CLO + NO -> NO2 + CL ; 6.40e-12, +290.0
+ CLO + NO2 + M -> CLONO2 + M ; 1.8e-31,3.4, 1.5e-11,1.9, .6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.0
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.0
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.0
+ [usr8] CLO + CLO + M -> CL2O2 + M ; 1.6e-32,4.5, 2.0e-12,2.4, .6
+ [usr8a] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350
+ HCL + O -> CL + OH ; 1.00e-11, -3300
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 1.50e-11, -600.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 7.5e-11
+ BRO + HO2 -> HOBR + O2 ; 3.40e-12, 540.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.2e-31,3.2, 6.9e-12,2.9, .6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230.
+ HBR + OH -> BR + H2O ; 1.10e-11
+
+* --------------------------------------------------------------
+* Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 3.20e-11, -1250
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.60e-12, -1520
+ HCFC22 + OH -> CL + H2O + CF2O ; 4.00e-12, -1400
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300
+
+* --------------------------------------------------------------
+* Sulfate aerosol reactions
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+* --------------------------------------------------------------
+* Ice aerosol reactions
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Ion reactions
+* --------------------------------------------------------------
+ [ion1] Op + O2 -> O2p + O
+ [ion2] Op + N2 -> NOp + N
+ [ion3] N2p + O -> NOp + N2D
+ [ion4,cph] O2p + N -> NOp + O ; 1.e-10
+ [ion5,cph] O2p + NO -> NOp + O2 ; 4.4e-10
+ [ion6,cph] Np + O2 -> O2p + N ; 4.e-10
+ [ion7,cph] Np + O2 -> NOp + O ; 2.e-10
+ [ion8,cph] Np + O -> Op + N ; 1.e-12
+ [ion9,cph] N2p + O2 -> O2p + N2 ; 6.e-11
+ O2p + N2 -> NOp + NO ; 5.e-16
+ [ion11] N2p + O -> Op + N2
+ [elec1] NOp + e -> .2*N + .8*N2D + O
+ [elec2] O2p + e -> 1.15*O + .85*O1D
+ [elec3] N2p + e -> 1.1*N + .9*N2D
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, HO2NO2, CLONO2, BRONO2, HCL, N2O5, HOCL, HOBR, HBR
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, Op, O2p, Np, N2p, N2D, N, e, OH
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Spatial Dimensions
+ Longitude points = 128
+ Latitude points = 64
+ Vertical points = 66
+ End Spatial Dimensions
+
+ Numerical Control
+ Implicit Iterations = 11
+ End Numerical Control
+
+ Surface Flux
+ NO, CH2O, CO
+ End Surface Flux
+
+ Surface Deposition
+ O3, NO2, HNO3, CH3OOH, CH2O, CO, H2O2, NO, HO2NO2
+ End Surface Deposition
+
+ Version Options
+ machine = ibm
+ model = cam
+ model_architecture = SCALAR
+ architecture = hybrid
+* vec_ftns = on
+ namemod = on
+ End Version Options
+
+ Outputs
+ File
+ Transported Species = avrg
+ All
+ End Transported Species
+ Surface Flux = avrg
+ NO, H2, CH2O, CO
+ End Surface Flux
+ Deposition velocity = avrg
+ O3, NO2, HNO3, CH3OOH, CH2O, CO, H2O2, H2
+ End Deposition velocity
+ External Forcing = avrg
+ NO, CO
+ End External Forcing
+ End File
+ End Outputs
+
+ End Simulation Parameters
+
+ENDSIM
diff --git a/chem_proc/inputs/waccm_mozart_mech.in b/chem_proc/inputs/waccm_mozart_mech.in
new file mode 100644
index 0000000000..20efdef16e
--- /dev/null
+++ b/chem_proc/inputs/waccm_mozart_mech.in
@@ -0,0 +1,374 @@
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2
+ Np -> N, Op -> O, NOp -> NO, e, N2D -> N, H2O
+ End Solution
+
+ Fixed
+ M, N2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2
+ End explicit
+ Implicit
+ O3, O, O1D, O2, O2_1S, O2_1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e
+ End implicit
+ End Solution classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2_a] O2 + hv -> O + O1D
+ [jo2_b] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2_1D
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno] NO + hv -> N + O
+ [jno_i] NO + hv -> NOp + e
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+*------------------------------------------------------------------------------
+* photo-ionization
+*------------------------------------------------------------------------------
+ [jeuv_1] O + hv -> Op + e
+ [jeuv_2] O + hv -> Op + e
+ [jeuv_3] O + hv -> Op + e
+ [jeuv_4] N + hv -> Np + e
+ [jeuv_5] O2 + hv -> O2p + e
+ [jeuv_6] N2 + hv -> N2p + e
+ [jeuv_7] O2 + hv -> O + Op + e
+ [jeuv_8] O2 + hv -> O + Op + e
+ [jeuv_9] O2 + hv -> O + Op + e
+ [jeuv_10] N2 + hv -> N + Np + e
+ [jeuv_11] N2 + hv -> N2D + Np + e
+ [jeuv_12] O2 + hv -> 2*O
+ [jeuv_13] N2 + hv -> 1.2*N2D + .8*N
+
+ [jeuv_14] O + hv -> Op + e
+ [jeuv_15] O + hv -> Op + e
+ [jeuv_16] O + hv -> Op + e
+ [jeuv_17] O2 + hv -> O2p + e
+ [jeuv_18] N2 + hv -> N2p + e
+ [jeuv_19] O2 + hv -> O + Op + e
+ [jeuv_20] O2 + hv -> O + Op + e
+ [jeuv_21] O2 + hv -> O + Op + e
+ [jeuv_22] N2 + hv -> N + Np + e
+ [jeuv_23] N2 + hv -> N2D + Np + e
+ [jeuv_24] O2 + hv -> 2*O
+ [jeuv_25] N2 + hv -> 1.2*N2D + .8*N
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr1] O + O2 + M -> O3 + M
+ [cph1,cph] O + O3 -> 2*O2 ; 8e-12, -2060
+ [usr2] O + O + M -> O2 + M
+ [cph17,cph] O1D + N2 -> O + N2 ; 1.8e-11, 110
+ [cph16,cph] O1D + O2 -> O + O2_1S ; 3.04e-11, 70
+ [cph29,cph] O1D + O2 -> O + O2 ; 1.60e-12, 70
+ O1D + H2O -> 2*OH ; 2.2e-10
+ O1D + N2O -> 2*NO ; 6.7e-11
+ O1D + N2O -> N2 + O2 ; 4.9e-11
+ O1D + O3 -> O2 + O2 ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.0e-11
+ O1D + CH4 -> CH2O + H2 ; 7.5e-12
+ O1D + H2 -> H + OH ; 1.1e-10
+ O1D + HCL -> CL + OH ; 1.5e-10
+
+ [cph18,cph] O2_1S + O -> O2_1D + O ; 8.e-14
+ [cph19,cph] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17
+ [cph20,cph] O2_1S + N2 -> O2_1D + N2 ; 2.1e-15
+ [cph21,cph] O2_1S + O3 -> O2_1D + O3 ; 2.2e-11
+*new reaction
+ O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13
+ [ag2,cph] O2_1S -> O2 ; 8.5e-2
+
+ [cph22,cph] O2_1D + O -> O2 + O ; 1.3e-16
+ [cph23,cph] O2_1D + O2 -> 2 * O2 ; 3.6e-18,-220
+ [cph24,cph] O2_1D + N2 -> O2 + N2 ; 1.e-20
+ [ag1,cph] O2_1D -> O2 ; 2.58e-4
+
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ [cph25,cph] N2D + O2 -> NO + O1D ; 5.e-12
+*[cph26,cph] N2D + O -> N + O ; 4.5e-13
+ [cph26,cph] N2D + O -> N + O ; 7.e-13
+ [cph27,cph] N + O2 -> NO + O ; 1.5e-11, -3600
+ [cph28,cph] N + NO -> N2 + O ; 2.1e-11, 100
+ NO + O + M -> NO2 + M ; 9.0e-32, 1.5, 3.0e-11, 0., 0.6
+ [cph8,cph] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ [cph12,cph] NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ [cph13,cph] NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, .7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ [usr3] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3a] N2O5 + M -> NO2 + NO3 + M
+ NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ NO3 + O -> NO2 + O2 ; 1.e-11
+ NO3 + OH -> HO2 + NO2 ; 2.2e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12
+ [usr5] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr5a] HO2NO2 + M -> HO2 + NO2 + M
+
+* --------------------------------------------------------------
+* Methane, CO, CH2O and derivatives
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O + H ; 9.e-12
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.0
+ [usr6] CO + OH -> CO2 + H
+
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ [cph5,cph] H + O2 + M -> HO2 + M ; 5.7e-32,1.6, 7.5e-11,0., .6
+ [cph7,cph] H + O3 -> OH + O2 ; 1.40e-10, -470.0
+ H + HO2 -> 2*OH ; 7.21e-11
+ [cph15,cph] H + HO2 -> H2 + O2 ; 7.29e-12
+ H + HO2 -> H2O + O ; 1.62e-12
+ [cph3,cph] OH + O -> H + O2 ; 2.2e-11, 120
+ [cph11,cph] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [cph14,cph] OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1.0, 2.6e-11, 0., .6
+ OH + H2 -> H2O + H ; 5.5e-12, -2000
+ OH + H2O2 -> H2O + HO2 ; 2.9e-12, -160
+ [cph4,cph] HO2 + O -> OH + O2 ; 3e-11, 200
+ [cph9,cph] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr7] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.4e-12, -2000
+
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200
+ CL + H2 -> HCL + H ; 3.70e-11, -2300.0
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.0
+ CL + HO2 -> HCL + O2 ; 1.80e-11, +170.0
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.0
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.0
+ CL + CH4 -> CH3O2 + HCL ; 9.60e-12, -1360
+ CLO + O -> CL + O2 ; 3.00e-11, +70.0
+ CLO + OH -> CL + HO2 ; 7.4e-12, 270
+ CLO + OH -> HCL + O2 ; 6.0e-13, 230
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220
+ CLO + NO -> NO2 + CL ; 6.40e-12, +290.0
+ CLO + NO2 + M -> CLONO2 + M ; 1.8e-31,3.4, 1.5e-11,1.9, .6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.0
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.0
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.0
+ [usr8] CLO + CLO + M -> CL2O2 + M ; 1.6e-32,4.5, 2.0e-12,2.4, .6
+ [usr8a] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350
+ HCL + O -> CL + OH ; 1.00e-11, -3300
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 1.50e-11, -600.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 7.5e-11
+ BRO + HO2 -> HOBR + O2 ; 3.40e-12, 540.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.2e-31,3.2, 6.9e-12,2.9, .6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230.
+ HBR + OH -> BR + H2O ; 1.10e-11
+
+* --------------------------------------------------------------
+* Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 3.20e-11, -1250
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.60e-12, -1520
+ HCFC22 + OH -> CL + H2O + CF2O ; 4.00e-12, -1400
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300
+
+* --------------------------------------------------------------
+* Sulfate aerosol reactions
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+* --------------------------------------------------------------
+* Ice aerosol reactions
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Ion reactions
+* --------------------------------------------------------------
+ [ion1] Op + O2 -> O2p + O
+ [ion2] Op + N2 -> NOp + N
+ [ion3] N2p + O -> NOp + N2D
+ [ion4,cph] O2p + N -> NOp + O ; 1.e-10
+ [ion5,cph] O2p + NO -> NOp + O2 ; 4.4e-10
+ [ion6,cph] Np + O2 -> O2p + N ; 4.e-10
+ [ion7,cph] Np + O2 -> NOp + O ; 2.e-10
+ [ion8,cph] Np + O -> Op + N ; 1.e-12
+ [ion9,cph] N2p + O2 -> O2p + N2 ; 6.e-11
+ O2p + N2 -> NOp + NO ; 5.e-16
+ [ion11] N2p + O -> Op + N2
+ [elec1] NOp + e -> .2*N + .8*N2D + O
+ [elec2] O2p + e -> 1.15*O + .85*O1D
+ [elec3] N2p + e -> 1.1*N + .9*N2D
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, HO2NO2, CLONO2, BRONO2, HCL, N2O5, HOCL, HOBR, HBR
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, Op, O2p, Np, N2p, N2D, N, e, OH
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Spatial Dimensions
+ Longitude points = 128
+ Latitude points = 64
+ Vertical points = 66
+ End Spatial Dimensions
+
+ Numerical Control
+ Implicit Iterations = 11
+ End Numerical Control
+
+ Surface Flux
+ NO, CH2O, CO
+ End Surface Flux
+
+ Surface Deposition
+ O3, NO2, HNO3, CH3OOH, CH2O, CO, H2O2, NO, HO2NO2
+ End Surface Deposition
+
+ Version Options
+ machine = ibm
+ model = cam
+ model_architecture = SCALAR
+ architecture = hybrid
+* vec_ftns = on
+ namemod = on
+ End Version Options
+
+ Outputs
+ File
+ Transported Species = avrg
+ All
+ End Transported Species
+ Surface Flux = avrg
+ NO, H2, CH2O, CO
+ End Surface Flux
+ Deposition velocity = avrg
+ O3, NO2, HNO3, CH3OOH, CH2O, CO, H2O2, H2
+ End Deposition velocity
+ External Forcing = avrg
+ NO, CO
+ End External Forcing
+ End File
+ End Outputs
+
+ End Simulation Parameters
diff --git a/chem_proc/inputs/waccm_mozart_tagged_mech.in b/chem_proc/inputs/waccm_mozart_tagged_mech.in
new file mode 100644
index 0000000000..a14c056681
--- /dev/null
+++ b/chem_proc/inputs/waccm_mozart_tagged_mech.in
@@ -0,0 +1,340 @@
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2
+ Np -> N, Op -> O, NOp -> NO, e, N2D -> N, H2O
+ End Solution
+
+ Fixed
+ M, N2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2
+ End explicit
+ Implicit
+ O3, O, O1D, O2, O2_1S, O2_1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e
+ End implicit
+ End Solution classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2_a=userdefined,] O2 + hv -> O + O1D
+ [jo2_b=userdefined,] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2_1D
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno=userdefined,] NO + hv -> N + O
+ [jno_i] NO + hv -> NOp + e
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+*------------------------------------------------------------------------------
+* photo-ionization
+*------------------------------------------------------------------------------
+ [jeuv_1=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_2=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_3=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_4=userdefined,userdefined] N + hv -> Np + e
+ [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+
+ [jeuv_14=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_15=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_16=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr1] O + O2 + M -> O3 + M
+ [cph1,cph] O + O3 -> 2*O2 ; 8e-12, -2060
+ [usr2] O + O + M -> O2 + M
+ [cph17,cph] O1D + N2 -> O + N2 ; 1.8e-11, 110
+ [cph16,cph] O1D + O2 -> O + O2_1S ; 3.04e-11, 70
+ [cph29,cph] O1D + O2 -> O + O2 ; 1.60e-12, 70
+ O1D + H2O -> 2*OH ; 2.2e-10
+ O1D + N2O -> 2*NO ; 6.7e-11
+ O1D + N2O -> N2 + O2 ; 4.9e-11
+ O1D + O3 -> O2 + O2 ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.0e-11
+ O1D + CH4 -> CH2O + H2 ; 7.5e-12
+ O1D + H2 -> H + OH ; 1.1e-10
+ O1D + HCL -> CL + OH ; 1.5e-10
+
+ [cph18,cph] O2_1S + O -> O2_1D + O ; 8.e-14
+ [cph19,cph] O2_1S + O2 -> O2_1D + O2 ; 3.9e-17
+ [cph20,cph] O2_1S + N2 -> O2_1D + N2 ; 2.1e-15
+ [cph21,cph] O2_1S + O3 -> O2_1D + O3 ; 2.2e-11
+*new reaction
+ O2_1S + CO2 -> O2_1D + CO2 ; 4.2e-13
+ [ag2,cph] O2_1S -> O2 ; 8.5e-2
+
+ [cph22,cph] O2_1D + O -> O2 + O ; 1.3e-16
+ [cph23,cph] O2_1D + O2 -> 2 * O2 ; 3.6e-18,-220
+ [cph24,cph] O2_1D + N2 -> O2 + N2 ; 1.e-20
+ [ag1,cph] O2_1D -> O2 ; 2.58e-4
+
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ [cph25,cph] N2D + O2 -> NO + O1D ; 5.e-12
+*[cph26,cph] N2D + O -> N + O ; 4.5e-13
+ [cph26,cph] N2D + O -> N + O ; 7.e-13
+ [cph27,cph] N + O2 -> NO + O ; 1.5e-11, -3600
+ [cph28,cph] N + NO -> N2 + O ; 2.1e-11, 100
+ NO + O + M -> NO2 + M ; 9.0e-32, 1.5, 3.0e-11, 0., 0.6
+ [cph8,cph] NO + HO2 -> NO2 + OH ; 3.5e-12, 250
+ [cph12,cph] NO + O3 -> NO2 + O2 ; 3e-12, -1500
+ [cph13,cph] NO2 + O -> NO + O2 ; 5.6e-12, 180
+ NO2 + O + M -> NO3 + M ; 2.5e-31, 1.8, 2.2e-11, .7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.2e-13, -2450
+ [usr3] NO2 + NO3 + M -> N2O5 + M ; 2.e-30,4.4, 1.4e-12,.7, .6
+ [usr3a] N2O5 + M -> NO2 + NO3 + M
+ NO2 + OH + M -> HNO3 + M ; 2.0e-30,3.0, 2.5e-11,0., .6
+ [usr4] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.5e-11, 170
+ NO3 + O -> NO2 + O2 ; 1.e-11
+ NO3 + OH -> HO2 + NO2 ; 2.2e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.5e-12
+ [usr5] NO2 + HO2 + M -> HO2NO2 + M ; 1.8e-31,3.2, 4.7e-12,1.4, .6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.3e-12, 380
+ [usr5a] HO2NO2 + M -> HO2 + NO2 + M
+
+* --------------------------------------------------------------
+* Methane, CO, CH2O and derivatives
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775
+ CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.8e-12, 300
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.1e-13, 750
+ CH3OOH + OH -> CH3O2 + H2O ; 3.8e-12, 200
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.0e-13, -2058
+ CH2O + OH -> CO + H2O + H ; 9.e-12
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.0
+ [usr6] CO + OH -> CO2 + H
+
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ [cph5,cph] H + O2 + M -> HO2 + M ; 5.7e-32,1.6, 7.5e-11,0., .6
+ [cph7,cph] H + O3 -> OH + O2 ; 1.40e-10, -470.0
+ H + HO2 -> 2*OH ; 7.21e-11
+ [cph15,cph] H + HO2 -> H2 + O2 ; 7.29e-12
+ H + HO2 -> H2O + O ; 1.62e-12
+ [cph3,cph] OH + O -> H + O2 ; 2.2e-11, 120
+ [cph11,cph] OH + O3 -> HO2 + O2 ; 1.7e-12, -940
+ [cph14,cph] OH + HO2 -> H2O + O2 ; 4.8e-11, 250
+ OH + OH -> H2O + O ; 4.2e-12, -240
+ OH + OH + M -> H2O2 + M ; 6.9e-31,1.0, 2.6e-11, 0., .6
+ OH + H2 -> H2O + H ; 5.5e-12, -2000
+ OH + H2O2 -> H2O + HO2 ; 2.9e-12, -160
+ [cph4,cph] HO2 + O -> OH + O2 ; 3e-11, 200
+ [cph9,cph] HO2 + O3 -> OH + 2*O2 ; 1.e-14, -490
+ [usr7] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.4e-12, -2000
+
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200
+ CL + H2 -> HCL + H ; 3.70e-11, -2300.0
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.0
+ CL + HO2 -> HCL + O2 ; 1.80e-11, +170.0
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.0
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.0
+ CL + CH4 -> CH3O2 + HCL ; 9.60e-12, -1360
+ CLO + O -> CL + O2 ; 3.00e-11, +70.0
+ CLO + OH -> CL + HO2 ; 7.4e-12, 270
+ CLO + OH -> HCL + O2 ; 6.0e-13, 230
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220
+ CLO + NO -> NO2 + CL ; 6.40e-12, +290.0
+ CLO + NO2 + M -> CLONO2 + M ; 1.8e-31,3.4, 1.5e-11,1.9, .6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.0
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.0
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.0
+ [usr8] CLO + CLO + M -> CL2O2 + M ; 1.6e-32,4.5, 2.0e-12,2.4, .6
+ [usr8a] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350
+ HCL + O -> CL + OH ; 1.00e-11, -3300
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 1.50e-11, -600.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 7.5e-11
+ BRO + HO2 -> HOBR + O2 ; 3.40e-12, 540.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.2e-31,3.2, 6.9e-12,2.9, .6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.5e-12, 230.
+ HBR + OH -> BR + H2O ; 1.10e-11
+
+* --------------------------------------------------------------
+* Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 3.20e-11, -1250
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.60e-12, -1520
+ HCFC22 + OH -> CL + H2O + CF2O ; 4.00e-12, -1400
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300
+
+* --------------------------------------------------------------
+* Sulfate aerosol reactions
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+* --------------------------------------------------------------
+* Ice aerosol reactions
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+* --------------------------------------------------------------
+* Ion reactions
+* --------------------------------------------------------------
+ [ion1] Op + O2 -> O2p + O
+ [ion2] Op + N2 -> NOp + N
+ [ion3] N2p + O -> NOp + N2D
+ [ion4,cph] O2p + N -> NOp + O ; 1.e-10
+ [ion5,cph] O2p + NO -> NOp + O2 ; 4.4e-10
+ [ion6,cph] Np + O2 -> O2p + N ; 4.e-10
+ [ion7,cph] Np + O2 -> NOp + O ; 2.e-10
+ [ion8,cph] Np + O -> Op + N ; 1.e-12
+ [ion9,cph] N2p + O2 -> O2p + N2 ; 6.e-11
+ O2p + N2 -> NOp + NO ; 5.e-16
+ [ion11] N2p + O -> Op + N2
+ [elec1] NOp + e -> .2*N + .8*N2D + O
+ [elec2] O2p + e -> 1.15*O + .85*O1D
+ [elec3] N2p + e -> 1.1*N + .9*N2D
+ End Reactions
+
+ Heterogeneous
+ H2O2, HNO3, CH2O, CH3OOH, HO2NO2, CLONO2, BRONO2, HCL, N2O5, HOCL, HOBR, HBR
+ End Heterogeneous
+
+ Ext Forcing
+ NO, CO, Op, O2p, Np, N2p, N2D, N, e, OH
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = ibm
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
diff --git a/chem_proc/inputs/waccm_tslt_v3.inp b/chem_proc/inputs/waccm_tslt_v3.inp
new file mode 100644
index 0000000000..84d92745b2
--- /dev/null
+++ b/chem_proc/inputs/waccm_tslt_v3.inp
@@ -0,0 +1,650 @@
+BEGSIM
+output_unit_number = 7
+output_file = waccm_tslt_v3.doc
+procout_path = ../output/
+src_path = ../bkend/
+procfiles_path = ../procfiles/cam/
+sim_dat_path = ../output/
+sim_dat_filename = waccm_tslt_v3.dat
+
+Comments
+ "This is a waccm TSLT simulation with:"
+ "(1) The new advection routine Lin Rood"
+ "(2) WACCM dynamical inputs"
+ "(3) Strat, Meso, and Thermospheric mechanism"
+ "(4) JPL06 Kinetics"
+ "(5) CCMVal Mechanism, 2008"
+ "(6) Transporting total ClOY"
+ "(6) Transporting total BROY"
+End Comments
+
+ SPECIES
+
+ Solution
+ O3, O, O1D -> O, O2, O2_1S -> O2, O2_1D -> O2
+ N2O, N, NO, NO2, NO3, HNO3, HO2NO2, N2O5
+ CH4, CH3O2, CH3OOH, CH3OH, CH2O, CO
+ H2, H, OH, HO2, H2O2
+ CLY, BRY
+ CL -> Cl, CL2 -> Cl2, CLO -> ClO, OCLO -> OClO, CL2O2 -> Cl2O2
+ HCL -> HCl, HOCL -> HOCl, CLONO2 -> ClONO2, BRCL -> BrCl
+ BR -> Br, BRO -> BrO, HBR -> HBr, HOBR -> HOBr, BRONO2 -> BrONO2
+ HCN, CH3CN, C2H4, C2H6, C2H5O2, C2H5OOH, CH3CO3, CH3COOH, CH3CHO, C2H5OH, GLYALD -> HOCH2CHO
+ GLYOXAL -> C2H2O2, CH3COOOH, EO2 -> HOCH2CH2O2, EO -> HOCH2CH2O, PAN -> CH3CO3NO2
+ C3H6, C3H8, C3H7O2, C3H7OOH, CH3COCH3, PO2 -> C3H6OHO2, POOH -> C3H6OHOOH, HYAC -> CH3COCH2OH
+ RO2 -> CH3COCH2O2, CH3COCHO, ROOH -> CH3COCH2OOH
+ BIGENE -> C4H8, BIGALK -> C5H12, MEK -> C4H8O, ENEO2 -> C4H9O3, MEKO2 -> C4H7O3, MEKOOH -> C4H8O3
+ MCO3 -> CH2CCH3CO3, MVK -> CH2CHCOCH3, MACR -> CH2CCH3CHO
+ MACRO2 -> CH3COCHO2CH2OH, MACROOH -> CH3COCHOOHCH2OH, MPAN -> CH2CCH3CO3NO2, ONIT -> CH3COCH2ONO2
+ ISOP -> C5H8, ALKO2 -> C5H11O2, ALKOOH -> C5H12O2, BIGALD -> C5H6O2, HYDRALD -> HOCH2CCH3CHCHO
+ ISOPO2 -> HOCH2COOCH3CHCH2, ISOPNO3 -> CH2CHCCH3OOCH2ONO2, ONITR -> CH2CCH3CHONO2CH2OH
+ XO2 -> HOCH2COOCH3CHOHCHO, XOOH -> HOCH2COOHCH3CHOHCHO, ISOPOOH -> HOCH2COOHCH3CHCH2
+ TOLUENE -> C7H8, CRESOL -> C7H8O, TOLO2 -> C7H9O5, TOLOOH -> C7H10O6, XOH -> C7H10O6
+ C10H16, TERPO2 -> C10H17O3, TERPOOH -> C10H18O3
+ CH3CL -> CH3Cl, CH3BR -> CH3Br, CFC11 -> CFCl3, CFC12 -> CF2Cl2
+ CFC113 -> CCl2FCClF2, HCFC22 -> CHF2Cl, CCL4 -> CCl4, CH3CCL3 -> CH3CCl3
+ CF3BR -> CF3Br, CF2CLBR -> CF2ClBr, CO2, N2p -> N2, O2p -> O2
+ Np -> N, Op -> O, NOp -> NO, e, N2D -> N, H2O
+ C2H2, HCOOH, HOCH2OO
+ End Solution
+
+ Fixed
+ M, N2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ END Species
+
+ Solution classes
+ Explicit
+ CH4, N2O, CO, H2, CH3CL, CH3BR, CFC11, CFC12, CFC113
+ HCFC22, CCL4, CH3CCL3, CF3BR, CF2CLBR, CO2, CLY, BRY
+ End explicit
+ Implicit
+ O3, O, O1D, O2, O2_1S, O2_1D
+ N, NO, NO2, OH, NO3, HNO3, HO2NO2, N2O5
+ CH3O2, CH3OOH, HCN, CH3CN, CH2O, H, HO2, H2O2, H2O
+ CL, CL2, CLO, OCLO, CL2O2, HCL, HOCL, CLONO2, BRCL
+ BR, BRO, HBR, HOBR, BRONO2, N2p, O2p, Np, Op, NOp, N2D, e
+ C3H6, ISOP, PO2, CH3CHO, CH3COOH
+ POOH, CH3CO3, CH3COOOH, PAN, ONIT, C2H6, C2H4, BIGALK, MPAN
+ BIGENE, ENEO2, ALKO2, ALKOOH, MEK, MEKO2, MEKOOH, TOLUENE
+ CRESOL, TOLO2, TOLOOH, XOH, TERPO2, TERPOOH, BIGALD, GLYOXAL
+ ISOPO2, MVK, MACR, MACRO2, MACROOH
+ MCO3, C2H5O2, C2H5OOH, C10H16
+ C3H8, C3H7O2, C3H7OOH, CH3COCH3, ROOH
+ CH3OH, C2H5OH, GLYALD, HYAC, EO2
+ EO, HYDRALD, RO2, CH3COCHO, ISOPNO3, ONITR
+ XO2, XOOH, ISOPOOH
+ C2H2, HCOOH, HOCH2OO
+ End implicit
+ End Solution classes
+
+ CHEMISTRY
+ Photolysis
+ [jo2_a=userdefined,] O2 + hv -> O + O1D
+ [jo2_b=userdefined,] O2 + hv -> 2*O
+ [jo3_a] O3 + hv -> O1D + O2_1D
+ [jo3_b] O3 + hv -> O + O2
+ [jn2o] N2O + hv -> O1D + N2
+ [jno=userdefined,] NO + hv -> N + O
+ [jno_i] NO + hv -> NOp + e
+ [jno2] NO2 + hv -> NO + O
+ [jn2o5_a] N2O5 + hv -> NO2 + NO3
+ [jn2o5_b] N2O5 + hv -> NO + O + NO3
+ [jhno3] HNO3 + hv -> NO2 + OH
+ [jno3_a] NO3 + hv -> NO2 + O
+ [jno3_b] NO3 + hv -> NO + O2
+ [jho2no2_a] HO2NO2 + hv -> OH + NO3
+ [jho2no2_b] HO2NO2 + hv -> NO2 + HO2
+ [jch3ooh] CH3OOH + hv -> CH2O + H + OH
+ [jch2o_a] CH2O + hv -> CO + 2*H
+ [jch2o_b] CH2O + hv -> CO + H2
+ [jh2o_a] H2O + hv -> OH + H
+ [jh2o_b] H2O + hv -> H2 + O1D
+ [jh2o_c] H2O + hv -> 2*H + O
+ [jh2o2] H2O2 + hv -> 2*OH
+ [jcl2] CL2 + hv -> 2*CL
+ [joclo] OCLO + hv -> O + CLO
+ [jcl2o2] CL2O2 + hv -> 2*CL
+ [jhocl] HOCL + hv -> OH + CL
+ [jhcl] HCL + hv -> H + CL
+ [jclono2_a] CLONO2 + hv -> CL + NO3
+ [jclono2_b] CLONO2 + hv -> CLO + NO2
+ [jbrcl] BRCL + hv -> BR + CL
+ [jbro] BRO + hv -> BR + O
+ [jhobr] HOBR + hv -> BR + OH
+ [jbrono2_a] BRONO2 + hv -> BR + NO3
+ [jbrono2_b] BRONO2 + hv -> BRO + NO2
+ [jch3cl] CH3CL + hv -> CL + CH3O2
+ [jccl4] CCL4 + hv -> 4*CL
+ [jch3ccl3] CH3CCL3 + hv -> 3*CL
+ [jcfcl3] CFC11 + hv -> 3*CL
+ [jcf2cl2] CFC12 + hv -> 2*CL
+ [jcfc113] CFC113 + hv -> 3*CL
+ [jhcfc22] HCFC22 + hv -> CL
+ [jch3br] CH3BR + hv -> BR + CH3O2
+ [jcf3br] CF3BR + hv -> BR
+ [jcf2clbr] CF2CLBR + hv -> BR + CL
+ [jco2] CO2 + hv -> CO + O
+ [jch4_a] CH4 + hv -> H + CH3O2
+ [jch4_b] CH4 + hv -> 1.44*H2 + .18*CH2O + .18*O + .66*OH + .44*CO2 + .38*CO + .05*H2O
+ [jch3cho] CH3CHO + hv -> CH3O2 + CO + HO2
+ [jpooh->,jch3ooh] POOH + hv -> CH3CHO + CH2O + HO2 + OH
+ [jch3co3h->,0.28*jh2o2] CH3COOOH + hv -> CH3O2 + OH + CO2
+ [jpan] PAN + hv -> .6*CH3CO3 + .6*NO2 + .4*CH3O2 + .4*NO3
+ [jmpan->,jpan] MPAN + hv -> MCO3 + NO2
+ [jmacr_a] MACR -> 1.34 * HO2 + .66 * MCO3 + 1.34 * CH2O + 1.34 * CH3CO3
+ [jmacr_b] MACR -> .66 * OH + 1.34 * CO
+ [jmvk] MVK + hv -> .7 * C3H6 + .7 * CO + .3 * CH3O2 + .3 * CH3CO3
+ [jc2h5ooh->,jch3ooh] C2H5OOH + hv -> CH3CHO + HO2 + OH
+ [jc3h7ooh->,jch3ooh] C3H7OOH + hv -> 0.82 * CH3COCH3 + OH + HO2
+ [jrooh->,jch3ooh] ROOH + hv -> CH3CO3 + CH2O + OH
+ [jacet] CH3COCH3 + hv -> CH3CO3 + CH3O2
+ [jmgly] CH3COCHO + hv -> CH3CO3 + CO + HO2
+ [jxooh->,jch3ooh] XOOH + hv -> OH
+ [jonitr->,jch3ooh] ONITR + hv -> HO2 + CO + NO2 + CH2O
+ [jisopooh->,jch3ooh] ISOPOOH + hv -> .402 * MVK + .288 * MACR + .69 * CH2O + HO2
+ [jhyac] HYAC + hv -> CH3CO3 + HO2 + CH2O
+ [jglyald] GLYALD + hv -> 2 * HO2 + CO + CH2O
+ [jmek->,jacet] MEK + hv -> CH3CO3 + C2H5O2
+ [jbigald->,0.2*jno2] BIGALD + hv -> .45*CO + .13*GLYOXAL +.56*HO2 + .13*CH3CO3 + .18*CH3COCHO
+ [jglyoxal->,jmgly] GLYOXAL + hv -> 2*CO + 2*HO2
+ [jalkooh->,jch3ooh] ALKOOH + hv -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 + .9*HO2 + .8*MEK + OH
+ [jmekooh->,jch3ooh] MEKOOH + hv -> OH + CH3CO3 + CH3CHO
+ [jtolooh->,jch3ooh] TOLOOH + hv -> OH + .45*GLYOXAL + .45*CH3COCHO + .9*BIGALD
+ [jterpooh->,jch3ooh] TERPOOH + hv -> OH + .1*CH3COCH3 + HO2 + MVK + MACR
+
+*------------------------------------------------------------------------------
+* photo-ionization
+*------------------------------------------------------------------------------
+ [jeuv_1=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_2=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_3=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_4=userdefined,userdefined] N + hv -> Np + e
+ [jeuv_5=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_6=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_7=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_8=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_9=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_10=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_11=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_12=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_13=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+ [jeuv_14=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_15=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_16=userdefined,userdefined] O + hv -> Op + e
+ [jeuv_17=userdefined,userdefined] O2 + hv -> O2p + e
+ [jeuv_18=userdefined,userdefined] N2 + hv -> N2p + e
+ [jeuv_19=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_20=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_21=userdefined,userdefined] O2 + hv -> O + Op + e
+ [jeuv_22=userdefined,userdefined] N2 + hv -> N + Np + e
+ [jeuv_23=userdefined,userdefined] N2 + hv -> N2D + Np + e
+ [jeuv_24=userdefined,userdefined] O2 + hv -> 2*O
+ [jeuv_25=userdefined,userdefined] N2 + hv -> 1.2*N2D + .8*N
+ [jeuv_26=userdefined,userdefined] CO2 + hv -> CO + O
+ End Photolysis
+
+ Reactions
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions
+* --------------------------------------------------------------
+ [usr_O_O2] O + O2 + M -> O3 + M
+ [cph1,cph] O + O3 -> 2*O2 ; 8.00e-12, -2060.
+ [usr_O_O] O + O + M -> O2 + M
+ [cph18,cph] O2_1S + O -> O2_1D + O ; 8.00e-14
+ [cph19,cph] O2_1S + O2 -> O2_1D + O2 ; 3.90e-17
+ [cph20,cph] O2_1S + N2 -> O2_1D + N2 ; 1.80e-15, 45.
+ [cph21,cph] O2_1S + O3 -> O2_1D + O3 ; 3.50e-11, -135.
+ O2_1S + CO2 -> O2_1D + CO2 ; 4.20e-13
+ [ag2,cph] O2_1S -> O2 ; 8.50e-2
+ [cph22,cph] O2_1D + O -> O2 + O ; 1.30e-16
+ [cph23,cph] O2_1D + O2 -> 2 * O2 ; 3.60e-18, -220.
+ [cph24,cph] O2_1D + N2 -> O2 + N2 ; 1.00e-20
+ [ag1,cph] O2_1D -> O2 ; 2.58e-04
+* --------------------------------------------------------------
+* Odd-Oxygen Reactions (O1D only)
+* --------------------------------------------------------------
+ [cph17,cph] O1D + N2 -> O + N2 ; 2.15e-11, 110.
+ [cph16,cph] O1D + O2 -> O + O2_1S ; 3.135e-11, 55.
+ [cph29,cph] O1D + O2 -> O + O2 ; 1.65e-12, 55.
+ O1D + H2O -> 2*OH ; 1.63e-10, 60.
+ O1D + N2O -> 2*NO ; 6.70e-11, 20.
+ O1D + N2O -> N2 + O2 ; 4.70e-11, 20.
+ O1D + O3 -> O2 + O2 ; 1.20e-10
+ O1D + CFC11 -> 3*CL ; 1.70e-10
+ O1D + CFC12 -> 2*CL ; 1.20e-10
+ O1D + CFC113 -> 3*CL ; 1.50e-10
+ O1D + HCFC22 -> CL ; 7.20e-11
+ O1D + CCL4 -> 4*CL ; 2.84e-10
+ O1D + CH3BR -> BR ; 1.80e-10
+ O1D + CF2CLBR -> BR ; 9.60e-11
+ O1D + CF3BR -> BR ; 4.10e-11
+ O1D + CH4 -> CH3O2 + OH ; 1.125e-10
+ O1D + CH4 -> CH2O + H + HO2 ; 3.00e-11
+ O1D + CH4 -> CH2O + H2 ; 7.50e-12
+ O1D + H2 -> H + OH ; 1.10e-10
+ O1D + HCL -> CL + OH ; 1.50e-10
+ O1D + HBR -> BR + OH ; 1.50e-10
+ O1D + HCN -> HO2 ; 7.70e-11, 100.
+* --------------------------------------------------------------
+* Odd Hydrogen Reactions
+* --------------------------------------------------------------
+ [cph5,cph] H + O2 + M -> HO2 + M ; 4.40e-32, 1.3, 4.70e-11, 0.2, 0.6
+ [cph7,cph] H + O3 -> OH + O2 ; 1.40e-10, -470.
+ H + HO2 -> 2*OH ; 7.20e-11
+ [cph15,cph] H + HO2 -> H2 + O2 ; 6.90e-12
+ H + HO2 -> H2O + O ; 1.60e-12
+ [cph3,cph] OH + O -> H + O2 ; 2.20e-11, 120.
+ [cph11,cph] OH + O3 -> HO2 + O2 ; 1.70e-12, -940.
+ [cph14,cph] OH + HO2 -> H2O + O2 ; 4.80e-11, 250.
+ OH + OH -> H2O + O ; 1.80e-12
+ OH + OH + M -> H2O2 + M ; 6.90e-31, 1.0, 2.60e-11, 0.0, 0.6
+ OH + H2 -> H2O + H ; 2.80e-12, -1800.
+ OH + H2O2 -> H2O + HO2 ; 1.80e-12
+ [cph4,cph] HO2 + O -> OH + O2 ; 3.00e-11, 200.
+ [cph9,cph] HO2 + O3 -> OH + 2*O2 ; 1.00e-14, -490.
+ [usr_HO2_HO2] HO2 + HO2 -> H2O2 + O2
+ H2O2 + O -> OH + HO2 ; 1.40e-12, -2000.
+ HCN + OH -> HO2 ; 4.28e-33, 0.0, 9.30e-15, -4.42, 0.8
+ CH3CN + OH -> HO2 ; 7.80e-13, -1050.
+
+* --------------------------------------------------------------
+* Odd Nitrogen Reactions
+* --------------------------------------------------------------
+ [cph25,cph] N2D + O2 -> NO + O1D ; 5.00e-12
+*[cph26,cph] N2D + O -> N + O ; 4.50e-13
+ [cph26,cph] N2D + O -> N + O ; 7.00e-13
+ [cph27,cph] N + O2 -> NO + O ; 1.50e-11, -3600.
+ [cph28,cph] N + NO -> N2 + O ; 2.10e-11, 100.
+ N + NO2 -> N2O + O ; 5.80e-12, 220.
+ NO + O + M -> NO2 + M ; 9.00e-32, 1.5, 3.0e-11, 0.0, 0.6
+ [cph8,cph] NO + HO2 -> NO2 + OH ; 3.50e-12, 250.
+ [cph12,cph] NO + O3 -> NO2 + O2 ; 3.00e-12, -1500.
+ [cph13,cph] NO2 + O -> NO + O2 ; 5.20e-12, 210.
+ NO2 + O + M -> NO3 + M ; 2.50e-31, 1.8, 2.2e-11, 0.7, 0.6
+ NO2 + O3 -> NO3 + O2 ; 1.20e-13, -2450.
+ [tag_NO2_NO3] NO2 + NO3 + M -> N2O5 + M ; 2.00e-30, 4.4, 1.4e-12, 0.7, 0.6
+ [usr_N2O5_M] N2O5 + M -> NO2 + NO3 + M
+ [tag_NO2_OH] NO2 + OH + M -> HNO3 + M ; 1.80e-30, 3.0, 2.8e-11, 0.0, 0.6
+ [usr_HNO3_OH] HNO3 + OH -> NO3 + H2O
+ NO3 + NO -> 2*NO2 ; 1.50e-11, 170.
+ NO3 + O -> NO2 + O2 ; 1.00e-11
+ NO3 + OH -> HO2 + NO2 ; 2.20e-11
+ NO3 + HO2 -> OH + NO2 + O2 ; 3.50e-12
+ [tag_NO2_HO2] NO2 + HO2 + M -> HO2NO2 + M ; 2.00e-31, 3.4, 2.9e-12, 1.1, 0.6
+ HO2NO2 + OH -> H2O + NO2 + O2 ; 1.30e-12, 380.
+ [usr_HO2NO2_M] HO2NO2 + M -> HO2 + NO2 + M
+
+* --------------------------------------------------------------
+* Odd Chlorine Reactions
+* --------------------------------------------------------------
+ CL + O3 -> CLO + O2 ; 2.30e-11, -200.
+ CL + H2 -> HCL + H ; 3.05e-11, -2270.
+ CL + H2O2 -> HCL + HO2 ; 1.10e-11, -980.
+ CL + HO2 -> HCL + O2 ; 1.80e-11, 170.
+ CL + HO2 -> OH + CLO ; 4.10e-11, -450.
+ CL + CH2O -> HCL + HO2 + CO ; 8.10e-11, -30.
+ CL + CH4 -> CH3O2 + HCL ; 7.30e-12, -1280.
+ CLO + O -> CL + O2 ; 2.80e-11, 85.
+ CLO + OH -> CL + HO2 ; 7.40e-12, 270.
+ CLO + OH -> HCL + O2 ; 6.00e-13, 230.
+ CLO + HO2 -> O2 + HOCL ; 2.70e-12, 220.
+ CLO + NO -> NO2 + CL ; 6.40e-12 , 290.
+ CLO + NO2 + M -> CLONO2 + M ; 1.80e-31, 3.4, 1.5e-11, 1.9, 0.6
+ CLO + CLO -> 2*CL + O2 ; 3.00e-11, -2450.
+ CLO + CLO -> CL2 + O2 ; 1.00e-12, -1590.
+ CLO + CLO -> CL + OCLO ; 3.50e-13, -1370.
+ [tag_CLO_CLO] CLO + CLO + M -> CL2O2 + M ; 1.60e-32, 4.5, 2.0e-12, 2.4, 0.6
+ [usr_CL2O2_M] CL2O2 + M -> CLO + CLO + M
+ HCL + OH -> H2O + CL ; 2.60e-12, -350.
+ HCL + O -> CL + OH ; 1.00e-11, -3300.
+ HOCL + O -> CLO + OH ; 1.70e-13
+ HOCL + CL -> HCL + CLO ; 2.50e-12, -130.
+ HOCL + OH -> H2O + CLO ; 3.00e-12, -500.
+ CLONO2 + O -> CLO + NO3 ; 2.90e-12, -800.
+ CLONO2 + OH -> HOCL + NO3 ; 1.20e-12, -330.
+ CLONO2 + CL -> CL2 + NO3 ; 6.50e-12, 135.
+
+* --------------------------------------------------------------
+* Odd Bromine Reactions
+* --------------------------------------------------------------
+ BR + O3 -> BRO + O2 ; 1.70e-11, -800.
+ BR + HO2 -> HBR + O2 ; 4.80e-12, -310.
+ BR + CH2O -> HBR + HO2 + CO ; 1.70e-11, -800.
+ BRO + O -> BR + O2 ; 1.90e-11, 230.
+ BRO + OH -> BR + HO2 ; 1.70e-11, 250.
+ BRO + HO2 -> HOBR + O2 ; 4.50e-12, 460.
+ BRO + NO -> BR + NO2 ; 8.80e-12, 260.
+ BRO + NO2 + M -> BRONO2 + M ; 5.20e-31, 3.2, 6.9e-12, 2.9, 0.6
+ BRO + CLO -> BR + OCLO ; 9.50e-13, 550.
+ BRO + CLO -> BR + CL + O2 ; 2.30e-12, 260.
+ BRO + CLO -> BRCL + O2 ; 4.10e-13, 290.
+ BRO + BRO -> 2*BR + O2 ; 1.50e-12, 230.
+ HBR + OH -> BR + H2O ; 5.50e-12, 200.
+ HBR + O -> BR + OH ; 5.80e-12, -1500.
+ HOBR + O -> BRO + OH ; 1.20e-10, -430.
+ BRONO2 + O -> BRO + NO3 ; 1.90e-11, 215.
+* --------------------------------------------------------------
+* Organic Halogens Reactions with Cl, OH
+* --------------------------------------------------------------
+ CH3CL + CL -> HO2 + CO + 2*HCL ; 2.17e-11, -1130.
+ CH3CL + OH -> CL + H2O + HO2 ; 2.40e-12, -1250.
+ CH3CCL3 + OH -> H2O + 3*CL ; 1.64e-12, -1520.
+ HCFC22 + OH -> CL + H2O + CF2O ; 1.05e-12, -1600.
+ CH3BR + OH -> BR + H2O + HO2 ; 2.35e-12, -1300.
+
+* --------------------------------------------------------------
+* C-1 Degradation (Methane, CO, CH2O and derivatives)
+* --------------------------------------------------------------
+ CH4 + OH -> CH3O2 + H2O ; 2.45e-12, -1775.
+ CH3O2 + NO -> CH2O + NO2 + HO2 ; 2.80e-12, 300.
+ CH3O2 + HO2 -> CH3OOH + O2 ; 4.10e-13, 750.
+ CH3OOH + OH -> CH3O2 + H2O ; 3.80e-12, 200.
+ CH2O + NO3 -> CO + HO2 + HNO3 ; 6.00e-13, -2058.
+ CH2O + OH -> CO + H2O + H ; 5.50e-12, 125.
+ CH2O + O -> HO2 + OH + CO ; 3.40e-11, -1600.
+ CO + OH + M -> CO2 + HO2 + M ; 5.90e-33, 1.4, 1.10e-12, -1.3, 0.6
+ [usr_CO_OH_b] CO + OH -> CO2 + H
+ CH3O2 + CH3O2 -> 2 * CH2O + 2 * HO2 ; 5.00e-13, -424.
+ CH3O2 + CH3O2 -> CH2O + CH3OH ; 1.90e-14, 706.
+ CH3OH + OH -> HO2 + CH2O ; 2.90e-12, -345.
+ CH3OOH + OH -> .7 * CH3O2 + .3 * OH + .3 * CH2O + H2O ; 3.80e-12, 200.
+*new (HCOOH+OH, etc.)
+ HCOOH + OH -> HO2 + CO2 + H2O ; 4.5e-13
+ CH2O + HO2 -> HOCH2OO ; 9.7e-15, 625.
+ HOCH2OO -> CH2O + HO2 ; 2.4e12, -7000.
+ HOCH2OO + NO -> HCOOH + NO2 + HO2 ; 2.6e-12, 265.
+ HOCH2OO + HO2 -> HCOOH ; 7.5e-13, 700.
+
+* --------------------------------------------------------------
+* C-2 Degradation
+*
+* EO = HOCH2CH2O
+* EO2 = HOCH2CH2O2
+* PAN = CH3CO3NO2
+* GLYALD = HOCH2CHO
+* GLYOXAL= C2H2O2
+* C2H2 = C2H2
+* --------------------------------------------------------------
+ C2H2 + CL + M -> CL ; 5.20e-30, 2.4, 2.2e-10, 0.7, 0.6
+ C2H4 + CL + M -> CL ; 1.60e-29, 3.3, 3.1e-10, 1.0, 0.6
+ C2H6 + CL -> HCL + C2H5O2 ; 7.20e-11, -70.
+ C2H2 + OH + M -> .65*GLYOXAL + .65*OH + .35*HCOOH + .35*HO2 ; 5.50e-30, 0.0, 8.3e-13, -2.0, 0.6
+ + .35*CO + M
+ C2H6 + OH -> C2H5O2 + H2O ; 8.70e-12, -1070.
+ [tag_C2H4_OH] C2H4 + OH + M -> .75*EO2 + .5*CH2O + .25*HO2 + M ; 1.00e-28, 0.8, 8.80e-12, 0.0, 0.6
+* C2H4 + O3 -> CH2O + .12 * HO2 + .5 * CO ; 1.2e-14, -2630.
+* + .12 * OH + .32 * CH3COOH
+ C2H4 + O3 -> CH2O + .12*HO2 + .5*CO + .12*OH + .5*HCOOH ; 1.2e-14, -2630.
+ CH3COOH + OH -> CH3O2 + CO2 + H2O ; 7.00e-13
+ C2H5O2 + NO -> CH3CHO + HO2 + NO2 ; 2.60e-12, 365.
+ C2H5O2 + HO2 -> C2H5OOH + O2 ; 7.50e-13, 700.
+ C2H5O2 + CH3O2 -> .7 * CH2O + .8 * CH3CHO + HO2 ; 2.00e-13
+ + .3 * CH3OH + .2 * C2H5OH
+ C2H5O2 + C2H5O2 -> 1.6 * CH3CHO + 1.2 * HO2 + .4 * C2H5OH ; 6.80e-14
+ C2H5OOH + OH -> .5 * C2H5O2 + .5 * CH3CHO + .5 * OH ; 3.80e-12, 200.
+ CH3CHO + OH -> CH3CO3 + H2O ; 5.60e-12, 270.
+ CH3CHO + NO3 -> CH3CO3 + HNO3 ; 1.40e-12, -1900.
+ CH3CO3 + NO -> CH3O2 + CO2 + NO2 ; 8.10e-12, 270.
+ [tag_CH3CO3_NO2] CH3CO3 + NO2 + M -> PAN + M ; 8.50e-29, 6.5, 1.10e-11, 1.0, 0.6
+ CH3CO3 + HO2 -> .75 * CH3COOOH + .25 * CH3COOH + .25 * O3 ; 4.30e-13, 1040.
+ CH3CO3 + CH3O2 -> .9*CH3O2 + CH2O + .9*HO2 ; 2.00e-12, 500.
+ + .9*CO2 + .1*CH3COOH
+ CH3CO3 + CH3CO3 -> 2*CH3O2 + 2*CO2 ; 2.50e-12, 500.
+ CH3COOOH + OH -> .5*CH3CO3 + .5*CH2O + .5*CO2 + H2O ; 1.00e-12
+ EO2 + NO -> EO + NO2 ; 4.20e-12, 180.
+ EO + O2 -> GLYALD + HO2 ; 1.00e-14
+ EO -> 2 * CH2O + HO2 ; 1.60e11, -4150.
+ GLYALD + OH -> HO2 + .2*GLYOXAL + .8*CH2O + .8*CO2 ; 1.00e-11
+ GLYOXAL + OH -> HO2 + CO + CO2 ; 1.15e-11
+ C2H5OH + OH -> HO2 + CH3CHO ; 6.90e-12, -230.
+ [usr_PAN_M] PAN + M -> CH3CO3 + NO2 + M
+ PAN + OH -> CH2O + NO3 ; 4.00e-14
+
+* --------------------------------------------------------------
+* C-3 Degradation
+*
+* PO2 = C3H6OHO2
+* POOH = C3H6OHOOH
+* RO2 = CH3COCH2O2
+* ROOH = CH3COCH2OOH
+* HYAC = CH3COCH2OH
+* ONIT = CH3COCH2ONO2
+* --------------------------------------------------------------
+ [tag_C3H6_OH] C3H6 + OH + M -> PO2 + M ; 8.00e-27, 3.5, 3.00e-11, 0.0, 0.5
+ C3H6 + O3 -> .54*CH2O + .19*HO2 + .33*OH + .08*CH4 ; 6.50e-15, -1900.
+ + .56*CO + .5*CH3CHO + .31*CH3O2 + .25*CH3COOH
+ C3H6 + NO3 -> ONIT ; 4.60e-13, -1156.
+ C3H7O2 + NO -> .82 * CH3COCH3 + NO2 + HO2 + .27 * CH3CHO ; 4.20e-12, 180.
+ C3H7O2 + HO2 -> C3H7OOH + O2 ; 7.50e-13, 700.
+ C3H7O2 + CH3O2 -> CH2O + HO2 + .82 * CH3COCH3 ; 3.75e-13, -40.
+ C3H7OOH + OH -> H2O + C3H7O2 ; 3.80e-12, 200.
+ C3H8 + OH -> C3H7O2 + H2O ; 8.70e-12, -615.
+ PO2 + NO -> CH3CHO + CH2O + HO2 + NO2 ; 4.20e-12, 180.
+ PO2 + HO2 -> POOH + O2 ; 7.50e-13, 700.
+ POOH + OH -> .5*PO2 + .5*OH + .5*HYAC + H2O ; 3.80e-12, 200.
+ [usr_CH3COCH3_OH] CH3COCH3 + OH -> RO2 + H2O
+ RO2 + NO -> CH3CO3 + CH2O + NO2 ; 2.90e-12, 300.
+ RO2 + HO2 -> ROOH + O2 ; 8.60e-13, 700.
+ RO2 + CH3O2 -> .3*CH3CO3 + .8* CH2O + .3*HO2 + .2*HYAC ; 7.10e-12, 500.
+ + .5*CH3COCHO + .5*CH3OH
+ ROOH + OH -> RO2 + H2O ; 3.80e-12, 200.
+ HYAC + OH -> CH3COCHO + HO2 ; 1.20e-12
+ CH3COCHO + OH -> CH3CO3 + CO + H2O ; 8.40e-13, 830.
+ CH3COCHO + NO3 -> HNO3 + CO + CH3CO3 ; 1.40e-12, -1860.
+ ONIT + OH -> NO2 + CH3COCHO ; 6.80e-13
+
+* --------------------------------------------------------------
+* C-4 Degradation
+* BIGENE -> C4H8
+* ENEO2 = C4H9O3
+* MEK = C4H8O
+* MEKO2 = C4H7O3
+* MEKOOH = C4H8O3
+* MVK = CH2CHCOCH3
+* MACR = CH2CCH3CHO
+* MACRO2 = CH3COCHO2CH2OH
+* MACROOH = CH3COCHOOHCH2OH
+* MCO3 = CH2CCH3CO3
+* MPAN = CH2CCH3CO3NO2
+* --------------------------------------------------------------
+ BIGENE + OH -> ENEO2 ; 5.40e-11
+ ENEO2 + NO -> CH3CHO + .5*CH2O + .5*CH3COCH3 + HO2 + NO2 ; 4.20e-12, 180.
+ MVK + OH -> MACRO2 ; 4.13e-12, 452.
+ MVK + O3 -> .8 * CH2O + .95 * CH3COCHO + .08 * OH ; 7.52e-16, -1521.
+ + .2 * O3 + .06 * HO2 + .05 * CO + .04 * CH3CHO
+ MEK + OH -> MEKO2 ; 2.30e-12, -170.
+ MEKO2 + NO -> CH3CO3 + CH3CHO + NO2 ; 4.20e-12, 180.
+ MEKO2 + HO2 -> MEKOOH ; 7.50e-13, 700.
+ MEKOOH + OH -> MEKO2 ; 3.80e-12, 200.
+ MACR + OH -> .5 * MACRO2 + .5 * H2O + .5 * MCO3 ; 1.86e-11, 175.
+ MACR + O3 -> .8 * CH3COCHO + .275 * HO2 + .2 * CO ; 4.40e-15, -2500.
+ + .2 * O3 + .7 * CH2O + .215 * OH
+ MACRO2 + NO -> NO2 + .47 * HO2 + .25 * CH2O ; 2.70e-12, 360.
+ + .53 * GLYALD + .25 * CH3COCHO
+ + .53 * CH3CO3 + .22 * HYAC + .22 * CO
+ MACRO2 + NO -> 0.8*ONITR ; 1.30e-13, 360.
+ MACRO2 + NO3 -> NO2 + .47 * HO2 + .25 * CH2O ; 2.40e-12
+ + .25 * CH3COCHO + .22 * CO
+ + .53 * GLYALD + .22*HYAC + .53*CH3CO3
+ MACRO2 + HO2 -> MACROOH ; 8.00e-13, 700.
+ MACRO2 + CH3O2 -> .73 * HO2 + .88 * CH2O + .11 * CO ; 5.00e-13, 400.
+ + .24 * CH3COCHO
+ + .26 * GLYALD + .26 * CH3CO3
+ + .25 * CH3OH + .23 * HYAC
+ MACRO2 + CH3CO3 -> .25 * CH3COCHO + CH3O2 + .22 * CO ; 1.40e-11
+ + .47 * HO2 + .53 * GLYALD
+ + .22 * HYAC + .25*CH2O + .53*CH3CO3
+ MACROOH + OH -> .5 * MCO3 + .2*MACRO2 + .1*OH + .2*HO2 ; 2.30e-11, 200.
+ MCO3 + NO -> NO2 + CH2O + CH3CO3 ; 5.30e-12, 360.
+ MCO3 + NO3 -> NO2 + CH2O + CH3CO3 ; 5.00e-12
+ MCO3 + HO2 -> .25 * O3 + .25 * CH3COOH + .75 * CH3COOOH ; 4.30e-13, 1040.
+ + .75 * O2
+ MCO3 + CH3O2 -> 2 * CH2O + HO2 + CO2 + CH3CO3 ; 2.00e-12, 500.
+ MCO3 + CH3CO3 -> 2 * CO2 + CH3O2 + CH2O + CH3CO3 ; 4.60e-12, 530.
+ MCO3 + MCO3 -> 2 * CO2 + 2 * CH2O + 2 * CH3CO3 ; 2.30e-12, 530.
+ [usr_MCO3_NO2] MCO3 + NO2 + M -> MPAN + M
+ [usr_MPAN_M] MPAN + M -> MCO3 + NO2 + M
+ MPAN + OH -> .5 * HYAC + .5 * NO3 + .5 * CH2O + .5 *HO2 ; 8.00e-27, 3.5, 3.00e-11, 0.0, 0.5
+
+* --------------------------------------------------------------
+* C-5 Degradation
+*
+* ISOP = C5H8
+* ISOPO2 = HOCH2COOCH3CHCH2
+* ISOPNO3 = CH2CHCCH3OOCH2ONO2
+* ISOPOOH = HOCH2COOHCH3CHCH2
+* BIGALK = C5H12,
+* ALKO2 = C5H11O2
+* ALKOOH = C5H12O2
+* ONITR = CH2CCH3CHONO2CH2OH
+* XO2 = HOCH2COOCH3CHOHCHO
+* XOOH = HOCH2COOHCH3CHOHCHO
+* --------------------------------------------------------------
+ ISOP + OH -> ISOPO2 ; 2.54e-11, 410.
+ ISOP + O3 -> .4 * MACR + .2 * MVK + .07 * C3H6 + .27 * OH ; 1.05e-14, -2000.
+ + .06 * HO2 + .6 * CH2O + .3 * CO + .1 * O3
+ + .2 * MCO3 + .2 * CH3COOH
+ ISOP + NO3 -> ISOPNO3 ; 3.03e-12, -446.
+ ISOPO2 + NO -> .08 * ONITR + .92 * NO2 + HO2 + .51 * CH2O ; 4.40e-12, 180.
+ + .23 * MACR + .32 * MVK + .37 * HYDRALD
+ ISOPO2 + NO3 -> HO2 + NO2 + .6 * CH2O + .25 * MACR ; 2.40e-12
+ + .35 * MVK + .4 * HYDRALD
+ ISOPO2 + HO2 -> ISOPOOH ; 8.00e-13, 700.
+ ISOPOOH + OH -> .8 * XO2 + .2 * ISOPO2 ; 1.52e-11, 200.
+ ISOPO2 + CH3O2 -> .25 * CH3OH + HO2 + 1.2 * CH2O ; 5.00e-13, 400.
+ + .19 * MACR + .26 * MVK + .3 * HYDRALD
+ ISOPO2 + CH3CO3 -> CH3O2 + HO2 + .6 * CH2O ; 1.40e-11
+ + .25 * MACR + .35 * MVK + .4 * HYDRALD
+ ISOPNO3 + NO -> 1.206 * NO2 + .794 * HO2 + .072 * CH2O ; 2.70e-12, 360.
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ ISOPNO3 + NO3 -> 1.206 * NO2 + .072 * CH2O + .167 * MACR ; 2.40e-12
+ + .039 * MVK + .794 * ONITR + .794 * HO2
+ ISOPNO3 + HO2 -> XOOH + .206 * NO2 + .794 *HO2 + .008*CH2O ; 8.00e-13, 700.
+ + .167 * MACR + .039 * MVK + .794 * ONITR
+ BIGALK + OH -> ALKO2 ; 3.50e-12
+ ONITR + OH -> HYDRALD + .4*NO2 + HO2 ; 4.50e-11
+ ONITR + NO3 -> HO2 + NO2 + HYDRALD ; 1.40e-12, -1860.
+ HYDRALD + OH -> XO2 ; 1.86e-11, 175.
+
+
+ ALKO2 + NO -> .4*CH3CHO + .1*CH2O + .25*CH3COCH3 ; 4.20e-12, 180.
+ + .9*HO2 + .8*MEK + .9*NO2 + .1*ONIT
+ ALKO2 + HO2 -> ALKOOH ; 7.50e-13, 700.
+ ALKOOH + OH -> ALKO2 ; 3.80e-12, 200.
+ XO2 + NO -> NO2 + HO2 + .5*CO + .25*GLYOXAL ; 2.7e-12, 360.
+ + .25*HYAC + .25*CH3COCHO + .25*GLYALD
+ XO2 + NO3 -> NO2 + HO2 + 0.5*CO + .25*HYAC ; 2.40e-12
+ + 0.25*GLYOXAL + .25*CH3COCHO + .25*GLYALD
+ XO2 + HO2 -> XOOH ; 8.00e-13, 700.
+ XO2 + CH3O2 -> .3 * CH3OH + .8*HO2 + .7 * CH2O ; 5.e-13, 400.
+ + .2 * CO + .1 * HYAC + .1*GLYOXAL
+ + .1 * CH3COCHO + .1 * GLYALD
+ XO2 + CH3CO3 -> .5*CO + CH3O2 + HO2 + CO2 + .25*HYAC ; 1.3e-12, 640.
+ + .25*GLYOXAL + .25 * CH3COCHO + .25 * GLYALD
+ XOOH + OH -> H2O + XO2 ; 1.90e-12, 190.
+ [usr_XOOH_OH] XOOH + OH -> H2O + OH
+
+* --------------------------------------------------------------
+* C-7 degradation
+*
+* TOLUENE = C7H8
+* CRESOL = C7H8O
+* TOLO2 = C7H9O5
+* TOLOOH = C7H10O5
+* XOH = C7H10O6
+* --------------------------------------------------------------
+ TOLUENE + OH -> .25*CRESOL + .25*HO2 + .7*TOLO2 ; 1.70e-12, 352.
+ TOLO2 + NO -> .45*GLYOXAL + .45*CH3COCHO +.9*BIGALD ; 4.20e-12, 180.
+ + .9*NO2 + .9*HO2
+ TOLO2 + HO2 -> TOLOOH ; 7.50e-13, 700.
+ TOLOOH + OH -> TOLO2 ; 3.80e-12, 200.
+ CRESOL + OH -> XOH ; 3.00e-12
+ XOH + NO2 -> .7*NO2 + .7*BIGALD + .7*HO2 ; 1.00e-11
+
+* --------------------------------------------------------------
+* C-10 degradation
+*
+* TERPO2 = C10H17O3
+* TERPOOH = C10H18O3
+* --------------------------------------------------------------
+ C10H16 + OH -> TERPO2 ; 1.2e-11, 444.
+ C10H16 + O3 -> .7*OH + MVK + MACR + HO2 ; 1.e-15, -732.
+ C10H16 + NO3 -> TERPO2 + NO2 ; 1.2e-12, 490.
+ TERPO2 + NO -> .1*CH3COCH3 + HO2 + MVK + MACR + NO2 ; 4.2e-12, 180.
+ TERPO2 + HO2 -> TERPOOH ; 7.5e-13, 700.
+ TERPOOH + OH -> TERPO2 ; 3.8e-12, 200.
+
+* --------------------------------------------------------------
+* Sulfate aerosol reactions
+* --------------------------------------------------------------
+ [het1] N2O5 -> 2*HNO3
+ [het2] CLONO2 -> HOCL + HNO3
+ [het3] BRONO2 -> HOBR + HNO3
+ [het4] CLONO2 + HCL -> CL2 + HNO3
+ [het5] HOCL + HCL -> CL2 + H2O
+ [het6] HOBR + HCL -> BRCL + H2O
+
+* --------------------------------------------------------------
+* Nitric acid Di-hydrate reactions
+* --------------------------------------------------------------
+ [het7] N2O5 -> 2*HNO3
+ [het8] CLONO2 -> HOCL + HNO3
+ [het9] CLONO2 + HCL -> CL2 + HNO3
+ [het10] HOCL + HCL -> CL2 + H2O
+ [het11] BRONO2 -> HOBR + HNO3
+
+* --------------------------------------------------------------
+* Ice aerosol reactions
+* --------------------------------------------------------------
+ [het12] N2O5 -> 2*HNO3
+ [het13] CLONO2 -> HOCL + HNO3
+ [het14] BRONO2 -> HOBR + HNO3
+ [het15] CLONO2 + HCL -> CL2 + HNO3
+ [het16] HOCL + HCL -> CL2 + H2O
+ [het17] HOBR + HCL -> BRCL + H2O
+
+* --------------------------------------------------------------
+* Ion reactions
+* --------------------------------------------------------------
+ [ion1] Op + O2 -> O2p + O
+ [ion2] Op + N2 -> NOp + N
+ Op + CO2 -> O2p + CO ; 9.0e-10
+ [ion3] N2p + O -> NOp + N2D
+ [ion4,cph] O2p + N -> NOp + O ; 1.00e-10
+ [ion5,cph] O2p + NO -> NOp + O2 ; 4.40e-10
+ [ion6,cph] Np + O2 -> O2p + N ; 4.00e-10
+ [ion7,cph] Np + O2 -> NOp + O ; 2.00e-10
+ [ion8,cph] Np + O -> Op + N ; 1.00e-12
+ [ion9,cph] N2p + O2 -> O2p + N2 ; 6.00e-11
+ O2p + N2 -> NOp + NO ; 5.00e-16
+ [ion11] N2p + O -> Op + N2
+ [elec1] NOp + e -> .2*N + .8*N2D + O
+ [elec2] O2p + e -> 1.15*O + .85*O1D
+ [elec3] N2p + e -> 1.1*N + .9*N2D
+ End Reactions
+
+ Ext Forcing
+ NO<-dataset, NO2<-dataset, CO<-dataset, Op, O2p, Np, N2p, N2D, N, e, OH
+ End Ext Forcing
+
+ END Chemistry
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ machine = intel
+ model = cam
+ model_architecture = SCALAR
+ architecture = hybrid
+ namemod = on
+ End Version Options
+
+ End Simulation Parameters
+ENDSIM
diff --git a/chem_proc/procfiles/cam/mo_chem.mod b/chem_proc/procfiles/cam/mo_chem.mod
new file mode 100644
index 0000000000..e1f6353fd0
--- /dev/null
+++ b/chem_proc/procfiles/cam/mo_chem.mod
@@ -0,0 +1,68 @@
+
+ module chem_mods
+!--------------------------------------------------------------
+! ... Basic chemistry parameters and arrays
+!--------------------------------------------------------------
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+
+ implicit none
+
+ save
+
+ integer, parameter :: phtcnt = PHTCNT, & ! number of photolysis reactions
+ rxntot = RXNCNT, & ! number of total reactions
+ gascnt = GASCNT, & ! number of gas phase reactions
+ nabscol = NCOL, & ! number of absorbing column densities
+ gas_pcnst = PCNST, & ! number of "gas phase" species
+ nfs = NFS, & ! number of "fixed" species
+ relcnt = RELCNT, & ! number of relationship species
+ grpcnt = GRPCNT, & ! number of group members
+ nzcnt = IMP_NZCNT, & ! number of non-zero matrix entries
+ extcnt = EXTCNT, & ! number of species with external forcing
+ clscnt1 = CLSCNT1, & ! number of species in explicit class
+ clscnt2 = CLSCNT2, & ! number of species in hov class
+ clscnt3 = CLSCNT3, & ! number of species in ebi class
+ clscnt4 = CLSCNT4, & ! number of species in implicit class
+ clscnt5 = CLSCNT5, & ! number of species in rodas class
+ indexm = INDEXM, & ! index of total atm density in invariant array
+ indexh2o = INDEXH2O, & ! index of water vapor density
+ clsze = CLSZE, & ! loop length for implicit chemistry
+ rxt_tag_cnt = RXTTAGCNT, &
+ enthalpy_cnt = ENTHALPYCNT, &
+ nslvd = NSLVD
+
+ integer :: clscnt(5) = 0
+ integer :: cls_rxt_cnt(4,5) = 0
+ integer :: clsmap(gas_pcnst,5) = 0
+ integer :: permute(gas_pcnst,5) = 0
+# if CLSCNT4 != 0
+ integer :: diag_map(clscnt4) = 0
+# elif CLSCNT5 != 0
+ integer :: diag_map(clscnt5) = 0
+# endif
+ real(r8) :: adv_mass(gas_pcnst) = 0._r8
+ real(r8) :: crb_mass(gas_pcnst) = 0._r8
+ real(r8) :: fix_mass(max(1,nfs))
+# if GRPCNT != 0
+ real(r8) :: nadv_mass(grpcnt) = 0._r8
+# endif
+ real(r8), allocatable :: cph_enthalpy(:)
+ integer, allocatable :: cph_rid(:)
+ integer, allocatable :: num_rnts(:)
+
+ integer, allocatable :: rxt_tag_map(:)
+ real(r8), allocatable :: pht_alias_mult(:,:)
+ character(len=32), allocatable :: rxt_tag_lst(:)
+ character(len=16), allocatable :: pht_alias_lst(:,:)
+ character(len=16) :: inv_lst(max(1,nfs))
+ character(len=16) :: extfrc_lst(max(1,extcnt))
+ logical :: frc_from_dataset(max(1,extcnt))
+ logical :: is_vector
+ logical :: is_scalar
+ character(len=16) :: slvd_lst(max(1,nslvd))
+# if VECLEN !=0
+ integer, parameter :: veclen = VECLEN
+# endif
+
+ end module chem_mods
diff --git a/chem_proc/procfiles/cam/mo_exp_sol_scalar.F90 b/chem_proc/procfiles/cam/mo_exp_sol_scalar.F90
new file mode 100644
index 0000000000..0824807a06
--- /dev/null
+++ b/chem_proc/procfiles/cam/mo_exp_sol_scalar.F90
@@ -0,0 +1,102 @@
+
+module mo_exp_sol
+
+ private
+ public :: exp_sol
+ public :: exp_sol_inti
+
+contains
+
+ subroutine exp_sol_inti
+
+ use mo_tracname, only : solsym
+ use chem_mods, only : clscnt1, clsmap
+ use ppgrid, only : pver
+ use cam_history, only : addfld
+
+ implicit none
+
+ integer :: i,j
+
+ do i = 1,clscnt1
+
+ j = clsmap(i,1)
+ call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' )
+ call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' )
+
+ enddo
+ end subroutine exp_sol_inti
+
+
+ subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop )
+ !-----------------------------------------------------------------------
+ ! ... Exp_sol advances the volumetric mixing ratio
+ ! forward one time step via the fully explicit
+ ! Euler scheme
+ !-----------------------------------------------------------------------
+
+ use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot
+ use ppgrid, only : pcols, pver
+ use mo_prod_loss, only : exp_prod_loss
+ use mo_indprd, only : indprd
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use cam_history, only : outfld
+ use mo_tracname, only : solsym
+
+ implicit none
+ !-----------------------------------------------------------------------
+ ! ... Dummy arguments
+ !-----------------------------------------------------------------------
+ integer, intent(in) :: ncol ! columns in chunck
+ integer, intent(in) :: lchnk ! chunk id
+ real(r8), intent(in) :: delt ! time step (s)
+ real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s)
+ real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s)
+ real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s)
+ real(r8), intent(in) :: xhnm(ncol,pver)
+ integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index)
+ real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr)
+
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ integer :: i, k, l, m
+ real(r8), dimension(ncol,pver,clscnt1) :: &
+ prod, &
+ loss, &
+ ind_prd
+
+ real(r8), dimension(ncol,pver) :: wrk
+
+ !-----------------------------------------------------------------------
+ ! ... Put "independent" production in the forcing
+ !-----------------------------------------------------------------------
+ call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, &
+ reaction_rates, ncol )
+
+ !-----------------------------------------------------------------------
+ ! ... Form F(y)
+ !-----------------------------------------------------------------------
+ call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates )
+
+ !-----------------------------------------------------------------------
+ ! ... Solve for the mixing ratio at t(n+1)
+ !-----------------------------------------------------------------------
+ do m = 1,clscnt1
+ l = clsmap(m,1)
+ do i = 1,ncol
+ do k = ltrop(i)+1,pver
+ base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m))
+ end do
+ end do
+
+ wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm
+ call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk )
+ wrk(:,:) = (loss(:,:,m))*xhnm
+ call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk )
+
+ end do
+
+ end subroutine exp_sol
+
+end module mo_exp_sol
diff --git a/chem_proc/procfiles/cam/mo_exp_sol_vector.F90 b/chem_proc/procfiles/cam/mo_exp_sol_vector.F90
new file mode 100644
index 0000000000..62c7e8bde6
--- /dev/null
+++ b/chem_proc/procfiles/cam/mo_exp_sol_vector.F90
@@ -0,0 +1,104 @@
+
+module mo_exp_sol
+
+ private
+ public :: exp_sol
+ public :: exp_sol_inti
+
+contains
+
+ subroutine exp_sol_inti
+
+ use mo_tracname, only : solsym
+ use chem_mods, only : clscnt1, clsmap
+ use cam_history, only : addfld
+
+ implicit none
+
+ integer :: i,j
+
+ do i = 1,clscnt1
+
+ j = clsmap(i,1)
+ call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' )
+ call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' )
+
+ enddo
+ end subroutine exp_sol_inti
+
+
+ subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop )
+ !-----------------------------------------------------------------------
+ ! ... Exp_sol advances the volumetric mixing ratio
+ ! forward one time step via the fully explicit
+ ! Euler scheme
+ !-----------------------------------------------------------------------
+
+ use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot
+ use ppgrid, only : pcols, pver
+ use mo_prod_loss, only : exp_prod_loss
+ use mo_indprd, only : indprd
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use cam_history, only : outfld
+ use mo_tracname, only : solsym
+
+ implicit none
+ !-----------------------------------------------------------------------
+ ! ... Dummy arguments
+ !-----------------------------------------------------------------------
+ integer, intent(in) :: ncol ! columns in chunck
+ integer, intent(in) :: lchnk ! chunk id
+ real(r8), intent(in) :: delt ! time step (s)
+ real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s)
+ real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s)
+ real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s)
+ real(r8), intent(in) :: xhnm(ncol,pver)
+ integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index)
+ real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr)
+
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ integer :: i, k, l, m
+ integer :: chnkpnts
+ real(r8), dimension(ncol,pver,max(1,clscnt1)) :: &
+ prod, &
+ loss
+ real(r8), dimension(ncol,pver,clscnt1) :: ind_prd
+
+ real(r8), dimension(ncol,pver) :: wrk
+
+ chnkpnts = ncol*pver
+ !-----------------------------------------------------------------------
+ ! ... Put "independent" production in the forcing
+ !-----------------------------------------------------------------------
+ call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, &
+ reaction_rates, chnkpnts )
+
+ !-----------------------------------------------------------------------
+ ! ... Form F(y)
+ !-----------------------------------------------------------------------
+ call exp_prod_loss( 1, chnkpnts, prod, loss, base_sol, reaction_rates, &
+ het_rates, chnkpnts )
+
+ !-----------------------------------------------------------------------
+ ! ... Solve for the mixing ratio at t(n+1)
+ !-----------------------------------------------------------------------
+ do m = 1,clscnt1
+ l = clsmap(m,1)
+ do i = 1,ncol
+ do k = ltrop(i)+1,pver
+ base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m))
+ end do
+ end do
+
+ wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm
+ call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk )
+ wrk(:,:) = (loss(:,:,m))*xhnm
+ call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk )
+
+ end do
+
+ end subroutine exp_sol
+
+end module mo_exp_sol
diff --git a/chem_proc/procfiles/cam/mo_imp_sol_cache.F90 b/chem_proc/procfiles/cam/mo_imp_sol_cache.F90
new file mode 100644
index 0000000000..9f67fbfa4e
--- /dev/null
+++ b/chem_proc/procfiles/cam/mo_imp_sol_cache.F90
@@ -0,0 +1,480 @@
+
+ module mo_imp_sol
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : clscnt4, gas_pcnst, clsmap
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! Newton-Raphson iteration limits
+!-----------------------------------------------------------------------
+ integer, parameter :: itermax = 11
+ integer, parameter :: cut_limit = 5
+
+ save
+
+ real(r8) :: small
+ real(r8) :: epsilon(clscnt4)
+ logical :: factor(itermax)
+
+ private
+ public :: imp_slv_inti, imp_sol
+
+ contains
+
+ subroutine imp_slv_inti
+!-----------------------------------------------------------------------
+! ... Initialize the implict solver
+!-----------------------------------------------------------------------
+
+ use m_spc_id
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: m
+ real(r8) :: eps(gas_pcnst)
+
+ small = 1.e6_r8 * tiny( small )
+ factor(:) = .true.
+ eps(:) = .001_r8
+ eps((/id_o3,id_no,id_no2,id_no3,id_hno3,id_ho2no2,id_n2o5,id_oh,id_ho2/)) = .0001_r8
+ do m = 1,clscnt4
+ epsilon(m) = eps(clsmap(m,4))
+ end do
+
+ end subroutine imp_slv_inti
+
+ subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, &
+ ncol, lchnk )
+!-----------------------------------------------------------------------
+! ... Imp_sol advances the volumetric mixing ratio
+! forward one time step via the fully implicit
+! Euler scheme
+!-----------------------------------------------------------------------
+
+ use chem_mods, only : rxntot, extcnt, nzcnt, clsze, diag_map, permute, cls_rxt_cnt
+ use mo_tracname, only : solsym
+ use ppgrid, only : pver
+ use pmgrid, only : iam
+ use mo_lin_matrix, only : linmat
+ use mo_nln_matrix, only : nlnmat
+ use mo_lu_factor, only : lu_fac
+ use mo_lu_solve, only : lu_slv
+ use mo_prod_loss, only : imp_prod_loss
+ use mo_indprd, only : indprd
+ use time_manager, only : get_nstep
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: ncol ! columns in chunck
+ integer, intent(in) :: lchnk ! chunk id
+ real(r8), intent(in) :: delt ! time step (s)
+ real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot), & ! rxt rates (1/cm^3/s)
+ extfrc(ncol,pver,extcnt), & ! external in-situ forcing (1/cm^3/s)
+ het_rates(ncol,pver,max(1,gas_pcnst)) ! washout rates (1/s)
+ real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! species mixing ratios (vmr)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: nr_iter, &
+ lev, &
+ ofl, ofu, &
+ i, isec, isecu, &
+ j, &
+ k, l, &
+ m, cols
+ integer :: nstep
+ integer :: stp_con_cnt, cut_cnt, fail_cnt
+ real(r8) :: interval_done, dt, dti
+ real(r8) :: max_delta(clscnt4)
+ real(r8), dimension(clsze,nzcnt) :: &
+ sys_jac, &
+ lin_jac
+ real(r8), dimension(clsze,clscnt4) :: &
+ solution, &
+ forcing, &
+ iter_invariant, &
+ prod, &
+ loss
+ real(r8) :: lrxt(clsze,rxntot)
+ real(r8) :: lhet(clsze,max(1,gas_pcnst))
+ real(r8) :: lsol(clsze,gas_pcnst)
+ real(r8), dimension(clsze) :: &
+ wrk
+ real(r8), dimension(ncol,pver,clscnt4) :: &
+ ind_prd
+ logical :: convergence
+ logical :: iter_conv(clsze)
+ logical :: converged(clscnt4)
+ logical :: do_diag
+
+!-----------------------------------------------------------------------
+! ... Class independent forcing
+!-----------------------------------------------------------------------
+#ifdef DEBUG
+ call t_startf('indprd')
+#endif
+ if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then
+ call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, &
+ reaction_rates, ncol )
+ else
+ do m = 1,max(1,clscnt4)
+ ind_prd(:,:,m) = 0._r8
+ end do
+ end if
+#ifdef DEBUG
+ call t_stopf('indprd')
+#endif
+ isecu = (ncol - 1)/clsze + 1
+Level_loop : &
+ do lev = 1,pver
+Column_loop : &
+ do isec = 1,isecu
+ ofl = (isec - 1)*clsze + 1
+ ofu = min( ncol,ofl + clsze - 1 )
+ cols = ofu - ofl + 1
+!-----------------------------------------------------------------------
+! ... Transfer from base to local work arrays
+!-----------------------------------------------------------------------
+ do m = 1,rxntot
+ lrxt(:cols,m) = reaction_rates(ofl:ofu,lev,m)
+ end do
+ do m = 1,gas_pcnst
+ lhet(:cols,m) = het_rates(ofl:ofu,lev,m)
+ end do
+! do_diag = lev == 5 .and. isec == 2 .and. lchnk == 290
+ do_diag = .false.
+ if( do_diag ) then
+ write(*,*) ' '
+ write(*,*) 'imp_sol: lchnk,lev,isec,cols = ',lchnk,lev,isec,cols
+ write(*,*) ' '
+ write(*,*) 'imp_sol: lrxt'
+ write(*,'(1p,4g20.10)') lrxt(1,:)
+ write(*,*) 'imp_sol: lhet'
+ write(*,'(1p,4g20.10)') lhet(1,:)
+ end if
+!-----------------------------------------------------------------------
+! ... Time step loop
+!-----------------------------------------------------------------------
+ dt = delt
+ cut_cnt = 0
+ stp_con_cnt = 0
+ fail_cnt = 0
+ interval_done = 0._r8
+Time_step_loop : &
+ do
+ dti = 1._r8 / dt
+!-----------------------------------------------------------------------
+! ... Transfer from base to local work arrays
+!-----------------------------------------------------------------------
+ do m = 1,gas_pcnst
+ lsol(:cols,m) = base_sol(ofl:ofu,lev,m)
+ end do
+!-----------------------------------------------------------------------
+! ... Transfer from base to class array
+!-----------------------------------------------------------------------
+ do k = 1,clscnt4
+ j = clsmap(k,4)
+ m = permute(k,4)
+ solution(:cols,m) = lsol(:cols,j)
+ end do
+ if( do_diag ) then
+ write(*,*) ' '
+ write(*,*) 'imp_sol: solution'
+ write(*,'(1p,4g20.10)') solution(1,:)
+ end if
+!-----------------------------------------------------------------------
+! ... Set the iteration invariant part of the function F(y)
+! ... If there is "independent" production put it in the forcing
+!-----------------------------------------------------------------------
+ if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then
+ do m = 1,clscnt4
+ iter_invariant(:cols,m) = dti * solution(:cols,m) + ind_prd(ofl:ofu,lev,m)
+ end do
+ else
+ do m = 1,clscnt4
+ iter_invariant(:cols,m) = dti * solution(:cols,m)
+ end do
+ end if
+!-----------------------------------------------------------------------
+! ... The linear component
+!-----------------------------------------------------------------------
+#ifdef DEBUG
+ call t_startf('lin_mat')
+#endif
+ if( cls_rxt_cnt(2,4) > 0 ) then
+ call linmat( lin_jac, lsol, lrxt, lhet, cols )
+ end if
+#ifdef DEBUG
+ call t_stopf('lin_mat')
+#endif
+
+!=======================================================================
+! The Newton-Raphson iteration for F(y) = 0
+!=======================================================================
+Iteration_loop : &
+ do nr_iter = 1,itermax
+!-----------------------------------------------------------------------
+! ... The non-linear component
+!-----------------------------------------------------------------------
+ if( factor(nr_iter) ) then
+#ifdef DEBUG
+ call t_startf('nln_mat')
+#endif
+ call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti, cols )
+#ifdef DEBUG
+ call t_stopf('nln_mat')
+ call t_startf('lu_fac')
+#endif
+!-----------------------------------------------------------------------
+! ... Factor the "system" matrix
+!-----------------------------------------------------------------------
+#ifdef DEBUG_LU
+ if( do_diag ) then
+ write(*,*) 'imp_sol: before lu_fac - lchnk,lev,isec,iter,dt = ',lchnk,lev,isec,nr_iter,dt
+ write(*,*) 'imp_sol: lu(110,20,21,109)'
+ write(*,'(1p,4g20.10)') sys_jac(:cols,110)
+ write(*,'(1p,4g20.10)') sys_jac(:cols,20)
+ write(*,'(1p,4g20.10)') sys_jac(:cols,21)
+ write(*,'(1p,4g20.10)') sys_jac(:cols,109)
+ write(*,*) 'imp_sol: maxval sys_jac(3,:) = ',maxval( sys_jac(3,:) )
+ write(*,*) 'imp_sol: maxval sys_jac(4,:) = ',maxval( sys_jac(4,:) )
+ end if
+#endif
+ call lu_fac( sys_jac, cols )
+#ifdef DEBUG_LU
+ if( do_diag ) then
+ write(*,*) 'imp_sol: after lu_fac - lchnk,lev,isec,iter,dt = ',lchnk,lev,isec,nr_iter,dt
+ write(*,*) 'imp_sol: lu(110,20,21,109)'
+ write(*,'(1p,4g20.10)') sys_jac(:cols,110)
+ write(*,'(1p,4g20.10)') sys_jac(:cols,20)
+ write(*,'(1p,4g20.10)') sys_jac(:cols,21)
+ write(*,'(1p,4g20.10)') sys_jac(:cols,109)
+ write(*,*) 'imp_sol: maxval sys_jac(3,:) = ',maxval( sys_jac(3,:) )
+ write(*,*) 'imp_sol: maxval sys_jac(4,:) = ',maxval( sys_jac(4,:) )
+ end if
+#endif
+#ifdef DEBUG
+ call t_stopf('lu_fac')
+#endif
+ end if
+!-----------------------------------------------------------------------
+! ... Form F(y)
+!-----------------------------------------------------------------------
+#ifdef DEBUG
+ call t_startf('frcing')
+#endif
+ call imp_prod_loss( prod, loss, lsol, lrxt, lhet, cols )
+ do m = 1,clscnt4
+ forcing(:cols,m) = solution(:cols,m)*dti - (iter_invariant(:cols,m) + prod(:cols,m) - loss(:cols,m))
+ end do
+
+ if( do_diag ) then
+ write(*,*) ' '
+ write(*,*) 'imp_sol: frcing @ iter,dt = ',nr_iter,dt
+ write(*,'(1p,4g20.10)') forcing(1,:)
+ write(*,*) ' '
+ write(*,*) 'imp_sol: iter_invariant @ iter,dt = ',nr_iter,dt
+ write(*,'(1p,4g20.10)') iter_invariant(1,:)
+ write(*,*) ' '
+ write(*,*) 'imp_sol: prod @ iter,dt = ',nr_iter,dt
+ write(*,'(1p,4g20.10)') prod(1,:)
+ write(*,*) ' '
+ write(*,*) 'imp_sol: loss @ iter,dt = ',nr_iter,dt
+ write(*,'(1p,4g20.10)') loss(1,:)
+ end if
+#ifdef DEBUG
+ call t_stopf('frcing')
+ call t_startf('lu_slv')
+#endif
+!-----------------------------------------------------------------------
+! ... Solve for the mixing ratio at t(n+1)
+!-----------------------------------------------------------------------
+ call lu_slv( sys_jac, forcing, cols )
+ if( do_diag ) then
+ write(*,*) ' '
+ write(*,*) 'imp_sol: frcing @ iter,dt = ',nr_iter,dt
+ write(*,'(1p,4g20.10)') forcing(1,:)
+ end if
+ do m = 1,clscnt4
+ solution(:cols,m) = solution(:cols,m) + forcing(:cols,m)
+ end do
+ if( do_diag ) then
+ write(*,*) ' '
+ write(*,*) 'imp_sol: solution @ iter,dt = ',nr_iter,dt
+ write(*,'(1p,4g20.10)') solution(1,:)
+ end if
+#ifdef DEBUG
+ call t_stopf('lu_slv')
+#endif
+!-----------------------------------------------------------------------
+! ... Convergence measures
+!-----------------------------------------------------------------------
+#ifdef DEBUG
+ call t_startf('inner1_conv')
+#endif
+ if( nr_iter > 1 ) then
+ do k = 1,clscnt4
+ m = permute(k,4)
+ do i = 1,cols
+ if( abs(solution(i,m)) > 1.e-40_r8 ) then
+ wrk(i) = abs( forcing(i,m)/solution(i,m) )
+ else
+ wrk(i) = 0._r8
+ end if
+ end do
+! where( abs(solution(:cols,m)) > 1.e-40_r8 )
+! wrk(:cols) = abs( forcing(:cols,m)/solution(:cols,m) )
+! elsewhere
+! wrk(:cols) = 0._r8
+! endwhere
+ max_delta(k) = maxval( wrk(:cols) )
+ end do
+ end if
+#ifdef DEBUG
+ call t_stopf('inner1_conv')
+ call t_startf('inner2_conv')
+#endif
+!-----------------------------------------------------------------------
+! ... Limit iterate
+!-----------------------------------------------------------------------
+ do m = 1,clscnt4
+! where( solution(:cols,m) < 0._r8 )
+! solution(:cols,m) = 0._r8
+! endwhere
+ do i = 1,cols
+ if( solution(i,m) < 0. ) then
+ solution(i,m) = 0.
+ end if
+ end do
+ end do
+!-----------------------------------------------------------------------
+! ... Transfer latest solution back to work array
+!-----------------------------------------------------------------------
+ do k = 1,clscnt4
+ j = clsmap(k,4)
+ m = permute(k,4)
+ do i = 1,cols
+ lsol(i,j) = solution(i,m)
+ end do
+! lsol(:cols,j) = solution(:cols,m)
+ end do
+#ifdef DEBUG
+ call t_stopf('inner2_conv')
+ call t_startf('inner3_conv')
+#endif
+!-----------------------------------------------------------------------
+! ... Check for convergence
+!-----------------------------------------------------------------------
+ if( nr_iter > 1 ) then
+ do k = 1,clscnt4
+ m = permute(k,4)
+ do i = 1,cols
+ if( abs( forcing(i,m) ) > small ) then
+ iter_conv(i) = abs(forcing(i,m)) <= epsilon(k)*abs(solution(i,m))
+ else
+ iter_conv(i) = .true.
+ end if
+ end do
+ converged(k) = all( iter_conv(:cols) )
+ end do
+ convergence = all( converged(:clscnt4) )
+ if( convergence ) then
+#ifdef DEBUG
+ call t_stopf('inner3_conv')
+#endif
+ exit Iteration_loop
+ end if
+ end if
+#ifdef DEBUG
+ call t_stopf('inner3_conv')
+#endif
+ end do Iteration_loop
+
+!-----------------------------------------------------------------------
+! ... Check for Newton-Raphson convergence
+!-----------------------------------------------------------------------
+#ifdef DEBUG
+ call t_startf('outer_conv')
+#endif
+ if( .not. convergence ) then
+!-----------------------------------------------------------------------
+! ... Non-convergence
+!-----------------------------------------------------------------------
+ fail_cnt = fail_cnt + 1
+ nstep = get_nstep()
+ write(*,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,isec,nstep) = '',4i6)') dt,lchnk,lev,isec,nstep
+ stp_con_cnt = 0
+ if( cut_cnt < cut_limit ) then
+ cut_cnt = cut_cnt + 1
+ if( cut_cnt < cut_limit ) then
+ dt = .5_r8 * dt
+ else
+ dt = .1_r8 * dt
+ end if
+ cycle Time_step_loop
+ else
+ write(*,'('' imp_sol: Failed to converge @ (lchnk,lev,isec,nstep,dt,time) = '',4i6,1p,2e21.13)') &
+ lchnk,lev,isec,nstep,dt,interval_done+dt
+ do m = 1,clscnt4
+ if( .not. converged(m) ) then
+ write(*,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m)
+ end if
+ end do
+ end if
+ end if
+!-----------------------------------------------------------------------
+! ... Check for interval done
+!-----------------------------------------------------------------------
+ interval_done = interval_done + dt
+ if( abs( delt - interval_done ) <= .0001_r8 ) then
+ if( fail_cnt > 0 ) then
+ write(*,*) 'imp_sol : @ (lchnk,lev,isec) = ',lchnk,lev,isec,' failed ',fail_cnt,' times'
+ end if
+#ifdef DEBUG
+ call t_stopf('outer_conv')
+#endif
+ exit Time_step_loop
+ else
+!-----------------------------------------------------------------------
+! ... Transfer latest solution back to base array
+!-----------------------------------------------------------------------
+ if( convergence ) then
+ stp_con_cnt = stp_con_cnt + 1
+ end if
+ do m = 1,gas_pcnst
+ base_sol(ofl:ofu,lev,m) = lsol(:cols,m)
+ end do
+ if( stp_con_cnt >= 2 ) then
+ dt = 2._r8*dt
+ stp_con_cnt = 0
+ end if
+ dt = min( dt,delt-interval_done )
+! write(*,'('' imp_sol: New time step '',1p,e21.13)') dt
+ end if
+#ifdef DEBUG
+ call t_stopf('outer_conv')
+#endif
+ end do Time_step_loop
+!-----------------------------------------------------------------------
+! ... Transfer latest solution back to base array
+!-----------------------------------------------------------------------
+ do k = 1,clscnt4
+ j = clsmap(k,4)
+ m = permute(k,4)
+ base_sol(ofl:ofu,lev,j) = solution(:cols,m)
+ end do
+ end do Column_loop
+ end do Level_loop
+
+ end subroutine imp_sol
+
+ end module mo_imp_sol
diff --git a/chem_proc/procfiles/cam/mo_imp_sol_scalar.F90 b/chem_proc/procfiles/cam/mo_imp_sol_scalar.F90
new file mode 100644
index 0000000000..54061ea07a
--- /dev/null
+++ b/chem_proc/procfiles/cam/mo_imp_sol_scalar.F90
@@ -0,0 +1,417 @@
+
+module mo_imp_sol
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : clscnt4, gas_pcnst, clsmap
+ use cam_logfile, only : iulog
+
+ implicit none
+ private
+ public :: imp_slv_inti, imp_sol
+ save
+
+ real(r8), parameter :: rel_err = 1.e-3_r8
+ real(r8), parameter :: high_rel_err = 1.e-4_r8
+ !-----------------------------------------------------------------------
+ ! Newton-Raphson iteration limits
+ !-----------------------------------------------------------------------
+ integer, parameter :: itermax = 11
+ integer, parameter :: cut_limit = 5
+
+
+ real(r8), parameter :: small = 1.e-40_r8
+
+ real(r8) :: epsilon(clscnt4)
+ logical :: factor(itermax)
+
+contains
+
+ subroutine imp_slv_inti
+ !-----------------------------------------------------------------------
+ ! ... Initialize the implict solver
+ !-----------------------------------------------------------------------
+ use mo_chem_utls, only : get_spc_ndx
+
+ implicit none
+
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ integer :: m, ox_ndx, o3a_ndx
+ real(r8) :: eps(gas_pcnst)
+
+ factor(:) = .true.
+ eps(:) = rel_err
+
+ ox_ndx = get_spc_ndx( 'OX' )
+ if( ox_ndx < 1 ) then
+ ox_ndx = get_spc_ndx( 'O3' )
+ end if
+ if( ox_ndx > 0 ) then
+ eps(ox_ndx) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'HNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'HO2NO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'N2O5' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'OH' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'HO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ o3a_ndx = get_spc_ndx( 'O3A' )
+ if( o3a_ndx > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XHNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XHO2NO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO2NO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO2XNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ do m = 1,clscnt4
+ epsilon(m) = eps(clsmap(m,4))
+ end do
+
+ end subroutine imp_slv_inti
+
+ subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, &
+ ncol,nlev, lchnk, prod_out, loss_out )
+ !-----------------------------------------------------------------------
+ ! ... imp_sol advances the volumetric mixing ratio
+ ! forward one time step via the fully implicit euler scheme.
+ ! this source is meant for small l1 cache machines such as
+ ! the intel pentium and itanium cpus
+ !-----------------------------------------------------------------------
+
+ use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt
+ use mo_tracname, only : solsym
+ use mo_lin_matrix, only : linmat
+ use mo_nln_matrix, only : nlnmat
+ use mo_lu_factor, only : lu_fac
+ use mo_lu_solve, only : lu_slv
+ use mo_prod_loss, only : imp_prod_loss
+ use mo_indprd, only : indprd
+ use time_manager, only : get_nstep
+ use perf_mod, only : t_startf, t_stopf
+
+ implicit none
+
+ !-----------------------------------------------------------------------
+ ! ... dummy args
+ !-----------------------------------------------------------------------
+ integer, intent(in) :: ncol ! columns in chunck
+ integer, intent(in) :: nlev
+ integer, intent(in) :: lchnk ! chunk id
+ real(r8), intent(in) :: delt ! time step (s)
+
+ real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s)
+ real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s)
+ real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s)
+ real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr)
+
+ real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4))
+ real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4))
+
+ !-----------------------------------------------------------------------
+ ! ... local variables
+ !-----------------------------------------------------------------------
+ integer :: nr_iter, &
+ lev, &
+ i, &
+ j, &
+ k, l, &
+ m
+ integer :: fail_cnt, cut_cnt, stp_con_cnt
+ integer :: nstep
+ real(r8) :: interval_done, dt, dti
+ real(r8) :: max_delta(max(1,clscnt4))
+ real(r8) :: sys_jac(max(1,nzcnt))
+ real(r8) :: lin_jac(max(1,nzcnt))
+ real(r8), dimension(max(1,clscnt4)) :: &
+ solution, &
+ forcing, &
+ iter_invariant, &
+ prod, &
+ loss
+ real(r8) :: lrxt(max(1,rxntot))
+ real(r8) :: lsol(max(1,gas_pcnst))
+ real(r8) :: lhet(max(1,gas_pcnst))
+ real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: &
+ ind_prd
+ logical :: convergence
+ logical :: frc_mask, iter_conv
+ logical :: converged(max(1,clscnt4))
+
+ solution(:) = 0._r8
+ !-----------------------------------------------------------------------
+ ! ... class independent forcing
+ !-----------------------------------------------------------------------
+ if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then
+ call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, &
+ reaction_rates, ncol )
+ else
+ do m = 1,max(1,clscnt4)
+ ind_prd(:,:,m) = 0._r8
+ end do
+ end if
+ level_loop : do lev = 1,nlev
+ column_loop : do i = 1,ncol
+
+ !-----------------------------------------------------------------------
+ ! ... transfer from base to local work arrays
+ !-----------------------------------------------------------------------
+ do m = 1,rxntot
+ lrxt(m) = reaction_rates(i,lev,m)
+ end do
+ if( gas_pcnst > 0 ) then
+ do m = 1,gas_pcnst
+ lhet(m) = het_rates(i,lev,m)
+ end do
+ end if
+ !-----------------------------------------------------------------------
+ ! ... time step loop
+ !-----------------------------------------------------------------------
+ dt = delt
+ cut_cnt = 0
+ fail_cnt = 0
+ stp_con_cnt = 0
+ interval_done = 0._r8
+ time_step_loop : do
+ dti = 1._r8 / dt
+ !-----------------------------------------------------------------------
+ ! ... transfer from base to local work arrays
+ !-----------------------------------------------------------------------
+ do m = 1,gas_pcnst
+ lsol(m) = base_sol(i,lev,m)
+ end do
+ !-----------------------------------------------------------------------
+ ! ... transfer from base to class array
+ !-----------------------------------------------------------------------
+ do k = 1,clscnt4
+ j = clsmap(k,4)
+ m = permute(k,4)
+ solution(m) = lsol(j)
+ end do
+ !-----------------------------------------------------------------------
+ ! ... set the iteration invariant part of the function f(y)
+ !-----------------------------------------------------------------------
+ if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then
+ do m = 1,clscnt4
+ iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m)
+ end do
+ else
+ do m = 1,clscnt4
+ iter_invariant(m) = dti * solution(m)
+ end do
+ end if
+ !-----------------------------------------------------------------------
+ ! ... the linear component
+ !-----------------------------------------------------------------------
+ if( cls_rxt_cnt(2,4) > 0 ) then
+ call t_startf( 'lin_mat' )
+ call linmat( lin_jac, lsol, lrxt, lhet )
+ call t_stopf( 'lin_mat' )
+ end if
+ !=======================================================================
+ ! the newton-raphson iteration for f(y) = 0
+ !=======================================================================
+ iter_loop : do nr_iter = 1,itermax
+ !-----------------------------------------------------------------------
+ ! ... the non-linear component
+ !-----------------------------------------------------------------------
+ if( factor(nr_iter) ) then
+ call t_startf( 'nln_mat' )
+ call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti )
+ call t_stopf( 'nln_mat' )
+ !-----------------------------------------------------------------------
+ ! ... factor the "system" matrix
+ !-----------------------------------------------------------------------
+ call t_startf( 'lu_fac' )
+ call lu_fac( sys_jac )
+ call t_stopf( 'lu_fac' )
+ end if
+ !-----------------------------------------------------------------------
+ ! ... form f(y)
+ !-----------------------------------------------------------------------
+ call t_startf( 'prod_loss' )
+ call imp_prod_loss( prod, loss, lsol, lrxt, lhet )
+ call t_stopf( 'prod_loss' )
+ do m = 1,clscnt4
+ forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m))
+ end do
+ !-----------------------------------------------------------------------
+ ! ... solve for the mixing ratio at t(n+1)
+ !-----------------------------------------------------------------------
+ call t_startf( 'lu_slv' )
+ call lu_slv( sys_jac, forcing )
+ call t_stopf( 'lu_slv' )
+ do m = 1,clscnt4
+ solution(m) = solution(m) + forcing(m)
+ end do
+ !-----------------------------------------------------------------------
+ ! ... convergence measures
+ !-----------------------------------------------------------------------
+ if( nr_iter > 1 ) then
+ do k = 1,clscnt4
+ m = permute(k,4)
+ if( abs(solution(m)) > 1.e-20_r8 ) then
+ max_delta(k) = abs( forcing(m)/solution(m) )
+ else
+ max_delta(k) = 0._r8
+ end if
+ end do
+ end if
+ !-----------------------------------------------------------------------
+ ! ... limit iterate
+ !-----------------------------------------------------------------------
+ where( solution(:) < 0._r8 )
+ solution(:) = 0._r8
+ endwhere
+ !-----------------------------------------------------------------------
+ ! ... transfer latest solution back to work array
+ !-----------------------------------------------------------------------
+ do k = 1,clscnt4
+ j = clsmap(k,4)
+ m = permute(k,4)
+ lsol(j) = solution(m)
+ end do
+ !-----------------------------------------------------------------------
+ ! ... check for convergence
+ !-----------------------------------------------------------------------
+ converged(:) = .true.
+ if( nr_iter > 1 ) then
+ do k = 1,clscnt4
+ m = permute(k,4)
+ frc_mask = abs( forcing(m) ) > small
+ if( frc_mask ) then
+ converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m))
+ else
+ converged(k) = .true.
+ end if
+ end do
+ convergence = all( converged(:) )
+ if( convergence ) then
+ exit
+ end if
+ end if
+ end do iter_loop
+ !-----------------------------------------------------------------------
+ ! ... check for newton-raphson convergence
+ !-----------------------------------------------------------------------
+ if( .not. convergence ) then
+ !-----------------------------------------------------------------------
+ ! ... non-convergence
+ !-----------------------------------------------------------------------
+ fail_cnt = fail_cnt + 1
+ nstep = get_nstep()
+ write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') &
+ dt,lchnk,lev,i,nstep
+ stp_con_cnt = 0
+ if( cut_cnt < cut_limit ) then
+ cut_cnt = cut_cnt + 1
+ if( cut_cnt < cut_limit ) then
+ dt = .5_r8 * dt
+ else
+ dt = .1_r8 * dt
+ end if
+ cycle time_step_loop
+ else
+ write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') &
+ lchnk,lev,i,nstep,dt,interval_done+dt
+ do m = 1,clscnt4
+ if( .not. converged(m) ) then
+ write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m)
+ end if
+ end do
+ end if
+ end if
+ !-----------------------------------------------------------------------
+ ! ... check for interval done
+ !-----------------------------------------------------------------------
+ interval_done = interval_done + dt
+ if( abs( delt - interval_done ) <= .0001_r8 ) then
+ if( fail_cnt > 0 ) then
+ write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times'
+ end if
+ exit time_step_loop
+ else
+ !-----------------------------------------------------------------------
+ ! ... transfer latest solution back to base array
+ !-----------------------------------------------------------------------
+ if( convergence ) then
+ stp_con_cnt = stp_con_cnt + 1
+ end if
+ do m = 1,gas_pcnst
+ base_sol(i,lev,m) = lsol(m)
+ end do
+ if( stp_con_cnt >= 2 ) then
+ dt = 2._r8*dt
+ stp_con_cnt = 0
+ end if
+ dt = min( dt,delt-interval_done )
+ ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt
+ end if
+ end do time_step_loop
+ !-----------------------------------------------------------------------
+ ! ... Transfer latest solution back to base array
+ !-----------------------------------------------------------------------
+ cls_loop: do k = 1,clscnt4
+ j = clsmap(k,4)
+ m = permute(k,4)
+ base_sol(i,lev,j) = solution(m)
+
+ ! output diagnostics
+ prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k)
+ loss_out(i,lev,k) = loss(k)
+ end do cls_loop
+
+ end do column_loop
+ end do level_loop
+ end subroutine imp_sol
+end module mo_imp_sol
diff --git a/chem_proc/procfiles/cam/mo_imp_sol_vector.F90 b/chem_proc/procfiles/cam/mo_imp_sol_vector.F90
new file mode 100644
index 0000000000..63df62e8f2
--- /dev/null
+++ b/chem_proc/procfiles/cam/mo_imp_sol_vector.F90
@@ -0,0 +1,436 @@
+module mo_imp_sol
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : clscnt4, gas_pcnst, clsmap, veclen
+ use cam_logfile, only : iulog
+ implicit none
+ private
+ public :: imp_slv_inti, imp_sol
+ save
+ real(r8), parameter :: rel_err = 1.e-3_r8
+ real(r8), parameter :: high_rel_err = 1.e-4_r8
+ !-----------------------------------------------------------------------
+ ! Newton-Raphson iteration limits
+ !-----------------------------------------------------------------------
+ integer, parameter :: itermax = 11
+ integer, parameter :: cut_limit = 5
+ real(r8), parameter :: sol_min = 1.e-20_r8
+ real(r8), parameter :: small = 1.e-40_r8
+ real(r8) :: epsilon(clscnt4)
+ logical :: factor(itermax)
+contains
+ subroutine imp_slv_inti
+ !-----------------------------------------------------------------------
+ ! ... Initialize the implict solver
+ !-----------------------------------------------------------------------
+ use mo_chem_utls, only : get_spc_ndx
+ implicit none
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ integer :: m, ox_ndx, o3a_ndx
+ real(r8) :: eps(gas_pcnst)
+ factor(:) = .true.
+ eps(:) = rel_err
+ ox_ndx = get_spc_ndx( 'OX' )
+ if( ox_ndx < 1 ) then
+ ox_ndx = get_spc_ndx( 'O3' )
+ end if
+ if( ox_ndx > 0 ) then
+ eps(ox_ndx) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'HNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'HO2NO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'N2O5' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'OH' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'HO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ o3a_ndx = get_spc_ndx( 'O3A' )
+ if( o3a_ndx > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XHNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XHO2NO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO2NO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO2XNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ do m = 1,clscnt4
+ epsilon(m) = eps(clsmap(m,4))
+ end do
+ end subroutine imp_slv_inti
+ subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, &
+ ncol, nlev, lchnk, prod_out, loss_out )
+ !-----------------------------------------------------------------------
+ ! ... imp_sol advances the volumetric mixing ratio
+ ! forward one time step via the fully implicit euler scheme.
+ ! this source is meant for vector architectures such as the
+ ! nec sx6 and cray x1
+ !-----------------------------------------------------------------------
+ use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt
+ use mo_tracname, only : solsym
+ use mo_lin_matrix, only : linmat
+ use mo_nln_matrix, only : nlnmat
+ use mo_lu_factor, only : lu_fac
+ use mo_lu_solve, only : lu_slv
+ use mo_prod_loss, only : imp_prod_loss
+ use mo_indprd, only : indprd
+ use time_manager, only : get_nstep
+ use perf_mod, only : t_startf, t_stopf
+ implicit none
+ !-----------------------------------------------------------------------
+ ! ... dummy args
+ !-----------------------------------------------------------------------
+ integer, intent(in) :: ncol ! columns in chunck
+ integer, intent(in) :: nlev
+ integer, intent(in) :: lchnk ! chunk id
+ real(r8), intent(in) :: delt ! time step (s)
+ real(r8), intent(in) :: reaction_rates(ncol*nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s)
+ real(r8), intent(in) :: extfrc(ncol*nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s)
+ real(r8), intent(in) :: het_rates(ncol*nlev,max(1,gas_pcnst)) ! washout rates (1/s)
+ real(r8), intent(inout) :: base_sol(ncol*nlev,gas_pcnst) ! species mixing ratios (vmr)
+ real(r8), intent(out) :: prod_out(ncol*nlev,max(1,clscnt4))
+ real(r8), intent(out) :: loss_out(ncol*nlev,max(1,clscnt4))
+ !-----------------------------------------------------------------------
+ ! ... local variables
+ !-----------------------------------------------------------------------
+ integer :: nr_iter
+ integer :: ofl
+ integer :: ofu
+ integer :: avec_len
+ integer :: bndx ! base index
+ integer :: cndx ! class index
+ integer :: pndx ! permuted class index
+ integer :: i,m
+ integer :: fail_cnt(veclen)
+ integer :: cut_cnt(veclen)
+ integer :: stp_con_cnt(veclen)
+ integer :: nstep
+ real(r8) :: interval_done(veclen)
+ real(r8) :: dt(veclen)
+ real(r8) :: dti(veclen)
+ real(r8) :: max_delta(max(1,clscnt4))
+ real(r8) :: ind_prd(ncol*nlev,max(1,clscnt4))
+ logical :: convergence
+ integer :: chnkpnts ! total spatial points in chunk; ncol*ncol
+ logical :: diags_out(ncol*nlev,max(1,clscnt4))
+ real(r8) :: sys_jac_blk(veclen,max(1,nzcnt))
+ real(r8) :: lin_jac_blk(veclen,max(1,nzcnt))
+ real(r8) :: solution_blk(veclen,max(1,clscnt4))
+ real(r8) :: forcing_blk(veclen,max(1,clscnt4))
+ real(r8) :: iter_invariant_blk(veclen,max(1,clscnt4))
+ real(r8) :: prod_blk(veclen,max(1,clscnt4))
+ real(r8) :: loss_blk(veclen,max(1,clscnt4))
+ real(r8) :: ind_prd_blk(veclen,max(1,clscnt4))
+ real(r8) :: sbase_sol_blk(veclen,gas_pcnst)
+ real(r8) :: wrk_blk(veclen)
+ logical :: spc_conv_blk(veclen,max(1,clscnt4))
+ logical :: cls_conv_blk(veclen)
+ logical :: time_stp_done_blk(veclen)
+ real(r8) :: reaction_rates_blk(veclen,max(1,rxntot))
+ real(r8) :: extfrc_blk(veclen,max(1,extcnt))
+ real(r8) :: het_rates_blk(veclen,max(1,gas_pcnst))
+ real(r8) :: base_sol_blk(veclen,gas_pcnst)
+ chnkpnts = ncol*nlev
+ prod_out = 0._r8
+ loss_out = 0._r8
+ diags_out = .false.
+ !-----------------------------------------------------------------------
+ ! ... class independent forcing
+ !-----------------------------------------------------------------------
+ if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then
+ call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, &
+ reaction_rates, chnkpnts )
+ else
+ do m = 1,clscnt4
+ ind_prd(:,m) = 0._r8
+ end do
+ end if
+ nstep = get_nstep()
+ ofl = 1
+ chnkpnts_loop : do
+ ofu = min( chnkpnts,ofl + veclen - 1 )
+ avec_len = (ofu - ofl) + 1
+ reaction_rates_blk(1:avec_len,:) = reaction_rates(ofl:ofu,:)
+ extfrc_blk(1:avec_len,:) = extfrc(ofl:ofu,:)
+ het_rates_blk(1:avec_len,:) = het_rates(ofl:ofu,:)
+ ind_prd_blk(1:avec_len,:) = ind_prd(ofl:ofu,:)
+ base_sol_blk(1:avec_len,:) = base_sol(ofl:ofu,:)
+ cls_conv_blk(1:avec_len) = .false.
+ dt(1:avec_len) = delt
+ cut_cnt(1:avec_len) = 0
+ fail_cnt(1:avec_len) = 0
+ stp_con_cnt(1:avec_len) = 0
+ interval_done(1:avec_len) = 0._r8
+ time_stp_done_blk(1:avec_len) = .false.
+ !-----------------------------------------------------------------------
+ ! ... time step loop
+ !-----------------------------------------------------------------------
+ time_step_loop : do
+ dti(1:avec_len) = 1._r8 / dt(1:avec_len)
+ !-----------------------------------------------------------------------
+ ! ... transfer from base to class array
+ !-----------------------------------------------------------------------
+ do cndx = 1,clscnt4
+ bndx = clsmap(cndx,4)
+ pndx = permute(cndx,4)
+ do i = 1, avec_len
+ solution_blk(i,pndx) = base_sol_blk(i,bndx)
+ end do
+ end do
+ do m = 1,gas_pcnst
+ sbase_sol_blk(1:avec_len,m) = base_sol_blk(1:avec_len,m)
+ end do
+ !-----------------------------------------------------------------------
+ ! ... set the iteration invariant part of the function f(y)
+ !-----------------------------------------------------------------------
+ if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then
+ do m = 1,clscnt4
+ do i = 1, avec_len
+ iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m) + ind_prd_blk(i,m)
+ end do
+ end do
+ else
+ do m = 1,clscnt4
+ do i = 1, avec_len
+ iter_invariant_blk(i,m) = dti(i) * solution_blk(i,m)
+ end do
+ end do
+ end if
+ !-----------------------------------------------------------------------
+ ! ... the linear component
+ !-----------------------------------------------------------------------
+ if( cls_rxt_cnt(2,4) > 0 ) then
+ call t_startf( 'lin_mat' )
+ call linmat( avec_len, lin_jac_blk, base_sol_blk, &
+ reaction_rates_blk, het_rates_blk )
+ call t_stopf( 'lin_mat' )
+ end if
+ !=======================================================================
+ ! the newton-raphson iteration for f(y) = 0
+ !=======================================================================
+ iter_loop : do nr_iter = 1,itermax
+ !-----------------------------------------------------------------------
+ ! ... the non-linear component
+ !-----------------------------------------------------------------------
+ if( factor(nr_iter) ) then
+ call t_startf( 'nln_mat' )
+ call nlnmat( avec_len, sys_jac_blk, base_sol_blk, &
+ reaction_rates_blk, lin_jac_blk, dti )
+ call t_stopf( 'nln_mat' )
+ !-----------------------------------------------------------------------
+ ! ... factor the "system" matrix
+ !-----------------------------------------------------------------------
+ call t_startf( 'lu_fac' )
+ call lu_fac( avec_len, sys_jac_blk )
+ call t_stopf( 'lu_fac' )
+ end if
+ !-----------------------------------------------------------------------
+ ! ... form f(y)
+ !-----------------------------------------------------------------------
+ call t_startf( 'prod_loss' )
+ call imp_prod_loss( avec_len, prod_blk, loss_blk, &
+ base_sol_blk, reaction_rates_blk, het_rates_blk )
+ call t_stopf( 'prod_loss' )
+ do m = 1,clscnt4
+ do i = 1, avec_len
+ forcing_blk(i,m) = solution_blk(i,m)*dti(i) &
+ - (iter_invariant_blk(i,m) + prod_blk(i,m) - loss_blk(i,m))
+ end do
+ end do
+ !-----------------------------------------------------------------------
+ ! ... solve for the mixing ratio at t(n+1)
+ !-----------------------------------------------------------------------
+ call t_startf( 'lu_slv' )
+ call lu_slv( avec_len, sys_jac_blk, forcing_blk )
+ call t_stopf( 'lu_slv' )
+ do m = 1,clscnt4
+ do i = 1, avec_len
+ if( .not. cls_conv_blk(i) )then
+ solution_blk(i,m) = solution_blk(i,m) + forcing_blk(i,m)
+ else
+ forcing_blk(i,m) = 0._r8
+ endif
+ end do
+ end do
+ !-----------------------------------------------------------------------
+ ! ... convergence measures and test
+ !-----------------------------------------------------------------------
+ conv_chk : if( nr_iter > 1 ) then
+ !-----------------------------------------------------------------------
+ ! ... check for convergence
+ !-----------------------------------------------------------------------
+ do cndx = 1,clscnt4
+ pndx = permute(cndx,4)
+ bndx = clsmap(cndx,4)
+ do i = 1, avec_len
+ if ( abs( solution_blk(i,pndx) ) > sol_min ) then
+ wrk_blk(i) = abs( forcing_blk(i,pndx)/solution_blk(i,pndx) )
+ else
+ wrk_blk(i) = 0._r8
+ endif
+ enddo
+ max_delta(cndx) = maxval( wrk_blk(1:avec_len) )
+ do i = 1, avec_len
+ solution_blk(i,pndx) = max( 0._r8,solution_blk(i,pndx) )
+ base_sol_blk(i,bndx) = solution_blk(i,pndx)
+ if ( abs( forcing_blk(i,pndx) ) > small ) then
+ spc_conv_blk(i,cndx) = abs(forcing_blk(i,pndx)) <= epsilon(cndx)*abs(solution_blk(i,pndx))
+ else
+ spc_conv_blk(i,cndx) = .true.
+ endif
+ enddo
+ where( spc_conv_blk(1:avec_len,cndx) .and. .not.diags_out(ofl:ofu,cndx) )
+ ! capture output production and loss diagnostics at converged ponits
+ prod_out(ofl:ofu,cndx) = prod_blk(1:avec_len,cndx) + ind_prd_blk(1:avec_len,cndx)
+ loss_out(ofl:ofu,cndx) = loss_blk(1:avec_len,cndx)
+ diags_out(ofl:ofu,cndx) = .true.
+ endwhere
+ end do
+ do i = 1, avec_len
+ if( .not. cls_conv_blk(i) ) then
+ cls_conv_blk(i) = all( spc_conv_blk(i,:) )
+ end if
+ end do
+ convergence = all( cls_conv_blk(:) )
+ if( convergence ) then
+ exit iter_loop
+ end if
+ else conv_chk
+!-----------------------------------------------------------------------
+! ... limit iterate
+!-----------------------------------------------------------------------
+ do m = 1,clscnt4
+ do i = 1, avec_len
+ solution_blk(i,m) = max( 0._r8,solution_blk(i,m) )
+ end do
+ end do
+!-----------------------------------------------------------------------
+! ... transfer latest solution back to base array
+!-----------------------------------------------------------------------
+ do cndx = 1,clscnt4
+ pndx = permute(cndx,4)
+ bndx = clsmap(cndx,4)
+ do i = 1, avec_len
+ base_sol_blk(i,bndx) = solution_blk(i,pndx)
+ end do
+ end do
+ end if conv_chk
+ end do iter_loop
+ !-----------------------------------------------------------------------
+ ! ... check for newton-raphson convergence
+ !-----------------------------------------------------------------------
+ do i = 1,avec_len
+ if( .not. cls_conv_blk(i) ) then
+ fail_cnt(i) = fail_cnt(i) + 1
+ write(iulog,'('' imp_sol: time step '',1p,g15.7,'' failed to converge @ (lchnk,vctrpos,nstep) = '',3i8)') &
+ dt(i),lchnk,ofl+i-1,nstep
+ stp_con_cnt(i) = 0
+ if( cut_cnt(i) < cut_limit ) then
+ cut_cnt(i) = cut_cnt(i) + 1
+ if( cut_cnt(i) < cut_limit ) then
+ dt(i) = .5_r8 * dt(i)
+ else
+ dt(i) = .1_r8 * dt(i)
+ end if
+ base_sol_blk(i,:) = sbase_sol_blk(i,:)
+ else
+ write(iulog,'('' imp_sol: step failed to converge @ (lchnk,vctrpos,nstep,dt,time) = '',3i8,1p,2g15.7)') &
+ lchnk,ofl+i-1,nstep,dt(i),interval_done+dt(i)
+ do m = 1,clscnt4
+ if( .not. spc_conv_blk(i,m) ) then
+ write(iulog,'(1x,a16,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m)
+ end if
+ end do
+ cls_conv_blk(i) = .true.
+ if( .not. time_stp_done_blk(i) ) then
+ interval_done(i) = interval_done(i) + dt(i)
+ time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8
+ endif
+ end if
+ elseif( .not. time_stp_done_blk(i) ) then
+ interval_done(i) = interval_done(i) + dt(i)
+ time_stp_done_blk(i) = abs( delt - interval_done(i) ) <= .0001_r8
+ stp_con_cnt(i) = stp_con_cnt(i) + 1
+ if( .not. time_stp_done_blk(i) ) then
+ if( stp_con_cnt(i) >= 2 ) then
+ dt(i) = 2._r8*dt(i)
+ stp_con_cnt(i) = 0
+ end if
+ dt(i) = min( dt(i),delt-interval_done(i) )
+ else
+ base_sol(ofl+i-1,1:gas_pcnst) = base_sol_blk(i,1:gas_pcnst)
+ endif
+ endif
+ end do
+ convergence = all( cls_conv_blk(:) )
+ do i = 1,avec_len
+ if( cls_conv_blk(i) .and. .not. time_stp_done_blk(i) ) then
+ cls_conv_blk(i) = .false.
+ endif
+ end do
+ if( .not. convergence ) then
+ cycle time_step_loop
+ endif
+ !-----------------------------------------------------------------------
+ ! ... check for time step done
+ !-----------------------------------------------------------------------
+ if( all( time_stp_done_blk(1:avec_len) ) ) then
+ exit time_step_loop
+ end if
+ end do time_step_loop
+
+ ofl = ofu + 1
+ if( ofl > chnkpnts ) then
+ exit chnkpnts_loop
+ end if
+ end do chnkpnts_loop
+ end subroutine imp_sol
+end module mo_imp_sol
diff --git a/chem_proc/procfiles/mo_chem.mod b/chem_proc/procfiles/mo_chem.mod
new file mode 100644
index 0000000000..e7d53dcb5a
--- /dev/null
+++ b/chem_proc/procfiles/mo_chem.mod
@@ -0,0 +1,141 @@
+
+ module chem_mods
+!--------------------------------------------------------------
+! ... basic chemistry array parameters
+!--------------------------------------------------------------
+
+ use mo_grid, only : pcnstm1
+
+ implicit none
+
+ save
+
+ integer, parameter :: hetcnt = HETCNT, & ! number of heterogeneous processes
+ phtcnt = PHTCNT, & ! number of photo processes
+ rxntot = RXNCNT, & ! number of total reactions
+ gascnt = GASCNT, & ! number of gas phase reactions
+ nfs = NFS, & ! number of "fixed" species
+ relcnt = RELCNT, & ! number of relationship species
+ grpcnt = GRPCNT, & ! number of group members
+ imp_nzcnt = IMP_NZCNT, & ! number of non-zero implicit matrix entries
+ rod_nzcnt = ROD_NZCNT, & ! number of non-zero rodas matrix entries
+ extcnt = EXTCNT, & ! number of species with external forcing
+ clscnt1 = CLSCNT1, & ! number of species in explicit class
+ clscnt2 = CLSCNT2, & ! number of species in hov class
+ clscnt3 = CLSCNT3, & ! number of species in ebi class
+ clscnt4 = CLSCNT4, & ! number of species in implicit class
+ clscnt5 = CLSCNT5, & ! number of species in rodas class
+ indexm = INDEXM, & ! index of total atm density in invariant array
+ ncol_abs = NCOL, & ! number of column densities
+ indexh2o = INDEXH2O, & ! index of water vapor density
+ clsze = CLSZE ! loop length for implicit chemistry
+
+ integer :: ngrp = 0
+ integer :: drydep_cnt = 0
+ integer :: srfems_cnt = 0
+ integer :: rxt_alias_cnt = 0
+ integer :: fbc_cnt(2) = 0
+ integer, allocatable :: grp_mem_cnt(:)
+ integer, allocatable :: rxt_alias_map(:)
+ real :: adv_mass(pcnstm1)
+ real :: nadv_mass(grpcnt)
+ character(len=16), allocatable :: rxt_alias_lst(:)
+ character(len=8), allocatable :: drydep_lst(:)
+ character(len=8), allocatable :: srfems_lst(:)
+ character(len=8), allocatable :: grp_lst(:)
+ character(len=8), allocatable :: flbc_lst(:)
+ character(len=8) :: het_lst(max(1,hetcnt))
+ character(len=8) :: extfrc_lst(max(1,extcnt))
+ character(len=8) :: inv_lst(max(1,nfs))
+
+ type solver_class
+ integer :: clscnt
+ integer :: lin_rxt_cnt
+ integer :: nln_rxt_cnt
+ integer :: indprd_cnt
+ integer :: iter_max
+ integer :: cls_rxt_cnt(4)
+ integer, pointer :: permute(:)
+ integer, pointer :: diag_map(:)
+ integer, pointer :: clsmap(:)
+ end type solver_class
+
+ type(solver_class) :: explicit, implicit, rodas
+
+ contains
+
+ subroutine chem_mods_inti
+!--------------------------------------------------------------
+! ... intialize the class derived type
+!--------------------------------------------------------------
+
+ implicit none
+
+ integer :: astat
+
+ explicit%clscnt = CLSCNT1
+ explicit%indprd_cnt = CLSINDPRD1
+
+ implicit%clscnt = CLSCNT4
+ implicit%lin_rxt_cnt = IMP_LINCNT
+ implicit%nln_rxt_cnt = IMP_NLNCNT
+ implicit%indprd_cnt = CLSINDPRD4
+ implicit%iter_max = IMPITERMAX
+
+ rodas%clscnt = CLSCNT5
+ rodas%lin_rxt_cnt = ROD_LINCNT
+ rodas%nln_rxt_cnt = ROD_NLNCNT
+ rodas%indprd_cnt = CLSINDPRD5
+
+ if( explicit%clscnt > 0 ) then
+ allocate( explicit%clsmap(explicit%clscnt),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'chem_mods_inti: failed to allocate explicit%clsmap ; error = ',astat
+ call endrun
+ end if
+ explicit%clsmap(:) = 0
+ end if
+ if( implicit%clscnt > 0 ) then
+ allocate( implicit%permute(implicit%clscnt),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'chem_mods_inti: failed to allocate implicit%permute ; error = ',astat
+ call endrun
+ end if
+ implicit%permute(:) = 0
+ allocate( implicit%diag_map(implicit%clscnt),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'chem_mods_inti: failed to allocate implicit%diag_map ; error = ',astat
+ call endrun
+ end if
+ implicit%diag_map(:) = 0
+ allocate( implicit%clsmap(implicit%clscnt),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'chem_mods_inti: failed to allocate implicit%clsmap ; error = ',astat
+ call endrun
+ end if
+ implicit%clsmap(:) = 0
+ end if
+ if( rodas%clscnt > 0 ) then
+ allocate( rodas%permute(rodas%clscnt),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'chem_mods_inti: failed to allocate rodas%permute ; error = ',astat
+ call endrun
+ end if
+ rodas%permute(:) = 0
+ allocate( rodas%diag_map(rodas%clscnt),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'chem_mods_inti: failed to allocate rodas%diag_map ; error = ',astat
+ call endrun
+ end if
+ rodas%diag_map(:) = 0
+ allocate( rodas%clsmap(rodas%clscnt),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'chem_mods_inti: failed to allocate rodas%clsmap ; error = ',astat
+ call endrun
+ end if
+ rodas%clsmap(:) = 0
+ end if
+
+ end subroutine chem_mods_inti
+
+ end module chem_mods
diff --git a/chem_proc/procfiles/mo_grid.mod b/chem_proc/procfiles/mo_grid.mod
new file mode 100644
index 0000000000..f36e2ff917
--- /dev/null
+++ b/chem_proc/procfiles/mo_grid.mod
@@ -0,0 +1,32 @@
+
+ module mo_grid
+!---------------------------------------------------------------------
+! ... Basic grid point resolution parameters
+!---------------------------------------------------------------------
+ implicit none
+
+ save
+
+ integer, parameter :: &
+ pcnst = PCNST+1, & ! number of advected constituents including cloud water
+ pcnstm1 = PCNST, & ! number of advected constituents excluding cloud water
+ plev = PLEV, & ! number of vertical levels
+ plevp = plev+1, & ! plev plus 1
+ plevm = plev-1, & ! plev minus 1
+ plon = PLON, & ! number of longitudes
+ plat = PLAT ! number of latitudes
+
+ integer, parameter :: &
+ pnats = GRPCNT ! number of non-advected trace species
+
+#ifdef STRAT_CHEM
+ integer, parameter :: &
+ phmu = PCNST ! number of long-lived species
+#endif
+
+ integer :: nodes ! mpi task count
+ integer :: plonl ! longitude tile dimension
+ integer :: pplon ! longitude tile count
+ integer :: plnplv ! plonl * plev
+
+ end module mo_grid
diff --git a/chem_proc/src/Base_Srclist_f b/chem_proc/src/Base_Srclist_f
new file mode 100644
index 0000000000..0659d178fb
--- /dev/null
+++ b/chem_proc/src/Base_Srclist_f
@@ -0,0 +1,49 @@
+mozpp.mods.f
+mass_diags.f
+make_lu_slv.f
+res_hdr.f
+chm_hdr.f
+make_names.f
+slt_hdr.f
+eqrep.f
+rxt_equations.f
+sol_cls.f
+hist_hdr.f
+exe_opts.f
+sp_utils.f
+mozpp.subs.f
+sparse_pat.f
+files_hdr.f
+params_hdr.f
+hist_inp.f
+nln_code.f
+spat_dim.f
+hist_out.f
+num_ctl.f
+srfflx.f
+ipd_code.f
+padj_code.f
+sub_scan.f
+pl_code.f
+symbol.f
+job_ctl.f
+prd_map.f
+tokens.f
+lin_code.f
+radj_code.f
+usrsubs.f
+mak_grp_vmr.f
+rate_code.f
+ver_hdr.f
+make_lu_fac.f
+rate_tab.f
+ver_opts.f
+rxt_names.f
+het_names.f
+chem.f
+make_map.f
+rmod_code.f
+cls_map.f
+bndy_conds.f
+make_sim_dat.f
+mozpp.main.f
diff --git a/chem_proc/src/Makefile b/chem_proc/src/Makefile
new file mode 100644
index 0000000000..113024679c
--- /dev/null
+++ b/chem_proc/src/Makefile
@@ -0,0 +1,174 @@
+#-----------------------------------------------------------------------
+# This Makefile is for building MOZART2 Pre-processor
+#------------------------------------------------------------------------
+
+# Set up special characters
+null :=
+space := $(null) $(null)
+
+# Check for directory in which to put executable
+ifeq ($(MODEL_EXEDIR),$(null))
+MODEL_EXEDIR := ../bin
+endif
+
+# Check for name of executable
+ifeq ($(EXENAME),$(null))
+EXENAME := campp
+endif
+
+# Check for source list
+ifeq ($(SRCLIST),$(null))
+SRCLIST := Base_Srclist_f
+endif
+
+ifeq ($(OBJ_DIR),$(null))
+OBJ_DIR := ./OBJ
+endif
+
+# Load dependency search path.
+# Check for source directories
+ifeq ($(SRCDIRS),$(null))
+dirs := ./cam_chempp
+else
+dirs := ./ $(SRCDIRS)
+endif
+
+# Determine platform
+UNAMES := $(shell uname -s)
+UNAMEM := $(shell uname -m)
+
+# Set cpp search path, include netcdf
+cpp_dirs := $(dirs)
+cpp_path := $(foreach dir,$(cpp_dirs),-I$(dir)) # format for command line
+
+# Expand any tildes in directory names. Change spaces to colons.
+VPATH := $(foreach dir,$(cpp_dirs),$(dir))
+VPATH := $(subst $(space),:,$(VPATH))
+
+# Get list of files and determine objects and dependency files
+base_srclist_f := $(shell cat $(SRCLIST))
+OBJS := $(foreach file,$(base_srclist_f),$(OBJ_DIR)/$(file:.f=.o))
+
+all: $(MODEL_EXEDIR)/$(EXENAME)
+
+#------------------------------------------------------------------------
+#------------------------------------------------------------------------
+#------------------------------------------------------------------------
+
+# guess default compiler
+ifeq ($(USER_FC),$(null))
+
+#------------------------------------------------------------------------
+# Linux -- including pleiades
+#------------------------------------------------------------------------
+ifeq ($(UNAMES),Linux)
+ USER_FC := pgf95
+endif
+#------------------------------------------------------------------------
+# Altix (columbia)
+#------------------------------------------------------------------------
+ifeq ($(UNAMEM),ia64)
+ USER_FC := ifort
+endif
+#------------------------------------------------------------------------
+# Alpha
+#------------------------------------------------------------------------
+ifeq ($(UNAMEM),alpha)
+ USER_FC := f95
+endif
+#------------------------------------------------------------------------
+# AIX ?
+#------------------------------------------------------------------------
+ifeq ($(UNAMES),AIX)
+ USER_FC := xlf95
+endif
+#------------------------------------------------------------------------
+# BG/L, BG/P
+#------------------------------------------------------------------------
+ifeq ($(UNAMEM),ppc64)
+ USER_FC := xlf95
+endif
+#------------------------------------------------------------------------
+# SGI
+#------------------------------------------------------------------------
+ifeq ($(UNAMES),IRIX64)
+ USER_FC := f90
+ MACHFLGS := -OPT:Olimit=8200
+endif
+
+#------------------------------------------------------------------------
+#------------------------------------------------------------------------
+
+endif
+
+#------------------------------------------------------------------------
+#------------------------------------------------------------------------
+# set compiler flags ...
+#------------------------------------------------------------------------
+ifeq ($(USER_FC),ifort)
+ FFLAGS := -O2 -c -132 -ftz -g -FR -I $(OBJ_DIR)
+ ifeq ($(DEBUG),TRUE)
+ FFLAGS += -CB
+ endif
+endif
+ifeq ($(USER_FC),lf95)
+ ifeq ($(DEBUG),TRUE)
+ FFLAGS := --nfix --nap --chk --g --npca --nsav --trace --trap -c --mod $(OBJ_DIR) -O
+ else
+ FFLAGS := --nfix --nap --nchk --ng --npca --nsav --ntrace -c --mod $(OBJ_DIR) -O2
+ endif
+endif
+ifeq ($(USER_FC),pgf90)
+ FFLAGS := -O1 -c -g -Mfree -module $(OBJ_DIR)
+ ifeq ($(DEBUG),TRUE)
+ FFLAGS += -C
+ endif
+endif
+ifeq ($(USER_FC),pgf95)
+ FFLAGS := -O1 -c -g -Mfree -module $(OBJ_DIR)
+ ifeq ($(DEBUG),TRUE)
+ FFLAGS += -C
+ endif
+endif
+ifeq ($(USER_FC),f90)
+ FFLAGS := -c -freeform -I $(OBJ_DIR) -O2 $(MACHFLGS)
+endif
+ifeq ($(USER_FC),f95)
+ FFLAGS := -O4 -c -tune host -arch host -free -module $(OBJ_DIR) -I $(OBJ_DIR)
+endif
+ifeq ($(USER_FC),xlf95)
+ FFLAGS := -g -c -qarch=auto -qnosave -qfree=f90 -qmoddir=$(OBJ_DIR) -I $(OBJ_DIR) -qstrict -O3
+endif
+ifeq ($(USER_FC),gfortran)
+ FFLAGS := -g -c -ffree-form
+endif
+ifeq ($(USER_FC),g95)
+ FFLAGS := -g -c -ffree-form
+endif
+
+#------------------------------------------------------------------------
+#------------------------------------------------------------------------
+#------------------------------------------------------------------------
+
+FC := $(USER_FC)
+
+#------------------------------------------------------------------------
+# Default rules
+#------------------------------------------------------------------------
+
+.SUFFIXES:
+.SUFFIXES: .f .F .c .o
+
+$(OBJ_DIR)/%.o : %.f
+ $(FC) $(FFLAGS) -o $@ $<
+
+$(MODEL_EXEDIR)/$(EXENAME): $(OBJS)
+ $(FC) -o $@ $(OBJS) $(LDFLAGS)
+
+RM := rm
+
+clean:
+ $(RM) -f $(OBJ_DIR)/*.o $(OBJ_DIR)/*.mod $(MODEL_EXEDIR)/$(EXENAME)
+
+realclean:
+ $(RM) -f $(OBJ_DIR)/*.o *.d $(MODEL_EXEDIR)/$(EXENAME)
diff --git a/chem_proc/src/cam_chempp/alloc.f b/chem_proc/src/cam_chempp/alloc.f
new file mode 100644
index 0000000000..92f549aa6b
--- /dev/null
+++ b/chem_proc/src/cam_chempp/alloc.f
@@ -0,0 +1,330 @@
+
+ module REALLOC
+!-----------------------------------------------------------------------
+! ... Reallocation module for integer, real, and character arrays
+!-----------------------------------------------------------------------
+
+ implicit none
+
+ interface REALLOCATE
+ module PROCEDURE R3_ALLOCATE, R2_ALLOCATE, R1_ALLOCATE
+ $, I3_ALLOCATE, I2_ALLOCATE, I1_ALLOCATE
+ $, C2_ALLOCATE, C1_ALLOCATE
+ end interface
+
+ CONTAINS
+
+ subroutine R3_ALLOCATE( array )
+!-----------------------------------------------------------------------
+! ... Real realloc
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ real, pointer :: array(:,:,:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: astat
+ integer :: siz(3)
+ real, allocatable :: temp(:,:,:)
+
+ siz(1) = SIZE( array,1 )
+ siz(2) = SIZE( array,2 )
+ siz(3) = SIZE( array,3 )
+ ALLOCATE( temp(siz(1),siz(2),siz(3)),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'R3_ALLOCATE: Failed to allocate temp array'
+ write(*,*) ' Size = ',siz(1),' x ',siz(2),' x ',siz(3)
+ stop
+ end if
+ temp = array
+ DEALLOCATE( array )
+ ALLOCATE( array(2*siz(1),siz(2),siz(3)),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'R3_ALLOCATE: Failed to allocate new array'
+ write(*,*) ' Size = ',siz(1),' x ',siz(2),' x ',siz(3)
+ stop
+ end if
+ array = 0.
+ array(:siz(1),:,:) = temp(:siz(1),:,:)
+ DEALLOCATE( temp )
+
+ end subroutine R3_ALLOCATE
+
+ subroutine R2_ALLOCATE( array )
+!-----------------------------------------------------------------------
+! ... Real realloc
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ real, pointer :: array(:,:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: astat
+ integer :: siz(2)
+ real, allocatable :: temp(:,:)
+
+ siz(1) = SIZE( array,1 )
+ siz(2) = SIZE( array,2 )
+ ALLOCATE( temp(siz(1),siz(2)),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'R2_ALLOCATE: Failed to allocate temp array'
+ write(*,*) ' Size = ',siz(1),' x ',siz(2)
+ stop
+ end if
+ temp = array
+ DEALLOCATE( array )
+ ALLOCATE( array(2*siz(1),siz(2)),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'R2_ALLOCATE: Failed to allocate new array'
+ write(*,*) ' Size = ',2*siz(1),' x ',siz(2)
+ stop
+ end if
+ array = 0.
+ array(:siz(1),:) = temp(:siz(1),:)
+ DEALLOCATE( temp )
+
+ end subroutine R2_ALLOCATE
+
+ subroutine R1_ALLOCATE( array )
+!-----------------------------------------------------------------------
+! ... Real realloc
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ real, pointer :: array(:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: astat
+ integer :: siz
+ real, allocatable :: temp(:)
+
+ siz = SIZE( array )
+ ALLOCATE( temp(siz),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'R1_ALLOCATE: Failed to allocate temp array'
+ write(*,*) ' Size = ',siz
+ stop
+ end if
+ temp = array
+ DEALLOCATE( array )
+ ALLOCATE( array(2*siz),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'R1_ALLOCATE: Failed to allocate new array'
+ write(*,*) ' Size = ',2*siz
+ stop
+ end if
+ array = 0.
+ array(:siz) = temp(:siz)
+ DEALLOCATE( temp )
+
+ end subroutine R1_ALLOCATE
+
+ subroutine I3_ALLOCATE( array )
+!-----------------------------------------------------------------------
+! ... Integer realloc
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, pointer :: array(:,:,:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: astat
+ integer :: siz(3)
+ integer, allocatable :: temp(:,:,:)
+
+ siz(1) = SIZE( array,1 )
+ siz(2) = SIZE( array,2 )
+ siz(3) = SIZE( array,3 )
+ ALLOCATE( temp(siz(1),siz(2),siz(3)),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'I3_ALLOCATE: Failed to allocate temp array'
+ write(*,*) ' Size = ',siz(1),' x ',siz(2),' x ',siz(3)
+ stop
+ end if
+ temp = array
+ DEALLOCATE( array )
+ ALLOCATE( array(2*siz(1),siz(2),siz(3)),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'I3_ALLOCATE: Failed to allocate new array'
+ write(*,*) ' Size = ',siz(1),' x ',siz(2),' x ',siz(3)
+ stop
+ end if
+ array = 0
+ array(:siz(1),:,:) = temp(:siz(1),:,:)
+ DEALLOCATE( temp )
+
+ end subroutine I3_ALLOCATE
+
+ subroutine I2_ALLOCATE( array )
+!-----------------------------------------------------------------------
+! ... Integer realloc
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, pointer :: array(:,:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: astat
+ integer :: siz(2)
+ integer, allocatable :: temp(:,:)
+
+ siz(1) = SIZE( array,1 )
+ siz(2) = SIZE( array,2 )
+ ALLOCATE( temp(siz(1),siz(2)),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'I2_ALLOCATE: Failed to allocate temp array'
+ write(*,*) ' Size = ',siz(1),' x ',siz(2)
+ stop
+ end if
+ temp = array
+ DEALLOCATE( array )
+ ALLOCATE( array(2*siz(1),siz(2)),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'I2_ALLOCATE: Failed to allocate new array'
+ write(*,*) ' Size = ',2*siz(1),' x ',siz(2)
+ stop
+ end if
+ array = 0
+ array(:siz(1),:) = temp(:siz(1),:)
+ DEALLOCATE( temp )
+
+ end subroutine I2_ALLOCATE
+
+ subroutine I1_ALLOCATE( array )
+!-----------------------------------------------------------------------
+! ... Integer realloc
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, pointer :: array(:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: astat
+ integer :: siz
+ integer, allocatable :: temp(:)
+
+ siz = SIZE( array )
+ ALLOCATE( temp(siz),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'I1_ALLOCATE: Failed to allocate temp array'
+ write(*,*) ' Size = ',siz
+ stop
+ end if
+ temp = array
+ DEALLOCATE( array )
+ ALLOCATE( array(2*siz),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'I1_ALLOCATE: Failed to allocate new array'
+ write(*,*) ' Size = ',2*siz
+ stop
+ end if
+ array = 0
+ array(:siz) = temp(:siz)
+ DEALLOCATE( temp )
+
+ end subroutine I1_ALLOCATE
+
+ subroutine C1_ALLOCATE( array, clen )
+!-----------------------------------------------------------------------
+! ... Character realloc
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: clen ! length of array elements
+ character(len=clen), pointer :: array(:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: astat
+ integer :: siz
+ character(len=clen), allocatable :: temp(:)
+
+ siz = SIZE( array )
+ ALLOCATE( temp(siz),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'C1_ALLOCATE: Failed to allocate temp array'
+ write(*,*) ' Size = ',siz
+ stop
+ end if
+ temp = array
+ DEALLOCATE( array )
+ ALLOCATE( array(2*siz),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'C1_ALLOCATE: Failed to allocate new array'
+ write(*,*) ' Size = ',2*siz
+ stop
+ end if
+ array = ' '
+ array(:siz) = temp(:siz)
+ DEALLOCATE( temp )
+
+ end subroutine C1_ALLOCATE
+
+ subroutine C2_ALLOCATE( array, clen )
+!-----------------------------------------------------------------------
+! ... Character realloc
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: clen ! length of array elements
+ character(len=clen), pointer :: array(:,:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: astat
+ integer :: siz(2)
+ character(len=clen), allocatable :: temp(:,:)
+
+ siz(1) = SIZE( array,1 )
+ siz(2) = SIZE( array,2 )
+ ALLOCATE( temp(siz(1),siz(2)),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'C2_ALLOCATE: Failed to allocate temp array'
+ write(*,*) ' Size = ',siz(1),' x ',siz(2)
+ stop
+ end if
+ temp = array
+ DEALLOCATE( array )
+ ALLOCATE( array(2*siz(1),siz(2)),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'C2_ALLOCATE: Failed to allocate new array'
+ write(*,*) ' Size = ',2*siz(1),' x ',siz(2)
+ stop
+ end if
+ array = ' '
+ array(:siz(1),:) = temp(:siz(1),:)
+ DEALLOCATE( temp )
+
+ end subroutine C2_ALLOCATE
+
+ end module REALLOC
diff --git a/chem_proc/src/cam_chempp/bndy_conds.f b/chem_proc/src/cam_chempp/bndy_conds.f
new file mode 100644
index 0000000000..a071a3e3cd
--- /dev/null
+++ b/chem_proc/src/cam_chempp/bndy_conds.f
@@ -0,0 +1,120 @@
+
+ module mo_bndy_conds
+
+ private
+ public :: bndy_conds
+
+ contains
+
+ subroutine bndy_conds( lin, lout, new_nq, new_solsym, bc_is_fixed, bc_cnt )
+
+ use var_mod, only : var_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: lin, & ! input unit number
+ lout, & ! output unit number
+ new_nq ! species count
+ integer, intent(inout) :: bc_cnt(:) ! count of species with fixed bc
+ logical, intent(inout) :: bc_is_fixed(:,:) ! fixed bndy condition matrix
+ character(len=16), intent(in) :: new_solsym(:) ! species names
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: nchar
+ integer :: toklen(20)
+ integer :: j, k
+ integer :: no_tokens
+ integer :: parsw(2) = 0
+ integer :: bndy
+
+ character(len=320) :: buff
+ character(len=320) :: buffh
+ character(len=16) :: tokens(20)
+
+ logical :: found
+
+ integer, parameter :: symlen = 8
+
+!-----------------------------------------------------------------------
+! ... Read the species boundary conditions
+!-----------------------------------------------------------------------
+section_loop : &
+ do
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ if( buffh == 'ENDBNDYCONDS' ) then
+ exit
+ end if
+ if( buffh == 'FIXEDLOWERBC' ) then
+ bndy = 1
+ if( parsw(bndy) /= 0 ) then
+ call errmes( ' BNDY_COND: Fixed Lower BC already specified@', lout, buff, 1, buff )
+ end if
+ else if( buffh == 'FIXEDUPPERBC' ) then
+ bndy = 2
+ if( parsw(bndy) /= 0 ) then
+ call errmes( ' BNDY_COND: Fixed Upper BC already specified@', lout, buff, 1, buff )
+ end if
+ else
+ call errmes( ' BNDY_COND: # is an invalid keyword @', lout, buff, 1, buff )
+ end if
+ parsw(bndy) = 1
+
+bndy_loop : &
+ do
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ if( buffh == 'ENDFIXEDLOWERBC' ) then
+ if( bndy /= 1 ) then
+ call errmes( ' BNDY_COND: In Fixed Upper BC @', lout, buff, 1, buff )
+ else if( parsw(bndy) /= 1 ) then
+ call errmes( ' BNDY_COND: Fixed Lower BC not entered@', lout, buff, 1, buff )
+ end if
+ exit
+ else if( buffh == 'ENDFIXEDUPPERBC' ) then
+ if( bndy /= 2 ) then
+ call errmes( ' BNDY_COND: In Fixed Lower BC @', lout, buff, 1, buff )
+ else if( parsw(bndy) /= 1 ) then
+ call errmes( ' BNDY_COND: Fixed Upper BC not entered@', lout, buff, 1, buff )
+ end if
+ exit
+ end if
+ call gettokens( buff, nchar, ',', symlen, &
+ tokens, toklen, 20, no_tokens )
+ if( no_tokens == 0 ) then
+ call errmes( ' BNDY_COND: Species input line in error@', lout, buff, 1, buff )
+ end if
+token_loop : &
+ do j = 1,no_tokens
+ bc_cnt(bndy) = bc_cnt(bndy) + 1
+ if( bc_cnt(bndy) > var_lim ) then
+ call errmes( ' BNDY_COND: Species count exceeds limit@', lout, buff, 1, buff )
+ end if
+ found = .false.
+ do k = 1,new_nq
+ if( tokens(j) == new_solsym(k) ) then
+ if( bc_is_fixed(k,bndy) ) then
+ call errmes( '# is already specified @', lout, tokens(j), toklen(j), buff )
+ end if
+ bc_is_fixed(k,bndy) = .true.
+ found = .true.
+ exit
+ end if
+ end do
+ if( .not. found ) then
+ call errmes( '# is not in solution species list@', lout, tokens(j), toklen(j), buff )
+ end if
+ end do token_loop
+ end do bndy_loop
+ end do section_loop
+
+ end subroutine bndy_conds
+
+ end module mo_bndy_conds
diff --git a/chem_proc/src/cam_chempp/chem.f b/chem_proc/src/cam_chempp/chem.f
new file mode 100644
index 0000000000..b313f56ac9
--- /dev/null
+++ b/chem_proc/src/cam_chempp/chem.f
@@ -0,0 +1,1341 @@
+
+ module mo_chem
+
+ implicit none
+
+ private
+ public :: chem
+
+ character(len=256) :: buff
+ character(len=256) :: buffh
+
+ integer, private,parameter :: dp = selected_real_kind( 12 )
+
+ contains
+
+ subroutine chem
+!-----------------------------------------------------------------------
+! ... Scan chemical reactions and produce base chemistry maps
+!-----------------------------------------------------------------------
+
+ use io, only : lin, lout
+ use var_mod, only : solsym, fixsym, pcesym, &
+ nq, nfs, spcsym, spccnt, var_lim
+ use rxt_mod, only : rxno => rxntot, irc => rxmcnt, &
+ prdcnt, ipcep, ipcel, fixcnt, prdmap, &
+ fixmap, pcep, pcel, rxmap, hetcnt, &
+ hetmap, usrcnt, usrmap, rates => rxparm, &
+ troe_rxparm, troetab, troecnt, troe_sym_rates, &
+ rattab => rxptab, rateno => rxpcnt, &
+ pcoeff_cnt, pcoeff_ind, pcoeff, sym_rates, &
+ phtsym, phtcnt, pht_alias, pht_alias_mult, rxt_lim, rxt_tag, &
+ prd_lim, rxtnt_lim
+ use rxt_mod, only : has_cph => cph_flg, enthalpy
+ use rxt_mod, only : frc_from_dataset
+ use rxt_mod, only : num_rnts
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Local variables
+! nsr = number of solution reactants
+! nsp = number of solution products
+! nf = number of fixed reactants
+! npr = number of pce reactants
+! npp = number of pce products
+!-----------------------------------------------------------------------
+ integer, parameter :: photolysis = 1, gas_phase = 2
+ integer, parameter :: heterogeneous = 3, extraneous = 4
+
+ character(len=16) :: param
+ character(len=32) :: rxparms(prd_lim)
+ character(len=16) :: sym_rate(5)
+ character(len=16) :: keywords(4) = (/ 'PHOTOLYSIS ', &
+ 'REACTIONS ', &
+ 'HETEROGENEOUS ', &
+ 'EXTFORCING ' /)
+
+!-----------------------------------------------------------------------
+! ... local variables
+!-----------------------------------------------------------------------
+ integer :: nchar, k, nr, np, nsr, nsp, nf, &
+ npr, npp, ic, kc, i, npl, l, j, m, ipp, im, &
+ photo, rxtn, npce = 0, ipl
+ integer :: il, iu, istat
+ integer :: beg_alias
+ integer :: rxttab(5,prd_lim)
+ integer :: parsw(4), &
+ count1(var_lim), &
+ count2(var_lim)
+ integer, allocatable :: toklen(:)
+ integer :: tokcnt
+
+ character(len=128) :: line
+ character(len=32) :: loc_rxt_tag
+ character(len=32) :: loc_pht_alias(2)
+ character(len=16) :: wrk_char
+ character(len=16) :: rxtsym(rxtnt_lim)
+ character(len=16) :: prdsym(prd_lim)
+ character(len=1) :: char
+ character(len=24), allocatable :: ext_tokens(:)
+ character(len=16), allocatable :: tokens(:)
+
+ real :: number
+ real :: rate(5), pcoeffs(prd_lim)
+
+ logical :: cph_flg
+ real(dp) :: cph_val
+ logical :: coeff_flg
+ logical :: found
+
+ photo = 0
+ usrcnt = 0
+ rxtn = 1
+ rxno = 0
+ ipl = 0
+ rateno = 0
+ parsw = 0
+
+keyword_loop : &
+ do
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ if( buffh == 'ENDCHEMISTRY' ) then
+ exit
+ end if
+ found = .false.
+ do i = 1,4
+ if( buffh == keywords(i) ) then
+ if( parsw(i) /= 0 ) then
+ call errmes ( ' # Keyword already used@', &
+ lout, &
+ keywords(i), &
+ len_trim(keywords(i)), &
+ buff )
+ else if( i == 1 .and. parsw(2) /= 0 ) then
+ call errmes ( 'Must specify Photolysis before Reactions@', &
+ lout, char, 1, buff )
+ end if
+ parsw(i) = 1
+ found = .true.
+ exit
+ end if
+ end do
+ if( .not. found ) then
+ call errmes( 'CHEM: # is not a keyword@', &
+ lout, &
+ buff, &
+ len_trim(buff), &
+ buff )
+ end if
+ select case( i )
+ case( photolysis )
+!=======================================================================
+! ... The photolysis chemistry processing
+!=======================================================================
+ write(lout,*) ' '
+ write(lout,240)
+photolysis_loop : &
+ do
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ if( buffh == 'ENDPHOTOLYSIS' ) then
+ phtcnt = rxno
+!-----------------------------------------------------------------------
+! ... Check that all photorates have a reaction tag
+!-----------------------------------------------------------------------
+ if( phtcnt > 0 ) then
+ k = count( rxt_tag(:phtcnt) /= ' ' )
+ if( k /= phtcnt ) then
+ call errmes( 'All photoreactions must have a reaction tag@', lout, char, 1, buff )
+ end if
+ do ic = 1,phtcnt
+ if( any( pht_alias(ic,:) /= ' ' ) ) then
+ line = ' '
+ m = len_trim(rxt_tag(ic))
+ line = rxt_tag(ic)(:m) // ' -> '
+ do k = 1,2
+ if( pht_alias(ic,k) /= ' ' ) then
+ if( k == 2 .and. pht_alias(ic,1) /= ' ' ) then
+ line(len_trim(line)+1:) = ','
+ end if
+ m = len_trim(pht_alias_mult(ic,k))
+ line(len_trim(line)+2:) = pht_alias_mult(ic,k)(:m) // ' * '
+ m = len_trim(pht_alias(ic,k))
+ line(len_trim(line)+2:) = pht_alias(ic,k)(:m)
+ end if
+ end do
+ end if
+ end do
+ end if
+ cycle keyword_loop
+ end if
+ rxtsym(1:3) = ' '
+ prdsym(1:4) = ' '
+ sym_rate(:) = ' '
+!-----------------------------------------------------------------------
+! ... Reaction parsing routine
+!-----------------------------------------------------------------------
+ call rxtprs( nchar, nr, np, rxtsym, prdsym, &
+ rate, pcoeffs, coeff_flg, rxparms, sym_rate, &
+ loc_rxt_tag, cph_flg, cph_val, .true. )
+!-----------------------------------------------------------------------
+! ... Check for reaction string errors from parsing routine
+!-----------------------------------------------------------------------
+ if( nr < 0 ) then
+ call errmes ( 'gross syntax errors in reaction string@', lout, char, 1, buff )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Reaction mapping routine
+!-----------------------------------------------------------------------
+ call mapper( nq, nfs, npce, nr, np, &
+ rxtsym, prdsym, solsym, fixsym, pcesym, &
+ nsr, nsp, nf, npr, npp, &
+ rxttab, photo, coeff_flg,pcoeffs )
+
+!-----------------------------------------------------------------------
+! ... Check for logic errors in reaction
+!-----------------------------------------------------------------------
+ if( (nf + nsr + npr) == 0 ) then
+ call errmes ( 'photo-reaction has no reactants@', lout, char, 1, buff )
+ else if( (nf+nsr+npr) >= 2 ) then
+ call errmes ( 'photo-reaction has two or more reactants@', lout, char, 1, buff )
+ end if
+ if( nf == 1 ) then
+ if( nsp == 0 .and. npp == 0 ) then
+ call errmes( 'fixed species photolysis produces nothing@', lout, char, 1, buff )
+ end if
+ rxno = rxno + 1
+!-----------------------------------------------------------------------
+! ... Photolysis of an invariant species; check for products
+!-----------------------------------------------------------------------
+ if( nsp /= 0 ) then
+!-----------------------------------------------------------------------
+! ... Solution species production from fixed species photolysis
+!-----------------------------------------------------------------------
+ prdcnt = prdcnt + 1
+ prdmap(prdcnt,1) = rxno
+ prdmap(prdcnt,2:nsp+1) = rxttab(3,1:nsp)
+ end if
+ if( npp /= 0 ) then
+!-----------------------------------------------------------------------
+! ... Pce species production from fixed species photolysis
+!-----------------------------------------------------------------------
+ ipl = ipl + 1
+ do k = 1,npp
+ ipcep(1) = ipcep(1) + 1
+ ic = ipcep(1)
+ pcep(ic,1,1) = rxttab(5,k)
+ pcep(ic,2,1) = rxno
+ pcep(ic,3,1) = ipl
+ end do
+ end if
+!-----------------------------------------------------------------------
+! ... Set the fixed reactants map
+!-----------------------------------------------------------------------
+ fixcnt(1) = fixcnt(1) + 1
+ ic = fixcnt(1)
+ fixmap(ic,1,1) = -rxno
+ fixmap(ic,2,1) = rxttab(1,1)
+ kc = rxttab(1,1)
+ phtsym(rxno) = fixsym(kc)
+ else if( npr == 1 ) then
+!-----------------------------------------------------------------------
+! ... Pce species photolysis; put into pce loss map
+!-----------------------------------------------------------------------
+ if( npp /= 0 ) then
+!-----------------------------------------------------------------------
+! ... Check to see that a pce is not a product species
+!-----------------------------------------------------------------------
+ call errmes( 'pce reactants and products in same reaction@', lout, char, 1, buff )
+ end if
+ rxno = rxno + 1
+ ipcel(1) = ipcel(1) + 1
+ ic = ipcel(1)
+ pcel(ic,1,1) = rxttab(4,1)
+ pcel(ic,2,1) = rxno
+ kc = rxttab(4,1)
+ phtsym(rxno) = pcesym(kc)
+ if( nsp /= 0 ) then
+ pcel(ic,3:nsp+2,1) = rxttab(3,1:nsp)
+ end if
+!-----------------------------------------------------------------------
+! ... Solution species photolysis
+!-----------------------------------------------------------------------
+ else
+ rxno = rxno + 1
+ irc(1) = irc(1) + 1
+ ic = irc(1)
+ rxmap(ic,2,1) = rxttab(2,1)
+ rxmap(ic,1,1) = rxno
+ kc = rxttab(2,1)
+ phtsym(rxno) = solsym(kc)
+ if( nsp /= 0 ) then
+!---------------------------------------------------------------------
+! ... Solution species production from solution photolysis
+!---------------------------------------------------------------------
+ rxmap(ic,3:2+nsp,1) = rxttab(3,1:nsp)
+ end if
+ if( npp /= 0 ) then
+!----------------------------------------------------------------------
+! ... Pce species production from solution photolysis
+!----------------------------------------------------------------------
+ ipl = ipl + 1
+ do k = 1,npp
+ ipcep(2) = ipcep(2)+1
+ ic = ipcep(2)
+ pcep(ic,1,2) = rxttab(5,k)
+ pcep(ic,2,2) = rxno
+ pcep(ic,3,2) = rxttab(2,1)
+ pcep(ic,4,2) = ipl
+ end do
+ end if
+ end if
+ if( rxno > rxt_lim ) then
+ call errmes( ' Reaction count exceeds limit@', lout, buff, 1, buff )
+ end if
+!-----------------------------------------------------------------------
+! ... Check for non-unity product coefficients
+!-----------------------------------------------------------------------
+ if( coeff_flg ) then
+ pcoeff_cnt = pcoeff_cnt + 1
+ pcoeff_ind(rxno) = pcoeff_cnt
+ pcoeff(1:nsp,pcoeff_cnt) = pcoeffs(1:nsp)
+ end if
+!-----------------------------------------------------------------------
+! ... Check for photorate alias
+!-----------------------------------------------------------------------
+ m = index( loc_rxt_tag, '=' )
+ if( m /= 0 ) then
+ beg_alias = m + 1
+ else
+ m = index( loc_rxt_tag, '->' )
+ if( m > 0 ) then
+ beg_alias = m + 2
+ end if
+ end if
+ if( m > 0 ) then
+ loc_pht_alias(1) = loc_rxt_tag(beg_alias:)
+ loc_rxt_tag(m:) = ' '
+ m = index( loc_pht_alias(1), ',' )
+ il = 1
+ iu = 2
+ if( m == 0 ) then
+ iu = 1
+ else if( m == 1 ) then
+ il = 2
+ loc_pht_alias(2) = loc_pht_alias(1)(2:)
+ else
+ loc_pht_alias(2) = loc_pht_alias(1)(m+1:)
+ loc_pht_alias(1) = loc_pht_alias(1)(:m-1)
+ end if
+ do ic = il,iu
+ k = index( loc_pht_alias(ic), '*' )
+ if( k == 0 ) then
+ pht_alias(rxno,ic) = loc_pht_alias(ic)
+ else
+ pht_alias_mult(rxno,ic) = loc_pht_alias(ic)(:k-1)
+ read(pht_alias_mult(rxno,ic),*,iostat=istat) number
+ if( istat /= 0 ) then
+ call errmes ( ' # is not a valid number@', &
+ lout, &
+ pht_alias_mult(rxno,ic), &
+ len_trim(pht_alias_mult(rxno,ic)), &
+ buff )
+ end if
+ pht_alias(rxno,ic) = loc_pht_alias(ic)(k+1:)
+ end if
+ end do
+ end if
+!-----------------------------------------------------------------------
+! ... Check for duplicate reaction tag
+!-----------------------------------------------------------------------
+ do m = 1,rxno-1
+ if( trim( loc_rxt_tag ) /= ' ' ) then
+ if( trim( rxt_tag(m) ) == trim( loc_rxt_tag ) ) then
+ call errmes ( ' # rxtnt alias already in use@', &
+ lout, &
+ loc_rxt_tag, &
+ len_trim(loc_rxt_tag), &
+ buff )
+ end if
+ end if
+ end do
+ rxt_tag(rxno) = loc_rxt_tag
+ has_cph(rxno) = cph_flg
+!-----------------------------------------------------------------------
+! ... Print the reaction on unit lout
+!-----------------------------------------------------------------------
+ call outp( rxparms, nr, np, rxtsym, prdsym, sym_rate, rxno, rate, loc_rxt_tag, lout )
+ end do photolysis_loop
+
+ case( gas_phase )
+!=======================================================================
+! ... The chemical reactions
+!=======================================================================
+ write(lout,*) ' '
+ write(lout,260)
+gas_phase_rxt_loop : &
+ do
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ if( buffh == 'ENDREACTIONS' ) then
+ cycle keyword_loop
+ end if
+
+ rxtsym(1:3) = ' '
+ prdsym(1:4) = ' '
+ sym_rate = ' '
+ call rxtprs( nchar, nr, np, rxtsym, prdsym, &
+ rate, pcoeffs, coeff_flg, rxparms, sym_rate, &
+ loc_rxt_tag, cph_flg, cph_val, .false. )
+
+ if( nr < 0 ) then
+ call errmes ( 'there are no reactants@', lout, char, 1, buff )
+ end if
+ num_rnts(rxno+1) = nr
+
+ call mapper( nq, nfs, npce, nr, np, &
+ rxtsym, prdsym, solsym, fixsym, pcesym, &
+ nsr, nsp, nf, npr, npp, &
+ rxttab, rxtn, coeff_flg,pcoeffs )
+
+ if( nsr == 3 ) then
+ call errmes ( ' three solution species reactants@', lout, char, 1, buff )
+ end if
+ if( npr >= 2 ) then
+ call errmes ( ' there are two or more pce reactants@', lout, char, 1, buff )
+ end if
+ if( nsr == 2 .and. npr /= 0 ) then
+ call errmes ( ' there are two solution and one pce reactants@', lout, char, 1, buff )
+ end if
+ if( (nf+nsr+npr) /= nr ) then
+ call errmes ( ' reaction parsing algorithm error@', lout, char, 1, buff )
+ end if
+ rxno = rxno + 1
+ if( rxno > rxt_lim ) then
+ call errmes( ' Reaction count exceeds limit@', lout, buff, 1, buff )
+ end if
+!-----------------------------------------------------------------------
+! ... User specified reaction rate ?
+!-----------------------------------------------------------------------
+ if( sym_rate(1) /= ' ' ) then
+ if( sym_rate(3) == ' ' ) then
+ rateno = rateno + 1
+ rattab(rateno) = rxno
+ rates(:2,rateno) = rate(:2)
+ sym_rates(:2,rateno) = sym_rate(:2)
+ else if( sym_rate(5) /= ' ' ) then
+ troecnt = troecnt + 1
+ troetab(troecnt) = rxno
+ troe_rxparm(:,troecnt) = rate(:)
+ troe_sym_rates(:,troecnt) = sym_rate(:)
+ end if
+ end if
+!-----------------------------------------------------------------------
+! ... Check for duplicate reaction tag
+!-----------------------------------------------------------------------
+ do m = 1, rxno-1
+ if( trim( loc_rxt_tag ) /= ' ' ) then
+ if( trim( rxt_tag(m) ) == trim( loc_rxt_tag ) ) then
+ call errmes ( ' # rxtnt alias already in use@', &
+ lout, &
+ loc_rxt_tag, &
+ len_trim(loc_rxt_tag), &
+ buff )
+ end if
+ end if
+ end do
+ rxt_tag(rxno) = loc_rxt_tag
+ has_cph(rxno) = cph_flg
+ if (cph_flg) enthalpy(rxno) = cph_val
+ call outp( rxparms, nr, np, rxtsym, prdsym, sym_rate, rxno-phtcnt, rate, loc_rxt_tag, lout )
+
+ if( nf /= 0 ) then
+ fixcnt(nf) = fixcnt(nf) + 1
+ ic = fixcnt(nf)
+ fixmap(ic,1,nf) = rxno
+ fixmap(ic,2:1+nf,nf) = rxttab(1,1:nf)
+ if( nf == nr ) then
+!-----------------------------------------------------------------------
+! ... Fixed reactants only
+!-----------------------------------------------------------------------
+ prdcnt = prdcnt+1
+ fixmap(ic,1,nf) = -rxno
+ prdmap(prdcnt,1) = rxno
+ if( nsp /= 0 ) then
+ prdmap(prdcnt,2:1+nsp) = rxttab(3,1:nsp)
+ end if
+ if( npp /= 0 ) then
+ ipl = ipl + 1
+ do k = 1,npp
+ ipcep(1) = ipcep(1) + 1
+ ic = ipcep(1)
+ pcep(ic,1,1) = rxttab(5,k)
+ pcep(ic,2,1) = rxno
+ pcep(ic,3,1) = ipl
+ end do
+ end if
+ cycle
+ end if
+ end if
+
+ if( nsr == nr .or. npr == 0 ) then
+!-----------------------------------------------------------------------
+! ... Solution reactants only
+!-----------------------------------------------------------------------
+ irc(nsr) = irc(nsr) + 1
+ ic = irc(nsr)
+ rxmap(ic,1,nsr) = rxno
+ rxmap(ic,2:1+nsr,nsr) = rxttab(2,1:nsr)
+ if( nsp /= 0 ) then
+ rxmap(ic,nsr+2:nsr+nsp+1,nsr) = rxttab(3,1:nsp)
+ end if
+ if( npp /= 0 ) then
+ ipl = ipl + 1
+ npl = nsr + 1
+ do k = 1,npp
+ ipcep(npl) = ipcep(npl) + 1
+ ic = ipcep(npl)
+ pcep(ic,1,npl) = rxttab(5,k)
+ pcep(ic,2,npl) = rxno
+ pcep(ic,nsr+3,npl) = ipl
+ pcep(ic,3:2+nsr,npl) = rxttab(2,1:nsr)
+ end do
+ end if
+ else
+!-----------------------------------------------------------------------
+! Solution,fixed, and pce reactants possible.
+! There is a pce reactant, and either a solution/fixed
+! reactant or both. If there is a pce product then
+! terminate with a reaction logic error.
+!-----------------------------------------------------------------------
+ if( npp /= 0 ) then
+ call errmes( ' Reaction has both reactant and product pce species@', lout, char, 1, buff )
+ end if
+ npl = nsr + 1
+ ipcel(npl) = ipcel(npl)+1
+ ic = ipcel(npl)
+ pcel(ic,1,npl) = rxttab(4,1)
+ pcel(ic,2,npl) = rxno
+ if( npl == 2 ) then
+ pcel(ic,3,2) = rxttab(2,1)
+ end if
+ if( nsp == 0 ) then
+ cycle
+ end if
+ pcel(ic,npl+2:npl+nsp+1,npl) = rxttab(3,1:nsp)
+ end if
+!-----------------------------------------------------------------------
+! ... Check for non-unity product coefficients
+!-----------------------------------------------------------------------
+ if( coeff_flg ) then
+ pcoeff_cnt = pcoeff_cnt + 1
+ pcoeff_ind(rxno) = pcoeff_cnt
+ pcoeff(1:nsp,pcoeff_cnt) = pcoeffs(1:nsp)
+ end if
+ end do gas_phase_rxt_loop
+
+ case( heterogeneous )
+!=======================================================================
+! The heterogeneous loss chemistry list
+!=======================================================================
+ write(lout,*) ' '
+ write(lout,7175)
+ allocate( toklen(64) )
+ allocate( tokens(64) )
+hetero_loop : do
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ if( buffh == 'ENDHETEROGENEOUS' ) then
+ deallocate( toklen )
+ deallocate( tokens )
+ cycle keyword_loop
+ end if
+
+ call gettokens( buff, nchar, ',', 8, tokens, toklen, 64, tokcnt )
+ if( tokcnt <= 0 ) then
+ deallocate( toklen )
+ deallocate( tokens )
+ call errmes ( ' Error in het list@', lout, param, k, buff )
+ end if
+ end do hetero_loop
+
+ case( extraneous )
+!=======================================================================
+! ... The extraneous prod/loss chemistry list
+!=======================================================================
+ write(lout,*) ' '
+ write(lout,8175)
+ allocate( toklen(64) )
+ allocate( ext_tokens(64) )
+extfrc_loop : do
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ if( buffh == 'ENDEXTFORCING' ) then
+ deallocate( toklen )
+ deallocate( ext_tokens )
+ cycle keyword_loop
+ end if
+
+ call gettokens( buff, nchar, ',', 24, ext_tokens, toklen, 64, tokcnt )
+ if( tokcnt <= 0 ) then
+ deallocate( toklen )
+ deallocate( ext_tokens )
+ call errmes ( ' Error in ext prod list@', lout, param, k, buff )
+ end if
+ext_tok_loop : do j = 1,tokcnt
+ do m = 1,spccnt(1)
+ k = index( ext_tokens(j), '<' ) - 1
+ if( k < 1 ) then
+ found = .false.
+ k = len_trim( ext_tokens(j) )
+ else
+ found = .true.
+ end if
+ if( ext_tokens(j)(:k) == spcsym(m,1) ) then
+ if( usrcnt > 1 ) then
+ if( any(usrmap(:usrcnt) == m ) ) then
+ call errmes( ' # is already in ext frc list@', lout, ext_tokens(j), toklen(j), buff )
+ end if
+ end if
+ usrcnt = usrcnt + 1
+ if( usrcnt > rxt_lim ) then
+ call errmes( ' Extran reaction count exceeds limit@', lout, buff, 1, buff )
+ end if
+ usrmap(usrcnt) = m
+ !write(lout,'(1x,''('',i2,'')'',3x,a)') usrcnt, trim(spcsym(m,1))
+
+ if( .not. found ) then
+ write(lout,'(1x,''('',i2,'')'',3x,a)') usrcnt, trim(spcsym(m,1))
+ else
+ frc_from_dataset(usrcnt) = .true.
+ write(lout,'(1x,''('',i2,'')'',3x,a,3x,''(dataset)'')') usrcnt, trim(spcsym(m,1))
+ end if
+
+
+ cycle ext_tok_loop
+ end if
+ end do
+ call errmes ( ' # is not in Solution list@', lout, ext_tokens(j), toklen(j), buff )
+ end do ext_tok_loop
+ end do extfrc_loop
+ end select
+ end do keyword_loop
+ hetcnt = spccnt(1)
+ do j=1,hetcnt
+ hetmap(j,1) = j
+ enddo
+!-----------------------------------------------------------------------
+! ... Check for pce,sol reaction validity
+!-----------------------------------------------------------------------
+ il = ipcel(2)
+ ipp = ipcep(3)
+ if( il == 0 .or. ipp == 0 ) then
+ return
+ end if
+ do i = 1,il
+ im = pcel(i,1,2)
+ count1(im) = 1
+ end do
+ do i = 1,ipp
+ im = pcep(i,1,3)
+ count2(im) = 1
+ end do
+ do i = 1,npce
+ if( count1(i) == 1 .and. count2(i) == 1 ) then
+ call errmes ( 'pce species # violates use rules@', lout, pcesym(i), 8, buff )
+ end if
+ count1(i) = 0
+ end do
+
+240 format(5x,'Photolysis')
+260 format(5x,'Reactions')
+7175 format('Heterogeneous loss species')
+7177 format(1x,'(',i2,')',3x,a8)
+8175 format('Extraneous prod/loss species')
+!-----------------------------------------------------------------------
+! ... End of the chemistry processing code
+!-----------------------------------------------------------------------
+
+ end subroutine chem
+
+ subroutine rxtprs( nchar, &
+ rxtcnt, &
+ prdcnt, &
+ rxtsym, &
+ prdsym, &
+ rate, &
+ pcoeffs, &
+ coeff_flg, &
+ prdprms, &
+ sym_rate, &
+ loc_rxt_tag, &
+ cph_flg, cph_val, &
+ is_photorate )
+
+ use io, only : lin, lout
+ use rxt_mod, only : rxtnt_lim, prd_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Rxtprs parses the reaction and places the symbols
+! in the reactant and product character arrays rxtsym &
+! prdsym. The reactants and products are checked for
+! symbol length violations. The number of reactants
+! and products are limited to three each. Reaction rate
+! information is checked for numeric validity. There
+! must be at least one reactant. No other error checking
+! is performed in this subroutine.
+!-----------------------------------------------------------------------
+
+ integer, parameter :: symlen = 16
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: nchar
+ integer, intent(out) :: rxtcnt, prdcnt
+ real, intent(out) :: rate(*), pcoeffs(prd_lim)
+ character(len=*), intent(out) :: loc_rxt_tag
+ character(len=*), intent(out) :: rxtsym(rxtnt_lim), prdsym(prd_lim)
+ character(len=*), intent(out) :: prdprms(prd_lim)
+ character(len=*), intent(out) :: sym_rate(*)
+ logical, intent(in) :: is_photorate
+ logical, intent(out) :: coeff_flg
+ logical, intent(out) :: cph_flg
+ real(dp), intent(out) :: cph_val
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: retcod
+ integer :: ncharl, tprdcnt
+ integer :: comma
+ integer :: cphndx, eqlndx
+ integer :: k, j, length, ratcnt, start, position
+ integer, allocatable :: slen(:)
+ character(len=320) :: buffl, buffhl
+ character(len=16), allocatable :: rxparms(:)
+ character(len=320) :: cph_val_str
+
+ cph_val = -999.
+ rxtcnt = 0
+ prdcnt = 0
+ coeff_flg = .false.
+ cph_flg = .false.
+
+ rate(:5) = 0.
+ pcoeffs(:) = 1.
+ ncharl = nchar
+ allocate( slen(MAX(5,prd_lim)) )
+ allocate( rxparms(MAX(5,prd_lim)) )
+!-----------------------------------------------------------------------
+! ... Check for reaction name alias, cph
+!-----------------------------------------------------------------------
+ k = index( buff(:ncharl), ']' ) - 1
+ if( k > 0 ) then
+ j = index( buff(:ncharl), '[' ) + 1
+ loc_rxt_tag = buff(j:k)
+ comma = index( buff(j:k), ',' )
+ if( comma /= 0 ) then
+ cphndx = index( buff(j+comma:k),'cph' )
+ if (cphndx>0) then
+ eqlndx = index( buff(j+comma+cphndx:k),'=' )
+ if (eqlndx>0) then
+ cph_val_str = buff(j+comma+cphndx+eqlndx:k)
+ read(cph_val_str,fmt=*) cph_val
+ else
+ cph_val = 0
+ endif
+ cph_flg = .true.
+ loc_rxt_tag = buff(j:j+comma-2)
+ end if
+ end if
+ buff = buff(k+2:ncharl)
+ ncharl = nchar - (k+1)
+ else
+ loc_rxt_tag = ' '
+ end if
+
+ length = index( buff(:ncharl), '=' )
+ if( length == 0 ) then
+ length = index( buff(:ncharl), '->' )
+ end if
+
+ if( length <= 1 ) then
+ if( length == 0 ) then
+ write(6,102)
+ else if( length == 1 ) then
+ write(6,100)
+ end if
+ rxtcnt = -1
+ return
+ end if
+
+!-----------------------------------------------------------------------
+! ... Parse out the reactants
+!-----------------------------------------------------------------------
+ call gettokens( buff, &
+ length-1, &
+ '+', &
+ symlen, &
+ rxtsym, &
+ slen, &
+ rxtnt_lim, &
+ rxtcnt )
+ if( rxtcnt < 0 ) then
+ call errmes( 'Too many reactants in reaction@', lout, buff, 1, buff )
+ else if ( rxtcnt == 0 ) then
+ call errmes( 'Reactant symbol exceeds symbol length@', lout, buff, 1, buff )
+ end if
+
+ if( index( buff(:ncharl),'->' ) /= 0 ) then
+ length = length + 1
+ end if
+ if( length == ncharl ) then ! reaction has reactants only
+ return
+ end if
+ start = length + 1 ! char after "=" sign
+ position = index( buff(start:ncharl), ';' )
+ if( position == 0 ) then ! products, no rates
+ length = ncharl - start + 1
+ else if( position /= 1 ) then
+ length = position - 1
+ end if
+
+!-----------------------------------------------------------------------
+! ... Parse out the products and multipliers
+!-----------------------------------------------------------------------
+ if( position /= 1 ) then
+ call gettokens( buff(start:), &
+ length, &
+ '+', &
+ len(prdprms(1)), &
+ prdprms, &
+ slen, &
+ prd_lim, &
+ prdcnt )
+
+ if( prdcnt < 0 ) then
+ call errmes( 'Too many products in reaction@', lout, buff, 1, buff )
+ else if ( prdcnt == 0 ) then
+ call errmes( 'Product symbol exceeds symbol length@', lout, buff, 1, buff )
+ end if
+!-----------------------------------------------------------------------
+! ... Check each "product" token for an explicit multiplier
+!-----------------------------------------------------------------------
+ do k = 1,prdcnt
+ j = index( prdprms(k)(:slen(k)), '*' )
+ if( j == 0 ) then
+ prdsym(k) = prdprms(k)(:symlen)
+ cycle
+ else if( j == 1 .or. j == slen(k) ) then
+ call errmes( ' Product & multiplier syntax error@', lout, prdprms(k), 1, prdprms(k) )
+ end if
+ read(prdprms(k)(:j-1),*,iostat=retcod) pcoeffs(k)
+ if( retcod /= 0 ) then
+ call errmes( 'number format error in product multiplier #@', lout, &
+ prdprms(k), slen(k), buff )
+ end if
+ prdsym(k) = prdprms(k)(j+1:)
+ if( pcoeffs(k) /= 1. ) then
+ coeff_flg = .true.
+ end if
+ end do
+ end if
+
+!-----------------------------------------------------------------------
+! ... Set any reaction rate parms
+!-----------------------------------------------------------------------
+ if( position /= 0 ) then
+ start = start + position
+ call gettokens( buff(start:), &
+ ncharl-start+1, &
+ ',', &
+ len(rxparms(1)), &
+ rxparms, &
+ slen, &
+ 5, &
+ ratcnt )
+
+ if( ratcnt <= 0 ) then
+ call errmes( ' Syntax error in reaction rate parameters@', lout, buff, 1, buff )
+ end if
+ do k = 1,ratcnt
+ if( rxparms(k) /= ' ' ) then
+ read(rxparms(k)(:slen(k)),*,iostat=retcod) rate(k)
+ if( retcod /= 0 ) then
+ call errmes( 'number format error in reaction rate #@', lout, rxparms(k), slen(k), buff )
+ end if
+ sym_rate(k) = rxparms(k)(:slen(k))
+ else
+ rate(k) = 0.
+ sym_rate(k) = ' '
+ end if
+ end do
+ end if
+
+!-----------------------------------------------------------------------
+! ... New code for extended product lines
+!-----------------------------------------------------------------------
+ do
+ call cardin( lin, buffl, ncharl )
+
+ buffhl = buffl
+ call upcase( buffhl )
+ if( .not. is_photorate .and. buffhl == 'ENDREACTIONS' ) then
+ backspace( lin )
+ exit
+ else if( is_photorate .and. buffhl == 'ENDPHOTOLYSIS' ) then
+ backspace( lin )
+ exit
+ else
+ length = index( buffl(:ncharl), '=' )
+ if( length == 0 ) then
+ length = index( buffl(:ncharl), '->' )
+ end if
+ if( length /= 0 ) then
+ backspace( lin )
+ exit
+ end if
+ end if
+ if( buffl(1:1) /= '+' ) then
+ call errmes ( 'Extended Reactions must start with + delimiter@', lout, buffl, 1, buffl )
+ end if
+ if( prdcnt >= prd_lim ) then
+ call errmes( 'Too many products in reaction@', lout, buffl, 1, buffl )
+ end if
+!-----------------------------------------------------------------------
+! ... Parse out the products and multipliers
+!-----------------------------------------------------------------------
+ call gettokens( buffl(2:), &
+ ncharl-1, &
+ '+', &
+ len(prdprms(prdcnt+1)), &
+ prdprms(prdcnt+1), &
+ slen(prdcnt+1), &
+ prd_lim-prdcnt, &
+ tprdcnt )
+ if( tprdcnt < 0 ) then
+ call errmes( 'Too many products in reaction@', lout, buffl, 1, buffl )
+ else if ( tprdcnt == 0 ) then
+ call errmes( 'Product symbol exceeds symbol length@', lout, buffl, 1, buffl )
+ end if
+!-----------------------------------------------------------------------
+! ... Check each "product" token for an explicit multiplier
+!-----------------------------------------------------------------------
+ do k = prdcnt+1,prdcnt+tprdcnt
+ j = index( prdprms(k)(:slen(k)), '*' )
+ if( j == 0 ) then
+ prdsym(k) = prdprms(k)(:symlen)
+ cycle
+ else if( j == 1 .or. j == slen(k) ) then
+ call errmes( ' Product & multiplier syntax error@', lout, prdprms(k), 1, prdprms(k) )
+ end if
+ read(prdprms(k)(:j-1),*,iostat=retcod) pcoeffs(k)
+ if( retcod /= 0 ) then
+ call errmes( 'number format error in product multiplier #@', lout, &
+ prdprms(k), slen(k), buff )
+ end if
+ prdsym(k) = prdprms(k)(j+1:)
+ if( pcoeffs(k) /= 1. ) then
+ coeff_flg = .true.
+ end if
+ end do
+ prdcnt = prdcnt + tprdcnt
+ end do
+
+ deallocate( slen )
+ deallocate( rxparms )
+
+!-----------------------------------------------------------------------
+! ... Formats
+!-----------------------------------------------------------------------
+100 format('0 **** reaction string has no reactants ****')
+102 format('0 **** reaction string has no = sign separator ****')
+
+ end subroutine rxtprs
+
+ subroutine mapper( nsol, nfix, npce, rxtcnt, &
+ prdcnt, rxtsym, prdsym, solsym, &
+ fixsym, pcesym, nsr, nsp, &
+ nf, npr, npp, rxttab, &
+ rxtype, coeff_flg,pcoeffs )
+
+ use io, only : lout
+ use rxt_mod, only : rxtnt_lim, prd_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: nsol, nfix, npce, &
+ rxtcnt, prdcnt, rxtype
+ integer, intent(out) :: nsr, nsp, nf, npr, npp
+ integer, intent(out) :: rxttab(5,*)
+ real, intent(inout) :: pcoeffs(prd_lim)
+ logical, intent(inout) :: coeff_flg
+ character(len=*), intent(in) :: rxtsym(rxtnt_lim), prdsym(prd_lim)
+ character(len=*), intent(in) :: solsym(:), fixsym(:), pcesym(:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: k, l, photo = 0
+ logical :: local_flag
+
+ nf = 0
+ nsp = 0
+ nsr = 0
+ npr = 0
+ npp = 0
+
+rxtnt_scan : &
+ do k = 1,rxtcnt
+ if( rxtype == photo ) then
+ if( k == 2 ) then
+ if( rxtsym(k) /= 'hv' ) then
+ call errmes( 'Photo reaction has misplaced or missing "hv" operator@', lout, buff, 1, buff )
+ end if
+ cycle rxtnt_scan
+ else if( k > 2 ) then
+ call errmes( 'Photo-reaction can have only one reactant@', lout, buff, 1, buff )
+ else if( rxtsym(k) == 'hv' ) then
+ call errmes( 'Photo-reaction has misplaced "hv" operator@', lout, buff, 1, buff )
+ end if
+ else if( rxtsym(k) == 'hv' ) then
+ call errmes( ' Photolysis operator "hv" is illegal in a non-photolysis reaction@', lout, buff, 1, buff )
+ end if
+!-----------------------------------------------------------------------
+! ... Parse out fixed reactants
+!-----------------------------------------------------------------------
+ if( nfix /= 0 ) then
+ do l = 1,nfix
+ if( rxtsym(k) == fixsym(l) ) then
+ nf = nf + 1
+ rxttab(1,nf) = l
+ cycle rxtnt_scan
+ end if
+ end do
+ end if
+!-----------------------------------------------------------------------
+! ... Parse out solution reactants
+!-----------------------------------------------------------------------
+ do l = 1,nsol
+ if( rxtsym(k) == solsym(l) ) then
+ nsr = nsr + 1
+ rxttab(2,nsr) = l
+ cycle rxtnt_scan
+ end if
+ end do
+!-----------------------------------------------------------------------
+! ... Parse out the pce reactants
+!-----------------------------------------------------------------------
+ if( npce /= 0 .and. (nsr+nf) /= rxtcnt ) then
+ do l = 1,npce
+ if( rxtsym(k) == pcesym(l) ) then
+ npr = npr + 1
+ rxttab(4,npr) = l
+ cycle rxtnt_scan
+ end if
+ end do
+ end if
+ call errmes( ' Reactant "#" is not in sol, pce, or fixed lists@', lout, rxtsym(k), len_trim(rxtsym(k)), buff )
+ end do rxtnt_scan
+
+!-----------------------------------------------------------------------
+! ... Parse out solution products
+!-----------------------------------------------------------------------
+ local_flag = .false.
+ do k = 1,prdcnt
+ do l = 1,nsol
+ if( prdsym(k) == solsym(l) ) then
+ nsp = nsp + 1
+ rxttab(3,nsp) = l
+ if( coeff_flg ) then
+ pcoeffs(nsp) = pcoeffs(k)
+ if( pcoeffs(k) /= 1.e0 ) then
+ local_flag = .true.
+ end if
+ end if
+ exit
+ end if
+ end do
+ end do
+ coeff_flg = local_flag
+!-----------------------------------------------------------------------
+! ... Parse out the pce products
+!-----------------------------------------------------------------------
+ do k = 1,prdcnt
+ do l = 1,npce
+ if( prdsym(k) == pcesym(l) ) then
+ npp = npp + 1
+ rxttab(5,npp) = l
+ exit
+ end if
+ end do
+ end do
+
+ end subroutine mapper
+
+ subroutine outp( rxparms, &
+ nr, &
+ np, &
+ rxtsym, &
+ prdsym, &
+ sym_rate, &
+ irxn, &
+ rate, &
+ loc_rxt_tag, &
+ lout )
+
+ use rxt_mod, only : rxtnt_lim, prd_lim
+ use var_mod, only : nq, nfs, solsym, fixsym
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! OUTP OUTPuts a single reaction and rate
+!
+! Inputs:
+! nr - number of reactants
+! np - number of products
+! rxparms - vector of "full" product terms (including
+! multipliers)
+! rxtsym - reactant symbol(s)
+! prdsym - product symbol(s)
+! irxn - reaction number
+! rate - vector of reaction rate parameters
+! lout - logical OUTPut unit number
+! Outputs:
+! NONE
+!-----------------------------------------------------------------------
+
+ integer, intent(in) :: nr, np, irxn, lout
+ real, intent(in) :: rate(:)
+ character(len=*), intent(in) :: rxparms(prd_lim)
+ character(len=*), intent(in) :: sym_rate(5)
+ character(len=*), intent(in) :: loc_rxt_tag
+ character(len=*), intent(in) :: rxtsym(rxtnt_lim), prdsym(prd_lim)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: i, j, k, kl, length, slen, retcod, line_cnt
+ integer :: buff_pos, arrow_pos
+ real :: coeff
+ character(len=320) :: buff
+ character(len=64) :: rx_piece
+
+!-----------------------------------------------------------------------
+! ... function declarations
+!-----------------------------------------------------------------------
+ integer :: inclist
+
+ buff = ' '
+ j = 1
+
+!-----------------------------------------------------------------------
+! ... Form the reactants
+!-----------------------------------------------------------------------
+ do i = 1,nr
+ length = len_trim( rxtsym(i) )
+ buff(j:length+j-1) = rxtsym(i)(:length)
+ j = length + j + 1
+ if( i == nr ) then
+ buff(j:) = '->'
+ j = j + 3
+ else
+ buff(j:) = '+'
+ j = j + 2
+ end if
+ end do
+ buff_pos = j ; arrow_pos = j
+
+!-----------------------------------------------------------------------
+! ... Form the products
+!-----------------------------------------------------------------------
+ line_cnt = 1
+ if( np /= 0 ) then
+ do i = 1,np
+ if( i /= 1 ) then
+ rx_piece = '+'
+ else
+ rx_piece = ' '
+ end if
+ j = 1
+ length = index( rxparms(i), '*' )
+ if( length /= 0 ) then
+ read(rxparms(i)(:length-1),*,iostat=retcod) coeff
+ if( retcod /= 0 ) then
+ call errmes( ' # is not a valid real number@', &
+ lout, &
+ rxparms(i), &
+ length-1, &
+ buff )
+ end if
+ if( coeff /= 1. ) then
+ length = length + 1
+ slen = len_trim( rx_piece )
+ rx_piece(slen+2:slen+length+1) = rxparms(i)(:length-1)
+ j = len_trim( rx_piece ) + 1
+ else
+ j = len_trim( rx_piece ) + 2
+ end if
+ else
+ j = len_trim( rx_piece ) + 2
+ end if
+ kl = inclist( trim(prdsym(i)), solsym, nq )
+ if( kl < 1 .and. nfs > 0 ) then
+ kl = inclist( trim(prdsym(i)), fixsym, nfs )
+ end if
+ length = len_trim( prdsym(i) )
+ if( kl > 0 ) then
+ rx_piece(j:length+j-1) = prdsym(i)(:length)
+ else
+ rx_piece(j:length+j+1) = '{' // prdsym(i)(:length) // '}'
+ end if
+ length = len_trim( rx_piece )
+ if( (buff_pos + length) <= 69 ) then
+ buff(buff_pos:) = trim( rx_piece )
+ buff_pos = buff_pos + length + 1
+ if( i == np ) then
+ kl = line_cnt
+ do k = kl,max(4,line_cnt)
+ call write_rxt( buff, sym_rate, rate, loc_rxt_tag, irxn, line_cnt )
+ line_cnt = line_cnt + 1
+ end do
+ end if
+ else
+ call write_rxt( buff, sym_rate, rate, loc_rxt_tag, irxn, line_cnt )
+ line_cnt = line_cnt + 1
+ buff(arrow_pos+1:) = trim( rx_piece )
+ buff_pos = len_trim( buff ) + 2
+ if( i == np ) then
+ kl = line_cnt
+ do k = kl,max(4,line_cnt)
+ call write_rxt( buff, sym_rate, rate, loc_rxt_tag, irxn, line_cnt )
+ line_cnt = line_cnt + 1
+ end do
+ end if
+ end if
+ end do
+ else
+ buff(j:) = '(No products)'
+ do k = 1,3
+ call write_rxt( buff, sym_rate, rate, loc_rxt_tag, irxn, line_cnt )
+ line_cnt = line_cnt + 1
+ end do
+ end if
+
+ end subroutine outp
+
+ subroutine write_rxt( buff, sym_rate, rate, loc_rxt_tag, irxn, line_cnt )
+!-----------------------------------------------------------------------
+! ... Print the reaction rate
+!-----------------------------------------------------------------------
+
+ use io, only : lout
+ use rxt_mod, only : phtcnt
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: line_cnt, irxn
+ real, intent(in) :: rate(:)
+ character(len=*), intent(inout) :: buff
+ character(len=*), intent(in) :: sym_rate(:)
+ character(len=*), intent(in) :: loc_rxt_tag
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ logical :: troe_rate
+
+ if( line_cnt <= 3 ) then
+ if( sym_rate(1) /= ' ' ) then
+ troe_rate = rate(1) /= 0. .and. rate(3) /= 0.
+ if( line_cnt == 1 ) then
+ if( rate(1) == 0. ) then
+ buff(69:) = ' rate = 0.'
+ write(lout,100) loc_rxt_tag, irxn, buff, irxn+phtcnt
+ else if( .not. troe_rate ) then
+ buff(69:) = ' rate = '
+ write(buff(77:),'(1pe8.2)') rate(1)
+ if( rate(2) /= 0. ) then
+ buff(85:) = '*exp('
+ write(buff(90:),'(f8.0)') rate(2)
+ buff(98:) = '/t)'
+ end if
+ write(lout,100) loc_rxt_tag, irxn, buff, irxn+phtcnt
+ else
+ buff(69:) = ' troe : ko='
+ write(buff(80:),'(1pe8.2)') rate(1)
+ if( rate(2) /= 0. ) then
+ buff(88:) = '*(300/t)**'
+ if ( rate(2)>=0. ) then
+ write(buff(98:),'(f4.2)') rate(2)
+ else
+ write(buff(98:),'(f5.2)') rate(2)
+ endif
+ end if
+ write(lout,110) loc_rxt_tag, irxn, buff, irxn+phtcnt
+ end if
+ else if( troe_rate ) then
+ if( line_cnt == 2 ) then
+ buff(69:) = ' ki='
+ write(buff(80:),'(1pe8.2)') rate(3)
+ if( rate(4) /= 0. ) then
+ if( rate(4) /= 1. ) then
+ buff(88:) = '*(300/t)**'
+ if ( rate(4)>=0. ) then
+ write(buff(98:),'(f4.2)') rate(4)
+ else
+ write(buff(98:),'(f5.2)') rate(4)
+ endif
+ else
+ buff(88:) = '*(300/t)'
+ end if
+ end if
+ else if( line_cnt == 3 ) then
+ buff(69:) = ' f='
+ write(buff(80:),'(f4.2)') rate(5)
+ end if
+ write(lout,120) buff
+ else if( buff /= ' ' ) then
+ write(lout,120) buff
+ end if
+ else
+ if( line_cnt == 1 ) then
+ buff(69:) = ' rate = ** User defined **'
+ write(lout,100) loc_rxt_tag, irxn, buff, irxn+phtcnt
+ else if( buff /= ' ' ) then
+ write(lout,120) buff
+ end if
+ end if
+ else if( buff /= ' ' ) then
+ write(lout,120) buff
+ end if
+ buff = ' '
+
+!-----------------------------------------------------------------------
+! ... Formats
+!-----------------------------------------------------------------------
+100 format(2x,a16,1x,'(',i3,')',3x,a100,3x,'(',i3,')')
+110 format(2x,a16,1x,'(',i3,')',3x,a101,2x,'(',i3,')')
+120 format(27x,a103)
+
+ end subroutine write_rxt
+
+ end module mo_chem
diff --git a/chem_proc/src/cam_chempp/chm_hdr.f b/chem_proc/src/cam_chempp/chm_hdr.f
new file mode 100644
index 0000000000..67085f9887
--- /dev/null
+++ b/chem_proc/src/cam_chempp/chm_hdr.f
@@ -0,0 +1,110 @@
+
+ subroutine chm_hdr( rxt_tag_cnt, enthalpy_cnt, hetcnt, usrcnt, cls_rxt_cnt, radj_flag, phtcnt, &
+ rxpcnt, rxparm, rxntot, ncol, nfs, nslvd, &
+ indexm, indexh2o, spcno, relcnt, grpcnt, &
+ clscnt, iter_counts, nzcnt, vec_ftns, machine, chemistry, veclen )
+!-----------------------------------------------------------------------
+! ... Write the chemistry "header" file
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: rxt_tag_cnt
+ integer, intent(in) :: enthalpy_cnt
+ integer, intent(in) :: hetcnt ! count of washout processes
+ integer, intent(in) :: usrcnt ! count of extraneous forcing
+ integer, intent(in) :: phtcnt ! count of photorates
+ integer, intent(in) :: rxpcnt ! count of specified rates
+ integer, intent(in) :: rxntot ! count of totol reactions
+ integer, intent(in) :: ncol ! number of column integrals
+ integer, intent(in) :: nfs ! number of "fixed" species
+ integer, intent(in) :: nslvd ! number of "short lived" species
+ integer, intent(in) :: indexm ! index for "m"
+ integer, intent(in) :: indexh2o ! index for h2o
+ integer, intent(in) :: spcno ! total number of xported species
+ integer, intent(in) :: relcnt ! number of "relative" species
+ integer, intent(in) :: grpcnt ! number of group species
+ integer, intent(in) :: nzcnt(2) ! number of non-zero entries in lu
+ integer, intent(in) :: clscnt(5) ! solution class count
+ integer, intent(in) :: iter_counts(4) ! iteration counts
+ integer, intent(in) :: cls_rxt_cnt(4,5) ! class reaction count
+
+ real, intent(in) :: rxparm(2,*) ! rxtn rate parms
+ logical, intent(in) :: radj_flag ! rxt adjust flag
+ logical, intent(in) :: vec_ftns ! vector function flag
+ logical, intent(in) :: chemistry ! chemistry flag
+
+ character(len=16), intent(in) :: machine ! target machine
+ integer, intent(in) :: veclen ! vector length in vectorized solver
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: gascnt ! number of gas phase rxtns
+ logical :: lexist
+
+ inquire( file = 'chem.h', exist = lexist )
+ if( lexist ) then
+ call system( 'rm chem.h' )
+ end if
+ open( unit = 30, file = 'chem.h' )
+
+ write(30,'(''# define RXTTAGCNT '',i5)') rxt_tag_cnt
+ write(30,'(''# define ENTHALPYCNT '',i5)') enthalpy_cnt
+ write(30,'(''# define HETCNT '',i5)') hetcnt
+ write(30,'(''# define EXTCNT '',i5)') usrcnt
+ gascnt = sum( cls_rxt_cnt(1,1:5) )
+ write(30,'(''# define CLSINDPRD '',i5)') gascnt
+ write(30,'(''# define CLSINDPRD1 '',i5)') cls_rxt_cnt(1,1)
+ write(30,'(''# define CLSINDPRD2 '',i5)') cls_rxt_cnt(1,2)
+ write(30,'(''# define CLSINDPRD3 '',i5)') cls_rxt_cnt(1,3)
+ write(30,'(''# define CLSINDPRD4 '',i5)') cls_rxt_cnt(1,4)
+ write(30,'(''# define CLSINDPRD5 '',i5)') cls_rxt_cnt(1,5)
+ write(30,'(''# define IMP_NZCNT '',i5)') nzcnt(1)
+ write(30,'(''# define ROD_NZCNT '',i5)') nzcnt(2)
+ gascnt = cls_rxt_cnt(2,4) + cls_rxt_cnt(4,4)
+ write(30,'(''# define IMP_LINCNT '',i5)') gascnt
+ gascnt = cls_rxt_cnt(2,5) + cls_rxt_cnt(4,5)
+ write(30,'(''# define ROD_LINCNT '',i5)') gascnt
+ write(30,'(''# define IMP_NLNCNT '',i5)') cls_rxt_cnt(3,4)
+ write(30,'(''# define ROD_NLNCNT '',i5)') cls_rxt_cnt(3,5)
+ if( radj_flag ) then
+ write(30,'(''# define RADJFLAG'')')
+ end if
+ write(30,'(''# define PHTCNT '',i5)') phtcnt
+ write(30,'(''# define PHTCNTP1 '',i5)') phtcnt+1
+ write(30,'(''# define RXNCNT '',i5)') rxntot
+ gascnt = rxntot - phtcnt
+ write(30,'(''# define GASCNT '',i5)') gascnt
+ write(30,'(''# define SETRXNCNT '',i5)') rxpcnt
+ write(30,'(''# define USRRXNCNT '',i5)') gascnt - rxpcnt
+ gascnt = count( rxparm(2,1:rxpcnt) /= 0. )
+ write(30,'(''# define TDEPCNT '',i5)') gascnt
+ write(30,'(''# define NCOL '',i5)') ncol
+ write(30,'(''# define NFS '',i5)') nfs
+ write(30,'(''# define NSLVD '',i5)') nslvd
+ write(30,'(''# define VECLEN '',i5)') veclen
+ write(30,'(''# define INDEXM '',i5)') indexm
+ write(30,'(''# define INDEXH2O '',i5)') indexh2o
+ write(30,'(''# define PCNST '',i5)') spcno
+ write(30,'(''# define PCNSTP2 '',i5)') spcno+2
+ write(30,'(''# define RELCNT '',i5)') relcnt
+ write(30,'(''# define GRPCNT '',i5)') grpcnt
+ write(30,'(''# define CLSCNT1 '',i5)') clscnt(1)
+ write(30,'(''# define CLSCNT2 '',i5)') clscnt(2)
+ write(30,'(''# define CLSCNT3 '',i5)') clscnt(3)
+ write(30,'(''# define CLSCNT4 '',i5)') clscnt(4)
+ write(30,'(''# define CLSCNT5 '',i5)') clscnt(5)
+ write(30,'(''# define EBIITERMAX '',i5)') MAX( 1,iter_counts(4) )
+ write(30,'(''# define HOVITERMAX '',i5)') MAX( 1,iter_counts(1) )
+ write(30,'(''# define IMPITERMAX '',i5)') MAX( 1,iter_counts(2) )
+ write(30,'(''# define IMPJACITER '',i5)') MAX( 1,iter_counts(3) )
+ if( chemistry ) then
+ write(30,'(''# define TROP_CHEM'')')
+ end if
+ close( 30 )
+
+ end subroutine chm_hdr
diff --git a/chem_proc/src/cam_chempp/cls_map.f b/chem_proc/src/cam_chempp/cls_map.f
new file mode 100644
index 0000000000..a4e884ce9b
--- /dev/null
+++ b/chem_proc/src/cam_chempp/cls_map.f
@@ -0,0 +1,239 @@
+
+ subroutine CLS_MAPS( )
+!-----------------------------------------------------------------------
+! ... Form the individual method reaction maps from the
+! overall reaction map
+!-----------------------------------------------------------------------
+
+ use IO, only : lout
+ use VAR_MOD, only : extcnt
+ use RXT_MOD, only : cls_rxt_map, cls_rxt_cnt, rxmap, rxmcnt, &
+ prdmap, prdcnt, hetmap, hetcnt, usrmap, &
+ usrcnt, prd_lim, prd_limp1
+ use MO_MAKE_MAP, only : MAKE_MAP
+ use MO_PRD_MAP, only : PRD_MAP
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, allocatable :: template(:,:)
+ integer :: i, j, astat
+ integer :: class
+ integer :: index
+ integer :: row
+ integer :: rxno
+ integer :: rxtnt(2), rxtnt_cls(2)
+
+ integer :: XLATE
+
+!-----------------------------------------------------------------------
+! ... In the following the 1st column of template
+! represents the count of products in each class.
+! The 2nd column represents the class # of the product.
+! On input the 3rd column represents the master
+! product number and on output represents the product
+! number in the specific class.
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! ... Scan the base "pure" production map
+! for class pure production entries
+!-----------------------------------------------------------------------
+ ALLOCATE( template(MAX(5,prd_lim),3),stat=astat )
+ if( astat /= 0 ) then
+ write(lout,*) 'CLS_MAP: Failed to allocate template array; error = ',astat
+ stop
+ end if
+ do i = 1,prdcnt
+ template(:prd_lim,3) = prdmap(i,2:prd_limp1)
+ call PRD_MAP( template )
+ rxno = prdmap(i,1)
+ do class = 1,5
+ if( template(class,1) /= 0 ) then
+ index = cls_rxt_cnt(1,class) + 1
+ call MAKE_MAP( cls_rxt_map(index,:,class), &
+ cls_rxt_cnt(1,class), &
+ class, &
+ rxno, &
+ template(class,1), &
+ template )
+ end if
+ end do
+ end do
+
+!-----------------------------------------------------------------------
+! ... Scan the base linear reaction map
+! for class pure production entries
+!-----------------------------------------------------------------------
+ do i = 1,rxmcnt(1)
+ template(:prd_lim,3) = rxmap(i,3:prd_lim+2,1)
+ call PRD_MAP( template )
+ rxtnt(1) = ABS( rxmap(i,2,1) )
+ rxtnt_cls(1) = XLATE( rxtnt(1) )
+ rxno = rxmap(i,1,1)
+ do class = 1,5
+ if( class /= rxtnt_cls(1) .and. template(class,1) /= 0 ) then
+ index = cls_rxt_cnt(1,class) + 1
+ call MAKE_MAP( cls_rxt_map(index,:,class), &
+ cls_rxt_cnt(1,class), &
+ class, &
+ rxno, &
+ template(class,1), &
+ template )
+ cls_rxt_map(index,2,class) = ABS( rxmap(i,2,1) )
+ end if
+ end do
+ end do
+
+!-----------------------------------------------------------------------
+! ... Scan the base nonlinear reaction map
+! for class pure production entries
+!-----------------------------------------------------------------------
+ do i = 1,rxmcnt(2)
+ template(:prd_lim,3) = rxmap(i,4:prd_lim+3,2)
+ call PRD_MAP( template )
+ rxtnt = ABS( rxmap(i,2:3,2) )
+ rxno = rxmap(i,1,2)
+ do j = 1,2
+ rxtnt_cls(j) = XLATE( rxtnt(j) )
+ end do
+ do class = 1,5
+ if( class /= rxtnt_cls(1) .and. class /= rxtnt_cls(2) .and. template(class,1) /= 0 ) then
+ index = cls_rxt_cnt(1,class) + 1
+ call MAKE_MAP( cls_rxt_map(index,:,class), &
+ cls_rxt_cnt(1,class), &
+ class, &
+ rxno, &
+ template(class,1), &
+ template )
+ cls_rxt_map(index,2:3,class) = ABS( rxmap(i,2:3,2) )
+ end if
+ end do
+ end do
+
+!-----------------------------------------------------------------------
+! ... Scan the base linear reaction map
+! for entries in the class linear map
+!-----------------------------------------------------------------------
+ do i = 1,rxmcnt(1)
+ template(:prd_lim,3) = rxmap(i,3:prd_lim+2,1)
+ call PRD_MAP( template )
+ rxtnt(1) = ABS( rxmap(i,2,1) )
+ class = XLATE( rxtnt(1) )
+ rxno = rxmap(i,1,1)
+ if( template(class,1) /= 0 ) then
+ index = MAX( SUM(cls_rxt_cnt(1:2,class))+1,1 )
+ call MAKE_MAP( cls_rxt_map(index,:,class), &
+ cls_rxt_cnt(2,class), &
+ class, &
+ rxno, &
+ template(class,1), &
+ template )
+ cls_rxt_map(index,2,class) = rxmap(i,2,1)
+ else if( rxmap(i,2,1) > 0 ) then
+ cls_rxt_cnt(2,class) = cls_rxt_cnt(2,class) + 1
+ row = SUM( cls_rxt_cnt(1:2,class) )
+ cls_rxt_map(row,1:2,class) = rxmap(i,1:2,1)
+ end if
+ end do
+
+!-----------------------------------------------------------------------
+! ... Scan the base nonlinear reaction map
+! for entries in the class linear map
+!-----------------------------------------------------------------------
+ do i = 1,rxmcnt(2)
+ do j = 1,2
+ rxtnt(j) = ABS( rxmap(i,j+1,2) )
+ rxtnt_cls(j) = XLATE( rxtnt(j) )
+ end do
+ if( rxtnt_cls(1) /= rxtnt_cls(2) ) then
+ template(:prd_lim,3) = rxmap(i,4:prd_lim+3,2)
+ call PRD_MAP( template )
+ do j = 1,2
+ class = rxtnt_cls(j)
+ if( template(class,1) /= 0 ) then
+ index = MAX( SUM(cls_rxt_cnt(1:2,class))+1,1 )
+ call MAKE_MAP( cls_rxt_map(index,:,class), &
+ cls_rxt_cnt(2,class), &
+ class, &
+ rxmap(i,1,2), &
+ template(class,1), &
+ template )
+ cls_rxt_map(index,2,class) = rxmap(i,j+1,2)
+ if( j == 1 ) then
+ cls_rxt_map(index,3,class) = ABS( rxmap(i,3,2) )
+ else
+ cls_rxt_map(index,3,class) = ABS( rxmap(i,2,2) )
+ end if
+ else if( rxmap(i,j+1,2) > 0 ) then
+ cls_rxt_cnt(2,class) = cls_rxt_cnt(2,class) + 1
+ row = cls_rxt_cnt(1,class) + cls_rxt_cnt(2,class)
+ cls_rxt_map(row,1,class) = rxmap(i,1,2)
+ if( j == 1 ) then
+ cls_rxt_map(row,2:3,class) = ABS( rxmap(i,2:3,2) )
+ else
+ cls_rxt_map(row,2:3,class) = ABS( rxmap(i,3:2:-1,2) )
+ end if
+ end if
+ end do
+ end if
+ end do
+
+!-----------------------------------------------------------------------
+! ... Scan the base nonlinear reaction map
+! for entries in the class nonlinear map
+!-----------------------------------------------------------------------
+ do i = 1,rxmcnt(2)
+ do j = 1,2
+ rxtnt(j) = ABS( rxmap(i,j+1,2) )
+ rxtnt_cls(j) = XLATE( rxtnt(j) )
+ end do
+ if( rxtnt_cls(1) == rxtnt_cls(2) ) then
+ template(:prd_lim,3) = rxmap(i,4:prd_lim+3,2)
+ call PRD_MAP( template )
+ class = rxtnt_cls(1)
+ if( template(class,1) /= 0 ) then
+ index = MAX( 1,SUM(cls_rxt_cnt(1:3,class))+1 )
+ call MAKE_MAP( cls_rxt_map(index,:,class), &
+ cls_rxt_cnt(3,class), &
+ class, &
+ rxmap(i,1,2), &
+ template(class,1), &
+ template )
+ cls_rxt_map(index,2:3,class) = rxmap(i,2:3,2)
+ else if( rxmap(i,2,2) > 0 .or. rxmap(i,3,2) > 0 ) then
+ cls_rxt_cnt(3,class) = cls_rxt_cnt(3,class) + 1
+ row = SUM( cls_rxt_cnt(1:3,class) )
+ cls_rxt_map(row,1:3,class) = rxmap(i,1:3,2)
+ end if
+ end if
+ end do
+
+!-----------------------------------------------------------------------
+! ... Scan the heterogeneous reactions
+!-----------------------------------------------------------------------
+ do i = 1,hetcnt
+ rxtnt(1) = ABS( hetmap(i,1) )
+ class = XLATE( rxtnt(1) )
+ cls_rxt_cnt(4,class) = cls_rxt_cnt(4,class) + 1
+ index = SUM( cls_rxt_cnt(1:4,class) )
+ cls_rxt_map(index,1,class) = i
+ cls_rxt_map(index,2,class) = rxtnt(1)
+ end do
+
+!-----------------------------------------------------------------------
+! ... Scan the extraneous forcing
+!-----------------------------------------------------------------------
+ do i = 1,usrcnt
+ rxtnt(1) = ABS( usrmap(i) )
+ class = XLATE( rxtnt(1) )
+ extcnt(class) = extcnt(class) + 1
+ index = SUM( cls_rxt_cnt(1:4,class) ) + extcnt(class)
+ cls_rxt_map(index,1,class) = i
+ cls_rxt_map(index,2,class) = rxtnt(1)
+ end do
+
+ DEALLOCATE( template )
+
+ end subroutine CLS_MAPS
diff --git a/chem_proc/src/cam_chempp/eqrep.f b/chem_proc/src/cam_chempp/eqrep.f
new file mode 100644
index 0000000000..7a387f6332
--- /dev/null
+++ b/chem_proc/src/cam_chempp/eqrep.f
@@ -0,0 +1,420 @@
+module utils
+
+ contains
+ subroutine EQUATION_REP( &
+ nq, &
+ solsym, &
+ nfix, &
+ fixsym, &
+ prdcnt, &
+ prdmap, &
+ rxntot, &
+ rxmcnt, &
+ rxmap, &
+ coeff_cnt, &
+ coeff_ind, &
+ coeffs, &
+ fxmcnt, &
+ fixmap, &
+ phtcnt )
+
+ use IO, only : lout
+ use VAR_MOD, only : var_lim
+ use RXT_MOD, only : rxt_lim, prd_lim, prd_limp1
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: nq, &
+ nfix, &
+ prdcnt, &
+ rxntot, &
+ coeff_cnt, &
+ phtcnt
+ integer, intent(in) :: prdmap(var_lim,prd_limp1), &
+ rxmcnt(2), &
+ rxmap(rxt_lim,prd_lim+3,2), &
+ coeff_ind(rxt_lim), &
+ fxmcnt(2), &
+ fixmap(var_lim,3,2)
+
+ real, intent(in) :: coeffs(prd_lim,rxt_lim)
+
+ character(len=16), intent(in) :: solsym(*), &
+ fixsym(*)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: i, j, k, l
+ integer :: spc_num, length, beg_mark
+ integer :: line_pos, line_num, buf_pos, rxno
+
+ character(len=320) :: lines(2)
+ character(len=80) :: eq_piece
+ character(len=16) :: symbol
+
+ logical :: production, destruction, blow_off, quadratic
+
+ write(lout,*) ' '
+ write(lout,*) ' '
+ write(lout,'('' Equation Report'')')
+ write(lout,*) ' '
+
+ do spc_num = 1,nq
+ production = .false.
+ destruction = .false.
+ line_num = 1
+ lines = ' '
+ lines(1) = ' d('
+ length = LEN_TRIM( solsym(spc_num) )
+ lines(1)(7:) = solsym(spc_num)(:length)
+ line_pos = 7 + length
+ lines(1)(line_pos:) = ')/dt = '
+ line_pos = line_pos + 7
+ beg_mark = line_pos
+!-----------------------------------------------------------------------
+! ... Scan the "independent" production map for product target
+!-----------------------------------------------------------------------
+ do i = 1,prdcnt
+ do k = 2,prd_limp1
+ if( prdmap(i,k) == 0 ) then
+ exit
+ else if( prdmap(i,k) /= spc_num ) then
+ cycle
+ end if
+ eq_piece = ' '
+ if( production ) then
+ eq_piece = ' + '
+ buf_pos = 4
+ else
+ buf_pos = 1
+ end if
+ production = .true.
+ rxno = prdmap(i,1)
+ if( coeff_ind(rxno) /= 0 ) then
+ if( coeffs(k-1,coeff_ind(rxno)) /= 1.e0 ) then
+ call NUMCON( eq_piece(buf_pos:), coeffs(k-1,coeff_ind(rxno)), 'l' )
+ buf_pos = LEN_TRIM( eq_piece ) + 1
+ if( rxno > phtcnt ) then
+ eq_piece(buf_pos:) = '*r'
+ else
+ eq_piece(buf_pos:) = '*j'
+ end if
+ buf_pos = buf_pos + 2
+ else
+ if( rxno > phtcnt ) then
+ eq_piece(buf_pos:) = 'r'
+ else
+ eq_piece(buf_pos:) = 'j'
+ end if
+ buf_pos = buf_pos + 1
+ end if
+ else
+ if( rxno > phtcnt ) then
+ eq_piece(buf_pos:) = 'r'
+ else
+ eq_piece(buf_pos:) = 'j'
+ end if
+ buf_pos = buf_pos + 1
+ end if
+ if( rxno > phtcnt ) then
+ call NUMCON( eq_piece(buf_pos:), REAL(rxno-phtcnt), 'l' )
+ else
+ call NUMCON( eq_piece(buf_pos:), REAL(rxno), 'l' )
+ end if
+ buf_pos = LEN_TRIM( eq_piece ) + 1
+ call SET_FIXED_REACTANTS( fixmap, var_lim, 3, &
+ rxno, fixsym, eq_piece, buf_pos, &
+ phtcnt )
+ length = buf_pos
+ if( (line_pos+length) > 120 ) then ! inc line count
+ line_pos = beg_mark
+ line_num = line_num + 1
+ if( line_num > 2 ) then ! write out the buffer
+ write(lout,'(a120)') lines
+ line_num = 1
+ lines = ' '
+ end if
+ end if
+ lines(line_num)(line_pos:) = eq_piece(:length)
+ line_pos = line_pos + length
+ end do
+ end do
+
+!-----------------------------------------------------------------------
+! ... Scan the "regular" reaction map for product target
+!-----------------------------------------------------------------------
+ do i = 1,2
+ do j = 1,rxmcnt(i)
+ do k = i+2,i+prd_limp1
+ if( rxmap(j,k,i) == 0 ) then
+ exit
+ else if( rxmap(j,k,i) /= spc_num ) then
+ cycle
+ end if
+ eq_piece = ' '
+ if( production ) then
+ eq_piece = ' + '
+ buf_pos = 4
+ else
+ buf_pos = 1
+ end if
+ production = .true.
+ rxno = rxmap(j,1,i)
+ if( coeff_ind(rxno) /= 0 ) then
+ if ( coeffs(k-(i+1),coeff_ind(rxno)) /= 1.e0 ) then
+ 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
+ eq_piece(buf_pos:) = '*r'
+ else
+ eq_piece(buf_pos:) = '*j'
+ end if
+ buf_pos = buf_pos + 2
+ else
+ if( rxno > phtcnt ) then
+ eq_piece(buf_pos:) = 'r'
+ else
+ eq_piece(buf_pos:) = 'j'
+ end if
+ buf_pos = buf_pos + 1
+ end if
+ else
+ if( rxno > phtcnt ) then
+ eq_piece(buf_pos:) = 'r'
+ else
+ eq_piece(buf_pos:) = 'j'
+ end if
+ buf_pos = buf_pos + 1
+ end if
+
+ if( rxno > phtcnt ) then
+ call NUMCON( eq_piece(buf_pos:), REAL(rxno-phtcnt), 'l' )
+ else
+ call NUMCON( eq_piece(buf_pos:), REAL(rxno), 'l' )
+ end if
+ buf_pos = LEN_TRIM( eq_piece ) + 1
+ call SET_FIXED_REACTANTS( fixmap, var_lim, 3, &
+ rxno, fixsym, eq_piece, buf_pos, &
+ phtcnt )
+ do l = 2,i+1
+ if( rxmap(j,l,i) == 0 ) then
+ exit
+ end if
+ symbol = solsym(ABS(rxmap(j,l,i)))
+ length = LEN_TRIM( symbol )
+ eq_piece(buf_pos:) = '*' // symbol(:length)
+ buf_pos = buf_pos + length + 1
+ end do
+ length = buf_pos
+ if( (line_pos+length) > 120 ) then !inc line count
+ line_pos = beg_mark
+ line_num = line_num + 1
+ if( line_num > 2 ) then !write out the buffer
+ write(lout,'(a120)') lines
+ line_num = 1
+ lines = ' '
+ end if
+ end if
+ lines(line_num)(line_pos:) = eq_piece(:length)
+ line_pos = line_pos + length
+ end do
+ end do
+ end do
+!-----------------------------------------------------------------------
+! ... If buffer has unprinted lines flush it
+!-----------------------------------------------------------------------
+ if( production ) then
+ do l = 1,line_num
+ if( lines(l) /= ' ' ) then
+ write(lout,'(a120)') lines(l)
+ end if
+ end do
+ lines(1:line_num) = ' '
+ line_num = 1
+ line_pos = beg_mark
+ end if
+
+!-----------------------------------------------------------------------
+! ... Scan the "regular" reaction map for reactant target
+!-----------------------------------------------------------------------
+ do i = 1,2
+ do j = 1,rxmcnt(i)
+ blow_off = .false.
+ quadratic = .false.
+ do k = 2,i+1
+ eq_piece = ' '
+ if( rxmap(j,k,i) /= spc_num ) then
+ cycle
+ end if
+ eq_piece = ' - '
+ buf_pos = 4
+ if( i == 2 .and. k == 2 ) then
+ if( rxmap(j,3,i) == spc_num ) then
+ eq_piece(buf_pos:) = '2*'
+ buf_pos = buf_pos + 2
+ blow_off = .true.
+ quadratic = .true.
+ else
+ quadratic = .false.
+ end if
+ end if
+ destruction = .true.
+ rxno = rxmap(j,1,i)
+ if( rxno > phtcnt ) then
+ eq_piece(buf_pos:) = 'r'
+ else
+ eq_piece(buf_pos:) = 'j'
+ end if
+ buf_pos = buf_pos + 1
+ if( rxno > phtcnt ) then
+ call NUMCON( eq_piece(buf_pos:), REAL(rxno-phtcnt), 'l' )
+ else
+ call NUMCON( eq_piece(buf_pos:), REAL(rxno), 'l' )
+ end if
+ buf_pos = LEN_TRIM( eq_piece ) + 1
+ if( i == 1 ) then
+ blow_off = .true.
+ end if
+ call SET_FIXED_REACTANTS( fixmap, var_lim, 3, &
+ rxno, fixsym, eq_piece, buf_pos, &
+ phtcnt )
+ if( blow_off ) then
+ symbol = solsym(spc_num)
+ else
+ do l = 2,i+1
+ if( ABS(rxmap(j,l,i)) == spc_num ) then
+ cycle
+ end if
+ symbol = solsym(ABS(rxmap(j,l,i)))
+ end do
+ end if
+ length = LEN_TRIM( symbol )
+ eq_piece(buf_pos:) = '*' // symbol(:length)
+ buf_pos = buf_pos + length + 1
+ if( .not. blow_off .or. quadratic ) then
+ symbol = solsym(spc_num)
+ length = LEN_TRIM( symbol )
+ eq_piece(buf_pos:) = '*' // symbol(:length)
+ buf_pos = buf_pos + length + 1
+ end if
+ length = buf_pos
+ if( (line_pos+length) > 120 ) then ! inc line count
+ line_pos = beg_mark
+ line_num = line_num + 1
+ if( line_num > 2 ) then ! write out the buffer
+ write(lout,'(a120)') lines
+ line_num = 1
+ lines = ' '
+ end if
+ end if
+ lines(line_num)(line_pos:) = eq_piece(:length)
+ line_pos = line_pos + length
+ if( blow_off ) then
+ exit
+ end if
+ end do
+ end do
+ end do
+
+ if( .not. production .and. .not. destruction ) then
+ lines(line_num)(line_pos:) = '0'
+ end if
+
+!-----------------------------------------------------------------------
+! ... If buffer has unprinted lines flush it
+!-----------------------------------------------------------------------
+ do l = 1,line_num
+ if( lines(l) /= ' ' ) then
+ write(lout,'(a120)') lines(l)
+ end if
+ end do
+
+ end do
+
+ end subroutine EQUATION_REP
+
+ integer function GET_INDEX( array, rdim, cdim, scol, key )
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: rdim, cdim, scol, key
+ integer, intent(in) :: array(rdim,cdim)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: i
+
+ do i = 1,rdim
+ if( array(i,scol) == key ) then
+ GET_INDEX = i
+ return
+ end if
+ end do
+
+ GET_INDEX = 0
+
+ end function GET_INDEX
+
+ subroutine SET_FIXED_REACTANTS( &
+ fixmap, &
+ rowdim, &
+ coldim, &
+ rxno, &
+ fixsym, &
+ eq_piece, &
+ buf_pos, &
+ phtcnt )
+
+ use VAR_MOD, only : var_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: rowdim, coldim, phtcnt
+ integer, intent(in) :: fixmap(rowdim,coldim,2)
+ integer, intent(inout) :: rxno
+ integer, intent(inout) :: buf_pos
+
+ character(len=80), intent(out) :: eq_piece
+ character(len=16), intent(in) :: fixsym(*)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: j, l, index, length
+ character(len=16) :: symbol
+
+ if( rxno < phtcnt ) then
+ rxno = - rxno
+ end if
+ do j = 1,2
+ index = GET_INDEX( fixmap(1,1,j), var_lim, 3, 1, rxno )
+ if( index /= 0 ) then
+ do l = 2,3
+ if( fixmap(index,l,j) == 0 ) then
+ return
+ end if
+ symbol = fixsym(fixmap(index,l,j))
+ length = LEN_TRIM( symbol )
+ eq_piece(buf_pos:) = '*' // symbol(:length)
+ buf_pos = buf_pos + length + 1
+ end do
+ exit
+ end if
+ end do
+
+
+
+ end subroutine SET_FIXED_REACTANTS
+
+end module utils
diff --git a/chem_proc/src/cam_chempp/exe_opts.f b/chem_proc/src/cam_chempp/exe_opts.f
new file mode 100644
index 0000000000..2fb893b971
--- /dev/null
+++ b/chem_proc/src/cam_chempp/exe_opts.f
@@ -0,0 +1,87 @@
+ subroutine EXE_OPTS( options, &
+ lin, &
+ lout )
+!-----------------------------------------------------------------------
+! ... Set the execution options
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: lin
+ integer, intent(in) :: lout
+ logical, intent(out) :: options(3)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: kpar, nchar, k
+ integer :: parsw(3)
+
+ character(len=80) :: buff
+ character(len=20) :: parkey(3), keywrd
+ logical :: found
+
+ integer :: LENOF
+
+ parkey(1) = 'QSUBFILE'
+ parkey(2) = 'SUBMIT'
+ parkey(3) = 'FIXER'
+
+ parsw = 0
+
+!-----------------------------------------------------------------------
+! ... Scan for valid option keyword
+!-----------------------------------------------------------------------
+ do
+ call CARDIN( lin, buff, nchar )
+ call UPCASE ( buff )
+ if( buff == 'ENDEXECUTIONOPTIONS' ) then
+ exit
+ end if
+ k = INDEX( buff(:nchar), '=' )
+ if( k /= 0 ) then
+ keywrd = buff(:k-1)
+ found = .false.
+ do kpar = 1,6
+ if( keywrd == parkey(kpar) ) then
+ found = .true.
+ exit
+ end if
+ end do
+ if( .not. found ) then
+ call ERRMES ( ' # is an invalid options' &
+ // ' parameter keyword@', lout, keywrd, &
+ LENOF(20,keywrd), buff )
+ end if
+ else
+!-----------------------------------------------------------------------
+! ... Invalid parameter keyword; terminate the program
+!-----------------------------------------------------------------------
+ call ERRMES( ' option specification has no = operator@', &
+ lout, buff, 1, buff )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Valid parameter keyword; now check for duplicate keyword
+!-----------------------------------------------------------------------
+ if( parsw(kpar) /= 0 ) then
+ call ERRMES( '0 *** # has already been specified@', &
+ lout, parkey(kpar), k, ' ' )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Set individual options
+!-----------------------------------------------------------------------
+ if( buff(k+1:nchar) == 'ON' .or. &
+ buff(k+1:nchar) == 'YES' ) then
+ options(kpar) = .true.
+ else
+ options(kpar) = .false.
+ end if
+ parsw(kpar) = 1
+ end do
+
+ end subroutine EXE_OPTS
diff --git a/chem_proc/src/cam_chempp/files_hdr.f b/chem_proc/src/cam_chempp/files_hdr.f
new file mode 100644
index 0000000000..99fe0eeddc
--- /dev/null
+++ b/chem_proc/src/cam_chempp/files_hdr.f
@@ -0,0 +1,39 @@
+
+ module mo_files_hdr
+
+ use io, only : temp_path, procfiles_path
+
+ contains
+
+ subroutine files_hdr
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... The local variables
+!-----------------------------------------------------------------------
+ integer :: slen
+ logical :: lexist
+
+ inquire( file = 'files.h', exist = lexist )
+ if( lexist ) then
+ call system( 'rm files.h' )
+ end if
+ open( unit = 30, file = 'files.h' )
+
+ write(30,'(''#define SETRXTFILE '',a)') TRIM( temp_path ) // 'mo_setrxt.F'
+ write(30,'(''#define ADJRXTFILE '',a)') TRIM( temp_path ) // 'mo_adjrxt.F'
+ write(30,'(''#define PHTADJFILE '',a)') TRIM( temp_path ) // 'mo_phtadj.F'
+ write(30,'(''#define RXTMODFILE '',a)') TRIM( temp_path ) // 'mo_rxt_mod.F'
+ write(30,'(''#define GRPVMRFILE '',a)') TRIM( temp_path ) // 'mo_make_grp_vmr.F'
+ write(30,'(''#define SETDATFILE '',a)') TRIM( temp_path ) // 'mo_sim_dat.F'
+ slen = len_trim( procfiles_path )
+ write(30,'(''#define EXPSLVPATH '',a)') procfiles_path(:slen-1)
+ write(30,'(''#define IMPSLVPATH '',a)') procfiles_path(:slen-1)
+ write(30,'(''#define MODSPATH '',a)') procfiles_path(:slen-1)
+
+ close(30)
+
+ end subroutine files_hdr
+
+ end module mo_files_hdr
diff --git a/chem_proc/src/cam_chempp/het_names.f b/chem_proc/src/cam_chempp/het_names.f
new file mode 100644
index 0000000000..e165eae0e5
--- /dev/null
+++ b/chem_proc/src/cam_chempp/het_names.f
@@ -0,0 +1,54 @@
+
+ subroutine MAKE_HET_NAME_MOD
+!--------------------------------------------------------------------------------
+! ... Makes a module of parameter reaction names
+!--------------------------------------------------------------------------------
+
+ use RXT_MOD, only : hetcnt, hetmap
+ use VAR_MOD, only : spc_cnt => new_nq, spc_names => new_solsym
+ use IO, only : temp_path
+
+ implicit none
+
+!--------------------------------------------------------------------------------
+! ... Local variables
+!--------------------------------------------------------------------------------
+ integer :: i, m
+ character(len=80) :: buff
+ character(len=5) :: num
+ logical :: lexist
+
+!--------------------------------------------------------------------------------
+! ... Check mod file existence; remove if found
+!--------------------------------------------------------------------------------
+ INQUIRE( file = TRIM( temp_path ) // 'het_names.mod', exist = lexist )
+ if( lexist ) then
+ call SYSTEM( 'rm ' // TRIM( temp_path ) // 'het_names.mod' )
+ end if
+ OPEN( unit = 30, file = TRIM( temp_path ) // 'het_names.mod' )
+
+ buff = ''
+ write(30,'(a)') buff
+ buff(7:) = 'module m_het_id'
+ write(30,'(a)') buff
+ buff = ''
+ write(30,'(a)') buff
+ buff(7:) = 'implicit none'
+ write(30,'(a)') buff
+ buff = ''
+ write(30,'(a)') buff
+
+ do i = 1,hetcnt
+ m = hetmap(i,1)
+ write(buff(7:),'(''integer, parameter :: hid_'',a,1x,''='',1x,i4)') &
+ spc_names(m)(:LEN_TRIM(spc_names(m))), i
+ write(30,'(a)') buff
+ end do
+
+ buff = ''
+ write(30,'(a)') buff
+ buff(7:) = 'end module m_het_id'
+ write(30,'(a)') buff
+ CLOSE(30)
+
+ end subroutine MAKE_HET_NAME_MOD
diff --git a/chem_proc/src/cam_chempp/hist_hdr.f b/chem_proc/src/cam_chempp/hist_hdr.f
new file mode 100644
index 0000000000..35ca4fe91d
--- /dev/null
+++ b/chem_proc/src/cam_chempp/hist_hdr.f
@@ -0,0 +1,439 @@
+
+ subroutine HIST_HDR( hst_file_cnt, &
+ histout_cnt, &
+ histout_map, &
+ user_hst_names, &
+ hist_type, &
+ dyn_hst_fld_cnt, &
+ spcsym, &
+ spccnt, &
+ hetmap, &
+ usrmap, &
+ ptplen, &
+ filename, &
+ model )
+!-----------------------------------------------------------------------
+! ... Process all output history tape controls
+!-----------------------------------------------------------------------
+
+ use MASS_DIAGS
+ use VAR_MOD, only : var_lim, hst_file_lim, class_prod_cnt, class_loss_cnt, clsmap
+ use RXT_MOD, only : rxt_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: hst_file_cnt ! number of history files
+ integer, intent(in) :: histout_cnt(20,2,hst_file_lim) ! number of outputs in each catagory
+ integer, intent(in) :: histout_map(1000,20,2,hst_file_lim) ! map of outputs
+ integer, intent(in) :: dyn_hst_fld_cnt(2)
+ integer, intent(in) :: spccnt(*) ! number of symbols in each catagory
+ integer, intent(in) :: hetmap(*) ! wet dep map
+ integer, intent(in) :: usrmap(*) ! ext frc map
+ integer, intent(out) :: ptplen ! total hist tape fields
+ character(len=64), intent(in) :: hist_type ! type of dyn hist tape ( short/long )
+ character(len=16), intent(in) :: user_hst_names(var_lim,4)
+ character(len=16), intent(in) :: spcsym(var_lim,*) ! list of symbols
+ character(len=*), intent(in) :: filename ! path/name of simulation data file
+ character(len=*), intent(in) :: model ! model name
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: inst = 1, avgr = 2
+
+ integer :: i, j, m, n, typind, id_ox = 0
+ integer :: file
+ integer :: istat
+ integer :: class, classno
+ integer :: summ(2), sums(2)
+ character(len=32) :: fld_name(4)
+ character(len=16) :: namtag(1000)
+ character(len=4) :: numa
+ character(len=4) :: oper_tag(2) = (/ 'inst', 'avrg' /)
+ character(len=3) :: num
+ logical :: lexist
+
+ CLOSE( 30 )
+ OPEN( unit = 30, &
+ file = 'hist.h', &
+ status = 'replace', &
+ iostat = istat )
+ if( istat /= 0 ) then
+ write(*,*) 'HIST_HDR: Failed to open hist.h'
+ stop
+ end if
+!-----------------------------------------------------------------------
+! ... Locate index for ox
+!-----------------------------------------------------------------------
+ do i = 1,spccnt(6)
+ if( spcsym(i,6) == 'OX' ) then
+ id_ox = i
+ exit
+ end if
+ end do
+
+ do typind = inst,avgr
+ summ(typind) = SUM( histout_cnt(:2,typind,1) ) + SUM( histout_cnt(5:6,typind,1) ) &
+ + SUM( histout_cnt(8:11,typind,1) ) + histout_cnt(13,typind,1)
+ end do
+ write(30,'(''# define PMULTI '',i3)') summ(1) + summ(2)
+ write(30,'(''# define PMULTA '',i3)') summ(2)
+ sums(1) = histout_cnt(3,inst,1) + histout_cnt(4,inst,1) + histout_cnt(7,inst,1) &
+ + histout_cnt(12,inst,1)
+ sums(2) = histout_cnt(3,avgr,1) + histout_cnt(4,avgr,1) + histout_cnt(12,avgr,1)
+ write(30,'(''# define PSINGL '',i3)') sums(1) + sums(2)
+ write(30,'(''# define PSINGLA '',i3)') sums(2)
+ ptplen = summ(1) + sums(1) + summ(2) + sums(2)
+ write(30,'(''# define PTPLEN '',i3)') ptplen
+ i = SUM( histout_cnt(:4,inst,1) ) + SUM( histout_cnt(8:13,inst,1) ) &
+ + SUM( histout_cnt(:4,avgr,1) ) + SUM( histout_cnt(8:13,avgr,1) )
+ write(30,'(''# define HSTLEN '',i3)') i
+ write(30,'(''# define HSTOFFSET '',i3)') SUM( histout_cnt(5:7,inst,1) )
+ write(30,'(''# define HSTINSCNT '',i3)') SUM( histout_cnt(:17,inst,1) )
+ write(30,'(''# define HSTINSCNTM '',i3)') &
+ SUM( histout_cnt(:4,inst,1) ) &
+ + SUM( histout_cnt(8:13,inst,1) )
+ write(30,'(''# define HSTPHTCNT '',i3)') histout_cnt(8,inst,1)
+ write(30,'(''# define HSTRXTCNT '',i3)') histout_cnt(9,inst,1)
+ write(30,'(''# define HSTPHTCNTA '',i3)') histout_cnt(8,avgr,1)
+ write(30,'(''# define HSTRXTCNTA '',i3)') histout_cnt(9,avgr,1)
+ write(30,'(''# define HSTRXTIND '',i3)') SUM( histout_cnt(:4,inst,1) )
+ write(30,'(''# define HSTUSRINDI '',i3)') SUM( histout_cnt(:4,inst,1) ) &
+ + SUM( histout_cnt(8:11,inst,1) )
+ write(30,'(''# define HSTRXTINDA '',i3)') SUM( histout_cnt(:4,inst,1) ) &
+ + SUM( histout_cnt(8:13,inst,1) ) &
+ + SUM( histout_cnt(:4,avgr,1) )
+ write(30,'(''# define HSTUSRINDA '',i3)') SUM( histout_cnt(:4,inst,1) ) &
+ + SUM( histout_cnt(8:13,inst,1) ) &
+ + SUM( histout_cnt(:11,avgr,1) )
+ write(30,'(''# define HSTAVGCNT '',i3)') SUM( histout_cnt(:17,avgr,1) )
+ write(30,'(''# define HSTXPTICNT '',i3)') histout_cnt(1,inst,1)
+ write(30,'(''# define HSTXPTACNT '',i3)') histout_cnt(1,avgr,1)
+ write(30,'(''# define HSTPCEICNT '',i3)') histout_cnt(2,inst,1)
+ write(30,'(''# define HSTPCEACNT '',i3)') histout_cnt(2,avgr,1)
+ write(30,'(''# define HSTSFLXICNT '',i3)') histout_cnt(3,inst,1)
+ write(30,'(''# define HSTSFLXACNT '',i3)') histout_cnt(3,avgr,1)
+ write(30,'(''# define HSTDVELICNT '',i3)') histout_cnt(4,inst,1)
+ write(30,'(''# define HSTDVELACNT '',i3)') histout_cnt(4,avgr,1)
+ write(30,'(''# define HSTWDEPICNT '',i3)') histout_cnt(10,inst,1)
+ write(30,'(''# define HSTWDEPACNT '',i3)') histout_cnt(10,avgr,1)
+ write(30,'(''# define HSTEXTICNT '',i3)') histout_cnt(11,inst,1)
+ write(30,'(''# define HSTEXTACNT '',i3)') histout_cnt(11,avgr,1)
+ write(30,'(''# define HSTUSRSICNT '',i3)') histout_cnt(12,inst,1)
+ write(30,'(''# define HSTUSRMICNT '',i3)') histout_cnt(13,inst,1)
+ write(30,'(''# define HSTUSRSACNT '',i3)') histout_cnt(12,avgr,1)
+ write(30,'(''# define HSTUSRMACNT '',i3)') histout_cnt(13,avgr,1)
+ write(30,'(''# define HSTPROD '',i3)') histout_cnt(14,inst,1)
+ write(30,'(''# define HSTPRODA '',i3)') histout_cnt(14,avgr,1)
+ write(30,'(''# define HSTLOSS '',i3)') histout_cnt(15,inst,1)
+ write(30,'(''# define HSTLOSSA '',i3)') histout_cnt(15,avgr,1)
+ write(30,'(''# define HSTPLCNT1 '',i3)') MAX( MAXVAL(class_prod_cnt(1,:)),MAXVAL(class_loss_cnt(1,:)) )
+ write(30,'(''# define HSTPLCNT2 '',i3)') MAX( MAXVAL(class_prod_cnt(2,:)),MAXVAL(class_loss_cnt(2,:)) )
+ write(30,'(''# define HSTPLCNT3 '',i3)') MAX( MAXVAL(class_prod_cnt(3,:)),MAXVAL(class_loss_cnt(3,:)) )
+ write(30,'(''# define HSTPLCNT4 '',i3)') MAX( MAXVAL(class_prod_cnt(4,:)),MAXVAL(class_loss_cnt(4,:)) )
+ write(30,'(''# define HSTPLCNT5 '',i3)') MAX( MAXVAL(class_prod_cnt(5,:)),MAXVAL(class_loss_cnt(5,:)) )
+ write(30,'(''# define SW_MDI_CNT '',i3)') histout_cnt(16,inst,1)
+ write(30,'(''# define SW_MDA_CNT '',i3)') histout_cnt(16,avgr,1)
+ write(30,'(''# define SW_HINST '',i5)') SUM(histout_cnt(:4,inst,1)) &
+ + SUM(histout_cnt(8:11,inst,1)) &
+ + SUM(histout_cnt(14:17,inst,1))
+ write(30,'(''# define SW_HTIMAV '',i5)') SUM(histout_cnt(:4,avgr,1)) &
+ + SUM(histout_cnt(8:11,avgr,1)) &
+ + SUM(histout_cnt(14:17,avgr,1))
+ if( SUM(histout_cnt(14,:,1)+histout_cnt(15,:,1)) /= 0 ) then
+ write(30,'(''# define HSTPRDLOSS'')')
+ end if
+ if( SUM( histout_cnt(17,:,1) ) /= 0 ) then
+ write(30,'(''# define HSTMDIAGS'')')
+ end if
+ if( id_ox /= 0 ) then
+ do i = 14,15
+ if( ANY( histout_map(:histout_cnt(i,1,1),i,1,1) == id_ox ) .or. &
+ ANY( histout_map(:histout_cnt(i,2,1),i,2,1) == id_ox ) ) then
+ if( i == 14 ) then
+ write(30,'(''# define OX_PROD '')')
+ else
+ write(30,'(''# define OX_LOSS '')')
+ end if
+ end if
+ end do
+ end if
+ if( SUM( histout_cnt(12:13,inst,1) ) + SUM( histout_cnt(12:13,avgr,1) ) /= 0 ) then
+ write(30,'(''# define HSTUSR'')')
+ end if
+
+!-----------------------------------------------------------------------
+! ... Group history output flag
+!-----------------------------------------------------------------------
+ if( (histout_cnt(2,inst,1) + histout_cnt(2,avgr,1)) /= 0 ) then
+ write(30,'(''# define GRPHST'')')
+ end if
+
+ CLOSE(30)
+
+ if( model == 'MOZART') then
+!-----------------------------------------------------------------------
+! ... Write the history output tape information
+! 1. item count by category
+! 2. xported species
+! 3. "pce" species
+! 4. surface emissions
+! 5. deposition velocities
+! 6. washout rates
+! 7. "extraneous" forcing rates
+!-----------------------------------------------------------------------
+ OPEN( unit = 30, &
+ file = TRIM(filename), &
+ status = 'old', &
+ position = 'append', &
+ iostat = istat )
+ if( istat /= 0 ) then
+ write(*,*) 'HIST_HDR: Failed to open '//TRIM(filename)
+ stop
+ end if
+ write(30,'(i4)') hst_file_cnt
+ write(30,'(10i4)') histout_cnt(:,:,:hst_file_cnt)
+ if( ptplen /= 0 ) then
+file_loop : &
+ do file = 1,hst_file_cnt
+output_type : &
+ do typind = 1,2
+ if( histout_cnt(1,typind,file) /= 0 ) then
+ fld_name(:) = ' '
+ do j = 1,histout_cnt(1,typind,file)
+ m = MOD( j-1,4 ) + 1
+ write(fld_name(m),'(a)') TRIM( spcsym(histout_map(j,1,typind,file),6) )
+ write(fld_name(m)(LEN_TRIM(fld_name(m))+1:),'(''_VMR_'',a4)') oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(1,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(1,typind,file),1,typind,file)
+ end if
+
+ if( histout_cnt(2,typind,file) /= 0 ) then
+ fld_name(:) = ' '
+ do j = 1,histout_cnt(2,typind,file)
+ m = MOD( j-1,4 ) + 1
+ write(fld_name(m),'(a)') TRIM( spcsym(histout_map(j,2,typind,file),7) )
+ write(fld_name(m)(LEN_TRIM(fld_name(m))+1:),'(''_VMR_'',a4)') oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(2,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(2,typind,file),2,typind,file)
+ end if
+
+ if( histout_cnt(3,typind,file) /= 0 ) then
+ fld_name(:) = ' '
+ do j = 1,histout_cnt(3,typind,file)
+ m = MOD( j-1,4 ) + 1
+ write(fld_name(m),'(a)') TRIM( spcsym(histout_map(j,3,typind,file),6) )
+ write(fld_name(m)(LEN_TRIM(fld_name(m))+1:),'(''_SRF_EMIS_'',a4)') oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(3,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(3,typind,file),3,typind,file)
+ end if
+
+ if( histout_cnt(4,typind,file) /= 0 ) then
+ fld_name(:) = ' '
+ do j = 1,histout_cnt(4,typind,file)
+ m = MOD( j-1,4 ) + 1
+ write(fld_name(m),'(a)') TRIM( spcsym(histout_map(j,4,typind,file),6) )
+ write(fld_name(m)(LEN_TRIM(fld_name(m))+1:),'(''_DEP_VEL_'',a4)') oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(4,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(4,typind,file),4,typind,file)
+ end if
+
+ if( histout_cnt(8,typind,file) /= 0 ) then
+ do j = 1,histout_cnt(8,typind,file)
+ m = MOD( j-1,4 ) + 1
+ write(numa,'(i4)') histout_map(j,8,typind,file) + 1000
+ fld_name(m) = 'J_' // numa(2:4) // '_' // oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(8,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(8,typind,file),8,typind,file)
+ end if
+
+ if( histout_cnt(9,typind,file) /= 0 ) then
+ do j = 1,histout_cnt(9,typind,file)
+ m = MOD( j-1,4 ) + 1
+ write(numa,'(i4)') histout_map(j,9,typind,file) + 1000
+ fld_name(m) = 'R_' // numa(2:4) // '_' // oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(9,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(9,typind,file),9,typind,file)
+ end if
+
+ if( histout_cnt(10,typind,file) /= 0 ) then
+ fld_name(:) = ' '
+ do j = 1,histout_cnt(10,typind,file)
+ m = MOD( j-1,4 ) + 1
+ i = hetmap(histout_map(j,10,typind,file))
+ write(fld_name(m),'(a)') TRIM( spcsym(i,6) )
+ write(fld_name(m)(LEN_TRIM(fld_name(m))+1:),'(''_WET_DEP_RATE_'',a4)') oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(10,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(10,typind,file),10,typind,file)
+ end if
+
+ if( histout_cnt(11,typind,file) /= 0 ) then
+ fld_name(:) = ' '
+ do j = 1,histout_cnt(11,typind,file)
+ m = MOD( j-1,4 ) + 1
+ i = usrmap(histout_map(j,11,typind,file))
+ write(fld_name(m),'(a)') TRIM( spcsym(i,6) )
+ write(fld_name(m)(LEN_TRIM(fld_name(m))+1:),'(''_EXT_FRC_'',a4)') oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(11,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(11,typind,file),11,typind,file)
+ end if
+
+ if( histout_cnt(12,typind,file) /= 0 ) then
+ do j = 1,histout_cnt(12,typind,file)
+ m = MOD( j-1,4 ) + 1
+ fld_name(m) = TRIM( user_hst_names(j,2*(typind-1)+1) ) // '_' // oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(12,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ end if
+
+ if( histout_cnt(13,typind,file) /= 0 ) then
+ do j = 1,histout_cnt(13,typind,file)
+ m = MOD( j-1,4 ) + 1
+ fld_name(m) = TRIM( user_hst_names(j,2*(typind-1)+2) ) // '_' // oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(13,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ end if
+
+ if( histout_cnt(14,typind,file) /= 0 ) then
+ fld_name(:) = ' '
+ do j = 1,histout_cnt(14,typind,file)
+ class = histout_map(j,14,typind,file)/1000
+ classno = MOD( histout_map(j,14,typind,file),1000 )
+ n = clsmap(classno,class,2)
+ m = MOD( j-1,4 ) + 1
+ write(fld_name(m),'(a)') TRIM( spcsym(n,6) )
+ write(fld_name(m)(LEN_TRIM(fld_name(m))+1:),'(''_PROD_'',a4)') oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(14,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(14,typind,file),14,typind,file)
+ end if
+
+ if( histout_cnt(15,typind,file) /= 0 ) then
+ fld_name(:) = ' '
+ do j = 1,histout_cnt(15,typind,file)
+ class = histout_map(j,15,typind,file)/1000
+ classno = MOD( histout_map(j,15,typind,file),1000 )
+ n = clsmap(classno,class,2)
+ m = MOD( j-1,4 ) + 1
+ write(fld_name(m),'(a)') TRIM( spcsym(n,6) )
+ write(fld_name(m)(LEN_TRIM(fld_name(m))+1:),'(''_LOSS_'',a4)') oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(15,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(15,typind,file),15,typind,file)
+ end if
+
+ if( histout_cnt(16,typind,file) /= 0 ) then
+ do j = 1,histout_cnt(16,typind,file),8
+ fld_name(:) = ' '
+ do i = 1,4
+ select case (i)
+ case( 1 )
+ write(fld_name(i),'(a)') TRIM( spcsym(histout_map(j,16,typind,file),6) )
+ write(fld_name(i)(LEN_TRIM(fld_name(i))+1:),'(''_ADV_'',a4)') oper_tag(typind)
+ case( 2 )
+ write(fld_name(i),'(a)') TRIM( spcsym(histout_map(j,16,typind,file),6) )
+ write(fld_name(i)(LEN_TRIM(fld_name(i))+1:),'(''_DPS_'',a4)') oper_tag(typind)
+ case( 3 )
+ write(fld_name(i),'(a)') TRIM( spcsym(histout_map(j,16,typind,file),6) )
+ write(fld_name(i)(LEN_TRIM(fld_name(i))+1:),'(''_CNV_'',a4)') oper_tag(typind)
+ case( 4 )
+ write(fld_name(i),'(a)') TRIM( spcsym(histout_map(j,16,typind,file),6) )
+ write(fld_name(i)(LEN_TRIM(fld_name(i))+1:),'(''_DIF_'',a4)') oper_tag(typind)
+ write(30,'(4a32)') fld_name(:)
+ end select
+ end do
+ fld_name(:) = ' '
+ do i = 1,4
+ select case (i)
+ case( 1 )
+ write(fld_name(i),'(a)') TRIM( spcsym(histout_map(j,16,typind,file),6) )
+ write(fld_name(i)(LEN_TRIM(fld_name(i))+1:),'(''_CHM_'',a4)') oper_tag(typind)
+ case( 2 )
+ write(fld_name(i),'(a)') TRIM( spcsym(histout_map(j,16,typind,file),6) )
+ write(fld_name(i)(LEN_TRIM(fld_name(i))+1:),'(''_XFLX_'',a4)') oper_tag(typind)
+ case( 3 )
+ write(fld_name(i),'(a)') TRIM( spcsym(histout_map(j,16,typind,file),6) )
+ write(fld_name(i)(LEN_TRIM(fld_name(i))+1:),'(''_YFLX_'',a4)') oper_tag(typind)
+ case( 4 )
+ write(fld_name(i),'(a)') TRIM( spcsym(histout_map(j,16,typind,file),6) )
+ write(fld_name(i)(LEN_TRIM(fld_name(i))+1:),'(''_ZFLX_'',a4)') oper_tag(typind)
+ write(30,'(4a32)') fld_name(:)
+ end select
+ end do
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(16,typind,file),16,typind,file)
+ end if
+
+ if( histout_cnt(17,typind,file) /= 0 ) then
+ fld_name(:) = ' '
+ do j = 1,histout_cnt(17,typind,file)
+ m = MOD( j-1,4 ) + 1
+ write(fld_name(m),'(a)') TRIM( spcsym(histout_map(j,17,typind,file),6) )
+ write(fld_name(m)(LEN_TRIM(fld_name(m))+1:),'(''_DRY_DEP_FLX_'',a4)') oper_tag(typind)
+ if( m == 4 .or. j == histout_cnt(17,typind,file) ) then
+ write(30,'(4a32)') fld_name(:m)
+ fld_name(:) = ' '
+ end if
+ end do
+ write(30,'(20i4)') histout_map(:histout_cnt(17,typind,file),17,typind,file)
+ end if
+ end do output_type
+ end do file_loop
+ end if
+!-----------------------------------------------------------------------
+! ... Write out the diagnostics
+!-----------------------------------------------------------------------
+ call MASS_DIAGS_SERIALIZE( 30 )
+
+ CLOSE(30)
+
+ end if
+
+ end subroutine HIST_HDR
diff --git a/chem_proc/src/cam_chempp/hist_inp.f b/chem_proc/src/cam_chempp/hist_inp.f
new file mode 100644
index 0000000000..1708ed1e17
--- /dev/null
+++ b/chem_proc/src/cam_chempp/hist_inp.f
@@ -0,0 +1,127 @@
+ subroutine HIST_INP( lin, &
+ lout, &
+ histinp, &
+ dyn_hst_fld_cnt )
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: lin
+ integer, intent(in) :: lout
+ integer, intent(out) :: dyn_hst_fld_cnt(2)
+ character(len=64), intent(out) :: histinp(4) ! hist tape inputs
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: kpar, nchar, k
+ integer :: retcod, slen
+ integer :: parsw(6)
+ real :: time
+ character(len=80) :: buff
+ character(len=80) :: buffh
+ character(len=20) :: parkey(6), keywrd
+ logical :: found
+
+ integer :: LENOF
+
+ parkey(1) = 'DYNAMICSMSSFILE'
+ parkey(2) = 'STARTTIME'
+ parkey(3) = 'ICMSSFILE'
+ parkey(4) = 'DYNHISTTAPE'
+ parkey(5) = 'MULTILEVELFIELDS'
+ parkey(6) = 'SINGLELEVELFIELDS'
+
+ parsw = 0
+ dyn_hst_fld_cnt = -1
+
+!-----------------------------------------------------------------------
+! ... Scan for valid option keyword
+!-----------------------------------------------------------------------
+ do
+ call CARDIN( lin, buff, nchar )
+ buffh = buff
+ call UPCASE ( buffh )
+ if( buffh == 'ENDINPUTS' ) then
+ if( dyn_hst_fld_cnt(1) == -1 .and. dyn_hst_fld_cnt(2) == -1 ) then
+ if( histinp(4) == 'LONG' ) then
+ dyn_hst_fld_cnt(1) = 57
+ dyn_hst_fld_cnt(2) = 44
+ else if( histinp(4) == 'SHORT' ) then
+ dyn_hst_fld_cnt(1) = 10
+ dyn_hst_fld_cnt(2) = 4
+ end if
+ end if
+ exit
+ end if
+ k = INDEX( buffh(:nchar), '=' )
+ if( k /= 0 ) then
+ keywrd = buffh(:k-1)
+ found = .false.
+ do kpar = 1,6
+ if( keywrd == parkey(kpar) ) then
+ found = .true.
+ exit
+ end if
+ end do
+ if( .not. found ) then
+ call ERRMES ( ' # is an invalid job control' &
+ // ' parameter keyword@', &
+ lout, &
+ keywrd, &
+ LENOF(20,keywrd), &
+ buffh )
+ end if
+ else
+!-----------------------------------------------------------------------
+! ... Invalid parameter keyword; terminate the program
+!-----------------------------------------------------------------------
+ call ERRMES ( ' Job ctl specification has no = operator@', &
+ lout, buff, 1, buff )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Valid parameter keyword; now check for duplicate keyword
+!-----------------------------------------------------------------------
+ if( parsw(kpar) /= 0 ) then
+ call ERRMES( '0 *** # has already been specified@', &
+ lout, parkey(kpar), k, ' ' )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Set individual options
+!-----------------------------------------------------------------------
+ if( kpar == 2 ) then
+ call TIMCON( buff(k+1:nchar), time, lout )
+ histinp(2) = buff(k+1:nchar)
+ else if( kpar == 4 ) then
+ histinp(4) = buffh(k+1:nchar)
+ else if( kpar == 5 ) then
+ slen = LEN_TRIM( buff(k+1:nchar) )
+ call INTCON( buff(k+1:nchar), slen, dyn_hst_fld_cnt(1), retcod )
+ if( retcod /= 0 .or. dyn_hst_fld_cnt(1) < 0 ) then
+ call ERRMES ( ' # is an invalid Dyn hst tape field count@', &
+ lout, &
+ buff(k+1:nchar), &
+ slen, &
+ buffh )
+ end if
+ else if( kpar == 6 ) then
+ slen = LEN_TRIM( buff(k+1:nchar) )
+ call INTCON( buff(k+1:nchar), slen, dyn_hst_fld_cnt(2), retcod )
+ if( retcod /= 0 .or. dyn_hst_fld_cnt(2) < 0 ) then
+ call ERRMES ( ' Dyn hst tape has invalid field count@', &
+ lout, &
+ buff(k+1:nchar), &
+ slen, &
+ buffh )
+ end if
+ else
+ histinp(kpar) = buff(k+1:nchar)
+ end if
+ parsw(kpar) = 1
+ end do
+
+ end subroutine HIST_INP
diff --git a/chem_proc/src/cam_chempp/hist_out.f b/chem_proc/src/cam_chempp/hist_out.f
new file mode 100644
index 0000000000..890d97464c
--- /dev/null
+++ b/chem_proc/src/cam_chempp/hist_out.f
@@ -0,0 +1,507 @@
+
+ module mo_hist_out
+
+ private
+ public :: hist_out
+
+ contains
+
+ subroutine hist_out( histout, longnames, hst_file_cnt )
+!-----------------------------------------------------------------------
+! ... Process all output history file controls
+!-----------------------------------------------------------------------
+
+ use io
+ use var_mod, only : indexh2o, srf_flx_cnt, dvel_cnt, spccnt, &
+ histout_cnt, histout_map, user_hst_names, &
+ spcsym, class_prod_cnt, class_loss_cnt, &
+ clscnt, clsmap, hst_map_lim
+ use rxt_mod, only : hetcnt, hetmap, usrcnt, usrmap, gascnt, phtcnt
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(out) :: hst_file_cnt ! count of history files
+ character (len=64), intent(inout) :: histout(6) ! hist tape outputs
+ logical, intent(inout) :: longnames
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: maxparms = 26
+ integer, parameter :: inst = 1, avgr = 2
+ integer, parameter :: singl = 1, multi = 2
+ integer, parameter :: symlen = 8
+
+ integer :: class, kpar, nchar, k, kkk, j, khold, m
+ integer :: time_ind, level_ind
+ integer :: fileno = 1
+ integer :: retcod
+ integer :: kindex
+ integer :: tokcnt, cnt
+ integer :: parsw(maxparms,2)
+ integer :: toklen(20)
+ integer :: wrk(hst_map_lim)
+ real :: time
+ character (len=23) :: parkeyend(maxparms)
+ character (len=20) :: parkey(maxparms), keywrd
+ character (len=16) :: tokens(20)
+ character (len=16) :: temp
+ logical :: found, doing_file
+
+!-----------------------------------------------------------------------
+! ... Function declarations
+!-----------------------------------------------------------------------
+ integer :: lenof
+ integer :: inclist
+ integer :: inilist
+ integer :: xlate
+
+ parkey(1) = 'RETENTIONTIME'
+ parkey(2) = 'WRITEFREQUENCY'
+ parkey(3) = 'STARTFILENUMBER'
+ parkey(4) = 'DENSITY'
+ parkey(5) = 'PASSWORD'
+
+ parkey(6) = 'TRANSPORTEDSPECIES'
+ parkey(7) = 'GROUPMEMBERS'
+ parkey(8) = 'SURFACEFLUX'
+ parkey(9) = 'DEPOSITIONVELOCITY'
+ parkey(10) = 'TEMPERATURE'
+ parkey(11) = 'WATERVAPOR'
+ parkey(12) = 'SURFACEPRESSURE'
+ parkey(13) = 'PHOTORATES'
+ parkey(14) = 'REACTIONRATES'
+ parkey(15) = 'WASHOUTRATES'
+ parkey(16) = 'EXTERNALFORCING'
+
+ parkey(17) = 'DEFAULTOUTPUTS'
+ parkey(18) = 'USERDEFINED'
+ parkey(19) = 'PRODUCTION'
+ parkey(20) = 'LOSS'
+ parkey(21) = 'MASSDIAGS'
+ parkey(22) = 'DEPOSITIONFLUX'
+ parkey(23) = 'WASHOUTFLUX'
+ parkey(24) = 'LIFETIME'
+ parkey(25) = 'PRINTFREQUENCY'
+ parkey(26) = 'LONGNAMES'
+
+ parkeyend(6) = 'ENDTRANSPORTEDSPECIES'
+ parkeyend(7) = 'ENDGROUPMEMBERS'
+ parkeyend(8) = 'ENDSURFACEFLUX'
+ parkeyend(9) = 'ENDDEPOSITIONVELOCITY'
+ parkeyend(10) = 'ENDTEMPERATURE'
+ parkeyend(11) = 'ENDWATERVAPOR'
+ parkeyend(12) = 'ENDSURFACEPRESSURE'
+ parkeyend(13) = 'ENDPHOTORATES'
+ parkeyend(14) = 'ENDREACTIONRATES'
+ parkeyend(15) = 'ENDWASHOUTRATES'
+ parkeyend(16) = 'ENDEXTERNALFORCING'
+
+ parkeyend(17) = 'ENDDEFAULTOUTPUTS'
+ parkeyend(18) = 'ENDUSERDEFINED'
+ parkeyend(19) = 'ENDPRODUCTION'
+ parkeyend(20) = 'ENDLOSS'
+ parkeyend(21) = 'ENDMASSDIAGS'
+ parkeyend(22) = 'ENDDEPOSITIONFLUX'
+ parkeyend(23) = 'ENDWASHOUTFLUX'
+ parkeyend(24) = 'ENDLIFETIME'
+
+ parsw(:,:) = 0
+ histout_cnt(:,:,:) = 0
+
+!-----------------------------------------------------------------------
+! ... Check for intial file header
+!-----------------------------------------------------------------------
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase ( buffh )
+ if( buffh /= 'FILE' ) then
+ call errmes( ' FILE keyword must follow OUTPUTS keyword@', &
+ lout, &
+ buff, &
+ nchar, &
+ buff )
+ end if
+!-----------------------------------------------------------------------
+! ... Scan for valid option keyword
+!-----------------------------------------------------------------------
+ doing_file = .true.
+read_loop : &
+ do
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase ( buffh )
+ if( buffh == 'FILE' ) then
+ if( doing_file ) then
+ call errmes( ' ENDFILE must follow FILE keyword@', &
+ lout, buff, nchar, buff )
+ end if
+ if( fileno >= 10 ) then
+ call errmes( ' Only 10 output files allowed@', &
+ lout, buff, nchar, buff )
+ end if
+ fileno = fileno + 1
+ doing_file = .true.
+ parsw(:,:) = 0
+ cycle read_loop
+ else if( buffh == 'ENDFILE' ) then
+!-----------------------------------------------------------------------
+! ... Recast mass diags into individual deltas and fluxes
+! Note : only allow for 25 diagnostics
+!-----------------------------------------------------------------------
+ if( .not. doing_file ) then
+ call errmes( ' ENDFILE not preceeded by FILE keyword@', &
+ lout, buff, nchar, buff )
+ end if
+ do time_ind = inst,avgr
+ if( histout_cnt(16,time_ind,fileno) /= 0 ) then
+ k = min( histout_cnt(16,time_ind,fileno),25 )
+ j = 8*k
+ histout_cnt(16,time_ind,fileno) = j
+ wrk(:k) = histout_map(:k,16,time_ind,fileno)
+ do j = 1,k
+ histout_map(8*(j-1)+1:8*j,16,time_ind,fileno) = wrk(j)
+ end do
+ end if
+ end do
+ doing_file = .false.
+ cycle read_loop
+ else if( buffh == 'ENDOUTPUTS' ) then
+ if( doing_file ) then
+ call errmes( ' ENDFILE must follow FILE keyword@', &
+ lout, buff, nchar, buff )
+ end if
+ hst_file_cnt = fileno
+ exit
+ end if
+ k = index( buffh(:nchar), '=' )
+ if( k /= 0 ) then
+ keywrd = buffh(:k-1)
+ else
+ keywrd = buffh(:nchar)
+ end if
+ found = .false.
+ do kpar = 1,maxparms
+ if( keywrd == parkey(kpar) ) then
+ found = .true.
+ exit
+ end if
+ end do
+ if( .not. found ) then
+!-----------------------------------------------------------------------
+! ... Invalid parameter keyword; terminate the program
+!-----------------------------------------------------------------------
+ call errmes ( ' # is an invalid job control parameter keyword@', &
+ lout, keywrd, lenof(20,keywrd), buffh )
+ end if
+!-----------------------------------------------------------------------
+! ... Check for instantaneous or averaged qualifier
+!-----------------------------------------------------------------------
+output_type_qualifier : &
+ if( kpar > 5 .and. kpar < maxparms-1 ) then
+assignment_test : &
+ if( k /= 0 ) then
+ if( kpar == 18 ) then
+ j = index( buffh(:nchar), ',' )
+ if( j == 0 ) then
+ j = nchar
+ else
+ j = j - 1
+ end if
+ else
+ j = nchar
+ end if
+ if( buffh(k+1:j) == 'INST' ) then
+ time_ind = inst
+ else if( buffh(k+1:j) == 'AVRG' ) then
+ time_ind = avgr
+ else
+ call errmes( '0 *** # is invalid time qualifier@', &
+ lout, buff(k+1:j), j-k, buff )
+ end if
+ if( kpar == 18 ) then
+ k = index( buffh(:nchar), ',' )
+ if( k /= 0 ) then
+ if( buffh(k+1:nchar) == 'SINGLE' ) then
+ level_ind = singl
+ else if( buffh(k+1:nchar) == 'MULTI' ) then
+ level_ind = multi
+ else
+ call errmes( '0 *** # is invalid level qualifier@', &
+ lout, buff(k+1:), nchar-k, buff )
+ end if
+ else
+ level_ind = multi
+ end if
+ end if
+ else
+ if( kpar == 18 ) then
+ call errmes( ' User defined type must have time qualifier@', &
+ lout, buff, nchar, buff )
+ end if
+ time_ind = inst
+ end if assignment_test
+ else
+ time_ind = inst
+ end if output_type_qualifier
+!-----------------------------------------------------------------------
+! ... Valid parameter keyword; now check for duplicate keyword
+!-----------------------------------------------------------------------
+ if( kpar == 18 ) then
+ if( parsw(kpar,time_ind) == level_ind ) then
+ call errmes( '0 *** # has already been specified@', &
+ lout, parkey(kpar), k, ' ' )
+ end if
+ parsw(kpar,time_ind) = level_ind
+ else
+ if( parsw(kpar,time_ind) /= 0 ) then
+ call errmes( '0 *** # has already been specified@', &
+ lout, parkey(kpar), k, ' ' )
+ end if
+ parsw(kpar,time_ind) = 1
+ end if
+
+!-----------------------------------------------------------------------
+! ... Set individual options
+!-----------------------------------------------------------------------
+ if( kpar >= 6 ) then
+output_variables : &
+ select case( kpar )
+ case( 17 )
+!-----------------------------------------------------------------------
+! ... The "default" option
+!-----------------------------------------------------------------------
+ histout_cnt(1:20,time_ind,fileno) = 0
+ histout_cnt(1,time_ind,fileno) = spccnt(6)
+ histout_cnt(2,time_ind,fileno) = spccnt(7)
+ histout_cnt(3,time_ind,fileno) = spccnt(6)
+ histout_cnt(4,time_ind,fileno) = spccnt(6)
+ if( time_ind == inst ) then
+ histout_cnt(5,inst,fileno) = 1
+ if( indexh2o /= 0 ) then
+ histout_cnt(6,inst,fileno) = 1
+ end if
+ histout_cnt(7,inst,fileno) = 1
+ end if
+ do k = 1,spccnt(6)
+ histout_map(k,1,time_ind,fileno) = k
+ histout_map(k,3,time_ind,fileno) = k
+ histout_map(k,4,time_ind,fileno) = k
+ end do
+ do k = 1,spccnt(7)
+ histout_map(k,2,time_ind,fileno) = k
+ end do
+ case(maxparms-1)
+!-----------------------------------------------------------------------
+! ... The printout frequency option
+!-----------------------------------------------------------------------
+ call timcon( buff(k+1:nchar), &
+ time, &
+ lout )
+ histout(6) = buff(k+1:nchar)
+ case( maxparms )
+!-----------------------------------------------------------------------
+! ... The longnames flag
+!-----------------------------------------------------------------------
+ longnames = .true.
+ case( 10:12 )
+!-----------------------------------------------------------------------
+! ... The temp, water vapor, and surf press options
+!-----------------------------------------------------------------------
+ if( time_ind == inst ) then
+ histout_cnt(kpar-5,inst,fileno) = 1
+ end if
+ case default
+!-----------------------------------------------------------------------
+! ... All other options
+!-----------------------------------------------------------------------
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ khold = kpar
+ do
+ if( buffh == parkeyend(khold) ) then
+ exit
+ end if
+ kpar = khold
+ call GETTOKENS( buff, &
+ nchar, &
+ ',', &
+ symlen, &
+ tokens, &
+ toklen, &
+ 20, &
+ tokcnt )
+ if( tokcnt == 0 ) then
+ call errmes( ' Hist tape output list in error@', &
+ lout, &
+ buff, &
+ 1, &
+ buff )
+ end if
+ if( kpar == 18 ) then
+ if( histout_cnt(11+level_ind,time_ind,fileno) + tokcnt > hst_map_lim ) then
+ call errmes( ' Hist tape output list > hst_map_lim elements@', &
+ lout, &
+ buff, &
+ 1, &
+ buff )
+ end if
+ else if( histout_cnt(kpar-5,time_ind,fileno) + tokcnt > hst_map_lim ) then
+ call errmes( ' Hist tape output list > hst_map_lim elements@', &
+ lout, &
+ buff, &
+ 1, &
+ buff )
+ end if
+ if( kpar == 18 ) then
+ do j = 1,tokcnt
+ cnt = histout_cnt(11+level_ind,time_ind,fileno) + 1
+ histout_cnt(11+level_ind,time_ind,fileno) = cnt
+ user_hst_names(cnt,2*(time_ind-1)+level_ind) = tokens(j)
+ end do
+ else if( kpar <= 9 .or. kpar >= 13 ) then
+ temp = tokens(1)
+ if( kpar /= 7 ) then
+ kindex = 6
+ else
+ kindex = 7
+ end if
+ kpar = kpar - 5
+ call upcase( temp )
+!-----------------------------------------------------------------------
+! ... Handle the "all" list specifier
+!-----------------------------------------------------------------------
+ if( tokcnt == 1 .and. temp == 'ALL' ) then
+ if( kpar <= 4 ) then
+ do j = 1,spccnt(kindex)
+ histout_map(j,kpar,time_ind,fileno) = j
+ end do
+ histout_cnt(kpar,time_ind,fileno) = spccnt(kindex)
+ else if( kpar >= 8 ) then
+ select case( kpar )
+ case( 8 )
+ do j = 1,phtcnt
+ histout_map(j,kpar,time_ind,fileno) = j
+ end do
+ histout_cnt(kpar,time_ind,fileno) = phtcnt
+ case( 9 )
+ do j = 1,gascnt
+ histout_map(j,kpar,time_ind,fileno) = j
+ end do
+ histout_cnt(kpar,time_ind,fileno) = gascnt
+ case( 10 )
+ do j = 1,hetcnt
+ histout_map(j,kpar,time_ind,fileno) = j
+ end do
+ histout_cnt(kpar,time_ind,fileno) = hetcnt
+ case( 11 )
+ do j = 1,usrcnt
+ histout_map(j,kpar,time_ind,fileno) = j
+ end do
+ histout_cnt(kpar,time_ind,fileno) = usrcnt
+ end select
+ end if
+!-----------------------------------------------------------------------
+! ... Handle individual list elements
+!-----------------------------------------------------------------------
+ else
+ do j = 1,tokcnt
+ if( kpar == 8 .or. kpar == 9 ) then
+ call intcon( tokens(j), & ! input string to convert
+ toklen(j), & ! length of input string
+ k, & ! surrogate for converted number
+ retcod ) ! return code
+ if( retcod /= 0 ) then
+ call errmes( ' # is not a valid integer@', &
+ lout, tokens(j), toklen(j), buff )
+ end if
+ if( kpar == 8 .and. k > phtcnt) then
+ call errmes( ' # out of photolysis rate numbering@', &
+ lout, tokens(j), toklen(j), buff )
+ else if( k > gascnt ) then
+ call errmes( ' # out of reaction rate numbering@', &
+ lout, tokens(j), toklen(j), buff )
+ end if
+ histout_cnt(kpar,time_ind,fileno) = histout_cnt(kpar,time_ind,fileno) + 1
+ histout_map(histout_cnt(kpar,time_ind,fileno),kpar,time_ind,fileno) = k
+ else
+ class = 0
+ k = inclist( tokens(j), &
+ spcsym(1,kindex), &
+ spccnt(kindex) )
+ if( k == 0 ) then
+ call errmes( '# not in list@', &
+ lout, &
+ tokens(j), &
+ toklen(j), &
+ buff )
+ end if
+ if( kpar >= 10 ) then
+ if( kpar == 10 ) then
+ k = inilist( k, hetmap, hetcnt )
+ else if( kpar == 11 ) then
+ k = inilist( k, usrmap, usrcnt )
+ else if( kpar == 18 ) then
+ class = inilist( k, hetmap, hetcnt )
+ end if
+ if( k == 0 ) then
+ call errmes( '# not in list@', &
+ lout, &
+ tokens(j), &
+ toklen(j), &
+ buff )
+ end if
+ if( kpar == 14 .or. kpar == 15 .or. kpar == 19 ) then
+ kkk = k
+ class = xlate( kkk )
+ do m = 1,clscnt(class)
+ if( clsmap(m,class,2) == k ) then
+ exit
+ end if
+ end do
+ k = m
+ if( class /= 0 ) then
+ if( kpar == 14 ) then
+ class_prod_cnt(class,time_ind) = class_prod_cnt(class,time_ind) + 1
+ else if( kpar == 15 ) then
+ class_loss_cnt(class,time_ind) = class_loss_cnt(class,time_ind) + 1
+ end if
+ end if
+ end if
+ end if
+ histout_cnt(kpar,time_ind,fileno) = histout_cnt(kpar,time_ind,fileno) + 1
+ histout_map(histout_cnt(kpar,time_ind,fileno),kpar,time_ind,fileno) = 1000*class + k
+ end if
+ end do
+ end if
+ end if
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ end do
+ end select output_variables
+ else if( kpar <= 2 ) then
+ call timcon( buff(k+1:nchar), time, lout )
+ histout(kpar) = buff(k+1:nchar)
+ else if( kpar == 3 ) then
+ call intcon( buff(k+1:nchar), & ! input string to convert
+ nchar - k, & ! length of input string
+ toklen(1), & ! surrogate for converted number
+ toklen(2) ) ! surrogate for error code
+ if( toklen(2) /= 0 ) then
+ call errmes( ' # is not a valid integer@', &
+ lout, buff(k+1:nchar), nchar - k, buff )
+ end if
+ histout(kpar) = buff(k+1:nchar)
+ else
+ histout(kpar) = buff(k+1:nchar)
+ end if
+ end do read_loop
+
+ end subroutine hist_out
+
+ end module mo_hist_out
diff --git a/chem_proc/src/cam_chempp/ipd_code.f b/chem_proc/src/cam_chempp/ipd_code.f
new file mode 100644
index 0000000000..338925cabf
--- /dev/null
+++ b/chem_proc/src/cam_chempp/ipd_code.f
@@ -0,0 +1,518 @@
+
+ module ind_prod
+
+ use io, only : temp_path
+
+ contains
+
+ subroutine ipd_code( spccnt, &
+ clscnt, &
+ clsmap, &
+ cls_rxt_cnt, &
+ extcnt, &
+ cls_rxt_map, &
+ pcoeff_ind, &
+ pcoeff, &
+ permute, &
+ model, &
+ march )
+
+ use var_mod, only : var_lim
+ use rxt_mod, only : rxt_lim, prd_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: spccnt
+ integer, intent(in) :: clscnt(5), &
+ extcnt(5), &
+ clsmap(var_lim,5,2), &
+ cls_rxt_map(rxt_lim,prd_lim+3,5), &
+ cls_rxt_cnt(4,5)
+ integer, intent(in) :: permute(var_lim,5)
+ integer, intent(in) :: pcoeff_ind(*)
+ real, intent(in) :: pcoeff(prd_lim,*)
+ character(len=*), intent(in) :: model
+ character(len=*), intent(in) :: march
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: max_len = 90
+ integer :: i, k, kl, ku, l, m, n, prdndx
+ integer :: length, index
+ integer :: line_pos, cnt
+ integer :: class
+ integer :: base
+ integer :: species
+ integer :: match_cnt
+ integer :: max_loc(1)
+ integer :: match_ind(4)
+ integer :: freq(spccnt)
+ integer, allocatable :: indexer(:)
+ real :: rate
+ character(len=max_len) :: line
+ character(len=max_len) :: buff
+ character(len=4) :: num_suffix
+ character(len=4) :: dec_suffix
+ character(len=3) :: num
+ logical :: beg_line
+ logical :: lexist, first, indprds
+ logical :: first_class = .true.
+ logical :: is_vector
+ logical, allocatable, dimension(:,:) :: match_mask, pmask
+
+ inquire( file = trim( temp_path ) // 'indprd.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'indprd.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'indprd.F' )
+
+ if( model == 'CAM' ) then
+ num_suffix = '_r8'
+ dec_suffix = '(r8)'
+ else
+ num_suffix = ' '
+ dec_suffix = ' '
+ end if
+
+ is_vector = march == 'VECTOR'
+
+ line = ' '
+ write(30,100) trim(line)
+ line = ' module mo_indprd'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( model == 'CAM' ) then
+ line = ' use shr_kind_mod, only : r8 => shr_kind_r8'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ end if
+ line = ' private'
+ write(30,100) trim(line)
+ line = ' public :: indprd'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' contains'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( model /= 'CAM' ) then
+ line = ' subroutine indprd( class, prod, y, extfrc, rxt )'
+ else
+ if( .not. is_vector ) then
+ line = ' subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol )'
+ else
+ line = ' subroutine indprd( class, prod, nprod, y, extfrc, rxt, chnkpnts )'
+! line = ' subroutine indprd( class, prod, y, extfrc, rxt )'
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' use chem_mods, only : gas_pcnst, extcnt, rxntot'
+ if( .not. is_vector ) then
+ write(30,100) trim(line)
+ line = ' use ppgrid, only : pver'
+ end if
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' implicit none '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... dummy arguments'
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = ' integer, intent(in) :: class'
+ write(30,100) trim(line)
+ if( model /= 'CAM' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(:,:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(:,:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: extfrc(:,:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(inout) :: prod(:,:)'
+ write(30,100) trim(line)
+ else
+ if( .not. is_vector ) then
+ line = ' integer, intent(in) :: ncol'
+ write(30,100) trim(line)
+ line = ' integer, intent(in) :: nprod'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(ncol,pver,gas_pcnst)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(ncol,pver,rxntot)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: extfrc(ncol,pver,extcnt)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(inout) :: prod(ncol,pver,nprod)'
+ write(30,100) trim(line)
+ else
+ line = ' integer, intent(in) :: chnkpnts'
+ write(30,100) trim(line)
+ line = ' integer, intent(in) :: nprod'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(chnkpnts,gas_pcnst)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(chnkpnts,rxntot)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: extfrc(chnkpnts,extcnt)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(inout) :: prod(chnkpnts,nprod)'
+ write(30,100) trim(line)
+! line = ' real' // trim(dec_suffix) // ', intent(in) :: y(:,:)'
+! write(30,100) trim(line)
+! line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(:,:)'
+! write(30,100) trim(line)
+! line = ' real' // trim(dec_suffix) // ', intent(in) :: extfrc(:,:)'
+! write(30,100) trim(line)
+! line = ' real' // trim(dec_suffix) // ', intent(inout) :: prod(:,:)'
+! write(30,100) trim(line)
+ end if
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ line = ' '
+
+Class_loop : &
+ do class = 1,5
+ if( clscnt(class) /= 0 ) then
+ if( allocated( match_mask ) ) then
+ deallocate( match_mask )
+ end if
+ if( allocated( pmask ) ) then
+ deallocate( pmask )
+ end if
+ if( allocated( indexer ) ) then
+ deallocate( indexer )
+ end if
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... "independent" production for'
+ length = len_trim( line ) + 2
+ if( class == 1 ) then
+ line(length:) = 'Explicit species'
+ else if( class == 2 ) then
+ line(length:) = 'Ebi species'
+ else if( class == 3 ) then
+ line(length:) = 'Hov species'
+ else if( class == 4 ) then
+ line(length:) = 'Implicit species'
+ else if( class == 5 ) then
+ line(length:) = 'Rodas species'
+ end if
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ if( first_class ) then
+ line = ' if( class =='
+ first_class = .false.
+ else
+ line = ' else if( class =='
+ end if
+ write(line(len_trim(line)+2:),'(i1)') class
+ line(len_trim(line)+2:) = ') then'
+ write(30,100) trim(line)
+100 format(a)
+ ku = MAX( cls_rxt_cnt(1,class),extcnt(class) )
+ if( ku == 0 ) then
+ do species = 1,clscnt(class)
+ write(num,'(i3)') species
+ num = adjustl( num )
+ line = ' '
+ if( model /= 'CAM' ) then
+ line(10:) = 'prod(:,' // num(:len_trim(num)) // ') = 0.'
+ else
+ if( .not. is_vector ) then
+ line(10:) = 'prod(:,:,' // num(:len_trim(num)) // ') = 0._r8'
+ else
+ line(10:) = 'prod(:,' // num(:len_trim(num)) // ') = 0._r8'
+ end if
+ end if
+ write(30,100) trim(line)
+ end do
+ cycle Class_loop
+ end if
+ kl = 1
+ allocate( match_mask(ku,3) )
+ allocate( indexer(ku) )
+ allocate( pmask(ku,prd_lim) )
+
+Species_loop : &
+ do species = 1,clscnt(class)
+ line = ' '
+ write(num,'(i3)') permute(species,class)
+ num = adjustl( num )
+ if( model /= 'CAM' ) then
+ line(10:) = 'prod(:,' // num(:len_trim(num)) // ') = '
+ else
+ if( .not. is_vector ) then
+ line(10:) = 'prod(:,:,' // num(:len_trim(num)) // ') = '
+ else
+ line(10:) = 'prod(:,' // num(:len_trim(num)) // ') = '
+ end if
+ end if
+ ku = cls_rxt_cnt(1,class)
+!-----------------------------------------------------------------------
+! ...Write code for "independent" production processes
+!-----------------------------------------------------------------------
+ do k = kl,ku
+ pmask(k,:) = cls_rxt_map(k,4:prd_lim+3,class) == species
+ match_mask(k,1) = any( pmask(k,:) )
+ end do
+!-----------------------------------------------------------------------
+! ... No species products
+!-----------------------------------------------------------------------
+ if( count( match_mask(kl:ku,1) ) /= 0 ) then
+ indprds = .true.
+ first = .true.
+ do
+ do m = 1,spccnt
+ match_mask(kl:ku,3) = (abs(cls_rxt_map(kl:ku,2,class)) == m .or. &
+ abs(cls_rxt_map(kl:ku,3,class)) == m) .and.&
+ match_mask(kl:ku,1)
+ freq(m) = count( match_mask(kl:ku,3) )
+ end do
+ max_loc = maxloc( freq(:spccnt) )
+ cnt = maxvaL( freq(:spccnt) )
+ if( cnt /= 0 ) then
+ match_mask(kl:ku,3) = (abs(cls_rxt_map(kl:ku,2,class)) == max_loc(1) .or. &
+ abs(cls_rxt_map(kl:ku,3,class)) == max_loc(1)) .and. &
+ match_mask(kl:ku,1)
+ do k = kl,ku
+ if( match_mask(k,3) ) then
+ if( abs( cls_rxt_map(k,2,class) ) == max_loc(1) ) then
+ indexer(k) = 3
+ else
+ indexer(k) = 2
+ end if
+ end if
+ end do
+ else
+ match_mask(kl:ku,3) = match_mask(kl:ku,1)
+ indexer(kl:ku) = 0
+ cnt = count( match_mask(kl:ku,3) )
+ end if
+ if( cnt > 1 ) then
+ if( first ) then
+ buff = ' ('
+ else
+ buff = ' + ('
+ end if
+ else if( first ) then
+ buff = ' '
+ else
+ buff = ' +'
+ end if
+ if( first ) then
+ first = .false.
+ end if
+ m = cnt
+ do k = kl,ku
+ if( match_mask(k,3) ) then
+ index = pcoeff_ind(cls_rxt_map(k,1,class))
+ if( index == 0 ) then
+ rate = 1.
+ else
+ rate = 0.
+ do prdndx = 1,prd_lim
+ if( pmask(k,prdndx) ) then
+ rate = rate + pcoeff(prdndx,index)
+ end if
+ end do
+ end if
+ if( rate /= 0. .and. rate /= 1. ) then
+ call r2c( buff(len_trim(buff)+1:), rate, 'l' )
+ buff(len_trim( buff )+1:) = trim(num_suffix) // '*'
+ end if
+ write(num,'(i3)') cls_rxt_map(k,1,class)
+ num = adjustl( num )
+ if( model /= 'CAM' ) then
+ buff(len_trim(buff)+1:) = 'rxt(:,' // num(:len_trim(num)) // ')'
+ else
+ if( .not. is_vector ) then
+ buff(len_trim(buff)+1:) = 'rxt(:,:,' // num(:len_trim(num)) // ')'
+ else
+ buff(len_trim(buff)+1:) = 'rxt(:,' // num(:len_trim(num)) // ')'
+ end if
+ end if
+ if( indexer(k) /= 0 ) then
+ if( abs( cls_rxt_map(k,indexer(k),class) ) /= 0 ) then
+ write(num,'(i3)') abs( cls_rxt_map(k,indexer(k),class) )
+ num = adjustl( num )
+ if( model /= 'CAM' ) then
+ if( m > 1 ) then
+ buff(len_trim(buff)+1:) = '*y(:,' // num(:len_trim(num)) // ') +'
+ else if( cnt > 1 ) then
+ buff(len_trim(buff)+1:) = '*y(:,' // num(:len_trim(num)) // '))'
+ else
+ buff(len_trim(buff)+1:) = '*y(:,' // num(:len_trim(num)) // ')'
+ end if
+ else
+ if( .not. is_vector ) then
+ if( m > 1 ) then
+ buff(len_trim(buff)+1:) = '*y(:,:,' // num(:len_trim(num)) // ') +'
+ else if( cnt > 1 ) then
+ buff(len_trim(buff)+1:) = '*y(:,:,' // num(:len_trim(num)) // '))'
+ else
+ buff(len_trim(buff)+1:) = '*y(:,:,' // num(:len_trim(num)) // ')'
+ end if
+ else
+ if( m > 1 ) then
+ buff(len_trim(buff)+1:) = '*y(:,' // num(:len_trim(num)) // ') +'
+ else if( cnt > 1 ) then
+ buff(len_trim(buff)+1:) = '*y(:,' // num(:len_trim(num)) // '))'
+ else
+ buff(len_trim(buff)+1:) = '*y(:,' // num(:len_trim(num)) // ')'
+ end if
+ end if
+ end if
+ else
+ if( m > 1 ) then
+ buff(len_trim(buff)+1:) = ' +'
+ else if( cnt > 1 ) then
+ buff(len_trim(buff)+1:) = ')'
+ end if
+ end if
+ else
+ if( m > 1 ) then
+ buff(len_trim(buff)+1:) = ' +'
+ else if( cnt > 1 ) then
+ buff(len_trim(buff)+1:) = ')'
+ end if
+ end if
+ call put_in_line
+ if( m == 1 ) then
+ if( indexer(k) /= 0 ) then
+ write(num,'(i3)') max_loc(1)
+ num = adjustl( num )
+ if( model /= 'CAM' ) then
+ buff = '*y(:,' // num(:len_trim(num)) // ')'
+ else
+ if( .not. is_vector ) then
+ buff = '*y(:,:,' // num(:len_trim(num)) // ')'
+ else
+ buff = '*y(:,' // num(:len_trim(num)) // ')'
+ end if
+ end if
+ end if
+ call put_in_line
+ exit
+ end if
+ m = m - 1
+ end if
+ end do
+ where( match_mask(kl:ku,3) )
+ match_mask(kl:ku,1) = .false.
+ endwhere
+ if( count( match_mask(kl:ku,1) ) == 0 ) then
+ exit
+ end if
+ end do
+ else
+ indprds = .false.
+ end if
+!-----------------------------------------------------------------------
+! ... Write code for "extraneous" production processes
+!-----------------------------------------------------------------------
+ base = sum( cls_rxt_cnt(1:4,class) )
+ match_mask(:,2) = .false.
+ match_mask(:extcnt(class),2) = cls_rxt_map(base+1:base+extcnt(class),2,class) == species
+ if( count( match_mask(:extcnt(class),2) ) /= 0 ) then
+ do k = base+1,base+extcnt(class)
+ if( cls_rxt_map(k,2,class) == species ) then
+ write(num,'(i3)') cls_rxt_map(k,1,class)
+ num = adjustl( num )
+ n = len_trim( num )
+ if( model /= 'CAM' ) then
+ buff = ' + extfrc(:,' // num(:n) // ')'
+ else
+ if( .not. is_vector ) then
+ buff = ' + extfrc(:,:,' // num(:n) // ')'
+ else
+ buff = ' + extfrc(:,' // num(:n) // ')'
+ end if
+ end if
+ call put_in_line
+ end if
+ end do
+ else if( .not. indprds ) then
+ buff = ' 0._r8'
+ call put_in_line
+ end if
+ if( line /= ' ' ) then
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) line
+ end do Species_loop
+ end if
+ end do Class_loop
+
+ if ( .not. first_class ) then
+ line = ' end if'
+ write(30,100) line
+ endif
+
+ line = ' '
+ write(30,100) line
+ line = ' end subroutine indprd'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line = ' end module mo_indprd'
+ write(30,100) line
+
+ if( allocated( match_mask ) ) then
+ deallocate( match_mask )
+ end if
+ if( allocated( pmask ) ) then
+ deallocate( pmask )
+ end if
+ if( allocated( indexer ) ) then
+ deallocate( indexer )
+ end if
+ close( 30 )
+
+ contains
+
+ subroutine put_in_line
+!-----------------------------------------------------------------------
+! ... Put line piece in buff into the line
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: blen, llen
+
+ blen = len_trim( buff )
+ llen = len_trim( line ) + 1
+ if( blen + llen < max_len-2 ) then
+ line(llen:) = buff(:blen)
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,'(a)') trim(line)
+ line = ' '
+ line(18:) = buff(:blen)
+ end if
+ buff = ' '
+
+ end subroutine put_in_line
+
+ end subroutine ipd_code
+
+ end module ind_prod
diff --git a/chem_proc/src/cam_chempp/jcl.f b/chem_proc/src/cam_chempp/jcl.f
new file mode 100644
index 0000000000..97d8c5054b
--- /dev/null
+++ b/chem_proc/src/cam_chempp/jcl.f
@@ -0,0 +1,751 @@
+
+ subroutine JCL( jobctl, &
+ histinp, &
+ histout, &
+ options, &
+ sub_cnt, &
+ imp_cls_cnt, &
+ hostname, &
+ jobname, &
+ machine, &
+ wrk_dir, &
+ subfile, &
+ cpucnt )
+
+ use IO, only : lin, lout
+
+!-------------------------------------------------------
+! ... Input arguments
+!-------------------------------------------------------
+ integer, intent(in) :: sub_cnt ! user subroutine count
+ integer, intent(in) :: imp_cls_cnt ! implicit soln class count
+ integer, intent(in) :: cpucnt ! cpu count for distributed environs
+
+ character(len=16), intent(in) :: hostname ! user machine hostname
+ character(len=16), intent(in) :: jobname ! unique name for file
+ character(len=16), intent(in) :: jobctl(8) ! job control parms
+ character(len=64), intent(in) :: histinp(3) ! "history" tape input parms
+ character(len=64), intent(in) :: histout(6) ! "history" tape output parms
+ character(len=64), intent(in) :: wrk_dir ! working directory on target machine
+ character(len=64), intent(inout) :: subfile ! submission filespec
+ character(len=16), intent(in) :: machine ! target machine "name"
+
+ logical, intent(in), target :: options(*) ! run options
+
+!-------------------------------------------------------
+! ... Local variables
+!-------------------------------------------------------
+ integer :: spos
+ real :: time, days, seconds
+ real :: dtime
+ character(len=320) :: buff
+ character(len=64) :: caps
+ character(len=64) :: fpth
+ character(len=64) :: fname
+ character(len=6) :: date
+ character(len=1) :: char
+ logical :: lexist
+ logical, pointer :: f90
+ logical, pointer :: usemods
+
+!-------------------------------------------------------
+! ... Function declarations
+!-------------------------------------------------------
+ integer :: STRLEN
+ logical :: ISNUM
+
+!-----------------------------------------------------
+! ... The options array has the following mapping:
+!
+! (1) Chemistry (on/off) (2) Target machine == cray (yes/no)
+! (3) Diffusion (on/off) (4) Convection (on/off)
+! (5) Iter norms (on/off) (6) Conservation (on/off)
+! (7) Source code (yes/no) (8) Submission files (yes/no)
+! (9) Execution (yes/no) (10) SLT fixer (on/off)
+! (11) Multitasking (yes/no) (12) Rxt rate lookup table (on/off)
+! (13) Relative humidity (yes/no) (14) New compiler (yes/no)
+! (15) Height field (yes/no ) (16) User "hook" (yes/no)
+! (17) Use f90 modules (yes/no) (18) - (20) Unused
+!-----------------------------------------------------
+
+ f90 => options(14)
+ usemods => options(17)
+!-------------------------------------------------------
+! ... Open "script" file and make script
+!-------------------------------------------------------
+ if( machine == 'CRAYYMP' ) then
+ if( subfile == ' ' ) then
+ subfile = 'ctm.ymp.job'
+ end if
+ INQUIRE( file = subfile, exist = lexist )
+ if( lexist ) then
+ call SYSTEM( 'rm ' // subfile(:LEN_TRIM(subfile)) )
+ end if
+ CLOSE( 3 )
+ OPEN( unit = 3, &
+ file = subfile, &
+ status = 'new' )
+
+ buff = '#QSUB -s /bin/csh'
+ else if( machine == 'CRAY3' ) then
+ if( subfile == ' ' ) then
+ subfile = 'ctm.c3.job'
+ end if
+ INQUIRE( file = subfile, exist = lexist )
+ if( lexist ) then
+ call SYSTEM( 'rm ' // subfile(:LEN_TRIM(subfile)) )
+ end if
+ CLOSE( 3 )
+ OPEN( unit = 3, &
+ file = subfile, &
+ status = 'new' )
+
+ buff = '#QSUB -s /bin/csh'
+ else if( machine == 'T3D' ) then
+ if( subfile == ' ' ) then
+ subfile = 'ctm.t3d.job'
+ end if
+ INQUIRE( file = subfile, exist = lexist )
+ if( lexist ) then
+ call SYSTEM( 'rm ' // subfile(:LEN_TRIM(subfile)) )
+ end if
+ CLOSE( 3 )
+ OPEN( unit = 3, &
+ file = subfile, &
+ status = 'new' )
+
+ buff = '#QSUB -s /bin/csh'
+ else if( machine == 'RS6000' ) then
+ if( subfile == ' ' ) then
+ subfile = 'ctm.rs6000.job'
+ end if
+ INQUIRE( file = subfile, exist = lexist )
+ if( lexist ) then
+ call SYSTEM( 'rm ' // subfile(:LEN_TRIM(subfile)) )
+ end if
+ CLOSE( 3 )
+ OPEN( unit = 3, &
+ file = subfile, &
+ status = 'new' )
+
+ buff = '#! /bin/csh'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+!-------------------------------------------------------
+! ... Check for account override
+!-------------------------------------------------------
+ if( jobctl(5) /= ' ' .and. machine /= 'CRAY3' ) then
+ buff = '#QSUB -A ' // jobctl(5)(:STRLEN(jobctl(5)))
+ write(3,100) buff(:STRLEN(buff))
+ end if
+!-------------------------------------------------------
+! ... "Write" the que
+!-------------------------------------------------------
+ if( options(2) ) then
+ if( jobctl(8) /= ' ' ) then
+ caps = jobctl(8)
+ call UPCASE( caps )
+ if( caps(:4) == 'PREM' ) then
+ buff = '#QSUB -q prem'
+ else if( caps(:4) == 'ECON' ) then
+ buff = '#QSUB -q econ'
+ else if( caps(:3) == 'REG' ) then
+ buff = '#QSUB -q reg'
+ else if( caps(:2) == 'LM' ) then
+ buff = '#QSUB -q lm'
+ else
+ buff = '#QSUB -q reg'
+ endif
+ else
+ buff = '#QSUB -q prem'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+
+!-------------------------------------------------------
+! ... "Write" the cpu limit
+!-------------------------------------------------------
+ if( options(2) ) then
+ if( cpucnt > 1 ) then
+ buff = '#QSUB -la '
+ if( machine /= 'CRAY3' ) then
+ write(buff(11:12),'(i2)') MIN( cpucnt,16 )
+ end if
+ buff(13:) = 'cpus'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' '
+ end if
+ end if
+
+!-------------------------------------------------------
+! ... "Write" the time limit
+!-------------------------------------------------------
+ call TIMCON( jobctl(2)(:STRLEN(jobctl(2))), &
+ time, &
+ lout )
+ write(buff,'(''#QSUB -lT '',i6)') INT(time)
+ write(3,100) buff(:STRLEN(buff))
+!-------------------------------------------------------
+! ... "Write" the memory limit
+!-------------------------------------------------------
+ buff = '#QSUB -lM ' // jobctl(4)(:STRLEN(jobctl(4))) // 'Mw'
+ write(3,100) buff(:STRLEN(buff))
+
+ buff = 'set echo'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'set timestamp'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'date'
+ write(3,100) buff(:STRLEN(buff))
+ end if
+!-------------------------------------------------------
+! ... Change to working directory
+!-------------------------------------------------------
+ if( options(2) ) then
+ if( wrk_dir == ' ' ) then
+ buff = 'cd $TMPDIR'
+ else
+ buff = 'cd ' // wrk_dir(:LEN_TRIM(wrk_dir))
+ end if
+ else if( machine == 'RS6000' ) then
+ buff = 'set echo'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'set timestamp'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'date'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'if( ! -e /usr/tmp/stacy ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' mkdir /usr/tmp/stacy'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'cd /usr/tmp/stacy'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+!-------------------------------------------------------
+! ... "Write" the namelist inputs
+!-------------------------------------------------------
+ buff = 'if ( -e ctm.dat ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' rm ctm.dat'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'cat > ctm.dat << ''END1'''
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'ctm off-line (ver 2.0 ) : case = ' // jobctl(6)(:STRLEN(jobctl(6)))
+ write(3,100) buff(:STRLEN(buff))
+
+!-------------------------------------------------------
+! ... "Experiment" definition
+!-------------------------------------------------------
+ buff = ' &EXPDEF'
+ write(3,100) buff(:STRLEN(buff))
+ caps = jobctl(7)
+ call UPCASE( caps )
+ if( caps == 'TRUE' ) then
+ buff = ' NSREST = 1,'
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ if( histout(5) /= ' ' ) then
+ buff = ' WPASS = ''' // histout(5)(:STRLEN(histout(5))) // ''','
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ if( histout(1) /= ' ' ) then
+ call TIMCON( histout(1)(:STRLEN(histout(1))), &
+ time, &
+ lout )
+ write(buff,'('' IRT = '',i5,'','')') INT( time/8.64e4 + .01 )
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ buff = ' CASEID = ''' // jobctl(6)(:STRLEN(jobctl(6))) // ''','
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' /'
+ write(3,100) buff(:STRLEN(buff))
+
+!-------------------------------------------------------
+! ... "Run" definition
+!-------------------------------------------------------
+ buff = ' &NEWRUN'
+ write(3,100) buff(:STRLEN(buff))
+ call TIMCON( jobctl(1)(:STRLEN(jobctl(1))), &
+ dtime, &
+ lout )
+ write(buff,'('' DTIME = '',i5,'','')') INT(dtime)
+ write(3,100) buff(:STRLEN(buff))
+!-------------------------------------------------------
+! ... Simulation duration in time steps
+!-------------------------------------------------------
+ spos = STRLEN( jobctl(3) )
+ char = jobctl(3)(spos:spos)
+ if( ISNUM( char ) ) then
+ buff = ' NESTEP = ' // jobctl(3)(:spos) // ','
+ else
+ call TIMCON( jobctl(3)(:spos), &
+ time, &
+ lout )
+ write(buff,'('' NESTEP = '',i5,'','')') INT( (time + .01)/dtime )
+ end if
+ write(3,100) buff(:STRLEN(buff))
+!-------------------------------------------------------
+! ... History tape output frequency
+!-------------------------------------------------------
+ if( histout(2) /= ' ' ) then
+ spos = STRLEN( histout(2) )
+ char = histout(2)(spos:spos)
+ if( char >= '0' .and. char <= '9' ) then
+ buff = ' NNUMWT = ' // histout(2)(:spos) // ','
+ else
+ call TIMCON( histout(2)(:spos), &
+ time, &
+ lout )
+ write(buff,'('' NNUMWT = '',i5,'','')') INT( (time + .01)/dtime )
+ end if
+ else
+ buff = ' NNUMWT = 0,'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+!-------------------------------------------------------
+! ... Simulation printout frequency
+!-------------------------------------------------------
+ if( histout(6) /= ' ' ) then
+ spos = STRLEN( histout(6) )
+ char = histout(6)(spos:spos)
+ if( char >= '0' .and. char <= '9' ) then
+ buff = ' PRFREQ = ' // histout(6)(:spos) // ','
+ else
+ call TIMCON( histout(6)(:spos), &
+ time, &
+ lout )
+ write(buff,'('' PRFREQ = '',i5,'','')') INT( (time + .01)/dtime )
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ end if
+!-------------------------------------------------------
+! ... Output history tape density
+!-------------------------------------------------------
+ if( histout(4) /= ' ' ) then
+ buff = ' NDENS = ' // histout(4)(:STRLEN(histout(4))) // ','
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ if( options(10) ) then
+ buff = ' LFIXER = .TRUE.,'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' LIMFIX = .TRUE.,'
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ if( histout(3) /= ' ' ) then
+ buff = ' STFNUM = ' // histout(3)(:STRLEN(histout(3)))
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ buff = ' /'
+ write(3,100) buff(:STRLEN(buff))
+
+!-------------------------------------------------------
+! ... "Input" definition
+!-------------------------------------------------------
+ buff = ' &INPUT'
+ write(3,100) buff(:STRLEN(buff))
+ call PARSE_FLPTH( histinp(1), fname, fpth )
+ spos = STRLEN(fpth)
+ if( fpth(spos:spos) == '/' ) then
+ fpth(spos:spos) = ' '
+ end if
+ buff = ' MSPATH = ''' // fpth(:STRLEN(fpth)) // ''','
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' MSFN = ''' // fname(:STRLEN(fname)) // ''','
+ write(3,100) buff(:STRLEN(buff))
+ spos = STRLEN(histinp(3))
+ if( spos /= 0 ) then
+ buff = ' ICFLNM = ''' // histinp(3)(:spos) // ''','
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ call TIMCON_D( histinp(2)(:STRLEN(histinp(2))), &
+ days, &
+ seconds)
+ call MKDATE( days, date )
+ buff = ' ICDATE = ' // date // ','
+ write(3,100) buff(:STRLEN(buff))
+ write(buff,'('' ICSEC = '',i5,'','')') INT( seconds )
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' /'
+ write(3,100) buff(:STRLEN(buff))
+
+ buff = '''END1'''
+ write(3,100) buff(:STRLEN(buff))
+
+ buff = ' '
+ write(3,100) buff(:STRLEN(buff))
+
+!-------------------------------------------------------
+! ... Write the sim.dat file
+!-------------------------------------------------------
+ buff = 'if ( -e sim.dat ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' rm sim.dat'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'cat > sim.dat << ''END1'''
+ write(3,100) buff(:STRLEN(buff))
+ CLOSE(2)
+ OPEN( unit = 2, &
+ file = 'sim.dat', &
+ status = 'old' )
+ do
+ read(2,100,end=200) buff
+ write(3,100) buff(:STRLEN(buff))
+ end do
+
+200 continue
+ buff = '''END1'''
+ write(3,100) buff(:STRLEN(buff))
+
+!-------------------------------------------------------
+! ... Write the modules file
+!-------------------------------------------------------
+ if( usemods ) then
+ buff = 'if ( -e ctm.mods.f ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' rm ctm.mods.f'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'cat > ctm.mods.f << ''END1'''
+ write(3,100) buff(:STRLEN(buff))
+ CLOSE(2)
+ OPEN( unit = 2, &
+ file = 'ctm.mods.f', &
+ status = 'old' )
+ do
+ read(2,100,end=211) buff
+ write(3,100) buff(:STRLEN(buff))
+ end do
+211 continue
+ buff = '''END1'''
+ write(3,100) buff(:STRLEN(buff))
+ end if
+
+!-------------------------------------------------------
+! ... Write the main file
+!-------------------------------------------------------
+ buff = 'if ( -e ctm.main.f ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' rm ctm.main.f'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'cat > ctm.main.f << ''END1'''
+ write(3,100) buff(:STRLEN(buff))
+ CLOSE(2)
+ OPEN( unit = 2, &
+ file = 'ctm.main.f', &
+ status = 'old' )
+ do
+ read(2,100,end=210) buff
+ write(3,100) buff(:STRLEN(buff))
+ end do
+
+210 continue
+ buff = '''END1'''
+ write(3,100) buff(:STRLEN(buff))
+
+ if( options(7) .or. sub_cnt /= 0 ) then
+!-------------------------------------------------------
+! ... Write the subroutine file
+!-------------------------------------------------------
+ buff = 'if ( -e ctm.subs.f ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' rm ctm.subs.f'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'cat > ctm.subs.f << ''END1'''
+ write(3,100) buff(:STRLEN(buff))
+ CLOSE(2)
+ OPEN( unit = 2, &
+ file = 'ctm.subs.f', &
+ status = 'old' )
+ do
+ read(2,100,end=220) buff
+ write(3,100) buff(:STRLEN(buff))
+ end do
+
+220 continue
+ buff = '''END1'''
+ write(3,100) buff(:STRLEN(buff))
+ end if
+
+!-------------------------------------------------------
+! ... Compile the sources
+!-------------------------------------------------------
+ buff = ' '
+ write(3,100) buff(:STRLEN(buff))
+ if( options(2) ) then
+!-------------------------------------------------------
+! ... Compile for a Cray ( not T3D )
+!-------------------------------------------------------
+ buff = 'ja'
+ write(3,100) buff(:STRLEN(buff))
+ if( machine /= 'CRAY3' ) then
+ if( usemods ) then
+ buff = 'f90 -c ctm.mods.f'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'if ( $status ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' echo ctm.mods.f compile failed'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' goto errexit'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ buff = 'f90 -c ctm.main.f'
+ else
+ if( options(11) ) then
+ buff = '/u0/cs/bin/f77 -c -h fmp ctm.main.f'
+ else
+ buff = '/u0/cs/bin/f77 -c ctm.main.f'
+ end if
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ else if( machine == 'RS6000' ) then
+ buff = 's2d ctm.main.f > Main.f'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'if ( $status ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' echo ctm.main.f s2d failed'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' goto errexit'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 's2d ctm.subs.f > Subs.f'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'if ( $status ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' echo ctm.subs.f s2d failed'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' goto errexit'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'xlf -c -O3 Main.f'
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ buff = 'if ( $status ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' echo ctm.main.f compile failed'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' goto errexit'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+
+ if( options(7) .or. sub_cnt /= 0 ) then
+ if( options(2) ) then
+ if( machine /= 'CRAY3' ) then
+ buff = 'f90 -c ctm.subs.f'
+ else
+ buff = '/u0/cs/bin/f77 -c ctm.subs.f'
+ end if
+ else if( machine == 'RS6000' ) then
+ buff = 'xlf -c -O3 Subs.f'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'if ( $status ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' echo ctm.subs.f compile failed'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' goto errexit'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+ end if
+
+!-------------------------------------------------------
+! ... Form the executable
+!-------------------------------------------------------
+ buff = ' '
+ write(3,100) buff(:STRLEN(buff))
+ if( options(2) ) then
+ if( options(7) ) then
+ if( imp_cls_cnt /= 0 .and. machine /= 'CRAY3' ) then
+ if( f90 ) then
+ buff = 'f90 -Wl"-f indef" ctm.main.o ctm.subs.o /crestone/u2/stacy/ctm/lib/fsim.o \\'
+ else
+ buff = 'segldr -f indef ctm.main.o ctm.subs.o /crestone/u2/stacy/ctm/lib/fsim.o \\'
+ end if
+ else
+ buff = 'segldr -f indef ctm.main.o ctm.subs.o \\ '
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ if( f90 ) then
+ buff = ' -L /usr/local/lib -lncaro,hpf,mss'
+ else
+ buff = ' -L /lib,/usr/lib,/usr/local/lib \\'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ if( machine /= 'CRAY3' ) then
+ if( .not. f90 ) then
+ buff = ' -l ncaro,hpf,mss -M ,s'
+ end if
+ else
+ if( options(11) ) then
+ buff = ' -l ncaro,hpf,mss,net,pll -M ,s'
+ else
+ buff = ' -l ncaro,hpf,mss,net -M ,s'
+ end if
+ end if
+ else if( sub_cnt == 0 ) then
+ if( imp_cls_cnt /= 0 .and. machine /= 'CRAY3' ) then
+ buff = 'segldr -f indef ctm.main.o /crestone/u2/stacy/ctm/lib/fsim.o \\'
+ else
+ buff = 'segldr -f indef ctm.main.o \\'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' -L /lib,/usr/lib,/usr/local/lib,/u0/stacy/ctm/lib \\'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' -l ncaro,hpf,mss,ctm -M ,s'
+ else
+ buff = 'segldr -f indef ctm.main.o ctm.subs.o \\ '
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' -L /lib,/usr/lib,/usr/local/lib,/u2/stacy/ctm/lib \\'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' -l ncaro,hpf,mss,ctm -M ,s'
+ end if
+ else if( machine == 'RS6000' ) then
+ if( cpucnt == 1 ) then
+ buff = 'xlf Main.o Subs.o -L/usr/local/lib -lmss -lncaru -lessl'
+ else
+ buff = 'xlf Main.o Subs.o -L /usr/lpp/pvm/lib -lpvm -lf2c \\'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' -L/usr/local/lib -lmss -lncaru -lessl \\'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' -bI:/usr/lpp/pvm/lib/pvme.exp'
+ end if
+ end if
+ if( .not. f90 ) then
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ buff = 'if ( $status ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' echo segldr failed'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' goto errexit'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+
+!-------------------------------------------------------
+! ... Execution
+!-------------------------------------------------------
+ buff = ' '
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'if ( -e ctm.out.$$ ) then'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' rm ctm.out.$$'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'endif'
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' '
+ write(3,100) buff(:STRLEN(buff))
+ if( options(2) ) then
+ if( cpucnt > 1 ) then
+ buff = 'setenv NCPUS '
+ if( machine /= 'CRAY3' ) then
+ write(buff(14:),'(i2)') MIN( cpucnt,16 )
+ else
+ write(buff(14:),'(i1)') MIN( cpucnt,2 )
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ buff = ' '
+ end if
+ end if
+ buff = 'a.out < ctm.dat > ctm.out.$$'
+ write(3,100) buff(:STRLEN(buff))
+
+!-------------------------------------------------------
+! ... Disperse printouts; normal termination
+!-------------------------------------------------------
+ buff = ' '
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'rcp ctm.out.$$ \\'
+ write(3,100) buff(:STRLEN(buff))
+ if( hostname /= 'acd' ) then
+ buff = ' ' // hostname(:STRLEN(hostname)) // '.acd.ucar.edu:rje/ctm.out.$$'
+ else
+ buff = ' acd.ucar.edu:rje/ctm.out.$$'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ if( options(2) ) then
+ if( machine /= 'CRAY3' ) then
+ buff = 'ja -schflt > accnting.$$'
+ else
+ buff = 'ja -scflt > accnting.$$'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'rcp accnting.$$ \\'
+ write(3,100) buff(:STRLEN(buff))
+ if( hostname /= 'acd' ) then
+ buff = ' ' // hostname(:STRLEN(hostname)) // '.acd.ucar.edu:rje/accnting.$$'
+ else
+ buff = ' acd.ucar.edu:rje/accnting.$$'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ if( hostname /= 'acd' .and. options(9) ) then
+ buff = 'cd $home'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'echo "rcp /usr/tmp/O' // jobname(:STRLEN(jobname)) // ' ' // hostname(:STRLEN(hostname)) &
+ // '.acd.ucar.edu:rje/O' // jobname(:STRLEN(jobname)) // '" | at now + 2 minute'
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ end if
+ buff = 'exit( 0 )'
+ write(3,100) buff(:STRLEN(buff))
+
+ buff = ' '
+ write(3,100) buff(:STRLEN(buff))
+!-------------------------------------------------------
+! ... Disperse printouts; error termination
+!-------------------------------------------------------
+ buff = 'errexit:'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'rcp ctm.out.$$ \\'
+ write(3,100) buff(:STRLEN(buff))
+ if( hostname /= 'acd' ) then
+ buff = ' ' // hostname(:STRLEN(hostname)) // '.acd.ucar.edu:rje/ctm.out.$$'
+ else
+ buff = ' acd.ucar.edu:rje/ctm.out.$$'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ if( options(2) ) then
+ if( machine /= 'CRAY3' ) then
+ buff = 'ja -schflt > accnting.$$'
+ else
+ buff = 'ja -scflt > accnting.$$'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'rcp accnting.$$ \\'
+ write(3,100) buff(:STRLEN(buff))
+ if( hostname /= 'acd' ) then
+ buff = ' ' // hostname(:STRLEN(hostname)) // '.acd.ucar.edu:rje/accnting.$$'
+ else
+ buff = ' acd.ucar.edu:rje/accnting.$$'
+ end if
+ write(3,100) buff(:STRLEN(buff))
+ if( hostname /= 'acd' .and. options(9) ) then
+ buff = 'cd $home'
+ write(3,100) buff(:STRLEN(buff))
+ buff = 'echo "rcp /usr/tmp/O' // jobname(:STRLEN(jobname)) // ' ' // hostname(:STRLEN(hostname)) &
+ // '.acd.ucar.edu:rje/O' // jobname(:STRLEN(jobname)) // '" | at now + 2 minute'
+ write(3,100) buff(:STRLEN(buff))
+ end if
+ end if
+ buff = 'exit( -1 )'
+ write(3,100) buff(:STRLEN(buff))
+ CLOSE(3)
+
+100 format(a)
+
+ end
diff --git a/chem_proc/src/cam_chempp/job_ctl.f b/chem_proc/src/cam_chempp/job_ctl.f
new file mode 100644
index 0000000000..44ae799c55
--- /dev/null
+++ b/chem_proc/src/cam_chempp/job_ctl.f
@@ -0,0 +1,102 @@
+ subroutine JOB_CTL( lin, &
+ lout, &
+ jobctl )
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: lin, lout
+ character(len=16), intent(out) :: jobctl(8) ! job control variables
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: kpar, nchar, k
+ integer :: parsw(8)
+
+ real :: time
+
+ character(len=80) :: buff
+ character(len=80) :: buffh
+ character(len=20) :: parkey(8), keywrd
+
+ logical :: found
+
+ integer :: LENOF
+
+ parkey(1) = 'SIMULATIONTIMESTEP'
+ parkey(2) = 'CRAYTIMELIMIT'
+ parkey(3) = 'SIMULATIONLENGTH'
+ parkey(4) = 'CRAYMEMORY'
+ parkey(5) = 'ACCOUNT'
+ parkey(6) = 'CASE'
+ parkey(7) = 'RESTART'
+ parkey(8) = 'CRAYQUE'
+
+ parsw = 0
+
+!-----------------------------------------------------------------------
+! ... Scan for valid option keyword
+!-----------------------------------------------------------------------
+ do
+ call CARDIN( lin, buff, nchar )
+ buffh = buff
+ call UPCASE ( buffh )
+ if( buffh == 'ENDJOBCONTROL' ) then
+ exit
+ end if
+ k = INDEX( buffh(:nchar), '=' )
+ if( k /= 0 ) then
+ keywrd = buffh(:k-1)
+ found = .false.
+ do kpar = 1,8
+ if( keywrd == parkey(kpar) ) then
+ found = .true.
+ exit
+ end if
+ end do
+ else
+!-----------------------------------------------------------------------
+! ... Invalid parameter keyword; terminate the program
+!-----------------------------------------------------------------------
+ call ERRMES ( ' job ctl specification has no = operator@', lout, buff, 1, buff )
+ end if
+ if( .not. found) then
+ call ERRMES ( ' # is an invalid job control parameter keyword@', &
+ lout, &
+ keywrd, &
+ LENOF(20,keywrd), &
+ buffh )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Valid parameter keyword; now check for duplicate keyword
+!-----------------------------------------------------------------------
+ if( parsw(kpar) /= 0 ) then
+ call ERRMES( '0 *** # has already been specified@', lout, parkey(kpar), k, ' ' )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Set individual options
+!-----------------------------------------------------------------------
+ if( kpar <= 3 ) then
+ if( kpar == 3 ) then
+ if( buffh(nchar-4:nchar) == 'STEPS' ) then
+ jobctl(3) = buff(k+1:nchar-5)
+ else
+ call TIMCON( buff(k+1:nchar), time, lout )
+ jobctl(3) = buff(k+1:nchar)
+ end if
+ else
+ call TIMCON( buff(k+1:nchar), time, lout )
+ jobctl(kpar) = buff(k+1:nchar)
+ end if
+ else
+ jobctl(kpar) = buff(k+1:nchar)
+ end if
+ parsw(kpar) = 1
+ end do
+
+ end subroutine JOB_CTL
diff --git a/chem_proc/src/cam_chempp/lin_code.f b/chem_proc/src/cam_chempp/lin_code.f
new file mode 100644
index 0000000000..100bf9ff61
--- /dev/null
+++ b/chem_proc/src/cam_chempp/lin_code.f
@@ -0,0 +1,685 @@
+
+ module lin_matrix
+
+ use io, only : temp_path
+
+ implicit none
+
+ character(len=4) :: hdr, up_hdr
+ character(len=4) :: num_suffix
+ character(len=4) :: dec_suffix
+
+ contains
+
+ subroutine make_lin( clscnt, clsmap, cls_rxt_cnt, cls_rxt_map, pcoeff_ind, &
+ pcoeff, permute, mat_map, class, &
+ lin_mat_pat, march, model )
+!-----------------------------------------------------------------------
+! ... Write the fortran code for the linear components
+! of the Jacobian matrix
+!-----------------------------------------------------------------------
+
+ use var_mod, only : var_lim
+ use rxt_mod, only : rxt_lim, prd_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: clscnt, &
+ class, &
+ clsmap(var_lim,5,2), &
+ cls_rxt_map(rxt_lim,prd_lim+3), &
+ cls_rxt_cnt(4)
+ integer, intent(in) :: mat_map(max(1,clscnt),max(1,clscnt))
+ integer, intent(in) :: permute(max(1,clscnt))
+ integer, intent(in) :: pcoeff_ind(*)
+ real, intent(in) :: pcoeff(prd_lim,*)
+ character(len=16), intent(in) :: model ! target model
+ character(len=16), intent(in) :: march ! target architecture
+ logical, intent(out):: lin_mat_pat(:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: max_len= 90
+ integer :: i, j, k, l, m
+ integer :: length, index
+ integer :: row, col, sub_cnt
+ integer :: line_pos, rxno, target, line_cnt
+ integer :: base
+ integer :: species
+ integer :: mat_ind
+ integer :: match_cnt
+ integer :: list_cnt
+ integer :: other_ind
+ integer :: match_ind(var_lim)
+ integer :: scan(var_lim,3)
+ real :: rate
+ character(len=max_len+2) :: line
+ character(len=72) :: buff
+ character(len=12) :: het_piece
+ character(len= 6) :: mat_piece, rxt_piece
+ character(len= 4) :: sol_piece, num
+ logical :: beg_line, flush
+ logical :: lexist
+
+ if( class == 4 ) then
+ inquire( file = trim( temp_path ) // 'linmat.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'linmat.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'linmat.F' )
+ up_hdr = 'imp_'
+ hdr = 'imp_'
+ if( model == 'CAM' ) then
+ up_hdr = ' '
+ hdr = ' '
+ end if
+ else
+ open( unit = 30, file = trim( temp_path ) // 'linmat.F', position='append' )
+ up_hdr = 'rod_'
+ hdr = 'rod_'
+ end if
+
+ if( model == 'CAM' ) then
+ num_suffix = '_r8'
+ dec_suffix = '(r8)'
+ else
+ num_suffix = ' '
+ dec_suffix = ' '
+ end if
+
+ line_cnt = 0
+ line = ' '
+ write(30,100) trim(line)
+ line = ' module mo_' // trim(up_hdr) // 'lin_matrix'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if (march=='VECTOR') then
+ line = ' use chem_mods, only: veclen'
+ write(30,100) trim(line)
+ endif
+ line = ' private'
+ write(30,100) trim(line)
+ line = ' public :: linmat'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' contains'
+ write(30,100) trim(line)
+ if( clscnt == 0 .or. (cls_rxt_cnt(2)+cls_rxt_cnt(4)) == 0 ) then
+ sub_cnt = 0
+ else
+ sub_cnt = 1
+ end if
+ call make_lin_hdr( clscnt, sub_cnt, march, model )
+
+ select case( march )
+ case( 'SCALAR' )
+ mat_piece = 'mat('
+ rxt_piece = 'rxt('
+ sol_piece = 'y('
+ het_piece = 'het_rates('
+ case ( 'CACHE','VECTOR' )
+ mat_piece = 'mat(k,'
+ rxt_piece = 'rxt(k,'
+ sol_piece = 'y(k,'
+ het_piece = 'het_rates(k,'
+ case default
+ mat_piece = 'mat(k,'
+ rxt_piece = 'rxt(k,'
+ sol_piece = 'y(k,'
+ het_piece = 'het_rates(k,'
+ end select
+
+ lin_mat_pat(:) = .false.
+Species_loop : &
+ do species = 1,clscnt
+ target = clsmap(species,class,2)
+ flush = .false.
+!-----------------------------------------------------------------------
+! ...Write code for linear loss entries
+!-----------------------------------------------------------------------
+ row = permute(species)
+ mat_ind = mat_map(row,row)
+ write(num,'(i4)') mat_map(row,row)
+ num = adjustl( num )
+ l = len_trim( num )
+ line = ' '
+ line(10:) = trim( mat_piece ) // num(:l) // ') = -('
+ line_pos = len_trim( line ) + 2
+ base = cls_rxt_cnt(1)
+ beg_line = .true.
+ do k = base+1,base+cls_rxt_cnt(2)
+ if( cls_rxt_map(k,2) == target ) then
+ lin_mat_pat(mat_ind) = .true.
+ flush = .true.
+ write(num,'(i4)') cls_rxt_map(k,1)
+ num = adjustl( num )
+ l = len_trim( num )
+ buff = trim( rxt_piece ) // num(:l) // ')'
+ if( cls_rxt_map(k,3) > 0 ) then
+ write(num,'(i4)') cls_rxt_map(k,3)
+ num = adjustl( num )
+ l = len_trim( num )
+ buff(len_trim(buff)+1:) = '*' // trim( sol_piece ) // num(:l) // ')'
+ end if
+ length = len_trim(buff)
+ if( (line_pos + length) <= max_len-2 ) then
+ if( beg_line ) then
+ line(line_pos:) = buff(:length)
+ beg_line = .false.
+ else
+ line(line_pos:) = ' + ' // buff(:length)
+ end if
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ line = ' '
+ line(23:) = '+ ' // buff(:length)
+ end if
+ line_pos = len_trim( line ) + 1
+ end if
+ end do
+ base = base + cls_rxt_cnt(2) + cls_rxt_cnt(3)
+ do k = base+1,base+cls_rxt_cnt(4)
+ if( cls_rxt_map(k,2) == species ) then
+ lin_mat_pat(mat_ind) = .true.
+ flush = .true.
+ write(num,'(i4)') cls_rxt_map(k,1)
+ num = adjustl( num )
+ l = len_trim( num )
+ buff = trim( het_piece ) // num(:l) // ')'
+ length = len_trim(buff)
+ if( (line_pos + length) <= max_len-2 ) then
+ if( beg_line ) then
+ line(line_pos:) = buff(:length)
+ beg_line = .false.
+ else
+ line(line_pos:) = ' + ' // buff(:length)
+ end if
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ line = ' '
+ line(18:) = '+ ' // buff(:length)
+ end if
+ line_pos = len_trim( line ) + 1
+ end if
+ end do
+ if( flush ) then
+ if( line_pos <= max_len-2 ) then
+ line(line_pos+1:) = ')'
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ line = ' )'
+ end if
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ end if
+
+!-----------------------------------------------------------------------
+! ... Scan for production matches
+!-----------------------------------------------------------------------
+ match_cnt = 0
+ base = cls_rxt_cnt(1)
+ do k = base+1,base+cls_rxt_cnt(2)
+ other_ind = 0
+ do l = 4,prd_lim+3
+ if( cls_rxt_map(k,l) == species ) then
+ if( other_ind == 0 ) then
+ match_cnt = match_cnt + 1
+ scan(match_cnt,1) = k
+ scan(match_cnt,2) = ABS(cls_rxt_map(k,2))
+ end if
+ other_ind = other_ind + 1
+ end if
+ end do
+ if( other_ind /= 0 ) then
+ scan(match_cnt,3) = other_ind
+ end if
+ end do
+ list_cnt = match_cnt
+ do while( list_cnt > 0 )
+ do j = 1,match_cnt
+ if( scan(j,2) /= 0 ) then
+ index = scan(j,2)
+ exit
+ end if
+ end do
+ m = 0
+ do j = 1,match_cnt
+ if( scan(j,2) == index ) then
+ m = m + 1
+ match_ind(m) = j
+ scan(j,2) = 0
+ list_cnt = list_cnt - 1
+ end if
+ end do
+ row = permute(species)
+ col = permute(clsmap(index,class,1))
+ mat_ind = mat_map(row,col)
+ lin_mat_pat(mat_ind) = .true.
+ write(num,'(i4)') mat_map(row,col)
+ num = adjustl( num )
+ l = len_trim( num )
+ line = ' '
+ line(10:) = trim( mat_piece ) // num(:l) // ') ='
+ line_pos = len_trim( line )
+ if( clsmap(index,class,1) == species ) then
+ line(len_trim(line)+2:) = trim( mat_piece ) // num(:l) // ') +'
+ end if
+ line_pos = len_trim( line ) + 2
+ if( m > 0 ) then
+ beg_line = .true.
+ else
+ line(line_pos:) = '0.'
+ end if
+ do j = 1,m
+ l = match_ind(j)
+ rxno = cls_rxt_map(scan(l,1),1)
+ index = pcoeff_ind(rxno)
+ rate = 0.
+ if( index /= 0 ) then
+ do i = 4,prd_lim+3
+ if( cls_rxt_map(scan(l,1),i) == species ) then
+ rate = rate + pcoeff(i-3,index)
+ end if
+ end do
+ else if( scan(l,3) /= 1 ) then
+ rate = REAL(scan(l,3))
+ end if
+ buff = ' '
+ if( rate /= 0. .and. rate /= 1. ) then
+ call r2c( buff, rate, 'l' )
+ buff(len_trim(buff)+1:) = trim(num_suffix) // '*'
+ end if
+ write(num,'(i4)') rxno
+ num = adjustl( num )
+ buff(len_trim(buff)+1:) = trim( rxt_piece ) // num(:len_trim(num)) // ')'
+ if( cls_rxt_map(scan(l,1),3) > 0 ) then
+ write(num,'(i4)') cls_rxt_map(scan(l,1),3)
+ num = adjustl( num )
+ buff(len_trim(buff)+1:) = '*' // trim( sol_piece ) // num(:len_trim(num)) // ')'
+ end if
+ length = len_trim(buff)
+ if( (line_pos + length) <= max_len-2 ) then
+ if( beg_line ) then
+ line(line_pos:) = buff(:length)
+ beg_line = .false.
+ else
+ line(line_pos:) = ' + ' // buff(:length)
+ end if
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ line = ' '
+ line(23:) = '+ ' // buff(:length)
+ end if
+ line_pos = len_trim( line ) + 1
+ end do
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ end do
+ line = ' '
+ write(30,100) trim(line)
+ if( line_cnt > 200 ) then
+ if( march /= 'SCALAR' ) then
+ line = ' end do'
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ write(num,'(i4)') 1000+sub_cnt
+ write(line,'('' end subroutine '',a,''linmat'',a)') trim(up_hdr),num(3:4)
+ write(30,100) trim(line)
+ line_cnt = 0
+ if( species /= clscnt ) then
+ sub_cnt = sub_cnt + 1
+ call make_lin_hdr( clscnt, sub_cnt, march, model )
+ end if
+ end if
+ end do Species_loop
+
+ if( line_cnt /= 0 ) then
+ if( march /= 'SCALAR' ) then
+ line = ' end do'
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ write(num,'(i4)') 1000+sub_cnt
+ write(line,'('' end subroutine '',a,''linmat'',a)') trim(up_hdr),num(3:4)
+ write(30,100) trim(line)
+ end if
+
+ if( clscnt > 0 .and. (cls_rxt_cnt(2)+cls_rxt_cnt(4)) > 0 ) then
+ call make_lin_hdr( clscnt, 0, march, model )
+ end if
+ do m = 1,sub_cnt
+ write(num,'(i4)') 1000+m
+ select case( march )
+ case ( 'VECTOR' )
+ write(line,'('' call '',a,''linmat'',a,''( avec_len, mat, y, rxt, het_rates )'')') &
+ trim(up_hdr),num(3:4)
+ case ( 'SCALAR' )
+ write(line,'('' call '',a,''linmat'',a,''( mat, y, rxt, het_rates )'')') trim(up_hdr),num(3:4)
+ case default
+ if( model == 'MOZART' ) then
+ write(line,'('' call '',a,''linmat'',a,''( mat, y, rxt, het_rates )'')') trim(up_hdr),num(3:4)
+ else if( model == 'CAM' ) then
+ write(line,'('' call '',a,''linmat'',a,''( mat, y, rxt, het_rates, cols )'')') trim(up_hdr),num(3:4)
+ else if( model == 'WRF' ) then
+ write(line,'('' call '',a,''linmat'',a,''( mat, y, rxt )'')') trim(up_hdr),num(3:4)
+ end if
+ end select
+ write(30,100) trim(line)
+ end do
+ line = ' '
+ write(30,100) trim(line)
+ line = ' end subroutine ' // trim(up_hdr) // 'linmat'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' end module mo_' // trim(up_hdr) // 'lin_matrix'
+ write(30,100) trim(line)
+
+ close( 30 )
+
+100 format(a)
+
+ end subroutine make_lin
+
+ subroutine make_lin_hdr( clscnt, sub_cnt, march, model )
+!-----------------------------------------------------------------------
+! ... Write the fortran header code for the linear components
+! of the Jacobian matrix
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! ... Dummy arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: clscnt, sub_cnt
+ character(len=16), intent(in) :: march
+ character(len=16), intent(in) :: model
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: length
+ character(len=72) :: line
+ character(len=3) :: num
+
+ line = ' '
+ write(30,100) trim(line)
+ write(num,'(i3)') 100+sub_cnt
+ select case( march )
+ case ( 'SCALAR' )
+ if( sub_cnt /= 0 ) then
+ if( model == 'MOZART' .or. model == 'CAM' ) then
+ write(line,'('' subroutine '',a,''linmat'',a,''( mat, y, rxt, het_rates )'')') trim(up_hdr),num(2:3)
+ else if( model == 'WRF' ) then
+ write(line,'('' subroutine '',a,''linmat'',a,''( mat, y, rxt )'')') trim(up_hdr),num(2:3)
+ end if
+ else
+ if( model == 'MOZART' .or. model == 'CAM' ) then
+ write(line,'('' subroutine '',a,''linmat( mat, y, rxt, het_rates )'')') trim(up_hdr)
+ else if( model == 'WRF' ) then
+ write(line,'('' subroutine '',a,''linmat( mat, y, rxt )'')') trim(up_hdr)
+ end if
+ end if
+ case ( 'VECTOR' )
+ if( sub_cnt /= 0 ) then
+ write(line,'('' subroutine '',a,''linmat'',a,''( avec_len, mat, y, rxt, het_rates )'')') &
+ trim(up_hdr),num(2:3)
+ else
+ write(line,'('' subroutine '',a,''linmat( avec_len, mat, y, rxt, het_rates )'')') &
+ trim(up_hdr)
+ end if
+ case default
+ if( sub_cnt /= 0 ) then
+ if( model == 'MOZART' ) then
+ write(line,'('' subroutine '',a,''linmat'',a,''( mat, y, rxt, het_rates )'')') trim(up_hdr),num(2:3)
+ else if( model == 'CAM' ) then
+ write(line,'('' subroutine '',a,''linmat'',a,''( mat, y, rxt, het_rates, cols )'')') trim(up_hdr),num(2:3)
+ else if( model == 'WRF' ) then
+ write(line,'('' subroutine '',a,''linmat'',a,''( mat, y, rxt )'')') trim(up_hdr),num(2:3)
+ end if
+ else
+ if( model == 'MOZART' ) then
+ write(line,'('' subroutine '',a,''linmat( mat, y, rxt, het_rates )'')') trim(up_hdr)
+ else if( model == 'CAM' ) then
+ write(line,'('' subroutine '',a,''linmat( mat, y, rxt, het_rates, cols )'')') trim(up_hdr)
+ else if( model == 'WRF' ) then
+ write(line,'('' subroutine '',a,''linmat( mat, y, rxt )'')') trim(up_hdr)
+ end if
+ end if
+ end select
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... linear matrix entries for'
+ length = len_trim( line ) + 2
+ line(length:) = 'implicit species'
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( model == 'MOZART' ) then
+ select case( march )
+ case( 'SCALAR' )
+ line = ' use mo_grid, only : pcnstm1'
+ write(30,100) trim(line)
+ line = ' use chem_mods, only : rxntot, ' // hdr // 'nzcnt'
+ case ( 'VECTOR' )
+ line = ' use mo_grid, only : pcnstm1, plnplv'
+ write(30,100) trim(line)
+ line = ' use chem_mods, only : rxntot, ' // hdr // 'nzcnt'
+ case default
+ line = ' use mo_grid, only : pcnstm1'
+ write(30,100) trim(line)
+ line = ' use chem_mods, only : rxntot, ' // hdr // 'nzcnt, clsze'
+ end select
+ else if( model == 'CAM' ) then
+ select case( march )
+ case( 'SCALAR' )
+ line = ' use chem_mods, only : gas_pcnst, rxntot, nzcnt'
+ case ( 'VECTOR' )
+ line = ' use chem_mods, only : gas_pcnst, rxntot, nzcnt'
+ case default
+ line = ' use chem_mods, only : gas_pcnst, rxntot, nzcnt, clsze'
+ end select
+ write(30,100) trim(line)
+ line = ' use shr_kind_mod, only : r8 => shr_kind_r8'
+ else if( model == 'WRF' ) then
+ line = ''
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' implicit none '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... dummy arguments'
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ if( model /= 'CAM' ) then
+ select case( march )
+ case( 'SCALAR' )
+ if( model /= 'WRF' ) then
+ line = ' real, intent(in) :: y(pcnstm1)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: rxt(rxntot)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: het_rates(gas_pcnst)'
+ write(30,100) trim(line)
+ line = ' real, intent(inout) :: mat(' // hdr // 'nzcnt)'
+ else
+ line = ' real, intent(in) :: y(:)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: rxt(:)'
+ write(30,100) trim(line)
+ line = ' real, intent(inout) :: mat(:)'
+ end if
+ write(30,100) trim(line)
+ case ( 'VECTOR' )
+ line = ' integer, intent(in) :: avec_len'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: y(veclen,gas_pcnst)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: rxt(veclen,rxntot)'
+ write(30,100) trim(line)
+ if( model /= 'WRF' ) then
+ line = ' real, intent(in) :: het_rates(veclen,gas_pcnst)'
+ write(30,100) trim(line)
+ end if
+ line = ' real, intent(inout) :: mat(veclen,nzcnt)'
+ write(30,100) trim(line)
+ if( sub_cnt /= 0 ) then
+ line = ' '
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... Local variables'
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = ' integer :: k'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'do k = 1,avec_len'
+ write(30,100) trim(line)
+ end if
+ case default
+ line = ' real, intent(in) :: y(clsze,pcnstm1)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: rxt(clsze,rxntot)'
+ write(30,100) trim(line)
+ if( model /= 'WRF' ) then
+ line = ' real, intent(in) :: het_rates(clsze,gas_pcnst)'
+ write(30,100) trim(line)
+ end if
+ line = ' real, intent(inout) :: mat(clsze,' // hdr // 'nzcnt)'
+ write(30,100) trim(line)
+ if( sub_cnt /= 0 ) then
+ line = ' '
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... local variables'
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = ' integer :: k'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( clscnt /= 0 ) then
+ line(7:) = 'do k = 1,clsze'
+ write(30,100) trim(line)
+ end if
+ end if
+ end select
+ else
+ select case( march )
+ case ( 'SCALAR' )
+ line = ' real(r8), intent(in) :: y(gas_pcnst)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: rxt(rxntot)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: het_rates(max(1,gas_pcnst))'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(inout) :: mat(nzcnt)'
+ write(30,100) trim(line)
+ case ( 'VECTOR' )
+ line = ' integer, intent(in) :: avec_len'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: y(veclen,gas_pcnst)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: rxt(veclen,rxntot)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: het_rates(veclen,gas_pcnst)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(inout) :: mat(veclen,nzcnt)'
+ write(30,100) trim(line)
+ if( sub_cnt /= 0 ) then
+ line = ' '
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... local variables'
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = ' integer :: k'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( clscnt /= 0 ) then
+ if( model == 'CAM' ) then
+ line(7:) = 'do k = 1,avec_len'
+ end if
+ write(30,100) trim(line)
+ end if
+ end if
+ case default
+ line = ' integer, intent(in) :: cols'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: y(clsze,gas_pcnst)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: rxt(clsze,rxntot)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: het_rates(clsze,max(1,gas_pcnst))'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(inout) :: mat(clsze,nzcnt)'
+ write(30,100) trim(line)
+ if( sub_cnt /= 0 ) then
+ line = ' '
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... local variables'
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = ' integer :: k'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( clscnt /= 0 ) then
+ if( model == 'MOZART' ) then
+ line(7:) = 'do k = 1,clsze'
+ else if( model == 'CAM' ) then
+ line(7:) = 'do k = 1,cols'
+ end if
+ write(30,100) trim(line)
+ end if
+ end if
+ end select
+ end if
+ line = ' '
+ write(30,100) trim(line)
+
+100 format(a)
+
+ end subroutine make_lin_hdr
+
+ end module lin_matrix
diff --git a/chem_proc/src/cam_chempp/mak_grp_vmr.f b/chem_proc/src/cam_chempp/mak_grp_vmr.f
new file mode 100644
index 0000000000..cb1ebb92fe
--- /dev/null
+++ b/chem_proc/src/cam_chempp/mak_grp_vmr.f
@@ -0,0 +1,205 @@
+
+ subroutine mak_grp_vmr( grp_mem_cnt, mem2grp_map, model, march )
+!-------------------------------------------------------------------
+! ... Write the group volume mixing ratios code
+!-------------------------------------------------------------------
+
+ use io, only : temp_path
+
+ implicit none
+
+!-------------------------------------------------------------------
+! ... Dummy args
+!-------------------------------------------------------------------
+ integer, intent(in) :: grp_mem_cnt
+ integer, intent(in) :: mem2grp_map(*)
+ character(len=*), intent(in) :: model
+ character(len=*), intent(in) :: march
+
+!-------------------------------------------------------------------
+! ... Local variables
+!-------------------------------------------------------------------
+ integer, parameter :: max_len= 90
+ integer :: m
+ character(len=max_len) :: line
+ logical :: lexist
+
+ inquire( file = trim( temp_path ) // 'mo_make_grp_vmr.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'mo_make_grp_vmr.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'mo_make_grp_vmr.F' )
+
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'module mo_make_grp_vmr'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'private'
+ write(30,100) trim(line)
+ line(7:) = 'public :: mak_grp_vmr'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'contains'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ select case( model )
+ case( 'MOZART' )
+ line(7:) = 'subroutine mak_grp_vmr( vmr, group_ratios, group_vmrs, plonl )'
+ case( 'CAM' )
+ if( march /= 'VECTOR' ) then
+ line(7:) = 'subroutine mak_grp_vmr( vmr, group_ratios, group_vmrs, plonl )'
+ else
+ line(7:) = 'subroutine mak_grp_vmr( vmr, group_ratios, group_vmrs, chnkpnts )'
+ end if
+ case( 'WRF' )
+ line(7:) = 'subroutine mak_grp_vmr( vmr, group_ratios, group_vmrs )'
+ end select
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( model == 'MOZART' ) then
+ line(7:) = 'use mo_grid, only : plev, pcnstm1'
+ write(30,100) trim(line)
+ line(7:) = 'use chem_mods, only : grpcnt'
+ else if( model == 'CAM' ) then
+ line(7:) = 'use chem_mods, only : grpcnt, gas_pcnst'
+ write(30,100) trim(line)
+ if( march /= 'VECTOR' ) then
+ line(7:) = 'use ppgrid, only : pver'
+ write(30,100) trim(line)
+ end if
+ line(7:) = 'use shr_kind_mod, only : r8 => shr_kind_r8'
+ else if( model == 'WRF' ) then
+ line(7:) = ' '
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'implicit none '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = '!----------------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... dummy arguments'
+ write(30,100) trim(line)
+ line = '!----------------------------------------------------------------------------'
+ write(30,100) trim(line)
+ select case( model )
+ case( 'MOZART' )
+ line = ' integer, intent(in) :: plonl'
+ write(30,100) trim(line)
+ case( 'CAM' )
+ if( march /= 'VECTOR' ) then
+ line = ' integer, intent(in) :: plonl'
+ else
+ line = ' integer, intent(in) :: chnkpnts'
+ end if
+ write(30,100) trim(line)
+ end select
+ if( model == 'MOZART' ) then
+ line = ' real, intent(in) :: vmr(plonl,plev,pcnstm1)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: group_ratios(plonl,plev,grpcnt)'
+ write(30,100) trim(line)
+ line = ' real, intent(out) :: group_vmrs(plonl,plev,grpcnt)'
+ else if( model == 'CAM' ) then
+ if( march /= 'VECTOR' ) then
+ line = ' real(r8), intent(in) :: vmr(:,:,:)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: group_ratios(:,:,:)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(out) :: group_vmrs(:,:,:)'
+ else
+ line = ' real(r8), intent(in) :: vmr(chnkpnts,max(1,gas_pcnst))'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: group_ratios(chnkpnts,max(1,grpcnt))'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(out) :: group_vmrs(chnkpnts,max(1,grpcnt))'
+ end if
+ else if( model == 'WRF' ) then
+ line = ' real, intent(in) :: vmr(:,:)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: group_ratios(:,:)'
+ write(30,100) trim(line)
+ line = ' real, intent(out) :: group_vmrs(:,:)'
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( model /= 'WRF' ) then
+ line = '!----------------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... local variables'
+ write(30,100) trim(line)
+ line = '!----------------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = ' integer :: k'
+ write(30,100) trim(line)
+ end if
+ if( grp_mem_cnt > 0 ) then
+ line = ' '
+ write(30,100) trim(line)
+ select case( model )
+ case( 'MOZART' )
+ line(7:) = 'do k = 1,plev'
+ write(30,100) trim(line)
+ case( 'CAM' )
+ if( march /= 'VECTOR' ) then
+ line(7:) = 'do k = 1,plev'
+ else
+ line(7:) = 'do k = 1,chnkpnts'
+ end if
+ write(30,100) trim(line)
+ end select
+ do m = 1,grp_mem_cnt
+ line = ' '
+ select case( model )
+ case( 'MOZART' )
+ line(10:) = 'group_vmrs(:,k, ) = group_ratios(:,k, )'
+ write(line(25:26),'(i2)') m
+ write(line(48:49),'(i2)') m
+ line(len_trim(line)+1:) = ' * vmr(:,k,'
+ case( 'CAM' )
+ if( march /= 'VECTOR' ) then
+ line(10:) = 'group_vmrs(:,k, ) = group_ratios(:,k, )'
+ write(line(25:26),'(i2)') m
+ write(line(48:49),'(i2)') m
+ line(len_trim(line)+1:) = ' * vmr(:,k,'
+ else
+ line(10:) = 'group_vmrs(k, ) = group_ratios(k, )'
+ write(line(10:),'(''group_vmrs(k,'',i2,'') = group_ratios(k,'',i2,'')'')') m, m
+ line(len_trim(line)+1:) = ' * vmr(:,k,'
+ end if
+ case( 'WRF' )
+ line(7:) = 'group_vmrs(:,'
+ write(line(len_trim(line)+1:),*) m
+ line(len_trim(line)+1:) = ') = group_ratios(:,'
+ write(line(len_trim(line)+1:),*) m
+ line(len_trim(line)+1:) = ') * vmr(:,'
+ end select
+ write(line(len_trim(line)+1:),'(i2,'')'')') mem2grp_map(m)
+ write(30,100) trim(line)
+ end do
+ if( model /= 'WRF' ) then
+ line = ' '
+ line(7:) = 'end do'
+ write(30,100) trim(line)
+ end if
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'end subroutine mak_grp_vmr'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'end module mo_make_grp_vmr'
+ write(30,100) trim(line)
+
+100 format(a)
+
+ end subroutine mak_grp_vmr
diff --git a/chem_proc/src/cam_chempp/make_lu_fac.f b/chem_proc/src/cam_chempp/make_lu_fac.f
new file mode 100644
index 0000000000..3817d022b8
--- /dev/null
+++ b/chem_proc/src/cam_chempp/make_lu_fac.f
@@ -0,0 +1,410 @@
+
+ module lu_factor
+
+ use io, only : temp_path
+
+ implicit none
+
+ character(len=4) :: hdr, up_hdr
+ character(len=4) :: num_suffix
+ character(len=4) :: dec_suffix
+
+ contains
+
+ subroutine make_lu_fac( n, class, lu_sp_pat, mat_sp_pat, sp_map, &
+ march, model )
+!-----------------------------------------------------------------------
+! ... Write the fortran code for the sparse matrix decomposition
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: n ! species in class count
+ integer, intent(in) :: class ! class number
+ integer, intent(in) :: sp_map(n,n) ! sparsity matrix map
+ character(len=16), intent(in) :: march ! target architecture
+ character(len=16), intent(in) :: model ! target model
+ logical, intent(in), dimension(n,n) :: lu_sp_pat, mat_sp_pat
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: max_lines = 50
+ integer :: i, ip1, j, k, l, row, col, sub_cnt
+ integer :: indx, pos, line_cnt
+ character(len=90) :: code
+ character(len=72) :: comment, blank, buff
+ character(len= 6) :: mat_piece
+ character(len= 4) :: num
+ logical :: lexist
+ logical :: sp_pat(n,n)
+
+!-----------------------------------------------------------------------
+! ... Create and open code file; if it exists remove first
+!-----------------------------------------------------------------------
+ line_cnt = 0
+ if( class == 4 ) then
+ inquire( file = trim( temp_path ) // 'lu_fac.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'lu_fac.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'lu_fac.F' )
+ if( model /= 'CAM' ) then
+ hdr = 'imp_'
+ up_hdr = 'imp_'
+ else
+ hdr = ' '
+ up_hdr = ' '
+ end if
+ else
+ open( unit = 30, file = trim( temp_path ) // 'lu_fac.F', position='append' )
+ hdr = 'rod_'
+ up_hdr = 'rod_'
+ end if
+
+ if( model == 'CAM' ) then
+ num_suffix = '_r8'
+ dec_suffix = '(r8)'
+ else
+ num_suffix = ' '
+ dec_suffix = ' '
+ end if
+
+ if( n == 0 ) then
+ sub_cnt = 0
+ else
+ sub_cnt = 1
+ end if
+ code = ' '
+ write(30,100) trim(code)
+ if( model == 'MOZART' ) then
+ if( class == 4 ) then
+ code = ' module mo_imp_factor'
+ else if( class == 5 ) then
+ code = ' module mo_rod_factor'
+ end if
+ else if( model == 'CAM' ) then
+ if( class == 4 ) then
+ code = ' module mo_lu_factor'
+ end if
+ else if( model == 'WRF' ) then
+ if( class == 4 ) then
+ code = ' module mo_imp_factor'
+ end if
+ end if
+ write(30,100) trim(code)
+ code = ' '
+ write(30,100) trim(code)
+ if (march=='VECTOR') then
+ code = ' use chem_mods, only: veclen'
+ write(30,100) trim(code)
+ endif
+ code = ' private'
+ write(30,100) trim(code)
+ code = ' public :: lu_fac'
+ write(30,100) trim(code)
+ code = ' '
+ write(30,100) trim(code)
+ code = ' contains'
+ write(30,100) trim(code)
+ call make_lu_fac_hdr( sub_cnt, march, model )
+
+ code = ' ' ; blank = ' '
+ if( n > 0 ) then
+ sp_pat = mat_sp_pat
+ comment = '!------------------------------------------------------------------------'
+ select case( march )
+ case( 'SCALAR' )
+ mat_piece = 'lu('
+ case default
+ mat_piece = 'lu(k,'
+ end select
+ end if
+
+Column_loop : &
+ do i = 1,n
+!-----------------------------------------------------------------------
+! ... Form diagonal inverse
+!-----------------------------------------------------------------------
+ indx = sp_map(i,i)
+ write(num,'(i4)') indx
+ num = adjustl( num )
+ l = len_trim( num )
+ code(10:) = trim( mat_piece ) // num(:l) // ') = 1.' // trim(num_suffix) // ' / ' // trim( mat_piece ) // num(:l) // ')'
+ write(30,100) trim(code)
+ line_cnt = line_cnt + 1
+ buff = ' * ' // trim( mat_piece ) // num(:l) // ')'
+ ip1 = i + 1
+!-----------------------------------------------------------------------
+! ... Multiply column below diagonal
+!-----------------------------------------------------------------------
+ do row = ip1,n
+ if( sp_pat(row,i) ) then
+ indx = sp_map(row,i)
+ write(num,'(i4)') indx
+ num = adjustl( num )
+ l = len_trim( num )
+ code(10:) = trim( mat_piece ) // num(:l) // ') = ' // trim( mat_piece ) // num(:l) // ')' &
+ // buff(:len_trim(buff))
+ write(30,100) trim(code)
+ line_cnt = line_cnt + 1
+ end if
+ end do
+!-----------------------------------------------------------------------
+! ... Modify sub-matrix
+!-----------------------------------------------------------------------
+ do col = ip1,n
+ if( sp_pat(i,col) ) then
+ indx = sp_map(i,col)
+ write(num,'(i4)') indx
+ num = adjustl( num )
+ l = len_trim( num )
+ buff = ' * ' // trim( mat_piece ) // num(:l) // ')'
+ do row = ip1,n
+ if( sp_pat(row,i) ) then
+ indx = sp_map(row,col)
+ write(num,'(i4)') indx
+ num = adjustl( num )
+ l = len_trim( num )
+ if( sp_pat(row,col) ) then
+ code(10:) = trim( mat_piece ) // num(:l) // ') = ' // trim( mat_piece ) // num(:l) // ')'
+ indx = sp_map(row,i)
+ write(num,'(i4)') indx
+ num = adjustl( num )
+ l = len_trim( num )
+ code(len_trim(code)+2:) = '- ' // trim( mat_piece ) // num(:l) // ')' // buff(:len_trim(buff))
+ write(30,100) trim(code)
+ code(6:) = ' '
+ else
+ sp_pat(row,col) = .true.
+ code(10:) = trim( mat_piece ) // num(:l) // ') = '
+ indx = sp_map(row,i)
+ write(num,'(i4)') indx
+ num = adjustl( num )
+ l = len_trim( num )
+ pos = index( code,'=' ) + 2
+ code(pos:) = '- ' // trim( mat_piece ) // num(:l) // ')' // buff(:len_trim(buff))
+ write(30,100) trim(code)
+ line_cnt = line_cnt + 1
+ end if
+ end if
+ end do
+ end if
+ end do
+ write(30,100) blank
+ if( line_cnt > max_lines ) then
+ if( march /= 'SCALAR' ) then
+ code = ' end do'
+ write(30,100) trim(code)
+ end if
+ write(30,100) blank
+ write(num,'(i3)') 100+sub_cnt
+ write(code,'('' end subroutine '',a,''lu_fac'',a)') trim(up_hdr),num(2:3)
+ write(30,100) trim(code)
+ line_cnt = 0
+ if( i /= n ) then
+ sub_cnt = sub_cnt + 1
+ call make_lu_fac_hdr( sub_cnt, march, model )
+ end if
+ code = ' '
+ end if
+ end do Column_loop
+
+ if( line_cnt /= 0 ) then
+ if( march /= 'SCALAR' ) then
+ code(7:) = 'end do'
+ write(30,100) trim(code)
+ end if
+ write(30,100) blank
+ write(num,'(i3)') 100+sub_cnt
+ write(code,'('' end subroutine '',a,''lu_fac'',a)') trim(up_hdr),num(2:3)
+ write(30,100) trim(code)
+ end if
+
+ if( n > 0 ) then
+ call make_lu_fac_hdr( 0, march, model )
+ end if
+ do k = 1,sub_cnt
+ write(num,'(i3)') 100+k
+ select case( march )
+ case( 'SCALAR' )
+ write(code,'('' call '',a,''lu_fac'',a,''( lu )'')') trim(up_hdr),num(2:3)
+ case( 'VECTOR' )
+ write(code,'('' call '',a,''lu_fac'',a,''( avec_len, lu )'')') trim(up_hdr),num(2:3)
+ case default
+ if( model /= 'CAM' ) then
+ write(code,'('' call '',a,''lu_fac'',a,''( lu )'')') trim(up_hdr),num(2:3)
+ else
+ write(code,'('' call '',a,''lu_fac'',a,''( lu, cols )'')') trim(up_hdr),num(2:3)
+ end if
+ end select
+ write(30,100) trim(code)
+ end do
+ write(30,100) blank
+ code(7:) = 'end subroutine ' // trim(up_hdr) // 'lu_fac'
+ write(30,100) trim(code)
+ write(30,100) blank
+
+ if( model == 'MOZART' ) then
+ if( class == 4 ) then
+ code = ' end module mo_imp_factor'
+ else if( class == 5 ) then
+ code = ' end module mo_rod_factor'
+ end if
+ else if( model == 'CAM' ) then
+ if( class == 4 ) then
+ code = ' end module mo_lu_factor'
+ end if
+ else if( model == 'WRF' ) then
+ if( class == 4 ) then
+ code = ' end module mo_imp_factor'
+ end if
+ end if
+ write(30,100) trim(code)
+
+ close( 30 )
+
+100 format(a)
+
+ end subroutine make_lu_fac
+
+ subroutine make_lu_fac_hdr( sub_cnt, march, model )
+!-----------------------------------------------------------------------
+! ... Write the fortran header code for the sparse matrix decomposition
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: sub_cnt
+ character(len=16), intent(in) :: march
+ character(len=16), intent(in) :: model
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: i, ip1, j, k, l, row, col
+ integer :: indx, pos
+ character(len=72) :: code, comment, blank, buff
+ character(len=3) :: num
+
+ code = ' ' ; blank = ' '
+ comment = '!------------------------------------------------------------------------'
+
+ write(30,100) blank
+ write(num,'(i3)') 100+sub_cnt
+ select case( march )
+ case( 'SCALAR' )
+ if( sub_cnt /= 0 ) then
+ write(code,'('' subroutine '',a,''lu_fac'',a,''( lu )'')') trim(up_hdr),num(2:3)
+ else
+ write(code,'('' subroutine '',a,''lu_fac( lu )'')') trim(up_hdr)
+ end if
+ case( 'VECTOR' )
+ if( sub_cnt /= 0 ) then
+ write(code,'('' subroutine '',a,''lu_fac'',a,''( avec_len, lu )'')') trim(up_hdr),num(2:3)
+ else
+ write(code,'('' subroutine '',a,''lu_fac( avec_len, lu )'')') trim(up_hdr)
+ end if
+ case default
+ if( sub_cnt /= 0 ) then
+ if( model /= 'CAM' ) then
+ write(code,'('' subroutine '',a,''lu_fac'',a,''( lu )'')') trim(up_hdr),num(2:3)
+ else
+ write(code,'('' subroutine '',a,''lu_fac'',a,''( lu, cols )'')') trim(up_hdr),num(2:3)
+ end if
+ else
+ if( model /= 'CAM' ) then
+ write(code,'('' subroutine '',a,''lu_fac( lu )'')') trim(up_hdr)
+ else
+ write(code,'('' subroutine '',a,''lu_fac( lu, cols )'')') trim(up_hdr)
+ end if
+ end if
+ end select
+ write(30,100) trim(code)
+ write(30,100) blank
+ if( march == 'SCALAR' ) then
+ code(:) = ' '
+ else if( march == 'VECTOR' ) then
+ if( model /= 'CAM' ) then
+ code(7:) = 'use mo_grid, only : plnplv'
+ write(30,100) trim(code)
+ code(7:) = 'use chem_mods, only : ' // hdr // 'nzcnt'
+ else
+ code(7:) = 'use chem_mods, only : nzcnt'
+ end if
+ else
+ if( model /= 'WRF' ) then
+ code(7:) = 'use chem_mods, only : ' // hdr // 'nzcnt, clsze'
+ else
+ code(:) = ' '
+ end if
+ end if
+ write(30,100) trim(code)
+ if( model == 'CAM' ) then
+ code(7:) = 'use shr_kind_mod, only : r8 => shr_kind_r8'
+ write(30,100) trim(code)
+ end if
+ write(30,100) blank
+ code(7:) = 'implicit none '
+ write(30,100) trim(code)
+ write(30,100) blank
+ write(30,100) comment
+ code = '! ... dummy args'
+ write(30,100) trim(code)
+ write(30,100) comment
+ code = ' '
+ if( model == 'CAM' .and. march == 'CACHE' ) then
+ code(7:) = 'integer, intent(in) :: cols'
+ write(30,100) trim(code)
+ end if
+ select case( march )
+ case( 'SCALAR' )
+ code(7:) = 'real' // trim(dec_suffix) // ', intent(inout) :: lu(:)'
+ case( 'VECTOR' )
+ code(7:) = 'integer, intent(in) :: avec_len'
+ write(30,100) trim(code)
+ if( model /= 'CAM' ) then
+ code(7:) = 'real' // trim(dec_suffix) // ', intent(inout) :: lu(plnplv,' // hdr // 'nzcnt)'
+ else
+ code(7:) = 'real' // trim(dec_suffix) // ', intent(inout) :: lu(veclen,nzcnt)'
+ end if
+ case default
+ code(7:) = 'real' // trim(dec_suffix) // ', intent(inout) :: lu(clsze,' // hdr // 'nzcnt)'
+ end select
+ write(30,100) trim(code)
+ write(30,100) blank
+ if( sub_cnt /= 0 ) then
+ if( march /= 'SCALAR' ) then
+ write(30,100) comment
+ code = '! ... local variables'
+ write(30,100) trim(code)
+ write(30,100) comment
+ code = ' '
+ code(7:) = 'integer :: k'
+ write(30,100) trim(code)
+ write(30,100) blank
+ code = ' '
+ if( march == 'VECTOR' ) then
+ code(7:) = 'do k = 1,avec_len'
+ else if( march == 'CACHE' ) then
+ if( model == 'MOZART' ) then
+ code(7:) = 'do k = 1,clsze'
+ else if( model == 'CAM' ) then
+ code(7:) = 'do k = 1,cols'
+ end if
+ end if
+ write(30,100) trim(code)
+ end if
+ end if
+
+100 format(a)
+
+ end subroutine make_lu_fac_hdr
+
+ end module lu_factor
diff --git a/chem_proc/src/cam_chempp/make_lu_slv.f b/chem_proc/src/cam_chempp/make_lu_slv.f
new file mode 100644
index 0000000000..e48efeb89b
--- /dev/null
+++ b/chem_proc/src/cam_chempp/make_lu_slv.f
@@ -0,0 +1,475 @@
+
+ module lu_solve
+
+ use io, only : temp_path
+
+ implicit none
+
+ character(len=4) :: hdr, up_hdr
+ character(len=4) :: num_suffix
+ character(len=4) :: dec_suffix
+
+ contains
+
+ subroutine make_lu_slv( n, class, lu_sp_pat, march, model )
+!-----------------------------------------------------------------------
+! ... Write the fortran code for the sparse matrix solver
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: n ! count of species in class
+ integer, intent(in) :: class ! class number
+ character(len=16), intent(in) :: march ! target architecture
+ character(len=16), intent(in) :: model ! target model
+ logical, intent(in), dimension(n,n) :: lu_sp_pat
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: i, ip1, j, k, l, row, col, sub_cnt
+ integer :: indx, pos, line_cnt
+ integer :: sp_map(n,n)
+ character(len=72) :: code, comment, blank, buff
+ character(len= 6) :: mat_piece
+ character(len= 4) :: b_piece
+ character(len= 4) :: num
+ logical :: lexist
+
+!-----------------------------------------------------------------------
+! ... Create and open code file; if it exists remove first
+!-----------------------------------------------------------------------
+ line_cnt = 0
+ if( class == 4 ) then
+ inquire( file = trim( temp_path ) // 'lu_slv.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'lu_slv.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'lu_slv.F' )
+ if( model /= 'CAM' ) then
+ hdr = 'imp_'
+ up_hdr = 'imp_'
+ else
+ hdr = ' '
+ up_hdr = ' '
+ end if
+ else
+ open( unit = 30, file = trim( temp_path ) // 'lu_slv.F', position='append' )
+ hdr = 'rod_'
+ up_hdr = 'rod_'
+ end if
+
+ if( model == 'CAM' ) then
+ num_suffix = '_r8'
+ dec_suffix = '(r8)'
+ else
+ num_suffix = ' '
+ dec_suffix = ' '
+ end if
+
+ if( n == 0 ) then
+ sub_cnt = 0
+ else
+ sub_cnt = 1
+ end if
+ code = ' '
+ write(30,100) trim(code)
+ if( model == 'MOZART' ) then
+ if( class == 4 ) then
+ code = ' module mo_imp_solve'
+ else if( class == 5 ) then
+ code = ' module mo_rod_solve'
+ end if
+ else if( model == 'CAM' ) then
+ if( class == 4 ) then
+ code = ' module mo_lu_solve'
+ end if
+ else if( model == 'WRF' ) then
+ if( class == 4 ) then
+ code = ' module mo_imp_solve'
+ end if
+ end if
+ write(30,100) trim(code)
+ code = ' '
+ write(30,100) trim(code)
+ if (march=='VECTOR') then
+ code = ' use chem_mods, only: veclen'
+ write(30,100) trim(code)
+ endif
+ code = ' private'
+ write(30,100) trim(code)
+ code = ' public :: lu_slv'
+ write(30,100) trim(code)
+ code = ' '
+ write(30,100) trim(code)
+ code = ' contains'
+ write(30,100) trim(code)
+ call make_lu_slv_hdr( n, class, sub_cnt, march, model )
+
+ code = ' ' ; blank = ' '
+ if( n > 0 ) then
+!-----------------------------------------------------------------------
+! ... Form the lu matrix map
+!-----------------------------------------------------------------------
+ k = 0 ; sp_map = 0
+ do i = 1,n
+ do j = 1,n
+ if( lu_sp_pat(j,i) ) then
+ k = k + 1
+ sp_map(j,i) = k
+ end if
+ end do
+ end do
+
+ code = ' ' ; blank = ' '
+ comment = '!------------------------------------------------------------------------'
+
+ if( march == 'SCALAR' ) then
+ mat_piece = 'lu('
+ b_piece = 'b('
+ else
+ mat_piece = 'lu(k,'
+ b_piece = 'b(k,'
+ end if
+ end if
+
+!-----------------------------------------------------------------------
+! ... Solve L * y = b
+!-----------------------------------------------------------------------
+Forward_loop : &
+ do col = 1,n-1
+ write(num,'(i4)') col
+ num = adjustl( num )
+ l = len_trim( num )
+ buff = ' * ' // trim( b_piece ) // num(:l) // ')'
+ do row = col+1,n
+ if( lu_sp_pat(row,col) ) then
+ write(num,'(i4)') row
+ num = adjustl( num )
+ l = len_trim( num )
+ code(10:) = trim( b_piece ) // num(:l) // ') = ' // trim( b_piece ) // num(:l) // ')'
+ indx = sp_map(row,col)
+ write(num,'(i4)') indx
+ num = adjustl( num )
+ l = len_trim( num )
+ code(len_trim(code)+2:) = '- ' // trim( mat_piece ) // num(:l) // ')' // buff(:len_trim(buff))
+ write(30,100) trim(code)
+ line_cnt = line_cnt + 1
+ end if
+ end do
+ write(30,100) blank
+ if( line_cnt > 200 ) then
+ if( march /= 'SCALAR' ) then
+ code = ' end do'
+ write(30,100) trim(code)
+ end if
+ write(30,100) blank
+ write(num,'(i3)') 100+sub_cnt
+ write(code,'('' end subroutine '',a,''lu_slv'',a)') trim(up_hdr),num(2:3)
+ write(30,100) trim(code)
+ line_cnt = 0
+ sub_cnt = sub_cnt + 1
+ call make_lu_slv_hdr( n, class, sub_cnt, march, model )
+ code = ' '
+ end if
+ end do Forward_loop
+
+ if( line_cnt /= 0 ) then
+ if( march /= 'SCALAR' ) then
+ code = ' end do'
+ write(30,100) trim(code)
+ end if
+ write(30,100) blank
+ write(num,'(i3)') 100+sub_cnt
+ write(code,'('' end subroutine '',a,''lu_slv'',a)') trim(up_hdr),num(2:3)
+ write(30,100) trim(code)
+ line_cnt = 0
+ sub_cnt = sub_cnt + 1
+ call make_lu_slv_hdr( n, class, sub_cnt, march, model )
+ code = ' '
+ end if
+
+ if( n > 0 ) then
+ write(30,100) blank
+ write(30,100) comment
+ code = '! ... Solve U * x = y'
+ write(30,100) trim(code)
+ write(30,100) comment
+ code = ' '
+ end if
+
+!-----------------------------------------------------------------------
+! ... Solve U * x = y
+!-----------------------------------------------------------------------
+Backward_loop : &
+ do col = n,1,-1
+ write(num,'(i4)') col
+ num = adjustl( num )
+ l = len_trim( num )
+ code(10:) = trim( b_piece) // num(:l) // ') = ' // trim( b_piece ) // num(:l) // ')'
+ buff = ' * ' // trim( b_piece ) // num(:l) // ')'
+ write(num,'(i4)') sp_map(col,col)
+ num = adjustl( num )
+ l = len_trim( num )
+ code(len_trim(code)+2:) = '* ' // trim( mat_piece ) // num(:l) // ')'
+ write(30,100) trim(code)
+ line_cnt = line_cnt + 1
+ do row = col-1,1,-1
+ if( lu_sp_pat(row,col) ) then
+ write(num,'(i4)') row
+ num = adjustl( num )
+ l = len_trim( num )
+ code(10:) = trim( b_piece ) // num(:l) // ') = ' // trim( b_piece ) // num(:l) // ')'
+ indx = sp_map(row,col)
+ write(num,'(i4)') indx
+ num = adjustl( num )
+ l = len_trim( num )
+ code(len_trim(code)+2:) = '- ' // trim( mat_piece ) // num(:l) // ')' // buff(:len_trim(buff))
+ write(30,100) trim(code)
+ line_cnt = line_cnt + 1
+ end if
+ end do
+ write(30,100) blank
+ if( line_cnt > 200 ) then
+ if( march /= 'SCALAR' ) then
+ code = ' end do'
+ write(30,100) trim(code)
+ end if
+ write(30,100) blank
+ write(num,'(i3)') 100+sub_cnt
+ write(code,'('' end subroutine '',a,''lu_slv'',a)') trim(up_hdr),num(2:3)
+ write(30,100) trim(code)
+ line_cnt = 0
+ if( col /= 1 ) then
+ sub_cnt = sub_cnt + 1
+ call make_lu_slv_hdr( n, class, sub_cnt, march, model )
+ end if
+ code = ' '
+ end if
+ end do Backward_loop
+
+ if( line_cnt /= 0 ) then
+ if( march /= 'SCALAR' ) then
+ code = ' end do'
+ write(30,100) trim(code)
+ end if
+ write(30,100) blank
+ write(num,'(i3)') 100+sub_cnt
+ write(code,'('' end subroutine '',a,''lu_slv'',a)') trim(up_hdr),num(2:3)
+ write(30,100) trim(code)
+ end if
+
+ if( n > 0 ) then
+ call make_lu_slv_hdr( n, class, 0, march, model )
+ end if
+
+ do k = 1,sub_cnt
+ write(num,'(i3)') 100+k
+ select case( march )
+ case( 'SCALAR' )
+ write(code,'('' call '',a,''lu_slv'',a,''( lu, b )'')') trim(up_hdr),num(2:3)
+ case( 'VECTOR' )
+ write(code,'('' call '',a,''lu_slv'',a,''( avec_len, lu, b )'')') trim(up_hdr),num(2:3)
+ case default
+ if( model /= 'CAM' ) then
+ write(code,'('' call '',a,''lu_slv'',a,''( lu, b )'')') trim(up_hdr),num(2:3)
+ else
+ write(code,'('' call '',a,''lu_slv'',a,''( lu, b, cols )'')') trim(up_hdr),num(2:3)
+ end if
+ end select
+ write(30,100) trim(code)
+ end do
+
+ write(30,100) blank
+ code(7:) = 'end subroutine ' // trim(up_hdr) // 'lu_slv'
+ write(30,100) trim(code)
+ write(30,100) blank
+ if( model == 'MOZART' ) then
+ if( class == 4 ) then
+ code = ' end module mo_imp_solve'
+ else if( class == 5 ) then
+ code = ' end module mo_rod_solve'
+ end if
+ else if( model == 'CAM' ) then
+ if( class == 4 ) then
+ code = ' end module mo_lu_solve'
+ end if
+ else if( model == 'WRF' ) then
+ if( class == 4 ) then
+ code = ' end module mo_imp_solve'
+ end if
+ end if
+ write(30,100) trim(code)
+
+ close( 30 )
+
+100 format(a)
+
+ end subroutine make_lu_slv
+
+ subroutine make_lu_slv_hdr( n, class, sub_cnt, march, model )
+!-----------------------------------------------------------------------
+! ... Write the fortran header code for the sparse matrix solver
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! ... Dummy arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: n, class
+ integer, intent(in) :: sub_cnt
+ character(len=16), intent(in) :: march
+ character(len=16), intent(in) :: model
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ character(len=3) :: num
+ character(len=72) :: code, comment, blank
+
+
+ code = ' ' ; blank = ' '
+ comment = '!------------------------------------------------------------------------'
+
+ write(30,100) blank
+ write(num,'(i3)') 100+sub_cnt
+ select case( march )
+ case( 'SCALAR' )
+ if( sub_cnt /= 0 ) then
+ write(code,'('' subroutine '',a,''lu_slv'',a,''( lu, b )'')') trim(up_hdr),num(2:3)
+ else
+ write(code,'('' subroutine '',a,''lu_slv( lu, b )'')') trim(up_hdr)
+ end if
+ case( 'VECTOR' )
+ if( sub_cnt /= 0 ) then
+ write(code,'('' subroutine '',a,''lu_slv'',a,''( avec_len, lu, b )'')') trim(up_hdr),num(2:3)
+ else
+ write(code,'('' subroutine '',a,''lu_slv( avec_len, lu, b )'')') trim(up_hdr)
+ end if
+ case default
+ if( sub_cnt /= 0 ) then
+ if( model /= 'CAM' ) then
+ write(code,'('' subroutine '',a,''lu_slv'',a,''( lu, b )'')') trim(up_hdr),num(2:3)
+ else
+ write(code,'('' subroutine '',a,''lu_slv'',a,''( lu, b, cols )'')') trim(up_hdr),num(2:3)
+ end if
+ else
+ if( model /= 'CAM' ) then
+ write(code,'('' subroutine '',a,''lu_slv( lu, b )'')') trim(up_hdr)
+ else
+ write(code,'('' subroutine '',a,''lu_slv( lu, b, cols )'')') trim(up_hdr)
+ end if
+ end if
+ end select
+ write(30,100) trim(code)
+ write(30,100) blank
+ if( march == 'SCALAR' ) then
+ code(:) = ' '
+ else if( march == 'VECTOR' ) then
+ if( model /= 'CAM' ) then
+ code(7:) = 'use mo_grid, only : plnplv'
+ write(30,100) trim(code)
+ write(code(7:),'(''use chem_mods, only : ' // hdr // 'nzcnt, clscnt'',i1)') class
+ else
+ code(:) = ' '
+ end if
+ else
+ if( model /= 'WRF' ) then
+ write(code(7:),'(''use chem_mods, only : ' // hdr // 'nzcnt, clsze, clscnt'',i1)') class
+ else
+ code(:) = ' '
+ end if
+ end if
+ write(30,100) trim(code)
+ if( model == 'CAM' ) then
+ code(7:) = 'use shr_kind_mod, only : r8 => shr_kind_r8'
+ write(30,100) trim(code)
+ code(7:) = 'use chem_mods, only : clscnt4, nzcnt'
+ write(30,100) trim(code)
+ end if
+ write(30,100) blank
+ code(7:) = 'implicit none '
+ write(30,100) trim(code)
+ write(30,100) blank
+ write(30,100) comment
+ code = '! ... Dummy args'
+ write(30,100) trim(code)
+ write(30,100) comment
+ code = ' '
+ if( model == 'CAM' .and. march == 'CACHE' ) then
+ code(7:) = 'integer, intent(in) :: cols'
+ write(30,100) trim(code)
+ end if
+ code = ' '
+ if( march == 'SCALAR' ) then
+ if( model /= 'CAM' ) then
+ code(7:) = 'real, intent(in) :: lu(:)'
+ else
+ code(7:) = 'real(r8), intent(in) :: lu(:)'
+ end if
+ else
+ if( march == 'VECTOR' ) then
+ code(7:) = 'integer, intent(in) :: avec_len'
+ write(30,100) trim(code)
+ if( model /= 'CAM' ) then
+ code(7:) = 'real, intent(in) :: lu(plnplv,' // hdr // 'nzcnt)'
+ else
+ code(7:) = 'real(r8), intent(in) :: lu(veclen,max(1,nzcnt))'
+ end if
+ else
+ code(7:) = 'real, intent(in) :: lu(clsze,' // hdr // 'nzcnt)'
+ end if
+ end if
+ write(30,100) trim(code)
+ write(num,'(i3)') n
+ num = adjustl( num )
+ if( march == 'SCALAR' ) then
+ code(7:) = 'real' // trim(dec_suffix) // ', intent(inout) :: b(:)'
+ else if( march == 'VECTOR' ) then
+ if( model /= 'CAM' ) then
+ write(code(7:),'(''real' // trim(dec_suffix) // ', intent(inout) :: b(plnplv,clscnt'',i1,'')'')') class
+ else
+ write(code(7:),'(''real' // trim(dec_suffix) // ', intent(inout) :: b(veclen,clscnt4)'')'')')
+ end if
+ else
+ write(code(7:),'(''real' // trim(dec_suffix) // ', intent(inout) :: b(clsze,clscnt'',i1,'')'')') class
+ end if
+ write(30,100) trim(code)
+ write(30,100) blank
+ if( sub_cnt /= 0 ) then
+ write(30,100) comment
+ code = '! ... Local variables'
+ write(30,100) trim(code)
+ write(30,100) comment
+ code = ' '
+ if( march /= 'SCALAR' ) then
+ code(7:) = 'integer :: k'
+ write(30,100) trim(code)
+ end if
+ write(30,100) blank
+ write(30,100) comment
+ code = '! ... solve L * y = b'
+ write(30,100) trim(code)
+ write(30,100) comment
+ if( march /= 'SCALAR' ) then
+ code = ' '
+ if( march == 'VECTOR' ) then
+ code(7:) = 'do k = 1,avec_len'
+ else
+ if( model == 'MOZART' ) then
+ code(7:) = 'do k = 1,clsze'
+ else if( model == 'CAM' ) then
+ code(7:) = 'do k = 1,cols'
+ end if
+ end if
+ write(30,100) trim(code)
+ end if
+ end if
+
+100 format(a)
+
+ end subroutine make_lu_slv_hdr
+
+ end module lu_solve
diff --git a/chem_proc/src/cam_chempp/make_map.f b/chem_proc/src/cam_chempp/make_map.f
new file mode 100644
index 0000000000..0b84dfe4a5
--- /dev/null
+++ b/chem_proc/src/cam_chempp/make_map.f
@@ -0,0 +1,49 @@
+
+ module MO_MAKE_MAP
+
+ CONTAINS
+
+ subroutine MAKE_MAP( cls_rxt_map, &
+ cls_rxt_cnt, &
+ clsno, &
+ rxno, &
+ cls_prd_cnt, &
+ template )
+
+ use RXT_MOD, only : rxt_lim, prd_lim
+
+ implicit none
+
+!------------------------------------------------------------------------
+! ... Dummy args
+!------------------------------------------------------------------------
+ integer, intent(in) :: clsno, rxno, cls_prd_cnt
+ integer, intent(in) :: template(:,:)
+ integer, intent(inout) :: cls_rxt_cnt
+ integer, intent(inout) :: cls_rxt_map(:)
+
+!------------------------------------------------------------------------
+! ... Local variables
+!------------------------------------------------------------------------
+ integer :: count
+ integer :: k, kp3
+
+ count = 0
+ cls_rxt_cnt = cls_rxt_cnt + 1
+ cls_rxt_map(1) = rxno
+ do k = 1,prd_lim
+ kp3 = k + 3
+ if( template(k,2) == clsno ) then
+ count = count + 1
+ cls_rxt_map(kp3) = template(k,3)
+ if( count == cls_prd_cnt ) then
+ exit
+ end if
+ else
+ cls_rxt_map(kp3) = -huge(0)
+ end if
+ end do
+
+ end subroutine MAKE_MAP
+
+ end module MO_MAKE_MAP
diff --git a/chem_proc/src/cam_chempp/make_names.f b/chem_proc/src/cam_chempp/make_names.f
new file mode 100644
index 0000000000..cd5ffeb094
--- /dev/null
+++ b/chem_proc/src/cam_chempp/make_names.f
@@ -0,0 +1,97 @@
+
+ subroutine make_name_mod
+!--------------------------------------------------------------------------------
+! ... Makes a module of parameter species names
+!--------------------------------------------------------------------------------
+
+ use var_mod, only : spc_cnt => new_nq, spc_names => new_solsym, &
+ grp_mem_cnt, grp_mem_names => grp_mem_sym
+ use io, only : temp_path
+
+ implicit none
+
+!--------------------------------------------------------------------------------
+! ... Local variables
+!--------------------------------------------------------------------------------
+ integer :: i, j
+ integer :: beg, end
+ character(len=80) :: buff
+ character(len=63) :: legal = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' &
+ // 'abcdefghijklmnopqrstuvwxyz' &
+ // '0123456789_'
+ character(len=16) :: name
+ logical :: lexist
+
+ inquire( file = trim( temp_path ) // 'spc_names.mod', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'spc_names.mod' )
+ end if
+ open( unit = 30, &
+ file = trim( temp_path ) // 'spc_names.mod' )
+
+ buff = ' '
+ write(30,*) ' '
+ buff(7:) = 'module m_spc_id'
+ write(30,'(a)') buff
+ write(30,*) ' '
+ buff(7:) = 'implicit none'
+ write(30,'(a)') buff
+ buff = ' '
+ write(30,*) ' '
+
+ do i = 1,spc_cnt
+ name = spc_names(i)
+ end = len_trim(name)
+ beg = 1
+ do
+ j = VERIFY( name(beg:end), legal )
+ if( j == 0 ) then
+ exit
+ end if
+ j = j + beg - 1
+ if( j == end ) then
+ end = end - 1
+ exit
+ end if
+ name(j:j) = '_'
+ if( j >= end ) then
+ exit
+ end if
+ beg = j + 1
+ end do
+ write(buff(7:),'(''integer, parameter :: id_'',a,1x,''='',1x,i3)') &
+ name(:end), i
+ write(30,'(a)') buff(:len_trim(buff))
+ end do
+ write(30,*) ' '
+ do i = 1,grp_mem_cnt
+ name = grp_mem_names(i)
+ end = len_trim(name)
+ beg = 1
+ do
+ j = VERIFY( name(beg:end), legal )
+ if( j == 0 ) then
+ exit
+ end if
+ j = j + beg - 1
+ if( j == end ) then
+ end = end - 1
+ exit
+ end if
+ name(j:j) = '_'
+ if( j >= end ) then
+ exit
+ end if
+ beg = j + 1
+ end do
+ write(buff(7:),'(''integer, parameter :: id_'',a,1x,''='',1x,i3)') &
+ name(:end), i
+ write(30,'(a)') buff(:len_trim(buff))
+ end do
+ buff = ' '
+ write(30,*) ' '
+ buff(7:) = 'end module m_spc_id'
+ write(30,'(a)') buff
+ CLOSE(30)
+
+ end subroutine MAKE_NAME_MOD
diff --git a/chem_proc/src/cam_chempp/make_sim_dat.f b/chem_proc/src/cam_chempp/make_sim_dat.f
new file mode 100644
index 0000000000..77a5bd7d83
--- /dev/null
+++ b/chem_proc/src/cam_chempp/make_sim_dat.f
@@ -0,0 +1,872 @@
+
+ subroutine make_sim_dat( model, march, sparse )
+!-------------------------------------------------------------------
+! ... write the simulation data routine; only for CAM
+!-------------------------------------------------------------------
+
+ use io, only : temp_path
+ use sp_mods, only : sparsity
+ use var_mod, only : clscnt, clsmap, permute, new_nq, new_solsym
+ use var_mod, only : nq, newind, mass, c_mass, temp_mass
+ use var_mod, only : nfs, fixsym
+ use var_mod, only : nslvd, slvdsym
+ use rxt_mod, only : cls_rxt_cnt, rxntot
+ use rxt_mod, only : rxt_has_tag, rxt_tag
+ use rxt_mod, only : phtcnt, pht_alias, pht_alias_mult
+ use rxt_mod, only : usrcnt, usrmap, frc_from_dataset
+ use rxt_mod, only : cph_flg, enthalpy, num_rnts
+
+ implicit none
+
+!-------------------------------------------------------------------
+! ... dummy arguments
+!-------------------------------------------------------------------
+ character(len=16), intent(in) :: model
+ character(len=16), intent(in) :: march
+ type(sparsity), intent(in) :: sparse(2)
+
+!-------------------------------------------------------------------
+! ... local variables
+!-------------------------------------------------------------------
+ integer, parameter :: max_len= 132
+
+ integer :: i, l, m, m1, n, n1
+ integer :: lpos
+ integer :: lstrt
+ integer, allocatable :: ndx(:)
+ character(len=max_len) :: line
+ character(len=64) :: frmt
+ character(len=24) :: number
+ character(len=12) :: num12
+ character(len=32) :: rxt_string
+ character(len=16) :: wrk_chr(5)
+ logical :: flush
+ logical :: lexist
+ integer :: numlen
+ integer :: enthalpy_cnt
+ integer :: begcnt, endcnt
+
+ inquire( file = trim( temp_path ) // 'mo_sim_dat.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'mo_sim_dat.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'mo_sim_dat.F' )
+
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'module mo_sim_dat'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'private'
+ write(30,100) trim(line)
+ line(7:) = 'public :: set_sim_dat'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'contains'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'subroutine set_sim_dat'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass'
+ write(30,100) trim(line)
+ if( clscnt(4) > 0 ) then
+ line(7:) = 'use chem_mods, only : diag_map'
+ write(30,100) trim(line)
+ endif
+ line(7:) = 'use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map'
+ write(30,100) trim(line)
+ line(7:) = 'use chem_mods, only : pht_alias_lst, pht_alias_mult'
+ write(30,100) trim(line)
+ line(7:) = 'use chem_mods, only : extfrc_lst, inv_lst, slvd_lst'
+ write(30,100) trim(line)
+ line(7:) = 'use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot'
+ write(30,100) trim(line)
+ line(7:) = 'use cam_abortutils,only : endrun'
+ write(30,100) trim(line)
+ line(7:) = 'use mo_tracname, only : solsym'
+ write(30,100) trim(line)
+ line(7:) = 'use chem_mods, only : frc_from_dataset'
+ write(30,100) trim(line)
+ line(7:) = 'use chem_mods, only : is_scalar, is_vector'
+ write(30,100) trim(line)
+ line(7:) = 'use shr_kind_mod, only : r8 => shr_kind_r8'
+ write(30,100) trim(line)
+ line(7:) = 'use cam_logfile, only : iulog'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'implicit none '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... local variables'
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = ' integer :: ios'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+!-------------------------------------------------------------------
+! ... Scalar or vector code?
+!-------------------------------------------------------------------
+ if( march == 'VECTOR' ) then
+ line = ' is_scalar = .false.'
+ write(30,'(a)') trim(line)
+ line = ' is_vector = .true.'
+ elseif( march == 'SCALAR' ) then
+ line = ' is_scalar = .true.'
+ write(30,'(a)') trim(line)
+ line = ' is_vector = .false.'
+ endif
+ write(30,'(a)') trim(line)
+ line = ' '
+ write(30,100) trim(line)
+!-------------------------------------------------------------------
+! ... set the simulation chemical mechanism data
+! class species count
+!-------------------------------------------------------------------
+ line = ' clscnt(:) = (/'
+ write(line(len_trim(line)+2:),'(5(I6,a))') clscnt(1),',',clscnt(2),',',clscnt(3),',',clscnt(4),',',clscnt(5), ' /)'
+ write(30,'(a)') trim(line)
+ line = ' '
+ write(30,100) trim(line)
+
+!-------------------------------------------------------------------
+! ... class reaction count
+!-------------------------------------------------------------------
+ do i = 1,5
+ if( clscnt(i) > 0 ) then
+ line = ' cls_rxt_cnt(:,'
+ write(line(len_trim(line)+1:),'(i1,") = (/")') i
+ m = len_trim(line) + 2
+ write(line(m:),'(4(I6,a))') cls_rxt_cnt(1,i),',',cls_rxt_cnt(2,i),',',cls_rxt_cnt(3,i),',',cls_rxt_cnt(4,i),' /)'
+ write(30,'(a)') trim(line)
+ end if
+ end do
+
+!-------------------------------------------------------------------
+! ... species symbols
+!-------------------------------------------------------------------
+ line = ' '
+ write(30,100) trim(line)
+ write(line,'(" solsym(:",i3,") = (/")') new_nq
+ m = len_trim(line) + 2
+ do n = 1,new_nq,5
+ n1 = min( n+4,new_nq )
+ if( n1 /= new_nq ) then
+ write(line(m:),'(5("''",a16,"'',")," &")') new_solsym(n:n1)
+ else
+ if( n1 > n ) then
+ write(frmt,'("(",i1)') n1 - n
+ frmt(len_trim(frmt)+1:) = '("''",a16,"'',"),"''",a16,"'' /)")'
+ else
+ frmt = '("''",a16,"'' /)")'
+ end if
+ write(line(m:),trim(frmt)) new_solsym(n:n1)
+ end if
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+
+!-------------------------------------------------------------------
+! ... species mass
+!-------------------------------------------------------------------
+ if( nq > 0 ) then
+ line = ' '
+ write(30,100) trim(line)
+ temp_mass(:) = 0.
+ do n = 1,nq
+ if( newind(n) /= 0 ) then
+ temp_mass(newind(n)) = mass(n)
+ end if
+ end do
+ line = ' adv_mass(:'
+ write(line(len_trim(line)+1:),'(i3,") = (/")') new_nq
+ m = len_trim(line) + 2
+ lstrt = m
+ do n = 1,new_nq
+ number = ' '
+ if ( temp_mass(n) > 1. ) then
+ write(num12,'(f12.6)') temp_mass(n)
+ else
+ write(num12,'(g12.6)') temp_mass(n)
+ endif
+ numlen = len_trim(num12)
+ number(12-numlen+1:12) = num12(1:numlen)
+ lpos = scan( number, '0123456789', back=.true. ) + 1
+ if( n < new_nq ) then
+ if( mod(n,5) /= 0 ) then
+ number(lpos:) = '_r8,'
+ flush = .false.
+ else
+ number(lpos:) = '_r8, &'
+ flush = .true.
+ end if
+ else
+ number(lpos:) = '_r8 /)'
+ flush = .true.
+ end if
+ line(m:) = trim( number )
+ if( .not. flush ) then
+ m = len_trim(line) + 2
+ else
+ write(30,'(a)') trim(line)
+ line = ' '
+ m = lstrt
+ end if
+ end do
+ end if
+
+!-------------------------------------------------------------------
+! ... species carbon mass
+!-------------------------------------------------------------------
+ if( nq > 0 ) then
+ line = ' '
+ write(30,100) trim(line)
+ temp_mass(:) = 0.
+ do n = 1,nq
+ if( newind(n) /= 0 ) then
+ temp_mass(newind(n)) = c_mass(n)
+ end if
+ end do
+ line = ' crb_mass(:'
+ write(line(len_trim(line)+1:),'(i3,") = (/")') new_nq
+ m = len_trim(line) + 2
+ lstrt = m
+ do n = 1,new_nq
+ number = ' '
+ write(num12,'(f12.6)') temp_mass(n)
+ numlen = len_trim(num12)
+ number(12-numlen+1:12) = num12(1:numlen)
+ lpos = scan( number, '0123456789', back=.true. ) + 1
+ if( n < new_nq ) then
+ if( mod(n,5) /= 0 ) then
+ number(lpos:) = '_r8,'
+ flush = .false.
+ else
+ number(lpos:) = '_r8, &'
+ flush = .true.
+ end if
+ else
+ number(lpos:) = '_r8 /)'
+ flush = .true.
+ end if
+ line(m:) = trim( number )
+ if( .not. flush ) then
+ m = len_trim(line) + 2
+ else
+ write(30,'(a)') trim(line)
+ line = ' '
+ m = lstrt
+ end if
+ end do
+ end if
+!-------------------------------------------------------------------
+! ... fixed species masses
+!-------------------------------------------------------------------
+ if( nfs > 0 ) then
+ line = ' '
+ write(30,100) trim(line)
+ line = ' fix_mass(:'
+ write(line(len_trim(line)+1:),'(i3,") = (/")') nfs
+ m = len_trim(line) + 2
+ lstrt = m
+ do n = 1,nfs
+ number = ' '
+ write(number,'(g15.9)') mass(n+new_nq)
+ number = adjustl( number )
+ lpos = scan( number, '0123456789', back=.true. ) + 1
+ if( n < nfs ) then
+ if( mod(n,5) /= 0 ) then
+ number(lpos:) = '_r8,'
+ flush = .false.
+ else
+ number(lpos:) = '_r8, &'
+ flush = .true.
+ end if
+ else
+ number(lpos:) = '_r8 /)'
+ flush = .true.
+ end if
+ line(m:) = trim( number )
+ if( .not. flush ) then
+ m = len_trim(line) + 2
+ else
+ write(30,'(a)') trim(line)
+ line = ' '
+ m = lstrt
+ end if
+ end do
+ end if
+
+!-------------------------------------------------------------------
+! ... class map
+!-------------------------------------------------------------------
+ line = ' '
+ write(30,100) trim(line)
+ do i = 1,5
+ if( clscnt(i) > 0 ) then
+ write(line,'(" clsmap(:",i3,",",i1,") = (/")') clscnt(i),i
+ m = len_trim(line) + 2
+ do n = 1,clscnt(i),10
+ n1 = min( n+9,clscnt(i) )
+ if( n1 /= clscnt(i) ) then
+ write(line(m:),'(10(i4,",")," &")') clsmap(n:n1,i,2)
+ else
+ if( n1 > n ) then
+ write(frmt,'("(",i1)') n1 - n
+ frmt(len_trim(frmt)+1:) = '(i4,","),i4," /)")'
+ else
+ frmt = '(i4," /)")'
+ end if
+ write(line(m:),trim(frmt)) clsmap(n:n1,i,2)
+ end if
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+ end if
+ end do
+
+!-------------------------------------------------------------------
+! ... class permutation map
+!-------------------------------------------------------------------
+ line = ' '
+ write(30,100) trim(line)
+ do i = 2,5
+ if( clscnt(i) > 0 ) then
+ write(line,'(" permute(:",i3,",",i1,") = (/")') clscnt(i),i
+ m = len_trim(line) + 2
+ do n = 1,clscnt(i),10
+ n1 = min( n+9,clscnt(i) )
+ if( n1 /= clscnt(i) ) then
+ write(line(m:),'(10(i4,",")," &")') permute(n:n1,i)
+ else
+ if( n1 > n ) then
+ write(frmt,'("(",i1)') n1 - n
+ frmt(len_trim(frmt)+1:) = '(i4,","),i4," /)")'
+ else
+ frmt = '(i4," /)")'
+ end if
+ write(line(m:),trim(frmt)) permute(n:n1,i)
+ end if
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+ end if
+ end do
+
+!-------------------------------------------------------------------
+! ... class diagonal indicies
+!-------------------------------------------------------------------
+ line = ' '
+ write(30,100) trim(line)
+ do i = 4,4
+ if( clscnt(i) > 0 ) then
+ write(line,'(" diag_map(:",i3,") = (/")') clscnt(i)
+ m = len_trim(line) + 2
+ do n = 1,clscnt(i),10
+ n1 = min( n+9,clscnt(i) )
+ if( n1 /= clscnt(i) ) then
+ write(line(m:),'(10(i4,",")," &")') sparse(i-3)%diag_map(n:n1)
+ else
+ if( n1 > n ) then
+ write(frmt,'("(",i1)') n1 - n
+ frmt(len_trim(frmt)+1:) = '(i4,","),i4," /)")'
+ else
+ frmt = '(i4," /)")'
+ end if
+ write(line(m:),trim(frmt)) sparse(i-3)%diag_map(n:n1)
+ end if
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+ end if
+ end do
+
+!-----------------------------------------------------------------------
+! ... Write the ext frcing species
+!-----------------------------------------------------------------------
+ if( usrcnt > 0 ) then
+ line = ' '
+ write(30,100) trim(line)
+ write(line,'(" extfrc_lst(:",i3,") = (/")') usrcnt
+ m = len_trim(line) + 2
+ do n = 1,usrcnt,5
+ wrk_chr(:) = ' '
+ n1 = min( n+4,usrcnt )
+ do i = 1,n1-n+1 !!n,n1
+ wrk_chr(i) = new_solsym(usrmap(i+n-1))
+ end do
+ if( n1 /= usrcnt ) then
+ write(line(m:),'(5("''",a16,"'',")," &")') wrk_chr(1:n1-n+1)
+ else
+ if( n1 > n ) then
+ write(frmt,'("(",i1)') n1 - n
+ frmt(len_trim(frmt)+1:) = '("''",a16,"'',"),"''",a16,"'' /)")'
+ else
+ frmt = '("''",a16,"'' /)")'
+ end if
+ write(line(m:),trim(frmt)) wrk_chr(1:n1-n+1)
+ end if
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+
+!-----------------------------------------------------------------------
+! frc_from_dataset
+!-----------------------------------------------------------------------
+ line = ' '
+ write(30,100) trim(line)
+ write(line,'(" frc_from_dataset(:",i3,") = (/")') usrcnt
+ m1 = len_trim(line) + 2
+ do n = 1,usrcnt,5
+ n1 = min( n+4,usrcnt )
+ m = m1
+ do l = n,n1
+ if( l /= usrcnt ) then
+ if( l /= n1 ) then
+ if( frc_from_dataset(l) ) then
+ write(line(m:),'(".true.,")')
+ else
+ write(line(m:),'(".false.,")')
+ end if
+ else
+ if( frc_from_dataset(l) ) then
+ write(line(m:),'(".true., &")')
+ else
+ write(line(m:),'(".false., &")')
+ end if
+ end if
+ else
+ if( frc_from_dataset(l) ) then
+ write(line(m:),'(".true. /)")')
+ else
+ write(line(m:),'(".false. /)")')
+ end if
+ end if
+ m = len_trim(line) + 2
+ end do
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+ end if
+
+!-------------------------------------------------------------------
+! ... fixed species
+!-------------------------------------------------------------------
+ if( nfs > 0 ) then
+ line = ' '
+ write(30,100) trim(line)
+ write(line,'(" inv_lst(:",i3,") = (/")') nfs
+ m1 = len_trim(line) + 2
+ do n = 1,nfs,5
+ n1 = min( n+4,nfs )
+ m = m1
+ do l = n,n1
+ if( l /= nfs ) then
+ if( l /= n1 ) then
+ write(line(m:),'("''",a16,"'',")') fixsym(l)
+ else
+ write(line(m:),'("''",a16,"'', &")') fixsym(l)
+ end if
+ else
+ write(line(m:),'("''",a16,"'' /)")') fixsym(l)
+ end if
+ m = len_trim(line) + 2
+ end do
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+ end if
+
+!-------------------------------------------------------------------
+! ... short lived species
+!-------------------------------------------------------------------
+ if( nslvd > 0 ) then
+ line = ' '
+ write(30,100) trim(line)
+ write(line,'(" slvd_lst(:",i3,") = (/")') nslvd
+ m1 = len_trim(line) + 2
+ do n = 1,nslvd,5
+ n1 = min( n+4,nslvd )
+ m = m1
+ do l = n,n1
+ if( l /= nslvd ) then
+ if( l /= n1 ) then
+ write(line(m:),'("''",a16,"'',")') slvdsym(l)
+ else
+ write(line(m:),'("''",a16,"'', &")') slvdsym(l)
+ end if
+ else
+ write(line(m:),'("''",a16,"'' /)")') slvdsym(l)
+ end if
+ m = len_trim(line) + 2
+ end do
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+ end if
+
+!-------------------------------------------------------------------
+! ... reaction tags
+!-------------------------------------------------------------------
+ i = count( rxt_has_tag(:rxntot) )
+ if( i > 0 ) then
+ allocate( ndx(i) )
+ l = 0
+ do m = 1,rxntot
+ if( rxt_has_tag(m) ) then
+ l = l + 1
+ ndx(l) = m
+ end if
+ end do
+ line = ' '
+ write(30,100) trim(line)
+!!$ write(line,'(" rxt_tag_cnt = ",i4)') i
+!!$ write(30,100) trim(line)
+!!$ line = ' '
+ line(7:) = 'if( allocated( rxt_tag_lst ) ) then'
+ write(30,100) trim(line)
+ line(7:) = ' deallocate( rxt_tag_lst )'
+ write(30,100) trim(line)
+ line(7:) = 'end if'
+ write(30,100) trim(line)
+ line(7:) = 'allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios )'
+ write(30,100) trim(line)
+ line(7:) = 'if( ios /= 0 ) then'
+ write(30,100) trim(line)
+ line = ' '
+ line(10:) = 'write(iulog,*) ''set_sim_dat: failed to allocate rxt_tag_lst; error = '',ios'
+ write(30,100) trim(line)
+ line(10:) = 'call endrun'
+ write(30,100) trim(line)
+ line(7:) = 'end if'
+ write(30,100) trim(line)
+ line(7:) = 'if( allocated( rxt_tag_map ) ) then'
+ write(30,100) trim(line)
+ line(7:) = ' deallocate( rxt_tag_map )'
+ write(30,100) trim(line)
+ line(7:) = 'end if'
+ write(30,100) trim(line)
+ line(7:) = 'allocate( rxt_tag_map(rxt_tag_cnt),stat=ios )'
+ write(30,100) trim(line)
+ line(7:) = 'if( ios /= 0 ) then'
+ write(30,100) trim(line)
+ line = ' '
+ line(10:) = 'write(iulog,*) ''set_sim_dat: failed to allocate rxt_tag_map; error = '',ios'
+ write(30,100) trim(line)
+ line(10:) = 'call endrun'
+ write(30,100) trim(line)
+ line(7:) = 'end if'
+ write(30,100) trim(line)
+
+ do begcnt = 1,i,200
+ endcnt = min(begcnt+199,i)
+ write(line,'(a,i6,a,i6,a)') ' rxt_tag_lst(',begcnt,':',endcnt,') = (/ '
+ m1 = len_trim(line) + 2
+ do n = begcnt,endcnt,2
+ n1 = min( n+1,endcnt )
+ m = m1
+ do l = n,n1
+ rxt_string = rxt_tag(ndx(l))
+ lpos = index( rxt_string, ',cph' )
+ if( lpos > 0 ) then
+ rxt_string = trim( rxt_string(:lpos-1) )
+ end if
+ if( l /= endcnt ) then
+ if( l /= n1 ) then
+ write(line(m:),'("''",a32,"'',")') rxt_string
+ else
+ write(line(m:),'("''",a32,"'', &")') rxt_string
+ end if
+ else
+ write(line(m:),'("''",a32,"'' /)")') rxt_string
+ end if
+ m = len_trim(line) + 2
+ end do
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+ end do
+
+ line = ' rxt_tag_map(:rxt_tag_cnt) = (/'
+ m = len_trim(line) + 2
+ do n = 1,i,10
+ n1 = min( n+9,i )
+ if( n1 /= i ) then
+ write(line(m:),'(10(i4,",")," &")') ndx(n:n1)
+ else
+ if( n1 > n ) then
+ write(frmt,'("(",i1)') n1 - n
+ frmt(len_trim(frmt)+1:) = '(i4,","),i4," /)")'
+ else
+ frmt = '(i4," /)")'
+ end if
+ write(line(m:),trim(frmt)) ndx(n:n1)
+ end if
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+ deallocate( ndx )
+ end if
+
+!-------------------------------------------------------------------
+! ... photoreactions alias
+!-------------------------------------------------------------------
+ if( phtcnt > 0 ) then
+ line = ' '
+ line(7:) = 'if( allocated( pht_alias_lst ) ) then'
+ write(30,100) trim(line)
+ line(7:) = ' deallocate( pht_alias_lst )'
+ write(30,100) trim(line)
+ line(7:) = 'end if'
+ write(30,100) trim(line)
+ line(7:) = 'allocate( pht_alias_lst(phtcnt,2),stat=ios )'
+ write(30,100) trim(line)
+ line(7:) = 'if( ios /= 0 ) then'
+ write(30,100) trim(line)
+ line = ' '
+ line(10:) = 'write(iulog,*) ''set_sim_dat: failed to allocate pht_alias_lst; error = '',ios'
+ write(30,100) trim(line)
+ line(10:) = 'call endrun'
+ write(30,100) trim(line)
+ line(7:) = 'end if'
+ write(30,100) trim(line)
+ line = ' '
+ line(7:) = 'if( allocated( pht_alias_mult ) ) then'
+ write(30,100) trim(line)
+ line(7:) = ' deallocate( pht_alias_mult )'
+ write(30,100) trim(line)
+ line(7:) = 'end if'
+ write(30,100) trim(line)
+ line(7:) = 'allocate( pht_alias_mult(phtcnt,2),stat=ios )'
+ write(30,100) trim(line)
+ line(7:) = 'if( ios /= 0 ) then'
+ write(30,100) trim(line)
+ line = ' '
+ line(10:) = 'write(iulog,*) ''set_sim_dat: failed to allocate pht_alias_mult; error = '',ios'
+ write(30,100) trim(line)
+ line(10:) = 'call endrun'
+ write(30,100) trim(line)
+ line(7:) = 'end if'
+ write(30,100) trim(line)
+ do i = 1,2
+ if( i == 1 ) then
+ line = ' pht_alias_lst(:,1) = (/ '
+ else
+ line = ' pht_alias_lst(:,2) = (/ '
+ end if
+ m1 = len_trim(line) + 2
+ do n = 1,phtcnt,4
+ n1 = min( n+3,phtcnt )
+ m = m1
+ do l = n,n1
+ rxt_string = pht_alias(l,i)
+ if( l /= phtcnt ) then
+ if( l /= n1 ) then
+ write(line(m:),'("''",a16,"'',")') rxt_string
+ else
+ write(line(m:),'("''",a16,"'', &")') rxt_string
+ end if
+ else
+ write(line(m:),'("''",a16,"'' /)")') rxt_string
+ end if
+ m = len_trim(line) + 2
+ end do
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+ end do
+
+ do i = 1,2
+ if( i == 1 ) then
+ line = ' pht_alias_mult(:,1) = (/ '
+ else
+ line = ' pht_alias_mult(:,2) = (/ '
+ end if
+ m = len_trim(line) + 2
+ do n = 1,phtcnt
+ number = ' '
+ write(number,'(a)') pht_alias_mult(n,i)
+ number = adjustl( number )
+ lpos = scan( number, '0123456789', back=.true. )
+ if( lpos == 1 ) then
+ lpos = lpos + 1
+ number(lpos:lpos) = '.'
+ end if
+ lpos = lpos + 1
+ if( n < phtcnt ) then
+ if( mod(n,5) /= 0 ) then
+ number(lpos:) = '_r8,'
+ flush = .false.
+ else
+ number(lpos:) = '_r8, &'
+ flush = .true.
+ end if
+ else
+ number(lpos:) = '_r8 /)'
+ flush = .true.
+ end if
+ line(m:) = trim( number )
+ if( .not. flush ) then
+ m = len_trim(line) + 2
+ else
+ write(30,'(a)') trim(line)
+ line = ' '
+ m = lstrt
+ end if
+ end do
+ end do
+ end if
+
+!-------------------------------------------------------------------
+! ... Enthalpy / Chem potential heating
+!-------------------------------------------------------------------
+ enthalpy_cnt = count( cph_flg )
+
+ i = enthalpy_cnt
+ has_cph: if (i>0) then
+
+ allocate( ndx(i) )
+ l = 0
+ do m = 1,rxntot
+ if( cph_flg(m) ) then
+ l = l + 1
+ ndx(l) = m
+ end if
+ end do
+ line = ' '
+
+ line(7:) = 'allocate( cph_enthalpy(enthalpy_cnt),stat=ios )'
+ write(30,100) trim(line)
+ line(7:) = 'if( ios /= 0 ) then'
+ write(30,100) trim(line)
+ line = ' '
+ line(10:) = 'write(iulog,*) ''set_sim_dat: failed to allocate cph_enthalpy; error = '',ios'
+ write(30,100) trim(line)
+ line(10:) = 'call endrun'
+ write(30,100) trim(line)
+ line(7:) = 'end if'
+ write(30,100) trim(line)
+
+
+ line(7:) = 'allocate( cph_rid(enthalpy_cnt),stat=ios )'
+ write(30,100) trim(line)
+ line(7:) = 'if( ios /= 0 ) then'
+ write(30,100) trim(line)
+ line = ' '
+ line(10:) = 'write(iulog,*) ''set_sim_dat: failed to allocate cph_rid; error = '',ios'
+ write(30,100) trim(line)
+ line(10:) = 'call endrun'
+ write(30,100) trim(line)
+ line(7:) = 'end if'
+ write(30,100) trim(line)
+
+
+ line = ' cph_rid(:) = (/'
+ m = len_trim(line) + 2
+ do n = 1,i,5
+ n1 = min( n+4,i )
+ if( n1 /= i ) then
+ write(line(m:),'(5(i15,",")," &")') ndx(n:n1)
+ else
+ if( n1 > n ) then
+ write(frmt,'("(",i2)') n1 - n
+ frmt(len_trim(frmt)+1:) = '(i15,","),i15," /)")'
+ else
+ frmt = '(i15," /)")'
+ end if
+ write(line(m:),trim(frmt)) ndx(n:n1)
+ end if
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+
+
+ line = ' cph_enthalpy(:) = (/'
+ m = len_trim(line) + 2
+ do n = 1,i,5
+ n1 = min( n+4,i )
+ if( n1 /= i ) then
+ write(line(m:),'(5(f12.6,"_r8,")," &")') enthalpy(ndx(n:n1))
+ else
+ if( n1 > n ) then
+ write(frmt,'("(",i2)') n1 - n
+ frmt(len_trim(frmt)+1:) = '(f12.6,"_r8,"),f12.6,"_r8 /)")'
+ else
+ frmt = '(f12.6,"_r8 /)")'
+ end if
+ write(line(m:),trim(frmt)) enthalpy(ndx(n:n1))
+ end if
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+
+ deallocate( ndx )
+ endif has_cph
+
+!-------------------------------------------------------------------
+! ... List number of reactants
+!-------------------------------------------------------------------
+
+
+ i = rxntot-phtcnt
+ numrnts: if (i>0) then
+
+ line = ' '
+
+ line(7:) = 'allocate( num_rnts(rxntot-phtcnt),stat=ios )'
+ write(30,100) trim(line)
+ line(7:) = 'if( ios /= 0 ) then'
+ write(30,100) trim(line)
+ line = ' '
+ line(10:) = 'write(iulog,*) ''set_sim_dat: failed to allocate num_rnts; error = '',ios'
+ write(30,100) trim(line)
+ line(10:) = 'call endrun'
+ write(30,100) trim(line)
+ line(7:) = 'end if'
+ write(30,100) trim(line)
+
+
+ line = ' num_rnts(:) = (/'
+ m = len_trim(line) + 2
+ do n = 1,i,10
+ n1 = min( n+9, i )
+ if( n1 /= i ) then
+ write(line(m:),'(10(i6,",")," &")') num_rnts(n+phtcnt:n1+phtcnt)
+ else
+ if( n1 > n ) then
+ write(frmt,'("(",i2)') n1 - n
+ frmt(len_trim(frmt)+1:) = '(i6,","),i6," /)")'
+ else
+ frmt = '(i6," /)")'
+ end if
+ write(line(m:),trim(frmt)) num_rnts(n+phtcnt:n1+phtcnt)
+ end if
+ write(30,'(a)') trim(line)
+ line = ' '
+ end do
+
+ endif numrnts
+
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'end subroutine set_sim_dat'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'end module mo_sim_dat'
+ write(30,100) trim(line)
+
+100 format(a)
+
+ close( unit = 30 )
+ end subroutine make_sim_dat
diff --git a/chem_proc/src/cam_chempp/mass_diags.f b/chem_proc/src/cam_chempp/mass_diags.f
new file mode 100644
index 0000000000..1dbde63b10
--- /dev/null
+++ b/chem_proc/src/cam_chempp/mass_diags.f
@@ -0,0 +1,299 @@
+
+ module MASS_DIAGS
+!--------------------------------------------------------------------
+! ... General purpose mozart2 diagnostic module
+!--------------------------------------------------------------------
+
+ implicit none
+
+ integer, parameter :: max_diags = 100
+
+ type CONSERVATION
+ integer, dimension(2) :: long_ind, lat_ind, lev_ind
+ real, dimension(2) :: longitudes, latitudes, levels
+ character(len=16) :: species
+ end type CONSERVATION
+
+ integer :: ndiags = 0
+ type(CONSERVATION) :: mdiags(max_diags)
+ real :: bigneg
+
+ CONTAINS
+
+ subroutine INIDIAGS( name, plon, plev, plat )
+!--------------------------------------------------------------------
+! ... Initialize the diagnostic variables
+!--------------------------------------------------------------------
+
+ implicit none
+
+!--------------------------------------------------------------------
+! ... Dummy args
+!--------------------------------------------------------------------
+ integer, intent(in) :: plon, plev, plat
+ character(len=16), intent(in) :: name
+
+ if( ndiags >= max_diags ) then
+ write(*,*) ' INIDIAGS: Exceeded diagnostic limit'
+ stop
+ end if
+ ndiags = ndiags + 1
+ mdiags(ndiags)%species = name
+ mdiags(ndiags)%long_ind = (/ 1,plon /)
+ mdiags(ndiags)%lat_ind = (/ 1,plat /)
+ mdiags(ndiags)%lev_ind = (/ 1,plev /)
+ bigneg = -HUGE( bigneg )
+ mdiags(ndiags)%longitudes = bigneg
+ mdiags(ndiags)%latitudes = bigneg
+ mdiags(ndiags)%levels = bigneg
+
+ end subroutine INIDIAGS
+
+ subroutine MASS_DIAGNOSTICS( spcsym, spccnt, plon, plev, plat )
+!--------------------------------------------------------------------
+! ... Process the mass diagnostics
+!--------------------------------------------------------------------
+
+ use IO
+
+ implicit none
+
+!--------------------------------------------------------------------
+! ... Dummy args
+!--------------------------------------------------------------------
+ integer, intent(in) :: plon, plev, plat
+ integer, intent(in) :: spccnt(:)
+ character(len=16), intent(in) :: spcsym(:,:)
+
+!--------------------------------------------------------------------
+! ... Local variables
+!--------------------------------------------------------------------
+ integer, parameter :: symlen = 8
+ integer, parameter :: numlen = 16
+ integer :: tail, head
+ integer :: retcod, nchar
+ integer :: tokcnt, m, sep
+ integer :: toklen(20)
+ integer :: iind(2)
+ real :: rind(2)
+ character(len=numlen) :: tokens(20)
+ character(len=symlen) :: tstring
+ logical :: do_tokens, do_grid
+
+ do_tokens = .true.
+ do_grid = .false.
+ tokcnt = 0
+ head = 0
+ do
+ call CARDIN( lin, buff, nchar )
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh == 'ENDMASS_DIAGNOSTICS' ) then
+ return
+ end if
+ if( do_tokens ) then
+ call GETTOKENS( buff, &
+ nchar, &
+ ',', &
+ symlen, &
+ tokens, &
+ toklen, &
+ 20, &
+ tokcnt )
+ if( tokcnt == 0 ) then
+ call ERRMES( 'Diagnostic spieces list error@', &
+ lout, &
+ buff, &
+ 1, &
+ buff )
+ end if
+ tstring = tokens(1)
+ call UPCASE( tstring )
+ if( tokcnt == 1 .and. tstring == 'ALL' ) then
+ do m = 1,spccnt(6)
+ call INIDIAGS( spcsym(m,6), plon, plev, plat )
+ end do
+ else
+ do m = 1,tokcnt
+ call INIDIAGS( tokens(m), plon, plev, plat )
+ end do
+ end if
+ do_grid = .true.
+ do_tokens = .false.
+ tail = head + 1
+ head = ndiags
+ cycle
+ else if( do_grid ) then
+ if( buffh /= 'GRID' ) then
+ call ERRMES( '"GRID" keyword missing@', &
+ lout, &
+ buff, &
+ 1, &
+ buff )
+ end if
+ do
+ call CARDIN( lin, buff, nchar )
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh == 'ENDLST' ) then
+ do_grid = .false.
+ do_tokens = .true.
+ exit
+ end if
+ sep = INDEX( buffh, '=' )
+ if( sep == 0 .or. sep == nchar ) then
+ call ERRMES( 'Grid keyword missing "=" separator@', &
+ lout, &
+ buff, &
+ 1, &
+ buff )
+ end if
+ call GETTOKENS( buff(sep+1:), &
+ nchar-sep, &
+ ',', &
+ numlen, &
+ tokens, &
+ toklen, &
+ 20, &
+ tokcnt )
+ if( tokcnt == 0 ) then
+ call ERRMES( 'Grid value format invalid@', &
+ lout, &
+ buff, &
+ 1, &
+ buff )
+ end if
+ tokcnt = MIN(tokcnt,2)
+ select case( buffh(:sep-1) )
+ case( 'LONGITUDES', 'LATITUDES', 'LEVELS' )
+ do m = 1,tokcnt
+ call RELCON( tokens(m), &
+ toklen(m), &
+ rind(m), &
+ retcod )
+ if( retcod /= 0 ) then
+ call ERRMES( '# is an invalid real number@', &
+ lout, &
+ tokens(m), &
+ toklen(m), &
+ buff )
+ end if
+ end do
+ select case( buffh(:sep-1) )
+ case( 'LONGITUDES' )
+ do m = tail,head
+ mdiags(m)%longitudes(:tokcnt) = rind(:tokcnt)
+ end do
+ case( 'LATITUDES' )
+ do m = tail,head
+ mdiags(m)%latitudes(:tokcnt) = rind(:tokcnt)
+ end do
+ case( 'LEVELS' )
+ do m = tail,head
+ mdiags(m)%levels(:tokcnt) = rind(:tokcnt)
+ end do
+ end select
+ case( 'LONG_INDEX', 'LAT_INDEX', 'LEV_INDEX' )
+ do m = 1,tokcnt
+ call INTCON( tokens(m), &
+ toklen(m), &
+ iind(m), &
+ retcod )
+ if( retcod /= 0 ) then
+ call ERRMES( ' # is an invalid integer@', &
+ lout, &
+ tokens(m), &
+ toklen(m), &
+ buff )
+ end if
+ end do
+ select case( buffh(:sep-1) )
+ case( 'LONG_INDEX' )
+ do m = tail,head
+ mdiags(m)%long_ind(:tokcnt) = iind(:tokcnt)
+ end do
+ case( 'LAT_INDEX' )
+ do m = tail,head
+ mdiags(m)%lat_ind(:tokcnt) = iind(:tokcnt)
+ end do
+ case( 'LEV_INDEX' )
+ do m = tail,head
+ mdiags(m)%lev_ind(:tokcnt) = iind(:tokcnt)
+ end do
+ end select
+ case default
+ call ERRMES( 'Grid keyword invalid@', &
+ lout, &
+ buff, &
+ 1, &
+ buff )
+ end select
+ end do
+ end if
+ end do
+ call CHECK_RANGE()
+
+ end subroutine MASS_DIAGNOSTICS
+
+ subroutine CHECK_RANGE( )
+!--------------------------------------------------------------------
+! ... Check spatial domain ranges
+!--------------------------------------------------------------------
+
+ implicit none
+
+!--------------------------------------------------------------------
+! ... Local variables
+!--------------------------------------------------------------------
+ integer :: k, m
+ real :: value
+ real, parameter :: eps = 1.e-5
+
+ do m = 1,ndiags
+ do k = 1,2
+ value = mdiags(m)%longitudes(k)
+ if( value /= bigneg ) then
+ if( value < 0. ) then
+ value = MOD( value,360. ) + 360.
+ else
+ value = MOD( value+eps,360. )
+ end if
+ mdiags(m)%longitudes(k) = value
+ end if
+ value = mdiags(m)%latitudes(k)
+ if( value /= bigneg ) then
+ if( ABS( value) > 90. ) then
+ value = SIGN( 90.-eps,value )
+ end if
+ mdiags(m)%latitudes(k) = value
+ end if
+ end do
+ end do
+
+ end subroutine CHECK_RANGE
+
+ subroutine MASS_DIAGS_SERIALIZE( unit )
+!--------------------------------------------------------------------
+! ... Write conservation info to output file
+!--------------------------------------------------------------------
+
+ implicit none
+
+!--------------------------------------------------------------------
+! ... Dummy args
+!--------------------------------------------------------------------
+ integer, intent(in) :: unit
+
+!--------------------------------------------------------------------
+! ... Local variables
+!--------------------------------------------------------------------
+ integer :: m
+
+ write(unit,'(i3)') ndiags
+ do m = 1,ndiags
+ write(unit,*) mdiags(m)
+ end do
+
+ end subroutine MASS_DIAGS_SERIALIZE
+
+ end module MASS_DIAGS
diff --git a/chem_proc/src/cam_chempp/mozpp.main.f b/chem_proc/src/cam_chempp/mozpp.main.f
new file mode 100644
index 0000000000..f9a2e4c649
--- /dev/null
+++ b/chem_proc/src/cam_chempp/mozpp.main.f
@@ -0,0 +1,2309 @@
+
+ program mozart_pp
+!-----------------------------------------------------------------------
+! ... Mozart chemistry pre-processor
+!-----------------------------------------------------------------------
+
+ use io
+ use elements
+ use mass_diags
+ use var_mod
+ use rxt_mod
+ use lin_matrix
+ use nln_matrix
+ use lu_factor
+ use lu_solve
+ use prod_loss
+ use ind_prod
+ use set_rxt_rates
+ use mo_spat_dims
+ use mo_ver_hdr
+ use mo_files_hdr
+ use mo_hist_out
+ use mo_chem, only : chem
+ use sp_mods, only : sparsity
+ use mo_ver_opts, only : ver_opts
+ use rxt_equations_mod
+ use rxt_mod, only : cph_flg
+ use utils
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, target :: nind(200)
+ integer, pointer, dimension(:) :: nbeg, nend
+ integer :: dimensions(6) = (/ 128, 64, 18, 1, 1, 32 /)
+
+ integer :: plon, plonl, plat, plev ! spatial dimensions of simulation
+ integer :: jintmx, nxpt ! slt parameters for bounds and array "padding"
+ integer :: sub_cnt = 0 ! count of user subroutines
+
+ integer :: class, clsndx
+ integer :: grp_rows, rel_rows
+!-----------------------------------------------------------------------
+! ... Iteration counts are as follows:
+! (1) == "hov" iteration count
+! (2) == "implicit" iteration count
+! (3) == "implicit" jacobian update count( first count iterations)
+!-----------------------------------------------------------------------
+ character(len=1), parameter :: on = 'y'
+ character(len=1), parameter :: off = 'n'
+
+ integer :: iter_counts(4) = (/ 7, 4, 2, 5 /)
+
+ character(len=320) :: lib_src(350)
+ character(len=320) :: chem_src(50)
+ character(len=320) :: filename(100)
+ character(len=320) :: filepath(100)
+ character(len=320) :: sub_names(100)
+ character(len=80) :: iout(100)
+ character(len=320) :: mod_names(100)
+ character(len=320) :: mod_paths(100)
+ character(len=320) :: mod_src(100)
+ character(len=64) :: histinp(4)
+ character(len=64) :: histout(6)
+ character(len=16) :: jobctl(8)
+ character(len=16) :: wrk_rxt(10)
+ character(len=10) :: clshdr(5)
+ character(len=16) :: wrk_chr(10)
+ character(len=580) :: command, cpp_command
+ character(len=256) :: errcom, filout, filin
+ character(len=64) :: oper_flpth
+ character(len=64) :: cpp_dir, cpp_opts
+ character(len=64) :: wrk_dir
+ character(len=64) :: tar_flnm
+ character(len=64) :: subfile
+ character(len=64) :: filenm
+ character(len=64) :: tmp_filenm
+ character(len=16) :: param
+ character(len=16) :: hostname
+ character(len=16) :: jobname
+
+ character(len=16) :: machine = 'IBM'
+ character(len=16) :: march = 'SCALAR'
+ character(len=16) :: model = 'CAM'
+ character(len=16) :: arch_type = 'HYBRID'
+ character(len=16) :: char
+ character(len=4) :: ftunit = 'ft'
+ character(len=1) :: errflg
+
+ integer, allocatable :: mask(:)
+ integer :: entry(11)
+ integer :: filelines(5)
+ integer :: dyn_hst_fld_cnt(2) ! multi and single level field count
+ integer :: ratind(2)
+ integer :: additions(2)
+ integer :: multiplications(2)
+ integer :: nzcnt(2) = 0 ! number of nonzero entries in lu
+ integer :: file_cnt, hst_file_cnt
+ integer :: nchar, k, noff, m, j, l, il, iu
+ integer :: i, indx, ntab, ios, astat
+ integer :: spcno, counter, rxno, col, retcod, length, place
+ integer :: fixrows, rxmrows, pcelrows, pceprows
+ integer :: cpucnt = 1 ! number of cpu's
+
+ logical, target :: options(20)
+ logical, allocatable :: lin_mat_pat(:)
+ logical, pointer :: usemods
+ logical :: null_flag
+ logical :: found
+ logical :: lexist
+ logical :: vec_ftns = .false. ! vector functions
+ logical :: radj_flag
+ logical :: ohstflag ! output history tape flag
+ logical :: diagprnt = .false. ! chktrc or negtrc diagnostics printout
+ logical :: tavgprnt = .false. ! time averaged printout
+ logical :: longnames = .false. ! do not use long names
+ integer :: veclen = 0 ! vector length in vectorized solver
+ integer :: rxt_tag_cnt
+ integer :: enthalpy_cnt
+ character(len=32) :: rxt_rates_conv_file = 'mo_rxt_rates_conv.F90'
+
+ type(SPARSITY) :: sparse(2)
+
+!----------------------------------------------------------------------------------
+! ... Function declarations
+!----------------------------------------------------------------------------------
+ integer :: LENOF
+ integer :: STRLEN
+
+!----------------------------------------------------------------------------------
+! ... The options array has the following mapping:
+!
+! (1) Chemistry (on/off) (2) Target machine == cray (yes/no)
+! (3) Diffusion (on/off) (4) Convection (on/off)
+! (5) Iter norms (on/off) (6) Conservation (on/off)
+! (7) Source code (yes/no) (8) Submission files (yes/no)
+! (9) Execution (yes/no) (10) SLT fixer (on/off)
+! (11) Multitasking (yes/no) (12) Rxt rate lookup table (on/off)
+! (13) Relative humidity (yes/no) (14) New compiler (yes/no)
+! (15) Height field (yes/no ) (16) User "hook" (yes/no)
+! (17) Use f90 modules (yes/no) (18) Make and use f90 names module (yes/no)
+! (19 - 20) Unused
+!
+! Iter norms, Execution, and Rxt rate lookup default to off
+!----------------------------------------------------------------------------------
+ data options / 4*.true., .false., 3*.true., .false., 2*.true., 2*.false., .true., 6*.false. /
+ data clshdr / 'Explicit', 'Ebi', 'Hov', 'Implicit', 'Rodas' /
+
+!-----------------------------------------------------------------------
+! ... Initialize pointers and data
+!-----------------------------------------------------------------------
+ usemods => options(17)
+ nbeg => nind(1:100)
+ nend => nind(101:200)
+ jobctl(:) = ' '
+ histout(:) = ' '
+ histinp(:) = ' '
+ histinp(4) = 'LONG'
+ wrk_dir = '$TMPDIR'
+ subfile = ' '
+ entry(:) = 0
+ filelines(:) = 0
+ src_dir = '../bkend/'
+
+!-----------------------------------------------------------------------
+! ... Set default filenames/paths
+!-----------------------------------------------------------------------
+ output_path = '../output/'
+ input_path = '../input/'
+ temp_path = '../tmp/'
+ sim_dat_path = output_path
+ procout_path = output_path
+ procfiles_path = '../procfiles/'
+ sim_dat_filename = 'sim.dat'
+ sim_dat_filespec = trim(sim_dat_path) // 'sim.dat'
+ cpp_dir = ' '
+ cpp_opts = '-nostdinc -P -C -I.'
+
+!-----------------------------------------------------------------------
+! ... Assign default input, output units
+!-----------------------------------------------------------------------
+ lin = 5
+ lout = 6
+
+!-----------------------------------------------------------------------
+! ... Get arguments
+!-----------------------------------------------------------------------
+ filin = ' '
+ filout = ' '
+ call getarg( 1, filin )
+ call getarg( 2, filout )
+
+!-----------------------------------------------------------------------
+! ... No input filespec on command line; request input
+!-----------------------------------------------------------------------
+ if( filin == ' ' ) then
+ write(*,'('' Enter filespec of input file'')')
+ read(*,'(a80)') filin
+ if( filin == ' ' ) then
+ filin = './mozart2.inp'
+ end if
+ end if
+ open( unit = 5, &
+ file = trim( filin ), &
+ status = 'old', &
+ iostat = ios )
+ if( ios /= 0 ) then
+ write(*,*) ' Failed to open file ',trim( filin )
+ write(*,*) ' Error code = ',ios
+ stop
+ end if
+
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+
+!-----------------------------------------------------------------------
+! ... Check for input overide and process if present
+! if input unit 5 is overriden take
+! all simulation input from lin
+!-----------------------------------------------------------------------
+ if( buffh(:18) == 'INPUT_UNIT_NUMBER=' ) then
+ errflg = on
+ call intcon( buff(19:nchar), &
+ nchar - 18, &
+ lin, &
+ retcod )
+ if( retcod /= 0 ) then
+ errcom = buff(19:nchar) // ' is an invalid unit number@'
+ else
+ if( lin <= 0 ) then
+ errcom = buff(19:nchar) // ' is an invalid unit number@'
+ else if( lin <= 3 ) then
+ errcom = buff(19:nchar) // ' is a reserved unit number@'
+ else if( lin == 6 ) then
+ errcom = buff(19:nchar) // ' is a reserved unit number@'
+ else if( lin >= 100 ) then
+ errcom = buff(19:nchar) // ' is an invalid unit number@'
+ else
+ errflg = off
+ end if
+ end if
+
+ if( errflg == on ) then
+ call errmes( errcom, 6, param, 8, buff )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Check for input file override and process if present
+!-----------------------------------------------------------------------
+ call cardin ( 5, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ if( buffh(:15) == 'INPUT_FILESPEC=' ) then
+ filin = buff(16:nchar)
+ if( lin <= 10 ) then
+ write (ftunit(3:4),'(''0'',i1)') lin
+ else
+ write (ftunit(3:4),'(i2)') lin
+ end if
+ close( unit = 5 )
+ open( unit = lin, &
+ file = trim( filin ), &
+ status = 'old', &
+ iostat = ios )
+ if( ios /= 0 ) then
+ write(*,*) ' Failed to open file ',trim( filin )
+ write(*,*) ' Error code = ',ios
+ stop
+ end if
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ else
+ call errmes( ' ** Input reassignment requires both a unit number and filename@', &
+ lout, &
+ param, &
+ 8, &
+ buff )
+ end if
+ end if
+
+!-----------------------------------------------------------------------
+! ... Check for simulation start card (begsim)
+!-----------------------------------------------------------------------
+ if( buffh /= 'BEGSIM' ) then
+ call errmes ( ' ** first card not begsim **@', &
+ lout, &
+ param, &
+ 8, &
+ buff )
+ end if
+
+ call cardin ( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+
+!-----------------------------------------------------------------------
+! ... Check for doc file overide and process if present
+!-----------------------------------------------------------------------
+ if( buffh(:19) == 'OUTPUT_UNIT_NUMBER=' ) then
+ errflg = on
+ call intcon( buff(20:nchar), &
+ nchar - 19, &
+ lout, &
+ retcod )
+ if( retcod /= 0 ) then
+ errcom = buff(20:nchar) // ' is an invalid unit number@'
+ else
+ if( lout <= 0 ) then
+ errcom = buff(20:nchar) // ' is an invalid unit number@'
+ else if( lout <= 3 ) then
+ errcom = buff(20:nchar) // ' is a reserved unit number@'
+ else if( lout == lin .or. lout == 6 ) then
+ errcom = buff(20:nchar) // ' is a reserved unit number@'
+ else if( lout >= 100 ) then
+ errcom = buff(20:nchar) // ' is an invalid unit number@'
+ else
+ errflg = off
+ end if
+ end if
+
+!-----------------------------------------------------------------------
+! ... Error in assigning output unit number
+!-----------------------------------------------------------------------
+ if( errflg == on ) then
+ call errmes ( errcom, 6, param, 8, buff )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Set the output unit number
+!-----------------------------------------------------------------------
+ if( lout <= 10 ) then
+ write (ftunit(3:4),'(''0'',i1)') lout
+ else
+ write (ftunit(3:4),'(i2)') lout
+ end if
+
+ call cardin ( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+
+!-----------------------------------------------------------------------
+! ... get output_file
+!-----------------------------------------------------------------------
+ if( buffh(:12) == 'OUTPUT_FILE=' ) then
+ filout = buff(13:nchar)
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ else
+ call errmes( ' ** Output reassignment requires both a unit number and filename@', &
+ lout, &
+ param, &
+ 8, &
+ buff )
+ end if
+ else
+!-----------------------------------------------------------------------
+! ... Assign output unit
+!-----------------------------------------------------------------------
+ if( filout == ' ' ) then
+ write(*,'('' Enter filename of output file'')')
+ read(*,'(a80)') filout
+ if( filout == ' ' ) then
+ filout = 'mozart2.doc'
+ end if
+ filout = trim(output_path) // trim( filout )
+ end if
+ open( unit = lout, &
+ file = trim( filout ), &
+ status = 'new', &
+ iostat = ios )
+ if( ios /= 0 ) then
+ write(*,*) ' Failed to open file ',trim(filout)
+ write(*,*) ' Error code = ',ios
+ stop
+ end if
+ end if
+
+ do
+!-----------------------------------------------------------------------
+! ... Check for procout path override
+!-----------------------------------------------------------------------
+ if( buffh(:13) == 'PROCOUT_PATH=' ) then
+ procout_path = buff(14:nchar)
+!-----------------------------------------------------------------------
+! ... Check for output path override
+!-----------------------------------------------------------------------
+ else if( buffh(:15) == 'PROCFILES_PATH=' ) then
+ procfiles_path = buff(16:nchar)
+ else if( buffh(:12) == 'OUTPUT_PATH=' ) then
+ output_path = buff(13:nchar)
+!-----------------------------------------------------------------------
+! ... Check for tmp_path override
+!-----------------------------------------------------------------------
+ else if( buffh(:10) == 'TEMP_PATH=' ) then
+ temp_path= buff(11:nchar)
+!-----------------------------------------------------------------------
+! ... Check for sim_dat_path override
+!-----------------------------------------------------------------------
+ else if( buffh(:13) == 'SIM_DAT_PATH=' ) then
+ sim_dat_path = buff(14:nchar)
+!-----------------------------------------------------------------------
+! ... Check for src_path override
+!-----------------------------------------------------------------------
+ else if( buffh(:9) == 'SRC_PATH=' ) then
+ src_dir = buff(10:nchar)
+!-----------------------------------------------------------------------
+! ... Check for sim_dat_filename override
+!-----------------------------------------------------------------------
+ else if( buffh(:17) == 'SIM_DAT_FILENAME=' ) then
+ sim_dat_filename = buff(18:nchar)
+ sim_dat_filespec = trim( sim_dat_path ) // trim( sim_dat_filename )
+ inquire( file = trim( sim_dat_filespec ), exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f ' // trim( sim_dat_filespec ) )
+ end if
+ else
+ exit
+ end if
+ call cardin ( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ end do
+
+!-----------------------------------------------------------------------
+! ... Find cpp preprocessor
+!-----------------------------------------------------------------------
+ command = 'which cpp > ' // trim(temp_path) // 'cpp.path'
+ call system( trim( command ) )
+ open( unit=20, file=trim(temp_path)//'cpp.path', iostat=ios )
+ if( ios /= 0 ) then
+ write(*,*) ' Failed to locate cpp path'
+ stop
+ end if
+ read(20,'(a)',iostat=ios) iout(1)
+ if( ios /= 0 ) then
+ write(*,*) ' Failed to read cpp path'
+ stop
+ end if
+ nend(1) = index( trim(iout(1)), 'cpp' )
+ if( nend(1) > 0 ) then
+ cpp_dir = iout(1)(:nend(1)+2)
+ close( 20 )
+ else
+ write(*,*) ' Failed to locate cpp path'
+ stop
+ end if
+
+!-----------------------------------------------------------------------
+! ... Check for output file override and process if present
+!-----------------------------------------------------------------------
+ filout = trim(output_path) // filout
+ open( unit = lout, &
+ file = trim( filout ), &
+ status = 'replace', &
+ iostat = ios )
+ if( ios /= 0 ) then
+ write(*,*) ' Failed to open file ',trim(filout)
+ write(*,*) ' Error code = ',ios
+ stop
+ end if
+
+!-----------------------------------------------------------------------
+! ... Check for comments and process if present
+!-----------------------------------------------------------------------
+ if( trim(buffh) == 'COMMENTS' ) then
+ k = 1
+ do
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ if( buffh == 'ENDCOMMENTS' ) then
+ exit
+ end if
+ iout(k) = buff
+ k = k + 1
+ end do
+
+ k = k - 1
+ noff = 100
+
+ do m = 1,k
+ buff = iout(m)
+ do j = 1,80
+ if( buff(j:j) /= ' ' ) then
+ exit
+ end if
+ end do
+ l = j
+ do j = 80,l,-1
+ if( buff(j:j) /= ' ' ) then
+ nchar = j - l + 1
+ nchar = 40 - nchar/2
+ nbeg(m) = l
+ nend(m) = j
+ noff = MIN( nchar, noff )
+ exit
+ end if
+ end do
+ end do
+
+ do m = 1,k
+ buff = iout(m)
+ iout(m) = ' '
+ il = nbeg(m)
+ if( il /= 0 ) then
+ iu = nend(m)
+ iout(m)(noff:) = buff(il:iu)
+ end if
+ end do
+
+!-----------------------------------------------------------------------
+! ... Write out the comments
+!-----------------------------------------------------------------------
+ write(lout,*) ' '
+ write(lout,*) ' '
+ write(lout,1565)
+ write(lout,1571)
+ write(lout,1571)
+ write(lout,1567) (iout(m),m = 1,k)
+ write(lout,1571)
+ write(lout,1571)
+ write(lout,1565)
+ do m = 1,k
+ iout(m) = ' '
+ end do
+ call cardin ( lin, &
+ buff, &
+ nchar )
+ buffh = buff
+ call upcase( buffh )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Clean the temp work directory
+!-----------------------------------------------------------------------
+ call system( 'rm -f ' // trim( temp_path ) // '*' )
+!-----------------------------------------------------------------------
+! ... Initialize the variables
+!-----------------------------------------------------------------------
+ call var_ini
+!-----------------------------------------------------------------------
+! ... Initialize the reactions
+!-----------------------------------------------------------------------
+ call rxt_ini
+!-----------------------------------------------------------------------
+! ... The species symbol list processing
+!-----------------------------------------------------------------------
+ call symbol( iout )
+ ntab = maxval( spccnt(1:5) )
+
+!-----------------------------------------------------------------------
+! ... Get variable mass
+!-----------------------------------------------------------------------
+ call iniele
+ do i = 1,spccnt(1)
+ if( aliases(i) /= ' ' ) then
+ mass(i) = com_mass( aliases(i) )
+ c_mass(i) = com_mass( aliases(i),carbmass=.true. )
+ else
+ mass(i) = com_mass( solsym(i) )
+ c_mass(i) = com_mass( solsym(i),carbmass=.true. )
+ end if
+ end do
+ do i = spccnt(1)+1, spccnt(1)+spccnt(3)
+ if( aliases(i) /= ' ' ) then
+ mass(i) = com_mass( aliases(i) )
+ c_mass(i) = com_mass( aliases(i),carbmass=.true. )
+ else
+ mass(i) = com_mass( fixsym(i-spccnt(1)) )
+ c_mass(i) = com_mass( fixsym(i-spccnt(1)),carbmass=.true. )
+ end if
+ end do
+
+!-----------------------------------------------------------------------
+! ... Form individual group members
+!-----------------------------------------------------------------------
+ i = 0
+ do l = 1,ngrp
+ do k = 1,grpcnt(l)
+ j = grpmap(k,l)
+ if( j <= 1999 ) then
+ j = j - 1000
+ i = i + 1
+ grp_mem_sym(i) = solsym(j)
+ end if
+ end do
+ end do
+ grp_mem_cnt = i
+
+!-----------------------------------------------------------------------
+! ... Now begin group modification process by making
+! new species numbering and group association tables
+!-----------------------------------------------------------------------
+ counter = 0
+ do i = 1,ngrp
+ do j = 1,grpcnt(i)
+ indx = mod( grpmap(j,i),1000 )
+ grpflg(indx) = i
+ counter = counter + 1
+ mem2grp_map(counter) = i
+ grp_rat_ind(indx) = counter
+ end do
+ new_solsym(i) = grpsym(i)
+ end do
+
+ do i = 1,relcnt
+ indx = relmap(i,1)
+ rel_flg(indx) = i
+ end do
+
+ indx = ngrp
+ do i = 1,nq
+ if( grpflg(i) /= 0 .or. rel_flg(i) /= 0 ) then
+ cycle
+ else
+ indx = indx + 1
+ newind(i) = indx
+ new_solsym(indx) = solsym(i)
+ end if
+ end do
+ new_nq = indx
+
+ write(lout,*) ' '
+ write(lout,*) ' '
+ write(lout,230)
+ do j = 1,nq
+ if( aliases(j) == ' ' ) then
+ write(lout,231) j, solsym(j)
+ else
+ write(lout,'(6x,''('',i3,'')'',2x,a16,3x,''('',a,'')'')') j, solsym(j), trim( aliases(j) )
+ end if
+ end do
+ if( relcnt /= 0 ) then
+ write(lout,235)
+ do j = 1,relcnt
+ length = STRLEN( solsym(relmap(j,1)) )
+ buff = ' '
+ write(buff,'(6x,''('',i2,'')'')') j
+ buff(STRLEN(buff)+2:) = solsym(relmap(j,1))(:length) // ' ~ ' // solsym(relmap(j,2))
+ write(lout,'(a)') buff(:STRLEN(buff))
+ end do
+ end if
+ if( nfs /= 0 ) then
+ write(lout,*) ' '
+ write(lout,*) ' '
+ write(lout,232)
+ write(lout,231) (j, fixsym(j), j = 1,nfs)
+ end if
+ if( ncol /= 0 ) then
+ write(lout,*) ' '
+ write(lout,*) ' '
+ write(lout,236)
+ write(lout,238) (j, colsym(j), colub(j), j = 1,ncol)
+ end if
+ if( ngrp /= 0 ) then
+ write(lout,*) ' '
+ write(lout,*) ' '
+ write (lout,237)
+ write (lout,'(2x,''('',i2,'')'',2x,a80)') ( j, iout(j), j = 1,ngrp )
+ do j = 1,ngrp
+ iout(j) = ' '
+ end do
+ end if
+
+!-----------------------------------------------------------------------
+! ... Write out group modified species list
+!-----------------------------------------------------------------------
+ if( ngrp /= 0 ) then
+ write(lout,*) ' '
+ write(lout,*) ' '
+ write(lout,*) 'Advected species'
+ write(lout,231) (j, new_solsym(j), j = 1,new_nq)
+ end if
+
+!-----------------------------------------------------------------------
+! ... Define the solution classes
+!-----------------------------------------------------------------------
+ call sol_cls( iout )
+
+!-----------------------------------------------------------------------
+! ... Write out class lists
+!-----------------------------------------------------------------------
+ write(lout,*) ' '
+ write(lout,'(''Class List'')')
+ write(lout,'(''=========='')')
+ do k = 1,5
+ if( clscnt(k) /= 0 ) then
+ if( k > 1 ) then
+ write(lout,*) ' '
+ end if
+ write(lout,'(1x,a10)') clshdr(k)
+ write(lout,'('' --------'')')
+ write(lout,231) (j, new_solsym(clsmap(j,k,2)), j = 1,clscnt(k) )
+ end if
+ end do
+!-----------------------------------------------------------------------
+! End of the variable list processing
+!------------------------------------------------------------------------
+
+!=======================================================================
+! ... Chemistry processing
+!=======================================================================
+ call cardin( lin, buff, nchar )
+ call upcase( buff )
+ if( buff == 'CHEMISTRY' ) then
+!-----------------------------------------------------------------------
+! ... Set the reactions and rates
+!-----------------------------------------------------------------------
+ call chem
+ options(1) = .true.
+ gascnt = rxntot - phtcnt
+ do i = 1,rxntot
+ if( rxt_tag(i) /= ' ' ) then
+ rxt_has_tag(i) = .true.
+ end if
+ end do
+ call cardin( lin, &
+ buff, &
+ nchar )
+ call upcase( buff )
+ else
+ options(1) = .false.
+ end if
+
+!-----------------------------------------------------------------------
+! ... Transform the "hetero" reaction map
+! The 1st column is the new species number
+! if the species is a group member then the second column
+! indicates the species number within the group ( the 1st col)
+!-----------------------------------------------------------------------
+ do j = 1,hetcnt
+ spcno = hetmap(j,1)
+ if( grpflg(spcno) /= 0 ) then
+ hetmap(j,1) = grpflg(spcno)
+ hetmap(j,2) = grp_rat_ind(spcno)
+ else
+ hetmap(j,1) = newind(spcno)
+ hetmap(j,2) = 0
+ end if
+ end do
+
+!-----------------------------------------------------------------------
+! ... Then the "extraneous" reaction map
+!-----------------------------------------------------------------------
+ do j = 1,usrcnt
+ spcno = usrmap(j)
+ if( grpflg(spcno) /= 0 ) then
+ usrmap(j) = grpflg(spcno)
+ else
+ usrmap(j) = newind(spcno)
+ end if
+ end do
+
+!=======================================================================
+! ... The run parameters processing section
+!=======================================================================
+ if( buff == 'ENDSIM' ) then
+ go to 292
+ else if( buff == 'SIMULATIONPARAMETERS' ) then
+ do
+ call cardin( lin, &
+ buff, &
+ nchar )
+ call upcase( buff )
+ if( buff == 'SPATIALDIMENSIONS' ) then
+ if( entry(1) /= 0 ) then
+ call errmes( ' spatial dimensions already' &
+ // ' prescribed@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else
+ entry(1) = 1
+ call spat_dims( buff, dimensions )
+ plon = dimensions(1)
+ plat = dimensions(2)
+ plev = dimensions(3)
+ nxpt = dimensions(4)
+ jintmx = dimensions(5)
+ plonl = dimensions(6)
+ end if
+ else if( buff == 'MASSDIAGNOSTICS' ) then
+ if( entry(11) /= 0 ) then
+ call errmes( ' Mass diagsnostics already prescribed@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else if( entry(1) == 0 ) then
+ call errmes( ' Spatial dimensions must be done before mass diags@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else
+ entry(11) = 1
+ call mass_diagnostics( spcsym, &
+ spccnt, &
+ plon, plev, plat )
+ end if
+ else if( buff == 'VERSIONOPTIONS' ) then
+ if( entry(2) /= 0 ) then
+ call errmes( ' Version options already prescribed@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else
+ entry(2) = 1
+ call ver_opts( options(2:), model, machine, march, arch_type, &
+ wrk_dir, cpp_dir, cpp_opts, subfile, diagprnt, &
+ tavgprnt, cpucnt, vec_ftns, veclen )
+!-----------------------------------------------------------------------
+! ... Write out the species and reaction id files
+!-----------------------------------------------------------------------
+ if( options(18) ) then
+ call make_name_mod
+ call make_rxt_name_mod
+ !call make_het_name_mod
+ end if
+ end if
+ else if( buff == 'EXECUTIONOPTIONS' ) then
+ if( entry(4) /= 0 ) then
+ call errmes( ' Exec options already prescribed@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else
+ entry(4) = 1
+ call exe_opts( options(8), &
+ lin, &
+ lout )
+ end if
+ else if( buff == 'USERSUBROUTINES' ) then
+ if( entry(3) /= 0 ) then
+ call errmes( ' Subroutines already specified@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else
+ entry(3) = 1
+ call usrsubs( sub_names, &
+ sub_cnt )
+!-----------------------------------------------------------------------
+! ... Parse user file pathnames
+!-----------------------------------------------------------------------
+ if( sub_cnt /= 0 ) then
+ do i = 1,sub_cnt
+ call parse_flpth( sub_names(i), &
+ filename(i), &
+ filepath(i) )
+ end do
+ do i = 1,sub_cnt
+ if( index( filename(i), '.mod', back = .true. ) /= 0 ) then
+ options(17) = .true. ! force fortran90
+ usemods = .true.
+ exit
+ end if
+ end do
+ end if
+ end if
+ else if( buff == 'JOBCONTROL' ) then
+ if( entry(5) /= 0 ) then
+ call errmes( ' Job control already specified@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else
+ entry(5) = 1
+ call job_ctl( lin, &
+ lout, &
+ jobctl )
+ end if
+ else if( buff == 'NUMERICALCONTROL' ) then
+ if( entry(10) /= 0 ) then
+ call errmes( ' Numerical control already specified@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else
+ entry(10) = 1
+ call num_ctl( iter_counts )
+ end if
+ else if( buff == 'INPUTS' ) then
+ if( entry(6) /= 0 ) then
+ call errmes( ' Inputs already specified@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else
+ entry(6) = 1
+ call hist_inp( lin, &
+ lout, &
+ histinp, &
+ dyn_hst_fld_cnt )
+ end if
+ else if( buff == 'OUTPUTS' ) then
+ if( entry(7) /= 0 ) then
+ call errmes( ' Outputs already specified@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else
+ entry(6) = 1
+ call hist_out( histout, longnames, hst_file_cnt )
+ end if
+ else if( buff == 'SURFACEFLUX' ) then
+ if( entry(8) /= 0 ) then
+ call errmes( ' Surf flux already specified@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else
+ entry(8) = 1
+ call srfflx( lin, &
+ lout, &
+ new_nq, &
+ new_solsym, &
+ srf_flx_map, &
+ srf_flx_cnt, &
+ 1 )
+ end if
+ else if( buff == 'SURFACEDEPOSITION' ) then
+ if( entry(9) /= 0 ) then
+ call errmes( ' Surf Dep already specified@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ else
+ entry(9) = 1
+ call srfflx( lin, &
+ lout, &
+ new_nq, &
+ new_solsym, &
+ dvel_map, &
+ dvel_cnt, &
+ 2 )
+ end if
+ else if( buff == 'ENDSIMULATIONPARAMETERS' ) then
+ exit
+ else if( buff /= 'ENDPAR' ) then
+ call errmes ( ' endsim card missing@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ end if
+ end do
+ else
+ call errmes ( ' endsim card missing@', &
+ lout, &
+ char, &
+ 1, &
+ buff )
+ end if
+292 continue
+
+Has_chemistry: &
+ if( options(1) ) then ! do only if there is chemistry
+!=======================================================================
+! ... Weed out the proportional products in all reaction maps
+!=======================================================================
+ allocate( mask(max(7,prd_limp1)),stat=astat )
+ if( astat /= 0 ) then
+ write(lout,*) 'Failed to allocate the mask array; error = ',astat
+ stop 'abort'
+ end if
+!-----------------------------------------------------------------------
+! ... First the "independent" production map
+!-----------------------------------------------------------------------
+ do j = 1,prdcnt
+ do k = 2,prd_limp1
+ spcno = prdmap(j,k)
+ if( spcno == 0 ) then
+ mask(k) = -1
+ exit
+ else if( rel_flg(spcno) == 0 ) then
+ mask(k) = 1
+ else
+ mask(k) = 0
+ end if
+ end do
+ place = 1
+ do k = 2,prd_limp1
+ if( mask(k) == -1 ) then
+ prdmap(j,place+1:prd_limp1) = 0
+ exit
+ else if( mask(k) == 1 ) then
+ place = place + 1
+ prdmap(j,place) = prdmap(j,k)
+ end if
+ end do
+ end do
+
+!-----------------------------------------------------------------------
+! ... Then the "regular" reaction map
+!-----------------------------------------------------------------------
+ do i = 1,2
+ do j = 1,rxmcnt(i)
+ do k = i+2,i+prd_limp1
+ spcno = rxmap(j,k,i)
+ if( spcno == 0 ) then
+ mask(k) = -1
+ exit
+ else if( rel_flg(spcno) == 0 ) then
+ mask(k) = 1
+ else
+ mask(k) = 0
+ end if
+ end do
+ place = i + 1
+ do k = i+2,i+prd_limp1
+ if( mask(k) == -1 ) then
+ rxmap(j,place+1:i+prd_limp1,i) = 0
+ exit
+ else if( mask(k) == 1 ) then
+ place = place + 1
+ rxmap(j,place,i) = rxmap(j,k,i)
+ end if
+ end do
+ end do
+ end do
+
+!-----------------------------------------------------------------------
+! ... Now xform all "proportional" reactants to proportional species
+! NOTE! The proportional reactants are replaced by the NEGATIVE
+! index of the species they are proportional to
+!-----------------------------------------------------------------------
+ do i = 1,2
+ do j = 1,rxmcnt(i)
+ counter = 0
+ do k = 2,i+1 ! only do the reactants
+ spcno = rxmap(j,k,i)
+ if( rel_flg(spcno) /= 0 ) then
+ counter = counter + 1
+ rxmap(j,k,i) = -relmap(rel_flg(spcno),2)
+ ratind(counter) = spcno
+ end if
+ end do
+ if( counter /= 0 ) then
+ rxno = rxmap(j,1,i)
+ rel_rxt_cnt(counter) = rel_rxt_cnt(counter) + 1
+ indx = rel_rxt_cnt(counter)
+ rel_rxt_map(indx,1,counter) = rxno !the reaction number
+ do l = 1,counter
+ rel_rxt_map(indx,l+1,counter) = rel_flg(ratind(l))
+ end do
+ rel_rxt_pntr(rxno,1) = counter
+ rel_rxt_pntr(rxno,2) = indx
+ end if
+ end do
+ end do
+
+!-----------------------------------------------------------------------
+! Now do the actual reaction matrix transforms
+! The first phase just does the basic x-form.
+! The second phase scans resultant maps to "eliminate"
+! matching product and reactant species in the
+! same reaction.
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! ... First the "independent" production map
+!-----------------------------------------------------------------------
+ do j = 1,prdcnt
+ do k = 2,prd_limp1
+ spcno = prdmap(j,k)
+ if( spcno == 0 ) then
+ exit
+ else if( grpflg(spcno) /= 0 ) then
+ prdmap(j,k) = grpflg(spcno)
+ else
+ prdmap(j,k) = newind(spcno)
+ end if
+ end do
+ end do
+
+!-----------------------------------------------------------------------
+! ... Then the "regular" reaction map
+!-----------------------------------------------------------------------
+ do i = 1,2
+ do j = 1,rxmcnt(i)
+ counter = 0
+ do k = 2,i+prd_limp1
+ spcno = abs( rxmap(j,k,i) )
+ if( spcno == 0 ) then
+ exit
+ else if( grpflg(spcno) /= 0 ) then
+ rxmap(j,k,i) = SIGN( grpflg(spcno), rxmap(j,k,i) )
+ if( i == 1 ) then
+ if( k == 2 ) then
+ counter = counter + 1
+ ratind(counter) = spcno
+ end if
+ else
+ if( k <= 3 ) then
+ counter = counter + 1
+ ratind(counter) = spcno
+ end if
+ end if
+ else
+ rxmap(j,k,i) = SIGN( newind(spcno), rxmap(j,k,i) )
+ end if
+ end do
+ if( counter /= 0 ) then
+ rxno = rxmap(j,1,i)
+ grp_rat_cnt(counter) = grp_rat_cnt(counter) + 1
+ indx = grp_rat_cnt(counter)
+ grp_rat_map(indx,1,counter) = rxno
+ do l = 1,counter
+ grp_rat_map(indx,l+1,counter) = grp_rat_ind(ratind(l))
+ end do
+ rxt_to_grp_map(rxno,1) = counter
+ rxt_to_grp_map(rxno,2) = indx
+ end if
+ end do
+ end do
+
+!-----------------------------------------------------------------------
+! Scan reaction matrix to eliminate equally weigthed reactants
+! and products by setting the index = -index
+!-----------------------------------------------------------------------
+ do i = 1,2
+ do j = 1,rxmcnt(i)
+ do k = i+2,i+prd_limp1
+ spcno = rxmap(j,k,i)
+ if( spcno == 0 ) then
+ exit
+ else
+ col = pcoeff_ind(rxmap(j,1,i))
+ if( col /= 0 ) then
+ if( pcoeff(k-(i+1),col) /= 1. ) then
+ cycle
+ end if
+ end if
+ do l = 2,i+1
+ if( spcno == rxmap(j,l,i) ) then
+ rxmap(j,l,i) = -rxmap(j,l,i)
+ rxmap(j,k,i) = -spcno
+ exit
+ end if
+ end do
+ end if
+ end do
+ end do
+ end do
+
+!-----------------------------------------------------------------------
+! Scan reaction matrix to detect "null" reactions
+! and eliminate such reactions from the following maps:
+! 1. groups
+! 2. relationships
+! 3. reactions
+!-----------------------------------------------------------------------
+ do i = 1,2
+ place = 1
+ do j = 1,rxmcnt(i)
+ null_flag = .true. ! assume a null reaction
+ do k = 2,i+prd_limp1
+ if( rxmap(j,k,i) > 0 ) then
+ null_flag = .false. ! not a null reaction
+ exit
+ end if
+ end do
+ if( null_flag ) then ! remove from lists if null
+ rxno = rxmap(j,1,i)
+ rxt_to_grp_map(rxno,1:2) = 0
+ rel_rxt_pntr(rxno,1:2) = 0
+ else ! a non-null reaction; keep it
+ rxmap(place,1:i+prd_limp1,i) = rxmap(j,1:i+prd_limp1,i)
+ place = place + 1
+ end if
+ end do
+ rxmcnt(i) = place - 1
+ end do
+
+!-----------------------------------------------------------------------
+! ... Form the solution class reaction maps
+!-----------------------------------------------------------------------
+ call cls_maps
+
+!-----------------------------------------------------------------------
+! ... Order class reaction map reactants for the nonlinear reactions
+!-----------------------------------------------------------------------
+ do i = 1,5
+ if( cls_rxt_cnt(3,i) /= 0 ) then
+ do k = sum( cls_rxt_cnt(1:2,i) )+1,sum( cls_rxt_cnt(1:3,i) )
+ if( (abs(cls_rxt_map(k,2,i)) > abs(cls_rxt_map(k,3,i)) .and. &
+ cls_rxt_map(k,3,i) > 0 ) .or. cls_rxt_map(k,2,i) <= 0 ) then
+ m = cls_rxt_map(k,3,i)
+ cls_rxt_map(k,3,i) = cls_rxt_map(k,2,i)
+ cls_rxt_map(k,2,i) = m
+ end if
+ end do
+ end if
+ end do
+!=======================================================================
+! ... Call the code writing utilities
+!=======================================================================
+!-----------------------------------------------------------------------
+! ... Force permutation for explicit method
+!-----------------------------------------------------------------------
+ if( clscnt(1) /= 0 ) then
+ permute(:clscnt(1),1) = (/ (i,i=1,clscnt(1)) /)
+ end if
+!-----------------------------------------------------------------------
+! ... The iterated Euler backward and "Hov" methods
+!-----------------------------------------------------------------------
+ do class = 2,3
+ if( clscnt(class) /= 0 ) then
+ clsndx = class - 1
+ allocate( sparse(clsndx)%mat_sp_pat(clscnt(class),clscnt(class)),stat=astat )
+ if( astat /= 0 ) then
+ write(lout,*) 'Failed to allocate the matrix sparsity pattern array'
+ write(lout,*) 'for class = ',class,' ; error = ',astat
+ stop 'abort'
+ end if
+ allocate( sparse(clsndx)%lu_sp_pat(clscnt(class),clscnt(class)),stat=astat )
+ if( astat /= 0 ) then
+ write(lout,*) 'Failed to allocate the lu sparsity pattern array'
+ write(lout,*) 'for class = ',class,' ; error = ',astat
+ stop 'abort'
+ end if
+ call sparsity_pat( clscnt(class), clsmap(1,class,2), cls_rxt_cnt(1,class), &
+ cls_rxt_map(1,1,class), sparse(clsndx)%mat_sp_pat )
+ sparse(clsndx)%lu_sp_pat(:,:) = sparse(clsndx)%mat_sp_pat(:,:)
+ call diag_mark( clscnt(class), sparse(clsndx)%lu_sp_pat, permute(1,class) )
+ permute_orig(:clscnt(class),class-1) = permute(:clscnt(class),class)
+ deallocate( sparse(clsndx)%mat_sp_pat )
+ deallocate( sparse(clsndx)%lu_sp_pat )
+ end if
+ end do
+!-----------------------------------------------------------------------
+! ... The sparse matrix backward Euler method
+!-----------------------------------------------------------------------
+sparse_matrix_loop : &
+ do class = 4,5
+ k = max( 1,clscnt(class) )
+ clsndx = class - 3
+ allocate( sparse(clsndx)%mat_sp_pat(k,k), stat=astat )
+ if( astat /= 0 ) then
+ write(lout,*) 'Failed to allocate the matrix sparsity pattern array'
+ write(lout,*) 'for class = ',class,' ; error = ',astat
+ stop 'abort'
+ end if
+ allocate( sparse(clsndx)%lu_sp_pat(k,k), stat=astat )
+ if( astat /= 0 ) then
+ write(lout,*) 'Failed to allocate the lu sparsity pattern array'
+ write(lout,*) 'for class = ',class,' ; error = ',astat
+ stop 'abort'
+ end if
+ allocate( sparse(clsndx)%mat_sp_map(k,k), stat=astat )
+ if( astat /= 0 ) then
+ write(lout,*) 'Failed to allocate the matrix sparsity map array'
+ write(lout,*) 'for class = ',class,' ; error = ',astat
+ stop 'abort'
+ end if
+ allocate( sparse(clsndx)%diag_map(k), stat=astat )
+ if( astat /= 0 ) then
+ write(lout,*) 'Failed to allocate the matrix diagonal map array'
+ write(lout,*) 'for class = ',class,' ; error = ',astat
+ stop 'abort'
+ end if
+ if( clscnt(class) /= 0 ) then
+!-----------------------------------------------------------------------
+! ... Determine original jacobian sparsity
+!-----------------------------------------------------------------------
+ call sparsity_pat( clscnt(class), &
+ clsmap(1,class,2), &
+ cls_rxt_cnt(1,class), &
+ cls_rxt_map(1,1,class), &
+ sparse(clsndx)%mat_sp_pat )
+! call draw_mat( clscnt(class), mat_sp_pat(1,1,class-3) )
+ sparse(clsndx)%lu_sp_pat(:,:) = sparse(clsndx)%mat_sp_pat(:,:)
+!-----------------------------------------------------------------------
+! ... Reorder according to diagonal Markowitz
+!-----------------------------------------------------------------------
+ call diag_mark( clscnt(class), sparse(clsndx)%lu_sp_pat, permute(1,class) )
+!-----------------------------------------------------------------------
+! ... Permute the original sparsity pattern
+!-----------------------------------------------------------------------
+ call perm_mat( clscnt(class), sparse(clsndx)%lu_sp_pat, permute(1,class) )
+ sparse(clsndx)%mat_sp_pat(:,:) = sparse(clsndx)%lu_sp_pat(:,:)
+! call draw_mat( clscnt(class), lu_sp_pat )
+!-----------------------------------------------------------------------
+! ... Symbolic factorization; includes fillin
+!-----------------------------------------------------------------------
+ call sym_fac( clscnt(class), sparse(clsndx)%lu_sp_pat, additions, multiplications )
+!-----------------------------------------------------------------------
+! ... Make column oriented non-zero "map"
+!-----------------------------------------------------------------------
+ nzcnt(class-3) = COUNT( sparse(clsndx)%lu_sp_pat(:,:) )
+ sparse(clsndx)%mat_sp_map(:,:) = 0
+ k = 0
+ do j = 1,clscnt(class)
+ do i = 1,clscnt(class)
+ if( sparse(clsndx)%lu_sp_pat(i,j) ) then
+ k = k + 1
+ sparse(clsndx)%mat_sp_map(i,j) = k
+ if( i == j ) then
+ sparse(clsndx)%diag_map(j) = k
+ end if
+ end if
+ end do
+ end do
+ end if
+!-----------------------------------------------------------------------
+! ... Write the factorization code
+!-----------------------------------------------------------------------
+ if( class /= 5 .or. model == 'MOZART' ) then
+ call make_lu_fac( clscnt(class), class, sparse(clsndx)%lu_sp_pat, &
+ sparse(clsndx)%mat_sp_pat, sparse(clsndx)%mat_sp_map, march, model )
+!-----------------------------------------------------------------------
+! ... Write the solver code
+!-----------------------------------------------------------------------
+ call make_lu_slv( clscnt(class), class, sparse(clsndx)%lu_sp_pat, march, model )
+ end if
+ if( associated( sparse(clsndx)%lu_sp_pat ) ) then
+ deallocate( sparse(clsndx)%lu_sp_pat )
+ end if
+ end do sparse_matrix_loop
+!-----------------------------------------------------------------------
+! ... Make "from-to" permutation
+!-----------------------------------------------------------------------
+ do class = 2,5
+ do j = 1,clscnt(class)
+ do i = 1,clscnt(class)
+ if( permute(i,class) == j ) then
+ permutation(j) = i
+ end if
+ end do
+ end do
+ if( clscnt(class) /= 0 ) then
+ permute(:clscnt(class),class) = permutation(:clscnt(class))
+ end if
+ end do
+!-----------------------------------------------------------------------
+! ... Make reaction scheme dependent prod & loss code
+!-----------------------------------------------------------------------
+ call pl_code( new_nq, clscnt, clsmap, cls_rxt_cnt, cls_rxt_map, &
+ pcoeff_ind, pcoeff, permute, march, model )
+ cls_ind_prdcnt = sum( cls_rxt_cnt(1,1:5) )
+!-----------------------------------------------------------------------
+! ... Make reaction scheme independent prod & loss code
+!-----------------------------------------------------------------------
+ call ipd_code( new_nq, clscnt, clsmap, cls_rxt_cnt, extcnt, &
+ cls_rxt_map, pcoeff_ind, pcoeff, permute, model, march )
+!-----------------------------------------------------------------------
+! ... Make tabular reaction rates
+!-----------------------------------------------------------------------
+ if( options(12) ) then
+ call make_rate_tab( rxparm, rxptab, rxpcnt )
+ else
+ call make_rate( sym_rates, rxptab, rxpcnt, machine, vec_ftns, &
+ model, march )
+ end if
+ if( rxmcnt(2) /= 0 .or. fixcnt(2) /= 0 ) then
+ radj_flag = .true.
+ else
+ radj_flag = .false.
+ do i = 1,fixcnt(1)
+ if( abs(fixmap(i,1,1)) > phtcnt ) then
+ radj_flag = .true.
+ end if
+ end do
+ end if
+!-----------------------------------------------------------------------
+! ... Make reaction rate adjustment routines
+!-----------------------------------------------------------------------
+ call make_radj( fixmap, fixcnt, rxmap(1,1,2), rxmcnt(2), phtcnt, &
+ model, march )
+ call make_padj( fixmap, fixcnt(1), phtcnt, model, march )
+ call make_rmod( rel_rxt_pntr, rel_rxt_map, rxt_to_grp_map, grp_rat_map, hetmap(1,2), &
+ hetcnt, rxntot, model, march )
+ do class = 4,5
+ clsndx = class - 3
+ allocate( lin_mat_pat(nzcnt(clsndx)), stat=astat )
+ if( astat /= 0 ) then
+ write(lout,*) 'Failed to allocate the lin matrix map array'
+ write(lout,*) 'for class = ',class,' ; error = ',astat
+ stop 'abort'
+ end if
+ if( class /= 5 .or. model == 'MOZART' ) then
+ call make_lin( clscnt(class), clsmap, cls_rxt_cnt(1,class), cls_rxt_map(1,1,class), pcoeff_ind, &
+ pcoeff, permute(1,class), sparse(clsndx)%mat_sp_map, class, &
+ lin_mat_pat, march, model )
+ call make_nln( clscnt(class), clsmap, cls_rxt_cnt(1,class), cls_rxt_map(1,1,class), pcoeff_ind, &
+ pcoeff, permute(1,class), sparse(clsndx)%mat_sp_map, class, &
+ lin_mat_pat, nzcnt(clsndx), sparse(clsndx)%diag_map, march, model )
+ end if
+ if( associated( sparse(clsndx)%mat_sp_pat ) ) then
+ deallocate( sparse(clsndx)%mat_sp_pat )
+ end if
+ if( allocated( lin_mat_pat ) ) then
+ deallocate( lin_mat_pat )
+ end if
+ end do
+!-----------------------------------------------------------------------
+! ... Make group members vmr subroutine
+!-----------------------------------------------------------------------
+ call mak_grp_vmr( grp_mem_cnt, mem2grp_map, model, march )
+!-----------------------------------------------------------------------
+! ... Writeout the surface flux and depos vel info
+!-----------------------------------------------------------------------
+ if( srf_flx_cnt /= 0 ) then
+ write(lout,*) ' '
+ write(lout,'('' Species with non-zero surface emission'')')
+ do i = 1,srf_flx_cnt
+ write(lout,'(1x,''('',i2,'')'',3x,a8)') i, new_solsym(srf_flx_map(i))
+ end do
+ end if
+ if( dvel_cnt /= 0 ) then
+ write(lout,*) ' '
+ write(lout,'('' Species with non-zero dry deposition flux'')')
+ do i = 1,dvel_cnt
+ write(lout,'(1x,''('',i2,'')'',3x,a8)') i, new_solsym(dvel_map(i))
+ end do
+ end if
+!-----------------------------------------------------------------------
+! ... Call the equation reporting utility
+!-----------------------------------------------------------------------
+ call equation_rep( new_nq, new_solsym, nfs, fixsym, prdcnt, &
+ prdmap, rxntot, rxmcnt, rxmap, pcoeff_cnt, &
+ pcoeff_ind, pcoeff, fixcnt, fixmap, phtcnt )
+
+ call write_rxt_out_code ( &
+ rxmcnt, &
+ rxmap, &
+ fixmap, &
+ solsym, &
+ fixsym, &
+ prdcnt, &
+ prdmap, &
+ rxntot, &
+ phtcnt, &
+ rxt_rates_conv_file )
+
+ end if Has_chemistry
+
+!=======================================================================
+! ... This is for the new CTM interface; the old driver
+! data file can still be output for potential diagnostics
+!=======================================================================
+ open( unit = 20, &
+ file = trim( sim_dat_filespec ), &
+ status = 'replace', &
+ iostat = ios )
+ if( ios /= 0 ) then
+ write(*,*) ' Failed to open file '// trim( sim_dat_filespec )
+ write(*,*) ' Error code = ',ios
+ stop
+ end if
+ if( model == 'MOZART' ) then
+ do class = 1,5
+ if( class == 2 .or. class == 3 ) then
+ cycle
+ end if
+ if( clscnt(class) > 0 ) then
+ write(20,508) cls_rxt_cnt(:,class)
+ write(20,522) clsmap(:clscnt(class),class,2)
+ if( class >= 4 ) then
+ write(20,522) permute(:clscnt(class),class)
+ write(20,522) sparse(class-3)%diag_map(:clscnt(class))
+ end if
+ end if
+ end do
+!-----------------------------------------------------------------------
+! ... Write the "class" maps & species symbols
+!-----------------------------------------------------------------------
+ temp_mass(:) = 0.
+ if( nq > 0 ) then
+ do i = 1,nq
+ if( newind(i) /= 0 ) then
+ temp_mass(newind(i)) = mass(i)
+ end if
+ end do
+ write(20,*) temp_mass(:new_nq)
+ end if
+ if( ngrp > 0 ) then
+ do i = 1,nq
+ if( grp_rat_ind(i) /= 0 ) then
+ temp_mass(grp_rat_ind(i)) = mass(i)
+ end if
+ end do
+ write(20,*) temp_mass(:grp_mem_cnt)
+ end if
+ if( new_nq > 0 ) then
+ write(20,'(10a16)') new_solsym(:new_nq)
+ end if
+ if( grp_mem_cnt > 0 ) then
+ write(20,'(i4)') ngrp
+ write(20,'(20i4)') grpcnt(:ngrp)
+ write(20,'(10a16)') grpsym(:ngrp)
+ write(20,'(10a16)') grp_mem_sym(:grp_mem_cnt)
+ end if
+ write(20,'(i4)') srf_flx_cnt
+ if( srf_flx_cnt > 0 ) then
+ do m = 1,(srf_flx_cnt-1)/10+1
+ wrk_chr(:) = ' '
+ il = (m-1)*10 + 1
+ iu = min( 10*m,srf_flx_cnt )
+ do i = il,iu
+ wrk_chr(i-il+1) = new_solsym(srf_flx_map(i))
+ end do
+ write(20,'(10a16)') wrk_chr
+ end do
+ end if
+ write(20,'(i4)') dvel_cnt
+ if( dvel_cnt > 0 ) then
+ do m = 1,(dvel_cnt-1)/10+1
+ wrk_chr(:) = ' '
+ il = (m-1)*10 + 1
+ iu = min( 10*m,dvel_cnt )
+ do i = il,iu
+ wrk_chr(i-il+1) = new_solsym(dvel_map(i))
+ end do
+ write(20,'(10a16)') wrk_chr
+ end do
+ end if
+!-----------------------------------------------------------------------
+! ... Write the wet removal species
+!-----------------------------------------------------------------------
+ if( hetcnt > 0 ) then
+ do m = 1,(hetcnt-1)/10+1
+ wrk_chr(:) = ' '
+ il = (m-1)*10 + 1
+ iu = min( 10*m,hetcnt )
+ do i = il,iu
+ wrk_chr(i-il+1) = new_solsym(hetmap(i,1))
+ end do
+ write(20,'(10a16)') wrk_chr
+ end do
+ end if
+!-----------------------------------------------------------------------
+! ... Write the ext frcing species
+!-----------------------------------------------------------------------
+ if( usrcnt > 0 ) then
+ do m = 1,(usrcnt-1)/10+1
+ wrk_chr(:) = ' '
+ il = (m-1)*10 + 1
+ iu = min( 10*m,usrcnt )
+ do i = il,iu
+ wrk_chr(i-il+1) = new_solsym(usrmap(i))
+ end do
+ write(20,'(10a16)') wrk_chr
+ end do
+ end if
+!-----------------------------------------------------------------------
+! ... Write the rxt aliases
+!-----------------------------------------------------------------------
+ k = count( rxt_has_alias(:rxntot) )
+ write(20,'(i4)') k
+ if( k > 0 ) then
+ wrk_chr(:) = ' '
+ i = 0
+ do m = 1,rxntot
+ if( rxt_has_alias(m) ) then
+ i = i + 1
+ wrk_rxt(i) = rxt_tag(m)
+ if( i == 5 ) then
+ write(20,'(5a16)') wrk_rxt(:5)
+ i = 0
+ end if
+ end if
+ end do
+ if( i /= 0 ) then
+ write(20,'(5a16)') wrk_rxt(:i)
+ end if
+ i = 0
+ do m = 1,rxntot
+ if( rxt_has_alias(m) ) then
+ i = i + 1
+ nind(i) = m
+ if( i == 20 ) then
+ write(20,'(20i4)') nind(:20)
+ i = 0
+ end if
+ end if
+ end do
+ if( i /= 0 ) then
+ write(20,'(20i4)') nind(:i)
+ end if
+ end if
+ else
+ write(20,510) clscnt(:)
+ write(20,508) cls_rxt_cnt(:,:)
+ do class = 1,5
+ if( class == 2 .or. class == 3 ) then
+ cycle
+ end if
+ if( clscnt(class) > 0 ) then
+ write(20,522) clsmap(:clscnt(class),class,2)
+ end if
+ end do
+ temp_mass(:) = 0.
+ if( nq > 0 ) then
+ do i = 1,nq
+ if( newind(i) /= 0 ) then
+ temp_mass(newind(i)) = mass(i)
+ end if
+ end do
+ write(20,*) temp_mass(:new_nq)
+ end if
+ if( new_nq > 0 ) then
+ write(20,'(10a16)') new_solsym(:new_nq)
+ end if
+ do class = 2,5
+ if( clscnt(class) > 0 ) then
+ write(20,522) permute(:clscnt(class),class)
+ if( class > 3 ) then
+ write(20,522) sparse(class-3)%diag_map(:clscnt(class))
+ end if
+ end if
+ end do
+ call make_sim_dat( model, march, sparse )
+ end if
+ close( 20)
+
+ rxt_tag_cnt = count( rxt_has_tag )
+ enthalpy_cnt = count( cph_flg )
+
+!-----------------------------------------------------------------------
+! ... Write the chemistry header file
+!-----------------------------------------------------------------------
+ call chm_hdr( rxt_tag_cnt, enthalpy_cnt, hetcnt, usrcnt, cls_rxt_cnt, radj_flag, phtcnt, &
+ rxpcnt, rxparm, rxntot, ncol, nfs, nslvd, &
+ indexm, indexh2o, new_nq, relcnt, grp_mem_cnt, &
+ clscnt, iter_counts, nzcnt, vec_ftns, machine, options(1), veclen )
+
+!-----------------------------------------------------------------------
+! ... Write the resolution header file
+!-----------------------------------------------------------------------
+! call res_hdr( plon, plonl, plat, plev, jintmx, &
+! nxpt, arch_type, cpucnt )
+
+!-----------------------------------------------------------------------
+! ... Write the version header file
+!-----------------------------------------------------------------------
+ ptplen = histout_cnt(1,1,1) + histout_cnt(2,1,1) + histout_cnt(5,1,1) &
+ + histout_cnt(3,1,1) + histout_cnt(4,1,1) + histout_cnt(7,1,1) &
+ + histout_cnt(1,2,1) + histout_cnt(2,2,1) + histout_cnt(5,2,1) &
+ + histout_cnt(3,2,1) + histout_cnt(4,2,1) + histout_cnt(7,2,1)
+ if( ptplen /= 0 .and. histout(2) /= ' ' ) then
+ ohstflag = .true.
+ else
+ ohstflag = .false.
+ end if
+ call ver_hdr( options, plon, plonl, plev, machine, &
+ model, arch_type, ohstflag, diagprnt, tavgprnt, srf_flx_cnt, &
+ hetcnt, rxntot, clscnt, nzcnt, new_nq, dvel_cnt )
+
+!-----------------------------------------------------------------------
+! ... Write the slt header file
+!-----------------------------------------------------------------------
+ call slt_hdr( options(2), options(11), cpucnt, machine )
+
+!-----------------------------------------------------------------------
+! ... Write the history tape header file
+!-----------------------------------------------------------------------
+ call hist_hdr( hst_file_cnt, histout_cnt, histout_map, user_hst_names, histinp(4), &
+ dyn_hst_fld_cnt, spcsym, spccnt, hetmap, usrmap, &
+ ptplen, sim_dat_filespec, model )
+ if( model == 'MOZART' ) then
+!-----------------------------------------------------------------------
+! ... Special section for invariants
+!-----------------------------------------------------------------------
+ open( unit = 20, &
+ file = trim( sim_dat_filespec ), &
+ status = 'old', &
+ position = 'append', &
+ iostat = ios )
+ if( ios /= 0 ) then
+ write(*,*) ' Failed to open file '// trim( sim_dat_filespec )
+ write(*,*) ' Error code = ',ios
+ stop
+ end if
+!-----------------------------------------------------------------------
+! ... Write the invariants
+!-----------------------------------------------------------------------
+ if( nfs /= 0 ) then
+ do m = 1,(nfs-1)/10+1
+ wrk_chr(:) = ' '
+ il = (m-1)*10 + 1
+ iu = min( 10*m,nfs )
+ do i = il,iu
+ wrk_chr(i-il+1) = fixsym(i)
+ end do
+ write(20,'(10a16)') wrk_chr
+ end do
+ end if
+ close( 20 )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Write the files.h file
+!-----------------------------------------------------------------------
+ call files_hdr
+
+!-----------------------------------------------------------------------
+! ... Form "include" files stub file
+!-----------------------------------------------------------------------
+ inquire( file = trim( temp_path ) // 'wrk.stub.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f ' // trim( temp_path ) // 'wrk.stub.F' )
+ end if
+ open( unit = 3, &
+ file = trim( temp_path ) // 'wrk.stub.F', &
+ iostat = ios )
+ if( ios /= 0 ) then
+ write(*,*) ' Failed to open wrk file; terminating'
+ write(*,*) ' Error code = ',ios
+ stop
+ end if
+ write(3,'(''# include '')')
+!!$ write(3,'(''# include '')')
+ write(3,'(''# include '')')
+ write(3,'(''# include '')')
+ write(3,'(''# include '')')
+ close( 3 )
+ call system( 'rm -f wrk.F' )
+
+!-----------------------------------------------------------------------
+! ... Check for cpp utility
+!-----------------------------------------------------------------------
+ cpp_command = trim( cpp_dir ) // ' ' // trim( cpp_opts )
+ inquire( file = trim( cpp_dir ), exist = lexist )
+ if( .not. lexist ) then
+ buff = ' '
+ call errmes( ' ** cpp not in #', &
+ lout, &
+ trim( cpp_dir ), &
+ len_trim( cpp_dir ), &
+ buff )
+ end if
+!-----------------------------------------------------------------------
+! ... Check for fortran 90 modules
+!-----------------------------------------------------------------------
+ inquire( file = trim( temp_path ) // 'mod.src.files.PP', exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f ' // trim( temp_path ) // 'mod.src.files.PP' )
+ end if
+!-----------------------------------------------------------------------
+! ... Get mozart module files
+!-----------------------------------------------------------------------
+ if( model == 'MOZART' ) then
+ inquire( file = trim( src_dir ) // 'mozart.mod.files.PP', exist = lexist )
+ if( .not. lexist ) then
+ call errmes( ' ** Module source file missing@', 6, param, 8, buff )
+ end if
+ call system( 'cat ' // trim( src_dir ) // 'mozart.mod.files.PP > ' &
+ // trim( temp_path ) // 'mod.src.files.PP' )
+ else
+ inquire( file = trim( src_dir ) // 'cam.mod.files.PP', exist = lexist )
+ if( .not. lexist ) then
+ call errmes( ' ** Module source file missing@', 6, param, 8, buff )
+ end if
+ call system( 'cat ' // trim( src_dir ) // 'cam.mod.files.PP > ' &
+ // trim( temp_path ) // 'mod.src.files.PP' )
+ end if
+ inquire( file = trim( temp_path ) // 'mod.src.files', exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f ' // trim( temp_path ) // 'mod.src.files' )
+ end if
+ call system( trim( cpp_command ) // ' ' // trim( temp_path ) // 'mod.src.files.PP > ' &
+ // trim( temp_path ) // 'mod.src.files' )
+ close(2)
+ open( unit = 2, &
+ file = trim( temp_path ) // 'mod.src.files', &
+ status = 'old', &
+ position = 'rewind', &
+ iostat = ios )
+ if( ios /= 0 ) then
+ write(lout,*) ' Failed to open mod.src.files file'
+ write(lout,*) ' Error code = ',ios
+ stop
+ end if
+ file_cnt = 1
+ do k = 1,500
+ read(2,'(a320)',end=1105) mod_src(file_cnt)
+ if( mod_src(file_cnt) /= ' ' ) then
+ filelines(5) = filelines(5) + 1
+ file_cnt = file_cnt + 1
+ end if
+ end do
+1105 continue
+ close( 2 )
+!-----------------------------------------------------------------------
+! ... Check for species names module
+!-----------------------------------------------------------------------
+ if( options(18) ) then
+ k = 1
+!!$ mod_paths(k) = './'
+ mod_paths(k) = ' '
+ mod_names(k) = trim( temp_path ) // 'spc_names.mod'
+ k = 2
+!!$ mod_paths(k) = './'
+ mod_paths(k) = ' '
+ mod_names(k) = trim( temp_path ) // 'rxt_names.mod'
+!!$ k = 3
+!!$ mod_paths(k) = './'
+!!$ mod_paths(k) = ' '
+!!$ mod_names(k) = trim( temp_path ) // 'het_names.mod'
+ else
+ k = 0
+ end if
+!-----------------------------------------------------------------------
+! ... Check user files for any module files
+!-----------------------------------------------------------------------
+ do i = 1,sub_cnt
+ if( index( filename(i), 'mod', back = .true. ) == len_trim(filename(i))-2 ) then
+ k = k + 1
+ mod_paths(k) = trim( filepath(i) )
+ mod_names(k) = trim( filename(i) )
+ nend(i) = 0
+ else
+ nend(i) = 1
+ end if
+ end do
+ filelines(2) = k
+!-----------------------------------------------------------------------
+! ... Remove .mod files from user subroutine lists
+!-----------------------------------------------------------------------
+ k = 0
+ do i = 1,sub_cnt
+ if( nend(i) == 1 ) then
+ k = k + 1
+ filepath(k) = filepath(i)
+ filename(k) = filename(i)
+ end if
+ end do
+ sub_cnt = k
+!-----------------------------------------------------------------------
+! ... Check for user file "overrides"
+!-----------------------------------------------------------------------
+ if( filelines(2) /= 0 ) then
+ call sub_scan( filelines(5), &
+ mod_src, &
+ mod_paths, &
+ mod_names, &
+ filelines(2) )
+ end if
+!-----------------------------------------------------------------------
+! ... Form and preprocess the modules
+!-----------------------------------------------------------------------
+ call system( 'cat ' // trim( temp_path ) // 'wrk.stub.F > wrk.F' )
+ do i = 1,filelines(5)
+ command = 'cat ' // trim( mod_src(i) ) // ' >> wrk.F'
+ call system( trim( command ) )
+ end do
+ if( filelines(2) > 0 ) then
+ do i = 1,filelines(2)
+ command = 'cat ' // trim( mod_paths(i) ) // trim( mod_names(i) ) // ' >> wrk.F'
+ call system( trim( command ) )
+ end do
+ end if
+ inquire( file = trim(procout_path)//'moz.mods.F90', exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f '//trim(procout_path)//'moz.mods.F90' )
+ end if
+ call system( trim( cpp_command ) // ' wrk.F > '//trim(procout_path)//'moz.mods.F90' )
+ call system( 'rm -f wrk.F' )
+
+!-----------------------------------------------------------------------
+! ... for CAM,WRF remove tar file if it exists
+!-----------------------------------------------------------------------
+ if( model /= 'MOZART' ) then
+ if( model == 'CAM' ) then
+ tar_flnm = 'cam.subs.tar'
+ else if( model == 'WRF' ) then
+ tar_flnm = 'wrf.subs.tar'
+ end if
+ inquire( file = trim( temp_path ) // trim(tar_flnm), exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f ' // trim(temp_path ) // trim(tar_flnm) )
+ end if
+!-----------------------------------------------------------------------
+! ... add module files to cam tar file
+!-----------------------------------------------------------------------
+ if( filelines(5) /= 0 ) then
+ do i = 1,filelines(5)
+ call system( 'cat ' // trim( temp_path ) // 'wrk.stub.F > wrk.F' )
+ call system( 'cat '// trim( mod_src(i) ) // ' >> wrk.F' )
+! write(*,*) 'cpp file ',trim(mod_src(i))
+ il = index( mod_src(i), '/', back = .true. ) + 1
+ iu = index( mod_src(i), '.mod', back = .true. ) - 1
+ select case( mod_src(i)(il:iu) )
+ case( 'mo_chem' )
+ tmp_filenm = 'chem_mods'
+ case default
+ tmp_filenm = mod_src(i)(il:iu)
+ end select
+ filenm = trim(tmp_filenm) // '.F90'
+! write(*,*) 'tar file ',trim(filenm)
+ call system( trim( cpp_command ) // ' wrk.F > '// trim(filenm) )
+ if( i == 1 ) then
+ call system( 'tar -cf ' // trim(temp_path) // trim(tar_flnm) // ' ' // trim(filenm) )
+ else
+ call system( 'tar -rf ' // trim(temp_path) // trim(tar_flnm) // ' ' // trim(filenm) )
+ end if
+ call system( 'rm -f wrk.F' )
+ call system( 'rm -f ' // trim(filenm) )
+ end do
+ end if
+ if( filelines(2) > 0 ) then
+ do i = 1,filelines(2)
+ call system( 'cat ' // trim( temp_path ) // 'wrk.stub.F > wrk.F' )
+ call system( 'cat '// trim( mod_paths(i) ) // trim(mod_names(i) ) // ' >> wrk.F' )
+! write(*,*) 'cpp file ',trim(mod_paths(i)) // trim(mod_names(i))
+ il = index( mod_names(i), '/', back = .true. ) + 1
+ iu = index( mod_names(i), '.mod', back = .true. ) - 1
+ select case( mod_names(i)(il:iu) )
+ case( 'spc_names' )
+ tmp_filenm = 'm_spc_id'
+ case( 'rxt_names' )
+ tmp_filenm = 'm_rxt_id'
+ case( 'het_names' )
+ tmp_filenm = 'm_het_id'
+ case default
+ tmp_filenm = mod_src(i)(il:iu)
+ end select
+ filenm = trim(tmp_filenm) // '.F90'
+! write(*,*) 'tar file ',trim(filenm)
+ call system( trim( cpp_command ) // ' wrk.F > '// trim(filenm) )
+ if( filelines(5) == 0 .and. i == 1 ) then
+ call system( 'tar -cf ' // trim(temp_path) // trim(tar_flnm) // ' ' // trim(filenm) )
+ else
+ call system( 'tar -rf ' // trim(temp_path) // trim(tar_flnm) // ' ' // trim(filenm) )
+ end if
+ call system( 'rm -f wrk.F' )
+ call system( 'rm -f ' // trim(filenm) )
+ end do
+ end if
+ end if
+
+!-----------------------------------------------------------------------
+! ... Get all source files
+!-----------------------------------------------------------------------
+ if( options(7) ) then
+!-----------------------------------------------------------------------
+! ... Get "main" library files
+!-----------------------------------------------------------------------
+ inquire( file = trim( temp_path ) // 'lib.src.files.PP', exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f ' // trim(temp_path ) // 'lib.src.files.PP' )
+ end if
+!-----------------------------------------------------------------------
+! ... Get "chemistry" library files
+!-----------------------------------------------------------------------
+ if( model == 'MOZART' ) then
+ inquire( file = trim( src_dir ) // 'mozart.src.files.PP', exist = lexist )
+ else if( model == 'CAM' ) then
+ inquire( file = trim( src_dir ) // 'cam.src.files.PP', exist = lexist )
+ end if
+ if( .not. lexist ) then
+ call errmes( ' ** Chem source file missing@', 6, param, 8, buff )
+ end if
+ if( model == 'MOZART' ) then
+ call system( 'cat ' // trim( src_dir ) // 'mozart.src.files.PP ' // ' > ' // trim( temp_path ) // 'lib.src.files.PP' )
+ else if( model == 'CAM' ) then
+ call system( 'cat ' // trim( src_dir ) // 'cam.src.files.PP ' // ' > ' // trim( temp_path ) // 'lib.src.files.PP' )
+ end if
+ command = trim( cpp_command ) // ' ' // trim( temp_path ) // 'lib.src.files.PP > ' // trim( temp_path ) // 'lib.src.files'
+ inquire( file = trim( temp_path ) // 'lib.src.files', exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f ' // trim(temp_path ) // 'lib.src.files' )
+ end if
+ call system( trim( command ) )
+ close(2)
+ open( unit = 2, &
+ file = trim( temp_path ) // 'lib.src.files', &
+ status = 'old', &
+ iostat = ios )
+ if( ios /= 0 ) then
+ write(lout,*) ' Failed to open lib.src.files file'
+ write(lout,*) ' Error code = ',ios
+ stop
+ end if
+ file_cnt = 1
+ do k = 1,500
+ read(2,'(a320)',end=1005) lib_src(file_cnt)
+ if( lib_src(file_cnt) /= ' ' ) then
+ filelines(1) = filelines(1) + 1
+ file_cnt = file_cnt + 1
+ end if
+ end do
+1005 continue
+!-----------------------------------------------------------------------
+! ... set cam implicit solvers
+!-----------------------------------------------------------------------
+ if( model == 'CAM' ) then
+ if( march == 'SCALAR' ) then
+ lib_src(file_cnt) = trim(procfiles_path) // 'mo_imp_sol_scalar.F90'
+ file_cnt = file_cnt + 1
+ filelines(1) = filelines(1) + 1
+ lib_src(file_cnt) = trim(procfiles_path) // 'mo_exp_sol_scalar.F90'
+ else if( march == 'CACHE' ) then
+ lib_src(file_cnt) = trim(procfiles_path) // 'mo_imp_sol_cache.F90'
+ else if( march == 'VECTOR' ) then
+ lib_src(file_cnt) = trim(procfiles_path) // 'mo_imp_sol_vector.F90'
+ file_cnt = file_cnt + 1
+ filelines(1) = filelines(1) + 1
+ lib_src(file_cnt) = trim(procfiles_path) // 'mo_exp_sol_vector.F90'
+ end if
+ file_cnt = file_cnt + 1
+ filelines(1) = filelines(1) + 1
+ end if
+!-----------------------------------------------------------------------
+! ... check for iterative convergence norms
+!-----------------------------------------------------------------------
+ if( options(5) ) then
+ lib_src(file_cnt) = 'del_norm.F'
+ lib_src(file_cnt+1) = 'it_norm.F'
+ filelines(1) = filelines(1) + 2
+ end if
+!-----------------------------------------------------------------------
+! ... Check for user file "overrides"
+!-----------------------------------------------------------------------
+ if( sub_cnt /= 0 ) then
+ call sub_scan( filelines(1), lib_src, filepath, filename, sub_cnt )
+ end if
+!-----------------------------------------------------------------------
+! ... Form main lib portion of ccmpp file
+!-----------------------------------------------------------------------
+ call system( 'cat ' // trim( temp_path ) // 'wrk.stub.F > wrk.F' )
+ if( filelines(1) /= 0 ) then
+ do i = 1,filelines(1)
+ command = 'cat '// trim( lib_src(i) ) // ' >> wrk.F'
+ call system( trim( command ) )
+ end do
+ end if
+
+!-----------------------------------------------------------------------
+! ... Get user specified files
+!-----------------------------------------------------------------------
+ if( sub_cnt > 0 ) then
+ do i = 1,sub_cnt
+ command = 'cat ' // trim( filepath(i) ) // trim( filename(i) ) // ' >> wrk.F'
+ call system( trim( command ) )
+ end do
+ end if
+ end if
+ inquire( file = trim( procout_path ) // 'moz.subs.F90', exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f ' // trim(procout_path ) // 'moz.subs.F90' )
+ end if
+ call system( trim( cpp_command ) // ' wrk.F > '// trim(procout_path) // 'moz.subs.F90' )
+ call system( 'rm -f wrk.F' )
+
+!-----------------------------------------------------------------------
+! ... add source files to cam tar file
+!-----------------------------------------------------------------------
+ if( model /= 'MOZART' ) then
+ if( filelines(1) /= 0 ) then
+ do i = 1,filelines(1)
+ il = index( lib_src(i), '/', back = .true. ) + 1
+ iu = index( lib_src(i), '.F', back = .true. ) - 1
+ if( lib_src(i)(il:iu) /= 'mo_setrxt' .and. lib_src(i)(il:iu) /= 'mo_sim_dat' ) then
+ call system( 'cat ' // trim( temp_path ) // 'wrk.stub.F > wrk.F' )
+! write(*,*) 'cpp file ',trim(lib_src(i))
+ end if
+ call system( 'cat '// trim( lib_src(i) ) // ' >> wrk.F' )
+ if( lib_src(i)(il:iu) == 'mo_imp_sol_scalar' .or. &
+ lib_src(i)(il:iu) == 'mo_imp_sol_cache' .or. &
+ lib_src(i)(il:iu) == 'mo_imp_sol_vector' ) then
+ filenm = 'mo_imp_sol.F90'
+ elseif( lib_src(i)(il:iu) == 'mo_exp_sol_scalar' .or. &
+ lib_src(i)(il:iu) == 'mo_exp_sol_cache' .or. &
+ lib_src(i)(il:iu) == 'mo_exp_sol_vector' ) then
+ filenm = 'mo_exp_sol.F90'
+ else
+ filenm = lib_src(i)(il:iu) // '.F90'
+ end if
+ if( lib_src(i)(il:iu) /= 'mo_setrxt' .and. lib_src(i)(il:iu) /= 'mo_sim_dat' ) then
+ call system( trim( cpp_command ) // ' wrk.F > '// trim(filenm) )
+ else
+ call system( 'cp wrk.F ' // trim(filenm) )
+ end if
+! write(*,*) 'tar file ',trim(filenm)
+ call system( 'tar -rf ' // trim(temp_path) // trim(tar_flnm) // ' ' // trim(filenm) )
+ call system( 'rm -f wrk.F' )
+ call system( 'rm -f ' // trim(filenm) )
+ end do
+ end if
+ if( sub_cnt > 0 ) then
+ do i = 1,sub_cnt
+ call system( 'cat ' // trim( temp_path ) // 'wrk.stub.F > wrk.F' )
+ call system( 'cat '// trim( filepath(i) ) // trim(filename(i) ) // ' >> wrk.F' )
+! write(*,*) 'cpp file ',trim(filepath(i)) // trim(filename(i))
+ il = index( filename(i), '/', back = .true. ) + 1
+ iu = index( filename(i), '.F', back = .true. ) - 1
+ filenm = filename(i)(il:iu) // '.F90'
+ write(*,*) 'tar file ',trim(filenm)
+ call system( trim( cpp_command ) // ' wrk.F > '// trim(filenm) )
+ call system( 'tar -rf ' // trim(temp_path) // trim(tar_flnm) // ' ' // trim(filenm) )
+ call system( 'rm -f wrk.F' )
+ call system( 'rm -f ' // trim(filenm) )
+ end do
+ end if
+ end if
+
+!-----------------------------------------------------------------------
+! ... Get all matrix and production/loss files
+!-----------------------------------------------------------------------
+ inquire( file = trim( temp_path ) // 'lib.mat.files.PP', exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f ' // trim( temp_path ) // 'lib.mat.files.PP' )
+ end if
+ inquire( file = trim( src_dir ) // 'mozart.mat.files.PP', exist = lexist )
+ if( .not. lexist ) then
+ call errmes( ' ** Matrix source file missing@', 6, param, 8, buff )
+ end if
+ call system( 'cat ' // trim( src_dir ) // 'mozart.mat.files.PP ' // ' > ' &
+ // trim( temp_path) // 'lib.mat.files.PP' )
+ inquire( file = trim( temp_path ) // 'lib.mat.files', exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f ' // trim( temp_path ) // 'lib.mat.files' )
+ end if
+ call system( trim( cpp_command ) // ' ' // trim( temp_path ) // 'lib.mat.files.PP > ' &
+ // trim( temp_path ) // 'lib.mat.files' )
+ close(2)
+ open( unit = 2, &
+ file = trim( temp_path ) // 'lib.mat.files', &
+ status = 'old', &
+ iostat = ios )
+ if( ios /= 0 ) then
+ write(lout,*) ' Failed to open ',trim(temp_path) // 'lib.mat.files file'
+ write(lout,*) ' Error code = ',ios
+ stop
+ end if
+ file_cnt = 1
+ do k = 1,500
+ read(2,'(a320)',end=1015) lib_src(file_cnt)
+ if( lib_src(file_cnt) /= ' ' ) then
+ lib_src(file_cnt) = trim( temp_path ) // trim( lib_src(file_cnt) )
+ filelines(3) = filelines(3) + 1
+ file_cnt = file_cnt + 1
+ end if
+ end do
+1015 continue
+!-----------------------------------------------------------------------
+! ... Form main lib portion of ccmpp file
+!-----------------------------------------------------------------------
+ call system( 'cat ' // trim( temp_path ) // 'wrk.stub.F > wrk.F' )
+ if( filelines(3) /= 0 ) then
+ do i = 1,filelines(3)
+ command = 'cat '// trim( lib_src(i) ) // ' >> wrk.F'
+ call system( trim( command ) )
+ end do
+ end if
+
+ inquire( file = trim( procout_path ) // 'moz.mat.F90', exist = lexist )
+ if( lexist ) then
+ call system( 'rm -f ' // trim(procout_path ) // 'moz.mat.F90' )
+ end if
+ call system( trim( cpp_command ) // ' wrk.F > '//trim(procout_path)//'moz.mat.F90' )
+ call system( 'rm -f wrk.F' )
+
+!-----------------------------------------------------------------------
+! ... add matrix source files to cam tar file
+!-----------------------------------------------------------------------
+ if( model /= 'MOZART' ) then
+ if( filelines(3) /= 0 ) then
+ do i = 1,filelines(3)
+ call system( 'cat ' // trim( temp_path ) // 'wrk.stub.F > wrk.F' )
+ call system( 'cat '// trim( lib_src(i) ) // ' >> wrk.F' )
+! write(*,*) 'cpp file ',trim(lib_src(i))
+ il = index( lib_src(i), '/', back = .true. ) + 1
+ iu = index( lib_src(i), '.F', back = .true. ) - 1
+ select case( lib_src(i)(il:iu) )
+ case( 'prd_loss' )
+ mod_src(1) = 'prod_loss'
+ case( 'lu_fac' )
+ mod_src(1) = 'lu_factor'
+ case( 'lu_slv' )
+ mod_src(1) = 'lu_solve'
+ case( 'linmat' )
+ mod_src(1) = 'lin_matrix'
+ case( 'nlnmat' )
+ mod_src(1) = 'nln_matrix'
+ case default
+ mod_src(1) = lib_src(i)(il:iu)
+ end select
+ filenm = 'mo_' // trim(mod_src(1)) // '.F90'
+! write(*,*) 'tar file ',trim(filenm)
+ call system( trim( cpp_command ) // ' wrk.F > '// trim(filenm) )
+ call system( 'tar -rf ' // trim(temp_path) // trim(tar_flnm) // ' ' // trim(filenm) )
+ call system( 'rm -f wrk.F' )
+ call system( 'rm -f ' // trim(filenm) )
+ end do
+
+ call system( 'cp '// trim(temp_path) // trim(rxt_rates_conv_file) // ' .' )
+ call system( 'tar -rf ' // trim(temp_path) // trim(tar_flnm) // ' ' // trim(rxt_rates_conv_file) )
+ call system( 'rm -f ' // trim(rxt_rates_conv_file) )
+
+ call system( 'mv ' // trim(temp_path) // trim(tar_flnm) // ' ' // trim(output_path) // '.' )
+ end if
+ end if
+
+!-----------------------------------------------------------------------
+! ... Write the params.h file
+!-----------------------------------------------------------------------
+ call params_hdr( plon, plonl, plat, plev, phtcnt, &
+ rxntot, new_nq, grp_mem_cnt, histout_cnt, options(1), &
+ options(3), options(4), arch_type, trim(procout_path)//'params.h' )
+!-----------------------------------------------------------------------
+! ... Clean up this directory
+!-----------------------------------------------------------------------
+ call system( 'mv *.h ' // trim( temp_path ) // '.' )
+
+ write(*,*) ' '
+ write(*,*) '================================================'
+ write(*,*) 'CAM-Chem preprocessor has successfully completed'
+ write(*,*) '================================================'
+ write(*,*) ' '
+
+!-----------------------------------------------------------------------
+! ... Format statements
+!-----------------------------------------------------------------------
+101 format('0 *****Species header must be first card *****')
+102 format('0 *****Solution must follow species card *****')
+
+202 format(6x,i3,2x,i3)
+204 format(6x,i3,2x,i3,2x,i3)
+206 format(6x,i3,2x,i3,2x,i3,2x,i3)
+208 format(6x,i3,2x,i3,2x,i3,2x,i3,2x,i3)
+201 format('0 the unimolecular fixed map'/6x,'rxn',2x,'fsn')
+203 format('0 the bimolecular fixed map'/6x,'rxn',2(2x,'fsn'))
+205 format('0 the production map'/6x,'rxn',2(2x,'psn'))
+209 format('0 the unimolecular reaction map'/6x,'rxn',2x,'rsn',2(2x,'psn'))
+210 format(6x,i3,2x,i3,2x,i3,2x,i3,2x,i3,2x,i3)
+211 format('0 the bimolecualr reaction map'/6x,'rxn',2(2x,'rsn'),2(2x,'psn'))
+213 format('0 the pce loss map'/6x,'pcn',2x,'rxn',2(2x,'psn'))
+215 format('0 the pce,sol map'/6x,'pcn',2x,'rxn',2x,'rsn',2(2x,'psn'))
+217 format('0 pure prod map for pces'/6x,'pcn',2x,'rxn',2x,'ind')
+219 format('0 the linear prod map for pces'/6x,'pcn',2x,'rxn',2x,'rsn',2x,'ind')
+221 format('0 the quadratic prod map for pces'/6x,'pcn',2x,'rxn',2x,'rsn',2x,'rsn',2x,'ind')
+230 format(5x,'Solution species')
+231 format(6x,'(',i3,')',2x,a16)
+232 format(5x,'Invariant species')
+235 format(5x,'Relationships')
+236 format(5x,'Column integrals')
+237 format(5x,'Groups')
+238 format(3x,'(',i2,')',2x,a16,' - ',1pe10.3)
+
+502 format(10i4)
+504 format(2i4)
+506 format(3i4)
+508 format(4i4)
+510 format(5i4)
+512 format(6i4)
+514 format(i4)
+516 format(1x,2e10.4)
+519 format(5e16.8)
+522 format(20i4)
+
+600 format('0 upper bndy conds'/2x,'species d n')
+602 format(1x,a16,2i3)
+604 format('0 lower bndy conds'/2x,'species d n')
+606 format('0 upper bndy flux'/2x,'species day night ')
+608 format(1x,a16,1p,2e12.4)
+610 format('0 lower bndy flux'/2x,'species day night ')
+612 format('0 upper bndy dir constants'/2x,'species',5x,'day',8x,'night ')
+614 format('0 lower bndy dir constants'/2x,'species',5x,'day',8x,'night ')
+616 format('0 aust coefficients'/2x,'species',5x,'day',8x,'night ')
+618 format('0 the time increments')
+620 format(1x,'(',i2,')',2x,1pe12.4)
+
+1565 format(11x,'|--------------------------------------------------------------------------------------------------|')
+1571 format(11x,'| ',96x,' |')
+1567 format(11x,'| ',8x,a80,8x,' |')
+1569 format(11x,'|**************************************************************************************************|')
+
+2502 format('0 rxn a0 b0')
+2504 format(3x,i3,1p,2e12.4)
+2506 format('1',14x,'boundary conditions'/'+',14x,'________ __________' &
+ /'0',12x,'upper boundary',6x,'lower boundary'/'+',12x, &
+ '_____ ________',6x,'_____ ________'/' species',5x,'day',6x, &
+ 'night',6x,'day',6x,'night'/'+ _______',5x,'___',6x,'_____', &
+ 6x,'___',6x,'_____')
+2508 format(1x,10a16)
+2270 format('0',10a16)
+
+4000 format('0*** group table ***')
+4002 format('0 group no',i4)
+4004 format(1x,f3.1,i4)
+4010 format('0*** column table ***')
+4012 format(1x,2i4)
+4020 format('0*** printout table ***')
+4022 format('0 index',i4,' type',i4,' ic flag',i4)
+4024 format('0 st fine prt',1pe12.4,' st course prt',e12.4)
+4026 format('0 fine prt grid'/(1x,1pe12.4))
+4028 format('0 course prt grid'/(1x,1pe12.4))
+4030 format('0 column count'/(1x,i4))
+4032 format('0 print directory'/(1x,i4))
+
+ end program mozart_pp
diff --git a/chem_proc/src/cam_chempp/mozpp.mods.f b/chem_proc/src/cam_chempp/mozpp.mods.f
new file mode 100644
index 0000000000..9d9e5e4fa0
--- /dev/null
+++ b/chem_proc/src/cam_chempp/mozpp.mods.f
@@ -0,0 +1,790 @@
+
+ module io
+
+ implicit none
+
+ integer :: lin ! input unit number
+ integer :: lout ! output unit number
+
+ character(len=320) :: buff ! primary line input buffer
+ character(len=320) :: buffh ! upcase xform of buff
+ character(len=320) :: procout_path = "../output/"
+ character(len=320) :: procfiles_path = "../procfiles/cam/"
+ character(len=320) :: output_path = "../output/"
+ character(len=320) :: input_path
+ character(len=320) :: temp_path
+ character(len=320) :: src_dir = "../bkend/"
+ character(len=320) :: sim_dat_path = "../output/"
+ character(len=320) :: sim_dat_filespec
+ character(len=320) :: sim_dat_filename
+
+ end module io
+
+!-----------------------------------------------------------
+! ... Table of the elements; symbol and amu
+!-----------------------------------------------------------
+ module elements
+
+ integer, private,parameter :: dp = selected_real_kind( 12 )
+
+ type element
+ character(len=2) :: sym
+ real(dp) :: wght
+ end type element
+
+ integer, private :: tab_max = 100
+ integer, private :: id_cnt = 1
+ character(len=39), private :: id
+ type( element ), private :: e_table(100)
+
+ contains
+
+ subroutine iniele()
+!-----------------------------------------------------------
+! ... Initialize the element mass table and mass computation
+!-----------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------
+ integer :: i
+
+ e_table(:)%sym = ' '
+ e_table(1) = ELEMENT( 'H ',1.0074_dp )
+ e_table(2) = ELEMENT( 'He',4.0020602_dp )
+ e_table(3) = ELEMENT( 'Li',6.941_dp )
+ e_table(4) = ELEMENT( 'Be',9.012182_dp )
+ e_table(5) = ELEMENT( 'B ',10.811_dp )
+ e_table(6) = ELEMENT( 'C ',12.011_dp )
+ e_table(7) = ELEMENT( 'N ',14.00674_dp )
+ e_table(8) = ELEMENT( 'O ',15.9994_dp )
+ e_table(9) = ELEMENT( 'F ',18.9984032_dp )
+ e_table(10) = ELEMENT( 'Ne',20.1797_dp )
+ e_table(11) = ELEMENT( 'Na',22.989768_dp )
+ e_table(12) = ELEMENT( 'Mg',24.305_dp )
+ e_table(13) = ELEMENT( 'Al',26.981539_dp )
+ e_table(14) = ELEMENT( 'Si',28.0855_dp )
+ e_table(15) = ELEMENT( 'P ',30.97362_dp )
+ e_table(16) = ELEMENT( 'S ',32.066_dp )
+ e_table(17) = ELEMENT( 'Cl',35.4527_dp )
+ e_table(18) = ELEMENT( 'Ar',39.948_dp )
+ e_table(19) = ELEMENT( 'K ',39.0983_dp )
+ e_table(20) = ELEMENT( 'Ca',40.078_dp )
+ e_table(21) = ELEMENT( 'Sc',44.95591_dp )
+ e_table(22) = ELEMENT( 'Ti',47.867_dp )
+ e_table(23) = ELEMENT( 'V ',50.9415_dp )
+ e_table(24) = ELEMENT( 'Cr',51.9961_dp )
+ e_table(25) = ELEMENT( 'Mn',54.93085_dp )
+ e_table(26) = ELEMENT( 'Fe',55.845_dp )
+ e_table(27) = ELEMENT( 'Co',58.9332_dp )
+ e_table(28) = ELEMENT( 'Ni',58.6934_dp )
+ e_table(29) = ELEMENT( 'Cu',63.546_dp )
+ e_table(30) = ELEMENT( 'Zn',65.39_dp )
+ e_table(31) = ELEMENT( 'Ga',69.723_dp )
+ e_table(32) = ELEMENT( 'Ge',72.61_dp )
+ e_table(33) = ELEMENT( 'As',74.92159_dp )
+ e_table(34) = ELEMENT( 'Se',78.96_dp )
+ e_table(35) = ELEMENT( 'Br',79.904_dp )
+ e_table(36) = ELEMENT( 'Kr',83.8_dp )
+ e_table(37) = ELEMENT( 'Rb',85.4678_dp )
+ e_table(38) = ELEMENT( 'Sr',87.62_dp )
+ e_table(39) = ELEMENT( 'Y ',88.90585_dp )
+ e_table(40) = ELEMENT( 'Zr',91.224_dp )
+ e_table(41) = ELEMENT( 'Nb',92.90638_dp )
+ e_table(42) = ELEMENT( 'Mo',95.94_dp )
+ e_table(43) = ELEMENT( 'Tc',98._dp )
+ e_table(44) = ELEMENT( 'Ru',101.07_dp )
+ e_table(45) = ELEMENT( 'Rh',102.9055_dp )
+ e_table(46) = ELEMENT( 'Pd',106.42_dp )
+ e_table(47) = ELEMENT( 'Ag',107.8682_dp )
+ e_table(48) = ELEMENT( 'Cd',112.411_dp )
+ e_table(49) = ELEMENT( 'In',114.818_dp )
+ e_table(50) = ELEMENT( 'Sn',118.71_dp )
+ e_table(51) = ELEMENT( 'Sb',121.76_dp )
+ e_table(52) = ELEMENT( 'Te',127.6_dp )
+ e_table(53) = ELEMENT( 'I ',126.90447_dp )
+ e_table(54) = ELEMENT( 'Xe',131.29_dp )
+ e_table(55) = ELEMENT( 'Cs',132.90543_dp )
+ e_table(56) = ELEMENT( 'Ba',137.327_dp )
+ e_table(57) = ELEMENT( 'La',138.9055_dp )
+ e_table(58) = ELEMENT( 'Hf',178.49_dp )
+ e_table(59) = ELEMENT( 'Ta',180.9479_dp )
+ e_table(60) = ELEMENT( 'W ',183.84_dp )
+ e_table(61) = ELEMENT( 'Re',186.207_dp )
+ e_table(62) = ELEMENT( 'Os',190.23_dp )
+ e_table(63) = ELEMENT( 'Ir',192.217_dp )
+ e_table(64) = ELEMENT( 'Pt',195.08_dp )
+ e_table(65) = ELEMENT( 'Au',196.96654_dp )
+ e_table(66) = ELEMENT( 'Hg',200.59_dp )
+ e_table(67) = ELEMENT( 'Tl',204.3833_dp )
+ e_table(68) = ELEMENT( 'Pb',207.2_dp )
+ e_table(69) = ELEMENT( 'Bi',208.98037_dp )
+ e_table(70) = ELEMENT( 'Po',209._dp )
+ e_table(71) = ELEMENT( 'At',210._dp )
+ e_table(72) = ELEMENT( 'Rn',222._dp )
+ e_table(73) = ELEMENT( 'Fr',223._dp )
+ e_table(74) = ELEMENT( 'Ra',226.025_dp )
+ e_table(75) = ELEMENT( 'Ac',227.028_dp )
+ e_table(76) = ELEMENT( 'E ',.000548567_dp )
+
+ do i = 1,100
+ if( e_table(i)%sym == ' ' ) then
+ exit
+ end if
+ end do
+ tab_max = i - 1
+
+ id(:1) = e_table(1)%sym(:1)
+ do i = 2,tab_max
+ if( scan( e_table(i)%sym(:1), id(:id_cnt) ) == 0 ) then
+ id_cnt = id_cnt + 1
+ id(id_cnt:id_cnt) = e_table(i)%sym(:1)
+ end if
+ end do
+
+ end subroutine iniele
+
+ real(dp) function com_mass( compound, carbmass )
+!-----------------------------------------------------------
+! ... Compute the mass of input compound
+!-----------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------
+ character(len=*), intent(in) :: compound
+ logical, optional,intent(in) :: carbmass
+
+!-----------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------
+ integer :: beg, end, pos, nump, index
+ integer :: ios, el_cnt
+ real(dp) :: sum
+ logical :: carbon_only
+
+ carbon_only = .false.
+ if (present(carbmass)) then
+ carbon_only = carbmass
+ endif
+
+ end = len_trim( compound )
+ sum = 0._dp
+ do
+ pos = scan( compound(:end), id(:id_cnt), back = .true. )
+ if( pos == 0 ) then
+ exit
+ end if
+ nump = scan( compound(pos+1:end), '0123456789' )
+ if( nump /= 0 ) then
+ nump = pos + nump
+ read(compound(nump:end),*,iostat=ios) el_cnt
+ if( ios /= 0 .or. el_cnt == 0 ) then
+ exit
+ end if
+ end = nump - 1
+ else
+ el_cnt = 1
+ end if
+ do index = 1,tab_max
+ if( e_table(index)%sym == compound(pos:end) ) then
+ exit
+ end if
+ end do
+! if( index > 39 ) then
+! COM_MASS = 0.
+! exit
+! end if
+ if (carbon_only) then
+ if( trim(e_table(index)%sym) == 'C') then
+ sum = sum + e_table(index)%wght * real( el_cnt,dp )
+ endif
+ else
+ sum = sum + e_table(index)%wght * real( el_cnt,dp )
+ endif
+ end = pos - 1
+ if( end <= 0 ) then
+ exit
+ end if
+ end do
+ com_mass = sum
+
+ end function com_mass
+
+ end module elements
+
+ module SP_MODS
+ integer :: n = 0 ! order of matrix
+ integer :: nz = 0 ! # of non=zero elements
+ integer :: sp = 0 ! stack pointer
+ integer :: nb = 0 ! search counter
+ integer :: pp = 0 ! perm vector position
+ integer :: blkcnt = 0 ! strongly connected blk count
+ integer, allocatable :: number(:)
+ integer, allocatable :: lowlink(:)
+ integer, allocatable :: vstack(:)
+ integer, allocatable :: perm(:)
+ integer, allocatable :: rp(:)
+ integer, allocatable :: ci(:)
+ integer, allocatable :: stcoblk(:)
+ integer, allocatable :: blkmemcnt(:)
+ logical, allocatable :: matrix(:,:)
+
+ type SPARSITY
+ integer, pointer :: diag_map(:) ! map of jacobian diagonals
+ integer, pointer :: mat_sp_map(:,:) ! matrix sparsity "map"
+ logical, pointer, dimension(:,:) :: mat_sp_pat, lu_sp_pat
+ end type SPARSITY
+ end module SP_MODS
+
+ module VAR_MOD
+!-----------------------------------------------------------------------
+! ... Mozart reaction variables
+!-----------------------------------------------------------------------
+
+ implicit none
+
+ integer, parameter :: dp = selected_real_kind( 12 )
+
+ integer, parameter :: var_lim = 10000
+ integer :: hst_file_lim
+ integer :: hst_map_lim
+ integer, pointer :: nq, relcnt, nfs, ngrp, &
+ ncol, new_nq, grp_mem_cnt
+ integer, target :: spccnt(7) = 0
+ integer, allocatable :: &
+ grpflg(:), &
+ mem2grp_map(:), &
+ newind(:), &
+ grpmap(:,:), &
+ relmap(:,:), &
+ grpcnt(:), &
+ colmap(:), &
+ rel_flg(:), &
+ grp_rat_ind(:)
+
+!-----------------------------------------------------------------------
+! ... The solution class variables
+!-----------------------------------------------------------------------
+ integer, allocatable :: &
+ clsmap(:,:,:)
+ integer :: cls_ind_prdcnt
+ integer :: clscnt(5) = 0 ! count of solution species in each numerical "class"
+
+ integer :: ptplen = 0 ! total hist tape fields
+ integer, allocatable :: &
+ histout_cnt(:,:,:), &
+ histout_map(:,:,:,:)
+ integer, dimension(5,2) :: &
+ class_prod_cnt = 0, &
+ class_loss_cnt = 0
+ integer :: indexm = 0, & ! index for fixed species denoting total atm density
+ indexh2o = 0 ! index for fixed species denoting water vapor density
+
+ integer :: extcnt(5) = 0
+ integer, allocatable :: &
+ srf_flx_map(:) ! surface flux flag
+ integer :: srf_flx_cnt = 0 ! count of soln species with surface emissions
+ integer, allocatable :: &
+ dvel_map(:) ! deposition flux flag
+ integer :: dvel_cnt = 0 ! count of soln species with deposition flux
+
+ real, allocatable :: &
+ colub(:), & ! upper boundary column integral
+ grpcof(:,:) ! multiplier for group members
+
+ real(dp), allocatable :: &
+ mass(:), & ! molecular mass of the mechanism compound
+ c_mass(:), & ! carbon mass of the mechanism compound
+ temp_mass(:) ! original species masses and temp space
+
+ character(len=64), allocatable :: aliases(:)
+ character(len=16), target, allocatable :: spcsym(:,:)
+ character(len=16), pointer :: pcesym(:), &
+ solsym(:), &
+ fixsym(:), &
+ grpsym(:), &
+ colsym(:), &
+ new_solsym(:), &
+ grp_mem_sym(:), &
+ slvdsym(:)
+
+ integer :: nslvd
+
+ character(len=16), allocatable :: &
+ user_hst_names(:,:)
+
+ integer, allocatable :: permute(:,:) ! permutation vector
+ integer, allocatable :: permutation(:), permute_orig(:,:)
+
+ contains
+
+ subroutine VAR_INI()
+!-----------------------------------------------------------------------
+! ... Allocate and initialize reaction variables
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: astat
+
+ hst_file_lim = 10
+ hst_map_lim = 1000
+ allocate( grpflg(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate grpflg'
+ stop
+ end if
+ grpflg(:) = 0
+ allocate( mem2grp_map(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate mem2grp'
+ stop
+ end if
+ mem2grp_map(:) = 0
+ allocate( newind(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate newind'
+ stop
+ end if
+ newind(:) = 0
+ allocate( relmap(var_lim,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate relmap'
+ stop
+ end if
+ relmap(:,:) = 0
+ allocate( grpcnt(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate grpcnt'
+ stop
+ end if
+ grpcnt(:) = 0
+ allocate( grpmap(var_lim,var_lim/2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate grpmap'
+ stop
+ end if
+ grpmap(:,:) = 0
+ allocate( colmap(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate colmap'
+ stop
+ end if
+ colmap(:) = 0
+ allocate( rel_flg(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate rel_flg'
+ stop
+ end if
+ rel_flg(:) = 0
+ allocate( grp_rat_ind(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate grp_rat_ind'
+ stop
+ end if
+ grp_rat_ind(:) = 0
+ allocate( clsmap(var_lim,5,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate clsmap'
+ stop
+ end if
+ clsmap(:,:,:) = 0
+ allocate( histout_cnt(20,2,hst_file_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate histout_cnt'
+ stop
+ end if
+ histout_cnt(:,:,:) = 0
+ allocate( histout_map(hst_map_lim,20,2,hst_file_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate histout_map'
+ stop
+ end if
+ histout_map(:,:,:,:) = 0
+ allocate( srf_flx_map(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate srf_flx_map'
+ stop
+ end if
+ srf_flx_map(:) = 0
+ allocate( dvel_map(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate dvel_map'
+ stop
+ end if
+ dvel_map(:) = 0
+ allocate( colub(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate colub'
+ stop
+ end if
+ colub(:) = 0.
+ allocate( grpcof(var_lim,var_lim/2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate grpcof'
+ stop
+ end if
+ grpcof(:,:) = 1.
+ allocate( mass(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate mass'
+ stop
+ end if
+ mass(:) = 0.
+ allocate( c_mass(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate c_mass'
+ stop
+ end if
+ c_mass(:) = 0.
+ allocate( temp_mass(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate temp_mass'
+ stop
+ end if
+ temp_mass(:) = 0.
+ allocate( aliases(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate aliases'
+ stop
+ end if
+ aliases(:) = ' '
+ allocate( spcsym(var_lim,8),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate spcsym'
+ stop
+ end if
+ spcsym(:,:) = ' '
+ allocate( user_hst_names(var_lim,4),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate usr_hst_names'
+ stop
+ end if
+ user_hst_names(:,:) = ' '
+ allocate( permute(var_lim,5),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate permute'
+ stop
+ end if
+ permute(:,:) = 0
+ allocate( permute_orig(var_lim,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate permute_orig'
+ stop
+ end if
+ permute_orig(:,:) = 0
+ allocate( permutation(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'VAR_INI: Failed to allocate permutation'
+ stop
+ end if
+ permutation(:) = 0
+
+ nq => spccnt(1)
+ relcnt => spccnt(2)
+ nfs => spccnt(3)
+ ngrp => spccnt(4)
+ ncol => spccnt(5)
+ new_nq => spccnt(6)
+ grp_mem_cnt => spccnt(7)
+ solsym => spcsym(:,1)
+ pcesym => spcsym(:,2)
+ fixsym => spcsym(:,3)
+ grpsym => spcsym(:,4)
+ colsym => spcsym(:,5)
+ new_solsym => spcsym(:,6)
+ grp_mem_sym => spcsym(:,7)
+
+ slvdsym => spcsym(:,8)
+
+ end subroutine VAR_INI
+
+ end module VAR_MOD
+
+ module RXT_MOD
+!-----------------------------------------------------------------------
+! ... Mozart reaction variables
+!-----------------------------------------------------------------------
+
+ implicit none
+
+ integer, private,parameter :: dp = selected_real_kind( 12 )
+
+ integer :: rxt_lim
+ integer :: rxtnt_lim
+ integer :: prd_lim, prd_limp1
+ integer :: phtcnt = 0, & ! count of photolysis reactions
+ hetcnt = 0, & ! count of heterogeneous processes
+ usrcnt = 0, & ! count of "extraneous" forcing processes
+ rxntot = 0, & ! count of photo and gas phase reactions
+ gascnt = 0 ! count of gas phase reactions
+ integer, allocatable :: &
+ fixmap(:,:,:), &
+ prdmap(:,:)
+ integer, dimension(2) :: &
+ fixcnt = 0, & ! count of reactions with fixed rxtnts
+ rxmcnt = 0, & ! count of reactions with sol rxtnts
+ ipcel = 0 ! not used
+ integer, dimension(3) :: &
+ ipcep = 0 ! not used
+ integer :: prdcnt = 0, & ! entries in prdmap matrix
+ rxpcnt = 0, & ! entries in rxparm matrix
+ troecnt = 0 ! count of troe rates
+
+ integer, allocatable :: &
+ rxmap(:,:,:), &
+ pcel(:,:,:), & ! not used
+ pcep(:,:,:) ! not used
+
+ integer, allocatable :: &
+ rxptab(:), &
+ troetab(:), &
+ hetmap(:,:), &
+ usrmap(:)
+
+ integer, dimension(2) :: &
+ grp_rat_cnt = 0, &
+ rel_rxt_cnt = 0
+ integer, allocatable :: &
+ grp_rat_map(:,:,:), &
+ rxt_to_grp_map(:,:), &
+ rel_rxt_pntr(:,:), &
+ rel_rxt_map(:,:,:)
+
+ integer :: pcoeff_cnt = 0
+ integer, allocatable :: &
+ pcoeff_ind(:)
+ real, allocatable :: &
+ pcoeff(:,:), &
+ rxparm(:,:), &
+ troe_rxparm(:,:)
+ character(len=16), allocatable :: &
+ sym_rates(:,:), &
+ troe_sym_rates(:,:), &
+ pht_alias(:,:), &
+ pht_alias_mult(:,:)
+ character(len=32), allocatable :: rxt_tag(:)
+ character(len=16), allocatable :: &
+ phtsym(:)
+ logical, allocatable :: &
+ rxt_has_tag(:), &
+ rxt_has_alias(:)
+ logical, allocatable :: &
+ cph_flg(:)
+ real(dp), allocatable :: &
+ enthalpy(:)
+ logical, allocatable :: &
+ frc_from_dataset(:)
+
+ integer :: cls_rxt_cnt(4,5) = 0
+ integer, allocatable :: &
+ cls_rxt_map(:,:,:)
+ integer, allocatable :: num_rnts(:) ! number of reactants
+
+ contains
+
+ subroutine RXT_INI()
+!-----------------------------------------------------------------------
+! ... Allocate and initialize reaction variables
+!-----------------------------------------------------------------------
+
+ use VAR_MOD, only : var_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: astat
+
+!-----------------------------------------------------------------------
+! ... Set reaction limits
+!-----------------------------------------------------------------------
+ rxt_lim = 5000
+ rxtnt_lim = 3
+ prd_lim = 64
+ prd_limp1 = prd_lim + 1
+
+ allocate( fixmap(var_lim,3,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate fixmap'
+ stop
+ end if
+ fixmap(:,:,:) = 0
+ allocate( prdmap(var_lim,prd_limp1),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate prdmap'
+ stop
+ end if
+ prdmap(:,:) = 0
+ allocate( rxmap(rxt_lim,prd_lim+3,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate rxmap'
+ stop
+ end if
+ rxmap(:,:,:) = 0
+ allocate( pcel(var_lim,6,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate pcel'
+ stop
+ end if
+ pcel(:,:,:) = 0
+ allocate( pcep(var_lim,5,3),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate pcep'
+ stop
+ end if
+ pcep(:,:,:) = 0
+ allocate( rxptab(rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate rxptab'
+ stop
+ end if
+ rxptab(:) = 0
+ allocate( troetab(rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate troetab'
+ stop
+ end if
+ troetab(:) = 0
+ allocate( hetmap(rxt_lim,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate hetmap'
+ stop
+ end if
+ hetmap(:,:) = 0
+ allocate( usrmap(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate usrmap'
+ stop
+ end if
+ usrmap(:) = 0
+ allocate( grp_rat_map(rxt_lim,3,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate grp_rat_map'
+ stop
+ end if
+ grp_rat_map(:,:,:) = 0
+ allocate( rxt_to_grp_map(rxt_lim,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate rxt_to_grp_map'
+ stop
+ end if
+ rxt_to_grp_map(:,:) = 0
+ allocate( rel_rxt_pntr(rxt_lim,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate rel_rxt_pntr'
+ stop
+ end if
+ rel_rxt_pntr(:,:) = 0
+ allocate( rel_rxt_map(rxt_lim,3,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate rel_rxt_map'
+ stop
+ end if
+ rel_rxt_map(:,:,:) = 0
+ allocate( pcoeff_ind(rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate pcoeff_ind'
+ stop
+ end if
+ pcoeff_ind(:) = 0
+ allocate( pcoeff(prd_lim,rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate pcoeff'
+ stop
+ end if
+ pcoeff(:,:) = 0.
+ allocate( rxparm(2,rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate rxparm'
+ stop
+ end if
+ rxparm(:,:) = 0.
+ allocate( troe_rxparm(5,rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate troe_rxparm'
+ stop
+ end if
+ troe_rxparm(:,:) = 0.
+ allocate( sym_rates(2,rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate sym_rates'
+ stop
+ end if
+ sym_rates(:,:) = ' '
+ allocate( troe_sym_rates(5,rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate troe_sym_rates'
+ stop
+ end if
+ troe_sym_rates(:,:) = ' '
+ allocate( phtsym(rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate phtsym'
+ stop
+ end if
+ phtsym(:) = ' '
+ allocate( rxt_tag(rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate rxt_tag'
+ stop
+ end if
+ rxt_tag(:) = ' '
+ allocate( rxt_has_tag(rxt_lim),rxt_has_alias(rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate rxt_has_tag,rxt_has_alias'
+ stop
+ end if
+ rxt_has_tag(:) = .false.
+ rxt_has_alias(:) = .false.
+ allocate( cph_flg(rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate cph_flg'
+ stop
+ end if
+ cph_flg(:) = .false.
+ allocate( enthalpy(rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate enthalpy'
+ stop
+ end if
+ enthalpy(:) = 0
+ allocate( pht_alias(rxt_lim,2),pht_alias_mult(rxt_lim,2),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate pht_alias,pht_alias_mult'
+ stop
+ end if
+ pht_alias(:,:) = ' '
+ pht_alias_mult(:,:) = '1.'
+ allocate( frc_from_dataset(var_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate frc_from_dataset'
+ stop
+ end if
+ frc_from_dataset(:) = .false.
+ allocate( cls_rxt_map(rxt_lim,prd_lim+3,5),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate cls_rxt_map'
+ stop
+ end if
+ cls_rxt_map(:,:,:) = 0
+
+ allocate( num_rnts(rxt_lim),stat=astat )
+ if( astat /= 0 ) then
+ write(*,*) 'RXT_INI: Failed to allocate num_rnts'
+ stop
+ end if
+ num_rnts(:) = -1
+
+ end subroutine RXT_INI
+
+ end module RXT_MOD
diff --git a/chem_proc/src/cam_chempp/mozpp.subs.f b/chem_proc/src/cam_chempp/mozpp.subs.f
new file mode 100644
index 0000000000..54cfd4e4b7
--- /dev/null
+++ b/chem_proc/src/cam_chempp/mozpp.subs.f
@@ -0,0 +1,978 @@
+
+ subroutine TIMCON ( buff, &
+ time, &
+ lout )
+
+ use IO, only : buffh
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: lout ! output unit number
+ character (len=*), intent(in) :: buff ! input time character string
+ real, intent(out) :: time ! converted time in seconds
+
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: retcod, l, i, j, k, slen
+ integer :: mnth, tokcnt
+ integer :: toklen(6)
+ real :: units(6)
+ real :: days
+ real :: ndym(12) = (/ 31., 28., 31., 30., 31., 30., &
+ 31., 31., 30., 31., 30., 31. /)
+ character(len=16) :: tokens(6)
+ character(len=16) :: number
+ character(len=3) :: timsym(6) = &
+ (/ 'Y ', 'MON', 'D ', 'H ', 'MIN', 'S ' /)
+
+ units(:) = 0.
+ slen = LEN_TRIM( buff )
+ buffh = buff(:slen)
+ call UPCASE( buffh )
+ call GETTOKENS( buffh, slen, ':', 16, tokens, toklen, 6, tokcnt )
+ if( tokcnt == 0 ) then
+ write(*,*) ' TIMCON : Improper input time string'
+ stop
+ end if
+ do i = 1,tokcnt
+ l = VERIFY( tokens(i)(:toklen(i)), 'YMONDHIS', back = .true. )
+ if( l == 0 ) then
+ write(*,*) ' TIMCON : Improper input time number'
+ stop
+ end if
+ if( l == toklen(i) ) then
+ j = 6
+ else
+ l = l + 1
+ do j = 1,6
+ if( tokens(i)(l:toklen(i)) == timsym(j)(:LEN_TRIM(timsym(j))) ) then
+ l = l - 1
+ exit
+ end if
+ end do
+ end if
+
+ number = tokens(i)(:l)
+ if( j /= 2 ) then
+ call RELCON( number, l, units(j), retcod )
+ if( retcod /= 0 ) then
+ call ERRMES( 'number format error in time input #@', &
+ lout, &
+ number(:l), &
+ l, &
+ buff )
+ end if
+ else
+ call INTCON( number, l, mnth, retcod )
+ if( retcod /= 0 ) then
+ call ERRMES( 'number format error in time input #@', &
+ lout, &
+ number(:l), &
+ l, &
+ buff )
+ end if
+ units(2) = SUM( ndym(:mnth-1) )
+ end if
+ end do
+
+ time = 365.*units(1) + SUM( units(2:3) )
+ time = time * 8.64e4
+ time = time + 60.*(60.*units(4) + units(5)) + units(6)
+
+ end subroutine TIMCON
+
+ subroutine TIMCON_D ( buff, &
+ days0, &
+ secs )
+
+ use IO, only : lout, buffh
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy arguments
+!-----------------------------------------------------------------------
+ character (len=*), intent(in) :: buff ! input time character string
+ real, intent(out) :: days0 ! elapsed days since 0/0/0
+ real, intent(out) :: secs ! elapsed secs
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: retcod, l, i, j, k, slen
+ integer :: mnth, tokcnt
+ integer :: toklen(6)
+ real :: units(6)
+ real :: days
+ real :: ndym(12) = (/ 31., 28., 31., 30., 31., 30., &
+ 31., 31., 30., 31., 30., 31. /)
+ character(len=16) :: tokens(6)
+ character(len=16) :: number
+ character(len=3) :: timsym(6) = &
+ (/ 'Y ', 'MON', 'D ', 'H ', 'MIN', 'S ' /)
+
+ units(:) = 0.
+ slen = LEN_TRIM(buff)
+ buffh = buff(:slen)
+ call UPCASE( buffh )
+ call GETTOKENS( buffh, slen, ':', 16, tokens, toklen, 6, tokcnt )
+ if( tokcnt == 0 ) then
+ write(*,*) ' TIMCON_D : Improper input time string'
+ stop
+ end if
+ do i = 1,tokcnt
+ l = VERIFY( tokens(i)(:toklen(i)), 'YMONDHIS', back = .true. )
+ if( l == 0 ) then
+ write(*,*) ' TIMCON_D : Improper input time number'
+ stop
+ end if
+ if( l == toklen(i) ) then
+ j = 6
+ else
+ l = l + 1
+ do j = 1,6
+ if( tokens(i)(l:toklen(i)) == timsym(j)(:LEN_TRIM(timsym(j))) ) then
+ l = l - 1
+ exit
+ end if
+ end do
+ end if
+
+ number = tokens(i)(:l)
+ if( j /= 2 ) then
+ call RELCON( number, l, units(j), retcod )
+ if( retcod /= 0 ) then
+ call ERRMES( 'number format error in time input #@', &
+ lout, &
+ number(:l), &
+ l, &
+ buff )
+ end if
+ else
+ call INTCON( number, l, mnth, retcod )
+ if( retcod /= 0 ) then
+ call ERRMES( 'number format error in time input #@', &
+ lout, &
+ number(:l), &
+ l, &
+ buff )
+ end if
+ units(2) = SUM( ndym(:mnth-1) )
+ end if
+ end do
+
+ days0 = 365.*units(1) + SUM( units(2:3) )
+ secs = 60.*(60.*units(4) + units(5)) + units(6)
+
+ end subroutine TIMCON_D
+
+ subroutine CARDIN( lin, card, chars )
+!-----------------------------------------------------------------------
+! ... Cardin reads on logical input unit lin an 80 character
+! card image right filled with blanks.
+! The image has all imbedded whitespace removed and
+! non whitespace character count returned in chars
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: lin
+ integer, intent(out) :: chars
+ character(len=*), intent(out) :: card
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: ht = 9
+ integer :: i, ios, slen
+ character(len=6) :: format
+ logical :: compress
+
+
+ format = ' '
+ slen = LEN( card )
+ if( slen < 10 ) then
+ write(format,'(''(a'',i1,'')'')') slen
+ else if( slen < 100 ) then
+ write(format,'(''(a'',i2,'')'')') slen
+ else if( slen < 1000 ) then
+ write(format,'(''(a'',i3,'')'')') slen
+ end if
+ do
+ compress = .true.
+ card = ' '
+ read(lin,format,iostat=ios) card
+ if( ios /= 0 ) then
+ write(*,*) ' CARDIN : Read error = ',ios
+ call ERRMES( 'Read Error in driver file@', 6, card, 1, card )
+ end if
+!-----------------------------------------------------------------------
+! ... Remove blanks and horizontal tabs
+!-----------------------------------------------------------------------
+ slen = LEN_TRIM( card )
+ if( slen == 0 ) then
+ cycle
+ end if
+ chars = VERIFY( card(:slen), ' ' )
+ if( card(chars:chars) == '*' ) then
+ cycle
+ end if
+!-----------------------------------------------------------------------
+! ... strip all characters following a '#' or '!' character
+!-----------------------------------------------------------------------
+ i = index( card, '#' )
+ if( i == 0 ) then
+ i = index( card, '!' )
+ endif
+ if( i > 0 ) then
+ card(i:) = ' '
+ endif
+
+ chars = 0
+ do i = 1,slen
+ if( compress ) then
+ if( card(i:i) /= ' ' .and. ICHAR( card(i:i) ) /= ht ) then
+ if( card(i:i) == '"' ) then
+ compress = .false.
+ cycle
+ end if
+ chars = chars + 1
+ card(chars:chars) = card(i:i)
+ end if
+ else
+ if( card(i:i) == '"' ) then
+ compress = .true.
+ cycle
+ end if
+ chars = chars + 1
+ card(chars:chars) = card(i:i)
+ end if
+ end do
+ if( card(chars:chars) == ',' ) then
+ card(chars:chars) = ' '
+ chars = chars - 1
+ if( chars == 0 ) then
+ cycle
+ end if
+ end if
+!-----------------------------------------------------------------------
+! ... Ignore "blank" or comment card
+!-----------------------------------------------------------------------
+ if( card == ' ' ) then
+ cycle
+ else
+ card(chars+1:) = ' '
+ exit
+ end if
+ end do
+
+ end subroutine CARDIN
+
+ subroutine ERRMES( string, &
+ lout, &
+ instng, &
+ count, &
+ card )
+!-----------------------------------------------------------------------
+! ... Prints the input string error message;
+! stops the pre-processor
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: count
+ integer, intent(in) :: lout
+ character(len=*), intent(in) :: string, instng, card
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: ls, i
+ character(len=320) :: copy
+
+ copy = '0 *** '
+ ls = 6
+
+ do i = 1,MIN( LEN(string),120 )
+ if( string(i:i) == '@' ) then
+ exit
+ else if( string(i:i) == '#' ) then
+ copy(ls+1:ls+count) = instng(:count)
+ ls = ls + count
+ else
+ ls = ls + 1
+ copy(ls:ls) = string(i:i)
+ end if
+ end do
+
+ write(lout,'(a)') copy(:ls)
+ write( *,'(a)') copy(:ls)
+ if( card /= ' ' ) then
+ write(lout,'('' Input line:'')')
+ write( *,'('' Input line:'')')
+ write(lout,'(1x,a80)') card
+ write( *,'(1x,a80)') card
+ end if
+
+ stop 'abort'
+
+ end subroutine ERRMES
+
+ subroutine ALTCON( string, &
+ ls, &
+ alt, &
+ retcod )
+!-----------------------------------------------------------------------
+! altcon converts the input character string altcon
+! to a real number returned in alt. The input string
+! must have length ls and can be of the following forms:
+! 1. %km
+! 2. %
+! where % is a generalized e format
+! Successful conversion returns zero in retcod and -12
+! otherwise
+!
+! inputs:
+!
+! string = character string to convert
+! ls = length of string (max value = 80)
+!
+! outputs:
+!
+! nout = integer value if retcod = 0
+! retcod = error flag; = 0 => proper format for string
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: ls
+ integer, intent(out) :: retcod
+ real, intent(out) :: alt
+ character(len=*), intent(in) :: string
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: len
+
+ if( string(ls:ls) == 'm' .or. string(ls:ls) == 'M' ) then
+ len = ls - 1
+ else
+ len = ls
+ end if
+
+ if( len /= 0 ) then
+ call RELCON( string, &
+ len, &
+ alt, &
+ retcod )
+ if( retcod == 0 ) then
+ if( len == ls ) then
+ alt = alt*1.e5
+ else
+ alt = alt*1.e2
+ end if
+ retcod = 0
+ return
+ end if
+ end if
+
+ retcod = -12
+
+ end subroutine ALTCON
+
+ subroutine INTCON( string, &
+ ls, &
+ nout, &
+ retcod )
+!-----------------------------------------------------------------------
+! intcon converts a character string of length ls to an integer
+! format errors are trapped and retcod is set to -12
+!
+! inputs:
+!
+! string = character string to convert
+! ls = length of string (max value = 80)
+!
+! outputs:
+!
+! nout = integer value if retcod = 0
+! retcod = error flag; = 0 => proper format for string
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: ls
+ integer, intent(out) :: nout, retcod
+ character(len=*), intent(in) :: string
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: ios
+
+ read (string(:ls),*,iostat=ios) nout
+ if( ios == 0 ) then
+ retcod = 0
+ else
+ retcod = -12
+ end if
+
+ end subroutine INTCON
+
+ subroutine RELCON( string, &
+ ls, &
+ flpout, &
+ retcod )
+!-----------------------------------------------------------------------
+! relcon converts a character string of length ls to a real number
+! format errors are trapped and retcod is set to -12
+!
+! inputs:
+!
+! string = character string to convert
+! ls = length of string (max value = 80)
+!
+! outputs:
+!
+! flpout = real value if retcod = 0
+! retcod = error flag; = 0 => proper format for string
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: ls
+ integer, intent(out) :: retcod
+ real, intent(out) :: flpout
+ character(len=*), intent(in) :: string
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: ios, l
+
+ l = LEN_TRIM( string(:ls) )
+ if( l == 0 ) then
+ retcod = -12
+ else
+ read(string(:l),*,iostat=ios) flpout
+ if( ios == 0 ) then
+ retcod = 0
+ else
+ retcod = -12
+ end if
+ end if
+
+ end subroutine RELCON
+
+ subroutine NUMCON( string, &
+ num, &
+ jus )
+!-----------------------------------------------------------------------
+! numcon converts a real number to a generalized
+! e format character string
+!
+! inputs:
+!
+! num = real number to convert
+! jus = character code for output string justification
+! 'l' = left justify
+! 'c' = center
+! 'r' = right justify
+!
+! outputs:
+!
+! string = converted character string
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ real, intent(in) :: num
+ character(len=*), intent(out) :: string
+ character(len=1), intent(in) :: jus
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: wpart, il, i, iu
+ real :: frac
+ character(len=16) :: mask
+ character(len=8) :: copy(2)
+
+ equivalence (mask,copy)
+
+ if( num == 0. ) then
+ string = '0'
+ else
+ wpart = INT( num )
+ if( wpart == 0 ) then
+ il = 9
+ else
+ write(copy(1),'(i8)') wpart
+ do i = 1,8
+ if( copy(1)(i:i) /= ' ') then
+ go to 12
+ end if
+ end do
+12 il = i
+ end if
+ frac = num - INT( num )
+ if( frac == 0. ) then
+ iu = 8
+ else
+ if( wpart == 0 .and. frac < 0.e0 ) then
+ write(copy(2),'(f8.6)') frac
+ else
+ write(copy(2),'(f8.7)') ABS( frac )
+ end if
+ do i = 8,2,-1
+ if( copy(2)(i:i) /= '0') then
+ go to 22
+ end if
+ end do
+22 iu = i + 8
+ end if
+ string = mask(il:iu)
+ end if
+ if( jus == 'c' ) then
+ call CENTER( string, 16 )
+ end if
+
+ end subroutine NUMCON
+
+ subroutine CENTER( string, ls )
+!-----------------------------------------------------------------------
+! ... Center a character string of length ls
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: ls
+ character(len=*), intent(inout) :: string
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: offset, i, il, iu, len, j
+ character(len=320) :: copy
+
+ len = MIN( ls,120 )
+ copy(:len) = string(:len)
+ il = VERIFY( string(:len), ' ' )
+ if( il /= 0) then
+ iu = VERIFY( string(:len), ' ', back = .true. )
+ len = iu - il + 1
+ offset = MAX( 0,(ls - len)/2 + 1)
+ string(:ls) = ' '
+ string(offset:offset+len) = copy(il:iu)
+ end if
+
+ end subroutine CENTER
+
+ integer function LENOF( ls, string )
+!-----------------------------------------------------------------------
+! ... Returns the length of a string by finding
+! the first non-blank character from the right side
+! of the input string.
+! This function will not scan beyond ls characters
+! in the input string. If the string consists of only
+! blanks then an "error" value of zero is returned.
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: ls
+ character(len=*), intent(in) :: string
+
+ LENOF = LEN_TRIM( string(:ls) )
+
+ end function LENOF
+
+ integer function ALTCHK( alt, sptgrd, np )
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: np
+ real, intent(in) :: alt
+ real, intent(in) :: sptgrd(np)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: i
+
+ ALTCHK = 0
+ do i = 1,np
+ if( sptgrd(i) == alt ) then
+ ALTCHK = 1
+ exit
+ end if
+ end do
+
+ end function ALTCHK
+
+ subroutine UPCASE( lstring )
+!----------------------------------------------------------------------
+! ... Convert character string lstring to upper case
+!----------------------------------------------------------------------
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ character(len=*), intent(inout) :: lstring
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: i
+
+ do i = 1,LEN_TRIM( lstring )
+ if( ICHAR(lstring(i:i)) >= 97 .and. ICHAR(lstring(i:i)) <= 122 ) then
+ lstring(i:i) = CHAR(ICHAR(lstring(i:i)) - 32)
+ end if
+ end do
+
+ end subroutine UPCASE
+
+ integer function STRLEN ( string )
+!-----------------------------------------------------------------------
+! ... Returns the length of a string by finding
+! the first non-blank character from the right side
+! of the input string.
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ character(len=*), intent(in) :: string
+
+ STRLEN = LEN_TRIM( string )
+
+ end function STRLEN
+
+ subroutine PARSE_FLPTH( fullpath, filename, filepath )
+
+ implicit none
+
+!-------------------------------------------------------
+! ... Dummy args
+!-------------------------------------------------------
+ character(len=*), intent(in) :: fullpath ! incoming full pathname
+ character(len=*), intent(out) :: filename ! the file name
+ character(len=*), intent(out) :: filepath ! the file path
+
+!-------------------------------------------------------
+! ... Local variables
+!-------------------------------------------------------
+ integer :: i
+
+ i = INDEX( fullpath(:LEN_TRIM(fullpath)), '/', back = .true. )
+ filename = fullpath(i+1:)
+ if( i /= 0 ) then
+ filepath = fullpath(:i)
+ else
+ filepath = ' '
+ end if
+
+ end subroutine PARSE_FLPTH
+
+ logical function ISNUM( char )
+
+ implicit none
+
+ character(len=1), intent(in) :: char
+
+ if( char <= '9' .and. char >= '0' ) then
+ ISNUM = .true.
+ else
+ ISNUM = .false.
+ end if
+
+ end function ISNUM
+
+ subroutine MKDATE( time, date )
+
+ implicit none
+
+!-------------------------------------------------------
+! ... Dummy args
+!-------------------------------------------------------
+ real, intent(in) :: time ! time to convert in days
+ character(len=6), intent(out) :: date ! date in form yymmdd
+
+!-------------------------------------------------------
+! ... Local variables
+!-------------------------------------------------------
+ integer :: years, days
+ integer :: mnth
+ integer :: mdys(0:12) = (/ 0, 31, 59, 90, 120, 151, &
+ 181, 212, 243, 273, 304, 334, 365 /)
+
+ years = INT( time/365. )
+ if( years > 1900 ) then
+ years = years - 1900
+ end if
+ write(date(1:2),'(i2)') years
+
+ days = INT( time - REAL(years)*365. )
+ do mnth = 1,12
+ if( days <= mdys(mnth) ) then
+ exit
+ end if
+ end do
+
+ mnth = MAX( 1,MIN( 12, mnth ) )
+ if( mnth < 10 ) then
+ write(date(3:4),'(''0'',i1)') mnth
+ else
+ write(date(3:4),'(i2)') mnth
+ end if
+
+ days = days - mdys(mnth-1)
+ if( days < 10 ) then
+ write(date(5:6),'(''0'',i1)') days
+ else
+ write(date(5:6),'(i2)') days
+ end if
+
+ end subroutine MKDATE
+
+ integer function INCLIST( target, list, cnt )
+!-------------------------------------------------------
+! ... Check for match in character list
+!-------------------------------------------------------
+
+ implicit none
+
+!-------------------------------------------------------
+! ... Input arguments
+!-------------------------------------------------------
+ integer, intent(in) :: cnt ! no elements in list
+ character(len=*), intent(in) :: target ! match string
+ character(len=*), intent(in) :: list(*) ! list to search
+
+!-------------------------------------------------------
+! ... Local variables
+!-------------------------------------------------------
+ integer :: i
+
+ INCLIST = 0
+ do i = 1,cnt
+ if( target == list(i) ) then
+ INCLIST = i
+ exit
+ end if
+ end do
+
+ end function INCLIST
+
+ integer function INILIST( target, list, cnt )
+!-------------------------------------------------------
+! ... Check for match in integer list
+!-------------------------------------------------------
+
+ implicit none
+
+!-------------------------------------------------------
+! ... Input arguments
+!-------------------------------------------------------
+ integer, intent(in) :: cnt ! no elements in list
+ integer, intent(in) :: target ! match integer
+ integer, intent(in) :: list(*) ! list to search
+
+!-------------------------------------------------------
+! ... Local variables
+!-------------------------------------------------------
+ integer :: i
+
+ INILIST = 0
+ do i = 1,cnt
+ if( target == list(i) ) then
+ INILIST = i
+ exit
+ end if
+ end do
+
+ end function INILIST
+
+ subroutine r2c( string, num, jus )
+!-----------------------------------------------------------------------
+! r2c converts a real number to a generalized e format character string
+!
+! inputs:
+!
+! num = real number to convert
+! jus = character code for output string justification
+! 'l' = left justify
+! 'c' = center
+! 'r' = right justify
+!
+! outputs:
+!
+! char = converted character string
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ real, intent(in) :: num
+ character(len=*), intent(out) :: string
+ character(len=1) :: jus
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ real, parameter :: epsilon = .0000005
+
+ integer :: wpart, il, i, iu
+ integer :: power
+ real :: frac
+ real :: wrk_num
+ character(len=24) :: mask
+ character(len=8) :: copy(3)
+
+ equivalence (mask,copy)
+
+ if( num == 0. ) then
+ string = '0'
+ else
+ wrk_num = num
+ power = 0
+ if( abs(wrk_num) < 1.e-4 ) then
+ power = 1
+ wrk_num = wrk_num
+ do while( power < 40 )
+ wrk_num = 10.*wrk_num
+ if( abs(wrk_num) >= 1. ) then
+ go to 100
+ end if
+ power = power + 1
+ end do
+ string = '0'
+ return
+ end if
+
+100 wrk_num = wrk_num + epsilon
+ wpart = int( wrk_num )
+ if( wpart == 0 ) then
+ il = 9
+ else
+ write(copy(1),'(i8)') wpart
+ do i = 1,8
+ if( copy(1)(i:i) /= ' ') then
+ exit
+ end if
+ end do
+ il = i
+ end if
+ frac = wrk_num - int(wrk_num)
+ if( frac == 0. ) then
+ mask(9:9) = '.'
+ iu = 9
+ else
+ if( wpart == 0 .and. frac < 0.e0 ) then
+ write(copy(2),'(f8.6)') frac
+ else
+ write(copy(2),'(f8.7)') abs(frac)
+ end if
+ do i = 8,2,-1
+ if( copy(2)(i:i) /= '0') then
+ exit
+ end if
+ end do
+ iu = i + 8
+ end if
+ if( frac /= 0. ) then
+ if( mask(iu-3:iu-1) == '000') then
+ iu = iu - 4
+ else if( mask(iu-4:iu-2) == '000' ) then
+ iu = iu - 5
+ end if
+ end if
+ if( power /= 0 ) then
+ if( power < 10 ) then
+ write(mask(iu+1:),'(''e'',i2)') -power
+ iu = iu + 3
+ else
+ write(mask(iu+1:),'(''e'',i3)') -power
+ iu = iu + 4
+ end if
+ end if
+ if( num > 0. ) then
+ string = mask(il:iu)
+ else
+ string = '(' // mask(il:iu) // ')'
+ end if
+ end if
+
+ if( jus == 'c' ) then
+ call center( string, 16 )
+ end if
+
+ end subroutine r2c
+
+ integer function XLATE( match )
+!------------------------------------------------------------------------
+! ... Translate between overall indexing and method indexing
+!------------------------------------------------------------------------
+
+ use VAR_MOD, only : var_lim, clsmap
+
+ implicit none
+
+!------------------------------------------------------------------------
+! ... Dummy args
+!------------------------------------------------------------------------
+ integer, intent(inout) :: match
+
+!------------------------------------------------------------------------
+! ... Local variables
+!------------------------------------------------------------------------
+ integer :: class
+
+ do class = 1,5
+ if( clsmap(match,class,1) /= 0 ) then
+ match = clsmap(match,class,1)
+ XLATE = class
+ return
+ end if
+ end do
+
+ XLATE = 0
+
+ end function XLATE
diff --git a/chem_proc/src/cam_chempp/nln_code.f b/chem_proc/src/cam_chempp/nln_code.f
new file mode 100644
index 0000000000..18f76ba7bc
--- /dev/null
+++ b/chem_proc/src/cam_chempp/nln_code.f
@@ -0,0 +1,990 @@
+
+ module nln_matrix
+
+ use io, only : temp_path
+
+ implicit none
+
+ character(len=9) :: spc_cnt
+ character(len=4) :: hdr, up_hdr
+ character(len=4) :: num_suffix
+ character(len=4) :: dec_suffix
+
+ contains
+
+ subroutine make_nln( clscnt, clsmap, cls_rxt_cnt, cls_rxt_map, pcoeff_ind, &
+ pcoeff, permute, mat_map, class, &
+ lin_mat_pat, nzcnt, diag_map, march, model )
+!-----------------------------------------------------------------------
+! ... Write the fortran code for the non-linear components
+! of the Jacobian matrix
+!-----------------------------------------------------------------------
+
+ use var_mod, only : var_lim
+ use rxt_mod, only : rxt_lim, prd_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: clscnt ! count of class members
+ integer, intent(in) :: class ! class index
+ integer, intent(in) :: nzcnt ! matrix non-zero count
+ integer, intent(in) :: clsmap(var_lim,5,2)
+ integer, intent(in) :: cls_rxt_map(rxt_lim,prd_lim+3)
+ integer, intent(in) :: cls_rxt_cnt(4) ! class rxtns count
+ integer, intent(in) :: permute(clscnt)
+ integer, intent(in) :: mat_map(clscnt,clscnt)
+ integer, intent(in) :: diag_map(:)
+ integer, intent(in) :: pcoeff_ind(*) ! map for nonunity prod
+ real, intent(in) :: pcoeff(prd_lim,*)
+ character(len=16), intent(in) :: march ! target architecture
+ character(len=16), intent(in) :: model ! target model
+ logical, intent(in) :: lin_mat_pat(:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: max_len = 90
+ integer, parameter :: max_lines = 200
+ integer :: i, j, k, l, m, m2, n, r1, r2
+ integer :: length, index, pindx, mat_ind
+ integer :: row, col, sub_cnt
+ integer :: line_pos, buf_pos, rxno, target, line_cnt
+ integer :: base
+ integer :: species
+ integer :: match_cnt
+ integer :: list_cnt
+ integer :: rxtnt_cnt, rxtnt1, rxtnt2
+ integer :: other_ind
+ integer :: match_ind(rxt_lim)
+ integer :: rxt_match_ind(rxt_lim)
+ integer :: scan(rxt_lim,4)
+ integer :: rxtnt(2)
+ real :: rate
+ character(len=max_len+10) :: line
+ character(len=max_len) :: buff
+ character(len= 6) :: mat_piece, rxt_piece
+ character(len= 4) :: sol_piece, num, num1
+ logical :: beg_line
+ logical :: lexist
+ logical, allocatable :: nln_mat_pat(:)
+ logical :: hdr_made = .false.
+
+ allocate( nln_mat_pat(nzcnt),stat=pindx )
+ if( pindx /= 0 ) then
+ stop
+ end if
+ nln_mat_pat(:) = .false.
+
+ if( class == 4 ) then
+ inquire( file = trim( temp_path ) // 'nlnmat.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'nlnmat.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'nlnmat.F' )
+ if( model /= 'CAM' ) then
+ up_hdr = 'imp_'
+ hdr = 'imp_'
+ else
+ up_hdr = ' '
+ hdr = ' '
+ end if
+ else
+ open( unit = 30, file = trim( temp_path ) // 'nlnmat.F', position='append' )
+ up_hdr = 'rod_'
+ hdr = 'rod_'
+ end if
+
+ if( model == 'CAM' ) then
+ num_suffix = '_r8'
+ dec_suffix = '(r8)'
+ spc_cnt = 'gas_pcnst'
+ else
+ num_suffix = ' '
+ dec_suffix = ' '
+ spc_cnt = 'pcnstm1'
+ end if
+
+ line_cnt = 0
+ line = ' '
+ write(30,100) trim(line)
+ line = ' module mo_' // trim(up_hdr) // 'nln_matrix'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( model == 'CAM' ) then
+ line = ' use shr_kind_mod, only : r8 => shr_kind_r8'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if ( march == 'VECTOR' ) then
+ line = ' use chem_mods, only: veclen'
+ write(30,100) trim(line)
+ end if
+ end if
+ line = ' private'
+ write(30,100) trim(line)
+ line = ' public :: nlnmat'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' contains'
+ write(30,100) trim(line)
+ if( clscnt == 0 .or. cls_rxt_cnt(3) == 0 ) then
+ sub_cnt = 0
+ else
+ sub_cnt = 1
+ end if
+ call make_nln_hdr( sub_cnt, march, model )
+ if (sub_cnt>0) hdr_made = .true.
+
+ select case ( march )
+ case( 'SCALAR' )
+ mat_piece = 'mat('
+ rxt_piece = 'rxt('
+ sol_piece = 'y('
+ case default
+ mat_piece = 'mat(k,'
+ rxt_piece = 'rxt(k,'
+ sol_piece = 'y(k,'
+ end select
+
+ base = sum( cls_rxt_cnt(:2) )
+Species_loop : &
+ do species = 1,clscnt
+ target = clsmap(species,class,2)
+ line = ' '
+!-----------------------------------------------------------------------
+! ... Write code for nonlinear loss entries
+!-----------------------------------------------------------------------
+ match_cnt = 0
+ do k = base+1,base+cls_rxt_cnt(3)
+!-----------------------------------------------------------------------
+! ... Find all reactions with target reactant
+!-----------------------------------------------------------------------
+ other_ind = 0
+ do l = 2,3
+ if( cls_rxt_map(k,l) == target ) then
+ if( other_ind == 0 ) then
+ match_cnt = match_cnt + 1
+ scan(match_cnt,1) = k
+ if( l == 2 ) then
+ scan(match_cnt,2) = abs(cls_rxt_map(k,3))
+ else
+ scan(match_cnt,2) = abs(cls_rxt_map(k,2))
+ end if
+ scan(match_cnt,4) = l
+ end if
+ other_ind = other_ind + 1
+ end if
+ end do
+ end do
+!-----------------------------------------------------------------------
+! ... Write the diagonal loss entry
+!-----------------------------------------------------------------------
+ if( match_cnt > 0 ) then
+ scan(:match_cnt,3) = scan(:match_cnt,2)
+ pindx = permute(species)
+ mat_ind = mat_map(pindx,pindx)
+ write(num,'(i4)') mat_map(pindx,pindx)
+ num = adjustl( num )
+ n = len_trim( num )
+ line = ' '
+ line(10:) = trim( mat_piece ) // num(:n) // ') = -('
+ line_pos = len_trim( line ) + 1
+ beg_line = .true.
+ end if
+ list_cnt = match_cnt
+ do while( list_cnt > 0 )
+ do j = 1,match_cnt
+ if( scan(j,2) /= 0 ) then
+ index = scan(j,2)
+ exit
+ end if
+ end do
+ m = 0
+ do j = 1,match_cnt
+ if( scan(j,2) == index ) then
+ m = m + 1
+ match_ind(m) = j
+ scan(j,2) = 0
+ list_cnt = list_cnt - 1
+ end if
+ end do
+ do j = 1,m
+ l = match_ind(j)
+ rxno = cls_rxt_map(scan(l,1),1)
+ buff = ' '
+ buf_pos = 1
+ if( j == 1 .and. m > 1 ) then
+ if( scan(l,3) == target ) then
+ buff(buf_pos:) = '(4.' // trim(num_suffix) // '*'
+ else
+ buff(buf_pos:) = '('
+ end if
+ else if( scan(l,3) == target ) then
+ buff(buf_pos:) = '4.' // trim(num_suffix) // '*'
+ end if
+ write(num,'(i4)') rxno
+ num = adjustl( num )
+ n = len_trim( num )
+ buff(len_trim(buff)+1:) = trim( rxt_piece ) // num(:n) // ')'
+ length = len_trim(buff)
+ if( (line_pos + length) <= max_len-3 ) then
+ if( beg_line ) then
+ line(line_pos:) = buff(:length)
+ beg_line = .false.
+ else
+ line(line_pos:) = ' + ' // buff(:length)
+ end if
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ line = ' '
+ line(23:) = '+ ' // buff(:length)
+ end if
+ line_pos = len_trim( line ) + 1
+ end do
+ write(num,'(i4)') scan(l,3)
+ num = adjustl( num )
+ if( m > 1 ) then
+ buff = ') * ' // trim( sol_piece ) // num(:len_trim(num)) // ')'
+ else
+ buff = '*' // trim( sol_piece ) // num(:len_trim(num)) // ')'
+ end if
+ length = len_trim(buff)
+ if( (line_pos + length) <= max_len-3 ) then
+ line(line_pos:) = buff(:length)
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ line = ' '
+ line(23:) = buff(:length)
+ end if
+ line_pos = len_trim( line ) + 1
+ nln_mat_pat(mat_ind) = .true.
+ end do
+ if( match_cnt /= 0 ) then
+ line(len_trim(line)+1:) = ')'
+ end if
+ if( line /= ' ' ) then
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ end if
+
+!-----------------------------------------------------------------------
+! ... Write nondiagonal loss entries
+!-----------------------------------------------------------------------
+ list_cnt = match_cnt
+ do j = 1,match_cnt
+ if( scan(j,3) == target ) then
+ scan(j,2) = 0
+ list_cnt = list_cnt - 1
+ else
+ scan(j,2) = scan(j,3)
+ end if
+ end do
+ do while( list_cnt > 0 )
+ do j = 1,match_cnt
+ if( scan(j,2) /= 0 ) then
+ index = scan(j,2)
+ exit
+ end if
+ end do
+ m = 0
+ do j = 1,match_cnt
+ if( scan(j,2) == index ) then
+ m = m + 1
+ match_ind(m) = j
+ scan(j,2) = 0
+ list_cnt = list_cnt - 1
+ end if
+ end do
+ pindx = permute(clsmap(index,class,1))
+ mat_ind = mat_map(permute(species),pindx)
+ write(num,'(i4)') mat_map(permute(species),pindx)
+ num = adjustl( num )
+ n = len_trim( num )
+ line = ' '
+ line(10:) = trim( mat_piece ) // num(:n) // ') = -'
+ line_pos = len_trim( line ) + 1
+ if( m > 0 ) then
+ beg_line = .true.
+ nln_mat_pat(mat_ind) = .true.
+ else
+ if( model /= 'CAM' ) then
+ line(line_pos:) = '0.'
+ else
+ line(line_pos:) = '0._r8'
+ end if
+ end if
+ do j = 1,m
+ l = match_ind(j)
+ rxno = cls_rxt_map(scan(l,1),1)
+ buff = ' '
+ if( j == 1 .and. m > 1 ) then
+ buff = '('
+ buf_pos = 2
+ else
+ buf_pos = 1
+ end if
+ write(num,'(i4)') rxno
+ num = adjustl( num )
+ n = len_trim( num )
+ buff(buf_pos:) = trim( rxt_piece ) // num(:n) // ')'
+ if( j == 1 ) then
+ if ( scan(l,4) == 2 ) then
+ index = 3
+ else
+ index = 2
+ end if
+ end if
+ length = len_trim(buff)
+ if( (line_pos + length) <= max_len-3 ) then
+ if( beg_line ) then
+ line(line_pos:) = buff(:length)
+ beg_line = .false.
+ else
+ line(line_pos:) = ' + ' // buff(:length)
+ end if
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ line = ' '
+ line(23:) = '+ ' // buff(:length)
+ end if
+ line_pos = len_trim( line ) + 1
+ end do
+ write(num,'(i4)') target
+ num = adjustl( num )
+ if( m > 1 ) then
+ buff = ') * '// trim( sol_piece ) // num(:len_trim(num)) // ')'
+ else
+ buff = '*' // trim( sol_piece ) // num(:len_trim(num)) // ')'
+ end if
+ length = len_trim(buff)
+ if( (line_pos + length) <= max_len-3 ) then
+ line(line_pos:) = buff(:length)
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ line = ' '
+ line(23:) = buff(:length)
+ end if
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ end do
+ line = ' '
+ write(30,100) trim(line)
+
+!-----------------------------------------------------------------------
+! ... Scan for production matches
+!-----------------------------------------------------------------------
+ match_cnt = 0
+Product_match : &
+ do k = base+1,base+cls_rxt_cnt(3)
+ other_ind = 0
+ do l = 4,prd_lim+3
+ if( cls_rxt_map(k,l) == species ) then
+ if( other_ind == 0 ) then
+ match_cnt = match_cnt + 1
+ scan(match_cnt,1) = k
+ scan(match_cnt,2) = abs(cls_rxt_map(k,2))
+ scan(match_cnt,4) = abs(cls_rxt_map(k,3))
+ end if
+ other_ind = other_ind + 1
+ end if
+ end do
+ if( other_ind /= 0 ) then
+ scan(match_cnt,3) = other_ind
+ end if
+ end do Product_match
+ if( match_cnt == 0 ) then
+ cycle
+ end if
+!-----------------------------------------------------------------------
+! ... "Order" the match list reactants
+!-----------------------------------------------------------------------
+ do j = 1,match_cnt
+ if( scan(j,2) > scan(j,4) ) then
+ l = scan(j,2)
+ scan(j,2) = scan(j,4)
+ scan(j,4) = l
+ end if
+ end do
+!-----------------------------------------------------------------------
+! ... Search matching reactions for reactant match
+!-----------------------------------------------------------------------
+Reactant_match : &
+ do r1 = 1,clscnt
+ m = 0
+ rxtnt1 = clsmap(r1,class,2)
+ do j = 1,match_cnt
+ if( scan(j,2) == rxtnt1 .or. scan(j,4) == rxtnt1 ) then
+ m = m + 1
+ match_ind(m) = j
+ end if
+ end do
+ if( m == 0 ) then
+ cycle
+ end if
+ pindx = permute(clsmap(rxtnt1,class,1))
+ mat_ind = mat_map(permute(species),pindx)
+ write(num,'(i4)') mat_ind
+ num = adjustl( num )
+ line = ' '
+ line(10:) = trim( mat_piece ) // num(:len_trim(num)) // ') ='
+ beg_line = .true.
+ if( nln_mat_pat(mat_ind) ) then
+ line_pos = len_trim(line) + 2
+ line(line_pos:) = trim( mat_piece ) // num(:len_trim(num)) // ')'
+ beg_line = .false.
+ end if
+ nln_mat_pat(mat_ind) = .true.
+Second_reactant_match : &
+ do r2 = 1,clscnt
+ m2 = 0
+ rxtnt2 = clsmap(r2,class,2)
+ do n = 1,m
+ j = match_ind(n)
+ if( rxtnt2 /= rxtnt1 ) then
+ if( scan(j,2) == rxtnt2 .or. scan(j,4) == rxtnt2 ) then
+ m2 = m2 + 1
+ rxt_match_ind(m2) = j
+ end if
+ else if( scan(j,2) == rxtnt2 .and. scan(j,4) == rxtnt2 ) then
+ m2 = m2 + 1
+ rxt_match_ind(m2) = j
+ end if
+ end do
+ if( m2 == 0 ) then
+ cycle
+ end if
+ if( .not. beg_line ) then
+ line(len_trim(line)+2:) = '+'
+ else
+ beg_line = .false.
+ end if
+ if( m2 > 1 ) then
+ line(len_trim(line)+2:) = '('
+ line_pos = len_trim( line ) + 1
+ else
+ line_pos = len_trim( line ) + 2
+ end if
+Rates_loop : &
+ do n = 1,m2
+!-----------------------------------------------------------------------
+! ... The reaction rate
+!-----------------------------------------------------------------------
+ l = rxt_match_ind(n)
+ rxno = cls_rxt_map(scan(l,1),1)
+ index = pcoeff_ind(rxno)
+ rate = 0.
+ if( index /= 0 ) then
+ do i = 4,prd_lim+3
+ if( cls_rxt_map(scan(l,1),i) == species ) then
+ rate = rate + pcoeff(i-3,index)
+ end if
+ end do
+ else if( scan(l,3) /= 1 ) then
+ rate = REAL(scan(l,3))
+ end if
+ if( rxtnt1 == rxtnt2 ) then
+ if( rate == 0. ) then
+ rate = 2.
+ else
+ rate = 2.*rate
+ end if
+ end if
+ buff = ' '
+ if( n > 1 .and. m2 > 1 ) then
+ buff = '+'
+ end if
+ if( rate /= 0. .and. rate /= 1. ) then
+ call r2c( buff(len_trim(buff)+1:), rate, 'l' )
+ buff(len_trim(buff)+1:) = trim(num_suffix) // '*'
+ end if
+ write(num,'(i4)') rxno
+ num = adjustl( num )
+ buff(len_trim(buff)+1:) = trim( rxt_piece ) // num(:len_trim(num)) // ')'
+ length = len_trim(buff)
+ if( (line_pos + length) <= max_len-3 ) then
+ line(line_pos:) = buff(:length)
+ else
+ if( line(len_trim(line):len_trim(line)) /= '+' ) then
+ line(len_trim(line)+1:) = ' &'
+ else
+ line(len_trim(line):) = ' &'
+ end if
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ line = ' '
+ if( buff(1:1) /= '+' ) then
+ line(23:) = '+ ' // buff(:length)
+ else
+ line(23:) = ' ' // buff(:length)
+ end if
+! line(23:) = '+ ' // buff(:length)
+ end if
+ line_pos = len_trim( line ) + 1
+ end do Rates_loop
+!-----------------------------------------------------------------------
+! ... The reactant
+!-----------------------------------------------------------------------
+ if( m2 > 1 ) then
+ line(len_trim(line)+1:) = ')'
+ line_pos = len_trim( line ) + 1
+ end if
+ write(num,'(i4)') rxtnt2
+ num = adjustl( num )
+ buff = '*' // trim( sol_piece ) // num(:len_trim(num)) // ')'
+ length = len_trim(buff)
+ if( (line_pos + length) <= max_len-3 ) then
+ line(line_pos:) = buff(:length)
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ line = ' '
+ line(23:) = buff(:length)
+ end if
+ end do Second_Reactant_match
+ write(30,100) trim(line)
+ line_cnt = line_cnt + 1
+ end do Reactant_match
+ line = ' '
+ write(30,100) trim(line)
+ if( line_cnt > max_lines ) then
+ if( march /= 'SCALAR' ) then
+ line = ' end do'
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ write(num,'(i3)') 100+sub_cnt
+ write(line,'('' end subroutine '',a,''nlnmat'',a)') up_hdr,num(2:3)
+ write(30,100) trim(line)
+ hdr_made = .false.
+ line_cnt = 0
+ if( species /= clscnt ) then
+ sub_cnt = sub_cnt + 1
+ call make_nln_hdr( sub_cnt, march, model )
+ hdr_made = .true.
+ end if
+ end if
+ end do Species_loop
+ if ( hdr_made ) then
+ if( march /= 'SCALAR' ) then
+ line = ' end do'
+ write(30,100) trim(line)
+ end if
+
+ line = ' '
+ write(30,100) trim(line)
+ write(num,'(i3)') 100+sub_cnt
+ write(line,'('' end subroutine '',a,''nlnmat'',a)') up_hdr,num(2:3)
+ write(30,100) trim(line)
+ end if
+!-----------------------------------------------------------------------
+! ... Make the inclusion routine
+!-----------------------------------------------------------------------
+ if( clscnt > 0 ) then
+ if( cls_rxt_cnt(3) == 0 ) then
+ if( model == 'MOZART' ) then
+ select case( march )
+ case ( 'VECTOR' )
+ write(line,'('' call '',a,''nlnmat_finit( avec_len, mat, lmat, dti )'')') up_hdr
+ case default
+ write(line,'('' call '',a,''nlnmat_finit( mat, lmat, dti )'')') up_hdr
+ end select
+ else
+ if ( march == 'VECTOR' ) then
+ write(line,'('' call '',a,''nlnmat_finit( avec_len, mat, lmat, dti )'')') up_hdr
+ else
+ write(line,'('' call '',a,''nlnmat_finit( mat, lmat, dti )'')') up_hdr
+ endif
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' end subroutine ' // trim(up_hdr) // 'nlnmat'
+ write(30,100) trim(line)
+ end if
+ call make_nln_hdr( -1, march, model )
+ line = ' '
+ do n = 1,size(lin_mat_pat)
+ if( lin_mat_pat(n) ) then
+ write(num,'(i4)') n
+ m = len_trim( num )
+ if( nln_mat_pat(n) ) then
+ line(10:) = trim( mat_piece ) // num(:m) // ') = ' // trim(mat_piece) // num(:m) // ') + l' &
+ // trim(mat_piece) // num(:m) // ')'
+ else
+ line(10:) = trim( mat_piece ) // num(:m) // ') = l' // trim(mat_piece) // num(:m) // ')'
+ end if
+ write(30,100) trim(line)
+ end if
+ end do
+ line = ' '
+ do n = 1,size(lin_mat_pat)
+ if( .not. lin_mat_pat(n) .and. .not. nln_mat_pat(n) ) then
+ write(num,'(i4)') n
+ m = len_trim( num )
+ if( model /= 'CAM' ) then
+ line(10:) = trim( mat_piece ) // num(:m) // ') = 0.'
+ else
+ line(10:) = trim( mat_piece ) // num(:m) // ') = 0._r8'
+ end if
+ write(30,100) trim(line)
+ end if
+ end do
+ do n = 1,size(diag_map)
+ l = diag_map(n)
+ if( lin_mat_pat(l) .or. nln_mat_pat(l) ) then
+ write(num,'(i4)') l
+ m = len_trim( num )
+ if( model == 'CAM' .and. march == 'VECTOR' ) then
+ line(10:) = trim( mat_piece ) // num(:m) // ') = ' // trim(mat_piece) // num(:m) // ') - dti(k)'
+ else
+ line(10:) = trim( mat_piece ) // num(:m) // ') = ' // trim(mat_piece) // num(:m) // ') - dti'
+ endif
+ else
+ write(num,'(i4)') l
+ m = len_trim( num )
+ if( model == 'CAM' .and. march == 'VECTOR' ) then
+ line(10:) = trim( mat_piece ) // num(:m) // ') = -dti(k)'
+ else
+ line(10:) = trim( mat_piece ) // num(:m) // ') = -dti'
+ endif
+ end if
+ write(30,100) trim(line)
+ end do
+ if( march /= 'SCALAR' ) then
+ line = ' end do'
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ line = ' end subroutine ' // trim(up_hdr) // 'nlnmat_finit'
+ write(30,100) trim(line)
+ end if
+!-----------------------------------------------------------------------
+! ... Now make the driver routine
+!-----------------------------------------------------------------------
+ if( clscnt > 0 .and. cls_rxt_cnt(3) > 0 ) then
+ call make_nln_hdr( 0, march, model )
+ end if
+ do n = 1,sub_cnt
+ write(num,'(i3)') 100+n
+ select case( march )
+ case ( 'SCALAR' )
+ write(line,'('' call '',a,''nlnmat'',a,''( mat, y, rxt )'')') up_hdr,num(2:3)
+ case ( 'VECTOR' )
+ write(line,'('' call '',a,''nlnmat'',a,''( avec_len, mat, y, rxt )'')') &
+ up_hdr,num(2:3)
+ case default
+ if( model /= 'CAM' ) then
+ write(line,'('' call '',a,''nlnmat'',a,''( mat, y, rxt )'')') up_hdr,num(2:3)
+ else
+ write(line,'('' call '',a,''nlnmat'',a,''( mat, y, rxt, cols )'')') up_hdr,num(2:3)
+ end if
+ end select
+ write(30,100) trim(line)
+ end do
+ if( clscnt > 0 .and. cls_rxt_cnt(3) > 0 ) then
+ select case( march )
+ case ( 'SCALAR' )
+ write(line,'('' call '',a,''nlnmat_finit( mat, lmat, dti )'')') up_hdr
+ case ( 'VECTOR' )
+ write(line,'('' call '',a,''nlnmat_finit( avec_len, mat, lmat, dti )'')') up_hdr
+ case default
+ if( model /= 'CAM' ) then
+ write(line,'('' call '',a,''nlnmat_finit( mat, lmat, dti )'')') up_hdr
+ else
+ write(line,'('' call '',a,''nlnmat_finit( mat, lmat, dti, cols )'')') up_hdr
+ end if
+ end select
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' end subroutine ' // trim(up_hdr) // 'nlnmat'
+ write(30,100) trim(line)
+ end if
+ if( clscnt == 0 ) then
+ line = ' '
+ write(30,100) trim(line)
+ line = ' end subroutine ' // trim(up_hdr) // 'nlnmat'
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ line = ' end module mo_' // trim(up_hdr) // 'nln_matrix'
+ write(30,100) trim(line)
+
+ if( allocated( nln_mat_pat ) ) then
+ deallocate( nln_mat_pat )
+ end if
+
+ close( 30 )
+
+100 format(a)
+
+ end subroutine make_nln
+
+ subroutine make_nln_hdr( sub_cnt, march, model )
+!-----------------------------------------------------------------------
+! ... Write the fortran header code for the non-linear components
+! of the Jacobian matrix
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: sub_cnt ! subroutine counter
+ character(len=16), intent(in) :: march ! targe architecture
+ character(len=16), intent(in) :: model ! target model
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: length
+ character(len=132) :: line
+ character(len=3) :: num
+
+ line = ' '
+ write(30,100) trim(line)
+ write(num,'(i3)') 100+sub_cnt
+ select case( march )
+ case ( 'SCALAR' )
+ if( sub_cnt > 0 ) then
+ write(line,'('' subroutine '',a,''nlnmat'',a,''( mat, y, rxt )'')') up_hdr,num(2:3)
+ else if( sub_cnt < 0 ) then
+ write(line,'('' subroutine '',a,''nlnmat_finit( mat, lmat, dti )'')') up_hdr
+ else
+ write(line,'('' subroutine '',a,''nlnmat( mat, y, rxt, lmat, dti )'')') up_hdr
+ end if
+ case ( 'VECTOR' )
+ if( sub_cnt > 0 ) then
+ write(line,'('' subroutine '',a,''nlnmat'',a,''( avec_len, mat, y, rxt )'')') up_hdr,num(2:3)
+ else if( sub_cnt < 0 ) then
+ write(line,'('' subroutine '',a,''nlnmat_finit( avec_len, mat, lmat, dti )'')') up_hdr
+ else
+ write(line,'('' subroutine '',a,''nlnmat( avec_len, mat, y, rxt, lmat, dti )'')') up_hdr
+ end if
+ case default
+ if( model /= 'CAM' ) then
+ if( sub_cnt > 0 ) then
+ write(line,'('' subroutine '',a,''nlnmat'',a,''( mat, y, rxt )'')') up_hdr,num(2:3)
+ else if( sub_cnt < 0 ) then
+ write(line,'('' subroutine '',a,''nlnmat_finit( mat, lmat, dti )'')') up_hdr
+ else
+ write(line,'('' subroutine '',a,''nlnmat( mat, y, rxt, lmat, dti )'')') up_hdr
+ end if
+ else
+ if( sub_cnt > 0 ) then
+ write(line,'('' subroutine '',a,''nlnmat'',a,''( mat, y, rxt, cols )'')') up_hdr,num(2:3)
+ else if( sub_cnt < 0 ) then
+ write(line,'('' subroutine '',a,''nlnmat_finit( mat, lmat, dti, cols )'')') up_hdr
+ else
+ write(line,'('' subroutine '',a,''nlnmat( mat, y, rxt, lmat, dti, cols )'')') up_hdr
+ end if
+ end if
+ end select
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ select case( march )
+ case( 'SCALAR' )
+ if( model /= 'WRF' ) then
+ if( model == 'MOZART' ) then
+ line = ' use mo_grid, only : ' // trim(spc_cnt)
+ write(30,100) trim(line)
+ line = ' use chem_mods, only : rxntot, ' // hdr // 'nzcnt'
+ else
+ line = ' use chem_mods, only : gas_pcnst, rxntot, ' // hdr // 'nzcnt'
+ end if
+ else
+ line = ' '
+ end if
+ case ( 'VECTOR' )
+ if( model == 'MOZART' ) then
+ line = ' use mo_grid, only : plnplv, ' // trim(spc_cnt)
+ write(30,100) trim(line)
+ line = ' use chem_mods, only : rxntot, ' // hdr // 'nzcnt'
+ elseif( march == 'VECTOR' ) then
+ line = ' use chem_mods, only : gas_pcnst, rxntot, nzcnt'
+ end if
+ case default
+ if( model == 'MOZART' ) then
+ line = ' use mo_grid, only : ' // trim(spc_cnt)
+ write(30,100) trim(line)
+ line = ' use chem_mods, only : rxntot, ' // hdr // 'nzcnt, clsze'
+ else if( model == 'CAM' ) then
+ line = ' use chem_mods, only : gas_pcnst, rxntot, nzcnt, clsze'
+ write(30,100) trim(line)
+ line = ' '
+ end if
+ end select
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' implicit none '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... dummy arguments'
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ if( model == 'CAM' .and. march == 'CACHE' ) then
+ line = ' integer, intent(in) :: cols'
+ write(30,100) trim(line)
+ end if
+ select case( march )
+ case( 'SCALAR' )
+ if( sub_cnt <= 0 ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: dti'
+ write(30,100) trim(line)
+ if( model /= 'WRF' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: lmat(' // trim(hdr) // 'nzcnt)'
+ write(30,100) trim(line)
+ else
+ line = ' real, intent(in) :: lmat(:)'
+ write(30,100) trim(line)
+ end if
+ end if
+ if( sub_cnt >= 0 ) then
+ if( model /= 'WRF' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(' // trim(spc_cnt) // ')'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(rxntot)'
+ write(30,100) trim(line)
+ else
+ line = ' real, intent(in) :: y(:)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: rxt(:)'
+ write(30,100) trim(line)
+ end if
+ end if
+ if( model /= 'WRF' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(inout) :: mat(' // trim(hdr) // 'nzcnt)'
+ else
+ line = ' real, intent(inout) :: mat(:)'
+ end if
+ case ( 'VECTOR' )
+ line = ' integer, intent(in) :: avec_len'
+ write(30,100) trim(line)
+ if( sub_cnt <= 0 ) then
+ if( model /= 'CAM' ) then
+ line = ' real, intent(in) :: dti'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: lmat(plnplv,' // trim(hdr) // 'nzcnt)'
+ else
+ line = ' real(r8), intent(in) :: dti(veclen)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: lmat(veclen,nzcnt)'
+ end if
+ write(30,100) trim(line)
+ end if
+ if( sub_cnt >= 0 ) then
+ if( model /= 'CAM' ) then
+ line = ' real, intent(in) :: y(plnplv,' // trim(spc_cnt) // ')'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: rxt(plnplv,rxntot)'
+ else
+ line = ' real(r8), intent(in) :: y(veclen,gas_pcnst)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: rxt(veclen,rxntot)'
+ end if
+ write(30,100) trim(line)
+ end if
+ if( model /= 'CAM' ) then
+ line = ' real, intent(inout) :: mat(plnplv,' // hdr // 'nzcnt)'
+ else
+ line = ' real(r8), intent(inout) :: mat(veclen,nzcnt)'
+ end if
+ case ( 'CACHE' )
+ if( sub_cnt <= 0 ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: dti'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: lmat(clsze,' // trim(hdr) // 'nzcnt)'
+ write(30,100) trim(line)
+ end if
+ if( sub_cnt >= 0 ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(clsze,' // trim(spc_cnt) // ')'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(clsze,rxntot)'
+ write(30,100) trim(line)
+ end if
+ line = ' real' // trim(dec_suffix) // ', intent(inout) :: mat(clsze,' // trim(hdr) // 'nzcnt)'
+ case default
+ if( sub_cnt <= 0 ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: dti'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: lmat(plnplv,' // trim(hdr) // 'nzcnt)'
+ write(30,100) trim(line)
+ end if
+ if( sub_cnt >= 0 ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(plnplv,' // trim(spc_cnt) // ')'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(plnplv,rxntot)'
+ write(30,100) trim(line)
+ end if
+ line = ' real' // trim(dec_suffix) // ', intent(inout) :: mat(plnplv,' // trim(hdr) // 'nzcnt)'
+ end select
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( sub_cnt /= 0 ) then
+ line = ' '
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... local variables'
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ if( march /= 'SCALAR' ) then
+ line = ' integer :: k'
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) trim(line)
+
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... complete matrix entries'
+ length = len_trim( line ) + 2
+ line(length:) = 'implicit species'
+ write(30,100) trim(line)
+ line = '!----------------------------------------------'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( march == 'VECTOR' ) then
+ line(7:) = 'do k = 1,avec_len'
+ else if( march == 'CACHE' ) then
+ if( model == 'MOZART' ) then
+ line(7:) = 'do k = 1,clsze'
+ else if( model == 'CAM' ) then
+ line(7:) = 'do k = 1,cols'
+ end if
+ end if
+ write(30,100) trim(line)
+ end if
+
+100 format(a)
+
+ end subroutine make_nln_hdr
+
+ end module nln_matrix
diff --git a/chem_proc/src/cam_chempp/num_ctl.f b/chem_proc/src/cam_chempp/num_ctl.f
new file mode 100644
index 0000000000..c3c46b0ab2
--- /dev/null
+++ b/chem_proc/src/cam_chempp/num_ctl.f
@@ -0,0 +1,96 @@
+
+ subroutine NUM_CTL( iter_counts )
+
+ use IO
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy arguments
+!-----------------------------------------------------------------------
+ integer, intent(inout) :: iter_counts(4) ! iteration counts
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: max_parm = 4
+ integer :: kpar, nchar, k
+ integer :: parsw(max_parm)
+ integer :: retcod
+ character(len=20) :: keywrd
+ character(len=20) :: parkey(max_parm)
+ logical :: found
+
+ parkey(1) = 'HOVITERATIONS'
+ parkey(2) = 'IMPLICITITERATIONS'
+ parkey(3) = 'JACOBIANITERATIONS'
+ parkey(4) = 'EBIITERATIONS'
+
+ parsw = 0
+
+!-----------------------------------------------------------------------
+! ... Scan for valid option keyword
+!-----------------------------------------------------------------------
+ do
+ call CARDIN( lin, buff, nchar )
+ buffh = buff
+ call UPCASE ( buffh )
+ if( buffh == 'ENDNUMERICALCONTROL' ) then
+ exit
+ end if
+ k = INDEX( buffh(:nchar), '=' )
+ if( k /= 0 ) then
+ found = .false.
+ keywrd = buffh(:k-1)
+ do kpar = 1,max_parm
+ if( keywrd == parkey(kpar) ) then
+ found = .true.
+ exit
+ end if
+ end do
+ else
+!-----------------------------------------------------------------------
+! ... Invalid parameter keyword; terminate the program
+!-----------------------------------------------------------------------
+ call ERRMES ( ' Num ctl specification has no = operator@', lout, buff, 1, buff )
+ end if
+!-----------------------------------------------------------------------
+! ... Invalid parameter keyword; terminate the program
+!-----------------------------------------------------------------------
+ if( .not. found ) then
+ call ERRMES ( ' # is an invalid Num control parameter keyword@', &
+ lout, &
+ keywrd, &
+ LEN_TRIM(keywrd), &
+ buffh )
+!-----------------------------------------------------------------------
+! ... Valid parameter keyword; now check for duplicate keyword
+!-----------------------------------------------------------------------
+ else if( parsw(kpar) /= 0 ) then
+ call ERRMES( '0 *** # has already been specified@', lout, parkey(kpar), k, ' ' )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Set individual iteration counts
+!-----------------------------------------------------------------------
+ call INTCON( buff(k+1:nchar), nchar - k, iter_counts(kpar), retcod )
+!-----------------------------------------------------------------------
+! ... Check itertion limit for validity
+!-----------------------------------------------------------------------
+ if( retcod /= 0 ) then
+ call ERRMES ( ' # is an invalid iteration count@', &
+ lout, &
+ buff(k+1:nchar), &
+ nchar - k, &
+ buffh )
+ else if( iter_counts(kpar) <= 0 ) then
+ call ERRMES ( ' # is an invalid iteration count@', &
+ lout, &
+ buff(k+1:nchar), &
+ nchar - k, &
+ buffh )
+ end if
+ parsw(kpar) = 1
+ end do
+
+ end subroutine NUM_CTL
diff --git a/chem_proc/src/cam_chempp/outp.f b/chem_proc/src/cam_chempp/outp.f
new file mode 100644
index 0000000000..bf626d2f88
--- /dev/null
+++ b/chem_proc/src/cam_chempp/outp.f
@@ -0,0 +1,222 @@
+
+ subroutine OUTP( rxparms, &
+ nr, &
+ np, &
+ rxtsym, &
+ prdsym, &
+ sym_rate, &
+ irxn, &
+ rate, &
+ loc_rxt_alias, &
+ lout )
+
+ use RXT_MOD, only : rxtnt_lim, prd_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! OUTP OUTPuts a single reaction and rate
+!
+! Inputs:
+! nr - number of reactants
+! np - number of products
+! rxparms - vector of "full" product terms (including
+! multipliers)
+! rxtsym - reactant symbol(s)
+! prdsym - product symbol(s)
+! irxn - reaction number
+! rate - vector of reaction rate parameters
+! lout - logical OUTPut unit number
+! Outputs:
+! NONE
+!-----------------------------------------------------------------------
+
+ integer, intent(in) :: nr, np, irxn, lout
+ real, intent(in) :: rate(:)
+ character(len=16), intent(in) :: rxparms(prd_lim)
+ character(len=16), intent(in) :: sym_rate(5)
+ character(len=16), intent(in) :: loc_rxt_alias
+ character(len=16), intent(in) :: rxtsym(rxtnt_lim), prdsym(prd_lim)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: i, j, k, kl, length, retcod, line_cnt
+ integer :: buff_pos, arrow_pos
+ real :: coeff
+ character(len=320) :: buff
+ character(len=64) :: rx_piece
+
+ buff = ' '
+ j = 1
+
+!-----------------------------------------------------------------------
+! ... Form the reactants
+!-----------------------------------------------------------------------
+ do i = 1,nr
+ length = LEN_TRIM( rxtsym(i) )
+ buff(j:length+j-1) = rxtsym(i)(:length)
+ j = length + j + 1
+ if( i == nr ) then
+ buff(j:) = '->'
+ j = j + 3
+ else
+ buff(j:) = '+'
+ j = j + 2
+ end if
+ end do
+ buff_pos = j ; arrow_pos = j - 1
+
+!-----------------------------------------------------------------------
+! ... Form the products
+!-----------------------------------------------------------------------
+ line_cnt = 1
+ if( np /= 0 ) then
+ do i = 1,np
+ rx_piece = ' '
+ j = 1
+ length = INDEX( rxparms(i), '*' )
+ if( length /= 0 ) then
+ read(rxparms(i)(:length-1),*,iostat=retcod) coeff
+ if( retcod /= 0 ) then
+ call ERRMES( ' # is not a valid real number@', &
+ lout, &
+ rxparms(i), &
+ length-1, &
+ buff )
+ end if
+ if( coeff /= 1. ) then
+ length = length + 1
+ rx_piece(:length) = rxparms(i)(:length-1) // '*'
+ j = length
+ end if
+ end if
+ length = LEN_TRIM( prdsym(i) )
+ rx_piece(j:length+j-1) = prdsym(i)(:length)
+ length = LEN_TRIM( rx_piece )
+ if( (buff_pos + length) <= 69 ) then
+ buff(buff_pos:) = TRIM( rx_piece )
+ buff_pos = buff_pos + length + 1
+ if( i /= np ) then
+ buff(buff_pos:buff_pos) = '+'
+ buff_pos = buff_pos + 2
+ else
+ kl = line_cnt
+ do k = kl,3
+ call WRITE_RXT( buff, sym_rate, rate, loc_rxt_alias, irxn, line_cnt )
+ line_cnt = line_cnt + 1
+ end do
+ end if
+ else
+ call WRITE_RXT( buff, sym_rate, rate, loc_rxt_alias, irxn, line_cnt )
+ line_cnt = line_cnt + 1
+ if( i /= np ) then
+ buff(arrow_pos:arrow_pos) = '+'
+ buff_pos = arrow_pos + 2
+ else
+ kl = line_cnt
+ do k = kl,3
+ call WRITE_RXT( buff, sym_rate, rate, loc_rxt_alias, irxn, line_cnt )
+ line_cnt = line_cnt + 1
+ end do
+ end if
+ end if
+ end do
+ else
+ buff(j:) = '(No products)'
+ do k = 1,3
+ call WRITE_RXT( buff, sym_rate, rate, loc_rxt_alias, irxn, line_cnt )
+ line_cnt = line_cnt + 1
+ end do
+ end if
+
+ end subroutine OUTP
+
+ subroutine WRITE_RXT( buff, sym_rate, rate, loc_rxt_alias, irxn, line_cnt )
+!-----------------------------------------------------------------------
+! ... Print the reaction rate
+!-----------------------------------------------------------------------
+
+ use IO, only : lout
+ use RXT_MOD, only : phtcnt
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: line_cnt, irxn
+ real, intent(in) :: rate(:)
+ character(len=320), intent(inout) :: buff
+ character(len=16), intent(in) :: sym_rate(:)
+ character(len=16), intent(in) :: loc_rxt_alias
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ logical :: troe_rate
+
+ if( line_cnt <= 3 ) then
+ if( sym_rate(1) /= ' ' ) then
+ troe_rate = rate(1) /= 0. .and. rate(3) /= 0.
+ if( line_cnt == 1 ) then
+ if( rate(1) == 0. ) then
+ buff(69:) = ' rate = 0.'
+ write(lout,100) loc_rxt_alias, irxn, buff, irxn+phtcnt
+ else if( .not. troe_rate ) then
+ buff(69:) = ' rate = '
+ write(buff(77:),'(1pe8.2)') rate(1)
+ if( rate(2) /= 0. ) then
+ buff(85:) = '*EXP('
+ write(buff(90:),'(f8.0)') rate(2)
+ buff(98:) = '/t)'
+ end if
+ write(lout,100) loc_rxt_alias, irxn, buff, irxn+phtcnt
+ else
+ buff(69:) = ' troe : ko='
+ write(buff(80:),'(1pe8.2)') rate(1)
+ if( rate(2) /= 0. ) then
+ buff(88:) = '*(300/t)**'
+ write(buff(98:),'(f4.2)') rate(2)
+ end if
+ write(lout,110) loc_rxt_alias, irxn, buff, irxn+phtcnt
+ end if
+ else if( troe_rate ) then
+ if( line_cnt == 2 ) then
+ buff(69:) = ' ki='
+ write(buff(80:),'(1pe8.2)') rate(3)
+ if( rate(4) /= 0. ) then
+ if( rate(4) /= 1. ) then
+ buff(88:) = '*(300/t)**'
+ write(buff(98:),'(f4.2)') rate(4)
+ else
+ buff(88:) = '*(300/t)'
+ end if
+ end if
+ else if( line_cnt == 3 ) then
+ buff(69:) = ' f='
+ write(buff(80:),'(f4.2)') rate(5)
+ end if
+ write(lout,120) buff
+ else if( buff /= ' ' ) then
+ write(lout,120) buff
+ end if
+ else
+ if( line_cnt == 1 ) then
+ buff(69:) = ' rate = ** User defined **'
+ write(lout,100) loc_rxt_alias, irxn, buff, irxn+phtcnt
+ end if
+ end if
+ else if( buff /= ' ' ) then
+ write(lout,120) buff
+ end if
+ buff = ' '
+
+!-----------------------------------------------------------------------
+! ... Formats
+!-----------------------------------------------------------------------
+100 format(2x,a8,1x,'(',i3,')',3x,a100,3x,'(',i3,')')
+110 format(2x,a8,1x,'(',i3,')',3x,a101,2x,'(',i3,')')
+120 format(19x,a101)
+
+ end subroutine WRITE_RXT
diff --git a/chem_proc/src/cam_chempp/padj_code.f b/chem_proc/src/cam_chempp/padj_code.f
new file mode 100644
index 0000000000..9867923f9e
--- /dev/null
+++ b/chem_proc/src/cam_chempp/padj_code.f
@@ -0,0 +1,191 @@
+
+ subroutine make_padj( fixmap, fixcnt, phtcnt, model, march )
+!-----------------------------------------------------------------------
+! ... Write the photorate adjustment code
+!-----------------------------------------------------------------------
+
+ use var_mod, only : var_lim
+ use io, only : temp_path
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... The arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: fixcnt
+ integer, intent(in) :: phtcnt
+ integer, intent(in) :: fixmap(var_lim,2)
+ character(len=*), intent(in) :: model
+ character(len=*), intent(in) :: march
+
+!-----------------------------------------------------------------------
+! ... The local variables
+!-----------------------------------------------------------------------
+ integer :: k, rxno
+ character(len=72) :: line
+ logical :: first
+ logical :: lexist
+
+
+ inquire( file = trim( temp_path ) // 'mo_phtadj.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'mo_phtadj.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'mo_phtadj.F' )
+
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'module mo_phtadj'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'private'
+ write(30,100) trim(line)
+ line(7:) = 'public :: phtadj'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'contains'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ select case( model )
+ case( 'MOZART' )
+ line(7:) = 'subroutine phtadj( p_rate, inv, m, plnplv )'
+ case ( 'CAM' )
+ line(7:) = 'subroutine phtadj( p_rate, inv, m, ncol, nlev )'
+ case ( 'WRF' )
+ line(7:) = 'subroutine phtadj( p_rate, inv, m, n )'
+ end select
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( model /= 'WRF' ) then
+ line(7:) = 'use chem_mods, only : nfs, phtcnt'
+ write(30,100) trim(line)
+ end if
+ if( model == 'CAM' ) then
+ line(7:) = 'use shr_kind_mod, only : r8 => shr_kind_r8'
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'implicit none'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... dummy arguments'
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ select case( model )
+ case( 'MOZART' )
+ line = ' integer, intent(in) :: plnplv'
+ case ( 'CAM' )
+ line = ' integer, intent(in) :: ncol, nlev'
+ case ( 'WRF' )
+ line = ' integer, intent(in) :: n'
+ end select
+ write(30,100) trim(line)
+ select case( model )
+ case( 'MOZART' )
+ line = ' real, intent(in) :: inv(plnplv,nfs)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: m(plnplv)'
+ write(30,100) trim(line)
+ line = ' real, intent(inout) :: p_rate(plnplv,phtcnt)'
+ case( 'CAM' )
+ line = ' real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs))'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: m(ncol,nlev)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt))'
+ case( 'WRF' )
+ line = ' real, intent(in) :: inv(:,:)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: m(:)'
+ write(30,100) trim(line)
+ line = ' real, intent(inout) :: p_rate(:,:)'
+ end select
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... local variables'
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ select case( model )
+ case( 'MOZART' )
+ line = ' real :: im(plnplv)'
+ case( 'CAM' )
+ line = ' integer :: k'
+ write(30,100) trim(line)
+ line = ' real(r8) :: im(ncol,nlev)'
+ case( 'WRF' )
+ line = ' real :: im(n)'
+ end select
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+
+ if( model == 'CAM' ) then
+ line = ' do k = 1,nlev'
+ write(30,100) trim(line)
+ end if
+
+ first = .true.
+ do k = 1,fixcnt
+ rxno = abs( fixmap(k,1) )
+ if( fixmap(k,1) < 0 .and. rxno <= phtcnt ) then
+ if( first ) then
+ select case( model )
+ case( 'CAM' )
+ line(7:) = ' im(:ncol,k) = 1._r8 / m(:ncol,k)'
+ case default
+ line(7:) = 'im(:) = 1. / m(:)'
+ end select
+ write(30,100) trim(line)
+ line = ' '
+ first = .false.
+ end if
+ select case( model )
+ case( 'CAM' )
+ write(line(7:),'('' p_rate(:,k,'',i3,'') = p_rate(:,k,'',i3,'')'')') rxno,rxno
+ line(len_trim(line)+2:) = ' * inv(:,k,'
+ write(line(len_trim(line)+1:),'(i2)') fixmap(k,2)
+ line(len_trim(line)+1:) = ') * im(:,k)'
+ case default
+ line(7:) = 'p_rate(:, ) = p_rate(:, )'
+ write(line(16:18),'(i3)') rxno
+ write(line(32:34),'(i3)') rxno
+ line(len_trim(line)+2:) = ' * inv(:,'
+ write(line(len_trim(line)+1:),'(i2)') fixmap(k,2)
+ line(len_trim(line)+1:) = ') * im(:)'
+ end select
+ write(30,100) trim(line)
+ end if
+ end do
+
+ if( model == 'CAM') then
+ line = ' end do'
+ write(30,100) trim(line)
+ end if
+
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'end subroutine phtadj'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'end module mo_phtadj'
+ write(30,100) trim(line)
+
+ close(30)
+
+100 format(a)
+
+ end subroutine make_padj
diff --git a/chem_proc/src/cam_chempp/params_hdr.f b/chem_proc/src/cam_chempp/params_hdr.f
new file mode 100644
index 0000000000..9e21738700
--- /dev/null
+++ b/chem_proc/src/cam_chempp/params_hdr.f
@@ -0,0 +1,62 @@
+
+ subroutine PARAMS_HDR( plon, plonl, plat, plev, &
+ phtcnt, rxntot, &
+ adv_cnt, nadv_cnt, histout_cnt, &
+ chemistry, diffusion, convection, arch_type, &
+ filespec )
+!-----------------------------------------------------------------------
+! ... Make the params.h file
+!-----------------------------------------------------------------------
+
+ use IO, only : lout
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: plon, plonl, plat, plev
+ integer, intent(in) :: phtcnt, rxntot
+ integer, intent(in) :: adv_cnt, nadv_cnt
+ integer, intent(in) :: histout_cnt(20,2)
+ logical, intent(in) :: chemistry, diffusion, convection
+ character(len=16), intent(in) :: arch_type
+ character(len=*), intent(in) :: filespec
+
+!-----------------------------------------------------------------------
+! ... The local variables
+!-----------------------------------------------------------------------
+ integer :: ios
+ logical :: lexist
+
+ INQUIRE( file = TRIM(filespec), exist = lexist )
+ if( lexist ) then
+ call SYSTEM( 'rm '//TRIM(filespec) )
+ end if
+ OPEN( unit = 30, file = TRIM(filespec), iostat=ios )
+ if( ios /= 0 ) then
+ write(lout,*) 'PARAMS_HDR: Failed to open simulation datafile ',TRIM(filespec),' ;error = ',ios
+ stop
+ end if
+ write(30,'(a)') '# ifndef PARAMS_H'
+ write(30,'(a)') '# define PARAMS_H'
+ write(30,'('' '')')
+ write(30,'(a)') '# define CALC_ETADOT'
+ if( diffusion ) then
+ write(30,'(a)') '# define DI_VDIFF'
+ else
+ write(30,'(a)') '# define AR_VDIFF'
+ end if
+ if( convection ) then
+ write(30,'(a)') '# define DI_CONV_CCM'
+ else
+ write(30,'(a)') '# define AR_CONV_CCM'
+ end if
+ write(30,'(a)') '# define DI_CLOUD_PHYS'
+ if( chemistry ) then
+ write(30,'(a)') '# define TROP_CHEM'
+ end if
+ write(30,'('' '')')
+ write(30,'(a)') '# endif'
+
+ end subroutine PARAMS_HDR
diff --git a/chem_proc/src/cam_chempp/pl_code.f b/chem_proc/src/cam_chempp/pl_code.f
new file mode 100644
index 0000000000..f9dcb78d19
--- /dev/null
+++ b/chem_proc/src/cam_chempp/pl_code.f
@@ -0,0 +1,919 @@
+
+ module prod_loss
+
+ use io, only : temp_path
+
+ contains
+
+ subroutine pl_code( spccnt, clscnt, clsmap, cls_rxt_cnt, cls_rxt_map, &
+ pcoeff_ind, pcoeff, permute, march, model )
+!-----------------------------------------------------------------------
+! ... Write the fortran production and loss code
+!-----------------------------------------------------------------------
+
+ use var_mod, only : var_lim
+ use rxt_mod, only : rxt_lim, prd_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... The arguments
+!
+! The columns of the cls_rxt_cnt represent the reaction count
+! for each class with the following row conontation:
+! (1) - independent reactions
+! (2) - linear reactions
+! (3) - nonlinear reactions
+! (4) - heterogeneous processes
+!-----------------------------------------------------------------------
+ integer, intent(in) :: spccnt
+ integer, intent(in) :: clscnt(5), &
+ clsmap(var_lim,5,2), &
+ cls_rxt_map(rxt_lim,prd_lim+3,5), &
+ cls_rxt_cnt(4,5)
+ integer, intent(in) :: pcoeff_ind(rxt_lim)
+ integer, intent(in) :: permute(var_lim,5)
+ real, intent(in) :: pcoeff(prd_lim,rxt_lim)
+ character(len=16), intent(in) :: march
+ character(len=16), intent(in) :: model
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: max_len = 90
+ integer, parameter :: explicit = 1
+ integer, parameter :: ebi = 2
+ integer, parameter :: hov = 3
+ integer, parameter :: implicit = 4
+ integer, parameter :: rodas = 5
+ integer :: i, k, kl, ku, l, m, ml
+ integer :: length, index, cnt
+ integer :: line_pos, target
+ integer :: class
+ integer :: base
+ integer :: species
+ integer :: match_cnt
+ integer :: other_ind
+ integer :: match_ind(4)
+ integer :: max_loc(1)
+ integer :: freq(spccnt)
+ integer, allocatable :: indexer(:)
+ real :: rate
+ character(len=max_len) :: line
+ character(len=72) :: buff
+ character(len=14) :: het_piece
+ character(len= 9) :: l_piece
+ character(len= 9) :: p_piece
+ character(len= 8) :: rxt_piece
+ character(len= 6) :: sol_piece
+ character(len=4) :: num_suffix
+ character(len=4) :: dec_suffix
+ character(len= 3) :: num
+ logical, allocatable :: match_mask(:,:)
+ logical, allocatable :: pmask(:,:)
+ logical :: beg_line
+ logical :: lexist, first
+
+ inquire( file = trim( temp_path ) // 'prd_loss.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'prd_loss.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'prd_loss.F' )
+
+ if( model == 'CAM' ) then
+ num_suffix = '_r8'
+ dec_suffix = '(r8)'
+ else
+ num_suffix = ' '
+ dec_suffix = ' '
+ end if
+
+ line = ' module mo_prod_loss'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( model == 'CAM' ) then
+ line = ' use shr_kind_mod, only : r8 => shr_kind_r8'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( march == 'VECTOR' ) then
+ line = ' use chem_mods, only : veclen'
+ write(30,100) trim(line)
+ endif
+ line = ' private'
+ write(30,100) trim(line)
+ end if
+ do class = 1,5
+ select case( class )
+ case( 1 )
+ line = ' public :: exp_prod_loss'
+ write(30,100) trim(line)
+ case( 4 )
+ line = ' public :: imp_prod_loss'
+ write(30,100) trim(line)
+ end select
+ end do
+ line = ' '
+ write(30,100) trim(line)
+ line = ' contains'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+
+Class_loop : &
+ do class = 1,5
+ if( class == ebi .or. class == hov ) then
+ cycle
+ else if( class == rodas .and. model /= 'MOZART' ) then
+ cycle
+ end if
+ if( march == 'SCALAR' ) then
+ select case( class )
+ case( explicit )
+ line = ' subroutine exp_prod_loss( prod, loss, y, rxt, het_rates )'
+ case( ebi )
+ line = ' subroutine ebi_prod_loss( prod, loss, y, rxt, het_rates )'
+ case( hov )
+ line = ' subroutine hov_prod_loss( prod, loss, y, rxt, het_rates )'
+ case( implicit )
+ line = ' subroutine imp_prod_loss( prod, loss, y, rxt, het_rates )'
+ case( rodas )
+ line = ' subroutine rodas_prod_loss( prod, loss, y, rxt, het_rates )'
+ end select
+ else if( march == 'VECTOR' ) then
+ select case( class )
+ case( explicit )
+ if( model /= 'CAM' ) then
+ line = ' subroutine exp_prod_loss( prod, loss, y, rxt, het_rates )'
+ else
+ line = ' subroutine exp_prod_loss( ofl, ofu, prod, loss, y, &'
+ write(30,100) trim(line)
+ line = ' rxt, het_rates, chnkpnts )'
+ end if
+ case( ebi )
+ line = ' subroutine ebi_prod_loss( prod, loss, y, rxt, het_rates )'
+ case( hov )
+ line = ' subroutine hov_prod_loss( prod, loss, y, rxt, het_rates )'
+ case( implicit )
+ line = ' subroutine imp_prod_loss( avec_len, prod, loss, y, &'
+ write(30,100) trim(line)
+ line = ' rxt, het_rates )'
+ case( rodas )
+ line = ' subroutine rodas_prod_loss( avec_len, prod, loss, y, &'
+ write(30,100) trim(line)
+ line = ' rxt, het_rates )'
+ end select
+ else
+ if( model == 'MOZART' ) then
+ select case( class )
+ case( explicit )
+ line = ' subroutine exp_prod_loss( prod, loss, y, rxt, het_rates )'
+ case( ebi )
+ line = ' subroutine ebi_prod_loss( prod, loss, y, rxt, het_rates )'
+ case( hov )
+ line = ' subroutine hov_prod_loss( prod, loss, y, rxt, het_rates )'
+ case( implicit )
+ line = ' subroutine imp_prod_loss( prod, loss, y, rxt, het_rates )'
+ case( rodas )
+ line = ' subroutine rodas_prod_loss( prod, loss, y, rxt, het_rates )'
+ end select
+ else if( model == 'CAM' ) then
+ select case( class )
+ case( explicit )
+ line = ' subroutine exp_prod_loss( prod, loss, y, rxt, het_rates )'
+ case( ebi )
+ line = ' subroutine ebi_prod_loss( prod, loss, y, rxt, het_rates, cols )'
+ case( hov )
+ line = ' subroutine hov_prod_loss( prod, loss, y, rxt, het_rates, cols )'
+ case( implicit )
+ line = ' subroutine imp_prod_loss( prod, loss, y, rxt, het_rates, cols )'
+ case( rodas )
+ line = ' subroutine rodas_prod_loss( prod, loss, y, rxt, het_rates, cols )'
+ end select
+ else if( model == 'WRF' ) then
+ select case( class )
+ case( explicit )
+ line = ' subroutine exp_prod_loss( prod, loss, y, rxt )'
+ case( ebi )
+ line = ' subroutine ebi_prod_loss( prod, loss, y, rxt )'
+ case( hov )
+ line = ' subroutine hov_prod_loss( prod, loss, y, rxt )'
+ case( implicit )
+ line = ' subroutine imp_prod_loss( prod, loss, y, rxt )'
+ case( rodas )
+ line = ' subroutine rodas_prod_loss( prod, loss, y, rxt )'
+ end select
+ end if
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( model == 'CAM' ) then
+ if( march /= 'VECTOR' ) then
+ line = ' use ppgrid, only : pver'
+ elseif( class == explicit ) then
+ line = ' use chem_mods, only : gas_pcnst,rxntot,clscnt1'
+ elseif( class == implicit ) then
+ line = ' use chem_mods, only : gas_pcnst,rxntot,clscnt4'
+ end if
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ line = ' implicit none '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... dummy args'
+ write(30,100) line
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ if( model == 'CAM' ) then
+ if( class == implicit ) then
+ if( march == 'CACHE' ) then
+ line = ' integer :: cols'
+ write(30,100) trim(line)
+ elseif( march == 'VECTOR' ) then
+ line = ' integer, intent(in) :: avec_len'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', dimension(veclen,clscnt4), intent(out) :: &'
+ else
+ line = ' real' // trim(dec_suffix) // ', dimension(:,:), intent(out) :: &'
+ endif
+ else
+ if( march /= 'VECTOR' ) then
+ line = ' real' // trim(dec_suffix) // ', dimension(:,:,:), intent(out) :: &'
+ elseif( class == explicit ) then
+ line = ' integer, intent(in) :: ofl, ofu, chnkpnts'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', dimension(chnkpnts,max(1,clscnt1)), intent(out) :: &'
+ else
+ line = ' real' // trim(dec_suffix) // ', dimension(:,:), intent(out) :: &'
+ end if
+ end if
+ else
+ line = ' real' // trim(dec_suffix) // ', dimension(:,:), intent(out) :: &'
+ end if
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ if( march == 'SCALAR' .and. class /= explicit ) then
+ line = ' real' // trim(dec_suffix) // ', dimension(:), intent(out) :: &'
+ p_piece = 'prod('
+ l_piece = 'loss('
+ rxt_piece = 'rxt('
+ het_piece = 'het_rates('
+ sol_piece = 'y('
+ else if( march == 'VECTOR' ) then
+ p_piece = 'prod(k,'
+ l_piece = 'loss(k,'
+ rxt_piece = 'rxt(k,'
+ het_piece = 'het_rates(k,'
+ sol_piece = 'y(k,'
+ else
+ if( class == explicit ) then
+ p_piece = 'prod(:,:,'
+ l_piece = 'loss(:,:,'
+ rxt_piece = 'rxt(:,:,'
+ het_piece = 'het_rates(:,:,'
+ sol_piece = 'y(:,:,'
+ else
+ p_piece = 'prod(k,'
+ l_piece = 'loss(k,'
+ rxt_piece = 'rxt(k,'
+ het_piece = 'het_rates(k,'
+ sol_piece = 'y(k,'
+ end if
+ end if
+ end if
+ write(30,100) trim(line)
+ line = ' prod, &'
+ write(30,100) trim(line)
+ line = ' loss'
+ write(30,100) trim(line)
+ if( class == explicit ) then
+ if( model /= 'CAM' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(:,:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(:,:)'
+ write(30,100) trim(line)
+ if( model /= 'WRF' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: het_rates(:,:)'
+ write(30,100) trim(line)
+ end if
+ else
+ if( march /= 'VECTOR' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(:,:,:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(:,:,:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: het_rates(:,:,:)'
+ else
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(chnkpnts,gas_pcnst)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(chnkpnts,rxntot)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: het_rates(chnkpnts,gas_pcnst)'
+ end if
+ write(30,100) trim(line)
+ end if
+ else
+ if( march == 'SCALAR' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(:)'
+ write(30,100) trim(line)
+ if( model /= 'WRF' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: het_rates(:)'
+ end if
+ else if( march == 'VECTOR' ) then
+! line = ' integer, intent(in) :: ofl'
+! write(30,100) trim(line)
+! line = ' integer, intent(in) :: ofu'
+! write(30,100) trim(line)
+! line = ' integer, intent(in) :: chnkpnts'
+! write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(veclen,gas_pcnst)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(veclen,rxntot)'
+ write(30,100) trim(line)
+ if( model /= 'WRF' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: het_rates(veclen,gas_pcnst)'
+ end if
+ else
+ if( model /= 'CAM' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(:,:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(:,:)'
+ write(30,100) trim(line)
+ if( model /= 'WRF' ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: het_rates(:,:)'
+ end if
+ else
+ select case( class )
+ case( explicit )
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(:,:,:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(:,:,:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: het_rates(:,:,:)'
+ case( implicit )
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: y(:,:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: rxt(:,:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: het_rates(:,:)'
+ end select
+ end if
+ end if
+ if( model /= 'WRF' ) then
+ write(30,100) trim(line)
+ end if
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ if( clscnt(class) /= 0 ) then
+ line = ' '
+ write(30,100) trim(line)
+ buff = ' '
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+! if( march /= 'SCALAR' .and. class /= explicit ) then
+ if( march == 'VECTOR' ) then
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... local variables'
+ write(30,100) line
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = ' '
+ line(7:) = 'integer :: k'
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ line = ' '
+ end if
+ if( allocated( match_mask ) ) then
+ deallocate( match_mask )
+ end if
+ if( allocated( pmask ) ) then
+ deallocate( pmask )
+ end if
+ if( allocated( indexer ) ) then
+ deallocate( indexer )
+ end if
+ k = sum( cls_rxt_cnt(:,class) )
+ if( k == 0 ) then
+ if( class == implicit .or. class == rodas ) then
+ line(10:) = trim( l_piece ) // ':) = 0.' // trim(num_suffix)
+ else
+ if( model == 'CAM' ) then
+ if( march /= 'VECTOR' ) then
+ line(10:) = 'loss(:,:,:) = 0.' // trim(num_suffix)
+ end if
+ else
+ line(7:) = 'loss(:,:) = 0.' // trim(num_suffix)
+ end if
+ end if
+ write(30,100) trim(line)
+
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ line(10:) = trim( p_piece ) // ':) = 0.' // trim(num_suffix)
+ else
+ line(7:) = 'prod(:,:) = 0.' // trim(num_suffix)
+ end if
+ write(30,100) trim(line)
+
+ call terminate_subroutine
+ cycle Class_loop
+ end if
+ allocate( match_mask(k,3) )
+ allocate( indexer(k) )
+ if( sum( cls_rxt_cnt(2:3,class) ) /= 0 ) then
+ allocate( pmask(k,prd_lim) )
+ end if
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... loss and production for'
+ length = len_trim( line ) + 2
+ select case( class )
+ case( 1 )
+ line(length:) = 'Explicit method'
+ case( 2 )
+ line(length:) = 'Ebi-gs method'
+ case( 3 )
+ line(length:) = 'Hov-gs method'
+ case( 4 )
+ line(length:) = 'Implicit method'
+ case( 5 )
+ line(length:) = 'Rodas3 method'
+ end select
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+100 format(a)
+ if( class == ebi ) then
+ line = ' '
+ line(10:) = 'select case( index )'
+ write(30,100) trim(line)
+ line = ' '
+ else if( model == 'CAM' .or. class == 4 .or. class == 5 ) then
+ line = ' '
+ if( march /= 'SCALAR' ) then
+ if( march == 'VECTOR' ) then
+ if( class == implicit ) then
+ line(7:) = 'do k = 1,avec_len'
+ else
+ line(7:) = 'do k = ofl,ofu'
+ end if
+ else
+ if( model == 'MOZART' ) then
+ line(7:) = 'do k = 1,clsze'
+ else if( model == 'CAM' .and. class /= explicit ) then
+ line(7:) = 'do k = 1,cols'
+ end if
+ end if
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ end if
+Species_loop : &
+ do species = 1,clscnt(class)
+ if( class == ebi .or. class == hov ) then
+ write(num,'(i3)') permute(species,2)
+ line = ' '
+ line(13:) = 'case( ' // num(:len_trim(num)) // ' )'
+ write(30,100) trim(line)
+ line = ' '
+ end if
+!-----------------------------------------------------------------------
+! ...Write code for loss processes; linear, nonlinear, and heterogeneous
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! ... Setup indicies and check whether species is in any loss reactions
+!-----------------------------------------------------------------------
+ target = clsmap(species,class,2)
+ kl = cls_rxt_cnt(1,class) + 1
+ ku = sum( cls_rxt_cnt(:3,class) )
+ do i = 1,2
+ match_mask(kl:ku,i) = cls_rxt_map(kl:ku,i+1,class) == target
+ where( match_mask(kl:ku,i) )
+ indexer(kl:ku) = 6/(i+1)
+ endwhere
+ end do
+ match_mask(kl:ku,1) = match_mask(kl:ku,1) .or. match_mask(kl:ku,2)
+ kl = ku + 1 ; ku = sum(cls_rxt_cnt(:,class))
+ match_mask(kl:ku,1) = cls_rxt_map(kl:ku,2,class) == species
+ kl = cls_rxt_cnt(1,class) + 1
+ if( class == ebi .or. class == hov ) then
+ num = '1'
+ else
+ write(num,'(i3)') permute(species,class)
+ num = adjustl( num )
+ end if
+ if( count( match_mask(kl:ku,1) ) == 0 ) then
+!-----------------------------------------------------------------------
+! ... no loss for this species
+!-----------------------------------------------------------------------
+ if( class == implicit .or. class == rodas ) then
+ line(10:) = trim( l_piece ) // num(:len_trim(num)) // ') = 0.' // trim(num_suffix)
+ else
+ if( model == 'CAM' ) then
+ if( march /= 'VECTOR' ) then
+ line(10:) = 'loss(:,:,' // num(:len_trim(num)) // ') = 0.' // trim(num_suffix)
+ end if
+ else
+ line(7:) = 'loss(:,' // num(:len_trim(num)) // ') = 0.' // trim(num_suffix)
+ end if
+ end if
+ write(30,100) trim(line)
+ else
+ line = ' '
+ if( class == explicit .or. class >= implicit ) then
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ line(10:) = trim( l_piece ) // num(:len_trim(num)) // ') = ('
+ else
+ line(7:) = 'loss(:,' // num(:len_trim(num)) // ') = ('
+ end if
+ line_pos = len_trim( line ) + 1
+ else
+ line(7:) = 'loss(:,' // num(:len_trim(num)) // ') ='
+ line_pos = len_trim( line ) + 2
+ end if
+!-----------------------------------------------------------------------
+! ... Scan loss reactions for common terms
+!-----------------------------------------------------------------------
+ ku = ku - cls_rxt_cnt(4,class)
+ first = .true.
+ do m = 1,spccnt
+ match_mask(kl:ku,2) = .false.
+ do k = kl,ku
+ if( match_mask(k,1) ) then
+ if( abs( cls_rxt_map(k,indexer(k),class) ) == m ) then
+ match_mask(k,2) = .true.
+ end if
+ end if
+ end do
+ cnt = count( match_mask(kl:ku,2) )
+ if( cnt == 0 ) then
+ cycle
+ end if
+ if( m == target ) then
+ if( cnt > 1 ) then
+ if( first ) then
+ buff = '2.' // trim(num_suffix) // '*('
+ else
+ buff = ' + 2.' // trim(num_suffix) // '*('
+ end if
+ else
+ if( first ) then
+ buff = '2.' // trim(num_suffix) // '*'
+ else
+ buff = ' + 2.' // trim(num_suffix) // '*'
+ end if
+ end if
+ else
+ if( cnt > 1 ) then
+ if( first ) then
+ buff = '('
+ else
+ buff = ' + ('
+ end if
+ else
+ if( first ) then
+ buff = ' '
+ else
+ buff = ' + '
+ end if
+ end if
+ end if
+ if( first ) then
+ first = .false.
+ end if
+ l = 0
+ do k = kl,ku
+ if( match_mask(k,2) ) then
+ l = l + 1
+ write(num,'(i3)') cls_rxt_map(k,1,class)
+ num = adjustl( num )
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ buff(len_trim(buff)+1:) = trim( rxt_piece ) // num(:len_trim(num)) // ') +'
+ else
+ buff(len_trim(buff)+1:) = 'rxt(:,' // num(:len_trim(num)) // ') +'
+ end if
+ if( l == cnt ) then
+ if( cnt > 1 ) then
+ buff(len_trim(buff)-1:) = ')'
+ else
+ buff(len_trim(buff)-1:) = ' '
+ end if
+ call put_in_line
+ write(num,'(i3)') m
+ num = adjustl( num )
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ buff(len_trim(buff)+1:) = '* ' // trim( sol_piece ) // num(:len_trim(num)) // ')'
+ else
+ buff(len_trim(buff)+1:) = '* y(:,' // num(:len_trim(num)) // ')'
+ end if
+ end if
+ call put_in_line
+ end if
+ end do
+ where( match_mask(kl:ku,2) )
+ match_mask(kl:ku,1) = .false.
+ endwhere
+ end do
+!-----------------------------------------------------------------------
+! ... Strictly unimolecular losses
+!-----------------------------------------------------------------------
+ ku = sum( cls_rxt_cnt(:,class) )
+ cnt = count( match_mask(kl:ku,1) )
+ if( cnt > 0 ) then
+ do k = kl,ku
+ if( match_mask(k,1) ) then
+ cnt = cnt - 1
+ write(num,'(i3)') cls_rxt_map(k,1,class)
+ num = adjustl( num )
+ if( k <= sum(cls_rxt_cnt(1:3,class)) ) then
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ buff(len_trim(buff)+1:) = ' + ' // trim( rxt_piece ) // num(:len_trim(num)) // ')'
+ else
+ buff(len_trim(buff)+1:) = ' + rxt(:,' // num(:len_trim(num)) // ')'
+ end if
+ else
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ buff(len_trim(buff)+1:) = ' + ' // trim( het_piece ) // num(:len_trim(num)) // ')'
+ else
+ buff(len_trim(buff)+1:) = ' + het_rates(:,' // num(:len_trim(num)) // ')'
+ end if
+ end if
+ if( cnt == 0 .and. (class == explicit .or. class >= implicit) ) then
+ buff(len_trim(buff)+1:) = ')'
+ end if
+ call put_in_line
+ end if
+ end do
+ else if( class == explicit .or. class >= implicit ) then
+ buff(len_trim(buff)+1:) = ')'
+ call put_in_line
+ end if
+ if( class == explicit .or. class >= implicit ) then
+ write(num,'(i3)') target
+ num = adjustl( num )
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ buff(len_trim(buff)+1:) = '* ' // trim( sol_piece ) // num(:len_trim(num)) // ')'
+ else
+ buff(len_trim(buff)+1:) = '* y(:,' // num(:len_trim(num)) // ')'
+ end if
+ call put_in_line
+ end if
+ if( line(7:) /= ' ' ) then
+ write(30,100) trim(line)
+ end if
+ end if
+!-----------------------------------------------------------------------
+! ...Write code for production from linear and nonlinear reactions
+!-----------------------------------------------------------------------
+ ku = sum( cls_rxt_cnt(:3,class) )
+ do k = kl,ku
+ pmask(k,:) = cls_rxt_map(k,4:prd_lim+3,class) == species
+ match_mask(k,1) = ANY( pmask(k,:) )
+ end do
+ if( class == ebi .or. class == hov ) then
+ num = '1'
+ else
+ write(num,'(i3)') permute(species,class)
+ num = adjustl( num )
+ end if
+ line = ' '
+!-----------------------------------------------------------------------
+! ... No species products
+!-----------------------------------------------------------------------
+ if( count( match_mask(kl:ku,1) ) == 0 ) then
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ line(10:) = trim( p_piece ) // num(:len_trim(num)) // ') = 0.' // trim(num_suffix)
+ else
+ line(7:) = 'prod(:,' // num(:len_trim(num)) // ') = 0.' // trim(num_suffix)
+ end if
+ write(30,100) trim(line)
+ cycle Species_loop
+ else
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ line(10:) = trim( p_piece ) // num(:len_trim(num)) // ') = '
+ else
+ line(7:) = 'prod(:,' // num(:len_trim(num)) // ') = '
+ end if
+ end if
+ first = .true.
+ do
+ do m = 1,spccnt
+ match_mask(kl:ku,3) = (abs(cls_rxt_map(kl:ku,2,class)) == m .or. &
+ abs(cls_rxt_map(kl:ku,3,class)) == m) .and.&
+ match_mask(kl:ku,1)
+ freq(m) = count( match_mask(kl:ku,3) )
+ end do
+ max_loc = MAXLOC( freq(:spccnt) )
+ cnt = MAXVAL( freq(:spccnt) )
+ match_mask(kl:ku,3) = (abs(cls_rxt_map(kl:ku,2,class)) == max_loc(1) .or. &
+ abs(cls_rxt_map(kl:ku,3,class)) == max_loc(1)) .and. &
+ match_mask(kl:ku,1)
+ do k = kl,ku
+ if( match_mask(k,3) ) then
+ if( abs( cls_rxt_map(k,2,class) ) == max_loc(1) ) then
+ indexer(k) = 3
+ else
+ indexer(k) = 2
+ end if
+ end if
+ end do
+ if( cnt > 1 ) then
+ if( first ) then
+ buff = ' ('
+ else
+ buff = ' + ('
+ end if
+ else if( first ) then
+ buff = ' '
+ else
+ buff = ' +'
+ end if
+ if( first ) then
+ first = .false.
+ end if
+ m = cnt
+ do k = kl,ku
+ if( match_mask(k,3) ) then
+ index = pcoeff_ind(cls_rxt_map(k,1,class))
+ if( index /= 0 ) then
+ rate = 0.
+ do ml = 1,prd_lim
+ if( pmask(k,ml) ) then
+ rate = rate + pcoeff(ml,index)
+ end if
+ end do
+ else
+ rate = REAL( count( abs( cls_rxt_map(k,4:prd_lim+3,class) ) == species ) )
+ end if
+ if( rate /= 0. .and. rate /= 1. ) then
+ call r2c( buff(len_trim(buff)+1:), rate, 'l' )
+ buff(len_trim( buff )+1:) = trim(num_suffix) // '*'
+ end if
+ write(num,'(i3)') cls_rxt_map(k,1,class)
+ num = adjustl( num )
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ buff(len_trim(buff)+1:) = trim( rxt_piece ) // num(:len_trim(num)) // ')'
+ else
+ buff(len_trim(buff)+1:) = 'rxt(:,' // num(:len_trim(num)) // ')'
+ end if
+ if( abs( cls_rxt_map(k,indexer(k),class) ) /= 0 ) then
+ write(num,'(i3)') abs( cls_rxt_map(k,indexer(k),class) )
+ num = adjustl( num )
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ if( m > 1 ) then
+ buff(len_trim(buff)+1:) = '*' // trim( sol_piece ) // num(:len_trim(num)) // ') +'
+ else if( cnt > 1 ) then
+ buff(len_trim(buff)+1:) = '*' // trim( sol_piece ) // num(:len_trim(num)) // '))'
+ else
+ buff(len_trim(buff)+1:) = '*' // trim( sol_piece ) // num(:len_trim(num)) // ')'
+ end if
+ else
+ if( m > 1 ) then
+ buff(len_trim(buff)+1:) = '*y(:,' // num(:len_trim(num)) // ') +'
+ else if( cnt > 1 ) then
+ buff(len_trim(buff)+1:) = '*y(:,' // num(:len_trim(num)) // '))'
+ else
+ buff(len_trim(buff)+1:) = '*y(:,' // num(:len_trim(num)) // ')'
+ end if
+ end if
+ else
+ if( m > 1 ) then
+ buff(len_trim(buff)+1:) = ' +'
+ else if( cnt > 1 ) then
+ buff(len_trim(buff)+1:) = ')'
+ end if
+ end if
+ call put_in_line
+ if( m == 1 ) then
+ write(num,'(i3)') max_loc(1)
+ num = adjustl( num )
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+ buff = '*' // trim( sol_piece ) // num(:len_trim(num)) // ')'
+ else
+ buff = '*y(:,' // num(:len_trim(num)) // ')'
+ end if
+ call put_in_line
+ exit
+ end if
+ m = m - 1
+ end if
+ end do
+ where( match_mask(kl:ku,3) )
+ match_mask(kl:ku,1) = .false.
+ endwhere
+ if( count( match_mask(kl:ku,1) ) == 0 ) then
+ exit
+ end if
+ end do
+ if( line(7:) /= ' ' ) then
+ write(30,100) trim(line)
+ line = ' '
+ end if
+ end do Species_loop
+ if( class == ebi ) then
+ line = ' '
+ line(10:) = 'end select'
+ write(30,100) trim(line)
+ line = ' '
+ end if
+ if( model == 'CAM' .or. class == implicit .or. class == rodas ) then
+! if( march /= 'SCALAR' .and. class /= explicit ) then
+ if( march == 'VECTOR' ) then
+ line = ' end do'
+ write(30,100) trim(line)
+ end if
+ end if
+ end if
+!-----------------------------------------------------------------------
+! ... Terminate the subroutine
+!-----------------------------------------------------------------------
+ call terminate_subroutine
+ end do Class_loop
+
+ line = ' end module mo_prod_loss'
+ write(30,100) trim(line)
+
+
+ CLOSE( 30 )
+ if( allocated( match_mask ) ) then
+ deallocate( match_mask )
+ end if
+ if( allocated( pmask ) ) then
+ deallocate( pmask )
+ end if
+ if( allocated( indexer ) ) then
+ deallocate( indexer )
+ end if
+
+ contains
+
+ subroutine put_in_line
+!-----------------------------------------------------------------------
+! ... Put line piece in buff into the line
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: blen, llen
+
+ blen = len_trim( buff )
+ llen = len_trim( line ) + 1
+ if( blen + llen < max_len-2 ) then
+ line(llen:) = buff(:blen)
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,'(a)') trim(line)
+ line = ' '
+ line(18:) = buff(:blen)
+ end if
+ buff = ' '
+
+ end subroutine put_in_line
+
+ subroutine terminate_subroutine
+!-----------------------------------------------------------------------
+! ... Terminate the subroutine
+!-----------------------------------------------------------------------
+
+ implicit none
+
+ line = ' '
+ write(30,100) trim(line)
+ select case( class )
+ case( 1 )
+ line = ' end subroutine exp_prod_loss'
+ case( 2 )
+ line = ' end subroutine ebi_prod_loss'
+ case( 3 )
+ line = ' end subroutine hov_prod_loss'
+ case( 4 )
+ line = ' end subroutine imp_prod_loss'
+ case( 5 )
+ line = ' end subroutine rodas_prod_loss'
+ end select
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+
+100 format(a)
+
+ end subroutine terminate_subroutine
+
+ end subroutine pl_code
+
+ end module prod_loss
diff --git a/chem_proc/src/cam_chempp/prd_map.f b/chem_proc/src/cam_chempp/prd_map.f
new file mode 100644
index 0000000000..24eea19c30
--- /dev/null
+++ b/chem_proc/src/cam_chempp/prd_map.f
@@ -0,0 +1,44 @@
+
+ module MO_PRD_MAP
+
+ CONTAINS
+
+ subroutine PRD_MAP( template )
+!-----------------------------------------------------------------------
+! ... Form production indicies
+!-----------------------------------------------------------------------
+
+ use VAR_MOD, only : var_lim
+ use RXT_MOD, only : prd_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(inout) :: template(:,:)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: i, clsno
+
+ integer :: XLATE
+
+ template(:,:2) = 0
+
+ do i = 1,prd_lim
+ if( template(i,3) < 0 ) then
+ cycle
+ else if( template(i,3) == 0 ) then
+ exit
+ else
+ clsno = XLATE( template(i,3) )
+ template(i,2) = clsno
+ template(clsno,1) = template(clsno,1) + 1
+ end if
+ end do
+
+ end subroutine PRD_MAP
+
+ end module MO_PRD_MAP
diff --git a/chem_proc/src/cam_chempp/radj_code.f b/chem_proc/src/cam_chempp/radj_code.f
new file mode 100644
index 0000000000..bf41b4d8a4
--- /dev/null
+++ b/chem_proc/src/cam_chempp/radj_code.f
@@ -0,0 +1,254 @@
+
+ subroutine make_radj( fixmap, fixcnt, rxmap, rxmcnt, phtcnt, &
+ model, march )
+!-----------------------------------------------------------------------
+! ... Make the reaction rate "adjustment" code
+!-----------------------------------------------------------------------
+
+ use var_mod, only : var_lim
+ use rxt_mod, only : rxt_lim
+ use io, only : temp_path
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... dummy arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: phtcnt
+ integer, intent(in) :: rxmcnt
+ integer, intent(in) :: fixcnt(2)
+ integer, intent(in) :: fixmap(var_lim,3,2)
+ integer, intent(in) :: rxmap(rxt_lim)
+ character(len=*), intent(in) :: model
+ character(len=*), intent(in) :: march
+
+!-----------------------------------------------------------------------
+! ... local variables
+!-----------------------------------------------------------------------
+ integer :: j, k, l, rxno
+ character(len=128):: line
+ character(len=4) :: dec_suffix
+ logical :: first
+ logical :: divide
+ logical :: doloop
+ logical :: lexist
+
+ integer :: strlen
+
+ inquire( file = trim( temp_path ) // 'mo_adjrxt.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'mo_adjrxt.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'mo_adjrxt.F' )
+
+ if( model == 'CAM' ) then
+ dec_suffix = '(r8)'
+ else
+ dec_suffix = ' '
+ end if
+
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'module mo_adjrxt'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'private'
+ write(30,100) trim(line)
+ line(7:) = 'public :: adjrxt'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'contains'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( model == 'MOZART' ) then
+ line(7:) = 'subroutine adjrxt( rate, inv, m, plnplv )'
+ else if( trim(model) == 'CAM' ) then
+ line(7:) = 'subroutine adjrxt( rate, inv, m, ncol, nlev )'
+ else if( trim(model) == 'WRF' ) then
+ line(7:) = 'subroutine adjrxt( rate, inv, m )'
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( trim(model) == 'CAM' ) then
+ line(7:) = 'use shr_kind_mod, only : r8 => shr_kind_r8'
+ write(30,100) trim(line)
+ line(7:) = 'use chem_mods, only : nfs, rxntot'
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'implicit none '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... dummy arguments'
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ if( trim(model) == 'MOZART' ) then
+ line = ' integer, intent(in) :: plnplv'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: inv(plnplv,nfs)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: m(plnplv)'
+ write(30,100) trim(line)
+ line = ' real, intent(inout) :: rate(plnplv,rxntot)'
+ else if( trim(model) == 'CAM' ) then
+ line = ' integer, intent(in) :: ncol, nlev'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: inv(ncol,nlev,nfs)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: m(ncol,nlev)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(inout) :: rate(ncol,nlev,rxntot)'
+ else if( trim(model) == 'WRF' ) then
+ line = ' real, intent(in) :: inv(:,:)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: m(:)'
+ write(30,100) trim(line)
+ line = ' real, intent(inout) :: rate(:,:)'
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+
+ divide = .false.
+ if( any( fixmap(:fixcnt(2),1,2) < 0 ) ) then
+ divide = .true.
+ endif
+ if( .not. divide ) then
+ do k = 1,fixcnt(1)
+ if( fixmap(k,1,1) < 0 .and. abs( fixmap(k,1,1) ) > phtcnt ) then
+ divide = .true.
+ exit
+ endif
+ end do
+ endif
+
+ if( divide ) then
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... local variables'
+ write(30,100) trim(line)
+ line = '!--------------------------------------------------------------------'
+ write(30,100) trim(line)
+ if( trim(model) == 'MOZART' ) then
+ line = ' real :: im(plnplv)'
+ else if( trim(model) == 'CAM' ) then
+ line = ' real(r8) :: im(ncol,nlev)'
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ write(30,100) trim(line)
+ end if
+
+ first = .true.
+ doloop = .false.
+
+ if( divide ) then
+ if( trim(model) /= 'CAM' ) then
+ line(10:) = 'im(:) = 1. / m(:)'
+ else
+ line(7:) = 'im(:,:) = 1._r8 / m(:,:)'
+ end if
+ write(30,100) trim(line)
+ endif
+
+!---------------------------------------------------------
+! ... First check reactions with invariants for
+! potential modification
+!---------------------------------------------------------
+ do j = 1,2
+ do k = 1,fixcnt(j)
+ rxno = abs( fixmap(k,1,j) )
+ if( j == 2 .or. rxno > phtcnt ) then
+ if( first ) then
+ first = .false.
+ doloop = .true.
+ if( trim(model) == 'CAM' ) then
+ line = ' '
+ end if
+ end if
+ if( trim(model) /= 'CAM' ) then
+ line(10:) = 'rate(:,'
+ write(line(len_trim(line)+1:),'(i3)') rxno
+ line(len_trim(line)+1:) = ') = rate(:,'
+ write(line(len_trim(line)+1:),'(i3)') rxno
+ line(len_trim(line)+1:) = ')'
+ do l = 2,j+1
+ line(strlen(line)+1:) = ' * inv(:,'
+ write(line(strlen(line)+1:),'(i2)') fixmap(k,l,j)
+ line(strlen(line)+1:) = ')'
+ end do
+ else
+ line(7:) = 'rate(:,:,'
+ write(line(len_trim(line)+1:),'(i3)') rxno
+ line(len_trim(line)+1:) = ') = rate(:,:,'
+ write(line(len_trim(line)+1:),'(i3)') rxno
+ line(len_trim(line)+1:) = ')'
+ do l = 2,j+1
+ line(strlen(line)+1:) = ' * inv(:,:,'
+ write(line(strlen(line)+1:),'(i2)') fixmap(k,l,j)
+ line(strlen(line)+1:) = ')'
+ end do
+ end if
+ if( fixmap(k,1,j) < 0 ) then
+ if( trim(model) /= 'CAM' ) then
+ line(strlen(line)+1:) = ' * im(:)'
+ else
+ line(strlen(line)+1:) = ' * im(:,:)'
+ end if
+ end if
+ write(30,100) trim(line)
+ end if
+ end do
+ end do
+
+!---------------------------------------------------------
+! ... Now do all nonlinear reactions
+!---------------------------------------------------------
+ first = .true.
+ do k = 1,rxmcnt
+ rxno = rxmap(k)
+ line = ' '
+ if( model /= 'CAM' ) then
+ line(10:) = 'rate(:,'
+ write(line(len_trim(line)+1:),'(i3)') rxno
+ line(len_trim(line)+1:) = ') = rate(:,'
+ write(line(len_trim(line)+1:),'(i3)') rxno
+ line(len_trim(line)+1:) = ') * m(:)'
+ else
+ line(7:) = 'rate(:,:,'
+ write(line(len_trim(line)+1:),'(i3)') rxno
+ line(len_trim(line)+1:) = ') = rate(:,:,'
+ write(line(len_trim(line)+1:),'(i3)') rxno
+ line(len_trim(line)+1:) = ') * m(:,:)'
+ end if
+ write(30,100) trim(line)
+ end do
+
+ if( model == 'CAM' ) then
+ if ( rxmcnt > 0 .or. fixcnt(1) > 0 .or. fixcnt(2) > 0 ) then
+ endif
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'end subroutine adjrxt'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'end module mo_adjrxt'
+ write(30,100) trim(line)
+
+ close(30)
+
+100 format(a)
+
+ end subroutine make_radj
diff --git a/chem_proc/src/cam_chempp/rate_code.f b/chem_proc/src/cam_chempp/rate_code.f
new file mode 100644
index 0000000000..1a3b447160
--- /dev/null
+++ b/chem_proc/src/cam_chempp/rate_code.f
@@ -0,0 +1,845 @@
+module set_rxt_rates
+
+ use rxt_mod, only : rxntot, cph_flg
+ use io, only : temp_path
+
+ private
+ public :: make_rate
+
+contains
+
+ subroutine make_rate( sym_rates, rxptab, rxpcnt, machine, vec_ftns, &
+ model, march )
+ !-----------------------------------------------------------------------
+ ! ... write fortran "internal" reaction rates
+ !-----------------------------------------------------------------------
+
+ use rxt_mod, only : troecnt, troetab, troe_sym_rates, rxparm
+
+ implicit none
+
+ !-----------------------------------------------------------------------
+ ! ... dummy arguments
+ !-----------------------------------------------------------------------
+ integer, intent(in) :: rxpcnt
+ integer, intent(in) :: rxptab(*)
+ character(len=16), intent(in) :: sym_rates(2,*)
+ character(len=16), intent(in) :: machine
+ character(len=16), intent(in) :: march
+ character(len=16), intent(in) :: model
+ logical, intent(in) :: vec_ftns
+
+ !-----------------------------------------------------------------------
+ ! ... local variables
+ !-----------------------------------------------------------------------
+ integer :: i, cnt, indp, inde, l, m, m1, pos
+ integer :: ftn_lim
+ integer :: ftn_mode
+ integer :: cph_cnt
+ integer :: match_cnt
+ integer :: subs_lim
+ integer :: subs
+ integer :: match_ind(rxpcnt)
+ real :: rate
+ character(len=132) :: line
+ character(len=32) :: wrk, buff
+ character(len=16) :: vec_dim
+ character(len=4) :: num_suffix
+ character(len=4) :: dec_suffix
+ character(len=3) :: num
+ character(len=3) :: numa
+ logical :: lexist
+ logical :: vftns
+ logical :: do_tmp
+ logical :: do_rxt
+ logical :: t_dependent(rxpcnt)
+
+
+
+ inquire( file = trim( temp_path ) // 'mo_setrxt.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'mo_setrxt.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'mo_setrxt.F' )
+
+ vec_dim = 'plnplv'
+ if( model == 'CAM' ) then
+ num_suffix = '_r8'
+ dec_suffix = '(r8)'
+ if( march == 'VECTOR' ) then
+ vec_dim = 'chnkpnts'
+ end if
+ else
+ num_suffix = ' '
+ dec_suffix = ' '
+ end if
+
+ if( model == 'CAM' ) then
+ subs_lim = 2
+ else
+ subs_lim = 1
+ end if
+ cph_cnt = count( cph_flg(:) )
+
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'module mo_setrxt'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' use shr_kind_mod, only : r8 => shr_kind_r8'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'private'
+ write(30,100) trim(line)
+ line(7:) = 'public :: setrxt'
+ write(30,100) trim(line)
+ line(7:) = 'public :: setrxt_hrates'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'contains'
+ write(30,100) trim(line)
+ line = ' '
+ subs_loop : do subs = 1,subs_lim
+ write(30,100) trim(line)
+ if( march == 'VECTOR' ) then
+ if( subs == 1 ) then
+! line(7:) = 'subroutine setrxt( rate, temp, m, ' // trim(vec_dim) // ' )'
+ line(7:) = 'subroutine setrxt( rate, temp, m, ncol )'
+ write(30,100) trim(line)
+ write(30,100) ' '
+ line(7:) = 'use ppgrid, only : pcols, pver'
+ else
+ line(7:) = 'subroutine setrxt_hrates( rate, temp, m, ncol, kbot )'
+ write(30,100) trim(line)
+ write(30,100) ' '
+ line(7:) = 'use ppgrid, only : pcols, pver'
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ else
+ select case( model )
+ case( 'MOZART' )
+ line(7:) = 'subroutine setrxt( rate, temp, m, plonl )'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' '
+ line(7:) = 'use mo_grid, only : plev, plnplv'
+ case( 'CAM' )
+ if( subs == 1 ) then
+ line(7:) = 'subroutine setrxt( rate, temp, m, ncol )'
+ else
+ line(7:) = 'subroutine setrxt_hrates( rate, temp, m, ncol, kbot )'
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = ' '
+ line(7:) = 'use ppgrid, only : pver, pcols'
+ write(30,100) trim(line)
+ line(7:) = 'use shr_kind_mod, only : r8 => shr_kind_r8'
+ case( 'WRF' )
+ line(7:) = 'subroutine setrxt( rate, temp, m, n )'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'use mo_jpl, only : jpl'
+ end select
+ end if
+ write(30,100) trim(line)
+ if( model /= 'WRF' ) then
+ line(7:) = 'use chem_mods, only : rxntot'
+ write(30,100) trim(line)
+ line(7:) = 'use mo_jpl, only : jpl'
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'implicit none '
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line = '!-------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... dummy arguments'
+ write(30,100) trim(line)
+ line = '!-------------------------------------------------------'
+ write(30,100) trim(line)
+ if( machine == 'NEC' .or. machine == 'FUJITSU' ) then
+! if( subs == 1 ) then
+! line = ' integer, intent(in) :: ' // trim(vec_dim)
+! else
+ line = ' integer, intent(in) :: ncol'
+! endif
+ write(30,100) trim(line)
+ if( subs == 1 ) then
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: temp(pcols,pver)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: m(ncol*pver)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(inout) :: rate(ncol*pver,max(1,rxntot))'
+ else
+ line = ' integer, intent(in) :: kbot'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: temp(pcols,pver)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: m(ncol*pver)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(inout) :: rate(ncol*pver,max(1,rxntot))'
+ endif
+ else
+ select case( model )
+ case( 'MOZART' )
+ line = ' integer, intent(in) :: plonl'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: temp(plonl,plev)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: m(plonl,plev)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(inout) :: rate(plonl,plev,rxntot)'
+ case( 'CAM' )
+ line = ' integer, intent(in) :: ncol'
+ write(30,100) trim(line)
+ if( subs == 2 ) then
+ line = ' integer, intent(in) :: kbot'
+ write(30,100) trim(line)
+ end if
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: temp(pcols,pver)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: m(ncol,pver)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(inout) :: rate(ncol,pver,rxntot)'
+ case( 'WRF' )
+ line = ' integer, intent(in) :: n'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: temp(:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(in) :: m(:)'
+ write(30,100) trim(line)
+ line = ' real' // trim(dec_suffix) // ', intent(inout) :: rate(:,:)'
+ end select
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+
+ if( rxpcnt == 0 ) then
+ if( subs == 1 ) then
+ line(7:) = 'end subroutine setrxt'
+ else
+ line(7:) = 'end subroutine setrxt_hrates'
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( subs == 2 ) then
+ line(7:) = 'end module mo_setrxt'
+ write(30,100) trim(line)
+ end if
+ cnt = 0
+ cycle subs_loop
+ else
+ t_dependent(:rxpcnt) = sym_rates(2,:rxpcnt) /= ' '
+ cnt = count( t_dependent(:rxpcnt) )
+ end if
+
+
+ !-----------------------------------------------------------------------
+ ! ... check for temp dependent rates
+ !-----------------------------------------------------------------------
+ temp_dep_rxts : if( cnt /= 0 .or. troecnt /= 0 ) then
+ line = '!-------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... local variables'
+ write(30,100) trim(line)
+ line = '!-------------------------------------------------------'
+ write(30,100) trim(line)
+ line = ' '
+ if( model /= 'WRF' ) then
+ line(7:) = 'integer :: n'
+ write(30,100) trim(line)
+ if( model == 'CAM' .and. march == 'VECTOR' ) then
+ line(7:) = 'integer :: offset'
+ write(30,100) trim(line)
+ if( subs > 1 ) then
+ line(7:) = 'integer :: k'
+ write(30,100) trim(line)
+ endif
+ endif
+ end if
+ if( machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ if( subs == 1 ) then
+ line(7:) = 'real' // trim(dec_suffix) // ' :: itemp(ncol*pver)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: exp_fac(ncol*pver)'
+ else
+ line(7:) = 'real' // trim(dec_suffix) // ' :: itemp(ncol*kbot)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: exp_fac(ncol*kbot)'
+ endif
+ else
+ select case( model )
+ case( 'MOZART' )
+ line(7:) = 'real' // trim(dec_suffix) // ' :: itemp(plonl,plev)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: exp_fac(plonl,plev)'
+ case( 'CAM' )
+ if( subs == 1 ) then
+ line(7:) = 'real' // trim(dec_suffix) // ' :: itemp(ncol,pver)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: exp_fac(ncol,pver)'
+ else
+ line(7:) = 'real' // trim(dec_suffix) // ' :: itemp(ncol,kbot)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: exp_fac(ncol,kbot)'
+ end if
+ case( 'WRF' )
+ line(7:) = 'real' // trim(dec_suffix) // ' :: itemp(n)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: exp_fac(n)'
+ end select
+ end if
+ write(30,100) trim(line)
+ end if temp_dep_rxts
+ troe_rxts : if( troecnt /= 0 ) then
+ if( machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ if( subs == 1 ) then
+ line(7:) = 'real' // trim(dec_suffix) // ' :: ko(ncol*pver)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: kinf(ncol*pver)'
+ if( subs > 1 ) then
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: wrk(ncol*pver)'
+ endif
+ else
+ line(7:) = 'real' // trim(dec_suffix) // ' :: ko(ncol*kbot)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: kinf(ncol*kbot)'
+ if( subs > 1 ) then
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: wrk(ncol*kbot)'
+ endif
+ endif
+ else
+ select case( model )
+ case( 'MOZART' )
+ line(7:) = 'real' // trim(dec_suffix) // ' :: ko(plonl,plev)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: kinf(plonl,plev)'
+ case( 'CAM' )
+ if( subs == 1 ) then
+ line(7:) = 'real' // trim(dec_suffix) // ' :: ko(ncol,pver)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: kinf(ncol,pver)'
+ else
+ line(7:) = 'real' // trim(dec_suffix) // ' :: ko(ncol,kbot)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: kinf(ncol,kbot)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: wrk(ncol,kbot)'
+ end if
+ case( 'WRF' )
+ line(7:) = 'real' // trim(dec_suffix) // ' :: ko(n)'
+ write(30,100) trim(line)
+ line(7:) = 'real' // trim(dec_suffix) // ' :: kinf(n)'
+ end select
+ end if
+ write(30,100) trim(line)
+ end if troe_rxts
+
+ if( model == 'CAM' .and. march == 'VECTOR' .and. subs > 1 ) then
+ write(30,100) ' '
+ line(7:) = 'n = ncol*kbot'
+ write(30,100) trim(line)
+ endif
+ line = ' '
+ write(30,100) trim(line)
+
+ !-----------------------------------------------------------------------
+ ! ... first do all temperature independent rates
+ !-----------------------------------------------------------------------
+ const_rxts : if( rxpcnt > 0 .and. cnt /= rxpcnt ) then
+ line = ' '
+ do i = 1,rxpcnt
+ if( sym_rates(2,i) == ' ' ) then
+ if( subs == 2 ) then
+ if( .not. cph_flg(rxptab(i)) ) then
+ cycle
+ end if
+ end if
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ if( subs == 1 ) then
+ line(7:) = 'rate(:,'
+ else
+ line(7:) = 'rate(:n,'
+ endif
+ else
+ if( subs == 1 ) then
+ line(7:) = 'rate(:,:,'
+ else
+ line(7:) = 'rate(:,:kbot,'
+ end if
+ end if
+ write(num,'(i3)') rxptab(i)
+ num = adjustl( num )
+ l = len_trim( sym_rates(1,i) )
+ wrk = sym_rates(1,i)(:l)
+ indp = scan( wrk(:l), '.' )
+ inde = scan( wrk(:l), 'eE' )
+ if( indp == 0 .and. inde == 0 ) then
+ l = l + 1
+ wrk(l:l) = '.'
+ end if
+ line(len_trim(line)+1:) = num(:len_trim(num)) // ') = ' // wrk(:l) // trim(num_suffix)
+ write(30,100) trim(line)
+ end if
+ end do
+ end if const_rxts
+
+ !-----------------------------------------------------------------------
+ ! ... now do temp dependent rxts
+ !-----------------------------------------------------------------------
+ do_tmp = cnt /= 0 .and. (subs == 1 .or. cph_cnt > 0)
+ any_temp_dep : if( do_tmp ) then
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ if( subs == 1 ) then
+ write(30,100) ' '
+ line(7:) = 'do n = 1,pver'
+ write(30,100) trim(line)
+ line(7:) = ' offset = (n-1)*ncol'
+ write(30,100) trim(line)
+ line(7:) = ' itemp(offset+1:offset+ncol) = 1.' // trim(num_suffix)// ' / temp(:ncol,n)'
+ write(30,100) trim(line)
+ line(7:) = 'end do'
+ else
+! line(7:) = 'itemp(:) = 1.' // trim(num_suffix)// ' / temp(:n)'
+ write(30,100) ' '
+ line(7:) = 'do k = 1,kbot'
+ write(30,100) trim(line)
+ line(7:) = ' offset = (k-1)*ncol'
+ write(30,100) trim(line)
+ line(7:) = ' itemp(offset+1:offset+ncol) = 1.' // trim(num_suffix)// ' / temp(:ncol,k)'
+ write(30,100) trim(line)
+ line(7:) = 'end do'
+ endif
+ else if( model == 'MOZART' ) then
+ line(7:) = 'itemp(:,:) = 1.' // trim(num_suffix)// ' / temp(:,:)'
+ else if( model == 'CAM' ) then
+ if( subs == 1 ) then
+ line(7:) = 'itemp(:ncol,:) = 1.' // trim(num_suffix)// ' / temp(:ncol,:)'
+ else
+ line(7:) = 'itemp(:ncol,:kbot) = 1.' // trim(num_suffix)// ' / temp(:ncol,:kbot)'
+ end if
+ end if
+ write(30,100) trim(line)
+ if( vec_ftns ) then
+ if( model == 'MOZART' ) then
+ line(7:) = 'n = plonl*plev'
+ else if( model == 'CAM' ) then
+ if( march /= 'VECTOR' ) then
+ if( subs == 1 ) then
+ line(7:) = 'n = ncol*pver'
+ else
+ line(7:) = 'n = ncol*kbot'
+ end if
+ else
+ line(7:) = 'n = ' // trim(vec_dim)
+ end if
+ end if
+ write(30,100) trim(line)
+ else if( model == 'CAM' ) then
+ if( march /= 'VECTOR' ) then
+ if( subs == 1 ) then
+ line(7:) = 'n = ncol*pver'
+ else
+ line(7:) = 'n = ncol*kbot'
+ end if
+ else
+! line(7:) = 'n = ' // trim(vec_dim)
+ line(7:) = ' '
+ end if
+ write(30,100) trim(line)
+ end if
+ line = ' '
+ if( model == 'CAM' .and. machine == 'IBM' ) then
+ ftn_lim = 2
+ else
+ ftn_lim = 1
+ end if
+ ftn_mode_loop : do ftn_mode = 1,ftn_lim
+ if( model == 'CAM' .and. machine == 'IBM' ) then
+ vftns = ftn_mode == 2
+ if( ftn_mode == 1 ) then
+ ! line = '#ifndef AIX'
+ line = '#if ( !defined AIX || defined NO_VEXP )'
+ else if( ftn_mode == 2 ) then
+ line = '#else'
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ else
+ vftns = vec_ftns
+ end if
+ if( ftn_mode == 2 ) then
+ t_dependent(:rxpcnt) = sym_rates(2,:rxpcnt) /= ' '
+ end if
+ rxt_loop : do i = 1,rxpcnt
+ do_rxt = t_dependent(i)
+ if( subs == 2 ) then
+ if( do_rxt ) then
+ do_rxt = cph_flg(rxptab(i))
+ end if
+ end if
+ is_temp_dep : if( do_rxt ) then
+ match_cnt = 0
+ do m = i,rxpcnt
+ if( rxparm(2,i) == rxparm(2,m) ) then
+ if( subs == 1 ) then
+ match_cnt = match_cnt + 1
+ match_ind(match_cnt) = m
+ t_dependent(m) = .false.
+ else if( cph_flg(rxptab(m)) ) then
+ match_cnt = match_cnt + 1
+ match_ind(match_cnt) = m
+ t_dependent(m) = .false.
+ end if
+ end if
+ end do
+ multiple_matches : if( match_cnt > 1 ) then
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ line(7:) = 'exp_fac(:) = '
+ else if( .not. vftns ) then
+ line(7:) = 'exp_fac(:,:) = '
+ end if
+ l = len_trim( sym_rates(2,i) )
+ wrk = sym_rates(2,i)(:l)
+ indp = scan( wrk(:l), '.' )
+ inde = scan( wrk(:l), 'eE' )
+ if( indp == 0 .and. inde == 0 ) then
+ l = l + 1
+ wrk(l:l) = '.'
+ end if
+ pos = len_trim( line )
+ if( .not. vftns ) then
+ line(pos+1:) = ' exp( ' // wrk(:l) // trim(num_suffix)
+ else
+ line(7:) = 'call vexp( exp_fac, ' // wrk(:l) // trim(num_suffix)
+ end if
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ line(len_trim(line)+1:) = ' * itemp(:) )'
+ else if( .not. vftns ) then
+ line(len_trim(line)+1:) = ' * itemp(:,:) )'
+ else if( vftns ) then
+ line(len_trim(line)+1:) = ' * itemp, n )'
+ end if
+ write(30,100) trim(line)
+ do m = 1,match_cnt
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ if( subs == 1 ) then
+ line(7:) = 'rate(:,'
+ else
+ line(7:) = 'rate(:n,'
+ endif
+ else
+ if( subs == 1 ) then
+ line(7:) = 'rate(:,:,'
+ else
+ line(7:) = 'rate(:,:kbot,'
+ end if
+ end if
+ m1 = match_ind(m)
+ write(num,'(i3)') rxptab(m1)
+ num = adjustl( num )
+ l = len_trim( sym_rates(1,m1) )
+ wrk = sym_rates(1,m1)(:l)
+ indp = scan( wrk(:l), '.' )
+ inde = scan( wrk(:l), 'eE' )
+ if( indp == 0 .and. inde == 0 ) then
+ l = l + 1
+ wrk(l:l) = '.'
+ end if
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ line(len_trim(line)+1:) = num(:len_trim(num)) // ') = ' // wrk(:l) // &
+ trim(num_suffix) // ' * exp_fac(:)'
+ else
+ line(len_trim(line)+1:) = num(:len_trim(num)) // ') = ' // wrk(:l) // &
+ trim(num_suffix) // ' * exp_fac(:,:)'
+ end if
+ write(30,100) trim(line)
+ end do
+ else multiple_matches
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ if( subs == 1 ) then
+ line(7:) = 'rate(:,'
+ else
+ line(7:) = 'rate(:n,'
+ endif
+ else if( .not. vftns ) then
+ if( subs == 1 ) then
+ line(7:) = 'rate(:,:,'
+ else
+ line(7:) = 'rate(:,:kbot,'
+ end if
+ end if
+ write(num,'(i3)') rxptab(i)
+ num = adjustl( num )
+ l = len_trim( sym_rates(1,i) )
+ wrk = sym_rates(1,i)(:l)
+ indp = scan( wrk(:l), '.' )
+ inde = scan( wrk(:l), 'eE' )
+ if( indp == 0 .and. inde == 0 ) then
+ l = l + 1
+ wrk(l:l) = '.'
+ end if
+ if( .not. vftns ) then
+ line(len_trim(line)+1:) = num(:len_trim(num)) // ') = ' // wrk(:l) // trim(num_suffix)
+ else
+ buff = wrk
+ end if
+ l = len_trim( sym_rates(2,i) )
+ wrk = sym_rates(2,i)(:l)
+ indp = scan( wrk(:l), '.' )
+ inde = scan( wrk(:l), 'eE' )
+ if( indp == 0 .and. inde == 0 ) then
+ l = l + 1
+ wrk(l:l) = '.'
+ end if
+ if( vftns ) then
+ line(7:) = 'call vexp( exp_fac, ' // wrk(:l) // trim(num_suffix) // '*itemp, n )'
+ write(30,100) trim(line)
+ if( subs == 1 ) then
+ line(7:) = 'rate(:,:,' // trim(num) // ') = ' // trim(buff) // trim(num_suffix) // ' * exp_fac(:,:)'
+ else
+ line(7:) = 'rate(:,:kbot,' // trim(num) // ') = ' // trim(buff) // trim(num_suffix) // ' * exp_fac(:,:)'
+ end if
+ end if
+ if( .not. vftns ) then
+ pos = len_trim( line )
+ line(pos+1:) = ' * exp( ' // wrk(:l) // trim(num_suffix)
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ line(len_trim(line)+1:) = ' * itemp(:) )'
+ else
+ line(len_trim(line)+1:) = ' * itemp(:,:) )'
+ end if
+ end if
+ write(30,100) trim(line)
+ end if multiple_matches
+ end if is_temp_dep
+ end do rxt_loop
+ if( model == 'CAM' .and. machine == 'IBM' .and. ftn_mode == 2 ) then
+ line = '#endif'
+ write(30,100) trim(line)
+ line = ' '
+ end if
+ end do ftn_mode_loop
+ end if any_temp_dep
+
+ !-----------------------------------------------------------------------
+ ! ... troe rates
+ !-----------------------------------------------------------------------
+ do_tmp = troecnt /= 0 .and. (subs == 1 .or. cph_cnt > 0)
+ any_troe_rxts : if( do_tmp ) then
+ line = ' '
+ write(30,100) trim(line)
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ line(7:) = 'itemp(:) = 300.' // trim(num_suffix) // ' * itemp(:)'
+ else
+ line(7:) = 'itemp(:,:) = 300.' // trim(num_suffix) // ' * itemp(:,:)'
+ end if
+ if( subs == 1 .and. model == 'CAM' .and. march == 'VECTOR' ) then
+ write(30,100) trim(line)
+ write(30,100) ' '
+ line(7:) = 'n = ncol*pver'
+ endif
+ write(30,100) trim(line)
+ troe_rxt_loop : do i = 1,troecnt
+ if( subs == 2 ) then
+ m1 = troetab(i)
+ do_rxt = cph_flg(m1)
+ else
+ do_rxt = .true.
+ end if
+ line = ' '
+ write(30,100) trim(line)
+ do_troe_rate : if( do_rxt ) then
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ line(7:) = 'ko(:)'
+ else
+ line(7:) = 'ko(:,:)'
+ end if
+ l = len_trim( troe_sym_rates(1,i) )
+ wrk = troe_sym_rates(1,i)(:l)
+ indp = scan( wrk(:l), '.' )
+ inde = scan( wrk(:l), 'eE' )
+ if( indp == 0 .and. inde == 0 ) then
+ l = l + 1
+ wrk(l:l) = '.'
+ end if
+ line(len_trim(line)+1:) = ' = ' // wrk(:l) // trim(num_suffix)
+ if( troe_sym_rates(2,i) /= ' ' ) then
+ l = len_trim( troe_sym_rates(2,i) )
+ read(troe_sym_rates(2,i)(:l),*) rate
+ wrk = troe_sym_rates(2,i)(:l)
+ indp = scan( wrk(:l), '.' )
+ inde = scan( wrk(:l), 'eE' )
+ if( indp == 0 .and. inde == 0 ) then
+ l = l + 1
+ wrk(l:l) = '.'
+ end if
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ if( rate /= 0. ) then
+ if ( rate < 0. ) then
+ line(len_trim(line)+1:) = ' * itemp(:)**(' // wrk(:l) // trim(num_suffix)//')'
+ else
+ line(len_trim(line)+1:) = ' * itemp(:)**' // wrk(:l) // trim(num_suffix)
+ endif
+ end if
+ else
+ if( rate /= 0. ) then
+ if ( rate < 0. ) then
+ line(len_trim(line)+1:) = ' * itemp(:,:)**(' // wrk(:l) // trim(num_suffix)//')'
+ else
+ line(len_trim(line)+1:) = ' * itemp(:,:)**' // wrk(:l) // trim(num_suffix)
+ endif
+ end if
+ end if
+ end if
+ write(30,100) trim(line)
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ line(7:) = 'kinf(:)'
+ else
+ line(7:) = 'kinf(:,:)'
+ end if
+ l = len_trim( troe_sym_rates(3,i) )
+ wrk = troe_sym_rates(3,i)(:l)
+ indp = scan( wrk(:l), '.' )
+ inde = scan( wrk(:l), 'eE' )
+ if( indp == 0 .and. inde == 0 ) then
+ l = l + 1
+ wrk(l:l) = '.'
+ end if
+ line(len_trim(line)+1:) = ' = ' // wrk(:l) // trim(num_suffix)
+ if( troe_sym_rates(4,i) /= ' ' ) then
+ l = len_trim( troe_sym_rates(4,i) )
+ read(troe_sym_rates(4,i)(:l),*) rate
+ wrk = troe_sym_rates(4,i)(:l)
+ indp = scan( wrk(:l), '.' )
+ inde = scan( wrk(:l), 'eE' )
+ if( indp == 0 .and. inde == 0 ) then
+ l = l + 1
+ wrk(l:l) = '.'
+ end if
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ if( rate /= 0. ) then
+ if( rate /= 1. ) then
+ if ( rate < 0. ) then
+ line(len_trim(line)+1:) = ' * itemp(:)**(' // wrk(:l) // trim(num_suffix)//')'
+ else
+ line(len_trim(line)+1:) = ' * itemp(:)**' // wrk(:l) // trim(num_suffix)
+ endif
+ else
+ line(len_trim(line)+1:) = ' * itemp(:)'
+ end if
+ end if
+ else
+ if( rate /= 0. ) then
+ if( rate /= 1. ) then
+ if ( rate < 0. ) then
+ line(len_trim(line)+1:) = ' * itemp(:,:)**(' // wrk(:l) // trim(num_suffix)//')'
+ else
+ line(len_trim(line)+1:) = ' * itemp(:,:)**' // wrk(:l) // trim(num_suffix)
+ endif
+ else
+ line(len_trim(line)+1:) = ' * itemp(:,:)'
+ end if
+ end if
+ end if
+ end if
+ write(30,100) trim(line)
+ if( model == 'WRF' .or. machine == 'NEC' .or. machine == 'FUJITSU' ) then
+ if( march /= 'VECTOR' ) then
+ line(7:) = 'call jpl( rate(1,'
+ else
+ if( subs == 1 ) then
+ line(7:) = 'call jpl( rate(:,'
+ else
+ line(7:) = 'call jpl( wrk'
+ endif
+ end if
+ else
+ if( subs == 1 ) then
+ line(7:) = 'call jpl( rate(1,1,'
+ else
+ line(7:) = 'call jpl( wrk'
+ end if
+ end if
+ write(numa,'(i3)') troetab(i)
+ if( subs == 1 ) then
+ num = numa
+ else
+ num = ' '
+ end if
+ num = adjustl( num )
+ l = len_trim( troe_sym_rates(5,i) )
+ wrk = troe_sym_rates(5,i)(:l)
+ indp = scan( wrk(:l), '.' )
+ inde = scan( wrk(:l), 'eE' )
+ if( indp == 0 .and. inde == 0 ) then
+ l = l + 1
+ wrk(l:l) = '.'
+ end if
+ select case( model )
+ case( 'MOZART' )
+ line(len_trim(line)+1:) = num(:len_trim(num)) // '), m, ' // wrk(:l) // &
+ trim(num_suffix) // ', ko, kinf, plnplv )'
+ case( 'CAM' )
+ if( subs == 1 ) then
+ line(len_trim(line)+1:) = num(:len_trim(num)) // '), m, ' // wrk(:l) // &
+ trim(num_suffix) // ', ko, kinf, n )'
+ else
+ line(len_trim(line)+1:) = num(:len_trim(num)) // ', m, ' // wrk(:l) // &
+ trim(num_suffix) // ', ko, kinf, n )'
+ write(30,100) trim(line)
+ if( march /= 'VECTOR' ) then
+ line = ' rate(:,:kbot,' // numa(:len_trim(numa)) // ') = wrk(:,:)'
+ else
+! line = ' rate(:,:kbot,' // numa(:len_trim(numa)) // ') = wrk(:)'
+ line = ' rate(:n,' // numa(:len_trim(numa)) // ') = wrk(:)'
+ endif
+ end if
+ case( 'WRF' )
+ line(len_trim(line)+1:) = num(:len_trim(num)) // '), m, ' // wrk(:l) // &
+ trim(num_suffix) // ', ko, kinf, n )'
+ end select
+ write(30,100) trim(line)
+ end if do_troe_rate
+ end do troe_rxt_loop
+ end if any_troe_rxts
+
+ line = ' '
+ write(30,100) trim(line)
+ if( subs == 1 ) then
+ line(7:) = 'end subroutine setrxt'
+ else
+ line(7:) = 'end subroutine setrxt_hrates'
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ if( subs == 2 ) then
+ line(7:) = 'end module mo_setrxt'
+ write(30,100) trim(line)
+ end if
+ end do subs_loop
+
+ close(30)
+
+100 format(a)
+
+ end subroutine make_rate
+
+end module set_rxt_rates
diff --git a/chem_proc/src/cam_chempp/rate_tab.f b/chem_proc/src/cam_chempp/rate_tab.f
new file mode 100644
index 0000000000..38f05c07fc
--- /dev/null
+++ b/chem_proc/src/cam_chempp/rate_tab.f
@@ -0,0 +1,232 @@
+
+ subroutine MAKE_RATE_TAB( rxparm, &
+ rxptab, &
+ rxpcnt )
+!-----------------------------------------------------------------------
+! ... Make the code to setup the rate table
+!-----------------------------------------------------------------------
+
+ use IO, only : temp_path
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: rxpcnt
+ integer, intent(in) :: rxptab(*)
+
+ real, intent(in) :: rxparm(2,*)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: i, j, k, cnt, pos
+ character(len=72) :: line
+ logical :: lexist
+
+ if( rxpcnt == 0 ) then
+ return
+ else
+!-----------------------------------------------------------------------
+! ... Check for temp dependent rates
+!-----------------------------------------------------------------------
+ cnt = COUNT( rxparm(2,1:rxpcnt) /= 0. )
+ if( cnt == 0 ) then
+ return
+ end if
+ end if
+
+!-----------------------------------------------------------------------
+! ... First write the table setup routine
+!-----------------------------------------------------------------------
+ INQUIRE( file = TRIM( temp_path ) // 'rxttab.F', exist = lexist )
+ if( lexist ) then
+ call SYSTEM( 'rm ' // TRIM( temp_path ) // 'rxttab.F' )
+ end if
+ OPEN( unit = 30, file = TRIM( temp_path ) // 'rxttab.F' )
+
+ line = ' '
+ write(30,100) line
+ line(7:) = 'subroutine RXTTAB( )'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'implicit none '
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'real rates'
+ write(30,100) line
+ line(7:) = 'common / RXTTAB / rates(126,'
+ write(line(LEN_TRIM(line)+1:),'(i3,'')'')') cnt
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'real temp(126)'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'integer j'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line = '# if defined(EXPHF)'
+ write(30,100) line
+ line = ' '
+ line(7:) = 'real EXPHF'
+ write(30,100) line
+ line = 'CDIR$ VFUNCTION EXPHF'
+ write(30,100) line
+ line = '# endif'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+
+ line(7:) = 'do j = 1,126'
+ write(30,100) line
+ line = ' '
+ line(10:) = 'temp(j) = 1. / (180. + REAL(j-1))'
+ write(30,100) line
+ line = ' '
+ line(7:) = 'end do'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'do j = 1,126'
+ write(30,100) line
+ line = ' '
+ line(10:) = 'rates(j, ) ='
+ k = 0
+ do i = 1,rxpcnt
+ if( rxparm(2,i) /= 0.e0 ) then
+ k = k + 1
+ write(line(18:20),'(i3)') k
+ call R2C( line(25:), rxparm(1,i), 'l' )
+ pos = LEN_TRIM(line)
+ write(30,*) '# if defined(EXPHF)'
+ line(pos+1:) = '*EXPHF('
+ call R2C( line(LEN_TRIM(line)+1:), rxparm(2,i), 'l' )
+ line(LEN_TRIM(line)+1:) = ' * temp(j) )'
+ write(30,100) line
+ write(30,*) '# else'
+ line(pos+1:) = '*EXP('
+ call R2C( line(LEN_TRIM(line)+1:), rxparm(2,i), 'l' )
+ line(LEN_TRIM(line)+1:) = ' * temp(j) )'
+ write(30,100) line
+ write(30,*) '# endif'
+ end if
+ end do
+
+ line = ' '
+ line(7:) = 'end do'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'end'
+ write(30,100) line
+
+ CLOSE(30)
+!-----------------------------------------------------------------------
+! ... Finally write the table interpolation routine
+!-----------------------------------------------------------------------
+ INQUIRE( file = 'setrxt.F', exist = lexist )
+ if( lexist ) then
+ call SYSTEM( 'rm setrxt.F' )
+ end if
+ OPEN( unit = 30, file = 'setrxt.F' )
+
+ line = ' '
+ write(30,100) line
+ line(7:) = 'subroutine SETRXT( rate,'
+ write(30,100) line
+ line(6:) = '$ temp )'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'implicit none '
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'real rate(PLNPLV,RXNCNT)'
+ write(30,100) line
+ line(7:) = 'real temp(PLNPLV)'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'real rates'
+ write(30,100) line
+ line(7:) = 'common / RXTTAB / rates(126,'
+ write(line(LEN_TRIM(line)+1:),'(i3,'')'')') cnt
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'integer i, ip1, j'
+ write(30,100) line
+ line(7:) = 'real del_temp'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'do j = 1,PLNPLV'
+ write(30,100) line
+
+ if( cnt /= rxpcnt ) then
+ line = ' '
+ line(10:) = 'rate(j, ) ='
+ do i = 1,rxpcnt
+ if( rxparm(2,i) == 0.e0 ) then
+ write(line(17:19),'(i3)') rxptab(i)
+ call R2C( line(24:), rxparm(1,i), 'l' )
+ write(30,100) line
+ end if
+ end do
+ end if
+ line = ' '
+ line(7:) = 'end do'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'do j = 1,PLNPLV'
+ write(30,100) line
+ line = ' '
+ line(10:) = 'i = INT( temp(j) ) - 179'
+ write(30,100) line
+ line(10:) = 'i = MAX( 1,MIN( 125,i) )'
+ write(30,100) line
+ line(10:) = 'ip1 = i + 1'
+ write(30,100) line
+ line(10:) = 'del_temp = temp(j) - AINT(temp(j))'
+ write(30,100) line
+ line = ' '
+ k = 0
+ do i = 1,rxpcnt
+ if( rxparm(2,i) /= 0.e0 ) then
+ line = ' '
+ line(10:) = 'rate(j,'
+ k = k + 1
+ write(line(LEN_TRIM(line)+1:),'(i3,'') ='')') rxptab(i)
+ line(LEN_TRIM(line)+2:) = 'rates(i,'
+ write(line(LEN_TRIM(line)+1:),'(i3,'')'')') k
+ write(30,100) line
+ j = INDEX( line,'=' ) + 2
+ line(6:) = '$'
+ line(j:) = '+ del_temp * (rates(ip1,'
+ write(line(LEN_TRIM(line)+1:),'(i3,'')'')') k
+ line(LEN_TRIM(line)+2:) = '- rates(i,'
+ write(line(LEN_TRIM(line)+1:),'(i3,''))'')') k
+ write(30,100) line
+ end if
+ end do
+
+ line = ' '
+ line(7:) = 'end do'
+ write(30,100) line
+ line = ' '
+ write(30,100) line
+ line(7:) = 'end'
+ write(30,100) line
+ CLOSE(30)
+
+100 format(a72)
+
+ end subroutine MAKE_RATE_TAB
diff --git a/chem_proc/src/cam_chempp/res_hdr.f b/chem_proc/src/cam_chempp/res_hdr.f
new file mode 100644
index 0000000000..feaa813ee4
--- /dev/null
+++ b/chem_proc/src/cam_chempp/res_hdr.f
@@ -0,0 +1,59 @@
+
+ subroutine RES_HDR( plon, &
+ plonl, &
+ plat, &
+ plev, &
+ jintmx, &
+ nxpt, &
+ arch_type, &
+ cpucnt )
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... The arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: plon
+ integer, intent(in) :: plonl
+ integer, intent(in) :: plat
+ integer, intent(in) :: plev
+ integer, intent(in) :: jintmx
+ integer, intent(in) :: nxpt
+ integer, intent(in) :: cpucnt
+ character(len=16), intent(in) :: arch_type
+
+!-----------------------------------------------------------------------
+! ... The local variables
+!-----------------------------------------------------------------------
+ character(len=72) :: comment
+ logical :: lexist
+
+ INQUIRE( file = 'res.h', exist = lexist )
+ if( lexist ) then
+ call SYSTEM( 'rm res.h' )
+ end if
+ OPEN( unit = 30, file = 'res.h' )
+
+ write(30,'(''# define PLON '',i3)') plon
+ write(30,'(''# define PLONP2 '',i3)') plon + 2
+ if( arch_type == 'HYBRID' ) then
+ write(30,'(''# define PLONL '',i3)') plonl
+ end if
+ write(30,'(''# define NXPT '',i3)') nxpt
+ write(30,'(''# define JINTMX '',i3)') jintmx
+ write(30,'(''# define NXPTJ '',i3)') nxpt + jintmx
+ write(30,'(''# define PLOND '',i3)') plon + 1 + 2*nxpt
+ write(30,'(''# define PLAT '',i3)') plat
+ write(30,'(''# define PLEV '',i3)') plev
+ write(30,'(''# define PLEVP '',i3)') plev + 1
+ write(30,'(''# define PLEVM '',i3)') plev - 1
+ write(30,'(''# define PLNPLV '',i6)') plon*plev
+ write(30,'(''# define I1 '',i3)') 1 + nxpt
+ write(30,'(''# define I1M '',i3)') nxpt
+ write(30,'(''# define J1 '',i3)') 1 + nxpt + jintmx
+ write(30,'(''# define J1M '',i3)') nxpt + jintmx
+ write(30,'(''# define PTIML 2 '')')
+
+ CLOSE(30)
+
+ end subroutine RES_HDR
diff --git a/chem_proc/src/cam_chempp/rmod_code.f b/chem_proc/src/cam_chempp/rmod_code.f
new file mode 100644
index 0000000000..fd09352da7
--- /dev/null
+++ b/chem_proc/src/cam_chempp/rmod_code.f
@@ -0,0 +1,193 @@
+
+ subroutine make_rmod( rxt2rel_pntr, rel_rxt_map, rxt2grp_pntr, &
+ grp_rxt_map, hetmap, hetcnt, rxntot, model, march )
+!-----------------------------------------------------------------------
+! ... Make the group ratios reaction rate adjustment code
+!-----------------------------------------------------------------------
+
+ use rxt_mod, only : rxt_lim
+ use io, only : temp_path
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: rxt2rel_pntr(rxt_lim,2)
+ integer, intent(in) :: rel_rxt_map(rxt_lim,3,2)
+ integer, intent(in) :: rxt2grp_pntr(rxt_lim,2)
+ integer, intent(in) :: grp_rxt_map(rxt_lim,3,2)
+ integer, intent(in) :: hetmap(rxt_lim)
+ integer, intent(in) :: rxntot
+ integer, intent(in) :: hetcnt
+ character(len=*), intent(in) :: model
+ character(len=*), intent(in) :: march
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: max_len = 90
+ integer :: k, l, rxno, row, index
+ character(len=max_len) :: line
+ logical :: first
+ logical :: found
+ logical :: lexist
+
+ integer :: strlen
+
+ inquire( file = trim( temp_path ) // 'mo_rxtmod.F', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'mo_rxt_mod.F' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'mo_rxt_mod.F' )
+
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'module mo_rxt_mod'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'private'
+ write(30,100) trim(line)
+ line(7:) = 'public :: rxt_mod'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'contains'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ select case( model )
+ case( 'MOZART' )
+ line(7:) = 'subroutine rxt_mod( rate, het_rates, grp_ratios, plnplv )'
+ case( 'CAM' )
+ line(7:) = 'subroutine rxt_mod( rate, het_rates, grp_ratios, chnkpnts )'
+ case( 'WRF' )
+ line(7:) = 'subroutine rxt_mod( rate, grp_ratios )'
+ end select
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim( line )
+ if( model /= 'WRF' ) then
+ line(7:) = 'use chem_mods, only : rxntot, hetcnt, grpcnt'
+ write(30,100) trim( line )
+ end if
+ if( model == 'CAM' ) then
+ line(7:) = 'use shr_kind_mod, only : r8 => shr_kind_r8'
+ write(30,100) trim( line )
+ end if
+ line = ' '
+ write(30,100) trim( line )
+ line(7:) = 'implicit none '
+ write(30,100) trim( line )
+ line = ' '
+ write(30,100) trim( line )
+ line = '!---------------------------------------------------------------------------'
+ write(30,100) trim(line)
+ line = '! ... dummy arguments'
+ write(30,100) trim(line)
+ line = '!---------------------------------------------------------------------------'
+ write(30,100) trim(line)
+ if( model == 'CAM' .and. march == 'VECTOR' ) then
+ line = ' integer, intent(in) :: chnkpnts'
+ write(30,100) trim(line)
+ else if( model /= 'WRF' ) then
+ line = ' integer, intent(in) :: plnplv'
+ write(30,100) trim(line)
+ end if
+ if( model == 'MOZART' ) then
+ line = ' real, intent(inout) :: rate(plnplv,rxntot)'
+ write(30,100) trim(line)
+ line = ' real, intent(inout) :: het_rates(plnplv,hetcnt)'
+ write(30,100) trim(line)
+ line = ' real, intent(in) :: grp_ratios(plnplv,grpcnt)'
+ else if( model == 'CAM' ) then
+ if( march /= 'VECTOR' ) then
+ line = ' real(r8), intent(inout) :: rate(:,:)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(inout) :: het_rates(:,:)'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: grp_ratios(:,:)'
+ else
+ line = ' real(r8), intent(inout) :: rate(chnkpnts,max(1,rxntot))'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(inout) :: het_rates(chnkpnts,max(1,hetcnt))'
+ write(30,100) trim(line)
+ line = ' real(r8), intent(in) :: grp_ratios(chnkpnts,max(1,grpcnt))'
+ end if
+ else if( model == 'WRF' ) then
+ line = ' real, intent(in) :: grp_ratios(:,:)'
+ write(30,100) trim(line)
+ line = ' real, intent(inout) :: rate(:,:)'
+ end if
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+
+ first = .true.
+ do k = 1,rxntot
+!-----------------------------------------------------------------------
+! ... Scan the group map
+!-----------------------------------------------------------------------
+ found = .false.
+ index = rxt2grp_pntr(k,1)
+ row = rxt2grp_pntr(k,2)
+ do l = 1,index
+ found = .true.
+ if( first ) then
+ line = ' '
+ first = .false.
+ end if
+ rxno = grp_rxt_map(row,1,index)
+ if( l == 1 ) then
+ line = ' '
+ line(7:) = 'rate(:, ) = rate(:, )'
+ write(line(14:16),'(i3)') rxno
+ write(line(28:30),'(i3)') rxno
+ line(strlen(line)+2:) = ' * grp_ratios(:,'
+ write(line(strlen(line)+1:),'(i2)') grp_rxt_map(row,l+1,index)
+ line(strlen(line)+1:) = ')'
+ else
+ line(len_trim(line)+1:) = ' &'
+ write(30,100) trim(line)
+ line(6:) = ' '
+ line(33:) = ' * grp_ratios(:,'
+ write(line(strlen(line)+1:),'(i2)') grp_rxt_map(row,l+1,index)
+ line(strlen(line)+1:) = ')'
+ end if
+ end do
+ if( found ) then
+ write(30,100) trim(line)
+ end if
+ end do
+
+ do k = 1,hetcnt
+ if( hetmap(k) /= 0 ) then
+ line = ' '
+ if( first ) then
+ first = .false.
+ end if
+ line(7:) = ' het_rates(j, ) = het_rates(j, )'
+ write(line(19:21),'(i3)') k
+ write(line(38:40),'(i3)') k
+ line(strlen(line)+2:) = ' * grp_ratios(:,'
+ write(line(strlen(line)+1:),'(i2)') hetmap(k)
+ line(strlen(line)+1:) = ')'
+ write(30,100) trim(line)
+ end if
+ end do
+
+ line = ' '
+ write(30,100) trim(line)
+ line = ' end subroutine rxt_mod'
+ write(30,100) trim(line)
+ line = ' '
+ write(30,100) trim(line)
+ line(7:) = 'end module mo_rxt_mod'
+ write(30,100) trim(line)
+
+ close(30)
+
+100 format(a)
+
+ end subroutine make_rmod
diff --git a/chem_proc/src/cam_chempp/rxt_equations.f b/chem_proc/src/cam_chempp/rxt_equations.f
new file mode 100644
index 0000000000..a90fe4b833
--- /dev/null
+++ b/chem_proc/src/cam_chempp/rxt_equations.f
@@ -0,0 +1,284 @@
+module rxt_equations_mod
+ use VAR_MOD, only : var_lim
+ use RXT_MOD, only : rxt_lim, prd_lim, prd_limp1
+ use utils, only: get_index
+
+ implicit none
+
+ private
+
+ public :: write_rxt_out_code
+
+contains
+
+ subroutine write_rxt_out_code ( &
+ rxmcnt, &
+ rxmap, &
+ fixmap, &
+ solsym, &
+ fixsym, &
+ prdcnt, &
+ prdmap, &
+ rxntot, &
+ phtcnt, &
+ outfile )
+
+ use io, only : temp_path
+
+ implicit none
+
+ integer, intent(in) :: rxmcnt(2)
+ integer, intent(in) :: rxmap(rxt_lim,prd_lim+3,2)
+ integer, intent(in) :: fixmap(var_lim,3,2)
+ character(len=16), intent(in) :: solsym(var_lim)
+ character(len=16), intent(in) :: fixsym(var_lim)
+ integer, intent(in) :: phtcnt
+ integer, intent(in) :: prdcnt
+ integer, intent(in) :: rxntot
+ integer, intent(in) :: prdmap(var_lim,prd_limp1)
+ character(len=*), intent(in) :: outfile
+
+ integer, parameter :: unitno = 33
+ character(len=128) :: line
+ character(len=64) :: mod_name
+ logical :: lexist
+ integer :: pos
+
+ inquire( file = trim( temp_path ) // outfile, exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // trim(outfile) )
+ end if
+ open( unit = unitno, file = trim( temp_path ) // trim(outfile) )
+
+ pos = index(trim(outfile),'.F')
+ mod_name = outfile(1:pos-1)
+
+ line = ' '
+ line(1:) = 'module '//trim(mod_name)
+ write(unitno,100) trim(line)
+
+ line = ' '
+ line(3:) = 'use shr_kind_mod, only : r8 => shr_kind_r8'
+ write(unitno,100) trim(line)
+
+ line = ' '
+ line(3:) = 'implicit none'
+ write(unitno,100) trim(line)
+
+ line = ' '
+ line(3:) = 'private'
+ write(unitno,100) trim(line)
+
+ line = ' '
+ line(3:) = 'public :: set_rates'
+ write(unitno,100) trim(line)
+
+ line = ' '
+ line(1:) = 'contains'
+ write(unitno,100) trim(line)
+
+ line = ' '
+ line(4:) = 'subroutine set_rates( rxt_rates, sol, ncol )'
+ write(unitno,100) trim(line)
+
+ line = ' '
+ line(7:) = 'real(r8), intent(inout) :: rxt_rates(:,:,:)'
+ write(unitno,100) trim(line)
+ line = ' '
+ line(7:) = 'real(r8), intent(in) :: sol(:,:,:)'
+ write(unitno,100) trim(line)
+ line = ' '
+ line(7:) = 'integer, intent(in) :: ncol'
+ write(unitno,100) trim(line)
+
+ call write_rxt_equations ( &
+ rxmcnt, &
+ rxmap, &
+ fixmap, &
+ solsym, &
+ fixsym, &
+ prdcnt, &
+ prdmap, &
+ rxntot, &
+ phtcnt, &
+ unitno )
+
+ line = ' '
+ line(3:) = 'end subroutine set_rates'
+ write(unitno,100) trim(line)
+
+ line = ' '
+ line(1:) = 'end module '//trim(mod_name)
+ write(unitno,100) trim(line)
+
+ close(unitno)
+
+100 format(a)
+
+ end subroutine write_rxt_out_code
+
+ subroutine write_rxt_equations ( &
+ rxmcnt, &
+ rxmap, &
+ fixmap, &
+ solsym, &
+ fixsym, &
+ prdcnt, &
+ prdmap, &
+ rxntot, &
+ phtcnt, unitno )
+
+ implicit none
+
+ integer, intent(in) :: rxmcnt(2)
+ integer, intent(in) :: rxmap(rxt_lim,prd_lim+3,2)
+ integer, intent(in) :: fixmap(var_lim,3,2)
+ character(len=16), intent(in) :: solsym(var_lim)
+ character(len=16), intent(in) :: fixsym(var_lim)
+ integer, intent(in) :: phtcnt
+ integer, intent(in) :: prdcnt
+ integer, intent(in) :: rxntot
+ integer, intent(in) :: prdmap(var_lim,prd_limp1)
+ integer, intent(in) :: unitno
+
+ character(len=80) :: eq_piece
+ character(len=80) :: doc_piece
+ character(len=6) :: num
+ character(len=120) :: eqline
+ character(len=120) :: docline
+ character(len=16) :: symbol
+
+ character(len=120) :: equations(rxntot)
+ character(len=120) :: docs(rxntot)
+
+ integer :: i,j,l
+ integer :: rxno
+ logical :: debug = .false.
+
+ equations(:) = ' '
+ docs(:) = ' '
+
+ ! this is for case where all reactants are invariants
+ do i = 1,prdcnt
+
+ rxno = prdmap(i,1)
+ write( num, '(i6)' ) rxno
+ docline = 'rate_const'
+!!$ eqline = 'rxt_rates(:ncol,:,'//trim(num)//') = rxt_rates(:ncol,:,'//trim(num)//')'
+
+ call get_fixed_reactants( fixmap, var_lim, 3, phtcnt, rxno, fixsym, doc_piece )
+
+ docline = trim(docline)//trim(doc_piece)
+
+!!$ equations(rxno) = trim(eqline)
+ docs(rxno) = trim(docline)
+
+ enddo
+
+ do i = 1,2
+ do j = 1,rxmcnt(i)
+
+ rxno = rxmap(j,1,i)
+
+ write(num, '(i6)' ) rxno
+ docline = 'rate_const'
+ eqline = 'rxt_rates(:ncol,:,'//trim(num)//') = rxt_rates(:ncol,:,'//trim(num)//')'
+ eq_piece = ' '
+ doc_piece = ' '
+
+ call get_fixed_reactants( fixmap, var_lim, 3, phtcnt, rxno, fixsym, doc_piece )
+
+ do l = 2,i+1
+ if( rxmap(j,l,i) == 0 ) then
+ exit
+ end if
+ symbol = solsym(ABS(rxmap(j,l,i)))
+
+ write(num,'(i6)') ABS(rxmap(j,l,i))
+ eq_piece = trim(eq_piece)//'*sol(:ncol,:,' // trim(num) //')'
+ doc_piece = trim(doc_piece)//'*' // trim(symbol)
+
+ end do
+
+ eqline = trim(eqline)//trim(eq_piece)
+ docline = trim(docline)//trim(doc_piece)
+
+ equations(rxno) = trim(eqline)
+ docs(rxno) = trim(docline)
+
+ enddo
+ enddo
+
+ do i = 1,rxntot
+ write(unitno,'(a6,a120,a)') ' ',equations(i), ' ! '//trim(docs(i))
+ enddo
+
+ if (debug) then
+ write(*,*) ' EQUATIONS : '
+ do i = 1,rxntot
+ write(*,'(i4,a120,a)') i, ' '//equations(i), ' ! '//trim(docs(i))
+ enddo
+ endif
+
+ end subroutine write_rxt_equations
+
+ subroutine get_fixed_reactants( &
+ fixmap, &
+ rowdim, &
+ coldim, &
+ phtcnt, &
+ rxno, &
+ fixsym, &
+ doc_piece )
+
+ use VAR_MOD, only : var_lim
+
+ implicit none
+
+ !-----------------------------------------------------------------------
+ ! ... Dummy args
+ !-----------------------------------------------------------------------
+ integer, intent(in) :: rowdim, coldim, phtcnt
+ integer, intent(in) :: fixmap(rowdim,coldim,2)
+ integer, intent(in) :: rxno
+ character(len=*), intent(in) :: fixsym(:)
+
+ character(len=*), intent(out) :: doc_piece
+
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ integer :: j, l, index
+ character(len=16) :: symbol
+ character(len=6) :: num
+
+ integer :: irx
+
+ doc_piece = ' '
+
+ irx = rxno
+ if( rxno < phtcnt ) then
+ irx = - rxno
+ end if
+ do j = 1,2
+ index = get_index( fixmap(1,1,j), var_lim, 3, 1, irx )
+ if( index /= 0 ) then
+ do l = 2,3
+
+ if( fixmap(index,l,j) == 0 ) then
+ return
+ end if
+
+ symbol = fixsym(fixmap(index,l,j))
+ write(num,'(i6)') fixmap(index,l,j)
+
+ doc_piece = trim(doc_piece)//'*' // trim(symbol)
+
+ end do
+ exit
+ end if
+ end do
+
+ end subroutine get_fixed_reactants
+
+end module rxt_equations_mod
diff --git a/chem_proc/src/cam_chempp/rxt_names.f b/chem_proc/src/cam_chempp/rxt_names.f
new file mode 100644
index 0000000000..63e7ad3638
--- /dev/null
+++ b/chem_proc/src/cam_chempp/rxt_names.f
@@ -0,0 +1,76 @@
+
+ subroutine make_rxt_name_mod
+!--------------------------------------------------------------------------------
+! ... Makes a module of parameter reaction names
+!--------------------------------------------------------------------------------
+
+ use rxt_mod, only : rxtcnt => rxntot, gascnt, phtcnt, rxt_tag, rxt_has_tag
+ use io, only : temp_path
+
+ implicit none
+
+!--------------------------------------------------------------------------------
+! ... Local variables
+!--------------------------------------------------------------------------------
+ integer :: i
+ character(len=80) :: buff
+ character(len=5) :: num
+ logical :: lexist
+
+!--------------------------------------------------------------------------------
+! ... Check mod file existence; remove if found
+!--------------------------------------------------------------------------------
+ inquire( file = trim( temp_path ) // 'rxt_names.mod', exist = lexist )
+ if( lexist ) then
+ call system( 'rm ' // trim( temp_path ) // 'rxt_names.mod' )
+ end if
+ open( unit = 30, file = trim( temp_path ) // 'rxt_names.mod' )
+
+ buff = ''
+ write(30,'(a)') buff
+ buff(7:) = 'module m_rxt_id'
+ write(30,'(a)') buff
+ buff = ''
+ write(30,'(a)') buff
+ buff(7:) = 'implicit none'
+ write(30,'(a)') buff
+ buff = ''
+ write(30,'(a)') buff
+
+ do i = 1,rxtcnt
+ if( rxt_tag(i) /= ' ' ) then
+ rxt_has_tag(i) = .true.
+ write(buff(7:),'(''integer, parameter :: rid_'',a,1x,''='',1x,i4)') &
+ rxt_tag(i)(:len_trim(rxt_tag(i))), i
+ write(30,'(a)') buff
+ end if
+ end do
+
+ if( any( rxt_has_tag(:rxtcnt) ) ) then
+ buff = ''
+ write(30,'(a)') buff
+ end if
+
+ do i = 1,rxtcnt
+ if( .not. rxt_has_tag(i) ) then
+ write(num,'(i5)') i+10000
+ if( i <= phtcnt ) then
+ write(buff(7:),'(''integer, parameter :: rid_j'',a,1x,''='',1x,i4)') &
+ num(2:5), i
+ write(rxt_tag(i)(:5),'(''j'',a)') num(2:5)
+ else
+ write(buff(7:),'(''integer, parameter :: rid_r'',a,1x,''='',1x,i4)') &
+ num(2:5), i
+ write(rxt_tag(i)(:5),'(''r'',a)') num(2:5)
+ end if
+ write(30,'(a)') buff
+ end if
+ end do
+
+ buff = ''
+ write(30,'(a)') buff
+ buff(7:) = 'end module m_rxt_id'
+ write(30,'(a)') buff
+ close( 30 )
+
+ end subroutine make_rxt_name_mod
diff --git a/chem_proc/src/cam_chempp/slt_hdr.f b/chem_proc/src/cam_chempp/slt_hdr.f
new file mode 100644
index 0000000000..b20f1050c0
--- /dev/null
+++ b/chem_proc/src/cam_chempp/slt_hdr.f
@@ -0,0 +1,41 @@
+ subroutine SLT_HDR( cray, &
+ multitask, &
+ cpucnt, &
+ machine )
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... The arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: cpucnt
+ logical, intent(in) :: cray
+ logical, intent(in) :: multitask
+ character(len=16), intent(in) :: machine
+
+!-----------------------------------------------------------------------
+! ... The local variables
+!-----------------------------------------------------------------------
+ logical :: lexist
+
+ INQUIRE( file = 'slt.h', exist = lexist )
+ if( lexist ) then
+ call SYSTEM( 'rm slt.h' )
+ end if
+ OPEN( unit = 30, file = 'slt.h' )
+
+ if( cray .and. multitask ) then
+ write(30,'(''# define MT'')')
+ else if( .not. cray ) then
+ write(30,'(''# define NOCRAY'')')
+ write(30,'(''# define PORT'')')
+ if( multitask ) then
+ write(30,'(''# define MPP'')')
+ write(30,'(''# define NCPUS '',i3)') cpucnt
+ end if
+ end if
+ write(30,'(''# define '',a8)') machine
+
+ CLOSE(30)
+
+ end subroutine SLT_HDR
diff --git a/chem_proc/src/cam_chempp/sol_cls.f b/chem_proc/src/cam_chempp/sol_cls.f
new file mode 100644
index 0000000000..fdea0e13d4
--- /dev/null
+++ b/chem_proc/src/cam_chempp/sol_cls.f
@@ -0,0 +1,182 @@
+
+ subroutine SOL_CLS( iout )
+!-----------------------------------------------------------------------
+! ... Map solution species to solution method groups
+!-----------------------------------------------------------------------
+
+ use IO
+ use VAR_MOD, only : spccnt => new_nq, spcsym => new_solsym, clscnt, clsmap
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ character(len=80), intent(inout) :: iout(*)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: symlen = 16
+
+ integer :: kpar, i, parsw(5), nchar
+ integer :: toklen(20)
+ integer :: j, l
+ integer :: no_tokens
+ integer :: class
+ character(len=16) :: tokens(20)
+ character(len=10) :: clshdr(5) = (/ 'EXPLICIT ', 'EBI ', &
+ 'HOV ', 'IMPLICIT ', &
+ 'RODAS ' /)
+ character(len=11) :: clsend(5) = (/ 'ENDEXPLICIT', 'ENDEBI ', &
+ 'ENDHOV ', 'ENDIMPLICIT', &
+ 'ENDRODAS ' /)
+ character(len=1) :: char
+ logical :: found
+
+ integer :: INILIST
+
+!-----------------------------------------------------------------------
+! ... Initialization
+!-----------------------------------------------------------------------
+ parsw(:) = 0 ; clscnt(:) = 0 ; clsmap(:,:,:) = 0
+
+ call CARDIN( lin, buff, nchar )
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh /= 'SOLUTIONCLASSES' ) then
+ call ERRMES( '"Solution classes" card missing; run terminated@', &
+ lout, char, 1, buff )
+ end if
+
+ do
+ call CARDIN(lin, buff, nchar )
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh == 'ENDSOLUTIONCLASSES' ) then
+!-----------------------------------------------------------------------
+! ... Check for all species in class
+!-----------------------------------------------------------------------
+ if( sum( clscnt(:) ) /= spccnt ) then
+ write(lout,*) ' '
+ write(lout,*) 'Following species not in a class'
+ write(lout,*) ' '
+ do l = 1,spccnt
+ found = .false.
+ do class = 1,5
+ if( clscnt(class) /= 0 ) then
+ j = INILIST( l, clsmap(1,class,2), clscnt(class) )
+ if( j /= 0 ) then
+ found = .true.
+ exit
+ end if
+ end if
+ end do
+ if( .not. found ) then
+ write(lout,*) trim(spcsym(l))
+ end if
+ end do
+ stop 'abort'
+ end if
+ exit
+ end if
+
+ found = .false.
+ do kpar = 1,5
+ if( buffh == clshdr(kpar) ) then
+ found = .true.
+ exit
+ end if
+ end do
+ if( .not. found ) then
+ call ERRMES( '# is an invalid class header@', &
+ lout, &
+ buff(:8), &
+ 8, &
+ buff )
+ else if( parsw(kpar) /= 0 ) then
+ call ERRMES( '# solution class already declared@', &
+ lout, &
+ clshdr(kpar), &
+ LEN_TRIM(clshdr(kpar)), &
+ buff )
+ else
+ parsw(kpar) = 1
+ end if
+
+!-----------------------------------------------------------------------
+! ... Read the solution class members
+!-----------------------------------------------------------------------
+Methods : &
+ do
+ call CARDIN(lin, buff, nchar)
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh /= clsend(kpar) ) then
+ if( buffh(:nchar) == 'ALL' ) then
+ clscnt(:5) = 0
+ clscnt(kpar) = spccnt
+ clsmap(:,:,:) = 0
+ do j = 1,spccnt
+ clsmap(j,kpar,1) = j
+ clsmap(j,kpar,2) = j
+ end do
+ cycle
+ else if( buffh(:nchar) == 'ALLOTHERS' ) then
+ clscnt(kpar) = 0
+ clsmap(:,kpar,:) = 0
+ do j = 1,spccnt
+ if( SUM( clsmap(j,:5,1) ) == 0 ) then
+ clscnt(kpar) = clscnt(kpar) + 1
+ clsmap(j,kpar,1) = clscnt(kpar)
+ clsmap(clscnt(kpar),kpar,2) = j
+ end if
+ end do
+ cycle
+ end if
+ call GETTOKENS( buff, &
+ nchar, &
+ ',', &
+ symlen, &
+ tokens, &
+ toklen, &
+ 20, &
+ no_tokens )
+ if( no_tokens == 0 ) then
+ call ERRMES( ' Species input line in error@', lout, buff, 1, ' ' )
+ end if
+
+Tok_loop: do j = 1,no_tokens
+ do l = 1,spccnt
+ if( trim(tokens(j)) == trim(spcsym(l)) ) then
+ clscnt(kpar) = clscnt(kpar) + 1
+ if( clscnt(kpar) > spccnt ) then
+ call ERRMES( ' Species count exceeds limit@', &
+ lout, &
+ buff, 1, buff )
+ end if
+ if( SUM( clsmap(l,:5,1) ) /= 0 ) then
+ call ERRMES( ' # in two or more classes@', &
+ lout, &
+ tokens(j), &
+ toklen(j), &
+ buff )
+ end if
+ clsmap(l,kpar,1) = clscnt(kpar)
+ clsmap(clscnt(kpar),kpar,2) = l
+ cycle tok_loop
+ end if
+ end do
+ call ERRMES( ' Class member # not in solution list@', &
+ lout, &
+ tokens(j), &
+ toklen(j), &
+ buff )
+ end do Tok_loop
+ else
+ exit
+ end if
+ end do Methods
+ end do
+
+ end subroutine SOL_CLS
diff --git a/chem_proc/src/cam_chempp/sp_utils.f b/chem_proc/src/cam_chempp/sp_utils.f
new file mode 100644
index 0000000000..c18c101bed
--- /dev/null
+++ b/chem_proc/src/cam_chempp/sp_utils.f
@@ -0,0 +1,356 @@
+
+ recursive subroutine STCO( vertex )
+!----------------------------------------------------------------
+! ... Permutate sparse matrix in order to find the
+! the strongly connected blocks in a lower triangular
+! block form (LTBF)
+!----------------------------------------------------------------
+
+ use SP_MODS
+
+ implicit none
+
+!----------------------------------------------------------------
+! ... Dummy args
+!----------------------------------------------------------------
+ integer, intent(in) :: vertex
+
+!----------------------------------------------------------------
+! ... Local variables
+!----------------------------------------------------------------
+ integer :: i, j, vn
+ integer :: adj_vertex
+
+ nb = nb + 1
+ lowlink(vertex) = nb
+ number(vertex) = nb
+ sp = sp + 1
+ vstack(sp) = vertex
+ do vn = rp(vertex),rp(vertex+1)-1
+ adj_vertex = ci(vn)
+ if( number(adj_vertex) == 0 ) then
+ call STCO( adj_vertex )
+ lowlink(vertex) = MIN( lowlink(vertex),lowlink(adj_vertex) )
+ else if( number(adj_vertex) < number(vertex) ) then
+ do j = 1,sp
+ if( vstack(j) == adj_vertex ) then
+ lowlink(vertex) = MIN( lowlink(vertex),number(adj_vertex) )
+ exit
+ end if
+ end do
+ end if
+ end do
+
+ if( lowlink(vertex) == number(vertex) ) then
+ blkcnt = blkcnt + 1
+ stcoblk(blkcnt) = pp + 1
+ do
+ if( sp == 0 ) then
+ exit
+ end if
+ vn = vstack(sp)
+ if( number(vn) >= number(vertex) ) then
+ sp = sp - 1
+ pp = pp + 1
+ perm(pp) = vn
+ blkmemcnt(blkcnt) = blkmemcnt(blkcnt) + 1
+ else
+ exit
+ end if
+ end do
+ end if
+
+ end subroutine STCO
+
+ recursive subroutine STCO_PAT( vertex, order )
+!----------------------------------------------------------------
+! ... Permutate sparse matrix in order to find the
+! the strongly connected blocks in a lower triangular
+! block form (LTBF)
+!----------------------------------------------------------------
+
+ use SP_MODS
+
+ implicit none
+
+!----------------------------------------------------------------
+! ... Dummy args
+!----------------------------------------------------------------
+ integer, intent(in) :: vertex, order
+
+!----------------------------------------------------------------
+! ... Local variables
+!----------------------------------------------------------------
+ integer :: i, j, vn
+ integer :: adj_vertex
+
+ nb = nb + 1
+ lowlink(vertex) = nb
+ number(vertex) = nb
+ sp = sp + 1
+ vstack(sp) = vertex
+ do vn = 1,order
+ if( matrix(vertex,vn) ) then
+ adj_vertex = vn
+ if( number(adj_vertex) == 0 ) then
+ call STCO_PAT( adj_vertex, order )
+ lowlink(vertex) = MIN( lowlink(vertex),lowlink(adj_vertex) )
+ else if( number(adj_vertex) < number(vertex) ) then
+ do j = 1,sp
+ if( vstack(j) == adj_vertex ) then
+ lowlink(vertex) = MIN( lowlink(vertex),number(adj_vertex) )
+ exit
+ end if
+ end do
+ end if
+ end if
+ end do
+
+ if( lowlink(vertex) == number(vertex) ) then
+ blkcnt = blkcnt + 1
+ stcoblk(blkcnt) = pp + 1
+ do
+ if( sp == 0 ) then
+ exit
+ end if
+ vn = vstack(sp)
+ if( number(vn) >= number(vertex) ) then
+ sp = sp - 1
+ pp = pp + 1
+ perm(pp) = vn
+ blkmemcnt(blkcnt) = blkmemcnt(blkcnt) + 1
+ else
+ exit
+ end if
+ end do
+ end if
+
+ end subroutine STCO_PAT
+
+ subroutine DIAG_MARK( order, matrix, perm )
+!---------------------------------------------------------------------------
+! ... Find permuatation via diagonal markowitz to produce
+! near optimal LU fillin
+!---------------------------------------------------------------------------
+
+ implicit none
+
+!---------------------------------------------------------------------------
+! ... Dummy args
+!---------------------------------------------------------------------------
+ integer, intent(in) :: order
+ integer, intent(out) :: perm(order)
+ logical, intent(in) :: matrix(order,order)
+
+!---------------------------------------------------------------------------
+! ... Local variables
+!---------------------------------------------------------------------------
+ integer :: row, rowp1, col, maxrow
+ integer :: beta, cnt
+ integer :: i, j
+ logical :: holder(order)
+ logical :: pattern(order,order)
+
+ cnt = COUNT( matrix )
+ perm(:order) = (/ (row,row=1,order) /) ! no permutations
+ pattern = matrix
+ do row = 1,order-1
+ rowp1 = row + 1
+ beta = (order - 1)**2
+ maxrow = row
+ do col = row,order
+ cnt = (COUNT(pattern(col,row:order)) - 1) * &
+ (COUNT(pattern(row:order,col)) - 1)
+ if( cnt < beta ) then
+ beta = cnt
+ maxrow = col
+ end if
+ end do
+ if( maxrow /= row ) then
+!----------------------------------------------------------------
+! ... Row and column permuatation
+!----------------------------------------------------------------
+ holder(row:order) = pattern(row,row:order)
+ pattern(row,row:order) = pattern(maxrow,row:order)
+ pattern(maxrow,row:order) = holder(row:order)
+ holder(row:order) = pattern(row:order,row)
+ pattern(row:order,row) = pattern(row:order,maxrow)
+ pattern(row:order,maxrow) = holder(row:order)
+ beta = perm(row)
+ perm(row) = perm(maxrow)
+ perm(maxrow) = beta
+ end if
+!----------------------------------------------------------------
+! ... Now do "symbolic" decomposition on sub-matrix
+!----------------------------------------------------------------
+ do col = rowp1,order
+ if( pattern(row,col) ) then
+ pattern(rowp1:order,col) = pattern(rowp1:order,row) .or. &
+ pattern(rowp1:order,col)
+ end if
+ end do
+ end do
+
+ end subroutine DIAG_MARK
+
+ subroutine SYM_FAC( order, matrix, adds, mults )
+!----------------------------------------------------------------
+! ... Do a symbolic LU decomposition on sparse matrix
+!----------------------------------------------------------------
+
+ implicit none
+
+!----------------------------------------------------------------
+! ... Dummy args
+!----------------------------------------------------------------
+ integer, intent(in) :: order ! matrix order
+ logical, intent(inout) :: matrix(order,order) ! sparse matrix
+ integer, intent(out) :: adds(2), mults(2) ! operation counts
+
+!----------------------------------------------------------------
+! ... Local variables
+!----------------------------------------------------------------
+ integer :: i, im1, j, rcnt, ccnt
+
+ adds = 0; mults = 0;
+ do i = 2,order
+ im1 = i - 1
+ ccnt = COUNT( matrix(i:order,im1) )
+ rcnt = COUNT( matrix(im1,i:order) )
+ mults(1) = mults(1) + ccnt * (1 + rcnt)
+ mults(2) = mults(2) + ccnt
+ do j = i,order
+ if( matrix(im1,j) ) then
+ adds(1) = adds(1) + COUNT( matrix(i:order,j) .and. matrix(i:order,im1) )
+ matrix(i:order,j) = matrix(i:order,j) .or. matrix(i:order,im1)
+ end if
+ end do
+ end do
+
+ do i = order,2,-1
+ ccnt = COUNT( matrix(1:i-1,i) )
+ mults(2) = mults(2) + ccnt
+ end do
+ adds(2) = mults(2)
+
+ end subroutine SYM_FAC
+
+ subroutine GEN_PAT( order, pattern, rp, ci )
+!----------------------------------------------------------------
+! ... Generate sparsity pattern from row storage
+!----------------------------------------------------------------
+
+ implicit none
+!----------------------------------------------------------------
+! ... Dummy args
+!----------------------------------------------------------------
+ integer, intent(in) :: order
+ integer, intent(in) :: rp(order+1)
+ integer, intent(in) :: ci(*)
+ logical, intent(out) :: pattern(order,order)
+
+!----------------------------------------------------------------
+! ... Local variables
+!----------------------------------------------------------------
+ integer :: i, row
+
+ pattern = .false.
+ do i = 1,order
+ do row = rp(i),rp(i+1)-1
+ pattern(i,ci(row)) = .true.
+ end do
+ end do
+
+ end subroutine GEN_PAT
+
+ subroutine PERM_MAT( order, matrix, perm)
+!----------------------------------------------------------------
+! ... Matrix row and column permutation
+!----------------------------------------------------------------
+
+ implicit none
+
+!----------------------------------------------------------------
+! ... Dummy args
+!----------------------------------------------------------------
+ integer, intent(in) :: order
+ integer, intent(in) :: perm(order)
+ logical, intent(inout) :: matrix(order,order)
+
+!----------------------------------------------------------------
+! ... Local variables
+!----------------------------------------------------------------
+ integer :: i
+ logical :: copy(order,order)
+
+ copy = matrix
+!----------------------------------------------------------------
+! ... Row permutation
+!----------------------------------------------------------------
+ do i = 1,order
+ if( perm(i) /= i ) then
+ copy(i,:order) = matrix(perm(i),:order)
+ end if
+ end do
+ matrix = copy
+!----------------------------------------------------------------
+! ... Col permutation
+!----------------------------------------------------------------
+ do i = 1,order
+ if( perm(i) /= i ) then
+ matrix(:order,i) = copy(:order,perm(i))
+ end if
+ end do
+
+ end subroutine PERM_MAT
+
+ subroutine DRAW_MAT( order, matrix )
+!----------------------------------------------------------------
+! ... Draw matrix sparsity
+!----------------------------------------------------------------
+
+ implicit none
+
+!----------------------------------------------------------------
+! ... Dummy args
+!----------------------------------------------------------------
+ integer, intent(in) :: order
+ logical, intent(in) :: matrix(order,order)
+
+!----------------------------------------------------------------
+! ... Local variables
+!----------------------------------------------------------------
+ integer :: i, row
+ character(len=1) :: matrow(order)
+ character(len=32) :: frmt
+ character(len=132) :: line
+
+ write(*,*) ' '
+ line = ' '
+ do i = 10,order,10
+ write(line(5+i*2:5+i*2),'(i1)') i/10
+ end do
+ write(*,'(a)') line(:LEN_TRIM(line))
+ line = ' '
+ do i = 1,order
+ write(line(5+i*2:5+i*2),'(i1)') MOD( i,10 )
+ end do
+ write(*,'(a)') line(:LEN_TRIM(line))
+ write(*,*) ' '
+ frmt = '(1x,i2,2x,'
+ i = LEN_TRIM( frmt ) + 1
+ if( order < 10 ) then
+ write(frmt(i:i),'(i1)') order
+ else
+ write(frmt(i:i+1),'(i2)') order
+ end if
+ frmt(LEN_TRIM(frmt)+1:) = '(1x,a))'
+ do row = 1,order
+ matrow = ' '
+ where( matrix(row,:order) )
+ matrow(:order) = 'X'
+ endwhere
+ write(*,frmt) row, matrow
+ end do
+
+ end subroutine DRAW_MAT
diff --git a/chem_proc/src/cam_chempp/sparse_pat.f b/chem_proc/src/cam_chempp/sparse_pat.f
new file mode 100644
index 0000000000..304bcff887
--- /dev/null
+++ b/chem_proc/src/cam_chempp/sparse_pat.f
@@ -0,0 +1,129 @@
+
+ subroutine SPARSITY_PAT( clscnt, &
+ clsmap, &
+ cls_rxt_cnt, &
+ cls_rxt_map, &
+ sparse_pat )
+!-----------------------------------------------------------------------
+! ... Set the jacobian matrix sparsity pattern
+!-----------------------------------------------------------------------
+
+ use VAR_MOD, only : var_lim
+ use RXT_MOD, only : rxt_lim, prd_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... The arguments
+!
+! The columns of the cls_rxt_cnt represent the reaction count
+! for each class with the following row conontation:
+! (1) - independent reactions
+! (2) - linear reactions
+! (3) - nonlinear reactions
+! (4) - heterogeneous processes
+!-----------------------------------------------------------------------
+ integer, intent(in) :: clscnt, &
+ clsmap(var_lim), &
+ cls_rxt_map(rxt_lim,prd_lim+3), &
+ cls_rxt_cnt(4)
+ logical, intent(out):: sparse_pat(clscnt,clscnt)
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: i, k, kl, ku, l, m
+ integer :: target
+ integer :: species
+ integer, allocatable :: indexer(:)
+ logical, allocatable :: match_mask(:,:)
+ logical, allocatable :: pmask(:,:)
+
+ if( ALLOCATED( match_mask ) ) then
+ DEALLOCATE( match_mask )
+ end if
+ if( ALLOCATED( pmask ) ) then
+ DEALLOCATE( pmask )
+ end if
+ if( ALLOCATED( indexer ) ) then
+ DEALLOCATE( indexer )
+ end if
+ k = SUM( cls_rxt_cnt(:) )
+ ALLOCATE( match_mask(k,3) )
+ ALLOCATE( indexer(k) )
+ if( SUM( cls_rxt_cnt(2:3) ) /= 0 ) then
+ ALLOCATE( pmask(k,prd_lim) )
+ end if
+ sparse_pat = .false.
+ do i = 1,clscnt
+ sparse_pat(i,i) = .true. ! assume only diagonal entries
+ end do
+
+Species_loop : &
+ do species = 1,clscnt
+!-----------------------------------------------------------------------
+! ... Check for non-linear losses
+!-----------------------------------------------------------------------
+ target = clsmap(species)
+ kl = SUM( cls_rxt_cnt(:2) ) + 1
+ ku = SUM( cls_rxt_cnt(:3) )
+ do i = 1,2
+ match_mask(kl:ku,i) = cls_rxt_map(kl:ku,i+1) == target
+ where( match_mask(kl:ku,i) )
+ indexer(kl:ku) = 6/(i+1)
+ endwhere
+ end do
+ match_mask(kl:ku,1) = match_mask(kl:ku,1) .or. match_mask(kl:ku,2)
+ if( COUNT( match_mask(kl:ku,1) ) /= 0 ) then
+ do k = kl,ku
+ if( match_mask(k,1) ) then
+ m = ABS( cls_rxt_map(k,indexer(k)) )
+ if( m /= target ) then
+ do i = 1,clscnt
+ if( clsmap(i) == m ) then
+ sparse_pat(species,i) = .true.
+ exit
+ end if
+ end do
+ end if
+ end if
+ end do
+ end if
+!-----------------------------------------------------------------------
+! ... Check for production from linear and nonlinear reactions
+!-----------------------------------------------------------------------
+ kl = cls_rxt_cnt(1) + 1
+ do k = kl,ku
+ pmask(k,:) = cls_rxt_map(k,4:prd_lim+3) == species
+ match_mask(k,1) = ANY( pmask(k,:) )
+ end do
+ if( COUNT( match_mask(kl:ku,1) ) /= 0 ) then
+ do k = kl,ku
+ if( match_mask(k,1) ) then
+ do i = 2,3
+ m = ABS( cls_rxt_map(k,i) )
+ if( m /= 0 ) then
+ do l = 1,clscnt
+ if( clsmap(l) == m ) then
+ sparse_pat(species,l) = .true.
+ exit
+ end if
+ end do
+ end if
+ end do
+ end if
+ end do
+ end if
+ end do Species_loop
+
+ if( ALLOCATED( match_mask ) ) then
+ DEALLOCATE( match_mask )
+ end if
+ if( ALLOCATED( pmask ) ) then
+ DEALLOCATE( pmask )
+ end if
+ if( ALLOCATED( indexer ) ) then
+ DEALLOCATE( indexer )
+ end if
+
+ end subroutine SPARSITY_PAT
diff --git a/chem_proc/src/cam_chempp/spat_dim.f b/chem_proc/src/cam_chempp/spat_dim.f
new file mode 100644
index 0000000000..87fba079fb
--- /dev/null
+++ b/chem_proc/src/cam_chempp/spat_dim.f
@@ -0,0 +1,99 @@
+
+ module MO_SPAT_DIMS
+
+ CONTAINS
+
+ subroutine SPAT_DIMS( buff, dimensions )
+!-----------------------------------------------------------------------
+! ... Set the simulation spatial dimensions
+!-----------------------------------------------------------------------
+
+ use IO, only : lin, lout
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(inout) :: dimensions(6)
+ character(len=80), intent(inout) :: buff
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: maxparms = 6
+ integer :: kpar, nchar, retcod, i, k
+ character(len=20) :: parkey(maxparms), keywrd
+ logical :: found
+ logical :: processed(maxparms)
+
+!-----------------------------------------------------------------------
+! ... Function declarations
+!-----------------------------------------------------------------------
+ integer :: LENOF
+
+ parkey(1) = 'LONGITUDEPOINTS'
+ parkey(2) = 'LATITUDEPOINTS'
+ parkey(3) = 'VERTICALPOINTS'
+ parkey(4) = 'NXPT'
+ parkey(5) = 'JINTMX'
+ parkey(6) = 'PLONL'
+
+ processed = .false.
+!-----------------------------------------------------------------------
+! ... Scan for valid numerical control parameter keyword
+!-----------------------------------------------------------------------
+ do
+ call CARDIN( lin, buff, nchar )
+ call UPCASE( buff )
+ if( buff == 'ENDSPATIALDIMENSIONS' ) then
+ exit
+ end if
+ k = INDEX( buff(:nchar), '=' )
+ if( k /= 0 ) then
+ keywrd = buff(:k-1)
+ found = .false.
+ do kpar = 1,maxparms
+ if( keywrd == parkey(kpar) ) then
+ found = .true.
+ exit
+ end if
+ end do
+ if( .not. found ) then
+ call ERRMES ( ' # is an invalid numerical control' &
+ // ' parameter keyword@', lout, keywrd, &
+ LENOF(20,keywrd), buff )
+ end if
+ else
+!-----------------------------------------------------------------------
+! ... Invalid parameter keyword; terminate the program
+!-----------------------------------------------------------------------
+ call ERRMES ( ' numerical specification has no = operator@', &
+ lout, buff, 1, buff )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Valid parameter keyword; now check for duplicate keyword
+!-----------------------------------------------------------------------
+ if( processed(kpar) ) then
+ call ERRMES( '0 *** # has already been specified@', &
+ lout, parkey(kpar), k, ' ' )
+ end if
+ call INTCON ( buff(k+1:), &
+ nchar-k, &
+ dimensions(kpar), &
+ retcod )
+!-----------------------------------------------------------------------
+! ... Check for numeric parameter syntax error
+!-----------------------------------------------------------------------
+ if( retcod /= 0 ) then
+ call ERRMES ( ' # is an invalid real or integer in ' &
+ // 'numeric controls@', lout, buff(k+1:), &
+ LENOF( nchar-k, buff(k+1:)), buff )
+ end if
+ processed(kpar) = .true.
+ end do
+
+ end subroutine SPAT_DIMS
+
+ end module MO_SPAT_DIMS
diff --git a/chem_proc/src/cam_chempp/srfflx.f b/chem_proc/src/cam_chempp/srfflx.f
new file mode 100644
index 0000000000..ced4e401c3
--- /dev/null
+++ b/chem_proc/src/cam_chempp/srfflx.f
@@ -0,0 +1,86 @@
+
+ subroutine srfflx( lin, &
+ lout, &
+ new_nq, &
+ new_solsym, &
+ srf_flx_map, &
+ srf_flx_cnt, &
+ tag )
+
+ use var_mod, only : var_lim
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(in) :: lin, & ! input unit number
+ lout, & ! output unit number
+ new_nq, & ! species count
+ tag ! emission or deposition tag ( 1,2 )
+ integer, intent(inout) :: srf_flx_cnt ! count of species with srf flux
+ integer, intent(out) :: srf_flx_map(*) ! srf flux "map"
+ character(len=16), intent(in) :: new_solsym(*) ! species names
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: nchar
+ integer :: toklen(20)
+ integer :: j, k
+ integer :: no_tokens
+
+ character(len=320) :: buff
+ character(len=320) :: buffh
+ character(len=16) :: tokens(20)
+
+ logical :: found
+
+ integer, parameter :: symlen = 8
+
+!-----------------------------------------------------------------------
+! ... Read the surface flux species
+!-----------------------------------------------------------------------
+ do
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase( buffh )
+ if( tag == 1 .and. buffh == 'ENDSURFACEFLUX' ) then
+ exit
+ else if( tag == 2 .and. buffh == 'ENDSURFACEDEPOSITION' ) then
+ exit
+ end if
+ call gettokens( buff, nchar, ',', symlen, &
+ tokens, toklen, 20, no_tokens )
+ if( no_tokens == 0 ) then
+ call errmes( ' SRFFLX: Species input line in error@', lout, buff, 1, buff )
+ end if
+ do j = 1,no_tokens
+ srf_flx_cnt = srf_flx_cnt + 1
+ if( srf_flx_cnt > var_lim ) then
+ call errmes( ' SRFFLX: Species count exceeds limit@', lout, buff, 1, buff )
+ end if
+ found = .false.
+ do k = 1,new_nq
+ if( tokens(j) == new_solsym(k) ) then
+ if( srf_flx_cnt > 1 ) then
+ if( any( srf_flx_map(:srf_flx_cnt) == k ) ) then
+ if( tag == 1 ) then
+ call errmes( '# is already in srf emis list@', lout, tokens(j), toklen(j), buff )
+ else if( tag == 2 ) then
+ call errmes( '# is already in dry dep list@', lout, tokens(j), toklen(j), buff )
+ end if
+ end if
+ end if
+ srf_flx_map(srf_flx_cnt) = k
+ found = .true.
+ exit
+ end if
+ end do
+ if( .not. found ) then
+ call errmes( '# is not in solution species list@', lout, tokens(j), toklen(j), buff )
+ end if
+ end do
+ end do
+
+ end subroutine srfflx
diff --git a/chem_proc/src/cam_chempp/sub_scan.f b/chem_proc/src/cam_chempp/sub_scan.f
new file mode 100644
index 0000000000..9620e093bf
--- /dev/null
+++ b/chem_proc/src/cam_chempp/sub_scan.f
@@ -0,0 +1,76 @@
+
+ subroutine SUB_SCAN( filecnt, &
+ lib_files, &
+ usr_paths, &
+ usr_files, &
+ sub_cnt )
+!---------------------------------------------------------------------
+! ... This subroutine scans a "standard" library routine for
+! matching user routines which will override the library
+! routine.
+!---------------------------------------------------------------------
+
+ implicit none
+
+!---------------------------------------------------------------------
+! ... Dummy args
+!---------------------------------------------------------------------
+ integer, intent(in) :: filecnt ! count of library subroutines
+ integer, intent(inout) :: sub_cnt ! count of "user" subroutines
+ character(len=*), intent(inout) :: lib_files(*) ! library filenames
+ character(len=*), intent(inout) :: usr_files(*) ! user filenames
+ character(len=*), intent(inout) :: usr_paths(*) ! user filepaths
+
+!---------------------------------------------------------------------
+! ... Local variables
+!---------------------------------------------------------------------
+ integer :: i, j, alls, cnt
+ integer, allocatable :: mark(:)
+ character(len=128), allocatable :: wrk_files(:) ! work space
+ character(len=128), allocatable :: wrk_paths(:) ! work space
+ logical, allocatable :: keep(:)
+
+ if( filecnt > 0 .and. sub_cnt > 0 ) then
+ ALLOCATE( wrk_files(sub_cnt), wrk_paths(sub_cnt), keep(sub_cnt), stat = alls )
+ if( alls /= 0 ) then
+ write(*,*) ' SUB_SCAN : Failed to allocated wrk array'
+ stop 'Alloc err'
+ end if
+ ALLOCATE( mark(filecnt), stat = alls )
+ if( alls /= 0 ) then
+ write(*,*) ' SUB_SCAN : Failed to allocated wrk array'
+ stop 'Alloc err'
+ end if
+ wrk_files(:sub_cnt) = usr_files(:sub_cnt)
+ wrk_paths(:sub_cnt) = usr_paths(:sub_cnt)
+ do i = 1,filecnt
+ mark(i) = INDEX( lib_files(i)(:LEN_TRIM(lib_files(i))), &
+ '/', back = .true. ) + 1
+ end do
+ keep(:sub_cnt) = .true.
+ do i = 1,filecnt
+ do j = 1,sub_cnt
+ if( keep(j) .and. &
+ lib_files(i)(mark(i):LEN_TRIM(lib_files(i))) == &
+ wrk_files(j)(:LEN_TRIM(wrk_files(j))) ) then
+ lib_files(i) = wrk_paths(j)(:LEN_TRIM(usr_paths(j))) &
+ // wrk_files(j)(:LEN_TRIM(wrk_files(j)))
+ keep(j) = .false.
+ exit
+ end if
+ end do
+ end do
+
+ cnt = COUNT( keep(:sub_cnt) )
+ if( cnt /= sub_cnt ) then
+ usr_files(:cnt) = PACK( wrk_files(:sub_cnt), mask = keep(:sub_cnt) )
+ usr_paths(:cnt) = PACK( wrk_paths(:sub_cnt), mask = keep(:sub_cnt) )
+ sub_cnt = cnt
+ end if
+ DEALLOCATE( wrk_files )
+ DEALLOCATE( wrk_paths )
+ DEALLOCATE( keep )
+ DEALLOCATE( mark )
+ end if
+
+ end subroutine SUB_SCAN
diff --git a/chem_proc/src/cam_chempp/symbol.f b/chem_proc/src/cam_chempp/symbol.f
new file mode 100644
index 0000000000..1c8c99804b
--- /dev/null
+++ b/chem_proc/src/cam_chempp/symbol.f
@@ -0,0 +1,379 @@
+
+subroutine SYMBOL( iout )
+ !-----------------------------------------------------------------------
+ ! ... Parse out the solution, pce, fixed, column, and group variables
+ !-----------------------------------------------------------------------
+
+ use IO
+ use VAR_MOD, only : indexh2o, spccnt, indexm, grpsym, grpcof, &
+ grpmap, grpcnt, colsym, colmap, spcsym, slvdsym, nslvd, &
+ colub, relmap, aliases, var_lim
+
+ implicit none
+
+ !-----------------------------------------------------------------------
+ ! ... Dummy args
+ !-----------------------------------------------------------------------
+ character(len=80), intent(out) :: iout(*)
+
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ integer, parameter :: symlen = 16
+
+ integer :: retcod, parsw(6), nchar
+ integer :: spclim(5)
+ integer :: kpar, i
+ integer :: symbol_len
+
+ integer, allocatable :: toklen(:)
+ integer :: j,jj, k, jl, l, ic, m, count,acount
+ integer :: jeq, no_tokens, relcnt
+
+ character(len=80), allocatable :: tokens(:)
+ character(len=16) :: param
+ character(len=16) :: spchdr(6) = (/ 'SOLUTION ', &
+ 'PCE ', &
+ 'FIXED ', &
+ 'GROUPS ', &
+ 'COL-INT ', &
+ 'NOT-TRANSPORTED ' /)
+ character(len=20) :: spcend(6) = (/ 'ENDSOLUTION ', &
+ 'ENDPCE ', &
+ 'ENDFIXED ', &
+ 'ENDGROUPS ', &
+ 'ENDCOL-INT ', &
+ 'ENDNOT-TRANSPORTED ' /)
+ character(len=16) :: upname
+ character(len=1) :: char
+
+ logical :: found
+ spclim(:) = var_lim
+ parsw(:) = 0
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh /= 'SPECIES' ) then
+ call ERRMES( '"Species" card missing; run terminated@', lout, char, 1, buff )
+ end if
+ kpar = 0
+ ALLOCATE( tokens(64) )
+ ALLOCATE( toklen(64) )
+ acount = 0
+ do
+ call CARDIN( lin, buff, nchar )
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh == 'ENDSPECIES' ) then
+ DEALLOCATE( tokens )
+ DEALLOCATE( toklen )
+ exit
+ end if
+ count = 0
+ found = .false.
+ do kpar = 1,6
+ if( buffh == spchdr(kpar) ) then
+ found = .true.
+ exit
+ end if
+ end do
+ if( .not. found ) then
+ call ERRMES( '# is an invalid species header@', lout, buff(:16), 16, buff )
+ else if( parsw(kpar) /= 0 ) then
+ call ERRMES( '# species class already declared@', lout, spchdr(kpar), LEN_TRIM(spchdr(kpar)), buff )
+ else if( kpar >= 4 .and. MAXVAL( spccnt(1:3) ) == 0 ) then
+ call ERRMES( 'There are no sol,pce,fixed species; cannot declare # species class@', lout, &
+ spchdr(kpar), LEN_TRIM(spchdr(kpar)), buff )
+ else if( kpar == 2 .and. parsw(1) /= 1 ) then
+ call ERRMES( ' Solution species must be specified BEFORE pce species@', lout, buff, 1, ' ' )
+ end if
+ parsw(kpar) = 1
+
+ if( kpar <= 3 ) then
+ !-----------------------------------------------------------------------
+ ! ... Read the solution, fixed, and/or "relationship" variables
+ !-----------------------------------------------------------------------
+ do
+ call CARDIN( lin, buff, nchar )
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh == spcend(kpar) ) then
+!!$ if( kpar == 1 .and. count == 0 ) then
+!!$ call ERRMES( 'No # variables declared; terminating@', lout, spchdr(1), &
+!!$ LEN_TRIM(spchdr(1)), &
+!!$ buff )
+!!$ end if
+ spccnt(kpar) = count
+ exit
+ end if
+ if( kpar == 1 .or. kpar == 3 ) then
+ symbol_len = 80
+ else if( kpar /= 2 ) then
+ symbol_len = symlen
+ else
+ symbol_len = 2*symlen+1
+ end if
+ call GETTOKENS( buff, nchar, ',', symbol_len, &
+ tokens, toklen, 64, no_tokens )
+ if( no_tokens <= 0 ) then
+ call ERRMES( ' Species input line in error@', lout, buff, 1, ' ' )
+ end if
+ if( (count + no_tokens) > spclim(kpar) ) then
+ call ERRMES( ' Species count exceeds limit@', lout, buff, 1, buff )
+ end if
+ do j = 1,no_tokens
+ count = count + 1
+ acount = acount + 1
+ if( kpar == 1 .or. kpar == 3 ) then
+ l = INDEX( tokens(j)(:toklen(j)), '->' )
+ if( l == 0 ) then
+ if( toklen(j) <= symlen ) then
+ spcsym(count,kpar) = tokens(j)(:toklen(j))
+ else
+ call ERRMES( ' Species input line in error@', lout, buff, 1, ' ' )
+ end if
+ else
+ l = l - 1
+ if( l <= symlen ) then
+ spcsym(count,kpar) = tokens(j)(:l)
+ else
+ call ERRMES( ' Species input line in error@', lout, buff, 1, ' ' )
+ end if
+ l = l + 3
+ if( toklen(j) - l + 1 <= 64 ) then
+ aliases(acount) = tokens(j)(l:toklen(j))
+ else
+ call ERRMES( ' Species input line in error@', lout, buff, 1, ' ' )
+ end if
+ end if
+ else if( kpar == 2 ) then
+ call GETTOKENS( tokens(j), toklen(j), '/', &
+ symlen, tokens(19), toklen(19), &
+ 2, relcnt )
+ if( relcnt /= 2 ) then
+ call ERRMES( ' Relationship syntax error@', lout, buff, 1, ' ' )
+ end if
+ match_loop : do m = 1,2
+ do l = 1,spccnt(1)
+ if( tokens(18+m) == spcsym(l,1)) then
+ relmap(count,m) = l
+ cycle match_loop
+ end if
+ end do
+ if( relmap(count,m) == 0 ) then
+ call ERRMES( ' Relation member # not in solution list@', lout, &
+ tokens(18+m), toklen(18+m), &
+ buff )
+ end if
+ end do match_loop
+ else
+ spcsym(count,kpar) = tokens(j)(:toklen(j))
+ end if
+ end do
+ end do
+ !-----------------------------------------------------------------------
+ ! ... Check fixed species for atmospheric total density symbol "M"
+ ! and see if water vapor is declard
+ !-----------------------------------------------------------------------
+ if( kpar == 3 ) then
+ found = .false.
+ do i = 1,spccnt(3)
+ upname = spcsym(i,3)
+ call UPCASE( upname )
+ if( upname == 'M' ) then
+ indexm = i
+ found = .true.
+ exit
+ end if
+ end do
+ if( .not. found ) then
+ call ERRMES( 'There must be a fixed symbol "m"; run terminated@', lout, char, 1, buff )
+ end if
+ do i = 1,spccnt(3)
+ upname = spcsym(i,3)
+ call UPCASE( upname )
+ if( upname == 'H2O' ) then
+ indexh2o = i
+ exit
+ end if
+ end do
+ end if
+ else if( kpar == 4 ) then
+ !-----------------------------------------------------------------------
+ ! ... The group section
+ !-----------------------------------------------------------------------
+ do
+ call CARDIN( lin, buff, nchar )
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh == spcend(kpar) ) then
+ spccnt(4) = count
+ exit
+ end if
+ count = count + 1
+ if( count > spclim(kpar) ) then
+ call ERRMES( 'Group count exceeds limit@', lout, buff, 1, buff )
+ end if
+ jeq = INDEX( buff(:symlen+1),'=' )
+ if( jeq == 0 ) then
+ call ERRMES( 'Group name exceeds char limit@', lout, buff, 1, buff )
+ else if( jeq == 1 ) then
+ call ERRMES( 'Group name missing@', lout, buff, 1, buff )
+ else if( jeq == nchar ) then
+ call ERRMES( 'Group list missing@', lout, buff, 1, buff )
+ end if
+ grpsym(count) = buff(:jeq-1)
+ jl = jeq + 1
+ call GETTOKENS( buff(jl:nchar), nchar - jl + 1, '+', 16, &
+ tokens, toklen, 20, no_tokens )
+ if( no_tokens <= 1 ) then
+ call ERRMES( 'One or fewer group members@', lout, buff, 1, buff )
+ end if
+ l = 0
+ do j = 1,no_tokens
+ k = INDEX( tokens(j)(:toklen(j)),'*' )
+ if( k == 1 ) then
+ call ERRMES( 'No group member multiplier specified@', lout, buff, 1, buff )
+ else if( k == toklen(j) ) then
+ call ERRMES( 'No group member specified@', lout, buff, 1, buff )
+ end if
+ param = tokens(j)(k+1:toklen(j))
+ found = .false.
+ grp_srch_loop : do ic = 1,2
+ do m = 1,spccnt(ic)
+ if( param == spcsym(m,ic) ) then
+ found = .true.
+ exit grp_srch_loop
+ end if
+ end do
+ end do grp_srch_loop
+ if( .not. found ) then
+ call ERRMES( 'Group member # not in sol,pce lists@', lout, param, k, buff )
+ end if
+ l = l + 1
+ if( l > 20 ) then
+ call ERRMES( 'Group member count exceeds limit@', lout, buff, 1, buff )
+ end if
+ if( k /= 0 ) then
+ param = tokens(j)(:k-1)
+ call RELCON( param, k-1, grpcof(l,count), retcod )
+ if( retcod /= 0 ) then
+ call ERRMES( '# is an invalid group member coefficient@', lout, param, k-1, buff )
+ end if
+ end if
+ grpmap(l,count) = 1000*ic + m
+ end do
+
+ if( l == 0 ) then
+ call ERRMES( 'Group has no members@', lout, buff, 1, buff )
+ end if
+ grpcnt(count) = l
+ iout(count) = ' '
+ iout(count) = buff(:jeq-1) // ' = '
+ do j = 1,no_tokens
+ jl = LEN_TRIM(iout(count)) + 1
+ if( j == 1 ) then
+ iout(count)(jl+1:) = tokens(j)(:toklen(j))
+ else
+ iout(count)(jl:) = ' + ' // tokens(j)(:toklen(j))
+ end if
+ end do
+ end do
+ else if( kpar == 5 ) then
+ !-----------------------------------------------------------------------
+ ! ... The column integrals
+ !-----------------------------------------------------------------------
+ do
+ call CARDIN( lin, buff, nchar )
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh == spcend(kpar) ) then
+ spccnt(5) = count
+ exit
+ end if
+ call GETTOKENS( buff(:nchar), nchar, ',', 32, &
+ tokens, toklen, 20, no_tokens )
+ if( no_tokens <= 0 ) then
+! call ERRMES( 'Column integral list improperly specified@', lout, buff, 1, buff )
+ end if
+ do j = 1,no_tokens
+ jeq = INDEX( tokens(j)(:toklen(j)),'=' )
+!!$ if( jeq == 0 ) then
+!!$ call ERRMES( 'No assignment operator in column integral list@', lout, tokens(j), toklen(j), buff )
+!!$ else if( jeq == 1 ) then
+!!$ call ERRMES( 'No member in column integral list@', lout, tokens(j), toklen(j), buff )
+!!$ else if( jeq == toklen(j) ) then
+!!$ call ERRMES( 'No value in column integral list@', lout, tokens(j), toklen(j), buff )
+!!$ else if( jeq > (symlen+1) ) then
+!!$ call ERRMES( 'Column name exceeds char limit@', lout, buff, 1, buff )
+!!$ end if
+ param = tokens(j)(:jeq-1)
+ found = .false.
+ colub_srch_loop : do ic = 1,3
+ do m = 1,spccnt(ic)
+ if( param == spcsym(m,ic) ) then
+ found = .true.
+ exit colub_srch_loop
+ end if
+ end do
+ end do colub_srch_loop
+!!$ if( .not. found ) then
+!!$ call ERRMES( 'Column member # not in sol,pce, or fixed lists@', lout, param, k, buff )
+!!$ end if
+ count = count + 1
+ if( count > spclim(kpar) ) then
+ call ERRMES( 'Column count exceeds limit@', lout, buff, 1, buff )
+ end if
+ param = tokens(j)(jeq+1:toklen(j))
+ call RELCON( param, toklen(j)-jeq, colub(count), retcod )
+ if( retcod /= 0 ) then
+ call ERRMES( '# is an invalid upper bndy column density@', lout, param, toklen(j)-jeq, buff )
+ end if
+ colsym(count) = tokens(j)(:jeq-1)
+ end do
+ end do
+ else if( kpar == 6 ) then
+ !-----------------------------------------------------------------------
+ ! ... The Short Lived Species
+ !-----------------------------------------------------------------------
+ jj=0
+ do
+
+ call CARDIN( lin, buff, nchar )
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh == spcend(kpar) ) then
+ exit
+ end if
+ call GETTOKENS( buff(:nchar), nchar, ',', 32, &
+ tokens, toklen, 20, no_tokens )
+!!$ if( no_tokens <= 0 ) then
+!!$! call ERRMES( 'Column integral list improperly specified@', lout, buff, 1, buff )
+!!$ end if
+
+ do j=1,no_tokens
+
+ found = .false.
+ slvd_srch_loop : do ic = 1,2
+ do m = 1,spccnt(ic)
+ if( tokens(j) == spcsym(m,ic) ) then
+ found = .true.
+ exit slvd_srch_loop
+ end if
+ end do
+ end do slvd_srch_loop
+ if( .not. found ) then
+ call ERRMES( 'Short Lived Species # not in sol,pce lists@', lout, tokens(j), toklen(j), buff )
+ end if
+ jj=jj+1
+ slvdsym(jj) = trim(tokens(j))
+ enddo
+
+ nslvd = jj
+
+ end do
+
+ end if
+
+ end do
+
+end subroutine SYMBOL
diff --git a/chem_proc/src/cam_chempp/tokens.f b/chem_proc/src/cam_chempp/tokens.f
new file mode 100644
index 0000000000..6f10f186d7
--- /dev/null
+++ b/chem_proc/src/cam_chempp/tokens.f
@@ -0,0 +1,71 @@
+ subroutine GETTOKENS( string, &
+ ls, &
+ delim, &
+ maxlen, &
+ tokens, &
+ toklen, &
+ maxtok, &
+ tokcnt )
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! Input arguments:
+! string - character string to crack into tokens
+! ls - length of string
+! delim - token delimiter character
+! maxlen - maximum length of any single token
+! maxtok - maximum number of tokens
+! Output arguments:
+! tokcnt - number of actual tokens
+! < 0 => hit maxtok before end of string
+! = 0 => error in input string
+! toklen - array containing length of each token
+! tokens - character array of tokens
+!-----------------------------------------------------------------------
+
+ integer, intent(in) :: ls, maxlen, maxtok
+ integer, intent(out) :: tokcnt
+ integer, intent(out) :: toklen(*)
+
+ character(len=*), intent(in) :: string
+ character(len=*), intent(out) :: tokens(*)
+ character(len=1), intent(in) :: delim
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer :: marker, i, length, endpos
+
+ tokcnt = 0
+ marker = 1
+ do i = 1,ls
+ if( string(i:i) == delim .or. i == ls ) then
+ if( i == ls ) then
+ if( string(i:i) == delim ) then
+ tokcnt = 0
+ exit
+ end if
+ length = i - marker + 1
+ endpos = i
+ else
+ length = i - marker
+ endpos = i - 1
+ end if
+ if( length < 1 .or. length > maxlen ) then
+ tokcnt = 0
+ exit
+ end if
+ tokcnt = tokcnt + 1
+ if( tokcnt > maxtok ) then
+ tokcnt = -tokcnt
+ exit
+ end if
+ tokens(tokcnt) = ' '
+ tokens(tokcnt)(:length) = string(marker:endpos)
+ toklen(tokcnt) = length
+ marker = i + 1
+ end if
+ end do
+
+ end subroutine GETTOKENS
diff --git a/chem_proc/src/cam_chempp/usrsubs.f b/chem_proc/src/cam_chempp/usrsubs.f
new file mode 100644
index 0000000000..b136cbd66f
--- /dev/null
+++ b/chem_proc/src/cam_chempp/usrsubs.f
@@ -0,0 +1,98 @@
+
+ subroutine USRSUBS ( sub_names, sub_cnt )
+
+ use IO
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(out) :: sub_cnt ! count of user subroutines
+ character(len=128), intent(out) :: sub_names(*) ! user filenames
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: symlen = 64
+
+ integer :: sublim = 100
+ integer :: nchar, pos
+ integer :: toklen(20)
+ integer :: j, count
+ integer :: no_tokens
+
+ character(len=64) :: filepath
+ character(len=128) :: filespec
+ character(len=64) :: tokens(20)
+
+ logical :: lexist
+
+ sub_cnt = 0
+ count = 0
+ filepath = ' '
+ filespec = ' '
+!-----------------------------------------------------------------------
+! ... Read the subroutine pathnames
+!-----------------------------------------------------------------------
+ do
+ call CARDIN ( lin, buff, nchar )
+ buffh = buff
+ call UPCASE( buffh )
+ if( buffh /= 'ENDUSERSUBROUTINES' ) then
+ call GETTOKENS( buff, nchar, ',', symlen, &
+ tokens, toklen, 20, no_tokens )
+ if( no_tokens == 0 ) then
+ call ERRMES( ' Files input line in error@', lout, buff, 1, ' ' )
+!-----------------------------------------------------------------------
+! ... Check for filepath setting
+!-----------------------------------------------------------------------
+ else if( no_tokens == 1 .and. tokens(1)(9:9) == '=' ) then
+ filepath = tokens(1)(:8)
+ call UPCASE( filepath )
+ if( filepath == 'FILEPATH' ) then
+ filepath = tokens(1)(10:)
+ filepath = TRIM( filepath )
+ else
+ call ERRMES( ' # is not FILEPATH keyword@', lout, tokens(1)(:8), 8, buff )
+ end if
+ cycle
+ end if
+!-----------------------------------------------------------------------
+! ... Process the user subroutine filespec
+!-----------------------------------------------------------------------
+ do j = 1,no_tokens
+ count = count + 1
+ if( count > sublim ) then
+ call ERRMES( ' Files count exceeds limit@', lout, buff, 1, buff )
+ end if
+ if( tokens(j)(1:1) == '/' ) then
+ filespec = tokens(j)(:toklen(j))
+ else
+ if( filepath /= ' ' ) then
+ pos = LEN_TRIM(filepath)
+ if( filepath(pos:pos) /= '/' ) then
+ filepath(pos+1:pos+1) = '/'
+ end if
+ filespec = TRIM( filepath) // tokens(j)(:toklen(j))
+ else
+ filespec = tokens(j)(:toklen(j))
+ end if
+ end if
+!-----------------------------------------------------------------------
+! ... Check for file existence
+!-----------------------------------------------------------------------
+ INQUIRE( file = TRIM( filespec ), exist = lexist )
+ if( .not. lexist ) then
+ call ERRMES( ' File # does NOT exist@', lout, filespec, LEN_TRIM(filespec), buff )
+ end if
+ sub_names(count) = filespec
+ end do
+ cycle
+ else
+ sub_cnt = count
+ exit
+ end if
+ end do
+
+ end subroutine USRSUBS
diff --git a/chem_proc/src/cam_chempp/ver_hdr.f b/chem_proc/src/cam_chempp/ver_hdr.f
new file mode 100644
index 0000000000..00487b06e4
--- /dev/null
+++ b/chem_proc/src/cam_chempp/ver_hdr.f
@@ -0,0 +1,144 @@
+
+ module mo_ver_hdr
+
+ contains
+
+ subroutine ver_hdr( options, &
+ plon, plonl, plev, &
+ machine, &
+ model, &
+ arch_type, &
+ ohstflag, &
+ diagprnt, &
+ tavgprnt, &
+ srf_flx_cnt, &
+ hetcnt, rxntot, clscnt, nzcnt, spcno, &
+ dvel_cnt )
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... The arguments
+!-----------------------------------------------------------------------
+ integer, intent(in) :: srf_flx_cnt ! species with srf flux
+ integer, intent(in) :: dvel_cnt ! species with dep vel
+ integer, intent(in) :: plon, plonl, plev
+ integer, intent(in) :: hetcnt, rxntot, spcno
+ integer, intent(in) :: nzcnt(2)
+ integer, intent(in) :: clscnt(5)
+ character(len=16), intent(in) :: machine ! target machine
+ character(len=16), intent(in) :: model ! target model
+ character(len=16), intent(in) :: arch_type ! architecture
+ logical, intent(in) :: options(*) ! options array
+ logical, intent(in) :: ohstflag ! hist tape write flag
+ logical, intent(in) :: diagprnt ! chktrc, negtrc diag printout flag
+ logical, intent(in) :: tavgprnt ! time averaged printout flag
+
+!-----------------------------------------------------------------------
+! ... The local variables
+!-----------------------------------------------------------------------
+ integer :: i, cache_factor
+ integer :: up_bound(2)
+ logical :: lexist
+
+ inquire( file = 'version.h', exist = lexist )
+ if( lexist ) then
+ call system( 'rm version.h' )
+ end if
+ open( unit = 30, file = 'version.h' )
+
+ if( options(1) ) then
+ write(30,'(''# define CHEM'')')
+ end if
+
+ if( options(2) ) then
+ write(30,'(''# define CRAY'')')
+ end if
+
+ if( ohstflag ) then
+ write(30,'(''# define HISTTAPE'')')
+ end if
+
+ if( diagprnt ) then
+ write(30,'(''# define DIAGPRNT'')')
+ end if
+
+ if( tavgprnt ) then
+ write(30,'(''# define TAVGPRNT'')')
+ end if
+
+ if( options(12) ) then
+ write(30,'(''# define RXTNLOOKUP'')')
+ end if
+
+ if( options(14) ) then
+ write(30,'(''# define F90'')')
+ end if
+
+ if( options(16) ) then
+ write(30,'(''# define USRHOOK'')')
+ end if
+
+ if( options(17) ) then
+ write(30,'(''# define MODULES'')')
+ end if
+
+ if( srf_flx_cnt /= 0 ) then
+ write(30,'(''# define SFLUX'')')
+ end if
+
+ if( dvel_cnt /= 0 ) then
+ write(30,'(''# define DVEL'')')
+ end if
+
+ select case( machine )
+ case( 'INTEL' )
+ write(30,'(''# define CLSZE 1'')')
+ write(30,'(''# define MACHINE_INTEL'')')
+ case( 'ALPHA', 'IBM' )
+ do i = 1,2
+ up_bound(i) = 2*nzcnt(i) + rxntot + hetcnt + 6*clscnt(i+3) + spcno
+ up_bound(i) = CEILING( 8.*1024./REAL(up_bound(i)) )
+ end do
+ i = MINVAL( up_bound(:) )
+ up_bound(1) = i
+ do i = 2,up_bound(1)
+ if( MOD( plonl,i) == 0 ) then
+ cache_factor = i
+ end if
+ end do
+ write(30,'(''# define CLSZE '',i3)') MAX( 1,cache_factor )
+ if( machine == 'IBM' ) then
+ write(30,'(''# define MACHINE_IBM'')')
+ else
+ write(30,'(''# define MACHINE_ALPHA'')')
+ end if
+ case( 'CRAY': 'CRAYYMP', 'J90', 'C90' )
+ write(30,'(''# define CLSZE '',i3)') plon
+ write(30,'(''# define MACHINE CRAY'')')
+ case( 'NEC', 'FUJITSU' )
+! write(30,'(''# define CLSZE '',i5)') plon*plev
+ write(30,'(''# define CLSZE 1'')')
+ if( machine == 'NEC' ) then
+ write(30,'(''# define MACHINE_NEC'')')
+ else
+ write(30,'(''# define MACHINE_FUJITSU'')')
+ end if
+ case default
+ if( arch_type == 'HYBRID' ) then
+ write(30,'(''# define CLSZE 4'')')
+ else
+ write(30,'(''# define CLSZE '',i3)') plon
+ end if
+ end select
+ if( model == 'MOZART' ) then
+ write(30,'(''# define MOZART '')')
+ else if( model == 'MOZART' ) then
+ write(30,'(''# define CAM '')')
+ end if
+
+ close(30)
+
+ end subroutine ver_hdr
+
+ end module mo_ver_hdr
diff --git a/chem_proc/src/cam_chempp/ver_opts.f b/chem_proc/src/cam_chempp/ver_opts.f
new file mode 100644
index 0000000000..7a5158386d
--- /dev/null
+++ b/chem_proc/src/cam_chempp/ver_opts.f
@@ -0,0 +1,243 @@
+
+ module mo_ver_opts
+
+ private
+ public :: ver_opts
+
+ contains
+
+ subroutine ver_opts( options, model, machine, march, arch_type, &
+ wrk_dir, cpp_dir, cpp_opts, subfile, diagprnt, &
+ tavgprnt, cpucnt, vec_ftns, vctr_len )
+!-----------------------------------------------------------------------
+! ... Set the simulation options
+!-----------------------------------------------------------------------
+
+ use io
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ integer, intent(inout) :: cpucnt
+ character(len=16), intent(inout) :: machine
+ character(len=16), intent(inout) :: model
+ character(len=16), intent(inout) :: march
+ character(len=16), intent(inout) :: arch_type
+ character(len=64), intent(out) :: wrk_dir
+ character(len=64), intent(inout) :: cpp_dir, cpp_opts
+ character(len=64), intent(out) :: subfile
+ logical, intent(inout) :: diagprnt
+ logical, intent(inout) :: tavgprnt
+ logical, intent(inout) :: vec_ftns
+ logical, intent(inout) :: options(:)
+ integer, intent(inout) :: vctr_len
+
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+ integer, parameter :: maxparm = 27
+
+ integer :: kpar, nchar, k
+ integer :: err
+ logical :: entered(maxparm)
+
+ character(len=20) :: keywrd
+ character(len=20) :: parkey(maxparm)
+
+ logical :: found
+
+ integer :: lenof
+
+ parkey(1) = 'MACHINE'
+ parkey(2) = 'DIFFUSION'
+ parkey(3) = 'CONVECTION'
+ parkey(4) = 'NORMS'
+ parkey(5) = 'CONSERVATION'
+ parkey(6) = 'SOURCECODE'
+ parkey(7) = 'CPUS'
+ parkey(8) = 'MULTITASK'
+ parkey(9) = 'FIXER'
+ parkey(10) = 'DIAGPRNT'
+ parkey(11) = 'RXTNLOOKUP'
+ parkey(12) = 'RELHUM'
+ parkey(13) = 'F90'
+ parkey(14) = 'GEOHEIGHT'
+ parkey(15) = 'USERHOOK'
+ parkey(16) = 'MODULES'
+ parkey(17) = 'WORKDIR'
+ parkey(18) = 'NAMEMOD'
+ parkey(19) = 'SUBFILE'
+ parkey(20) = 'TAVGPRNT'
+ parkey(21) = 'VEC_FTNS'
+ parkey(22) = 'ARCHITECTURE'
+ parkey(23) = 'CPP_DIR'
+ parkey(24) = 'CPP_OPTS'
+ parkey(25) = 'MODEL'
+ parkey(26) = 'MODEL_ARCHITECTURE'
+ parkey(27) = 'VECTOR_LENGTH'
+
+ entered = .false.
+
+!-----------------------------------------------------------------------
+! ... Scan for valid option keyword
+!-----------------------------------------------------------------------
+ do
+ call cardin( lin, buff, nchar )
+ buffh = buff
+ call upcase ( buffh )
+ if( buffh == 'ENDVERSIONOPTIONS' ) then
+ if( .not. options(1) ) then ! not a cray target
+ if( cpucnt > 1 ) then
+ options(10) = .true. ! "distributed" processing
+ else
+ options(10) = .false. ! no dist processing
+ end if
+ end if
+ if( .not. options(13) ) then ! if not fortran90 then no modules
+ options(16) = .false.
+ options(17) = .false.
+ end if
+ if( machine /= 'IBM' ) then
+ vec_ftns = .false.
+ end if
+ if( machine == 'NEC' ) then
+ march = 'VECTOR'
+ else if( machine == 'INTEL' ) then
+ march = 'SCALAR'
+ end if
+ if( model == 'WRF' ) then
+ march = 'SCALAR'
+ end if
+ exit
+ end if
+ k = index( buffh(:nchar), '=' )
+ if( k /= 0 ) then
+ keywrd = buffh(:k-1)
+ found = .false.
+ do kpar = 1,maxparm
+ if( keywrd == parkey(kpar) ) then
+ found = .true.
+ exit
+ end if
+ end do
+ else
+ call errmes ( ' option specification has no = operator@', lout, buff, 1, buff )
+ end if
+ if( .not. found ) then
+!-----------------------------------------------------------------------
+! ... Invalid parameter keyword; terminate the program
+!-----------------------------------------------------------------------
+ call errmes ( ' # is an invalid options' &
+ // ' parameter keyword@', lout, keywrd, &
+ LENOF(20,keywrd), buff )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Valid parameter keyword; now check for duplicate keyword
+!-----------------------------------------------------------------------
+ if( entered(kpar) ) then
+ call errmes( '0 *** # has already been specified@', &
+ lout, parkey(kpar), k, ' ' )
+ end if
+
+!-----------------------------------------------------------------------
+! ... Set individual options
+!-----------------------------------------------------------------------
+ if( kpar == 1 ) then
+ machine = buffh(k+1:nchar)
+ if( machine /= 'CRAYYMP' .and. machine /= 'CRAY2' .and. machine /= 'CRAY3' &
+ .and. machine /= 'J90' .and. machine /= 'C90' ) then
+ options(1) = .false.
+ end if
+ else if( kpar == 6 ) then
+ if( buffh(k+1:nchar) /= 'FULL' ) then
+ options(6) = .false.
+ end if
+ else if( kpar == 7 ) then
+ call intcon( buffh(k+1:), &
+ nchar - k, &
+ cpucnt, &
+ err )
+ if( err /= 0 ) then
+ call errmes( ' # is not a valid number@', &
+ lout, &
+ buffh(k+1:), &
+ nchar - k, &
+ buff )
+ end if
+ else if( kpar == 21 ) then
+ if( buffh(k+1:nchar) == 'ON' .or. buffh(k+1:nchar) == 'YES' ) then
+ vec_ftns = .true.
+ end if
+ else if( kpar == 22 ) then
+ arch_type = buffh(k+1:nchar)
+ if( arch_type /= 'OMP' .and. arch_type /= 'MPI' .and. arch_type /= 'HYBRID' ) then
+ call errmes( '0 *** # is not a valid architecture type@', lout, arch_type, 8, ' ' )
+ end if
+ else if( kpar == 25 ) then
+ model = buffh(k+1:nchar)
+ if( model /= 'MOZART' .and. model /= 'CAM' .and. model /= 'WRF' ) then
+ call errmes( '# is not a valid model type@', lout, buff(k+1:), nchar-k , ' ' )
+ end if
+ else if( kpar == 26 ) then
+ march = buffh(k+1:nchar)
+ if( march /= 'SCALAR' .and. march /= 'CACHE' .and. march /= 'VECTOR' ) then
+ call errmes( '# is not a valid model architecture type@', lout, buff(k+1:), nchar-k , ' ' )
+ end if
+ else if( kpar == 27 ) then
+ call intcon( buffh(k+1:), &
+ nchar - k, &
+ vctr_len, &
+ err )
+ if( err /= 0 ) then
+ call errmes( ' # is not a valid number@', &
+ lout, &
+ buffh(k+1:), &
+ nchar - k, &
+ buff )
+ end if
+ else
+ if( buffh(k+1:nchar) == 'ON' .or. buffh(k+1:nchar) == 'YES' ) then
+ if( kpar == 10) then
+ diagprnt = .true.
+ else if( kpar == 20) then
+ tavgprnt = .true.
+ else if( kpar == 18 ) then
+ options(17) = .true.
+ else if( kpar /= 8 .and. kpar /= 9 ) then
+ options(kpar) = .true.
+ else if( kpar == 8 ) then
+ options(10) = .true.
+ else if( kpar == 9 ) then
+ options(9) = .true.
+ end if
+ else
+ if( kpar == 17) then
+ wrk_dir = buff(k+1:nchar)
+ else if( kpar == 23) then
+ cpp_dir = buff(k+1:nchar)
+ else if( kpar == 24) then
+ cpp_opts = buff(k+1:nchar)
+ else if( kpar == 19) then
+ subfile = buff(k+1:nchar)
+ else if( kpar == 10) then
+ diagprnt = .false.
+ else if( kpar == 20) then
+ tavgprnt = .false.
+ else if( kpar /= 8 .and. kpar /= 9 ) then
+ options(kpar) = .false.
+ else if( kpar == 8 ) then
+ options(10) = .false.
+ else if( kpar == 9 ) then
+ options(9) = .false.
+ end if
+ end if
+ end if
+ entered(kpar) = .true.
+ end do
+
+ end subroutine ver_opts
+
+ end module mo_ver_opts
diff --git a/chem_proc/src/make_chempp b/chem_proc/src/make_chempp
new file mode 100755
index 0000000000..3c1871b251
--- /dev/null
+++ b/chem_proc/src/make_chempp
@@ -0,0 +1,9 @@
+#!/bin/csh
+
+set exenam=../campp
+set objdir=OBJ
+
+rm -f $exenam
+rm -f $objdir/*
+
+gmake USER_FC=pgf95 DEBUG=TRUE EXENAME=$exenam
diff --git a/cime_config/buildcpp b/cime_config/buildcpp
index 7b8f9a8d53..6fe4700825 100644
--- a/cime_config/buildcpp
+++ b/cime_config/buildcpp
@@ -104,10 +104,7 @@ def buildcpp(case):
os.makedirs(camconf)
# Construct the command itself.
- testpath = os.path.join(srcroot, "components", "cam")
- if os.path.exists(testpath):
- srcroot = testpath
- cmd = os.path.join(srcroot, "bld", "configure") + \
+ cmd = os.path.join(srcroot, "components", "cam", "bld", "configure") + \
" " + " ".join(config_opts)
run_cmd_no_fail(cmd, from_dir=camconf)
diff --git a/cime_config/buildlib b/cime_config/buildlib
index 84cd406f1c..8c60595d1e 100755
--- a/cime_config/buildlib
+++ b/cime_config/buildlib
@@ -39,11 +39,7 @@ def _build_cam():
#-------------------------------------------------------
# Call cam's buildcpp
#-------------------------------------------------------
- testpath = os.path.join(srcroot, "components", "cam")
- if os.path.exists(testpath):
- srcroot = testpath
-
- cmd = os.path.join(os.path.join(srcroot,
+ cmd = os.path.join(os.path.join(srcroot, "components", "cam",
"cime_config", "buildcpp"))
logger.info(" ...calling cam buildcpp to set build time options")
try:
diff --git a/cime_config/buildnml b/cime_config/buildnml
index b12f690263..bf9e2ea298 100755
--- a/cime_config/buildnml
+++ b/cime_config/buildnml
@@ -44,11 +44,7 @@ def buildnml(case, caseroot, compname):
RUN_REFCASE = case.get_value("RUN_REFCASE")
RUN_REFDATE = case.get_value("RUN_REFDATE")
RUN_REFTOD = case.get_value("RUN_REFTOD")
-
- testsrc = os.path.join(srcroot, "components", "cam")
- if os.path.exists(testsrc):
- srcroot = testsrc
-
+ DMS_MODE = case.get_value("CCSM_BGC")
#--------------------------------------------------------------------
# call buildcpp to set both cppdefs and config_cache.xml file for generating namelist
#--------------------------------------------------------------------
@@ -61,7 +57,7 @@ def buildnml(case, caseroot, compname):
if not filecmp.cmp(file1, file2):
call_buildcpp = True
if call_buildcpp:
- cmd = os.path.join(os.path.join(srcroot,"cime_config","buildcpp"))
+ cmd = os.path.join(os.path.join(srcroot,"components","cam","cime_config","buildcpp"))
logger.info(" ...calling cam buildcpp to set build time options")
try:
mod = imp.load_source("buildcpp", cmd)
@@ -169,7 +165,7 @@ def buildnml(case, caseroot, compname):
buildnl_opts += ["-namelist",
'" &atmexp ' + CAM_NAMELIST_OPTS + '/" ']
- cmd = os.path.join(srcroot, "bld", "build-namelist")
+ cmd = os.path.join(srcroot, "components", "cam", "bld", "build-namelist")
cmd += " " + " ".join(buildnl_opts)
rc, out, err = run_cmd(cmd, from_dir=camconf)
diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml
index dfbba10270..33a9a21022 100644
--- a/cime_config/config_component.xml
+++ b/cime_config/config_component.xml
@@ -8,7 +8,7 @@
CAM
===============
-->
- CAM cam6 physics:
+ CAM cam6 physics:
CAM cam5 physics:
CAM cam4 physics:
CAM simplified and non-versioned physics :
@@ -19,8 +19,17 @@
===============
-->
abrupt quadrupling of CO2 with other forcings maintained at 1850 piControl levels (CMIP6 DECK abrupt4xCO2 experiment) :
+ abrupt doubling of CO2 with other forcings maintained at 1850 piControl levels :
ramped CO2 increasing by 1% per year with other forcings maintained at 1850 piControl levels (CMIP6 DECK 1pctCO2 experiment) :
+ cam 5 physics and Production tagged aerosols (OSLO_AERO)
+ cam 6 and Production tagged aerosols (OSLO_AERO)
+ cam 6 and general NorESM changes + Production tagged aerosols (OSLO_AERO)
+ cam 5.4+Production tagged aerosols (OSLO_AERO)+clm5
+ cam 5 physics and Production tagged aerosols (OSLO_AERO)
+ cam 6 (no clubb) physics and Production tagged aerosols (OSLO_AERO)
+ cam 6 physics and Production tagged aerosols (OSLO_AERO)
+
-offline_drv rad
+
+ -phys cam5 -chem trop_mam_oslo
+ -chem trop_mam_oslo
+ -chem trop_mam_oslo
+ -chem trop_mam_oslo -cosp
+ -chem trop_mam_oslo -cosp
+ -chem trop_mam_oslo -cosp
+ -chem trop_mam_oslo -cosp
+ -chem trop_mam_oslo
+
+ -phys cam5 -chem trop_mam_oslo -offline_dyn
+ -chem trop_mam_oslo -offline_dyn
+ -chem trop_mam_oslo -offline_dyn
build_component_cam
env_build.xml
@@ -228,6 +250,15 @@
1850-PD_cam5
+ ssp126_cam6
+ ssp245_cam6
+ ssp370_cam6
+ ssp585_cam6
+ waccm_tsmlt_ssp126_cam6
+ waccm_tsmlt_ssp245_cam6
+ waccm_tsmlt_ssp370_cam6
+ waccm_tsmlt_ssp534_cam6
+ waccm_tsmlt_ssp585_cam6
2005-2100_cam4_rcp26
2005-2100_cam4_rcp45
2005-2100_cam4_rcp45_bgc
@@ -256,6 +287,72 @@
scam_arm97
+ 2000_cam6_noclb
+ 1850_cam54_ptaero
+ 2000_cam6_noclb_oslo
+ 2000_cam6_oslo
+ 1850_cam6_oslo
+ 1850_cam6_noresm
+ 1850_cam6_noresm_frc2
+
+ 1850_cam6_noresm_ghgonly
+ 1850_cam6_noresm_natonly
+ 1850_cam6_noresm_aeroxidonly
+
+ ssp245_cam6_noresm_ghgonly_frc2
+ ssp245_cam6_noresm_natonly_frc2
+ ssp245_cam6_noresm_aeroxidonly_frc2
+
+
+ 1850_cam6_noresm_ghgonly
+ 1850_cam6_noresm_natonly
+ 1850_cam6_noresm_aeroxidonly
+ 1850_cam6_noresm_ozoneonly
+
+ 1850_cam6_noresm_ghg2014
+ 1850_cam6_noresm_ghgnoh2o2014
+ 1850_cam6_noresm_n2o2014
+ 1850_cam6_noresm_ch42014
+ 1850_cam6_noresm_ch4noh2o2014
+ 1850_cam6_noresm_bc2014
+ 1850_cam6_noresm_oc2014
+ 1850_cam6_noresm_so22014
+ 1850_cam6_noresm_aer2014
+ 1850_cam6_noresm_aeroxid2014
+ 1850_cam6_noresm_so2oxid2014
+ 1850_cam6_noresm_ntcf2014
+ 1850_cam6_noresm_anthro2014
+ 1850_cam6_noresm_ghgozone2014
+ 1850_cam6_noresm_ozone2014
+ 1850_cam6_noresm_h2o2014
+ 1850_cam6_noresm_oxid2014
+
+ hist_cam6_oslo
+ hist_cam6_noresm
+ hist_cam6_noresm_frc2
+ hist_cam6_noresm_frc2
+ hist_cam6_noresm_frc2
+
+ sd_hist_cam6_noresm
+
+ hist_cam6_noresm_pintcf
+ hist_cam6_noresm_piaer
+ hist_cam6_noresm_piaeroxid
+
+ hist_cam6_noresm_pintcf
+ hist_cam6_noresm_piaer
+
+ ssp126_cam6_noresm_frc2
+ ssp245_cam6_noresm_frc2
+ ssp370_cam6_noresm_frc2
+ ssp585_cam6_noresm_frc2
+
+ 2000_cam5_oslonudge
+ cam5_nudge_ptaero_up1
+ 2000_cam6_noclb_oslonudge
+ 2000_cam6_oslonudge
+ 2000_cam5_oslonudge
+ cam5_ptaero_up1
run_component_cam
env_run.xml
@@ -265,7 +362,7 @@
leverages groups of namelist options (use cases) that are often
paired with the CAM configure options. These use cases are xml
files located in
- $CIMEROOT/../components/cam/bld/namelist_files/use_cases.
+ $CIMEROOT/../components/atm/cam/bld/namelist_files/use_cases.
In general, this variable should not be modified for supported
component sets (compsets). Recommendation: If you want to
modify this value for your experiment, use your own user-defined
@@ -279,6 +376,7 @@
scenario_ghg='RAMP_CO2_ONLY'ramp_co2_annual_rate=1
co2vmr=1138.8e-6
+ co2vmr=568.64e-6
flbc_cycle_yr=1
flbc_file='$DIN_LOC_ROOT/atm/waccm/lb/LBC_CMIP6abrupt4xCO2_cyclicalYear1_0p5degLat_c180929.nc'
ncdata='$DIN_LOC_ROOT/atm/waccm/ic/b.e21.BW1850.f09_g17.CMIP6-piControl.001.cam.i.0070-01-01.abrupt4xCO2_c181003.nc'
@@ -291,6 +389,45 @@
flbc_file='$DIN_LOC_ROOT/atm/waccm/lb/LBC_CMIP6_1pctCO2ramp_y1-165_0p5degLat_c180930.nc'
nlte_limit_co2=.true.
co2_cycle_rad_passive=.true.
+ dms_source='ocean_flux'
+ co2_cycle_rad_passive=.true.,dms_source='ocean_flux'
+ dms_source='ocean_flux'
+ co2vmr=1138.8e-6
+ co2vmr=1138.8e-6
+ co2vmr=568.64e-6
+ flbc_type='SERIAL'
+ flbc_file='$DIN_LOC_ROOT/atm/waccm/lb/LBC_CMIP6_1pctCO2_y1-165_GlobAnnAvg_0p5degLat_c180929.nc'
+ flbc_list='CO2','CH4','N2O','CFC11eq','CFC12'
+ flbc_type='SERIAL'
+ flbc_file='$DIN_LOC_ROOT/atm/waccm/lb/LBC_CMIP6_1pctCO2_y1-165_GlobAnnAvg_0p5degLat_c180929.nc'
+ flbc_list='CO2','CH4','N2O','CFC11eq','CFC12'
+
+ ocean_filename='dms-hamocc-dow-taylor_chlor_a-lanaclim_N1850_f19_tn14_20190621_1751-1780_cycle_version20190726.nc'
+ dms_cycle_year=1850
+ opom_cycle_year=1850
+ dms_source_type='CYCLICAL'
+ opom_source_type='CYCLICAL'
+
+ ocean_filename='dms-hamocc-dow-taylor_chlor_a-lanaclim_N1850_f19_tn14_20190621_1751-1780_cycle_version20190726.nc'
+ dms_cycle_year=1850
+ opom_cycle_year=1850
+ dms_source_type='CYCLICAL'
+ opom_source_type='CYCLICAL'
+
+
+ ocean_filename='dms-hamocc-dow-taylor_chlor_a-lanaclim_NHIST_f19_tn14_20190625_1849-2015_series_version20190726.nc'
+ dms_source_type='INTERP_MISSING_MONTHS'
+ opom_source_type='INTERP_MISSING_MONTHS'
+
+ ocean_filename='dms-hamocc-dow-taylor_chlor_a-lanaclim_NHIST_f19_tn14_20190625_1985-2014_cycle_version20190726.nc'
+ dms_cycle_year=2000
+ opom_cycle_year=2000
+ dms_source_type='CYCLICAL'
+ opom_source_type='CYCLICAL'
+
+ co2vmr=1138.8e-6
+
+ co2vmr=568.64e-6
run_component_cam
env_run.xml
@@ -306,10 +443,10 @@
- $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/aquap
- $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/aquap
- $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/waccmx
- $COMP_ROOT_DIR_ATM/cime_config/usermods_dirs/scam_mandatory
+ $SRCROOT/components/cam/cime_config/usermods_dirs/aquap
+ $SRCROOT/components/cam/cime_config/usermods_dirs/aquap
+ $SRCROOT/components/cam/cime_config/usermods_dirs/waccmx
+ $SRCROOT/components/cam/cime_config/usermods_dirs/scam_mandatory
run_component_cam
env_case.xml
diff --git a/cime_config/config_compsets.xml b/cime_config/config_compsets.xml
index b93b3da8fe..5e941a2184 100644
--- a/cime_config/config_compsets.xml
+++ b/cime_config/config_compsets.xml
@@ -58,6 +58,208 @@
+
+
+
+ NF1850
+ 1850_CAM60%PTAERO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NFHIST
+ HIST_CAM60%PTAERO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+ NFHISTfsst
+ HIST_CAM60%NORESM%FSST_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+ NFHISTfsstfrc2
+ HIST_CAM60%NORESM%FSST%FRC2_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+
+ NFHISTnorpddmsbc
+ HIST_CAM60%NORESM%NORPDDMSBC_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+
+ NFHISTnorpddmsbcsdyn
+ HIST_CAM60%NORESM%NORPDDMSBC%SDYN_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+ NFHISTfrc2norpddmsbc
+ HIST_CAM60%NORESM%NORPDDMSBC%FRC2_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+
+ NFHISTnorbc
+ HIST_CAM60%NORESM%NORBC_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+ NFHISTnorbc_pintcf
+ HIST_CAM60%NORESM%NORBC%PINTCF_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+ NFHISTnorbc_piaer
+ HIST_CAM60%NORESM%NORBC%PIAER_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+
+ NFHISTnorpibc
+ HIST_CAM60%NORESM%NORPIBC_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+ NFHISTnorpibc_ghgonly
+ 1850_CAM60%NORESM%NORPIBC%GHGONLY_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+ NFHISTnorpibc_natonly
+ 1850_CAM60%NORESM%NORPIBC%NATONLY_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+ NFHISTnorpibc_aeroxidonly
+ 1850_CAM60%NORESM%NORPIBC%AEROXIDONLY_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+ NFHISTnorpibc_ozoneonly
+ 1850_CAM60%NORESM%NORPIBC%OZONEONLY_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+ NF2000climo
+ 2000_CAM60%PTAERO_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+
+
+ NF1850norbc
+ 1850_CAM60%NORESM%NORBC_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_4xco2
+ 1850_CAM60%NORESM%NORBC%4xCO2_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_2xco2
+ 1850_CAM60%NORESM%NORBC%2xCO2_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_ghg2014
+ 1850_CAM60%NORESM%NORBC%GHG2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_ghgnoh2o2014
+ 1850_CAM60%NORESM%NORBC%GHGNOH2O2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_n2o2014
+ 1850_CAM60%NORESM%NORBC%N2O2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_ch42014
+ 1850_CAM60%NORESM%NORBC%CH42014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_ch4noh2o2014
+ 1850_CAM60%NORESM%NORBC%CH4NOH2O2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_bc2014
+ 1850_CAM60%NORESM%NORBC%BC2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_oc2014
+ 1850_CAM60%NORESM%NORBC%OC2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_so22014
+ 1850_CAM60%NORESM%NORBC%SO22014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_aer2014
+ 1850_CAM60%NORESM%NORBC%AER2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_aeroxid2014
+ 1850_CAM60%NORESM%NORBC%AEROXID2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_ntcf2014
+ 1850_CAM60%NORESM%NORBC%NTCF2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_anthro2014
+ 1850_CAM60%NORESM%NORBC%ANTHRO2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_ghgozonelu2014
+ 1850_CAM60%NORESM%NORBC%GHGOZONELU2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_so2oxid2014
+ 1850_CAM60%NORESM%NORBC%SO2OXID2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_ozone2014
+ 1850_CAM60%NORESM%NORBC%OZONE2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_h2o2014
+ 1850_CAM60%NORESM%NORBC%H2O2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
+
+ NF1850norbc_oxid2014
+ 1850_CAM60%NORESM%NORBC%OXID2014_CLM50%BGC-CROP_CICE%PRES_DOCN%DOM_MOSART_SGLC_SWAV
+
+
@@ -68,13 +270,6 @@
-
- FKESSLER
- 2000_CAM%KESSLER_SLND_SICE_SOCN_SROF_SGLC_SWAV
-
-
-
-
FSCAM
2000_CAM60%SCAM_CLM50%SP_CICE%PRES_DOCN%DOM_SROF_SGLC_SWAV
@@ -157,6 +352,10 @@
2000_CAM%TJ16_SLND_SICE_SOCN_SROF_SGLC_SWAV
+
+ FKESSLER
+ 2000_CAM%KESSLER_SLND_SICE_SOCN_SROF_SGLC_SWAV
+
@@ -253,7 +452,40 @@
2000_CAM50_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV
-
+
+ QSC6O
+ 2000_CAM60%PTAERO_SLND_SICE_DOCN%SOMAQP_SROF_SGLC_SWAV
+
+
+
+ NFPTAERO
+ 2000_CAM5%PTAEROUPD1_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+
+
+ NFPTAERO60
+
+ 2000_CAM60%PTAERO_CLM50%BGC_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV
+
+
+ NFPTAERO60NC
+ 2000_CAM54%PTAERO_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+
+
+ NFAMIPNUDGEPTAEROUPD1
+ 2000_CAM5%NUDGEPTAEROUPD1_CLM45%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+
+
+ NFAMIPNUDGEPTAERONCLB
+ 2000_CAM54%NUDGEPTAERO_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+
+
+ NFAMIPNUDGEPTAEROCLB
+ 2000_CAM60%NUDGEPTAERO_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+
+
+
+
+
@@ -269,36 +501,40 @@
-
- FW1850
- 1850_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV
-
-
-
-
-
-
-
FWsc2010climo
2010_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV
+
FWsc2000climo
2000_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV
+
FWsc1850
1850_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV
+
FWscHIST
HIST_CAM60%WCSC_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV
+
+
+
+
+ FW1850
+ 1850_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV
+
+
+
+
+
FW2000climo
2000_CAM60%WCTS_CLM50%SP_CICE%PRES_DOCN%DOM_MOSART_CISM2%NOEVOLVE_SWAV
@@ -341,11 +577,11 @@
FW4madHIST
- HIST_CAM40%WCMD_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+ HIST_CAM40%WCMD_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
FW4madSD
- HIST_CAM40%WCMD%SDYN_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+ HIST_CAM40%WCMD%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
@@ -354,33 +590,68 @@
FX2000
- 2000_CAM40%WXIE_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+ 2000_CAM40%WXIE_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
FXHIST
- HIST_CAM40%WXIE_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+ HIST_CAM40%WXIE_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
FXmadHIST
- HIST_CAM40%WXIED_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+ HIST_CAM40%WXIED_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
FXSD
- HIST_CAM40%WXIE%SDYN_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+ HIST_CAM40%WXIE%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
FXmadSD
- HIST_CAM40%WXIED%SDYN_CLM40%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+ HIST_CAM40%WXIED%SDYN_CLM50%SP_CICE%PRES_DOCN%DOM_RTM_SGLC_SWAV
+
+
+ domain.lnd.fv1.9x2.5_tnx1v4.170609.nc
+ domain.lnd.fv1.9x2.5_tnx1v4.170609.nc
+
+
+
+
+
+ domain.lnd.fv1.9x2.5_tnx1v4.170609.nc
+ domain.lnd.fv1.9x2.5_tnx1v4.170609.nc
+
+
+
+
+
+ domain.ocn.fv1.9x2.5_tnx1v4.170609_djlo.nc
+ domain.ocn.fv1.9x2.5_tnx1v4.170609_djlo.nc
+
+
+
+
+
+ domain.ocn.fv1.9x2.5_tnx1v4.170609_djlo.nc
+ domain.ocn.fv1.9x2.5_tnx1v4.170609_djlo.nc
+
+
+
+
+
+ $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.ocn.fv1.9x2.5_tnx1v4.170609_djlo.nc
+ $DIN_LOC_ROOT/atm/cam/ocnfrac/domain.ocn.fv1.9x2.5_tnx1v4.170609_djlo.nc
+
+
+
1997-06-18
@@ -392,6 +663,7 @@
1995-01-01
1995-01-01
2005-01-01
+ 2015-01-01
2005-01-01
2010-01-01
2000-01-01
@@ -442,12 +714,19 @@
$DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_1850_2017_c180507.nc
$DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_1850_2017_c180507.nc
+
+ $DIN_LOC_ROOT/noresm-only/atm/cam/sst/fice-micom-divocn_sst-micom-dow_NHIST_f19_tn14_20190625_1849-2015_series_version20190726_ts.nc
+
$DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_clim_pi_c101029.nc
$DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_clim_pi_c101028.nc
$DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1.9x2.5_clim_pi_c101028.nc
$DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.9x1.25_clim_pi_c101028.nc
$DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.47x0.63_clim_pi_c101028.nc
$DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_0.23x0.31_clim_pi_c101028.nc
+
+
+ $DIN_LOC_ROOT/noresm-only/atm/cam/sst/fice-micom-divocn_sst-micom-dow_N1850_f19_tn14_20190621_1751-1780_series_version20190726_clim.nc
+ $DIN_LOC_ROOT/noresm-only/atm/cam/sst/fice-micom-divocn_sst-micom-dow_N1850_f19_tn14_20190621_1751-1780_series_version20190726_clim.nc
$DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_1x1_2000climo_c180511.nc
$DIN_LOC_ROOT/atm/cam/sst/sst_HadOIBl_bc_48x96_2000climo_c180511.nc
@@ -494,7 +773,8 @@
- 2016
+ 0
+ 2016
@@ -502,6 +782,7 @@
hybrid
hybrid
+ hybrid
hybrid
hybrid
@@ -515,6 +796,7 @@
b.e20.BHIST.f09_g17.20thC.297_01_v2
b.e20.BHIST.f09_g17.20thC.297_01_v2
+ b.e20.BHIST.f09_g17.20thC.297_01_v2
b.e16.B1850_WW3.f09_g16.lang_redi_2hr_frz_chl.003
b.e20.B1850.f09_g16.pi_control.all.123
@@ -528,6 +810,7 @@
1979-01-01
2000-01-01
+ 2000-01-01
0097-01-01
0010-01-01
0097-01-01
@@ -540,6 +823,7 @@
cesm2_init
cesm2_init
+ cesm2_init
cesm2_init
diff --git a/cime_config/config_pes.xml b/cime_config/config_pes.xml
index d4e7ae45c8..2d51b135c9 100644
--- a/cime_config/config_pes.xml
+++ b/cime_config/config_pes.xml
@@ -1289,6 +1289,43 @@
+
+
+
+ none
+
+ 256
+ 256
+ 256
+ 256
+ 256
+ 256
+ 256
+ 256
+
+
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+
+
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+
+
+
+
diff --git a/cime_config/usermods_dirs/cmip6_noresm/SourceMods/src.cam/preprocessorDefinitions.h b/cime_config/usermods_dirs/cmip6_noresm/SourceMods/src.cam/preprocessorDefinitions.h
new file mode 100755
index 0000000000..3803258bdf
--- /dev/null
+++ b/cime_config/usermods_dirs/cmip6_noresm/SourceMods/src.cam/preprocessorDefinitions.h
@@ -0,0 +1,2 @@
+#define AEROCOM
+#define AEROFFL
diff --git a/cime_config/usermods_dirs/cmip6_noresm_fsst_hifreq_xaer/SourceMods/src.cam/preprocessorDefinitions.h b/cime_config/usermods_dirs/cmip6_noresm_fsst_hifreq_xaer/SourceMods/src.cam/preprocessorDefinitions.h
new file mode 100755
index 0000000000..3803258bdf
--- /dev/null
+++ b/cime_config/usermods_dirs/cmip6_noresm_fsst_hifreq_xaer/SourceMods/src.cam/preprocessorDefinitions.h
@@ -0,0 +1,2 @@
+#define AEROCOM
+#define AEROFFL
diff --git a/cime_config/usermods_dirs/cmip6_noresm_fsst_hifreq_xaer/user_nl_cam b/cime_config/usermods_dirs/cmip6_noresm_fsst_hifreq_xaer/user_nl_cam
new file mode 100644
index 0000000000..273a1320e0
--- /dev/null
+++ b/cime_config/usermods_dirs/cmip6_noresm_fsst_hifreq_xaer/user_nl_cam
@@ -0,0 +1,35 @@
+
+history_aerosol=.true.
+
+nhtfrq = 0, -24, -6, -6, -3, -3 , -1, 1, -24
+
+mfilt = 1, 73, 292, 292, 584, 584, 584, 240, 365
+
+ndens = 2, 2, 2, 2, 2, 2, 2, 1, 1
+
+fincl1 = 'SST','TAUX','TAUY','TAUBLJX','TAUBLJY','BTAUNET','PRECC','PRECL','PRECT','FREQZM','PCONVB','PCONVT','PRECCDZM','Z700','Z500','Z200','Z300','Z100','Z050','U200','U850','V200','V850','T200','T500', 'T700','T1000','OMEGA500','OMEGA850','VTHzm','WTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','dUzm','dVzm','dUazm','dVazm','dUfzm','U','V','T','Q','Z3','dU','dV','dUa','dVa','dUf','EFLX','PTTEND','IETEND_DME', 'PTTEND_DME','TFIX','EFIX','EP','QFLX','MEANPTOP','MEANTTOP','MEANTAU','TCLDAREA',
+'RHREFHT','TREFMXAV','TREFMNAV','ozone','O3','TROP_P','TROP_T','TROP_Z','VT100'
+
+
+fincl2 = 'ABSVIS ','ACTNL:A', 'ACTREL:A', 'AOD_VIS:A', 'cb_BC:A', 'cb_DMS:A', 'cb_DUST:A', 'cb_OM:A', 'cb_SALT:A', 'cb_SO2:A', 'cb_SULFATE:A','CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CMFMC:A', 'CMFMCDZM:A', 'DAYFOC:A', 'FCTL:A', 'FLDS:A', 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A','FLNT:A', 'FLNTC:A', 'FLUT:A', 'FLUTC:A', 'FSDS:A', 'FSDSC:A', 'FSNR:A', 'FSNS:A', 'FSNSC:A', 'FSNTOA:A', 'FSNTOAC:A', 'ICEFRAC:A' ,'LHFLX:A', 'MASS:A', 'OMEGA:A','OMEGA500:A', 'PBLH:A', 'PDELDRY:A', 'PRECC:A', 'PRECT:A', 'PS:A', 'PSL:A', 'Q:A', 'QREFHT:A', 'QSNOW:A', 'RELHUM:A', 'RHREFHT:A', 'SHFLX:A', 'SOLIN:A', 'SOLLD:A', 'SOLSD:A','SST:A', 'T:A', 'T500:A', 'T700:A', 'T850:A', 'TAUBLJX:A', 'TAUBLJY:A', 'TAUGWX:A', 'TAUGWY:A', 'TAUX:A', 'TAUY:A', 'TGCLDIWP:A', 'TGCLDLWP:A', 'TMQ:A', 'TREFHT:A', 'TREFHTMN:M', 'TREFHTMX:X', 'TS:A', 'TSMN:M', 'TSMX:X', 'U:A', 'U10:A', 'UTGWORO:A','V:A', 'Z3:A', 'Z500:A','PRECL:A','FREQZM:A','PCONVB:A','PCONVT:A','PRECCDZM:A','Z700:A','Z200:A', 'Z300:A','Z100:A','Z050:A','U200:A','U850:A','V200:A','V850:A','T200:A','T1000:A','OMEGA850:A','VTHzm:A','WTHzm:A','UVzm:A','UWzm:A','Uzm:A','Vzm:A','THzm:A','Wzm:A','dUzm:A','dVzm:A','dUazm:A','dVazm:A','dUfzm:A','EFLX:A','TFIX:A','EFIX:A',
+'TOT_CLD_VISTAU:A','PBLHMX:X','PBLHMN:M','DOD550:A','UA010:A','Z010:A','Z1000:A',
+'TAUTMODIS:A','CLTMODIS:A'
+
+fincl3 ='CLOUD:A','PBLH:A','RHREFHT:A','PRECT:A','PRECC:A','PRECL:A','PSL:A','U10:A','TREFHT:A','OMEGA:A','UBOT:A','VBOT:A','Z1000:A','Q:A','OMEGA:A','TS:A','SST:A','ICEFRAC:A','PRECCDZM:A','PRECSH:A','PRECTMX:X','BS550AER:A'
+
+fincl4= 'CLDICE:I','CLDLIQ:I','TOT_CLD_VISTAU:I','Q:I','QREFHT:I','Q850:I','PSL:I','U10:I','SNOWHLND:I','SNOWHICE:I','QRAIN:I','QSNOW:I', 'PS:I','PHIS:I','T:I','TREFHT:I','TS:I','T850:I','U:I','UBOT:I','V:I','VBOT:I','Z3:I','ZM_ORG:I','CMFMC:I','CMFMCDZM:I','FREQSH:I','FREQZM:I','PCONVB:I','PCONVT:I','Z700:I','Z500:I','Z200:I','Z300:I','Z100:I','Z050:I','U200:I','U850:I','V200:I','V850:I','T200:I','T500:I','T700:I','T1000:I','OMEGA500:I','OMEGA850:I','PTTEND:I','LHFLX:I','SHFLX:I','EFLX:I',
+'EC550AER:I'
+
+
+fincl5='PRECC:A','PRECL:A','PRECT:A','LHFLX:A','SHFLX:A','FLDS:A', 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A','FLNT:A', 'FLNTC:A', 'FLUT:A', 'FLUTC:A', 'FSDS:A', 'FSDSC:A', 'FSNR:A', 'FSNS:A', 'FSNSC:A', 'FSNTOA:A', 'FSNTOAC:A', 'LWCF','SWCF:A','CLDTOT:A','SOLLD:A','SOLSD:A',
+'PRECSC:A','PRECSL:A'
+
+fincl6='UBOT:I','VBOT:I','TREFHT:I','QREFHT:I','TS:I','SST:I','PS:I','ICEFRAC:I',
+'U10:I'
+
+fincl7='PS:A','TREFHT:A','MMRPM2P5_SRF:A'
+
+
+do_circulation_diags = .true.
+
+
diff --git a/cime_config/usermods_dirs/cmip6_noresm_fsst_hifreq_xaer/user_nl_clm b/cime_config/usermods_dirs/cmip6_noresm_fsst_hifreq_xaer/user_nl_clm
new file mode 100644
index 0000000000..6028a6a170
--- /dev/null
+++ b/cime_config/usermods_dirs/cmip6_noresm_fsst_hifreq_xaer/user_nl_clm
@@ -0,0 +1,36 @@
+!----------------------------------------------------------------------------------
+! Users should add all user specific namelist changes below in the form of
+! namelist_var = new_namelist_value
+!
+! EXCEPTIONS:
+! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting
+! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting
+! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting
+! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting
+! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting
+! Set irrigate by the CLM_BLDNML_OPTS -irrig .true. setting
+! Set co2_ppmv with CCSM_CO2_PPMV option
+! Set dtime with L_NCPL option
+! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options
+! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases
+! (includes $inst_string for multi-ensemble cases)
+! or with CLM_FORCE_COLDSTART to do a cold start
+! or set it with an explicit filename here.
+! Set maxpatch_glcmec with GLC_NEC option
+! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable
+!----------------------------------------------------------------------------------
+
+
+hist_nhtfrq = 0, -24, -3,-8760
+
+hist_mfilt = 12, 365, 2920,1
+
+hist_fincl1 = 'FERT_TO_SMINN','NFIX_TO_SMINN','LITFIRE','LITR1C_TO_SOIL1C','LITR2C_TO_SOIL1C','LITR3C_TO_SOIL2C','M_LEAFC_TO_LITTER','M_FROOTC_TO_LITTER','M_LIVESTEMC_TO_LITTER','M_DEADSTEMC_TO_LITTER','M_LIVECROOTC_TO_LITTER','M_DEADCROOTC_TO_LITTER'
+
+hist_fincl2 = 'ALT','H2OCAN','H2OSFC','QVEGE','QVEGT','QSOIL','QSNOEVAP','QRUNOFF','QOVER','QDRAI','QINTR','QCHARGE','RAM1','SOILLIQ','SOILICE','SOILWATER_10CM','SNOFSRVD','SNOFSRVI','SNOFSRND','SNOFSRNI','SNOFSDSVD','SNOFSDSVI','SNOFSDSND','SNOFSDSNI','TLAI','TG','TSA','TSOI','TV','TOTSOILLIQ','TOTSOILICE','TWS','VOLR','ZWT'
+
+
+ hist_fincl3 = 'QRUNOFF', 'SOILLIQ', 'SOILICE', 'SOILWATER_10CM', 'TSA', 'TSL', 'GPP', 'AR', 'HR'
+
+
+hist_fincl4 = 'TOTVEGC','TOTSOMC','TOTLITC'
diff --git a/cime_config/usermods_dirs/cmip6_noresm_fsst_xaer/SourceMods/src.cam/preprocessorDefinitions.h b/cime_config/usermods_dirs/cmip6_noresm_fsst_xaer/SourceMods/src.cam/preprocessorDefinitions.h
new file mode 100755
index 0000000000..3803258bdf
--- /dev/null
+++ b/cime_config/usermods_dirs/cmip6_noresm_fsst_xaer/SourceMods/src.cam/preprocessorDefinitions.h
@@ -0,0 +1,2 @@
+#define AEROCOM
+#define AEROFFL
diff --git a/cime_config/usermods_dirs/cmip6_noresm_fsst_xaer/user_nl_cam b/cime_config/usermods_dirs/cmip6_noresm_fsst_xaer/user_nl_cam
new file mode 100644
index 0000000000..ed04ce6ad4
--- /dev/null
+++ b/cime_config/usermods_dirs/cmip6_noresm_fsst_xaer/user_nl_cam
@@ -0,0 +1,23 @@
+
+history_aerosol=.true.
+
+nhtfrq = 0, -24, -6, -3, -1, 1, -24,-120,-240
+
+mfilt = 1, 5, 20, 40, 120, 240, 365, 73, 365
+
+ndens = 2, 2, 2, 2, 2, 2, 1, 1, 1
+
+
+fincl1 = 'SST','TAUX','TAUY','TAUBLJX','TAUBLJY','BTAUNET','PRECC','PRECL','PRECT','FREQZM','PCONVB','PCONVT','PRECCDZM','Z700','Z500','Z200','Z300','Z100','Z050','U200','U850','V200','V850','T200','T500', 'T700','T1000','OMEGA500','OMEGA850','VTHzm','WTHzm','UVzm','UWzm','Uzm','Vzm','THzm','Wzm','dUzm','dVzm','dUazm','dVazm','dUfzm','U','V','T','Q','Z3','dU','dV','dUa','dVa','dUf','EFLX','PTTEND','IETEND_DME', 'PTTEND_DME','TFIX','EFIX','EP','QFLX','MEANPTOP','MEANTTOP','MEANTAU','TCLDAREA','RHREFHT','TREFMXAV','TREFMNAV','ozone','O3','TROP_P','TROP_T','TROP_Z','VT100'
+
+
+fincl2 = 'ABSVIS:A', 'ACTNL:A', 'ACTREL:A', 'AOD_VIS:A', 'cb_BC:A', 'cb_DMS:A', 'cb_DUST:A', 'cb_OM:A', 'cb_SALT:A', 'cb_SO2:A', 'cb_SULFATE:A',
+ 'CDNUMC:A', 'CLDICE:A', 'CLDLIQ:A', 'CLDTOT:A', 'CLOUD:A', 'CMFMC:A', 'CMFMCDZM:A', 'DAYFOC:A', 'FCTL:A', 'FLDS:A', 'FLDSC:A', 'FLNR:A', 'FLNS:A', 'FLNSC:A',
+ 'FLNT:A', 'FLNTC:A', 'FLUT:A', 'FLUTC:A', 'FSDS:A', 'FSDSC:A', 'FSNR:A', 'FSNS:A', 'FSNSC:A', 'FSNTOA:A', 'FSNTOAC:A', 'ICEFRAC:A' , 'LHFLX:A', 'MASS:A', 'OMEGA:A',
+ 'OMEGA500:A', 'PBLH:A', 'PDELDRY:A', 'PRECC:A', 'PRECT:A', 'PS:A', 'PSL:A', 'Q:A', 'QREFHT:A', 'QSNOW:A', 'RHREFHT:A', 'SHFLX:A',
+ 'SOLIN:A', 'SOLLD:A', 'SOLSD:A', 'SST:A' ,'T:A', 'T500:A', 'T700:A', 'T850:A', 'TAUBLJX:A', 'TAUBLJY:A', 'TAUGWX:A', 'TAUGWY:A', 'TAUX:A', 'TAUY:A',
+ 'TGCLDIWP:A', 'TGCLDLWP:A', 'TMQ:A', 'TREFHT:A', 'TREFHTMN:M', 'TREFHTMX:X', 'TS:A', 'TSMN:M', 'TSMX:X', 'U10:A', 'UTGWORO:A',
+ 'Z500:A',
+ 'Z100:A','Z1000:A','DOD550:A','TAUTMODIS:A','CLTMODIS:A'
+
+
diff --git a/cime_config/usermods_dirs/cmip6_noresm_fsst_xaer/user_nl_clm b/cime_config/usermods_dirs/cmip6_noresm_fsst_xaer/user_nl_clm
new file mode 100644
index 0000000000..f483209066
--- /dev/null
+++ b/cime_config/usermods_dirs/cmip6_noresm_fsst_xaer/user_nl_clm
@@ -0,0 +1,30 @@
+!----------------------------------------------------------------------------------
+! Users should add all user specific namelist changes below in the form of
+! namelist_var = new_namelist_value
+!
+! EXCEPTIONS:
+! Set use_cndv by the compset you use and the CLM_BLDNML_OPTS -dynamic_vegetation setting
+! Set use_vichydro by the compset you use and the CLM_BLDNML_OPTS -vichydro setting
+! Set use_cn by the compset you use and CLM_BLDNML_OPTS -bgc setting
+! Set use_crop by the compset you use and CLM_BLDNML_OPTS -crop setting
+! Set spinup_state by the CLM_BLDNML_OPTS -bgc_spinup setting
+! Set irrigate by the CLM_BLDNML_OPTS -irrig .true. setting
+! Set co2_ppmv with CCSM_CO2_PPMV option
+! Set dtime with L_NCPL option
+! Set fatmlndfrc with LND_DOMAIN_PATH/LND_DOMAIN_FILE options
+! Set finidat with RUN_REFCASE/RUN_REFDATE/RUN_REFTOD options for hybrid or branch cases
+! (includes $inst_string for multi-ensemble cases)
+! or with CLM_FORCE_COLDSTART to do a cold start
+! or set it with an explicit filename here.
+! Set maxpatch_glcmec with GLC_NEC option
+! Set glc_do_dynglacier with GLC_TWO_WAY_COUPLING env variable
+!----------------------------------------------------------------------------------
+
+
+hist_nhtfrq = 0, -24, -6, -3
+
+hist_mfilt = 1, 5, 20, 40
+
+hist_fincl1 = 'FERT_TO_SMINN','NFIX_TO_SMINN','LITFIRE','LITR1C_TO_SOIL1C','LITR2C_TO_SOIL1C','LITR3C_TO_SOIL2C','M_LEAFC_TO_LITTER','M_FROOTC_TO_LITTER','M_LIVESTEMC_TO_LITTER','M_DEADSTEMC_TO_LITTER','M_LIVECROOTC_TO_LITTER','M_DEADCROOTC_TO_LITTER'
+
+ hist_fincl2 = 'QRUNOFF', 'SOILLIQ', 'SOILICE', 'SOILWATER_10CM', 'TSA', 'TSL', 'GPP', 'AR', 'HR'
diff --git a/src/NorESM/cam_diagnostics.F90 b/src/NorESM/cam_diagnostics.F90
new file mode 100644
index 0000000000..e8dff42def
--- /dev/null
+++ b/src/NorESM/cam_diagnostics.F90
@@ -0,0 +1,3047 @@
+module cam_diagnostics
+
+!---------------------------------------------------------------------------------
+! Module to compute a variety of diagnostics quantities for history files
+!---------------------------------------------------------------------------------
+
+#ifdef OSLO_AERO
+#include
+#endif
+
+use shr_kind_mod, only: r8 => shr_kind_r8
+use camsrfexch, only: cam_in_t, cam_out_t
+use cam_control_mod, only: moist_physics
+use physics_types, only: physics_state, physics_tend
+use ppgrid, only: pcols, pver, begchunk, endchunk
+use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dtype_r8
+use physics_buffer, only: dyn_time_lvls, pbuf_get_field, pbuf_get_index, pbuf_old_tim_idx
+
+use cam_history, only: outfld, write_inithist, hist_fld_active, inithist_all
+use constituents, only: pcnst, cnst_name, cnst_longname, cnst_cam_outfld
+use constituents, only: ptendnam, dmetendnam, apcnst, bpcnst, cnst_get_ind
+use dycore, only: dycore_is
+use phys_control, only: phys_getopts
+use wv_saturation, only: qsat, qsat_water, svp_ice
+use time_manager, only: is_first_step
+
+use scamMod, only: single_column, wfld
+use cam_abortutils, only: endrun
+
+#ifdef OSLO_AERO
+use opttab, only: RF
+#endif
+
+implicit none
+private
+save
+
+! Public interfaces
+
+public :: &
+ diag_readnl, &! read namelist options
+ diag_register, &! register pbuf space
+ diag_init, &! initialization
+ diag_allocate, &! allocate memory for module variables
+ diag_deallocate, &! deallocate memory for module variables
+ diag_conv_tend_ini, &! initialize convective tendency calcs
+ diag_phys_writeout, &! output diagnostics of the dynamics
+ diag_phys_tend_writeout, &! output physics tendencies
+ diag_state_b4_phys_write, &! output state before physics execution
+ diag_conv, &! output diagnostics of convective processes
+ diag_surf, &! output diagnostics of the surface
+ diag_export, &! output export state
+ diag_physvar_ic, &
+ diag_phys_writeout_dry, &! output diagnostics of the dynamics
+ nsurf
+
+
+! Private data
+
+integer :: dqcond_num ! number of constituents to compute convective
+character(len=16) :: dcconnam(pcnst) ! names of convection tendencies
+ ! tendencies for
+real(r8), allocatable :: dtcond(:,:,:) ! temperature tendency due to convection
+type dqcond_t
+ real(r8), allocatable :: cnst(:,:,:) ! constituent tendency due to convection
+end type dqcond_t
+type(dqcond_t), allocatable :: dqcond(:)
+
+character(len=8) :: diag_cnst_conv_tend = 'q_only' ! output constituent tendencies due to convection
+ ! 'none', 'q_only' or 'all'
+
+integer, parameter :: surf_100000 = 1
+integer, parameter :: surf_092500 = 2
+integer, parameter :: surf_085000 = 3
+integer, parameter :: surf_070000 = 4
+integer, parameter :: nsurf = 4
+
+logical :: history_amwg ! output the variables used by the AMWG diag package
+logical :: history_vdiag ! output the variables used by the AMWG variability diag package
+logical :: history_eddy ! output the eddy variables
+logical :: history_budget ! output tendencies and state variables for CAM4
+ ! temperature, water vapor, cloud ice and cloud
+ ! liquid budgets.
+integer :: history_budget_histfile_num ! output history file number for budget fields
+logical :: history_waccm ! outputs typically used for WACCM
+
+! Physics buffer indices
+
+integer :: psl_idx = 0
+integer :: relhum_idx = 0
+integer :: qcwat_idx = 0
+integer :: tcwat_idx = 0
+integer :: lcwat_idx = 0
+integer :: cld_idx = 0
+integer :: concld_idx = 0
+integer :: tke_idx = 0
+integer :: kvm_idx = 0
+integer :: kvh_idx = 0
+integer :: cush_idx = 0
+integer :: t_ttend_idx = 0
+
+integer :: prec_dp_idx = 0
+integer :: snow_dp_idx = 0
+integer :: prec_sh_idx = 0
+integer :: snow_sh_idx = 0
+integer :: prec_sed_idx = 0
+integer :: snow_sed_idx = 0
+integer :: prec_pcw_idx = 0
+integer :: snow_pcw_idx = 0
+
+
+integer :: tpert_idx=-1, qpert_idx=-1, pblh_idx=-1
+
+integer :: trefmxav_idx = -1, trefmnav_idx = -1
+
+contains
+
+!==============================================================================
+
+ subroutine diag_readnl(nlfile)
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use spmd_utils, only: masterproc, masterprocid, mpi_character, mpicom
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'diag_readnl'
+
+ namelist /cam_diag_opts/ diag_cnst_conv_tend
+ !--------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'cam_diag_opts', status=ierr)
+ if (ierr == 0) then
+ read(unitn, cam_diag_opts, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+ end if
+
+ ! Broadcast namelist variables
+ call mpi_bcast(diag_cnst_conv_tend, len(diag_cnst_conv_tend), mpi_character, masterprocid, mpicom, ierr)
+
+ end subroutine diag_readnl
+
+!==============================================================================
+
+ subroutine diag_register_dry()
+
+ call pbuf_add_field('PSL', 'physpkg', dtype_r8, (/pcols/), psl_idx)
+
+ ! Request physics buffer space for fields that persist across timesteps.
+ call pbuf_add_field('T_TTEND', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), t_ttend_idx)
+ end subroutine diag_register_dry
+
+ subroutine diag_register_moist()
+ ! Request physics buffer space for fields that persist across timesteps.
+ call pbuf_add_field('TREFMXAV', 'global', dtype_r8, (/pcols/), trefmxav_idx)
+ call pbuf_add_field('TREFMNAV', 'global', dtype_r8, (/pcols/), trefmnav_idx)
+ end subroutine diag_register_moist
+
+ subroutine diag_register()
+ call diag_register_dry()
+ if (moist_physics) then
+ call diag_register_moist()
+ end if
+ end subroutine diag_register
+
+!==============================================================================
+
+ subroutine diag_init_dry(pbuf2d)
+ ! Declare the history fields for which this module contains outfld calls.
+
+ use cam_history, only: addfld, add_default, horiz_only
+ use cam_history, only: register_vector_field
+ use constituent_burden, only: constituent_burden_init
+ use physics_buffer, only: pbuf_set_field
+ use tidal_diag, only: tidal_diag_init
+!+
+#ifdef AEROCOM
+ use commondefinitions, only: nbmodes
+!#ifdef RFMIPIRF
+! use radconstants, only: nswbands, nlwbands
+!#endif
+#endif
+!-
+
+ type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:)
+
+ integer :: k, m
+ integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water.
+!AL
+ integer :: ixcldni, ixcldnc ! constituent indices for cloud liquid and ice water.
+!AL
+ integer :: ierr
+
+!+
+#ifdef AEROCOM
+ character(len=10) :: modeString
+ character(len=20) :: varname
+ integer :: i, irh
+!#ifdef RFMIPIRF
+! character(len=2) :: c2
+! integer :: ib
+!#endif
+#endif
+!-
+
+ ! outfld calls in diag_phys_writeout
+ call addfld (cnst_name(1), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(1))
+ call addfld ('NSTEP', horiz_only, 'A', 'timestep', 'Model timestep')
+ call addfld ('PHIS', horiz_only, 'I', 'm2/s2', 'Surface geopotential')
+
+ call addfld ('PS', horiz_only, 'A', 'Pa', 'Surface pressure')
+ call addfld ('T', (/ 'lev' /), 'A', 'K', 'Temperature')
+ call addfld ('U', (/ 'lev' /), 'A', 'm/s', 'Zonal wind')
+ call addfld ('UA010', horiz_only, 'A', 'm/s', 'Zonal wind U at 10 mbar pressure surface')
+ call addfld ('V', (/ 'lev' /), 'A', 'm/s', 'Meridional wind')
+
+ call register_vector_field('U','V')
+
+ ! State before physics
+ call addfld ('TBP', (/ 'lev' /), 'A','K', 'Temperature (before physics)')
+ call addfld (bpcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (before physics)')
+ ! State after physics
+ call addfld ('TAP', (/ 'lev' /), 'A','K', 'Temperature (after physics)' )
+ call addfld ('UAP', (/ 'lev' /), 'A','m/s', 'Zonal wind (after physics)' )
+ call addfld ('VAP', (/ 'lev' /), 'A','m/s', 'Meridional wind (after physics)' )
+
+ call register_vector_field('UAP','VAP')
+
+ call addfld (apcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (after physics)')
+ if ( dycore_is('LR') .or. dycore_is('SE') ) then
+ call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)')
+!+tht
+ call addfld ('EBREAK', horiz_only, 'A','W/m2', 'Global-mean energy-nonconservation (W/m2)')
+ call addfld ('PTTEND_DME', (/ 'lev' /), 'A', 'K/s ', &
+ 'T-tendency due to dry mass adjustment at the end of tphysac' )
+ call addfld ('IETEND_DME', horiz_only, 'A','W/m2 ', &
+ 'Column DSE tendency due to mass adjustment at end of tphysac' )
+ call addfld ('EFLX ' , horiz_only, 'A','W/m2 ', &
+ 'Material enthalpy flux due to mass adjustment at end of tphysac')
+!-tht
+ end if
+ call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency')
+
+ call addfld ('Z3', (/ 'lev' /), 'A', 'm', 'Geopotential Height (above sea level)')
+ call addfld ('Z1000', horiz_only, 'A', 'm', 'Geopotential Z at 1000 mbar pressure surface')
+ call addfld ('Z700', horiz_only, 'A', 'm', 'Geopotential Z at 700 mbar pressure surface')
+ call addfld ('Z500', horiz_only, 'A', 'm', 'Geopotential Z at 500 mbar pressure surface')
+ call addfld ('Z300', horiz_only, 'A', 'm', 'Geopotential Z at 300 mbar pressure surface')
+ call addfld ('Z200', horiz_only, 'A', 'm', 'Geopotential Z at 200 mbar pressure surface')
+ call addfld ('Z100', horiz_only, 'A', 'm', 'Geopotential Z at 100 mbar pressure surface')
+ call addfld ('Z050', horiz_only, 'A', 'm', 'Geopotential Z at 50 mbar pressure surface')
+ call addfld ('Z010', horiz_only, 'A', 'm', 'Geopotential Z at 10 mbar pressure surface')
+
+ call addfld ('ZZ', (/ 'lev' /), 'A', 'm2', 'Eddy height variance' )
+ call addfld ('VZ', (/ 'lev' /), 'A', 'm2/s', 'Meridional transport of geopotential height')
+ call addfld ('VT', (/ 'lev' /), 'A', 'K m/s ', 'Meridional heat transport')
+ call addfld ('VT100', horiz_only, 'A', 'K m/s ', 'Meridional heat transport at 100 mbar pressure level')
+ call addfld ('VU', (/ 'lev' /), 'A', 'm2/s2', 'Meridional flux of zonal momentum' )
+ call addfld ('VV', (/ 'lev' /), 'A', 'm2/s2', 'Meridional velocity squared' )
+ call addfld ('OMEGAV', (/ 'lev' /), 'A', 'm Pa/s2 ', 'Vertical flux of meridional momentum' )
+ call addfld ('OMGAOMGA', (/ 'lev' /), 'A', 'Pa2/s2', 'Vertical flux of vertical momentum' )
+
+ call addfld ('UU', (/ 'lev' /), 'A', 'm2/s2', 'Zonal velocity squared' )
+ call addfld ('WSPEED', (/ 'lev' /), 'X', 'm/s', 'Horizontal total wind speed maximum' )
+ call addfld ('WSPDSRFMX', horiz_only, 'X', 'm/s', 'Horizontal total wind speed maximum at the surface' )
+ call addfld ('WSPDSRFAV', horiz_only, 'A', 'm/s', 'Horizontal total wind speed average at the surface' )
+
+ call addfld ('OMEGA', (/ 'lev' /), 'A', 'Pa/s', 'Vertical velocity (pressure)')
+ call addfld ('OMEGAT', (/ 'lev' /), 'A', 'K Pa/s ', 'Vertical heat flux' )
+ call addfld ('OMEGAU', (/ 'lev' /), 'A', 'm Pa/s2 ', 'Vertical flux of zonal momentum' )
+ call addfld ('OMEGA850', horiz_only, 'A', 'Pa/s', 'Vertical velocity at 850 mbar pressure surface')
+ call addfld ('OMEGA500', horiz_only, 'A', 'Pa/s', 'Vertical velocity at 500 mbar pressure surface')
+
+ call addfld ('PSL', horiz_only, 'A', 'Pa','Sea level pressure')
+
+ call addfld ('T1000', horiz_only, 'A', 'K','Temperature at 1000 mbar pressure surface')
+ call addfld ('T925', horiz_only, 'A', 'K','Temperature at 925 mbar pressure surface')
+ call addfld ('T850', horiz_only, 'A', 'K','Temperature at 850 mbar pressure surface')
+ call addfld ('T700', horiz_only, 'A', 'K','Temperature at 700 mbar pressure surface')
+ call addfld ('T500', horiz_only, 'A', 'K','Temperature at 500 mbar pressure surface')
+ call addfld ('T400', horiz_only, 'A', 'K','Temperature at 400 mbar pressure surface')
+ call addfld ('T300', horiz_only, 'A', 'K','Temperature at 300 mbar pressure surface')
+ call addfld ('T200', horiz_only, 'A', 'K','Temperature at 200 mbar pressure surface')
+ call addfld ('T010', horiz_only, 'A', 'K','Temperature at 10 mbar pressure surface')
+
+ call addfld ('T7001000', horiz_only, 'A', 'K','Temperature difference 700 mb - 1000 mb')
+ call addfld ('TH7001000', horiz_only, 'A', 'K','Theta difference 700 mb - 1000 mb')
+ call addfld ('THE7001000', horiz_only, 'A', 'K','ThetaE difference 700 mb - 1000 mb')
+
+ call addfld ('T8501000', horiz_only, 'A', 'K','Temperature difference 850 mb - 1000 mb')
+ call addfld ('TH8501000', horiz_only, 'A', 'K','Theta difference 850 mb - 1000 mb')
+ call addfld ('T9251000', horiz_only, 'A', 'K','Temperature difference 925 mb - 1000 mb')
+ call addfld ('TH9251000', horiz_only, 'A', 'K','Theta difference 925 mb - 1000 mb')
+
+ call addfld ('TT', (/ 'lev' /), 'A', 'K2','Eddy temperature variance' )
+
+ call addfld ('U850', horiz_only, 'A', 'm/s','Zonal wind at 850 mbar pressure surface')
+ call addfld ('U500', horiz_only, 'A', 'm/s','Zonal wind at 500 mbar pressure surface')
+ call addfld ('U250', horiz_only, 'A', 'm/s','Zonal wind at 250 mbar pressure surface')
+ call addfld ('U200', horiz_only, 'A', 'm/s','Zonal wind at 200 mbar pressure surface')
+ call addfld ('U010', horiz_only, 'A', 'm/s','Zonal wind at 10 mbar pressure surface')
+ call addfld ('V850', horiz_only, 'A', 'm/s','Meridional wind at 850 mbar pressure surface')
+ call addfld ('V500', horiz_only, 'A', 'm/s','Meridional wind at 500 mbar pressure surface')
+ call addfld ('V250', horiz_only, 'A', 'm/s','Meridional wind at 250 mbar pressure surface')
+ call addfld ('V200', horiz_only, 'A', 'm/s','Meridional wind at 200 mbar pressure surface')
+
+ call register_vector_field('U850', 'V850')
+ call register_vector_field('U500', 'V500')
+ call register_vector_field('U250', 'V250')
+ call register_vector_field('U200', 'V200')
+
+ call addfld ('UBOT', horiz_only, 'A', 'm/s','Lowest model level zonal wind')
+ call addfld ('VBOT', horiz_only, 'A', 'm/s','Lowest model level meridional wind')
+ call register_vector_field('UBOT', 'VBOT')
+
+ call addfld ('ZBOT', horiz_only, 'A', 'm','Lowest model level height')
+
+ call addfld ('ATMEINT', horiz_only, 'A', 'J/m2','Vertically integrated total atmospheric energy ')
+
+!akc6+ CNVCLD is zero...
+! call addfld ('CNVCLD', horiz_only, 'A', 'fraction', 'Vertically integrated convective cloud cover')
+!akc6-
+
+
+#ifdef OSLO_AERO
+
+#ifdef DIRIND
+ call addfld ('AOD_VIS ',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um') ! CAM4-Oslo: 0.35-0.64um
+ call addfld ('ABSVIS ',horiz_only, 'A','unitless','Aerosol absorptive optical depth at 0.442-0.625um') ! CAM4-Oslo: 0.35-0.64um
+ call addfld ('AODVVOLC ',horiz_only, 'A','unitless','CMIP6 volcanic aerosol optical depth at 0.442-0.625um') ! CAM4-Oslo: 0.35-0.64um
+ call addfld ('ABSVVOLC ',horiz_only, 'A','unitless','CMIP6 volcanic aerosol absorptive optical depth at 0.442-0.625um') ! CAM4-Oslo: 0.35-0.64um
+ call addfld ('CAODVIS ',horiz_only, 'A','unitless','Clear air aerosol optical depth')
+ call addfld ('CABSVIS ',horiz_only, 'A','unitless','Clear air aerosol absorptive optical depth')
+ call addfld ('CLDFREE ',horiz_only, 'A','unitless','Cloud free fraction wrt CAODVIS and CABSVIS')
+ call addfld ('DAYFOC ',horiz_only, 'A','unitless','Daylight fraction')
+ call addfld ('N_AER ',(/'lev'/), 'A', 'unitless','Aerosol number concentration')
+!- call addfld ('N_AERORG','unitless',pver, 'A','Aerosol number concentration',phys_decomp)
+ call addfld ('SSAVIS ',(/'lev'/), 'A','unitless','Aerosol single scattering albedo in visible wavelength band')
+ call addfld ('ASYMMVIS',(/'lev'/), 'A','unitless','Aerosol assymetry factor in visible wavelength band')
+ call addfld ('EXTVIS ',(/'lev'/), 'A','1/km ','Aerosol extinction')
+!=0 call addfld ('RELH ',(/'lev'/), 'A', 'unitless','Fictive relative humidity')
+!akc6+
+ call addfld ('BVISVOLC ',(/'lev'/), 'A','1/km ','CMIP6 volcanic aerosol extinction at 0.442-0.625um')
+!akc6-
+!#ifdef SPAERO
+! call addfld ('AODVISSP',horiz_only, 'A','unitless' ,'Simple plumes aerosol optical depth at 0.35-0.64um')
+! call addfld ('ABSVISSP',horiz_only, 'A','unitless' ,'Simple plumes aerosol absorptive optical depth at 0.35-0.64um')
+! call addfld ('XCDNC_SP',horiz_only, 'A','unitless' ,'CDNC modification factor for simple plume aerosols')
+! call addfld ('AODV3DSP',(/'lev'/), 'A','unitless','Simple plumes 3D aerosol optical depth at 0.35-0.64um')
+! call addfld ('ABSV3DSP',(/'lev'/), 'A','unitless','Simple plumes 3D absorption AOD at 0.35-0.64um')
+!#endif
+#ifdef COLTST4INTCONS
+! optical depth for each mode/mixture:
+ call addfld ('TAUKC0 ',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 0')
+ call addfld ('TAUKC1 ',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 1')
+ call addfld ('TAUKC2 ',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 2')
+ call addfld ('TAUKC4 ',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 4')
+ call addfld ('TAUKC5 ',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 5')
+ call addfld ('TAUKC6 ',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 6')
+ call addfld ('TAUKC7 ',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 7')
+ call addfld ('TAUKC8 ',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 8')
+ call addfld ('TAUKC9 ',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 9')
+ call addfld ('TAUKC10',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 10')
+ call addfld ('TAUKC12',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 12')
+ call addfld ('TAUKC14',horiz_only, 'A','unitless','Aerosol optical depth at 0.442-0.625um for kcomp 14')
+! mass specific extinction (including condensed water) for each mode/mixture:
+ call addfld ('MECKC0 ',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 0')
+ call addfld ('MECKC1 ',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 1')
+ call addfld ('MECKC2 ',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 2')
+ call addfld ('MECKC4 ',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 4')
+ call addfld ('MECKC5 ',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 5')
+ call addfld ('MECKC6 ',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 6')
+ call addfld ('MECKC7 ',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 7')
+ call addfld ('MECKC8 ',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 8')
+ call addfld ('MECKC9 ',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 9')
+ call addfld ('MECKC10',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 10')
+ call addfld ('MECKC12',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 12')
+ call addfld ('MECKC14',(/'lev'/), 'A','m2/g','Aerosol MEC at 0.442-0.625um for kcomp 14')
+#ifdef AEROCOM
+! dry mass for each mode/mixture (for calculation of specific extinction without condensed water):
+ call addfld ('CMDRY0 ',horiz_only, 'A','unitless','Total dry mass load for kcomp 0')
+ call addfld ('CMDRY1 ',horiz_only, 'A','unitless','Total dry mass load for kcomp 1')
+ call addfld ('CMDRY2 ',horiz_only, 'A','unitless','Total dry mass load for kcomp 2')
+ call addfld ('CMDRY4 ',horiz_only, 'A','unitless','Total dry mass load for kcomp 4')
+ call addfld ('CMDRY5 ',horiz_only, 'A','unitless','Total dry mass load for kcomp 5')
+ call addfld ('CMDRY6 ',horiz_only, 'A','unitless','Total dry mass load for kcomp 6')
+ call addfld ('CMDRY7 ',horiz_only, 'A','unitless','Total dry mass load for kcomp 7')
+ call addfld ('CMDRY8 ',horiz_only, 'A','unitless','Total dry mass load for kcomp 8')
+ call addfld ('CMDRY9 ',horiz_only, 'A','unitless','Total dry mass load for kcomp 9')
+ call addfld ('CMDRY10',horiz_only, 'A','unitless','Total dry mass load for kcomp 10')
+ call addfld ('CMDRY12',horiz_only, 'A','unitless','Total dry mass load for kcomp 12')
+ call addfld ('CMDRY14',horiz_only, 'A','unitless','Total dry mass load for kcomp 14')
+#endif !aerocom
+#endif !extra tests
+#ifdef AEROFFL
+ call addfld ('FSNT_DRF',horiz_only, 'A','W/m^2','Total column absorbed solar flux (DIRind)')
+ call addfld ('FSNTCDRF',horiz_only, 'A','W/m^2','Clear sky total column absorbed solar flux (DIRind)' )
+ call addfld ('FSNS_DRF',horiz_only, 'A','W/m^2 ','Surface absorbed solar flux (DIRind)' )
+ call addfld ('FSNSCDRF',horiz_only, 'A','W/m^2 ','Clear sky surface absorbed solar flux (DIRind)' )
+ call addfld ('QRS_DRF ',(/'lev'/), 'A','K/s ','Solar heating rate (DIRind)')
+ call addfld ('QRSC_DRF',(/'lev'/), 'A','K/s ','Clearsky solar heating rate (DIRind)' )
+ call addfld ('FLNT_DRF',horiz_only, 'A','W/m^2 ','Total column longwave flux (DIRind)' )
+ call addfld ('FLNTCDRF',horiz_only, 'A','W/m^2 ','Clear sky total column longwave flux (DIRind)' )
+ call addfld ('FSUTADRF',horiz_only, 'A','W/m^2 ','SW upwelling flux at TOA')
+ call addfld ('FSDS_DRF',horiz_only, 'A','W/m^2 ','SW downelling flux at surface')
+ call addfld ('FSUS_DRF',horiz_only, 'A','W/m^2 ','SW upwelling flux at surface')
+ call addfld ('FSDSCDRF',horiz_only, 'A','W/m^2 ','SW downwelling clear sky flux at surface')
+ call addfld ('FLUS ',horiz_only, 'A','W/m^2 ','LW surface upwelling flux')
+!->ut call addfld ('FLNT_ORG',horiz_only, 'A','W/m^2 ','Total column longwave flux (CAM5)' )
+#endif ! aeroffl
+#ifdef AEROCOM
+ call addfld ('AKCXS ',horiz_only, 'A','mg/m2 ','Scheme excess aerosol mass burden')
+ call addfld ('PMTOT ',horiz_only, 'A','ug/m3 ','Aerosol PM, all sizes')
+ call addfld ('PM25 ',horiz_only, 'A','ug/m3 ','Aerosol PM2.5')
+!akc6+
+ call addfld ('PM2P5 ',(/'lev'/), 'A','ug/m3 ','3D aerosol PM2.5')
+ call addfld ('MMRPM2P5',(/'lev'/), 'A','kg/kg ','3D aerosol PM2.5 mass mixing ratio')
+ call addfld ('MMRPM1 ',(/'lev'/), 'A','kg/kg ','3D aerosol PM1.0 mass mixing ratio')
+ call addfld ('MMRPM2P5_SRF',horiz_only, 'A','kg/kg ','Aerosol PM2.5 mass mixing ratio in bottom layer')
+!akc6-
+ call addfld ('GRIDAREA',horiz_only, 'A','m2 ','Grid area for 1.9x2.5 horizontal resolution')
+ call addfld ('DAERH2O ',horiz_only, 'A', 'mg/m2 ','Aerosol water load')
+ call addfld ('MMR_AH2O',(/'lev'/), 'A', 'kg/kg ','Aerosol water mmr')
+ call addfld ('ECDRYAER',(/'lev'/), 'A', 'kg/kg ','Dry aerosol extinction at 550nm')
+ call addfld ('ABSDRYAE',(/'lev'/), 'A','m-1 ','Dry aerosol absorption at 550nm')
+ call addfld ('ECDRY440',(/'lev'/), 'A','m-1 ','Dry aerosol extinction at 440nm')
+ call addfld ('ABSDR440',(/'lev'/),'A','m-1 ','Dry aerosol absorption at 440nm')
+ call addfld ('ECDRY870',(/'lev'/),'A','m-1 ','Dry aerosol extinction at 870nm')
+ call addfld ('ABSDR870',(/'lev'/),'A','m-1 ','Dry aerosol absorption at 870nm')
+ call addfld ('ASYMMDRY',(/'lev'/),'A','unitless','Dry asymmetry factor in visible wavelength band')
+ call addfld ('ECDRYLT1',(/'lev'/),'A','m-1 ','Dry aerosol extinction at 550nm lt05')
+ call addfld ('ABSDRYBC',(/'lev'/),'A','m-1 ','Dry BC absorption at 550nm')
+ call addfld ('ABSDRYOC',(/'lev'/),'A','m-1 ','Dry OC absorption at 550nm')
+ call addfld ('ABSDRYSU',(/'lev'/),'A','m-1 ','Dry sulfate absorption at 550nm')
+ call addfld ('ABSDRYSS',(/'lev'/),'A','m-1 ','Dry sea-salt absorption at 550nm')
+ call addfld ('ABSDRYDU',(/'lev'/),'A','m-1 ','Dry dust absorption at 550nm')
+ call addfld ('OD550DRY',horiz_only,'A','unitless','Dry aerosol optical depth at 550nm')
+ call addfld ('AB550DRY',horiz_only, 'A','unitless','Dry aerosol absorptive optical depth at 550nm')
+ call addfld ('DERLT05 ',horiz_only, 'A','um ','Effective aerosol dry radius<0.5um')
+ call addfld ('DERGT05 ',horiz_only, 'A','um ','Effective aerosol dry radius>0.5um')
+ call addfld ('DER ',horiz_only, 'A','um ','Effective aerosol dry radius')
+ call addfld ('DOD440 ',horiz_only, 'A', 'unitless','Aerosol optical depth at 440nm')
+ call addfld ('ABS440 ',horiz_only, 'A', 'unitless','Aerosol absorptive optical depth at 440nm')
+ call addfld ('DOD500 ',horiz_only, 'A', 'unitless','Aerosol optical depth at 500nm')
+ call addfld ('ABS500 ',horiz_only, 'A', 'unitless','Aerosol absorptive optical depth at 500nm')
+ call addfld ('DOD550 ',horiz_only, 'A','unitless','Aerosol optical depth at 550nm')
+!tst
+! call addfld ('DOD5503D',(/'lev'/),'A','unitless','3D aerosol optical depth at 550 nm')
+! call addfld ('AODVIS3D',(/'lev'/),'A','unitless','3D aerosol optical depth in visible wavelength band')
+!tst
+ call addfld ('ABS550 ',horiz_only, 'A','unitless','Aerosol absorptive optical depth at 550nm')
+ call addfld ('ABS550AL',horiz_only, 'A','unitless','Alt. aerosol absorptive optical depth at 550nm')
+ call addfld ('DOD670 ',horiz_only, 'A','unitless','Aerosol optical depth at 670nm')
+ call addfld ('ABS670 ',horiz_only, 'A','unitless','Aerosol absorptive optical depth at 670nm')
+ call addfld ('DOD870 ',horiz_only, 'A','unitless','Aerosol optical depth at 870nm')
+ call addfld ('ABS870 ',horiz_only, 'A','unitless','Aerosol absorptive optical depth at 870nm')
+ call addfld ('DLOAD_MI',horiz_only, 'A','mg/m2 ','mineral aerosol load')
+ call addfld ('DLOAD_SS',horiz_only, 'A','mg/m2 ','sea-salt aerosol load')
+ call addfld ('DLOAD_S4',horiz_only, 'A','mg/m2 ','sulfate aerosol load')
+ call addfld ('DLOAD_OC',horiz_only, 'A','mg/m2 ','OC aerosol load')
+ call addfld ('DLOAD_BC',horiz_only, 'A','mg/m2 ','BC aerosol load')
+
+ call addfld ('LOADBCAC',horiz_only, 'A','mg/m2 ','BC aerosol coag load')
+ call addfld ('LOADBC0 ',horiz_only, 'A','mg/m2 ','BC aerosol mode 0 load')
+ call addfld ('LOADBC2 ',horiz_only, 'A','mg/m2 ','BC aerosol mode 2 load')
+ call addfld ('LOADBC4 ',horiz_only, 'A','mg/m2 ','BC aerosol mode 4 load')
+ call addfld ('LOADBC12',horiz_only, 'A','mg/m2 ','BC aerosol mode 12 load')
+ call addfld ('LOADBC14',horiz_only, 'A','mg/m2 ','BC aerosol mode 14 load')
+ call addfld ('LOADOCAC',horiz_only, 'A','mg/m2 ','OC aerosol coag load')
+ call addfld ('LOADOC3 ',horiz_only, 'A','mg/m2 ','OC aerosol mode 3 load')
+ call addfld ('LOADOC4 ',horiz_only, 'A','mg/m2 ','OC aerosol mode 4 load')
+ call addfld ('LOADOC13',horiz_only, 'A','mg/m2 ','OC aerosol mode 13 load')
+ call addfld ('LOADOC14',horiz_only, 'A','mg/m2 ','OC aerosol mode 14 load')
+#ifdef COLTST4INTCONS
+ call addfld ('COLRBC0 ',horiz_only, 'A','unitless','COLRAT BC mode 0 load ratio')
+ call addfld ('COLRBC2 ',horiz_only, 'A','unitless','COLRAT BC mode 2 load ratio')
+ call addfld ('COLRBC4 ',horiz_only, 'A','unitless','COLRAT BC mode 4 load ratio')
+ call addfld ('COLRBC12',horiz_only, 'A','unitless','COLRAT BC mode 12 load ratio')
+ call addfld ('COLRBC14',horiz_only, 'A','unitless','COLRAT BC mode 14 load ratio')
+ call addfld ('COLRBCAC',horiz_only, 'A','unitless','COLRAT BC mode AC load ratio')
+ call addfld ('COLROC4 ',horiz_only, 'A','unitless','COLRAT OC mode 4 load ratio')
+ call addfld ('COLROC14',horiz_only, 'A','unitless','COLRAT OC mode 14 load ratio')
+ call addfld ('COLROCAC',horiz_only, 'A','unitless','COLRAT OC mode AC load ratio')
+ call addfld ('COLRSULA',horiz_only, 'A','unitless','COLRAT Sulfate mode A load ratio')
+ call addfld ('COLRSUL1',horiz_only, 'A','unitless','COLRAT Sulfate mode 1 load ratio')
+ call addfld ('COLRSUL5',horiz_only, 'A','unitless','COLRAT Sulfate mode 5 load ratio')
+#endif ! COLTST4INTCONS
+
+!
+ call addfld ('EC550AER',(/'lev'/),'A','m-1 ','aerosol extinction coefficient')
+ call addfld ('ABS550_A',(/'lev'/),'A','m-1 ','aerosol absorption coefficient')
+ call addfld ('BS550AER',(/'lev'/),'A','m-1 sr-1','aerosol backscatter coefficient')
+!
+ call addfld ('EC550SO4',(/'lev'/),'A','m-1 ','SO4 aerosol extinction coefficient')
+ call addfld ('EC550BC ',(/'lev'/),'A','m-1 ','BC aerosol extinction coefficient')
+ call addfld ('EC550POM',(/'lev'/), 'A','m-1 ','POM aerosol extinction coefficient')
+ call addfld ('EC550SS ',(/'lev'/), 'A','m-1 ','SS aerosol extinction coefficient')
+ call addfld ('EC550DU ',(/'lev'/), 'A','m-1 ','DU aerosol extinction coefficient')
+!
+ call addfld ('CDOD440 ',horiz_only, 'A','unitless','Clear air Aerosol optical depth at 440nm')
+ call addfld ('CDOD550 ',horiz_only, 'A','unitless','Clear air Aerosol optical depth at 550nm')
+ call addfld ('CABS550 ',horiz_only, 'A','unitless','Clear air Aerosol abs optical depth at 550nm')
+ call addfld ('CABS550A ',horiz_only, 'A','unitless','Clear air Aerosol abs optical depth at 550nm')
+ call addfld ('CDOD870 ' ,horiz_only, 'A','unitless','Clear air Aerosol optical depth at 870nm')
+ call addfld ('A550_DU ' ,horiz_only, 'A','unitless', 'mineral abs. aerosol optical depth 550nm')
+ call addfld ('A550_SS ' ,horiz_only, 'A','unitless','sea-salt abs aerosol optical depth 550nm')
+ call addfld ('A550_SO4' ,horiz_only, 'A','unitless','SO4 aerosol abs. optical depth 550nm')
+ call addfld ('A550_POM' ,horiz_only, 'A','unitless', 'OC abs. aerosol optical depth 550nm')
+ call addfld ('A550_BC ' ,horiz_only, 'A','unitless', 'BC abs. aerosol optical depth 550nm')
+ call addfld ('D440_DU ',horiz_only, 'A','unitless','mineral aerosol optical depth 440nm')
+ call addfld ('D440_SS ',horiz_only, 'A','unitless','sea-salt aerosol optical depth 440nm')
+ call addfld ('D440_SO4',horiz_only, 'A','unitless','SO4 aerosol optical depth 440nm')
+ call addfld ('D440_POM',horiz_only, 'A','unitless','OC aerosol optical depth 440nm')
+ call addfld ('D440_BC ',horiz_only, 'A','unitless','BC aerosol optical depth 440nm')
+ call addfld ('D500_DU ',horiz_only, 'A','unitless','mineral aerosol optical depth 500nm')
+ call addfld ('D500_SS ',horiz_only, 'A','unitless','sea-salt aerosol optical depth 500nm')
+ call addfld ('D500_SO4',horiz_only, 'A','unitless','SO4 aerosol optical depth 500nm')
+ call addfld ('D500_POM',horiz_only, 'A','unitless','OC aerosol optical depth 500nm')
+ call addfld ('D500_BC ',horiz_only, 'A','unitless','BC aerosol optical depth 500nm')
+ call addfld ('D550_DU ',horiz_only, 'A','unitless','mineral aerosol optical depth 550nm')
+ call addfld ('D550_SS ',horiz_only, 'A','unitless','sea-salt aerosol optical depth 550nm')
+ call addfld ('D550_SO4',horiz_only, 'A','unitless','SO4 aerosol optical depth 550nm')
+ call addfld ('D550_POM',horiz_only, 'A','unitless','OC aerosol optical depth 550nm')
+ call addfld ('D550_BC ',horiz_only, 'A','unitless','BC aerosol optical depth 550nm')
+ call addfld ('D670_DU ',horiz_only, 'A','unitless','mineral aerosol optical depth 670nm')
+ call addfld ('D670_SS ',horiz_only, 'A','unitless','sea-salt aerosol optical depth 670nm')
+ call addfld ('D670_SO4',horiz_only, 'A','unitless','SO4 aerosol optical depth 670nm')
+ call addfld ('D670_POM',horiz_only, 'A','unitless','OC aerosol optical depth 670nm')
+ call addfld ('D670_BC ',horiz_only, 'A','unitless','BC aerosol optical depth 670nm')
+ call addfld ('D870_DU ',horiz_only, 'A','unitless','mineral aerosol optical depth 870nm')
+ call addfld ('D870_SS ',horiz_only, 'A','unitless','sea-salt aerosol optical depth 870nm')
+ call addfld ('D870_SO4',horiz_only, 'A','unitless','SO4 aerosol optical depth 870nm')
+ call addfld ('D870_POM',horiz_only, 'A','unitless','OC aerosol optical depth 870nm')
+ call addfld ('D870_BC ',horiz_only, 'A','unitless','BC aerosol optical depth 870nm')
+ call addfld ('DLT_DUST',horiz_only, 'A','unitless','mineral aerosol optical depth 550nm lt05')
+ call addfld ('DLT_SS ',horiz_only, 'A','unitless','sea-salt aerosol optical depth 550nm lt05')
+ call addfld ('DLT_SO4 ',horiz_only, 'A','unitless','SO4 aerosol optical depth 550nm lt05')
+ call addfld ('DLT_POM ',horiz_only, 'A','unitless','OC aerosol optical depth 550nm lt05')
+ call addfld ('DLT_BC ',horiz_only, 'A','unitless','BC aerosol optical depth 550nm lt05')
+ call addfld ('DGT_DUST',horiz_only, 'A','unitless','mineral aerosol optical depth 550nm gt05')
+ call addfld ('DGT_SS ',horiz_only, 'A','unitless','sea-salt aerosol optical depth 550nm gt05')
+ call addfld ('DGT_SO4 ',horiz_only, 'A','unitless','SO4 aerosol optical depth 550nm gt05')
+ call addfld ('DGT_POM ',horiz_only, 'A','unitless','OC aerosol optical depth 550nm gt05')
+ call addfld ('DGT_BC ',horiz_only, 'A','unitless','BC aerosol optical depth 550nm gt05')
+ call addfld ('AIRMASS ',horiz_only, 'A','kg/m2 ','Vertically integrated airmass') !akc6
+ call addfld ('NNAT_0 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 0 number concentration')
+ call addfld ('NNAT_1 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 1 number concentration')
+ call addfld ('NNAT_2 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 2 number concentration')
+ call addfld ('NNAT_4 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 4 number concentration')
+ call addfld ('NNAT_5 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 5 number concentration')
+ call addfld ('NNAT_6 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 6 number concentration')
+ call addfld ('NNAT_7 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 7 number concentration')
+ call addfld ('NNAT_8 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 8 number concentration')
+ call addfld ('NNAT_9 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 9 number concentration')
+ call addfld ('NNAT_10 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 10 number concentration')
+ call addfld ('NNAT_12 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 12 number concentration')
+ call addfld ('NNAT_14 ',(/'lev'/),'A','1/cm3 ','Aerosol mode 14 number concentration')
+!ak call addfld ('AIRMASS ',(/'lev'/),'A','kg/m3 ','Layer airmass')
+ call addfld ('AIRMASSL',(/'lev'/),'A','kg/m2 ','Layer airmass')
+ call addfld ('BETOTVIS',(/'lev'/),'A','1/km','Aerosol 3d extinction at 0.442-0.625') ! CAM4-Oslo: 0.35-0.64um
+ call addfld ('BATOTVIS',(/'lev'/),'A','1/km','Aerosol 3d absorption at 0.442-0.625') ! CAM4-Oslo: 0.35-0.64um
+ call addfld ('BATSW13 ',(/'lev'/),'A','1/km','Aerosol 3d SW absorption at 3.077-3.846um')
+ call addfld ('BATLW01 ',(/'lev'/),'A','1/km','Aerosol 3d LW absorption depth at 3.077-3.846um')
+!akc6 call addfld ('AERLWA01',(/'lev'/),'A','unitless','CAM5 3d LW absorptive optical depth at 3.077-3.846um')
+!+
+ do i=1,nbmodes
+ modeString=" "
+ write(modeString,"(I2)"),i
+ if(i.lt.10) modeString="0"//adjustl(modeString)
+ varName = "Camrel"//trim(modeString)
+ if(i.ne.3) call addfld(varName, (/'lev'/),'A','unitless', 'relative added mass for mode'//modeString)
+ enddo
+ do i=1,nbmodes
+ modeString=" "
+ write(modeString,"(I2)"),i
+ if(i.lt.10) modeString="0"//adjustl(modeString)
+ varName = "Cxsrel"//trim(modeString)
+ if(i.ne.3) call addfld(varName, horiz_only, 'A', 'unitless', 'relative exessive added mass column for mode'//modeString)
+ enddo
+
+!#ifdef RFMIPIRF
+! do ib=1,nswbands
+! write(c2,'(I2)') ib
+! call addfld('AERTAUBND'//trim(adjustl(c2)), (/'lev'/),'A', 'unitless', 'aerosol extinction optical depth for wavelength band '//trim(adjustl(c2)))
+! call addfld('AERSSABND'//trim(adjustl(c2)), (/'lev'/),'A', 'unitless', 'aerosol single scattering albedo for wavelength band '//c2)
+! call addfld('AERASYBND'//trim(adjustl(c2)), (/'lev'/),'A', 'unitless', 'aerosol asymmetry parameter for wavelength band '//c2)
+!
+! call addfld('SDBND'//trim(adjustl(c2)), (/'ilev'/),'A', 'W/m^2', 'shortwave spectral flux down for wavelength band '//c2)
+! call addfld('SUBND'//trim(adjustl(c2)), (/'ilev'/),'A', 'W/m^2', 'shortwave spectral flux up for wavelength band '//c2)
+! enddo
+! do ib=1,nlwbands
+! write(c2,'(I2)') ib
+! call addfld('LDBND'//trim(adjustl(c2)), (/'ilev'/),'A', 'W/m^2', 'longwave spectral flux down for wavelength band '//c2)
+! call addfld('LUBND'//trim(adjustl(c2)), (/'ilev'/),'A', 'W/m^2', 'longwave spectral flux up for wavelength band '//c2)
+! enddo
+!#endif
+
+#ifdef AEROCOM_INSITU ! Note that this code has not yet been updated to CESM2 standard
+
+ do i=2,6
+
+ irh=RF(i)
+ modeString=" "
+ write(modeString,"(I2)"),irh
+ if(RF(i).eq.0) modeString="00"
+
+!- varName = "EC44RH"//trim(modeString)
+!- call addfld(varName, 'unitless', pver, 'A', '3D EC440 at RH ='//modeString//'%', phys_decomp)
+ varName = "EC55RH"//trim(modeString)
+ call addfld(varName, 'unitless', pver, 'A', '3D EC550 at RH ='//modeString//'%', phys_decomp)
+!- varName = "EC87RH"//trim(modeString)
+!- call addfld(varName, 'unitless', pver, 'A', '3D EC870 at RH ='//modeString//'%', phys_decomp)
+
+!- varName = "AB44RH"//trim(modeString)
+!- call addfld(varName, 'unitless', pver, 'A', '3D ABS440 at RH ='//modeString//'%', phys_decomp)
+ varName = "AB55RH"//trim(modeString)
+ call addfld(varName, 'unitless', pver, 'A', '3D ABS550 at RH ='//modeString//'%', phys_decomp)
+!- varName = "AB87RH"//trim(modeString)
+!- call addfld(varName, 'unitless', pver, 'A', '3D ABS870 at RH ='//modeString//'%', phys_decomp)
+
+ enddo
+
+#endif ! AEROCOM_INSITU
+
+#endif ! aerocom
+#endif ! dirind
+
+#endif ! OSLO_AERO
+
+
+ if (history_amwg) then
+ call add_default ('PHIS ' , 1, ' ')
+ call add_default ('PS ' , 1, ' ')
+ call add_default ('T ' , 1, ' ')
+ call add_default ('U ' , 1, ' ')
+ call add_default ('V ' , 1, ' ')
+ call add_default ('Z3 ' , 1, ' ')
+ call add_default ('OMEGA ' , 1, ' ')
+ call add_default ('VT ', 1, ' ')
+ call add_default ('VU ', 1, ' ')
+ call add_default ('VV ', 1, ' ')
+ call add_default ('UU ', 1, ' ')
+ call add_default ('OMEGAT ', 1, ' ')
+ call add_default ('PSL ', 1, ' ')
+ end if
+
+ if (history_vdiag) then
+ call add_default ('U200', 2, ' ')
+ call add_default ('V200', 2, ' ')
+ call add_default ('U850', 2, ' ')
+ call add_default ('U200', 3, ' ')
+ call add_default ('U850', 3, ' ')
+ call add_default ('OMEGA500', 3, ' ')
+ end if
+
+ if (history_eddy) then
+ call add_default ('VT ', 1, ' ')
+ call add_default ('VU ', 1, ' ')
+ call add_default ('VV ', 1, ' ')
+ call add_default ('UU ', 1, ' ')
+ call add_default ('OMEGAT ', 1, ' ')
+ call add_default ('OMEGAU ', 1, ' ')
+ call add_default ('OMEGAV ', 1, ' ')
+ endif
+
+ if ( history_budget ) then
+ call add_default ('PHIS ' , history_budget_histfile_num, ' ')
+ call add_default ('PS ' , history_budget_histfile_num, ' ')
+ call add_default ('T ' , history_budget_histfile_num, ' ')
+ call add_default ('U ' , history_budget_histfile_num, ' ')
+ call add_default ('V ' , history_budget_histfile_num, ' ')
+ call add_default ('TTEND_TOT' , history_budget_histfile_num, ' ')
+
+ ! State before physics (FV)
+ call add_default ('TBP ' , history_budget_histfile_num, ' ')
+ call add_default (bpcnst(1) , history_budget_histfile_num, ' ')
+ ! State after physics (FV)
+ call add_default ('TAP ' , history_budget_histfile_num, ' ')
+ call add_default ('UAP ' , history_budget_histfile_num, ' ')
+ call add_default ('VAP ' , history_budget_histfile_num, ' ')
+ call add_default (apcnst(1) , history_budget_histfile_num, ' ')
+ if ( dycore_is('LR') .or. dycore_is('SE') ) then
+ call add_default ('TFIX ' , history_budget_histfile_num, ' ')
+!+tht
+ call add_default ('EBREAK ' , history_budget_histfile_num, ' ')
+ call add_default ('PTTEND_DME', history_budget_histfile_num, ' ')
+ call add_default ('IETEND_DME', history_budget_histfile_num, ' ')
+ call add_default ('EFLX ' , history_budget_histfile_num, ' ')
+!-tht
+ end if
+ end if
+
+ if (history_waccm) then
+ call add_default ('PHIS', 7, ' ')
+ call add_default ('PS', 7, ' ')
+ call add_default ('PSL', 7, ' ')
+ end if
+
+ ! outfld calls in diag_phys_tend_writeout
+ call addfld ('PTTEND', (/ 'lev' /), 'A', 'K/s','T total physics tendency' )
+ if ( history_budget ) then
+ call add_default ('PTTEND' , history_budget_histfile_num, ' ')
+ end if
+
+!akc6+ CNVCLD is zero
+! call add_default ('CNVCLD ', 1, ' ')
+!akc6-
+
+ ! create history variables for fourier coefficients of the diurnal
+ ! and semidiurnal tide in T, U, V, and Z3
+ call tidal_diag_init()
+
+ !
+ ! energy diagnostics
+ !
+ call addfld ('SE_pBF', horiz_only, 'A', 'J/m2','Dry Static Energy before energy fixer')
+ call addfld ('SE_pBP', horiz_only, 'A', 'J/m2','Dry Static Energy before parameterizations')
+ call addfld ('SE_pAP', horiz_only, 'A', 'J/m2','Dry Static Energy after parameterizations')
+ call addfld ('SE_pAM', horiz_only, 'A', 'J/m2','Dry Static Energy after dry mass correction')
+
+ call addfld ('KE_pBF', horiz_only, 'A', 'J/m2','Kinetic Energy before energy fixer')
+ call addfld ('KE_pBP', horiz_only, 'A', 'J/m2','Kinetic Energy before parameterizations')
+ call addfld ('KE_pAP', horiz_only, 'A', 'J/m2','Kinetic Energy after parameterizations')
+ call addfld ('KE_pAM', horiz_only, 'A', 'J/m2','Kinetic Energy after dry mass correction')
+
+ call addfld ('TT_pBF', horiz_only, 'A', 'kg/m2','Total column test tracer before energy fixer')
+ call addfld ('TT_pBP', horiz_only, 'A', 'kg/m2','Total column test tracer before parameterizations')
+ call addfld ('TT_pAP', horiz_only, 'A', 'kg/m2','Total column test tracer after parameterizations')
+ call addfld ('TT_pAM', horiz_only, 'A', 'kg/m2','Total column test tracer after dry mass correction')
+
+ call addfld ('WV_pBF', horiz_only, 'A', 'kg/m2','Total column water vapor before energy fixer')
+ call addfld ('WV_pBP', horiz_only, 'A', 'kg/m2','Total column water vapor before parameterizations')
+ call addfld ('WV_pAP', horiz_only, 'A', 'kg/m2','Total column water vapor after parameterizations')
+ call addfld ('WV_pAM', horiz_only, 'A', 'kg/m2','Total column water vapor after dry mass correction')
+
+ call addfld ('WL_pBF', horiz_only, 'A', 'kg/m2','Total column cloud water before energy fixer')
+ call addfld ('WL_pBP', horiz_only, 'A', 'kg/m2','Total column cloud water before parameterizations')
+ call addfld ('WL_pAP', horiz_only, 'A', 'kg/m2','Total column cloud water after parameterizations')
+ call addfld ('WL_pAM', horiz_only, 'A', 'kg/m2','Total column cloud water after dry mass correction')
+
+ call addfld ('WI_pBF', horiz_only, 'A', 'kg/m2','Total column cloud ice before energy fixer')
+ call addfld ('WI_pBP', horiz_only, 'A', 'kg/m2','Total column cloud ice before parameterizations')
+ call addfld ('WI_pAP', horiz_only, 'A', 'kg/m2','Total column cloud ice after parameterizations')
+ call addfld ('WI_pAM', horiz_only, 'A', 'kg/m2','Total column cloud ice after dry mass correction')
+ !
+ ! Axial Angular Momentum diagnostics
+ !
+ call addfld ('MR_pBF', horiz_only, 'A', 'kg*m2/s*rad2',&
+ 'Total column wind axial angular momentum before energy fixer')
+ call addfld ('MR_pBP', horiz_only, 'A', 'kg*m2/s*rad2',&
+ 'Total column wind axial angular momentum before parameterizations')
+ call addfld ('MR_pAP', horiz_only, 'A', 'kg*m2/s*rad2',&
+ 'Total column wind axial angular momentum after parameterizations')
+ call addfld ('MR_pAM', horiz_only, 'A', 'kg*m2/s*rad2',&
+ 'Total column wind axial angular momentum after dry mass correction')
+
+ call addfld ('MO_pBF', horiz_only, 'A', 'kg*m2/s*rad2',&
+ 'Total column mass axial angular momentum before energy fixer')
+ call addfld ('MO_pBP', horiz_only, 'A', 'kg*m2/s*rad2',&
+ 'Total column mass axial angular momentum before parameterizations')
+ call addfld ('MO_pAP', horiz_only, 'A', 'kg*m2/s*rad2',&
+ 'Total column mass axial angular momentum after parameterizations')
+ call addfld ('MO_pAM', horiz_only, 'A', 'kg*m2/s*rad2',&
+ 'Total column mass axial angular momentum after dry mass correction')
+
+#ifdef DIRIND
+ call add_default ('AOD_VIS ', 1, ' ')
+ call add_default ('ABSVIS ', 1, ' ')
+ call add_default ('AODVVOLC', 1, ' ')
+ call add_default ('ABSVVOLC', 1, ' ')
+ call add_default ('DAYFOC ', 1, ' ')
+ call add_default ('CAODVIS ', 1, ' ')
+ call add_default ('CABSVIS ', 1, ' ')
+ call add_default ('CLDFREE ', 1, ' ')
+ call add_default ('N_AER ', 1, ' ')
+#ifdef COLTST4INTCONS
+ call add_default ('TAUKC0 ', 1, ' ')
+ call add_default ('TAUKC1 ', 1, ' ')
+ call add_default ('TAUKC2 ', 1, ' ')
+ call add_default ('TAUKC4 ', 1, ' ')
+ call add_default ('TAUKC5 ', 1, ' ')
+ call add_default ('TAUKC6 ', 1, ' ')
+ call add_default ('TAUKC7 ', 1, ' ')
+ call add_default ('TAUKC8 ', 1, ' ')
+ call add_default ('TAUKC9 ', 1, ' ')
+ call add_default ('TAUKC10', 1, ' ')
+ call add_default ('TAUKC12', 1, ' ')
+ call add_default ('TAUKC14', 1, ' ')
+!
+ call add_default ('MECKC0 ', 1, ' ')
+ call add_default ('MECKC1 ', 1, ' ')
+ call add_default ('MECKC2 ', 1, ' ')
+ call add_default ('MECKC4 ', 1, ' ')
+ call add_default ('MECKC5 ', 1, ' ')
+ call add_default ('MECKC6 ', 1, ' ')
+ call add_default ('MECKC7 ', 1, ' ')
+ call add_default ('MECKC8 ', 1, ' ')
+ call add_default ('MECKC9 ', 1, ' ')
+ call add_default ('MECKC10', 1, ' ')
+ call add_default ('MECKC12', 1, ' ')
+ call add_default ('MECKC14', 1, ' ')
+#ifdef AEROCOM
+ call add_default ('CMDRY0 ', 1, ' ')
+ call add_default ('CMDRY1 ', 1, ' ')
+ call add_default ('CMDRY2 ', 1, ' ')
+ call add_default ('CMDRY4 ', 1, ' ')
+ call add_default ('CMDRY5 ', 1, ' ')
+ call add_default ('CMDRY6 ', 1, ' ')
+ call add_default ('CMDRY7 ', 1, ' ')
+ call add_default ('CMDRY8 ', 1, ' ')
+ call add_default ('CMDRY9 ', 1, ' ')
+ call add_default ('CMDRY10', 1, ' ')
+ call add_default ('CMDRY12', 1, ' ')
+ call add_default ('CMDRY14', 1, ' ')
+#endif
+#endif
+!- call add_default ('N_AERORG', 1, ' ')
+ call add_default ('SSAVIS ', 1, ' ')
+ call add_default ('ASYMMVIS', 1, ' ')
+ call add_default ('EXTVIS ', 1, ' ')
+!=0 call add_default ('RELH ', 1, ' ')
+!akc6+
+ call add_default ('BVISVOLC', 1, ' ')
+!akc6-
+!#ifdef SPAERO
+! call add_default ('AODVISSP', 1, ' ')
+! call add_default ('ABSVISSP', 1, ' ')
+! call add_default ('XCDNC_SP', 1, ' ')
+! call add_default ('AODV3DSP', 1, ' ')
+! call add_default ('ABSV3DSP', 1, ' ')
+!#endif
+#ifdef AEROFFL
+ call add_default ('FSNT_DRF', 1, ' ')
+ call add_default ('FSNTCDRF', 1, ' ')
+ call add_default ('FSNS_DRF', 1, ' ')
+ call add_default ('FSNSCDRF', 1, ' ')
+ call add_default ('QRS_DRF ', 1, ' ')
+ call add_default ('QRSC_DRF', 1, ' ')
+ call add_default ('FLNT_DRF', 1, ' ')
+ call add_default ('FLNTCDRF', 1, ' ')
+ call add_default ('FSUTADRF', 1, ' ')
+ call add_default ('FSDS_DRF', 1, ' ')
+ call add_default ('FSUS_DRF', 1, ' ')
+ call add_default ('FSDSCDRF', 1, ' ')
+ call add_default ('FLUS ', 1, ' ')
+!->ut call add_default ('FLNT_ORG', 1, ' ')
+#endif ! aeroffl
+#ifdef AEROCOM
+ call add_default ('AKCXS ', 1, ' ')
+ call add_default ('PMTOT ', 1, ' ')
+ call add_default ('PM25 ', 1, ' ')
+!akc6+
+ call add_default ('PM2P5 ', 1, ' ')
+ call add_default ('MMRPM2P5', 1, ' ')
+ call add_default ('MMRPM1 ', 1, ' ')
+!akc6-
+ call add_default ('GRIDAREA', 1, ' ')
+ call add_default ('DAERH2O ', 1, ' ')
+ call add_default ('MMR_AH2O', 1, ' ')
+ call add_default ('ECDRYAER', 1, ' ')
+ call add_default ('ABSDRYAE', 1, ' ')
+ call add_default ('ECDRY440', 1, ' ')
+ call add_default ('ABSDR440', 1, ' ')
+ call add_default ('ECDRY870', 1, ' ')
+ call add_default ('ABSDR870', 1, ' ')
+ call add_default ('ASYMMDRY', 1, ' ')
+ call add_default ('ECDRYLT1', 1, ' ')
+ call add_default ('ABSDRYBC', 1, ' ')
+ call add_default ('ABSDRYOC', 1, ' ')
+ call add_default ('ABSDRYSU', 1, ' ')
+ call add_default ('ABSDRYSS', 1, ' ')
+ call add_default ('ABSDRYDU', 1, ' ')
+ call add_default ('OD550DRY', 1, ' ')
+ call add_default ('AB550DRY', 1, ' ')
+ call add_default ('DERLT05 ', 1, ' ')
+ call add_default ('DERGT05 ', 1, ' ')
+ call add_default ('DER ', 1, ' ')
+ call add_default ('DOD440 ', 1, ' ')
+ call add_default ('ABS440 ', 1, ' ')
+ call add_default ('DOD500 ', 1, ' ')
+ call add_default ('ABS500 ', 1, ' ')
+ call add_default ('DOD550 ', 1, ' ')
+!tst
+! call add_default ('DOD5503D', 1, ' ')
+! call add_default ('AODVIS3D', 1, ' ')
+!tst
+ call add_default ('ABS550 ', 1, ' ')
+ call add_default ('ABS550AL', 1, ' ')
+ call add_default ('DOD670 ', 1, ' ')
+ call add_default ('ABS670 ', 1, ' ')
+ call add_default ('DOD870 ', 1, ' ')
+ call add_default ('ABS870 ', 1, ' ')
+ call add_default ('DLOAD_MI', 1, ' ')
+ call add_default ('DLOAD_SS', 1, ' ')
+ call add_default ('DLOAD_S4', 1, ' ')
+ call add_default ('DLOAD_OC', 1, ' ')
+ call add_default ('DLOAD_BC', 1, ' ')
+ call add_default ('LOADBCAC', 1, ' ')
+ call add_default ('LOADBC0 ', 1, ' ')
+ call add_default ('LOADBC2 ', 1, ' ')
+ call add_default ('LOADBC4 ', 1, ' ')
+ call add_default ('LOADBC12', 1, ' ')
+ call add_default ('LOADBC14', 1, ' ')
+ call add_default ('LOADOCAC', 1, ' ')
+ call add_default ('LOADOC4 ', 1, ' ')
+ call add_default ('LOADOC14', 1, ' ')
+#ifdef COLTST4INTCONS
+ call add_default ('COLRBC0 ', 1, ' ')
+ call add_default ('COLRBC2 ', 1, ' ')
+ call add_default ('COLRBC4 ', 1, ' ')
+ call add_default ('COLRBC12', 1, ' ')
+ call add_default ('COLRBC14', 1, ' ')
+ call add_default ('COLRBCAC', 1, ' ')
+ call add_default ('COLROC4 ', 1, ' ')
+ call add_default ('COLROC14', 1, ' ')
+ call add_default ('COLROCAC', 1, ' ')
+ call add_default ('COLRSULA', 1, ' ')
+ call add_default ('COLRSUL1', 1, ' ')
+ call add_default ('COLRSUL5', 1, ' ')
+#endif ! COLTST4INTCONS
+!
+ call add_default ('EC550AER', 1, ' ')
+ call add_default ('ABS550_A', 1, ' ')
+ call add_default ('BS550AER', 1, ' ')
+!
+ call add_default ('EC550SO4', 1, ' ')
+ call add_default ('EC550BC ', 1, ' ')
+ call add_default ('EC550POM', 1, ' ')
+ call add_default ('EC550SS ', 1, ' ')
+ call add_default ('EC550DU ', 1, ' ')
+!
+ call add_default ('CDOD440 ', 1, ' ')
+ call add_default ('CDOD550 ', 1, ' ')
+ call add_default ('CABS550 ', 1, ' ')
+ call add_default ('CABS550A', 1, ' ')
+ call add_default ('CDOD870 ', 1, ' ')
+ call add_default ('A550_DU ', 1, ' ')
+ call add_default ('A550_SS ', 1, ' ')
+ call add_default ('A550_SO4', 1, ' ')
+ call add_default ('A550_POM', 1, ' ')
+ call add_default ('A550_BC ', 1, ' ')
+ call add_default ('D440_DU ', 1, ' ')
+ call add_default ('D440_SS ', 1, ' ')
+ call add_default ('D440_SO4', 1, ' ')
+ call add_default ('D440_POM', 1, ' ')
+ call add_default ('D440_BC ', 1, ' ')
+ call add_default ('D500_DU ', 1, ' ')
+ call add_default ('D500_SS ', 1, ' ')
+ call add_default ('D500_SO4', 1, ' ')
+ call add_default ('D500_POM', 1, ' ')
+ call add_default ('D500_BC ', 1, ' ')
+ call add_default ('D550_DU ', 1, ' ')
+ call add_default ('D550_SS ', 1, ' ')
+ call add_default ('D550_SO4', 1, ' ')
+ call add_default ('D550_POM', 1, ' ')
+ call add_default ('D550_BC ', 1, ' ')
+ call add_default ('D670_DU ', 1, ' ')
+ call add_default ('D670_SS ', 1, ' ')
+ call add_default ('D670_SO4', 1, ' ')
+ call add_default ('D670_POM', 1, ' ')
+ call add_default ('D670_BC ', 1, ' ')
+ call add_default ('D870_DU ', 1, ' ')
+ call add_default ('D870_SS ', 1, ' ')
+ call add_default ('D870_SO4', 1, ' ')
+ call add_default ('D870_POM', 1, ' ')
+ call add_default ('D870_BC ', 1, ' ')
+ call add_default ('DLT_DUST', 1, ' ')
+ call add_default ('DLT_SS ', 1, ' ')
+ call add_default ('DLT_SO4 ', 1, ' ')
+ call add_default ('DLT_POM ', 1, ' ')
+ call add_default ('DLT_BC ', 1, ' ')
+ call add_default ('DGT_DUST', 1, ' ')
+ call add_default ('DGT_SS ', 1, ' ')
+ call add_default ('DGT_SO4 ', 1, ' ')
+ call add_default ('DGT_POM ', 1, ' ')
+ call add_default ('DGT_BC ', 1, ' ')
+ call add_default ('NNAT_0 ', 1, ' ')
+ call add_default ('NNAT_1 ', 1, ' ')
+ call add_default ('NNAT_2 ', 1, ' ')
+ call add_default ('NNAT_4 ', 1, ' ')
+ call add_default ('NNAT_5 ', 1, ' ')
+ call add_default ('NNAT_6 ', 1, ' ')
+ call add_default ('NNAT_7 ', 1, ' ')
+ call add_default ('NNAT_8 ', 1, ' ')
+ call add_default ('NNAT_9 ', 1, ' ')
+ call add_default ('NNAT_10 ', 1, ' ')
+ call add_default ('NNAT_12 ', 1, ' ')
+ call add_default ('NNAT_14 ', 1, ' ')
+ call add_default ('AIRMASSL', 1, ' ') !akc6
+ call add_default ('AIRMASS ', 1, ' ') !akc6
+ call add_default ('BETOTVIS', 1, ' ')
+ call add_default ('BATOTVIS', 1, ' ')
+ call add_default ('BATSW13 ', 1, ' ')
+ call add_default ('BATLW01 ', 1, ' ')
+!akc6 call add_default ('AERLWA01', 1, ' ')
+!+
+ do i=1,nbmodes
+ modeString=" "
+ write(modeString,"(I2)"),i
+ if(i.lt.10) modeString="0"//adjustl(modeString)
+ varName = "Camrel"//trim(modeString)
+ if(i.ne.3) call add_default(varName, 1, ' ')
+ enddo
+ do i=1,nbmodes
+ modeString=" "
+ write(modeString,"(I2)"),i
+ if(i.lt.10) modeString="0"//adjustl(modeString)
+ varName = "Cxsrel"//trim(modeString)
+ if(i.ne.3) call add_default(varName, 1, ' ')
+ enddo
+!++
+
+!#ifdef RFMIPIRF
+! do i=1,nbands
+! do ib=1,nswbands
+! write(c2,'(I2)') ib
+! call add_default('AERTAUBND'//trim(adjustl(c2)), 1, ' ')
+! call add_default('AERSSABND'//trim(adjustl(c2)), 1, ' ')
+! call add_default('AERASYBND'//trim(adjustl(c2)), 1, ' ')
+!
+! call add_default('SDBND'//trim(adjustl(c2)), 1, ' ')
+! call add_default('SUBND'//trim(adjustl(c2)), 1, ' ')
+! enddo
+! do ib=1,nlwbands
+! write(c2,'(I2)') ib
+! call add_default('LDBND'//trim(adjustl(c2)), 1, ' ')
+! call add_default('LUBND'//trim(adjustl(c2)), 1, ' ')
+! enddo
+!#endif
+
+
+#ifdef AEROCOM_INSITU
+
+ do i=2,6
+
+ irh=RF(i)
+ modeString=" "
+ write(modeString,"(I2)"),irh
+ if(RF(i).eq.0) modeString="00"
+
+!- varName = "EC44RH"//trim(modeString)
+!- call add_default(varName, 1, ' ')
+ varName = "EC55RH"//trim(modeString)
+ call add_default(varName, 1, ' ')
+!- varName = "EC87RH"//trim(modeString)
+!- call add_default(varName, 1, ' ')
+
+!- varName = "AB44RH"//trim(modeString)
+!- call add_default(varName, 1, ' ')
+ varName = "AB55RH"//trim(modeString)
+ call add_default(varName, 1, ' ')
+!- varName = "AB87RH"//trim(modeString)
+!- call add_default(varName, 1, ' ')
+
+ enddo
+
+#endif ! AEROCOM_INSITU
+
+!--
+!-
+#endif ! aerocom
+#endif ! dirind
+
+!#ifdef SPAERO
+! call addfld ('FSNT_SP ', horiz_only, 'A','W/m^2','Total column absorbed solar flux (without SP aerosols)')
+! call addfld ('FSNTC_SP', horiz_only, 'A','W/m^2','Clear sky total column absorbed solar flux (without SP aerosols)')
+! call addfld ('FSNS_SP ', horiz_only, 'A','W/m^2','Surface absorbed solar flux (without SP aerosols)')
+! call addfld ('FSNSC_SP', horiz_only, 'A','W/m^2','Clear sky surface absorbed solar flux (without SP aerosols)')
+! call addfld ('FSNT_SP2', horiz_only, 'A','W/m^2','Total column absorbed solar flux (SP aerosols for DRF only)')
+! call addfld ('FSNTCSP2', horiz_only, 'A','W/m^2','Clear sky total column absorbed solar flux (SP aerosols for DRF only)')
+! call addfld ('FSNS_SP2', horiz_only, 'A','W/m^2','Surface absorbed solar flux (SP aerosols for DRF only)')
+! call addfld ('FSNSCSP2', horiz_only, 'A','W/m^2','Clear sky surface absorbed solar flux (SP aerosols for DRF only)')
+! call addfld ('FSNT_SP3', horiz_only, 'A','W/m^2','Total column absorbed solar flux (SP aerosols)')
+! call addfld ('FSNTCSP3', horiz_only, 'A','W/m^2','Clear sky total column absorbed solar flux (SP aerosols)')
+! call addfld ('FSNS_SP3', horiz_only, 'A','W/m^2','Surface absorbed solar flux (SP aerosols)')
+! call addfld ('FSNSCSP3', horiz_only, 'A','W/m^2','Clear sky surface absorbed solar flux (SP aerosols)')
+! call add_default ('FSNT_SP' , 1, ' ')
+! call add_default ('FSNTC_SP', 1, ' ')
+! call add_default ('FSNS_SP' , 1, ' ')
+! call add_default ('FSNSC_SP', 1, ' ')
+! call add_default ('FSNT_SP2', 1, ' ')
+! call add_default ('FSNTCSP2', 1, ' ')
+! call add_default ('FSNS_SP2', 1, ' ')
+! call add_default ('FSNSCSP2', 1, ' ')
+! call add_default ('FSNT_SP3', 1, ' ')
+! call add_default ('FSNTCSP3', 1, ' ')
+! call add_default ('FSNS_SP3', 1, ' ')
+! call add_default ('FSNSCSP3', 1, ' ')
+!#endif
+
+ end subroutine diag_init_dry
+
+ subroutine diag_init_moist(pbuf2d)
+
+ ! Declare the history fields for which this module contains outfld calls.
+
+ use cam_history, only: addfld, add_default, horiz_only
+ use cam_history, only: register_vector_field
+ use constituent_burden, only: constituent_burden_init
+ use physics_buffer, only: pbuf_set_field
+
+ type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:)
+
+ integer :: k, m
+ integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water.
+ integer :: ierr
+ !AL
+ integer :: ixcldnc
+ integer :: ixcldni
+ !AL
+ ! column burdens for all constituents except water vapor
+ call constituent_burden_init
+
+ call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.)
+ call cnst_get_ind('CLDICE', ixcldice, abort=.false.)
+
+ ! outfld calls in diag_phys_writeout
+ call addfld ('OMEGAQ', (/ 'lev' /), 'A', 'kgPa/kgs', 'Vertical water transport' )
+ call addfld ('VQ', (/ 'lev' /), 'A', 'm/skg/kg', 'Meridional water transport')
+ call addfld ('QQ', (/ 'lev' /), 'A', 'kg2/kg2', 'Eddy moisture variance')
+
+ call addfld ('MQ', (/ 'lev' /), 'A', 'kg/m2','Water vapor mass in layer')
+ call addfld ('TMQ', horiz_only, 'A', 'kg/m2','Total (vertically integrated) precipitable water')
+ call addfld ('RELHUM', (/ 'lev' /), 'A', 'percent','Relative humidity')
+ call addfld ('RHW', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to liquid')
+ call addfld ('RHI', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to ice')
+ call addfld ('RHCFMIP', (/ 'lev' /), 'A', 'percent','Relative humidity with respect to water above 273 K, ice below 273 K')
+
+ call addfld ('THE8501000', horiz_only, 'A', 'K','ThetaE difference 850 mb - 1000 mb')
+ call addfld ('THE9251000', horiz_only, 'A', 'K','ThetaE difference 925 mb - 1000 mb')
+
+ call addfld ('Q1000', horiz_only, 'A', 'kg/kg','Specific Humidity at 1000 mbar pressure surface')
+ call addfld ('Q925', horiz_only, 'A', 'kg/kg','Specific Humidity at 925 mbar pressure surface')
+ call addfld ('Q850', horiz_only, 'A', 'kg/kg','Specific Humidity at 850 mbar pressure surface')
+ call addfld ('Q200', horiz_only, 'A', 'kg/kg','Specific Humidity at 700 mbar pressure surface')
+ call addfld ('QBOT', horiz_only, 'A', 'kg/kg','Lowest model level water vapor mixing ratio')
+
+ call addfld ('PSDRY', horiz_only, 'A', 'Pa', 'Dry surface pressure')
+ call addfld ('PMID', (/ 'lev' /), 'A', 'Pa', 'Pressure at layer midpoints')
+ call addfld ('PDELDRY', (/ 'lev' /), 'A', 'Pa', 'Dry pressure difference between levels')
+
+ ! outfld calls in diag_conv
+
+ call addfld ('DTCOND', (/ 'lev' /), 'A','K/s','T tendency - moist processes')
+ call addfld ('DTCOND_24_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 24hr. cos coeff.')
+ call addfld ('DTCOND_24_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 24hr. sin coeff.')
+ call addfld ('DTCOND_12_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 12hr. cos coeff.')
+ call addfld ('DTCOND_12_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 12hr. sin coeff.')
+ call addfld ('DTCOND_08_COS',(/ 'lev' /), 'A','K/s','T tendency - moist processes 8hr. cos coeff.')
+ call addfld ('DTCOND_08_SIN',(/ 'lev' /), 'A','K/s','T tendency - moist processes 8hr. sin coeff.')
+!AL
+ call cnst_get_ind('NUMLIQ', ixcldnc)
+ call cnst_get_ind('NUMICE', ixcldni)
+!AL
+
+ call addfld ('PRECL', horiz_only, 'A', 'm/s','Large-scale (stable) precipitation rate (liq + ice)' )
+ call addfld ('PRECC', horiz_only, 'A', 'm/s','Convective precipitation rate (liq + ice)' )
+ call addfld ('PRECT', horiz_only, 'A', 'm/s','Total (convective and large-scale) precipitation rate (liq + ice)' )
+ call addfld ('PREC_PCW', horiz_only, 'A', 'm/s','LS_pcw precipitation rate')
+ call addfld ('PREC_zmc', horiz_only, 'A', 'm/s','CV_zmc precipitation rate')
+ call addfld ('PRECTMX', horiz_only, 'X','m/s','Maximum (convective and large-scale) precipitation rate (liq+ice)' )
+ call addfld ('PRECSL', horiz_only, 'A', 'm/s','Large-scale (stable) snow rate (water equivalent)' )
+ call addfld ('PRECSC', horiz_only, 'A', 'm/s','Convective snow rate (water equivalent)' )
+ call addfld ('PRECCav', horiz_only, 'A', 'm/s','Average large-scale precipitation (liq + ice)' )
+ call addfld ('PRECLav', horiz_only, 'A', 'm/s','Average convective precipitation (liq + ice)' )
+
+ ! outfld calls in diag_surf
+
+ call addfld ('SHFLX', horiz_only, 'A', 'W/m2','Surface sensible heat flux')
+ call addfld ('LHFLX', horiz_only, 'A', 'W/m2','Surface latent heat flux')
+ call addfld ('QFLX', horiz_only, 'A', 'kg/m2/s','Surface water flux')
+
+ call addfld ('TAUX', horiz_only, 'A', 'N/m2','Zonal surface stress')
+ call addfld ('TAUY', horiz_only, 'A', 'N/m2','Meridional surface stress')
+ call addfld ('TREFHT', horiz_only, 'A', 'K','Reference height temperature')
+ call addfld ('TREFHTMN', horiz_only, 'M','K','Minimum reference height temperature over output period')
+ call addfld ('TREFHTMX', horiz_only, 'X','K','Maximum reference height temperature over output period')
+ call addfld ('QREFHT', horiz_only, 'A', 'kg/kg','Reference height humidity')
+ call addfld ('U10', horiz_only, 'A', 'm/s','10m wind speed')
+ call addfld ('RHREFHT', horiz_only, 'A', 'fraction','Reference height relative humidity')
+
+ call addfld ('LANDFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by land')
+ call addfld ('ICEFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by sea-ice')
+ call addfld ('OCNFRAC', horiz_only, 'A', 'fraction','Fraction of sfc area covered by ocean')
+
+ call addfld ('TREFMNAV', horiz_only, 'A', 'K','Average of TREFHT daily minimum')
+ call addfld ('TREFMXAV', horiz_only, 'A', 'K','Average of TREFHT daily maximum')
+
+ call addfld ('TS', horiz_only, 'A', 'K','Surface temperature (radiative)')
+ call addfld ('TSMN', horiz_only, 'M','K','Minimum surface temperature over output period')
+ call addfld ('TSMX', horiz_only, 'X','K','Maximum surface temperature over output period')
+ call addfld ('SNOWHLND', horiz_only, 'A', 'm','Water equivalent snow depth')
+ call addfld ('SNOWHICE', horiz_only, 'A', 'm','Snow depth over ice', fill_value = 1.e30_r8)
+ call addfld ('TBOT', horiz_only, 'A', 'K','Lowest model level temperature')
+
+ call addfld ('ASDIR', horiz_only, 'A', '1','albedo: shortwave, direct')
+ call addfld ('ASDIF', horiz_only, 'A', '1','albedo: shortwave, diffuse')
+ call addfld ('ALDIR', horiz_only, 'A', '1','albedo: longwave, direct')
+ call addfld ('ALDIF', horiz_only, 'A', '1','albedo: longwave, diffuse')
+ call addfld ('SST', horiz_only, 'A', 'K','sea surface temperature')
+
+
+ ! outfld calls in diag_phys_tend_writeout
+
+ call addfld (ptendnam( 1),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name( 1))//' total physics tendency ' )
+
+ if (ixcldliq > 0) then
+ call addfld (ptendnam(ixcldliq),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldliq))//' total physics tendency ' )
+ end if
+ if (ixcldice > 0) then
+ call addfld (ptendnam(ixcldice),(/ 'lev' /), 'A', 'kg/kg/s',trim(cnst_name(ixcldice))//' total physics tendency ')
+ end if
+!AL
+ call addfld (ptendnam(ixcldnc), (/ 'lev' /), 'A', '#/kg/s ',trim(cnst_name(ixcldnc))//' total physics tendency ')
+ call addfld (ptendnam(ixcldni), (/ 'lev' /), 'A', '#/kg/s ',trim(cnst_name(ixcldni))//' total physics tendency ')
+!AL
+ if ( dycore_is('LR') )then
+ call addfld (dmetendnam( 1),(/ 'lev' /), 'A','kg/kg/s', &
+ trim(cnst_name( 1))//' dme adjustment tendency (FV) ')
+ if (ixcldliq > 0) then
+ call addfld (dmetendnam(ixcldliq),(/ 'lev' /), 'A','kg/kg/s', &
+ trim(cnst_name(ixcldliq))//' dme adjustment tendency (FV) ')
+ end if
+ if (ixcldice > 0) then
+ call addfld (dmetendnam(ixcldice),(/ 'lev' /), 'A','kg/kg/s', &
+ trim(cnst_name(ixcldice))//' dme adjustment tendency (FV) ')
+ end if
+!AL
+ call addfld (dmetendnam(ixcldnc),(/ 'lev' /), 'A','#/kg/s ', &
+ trim(cnst_name(ixcldnc))//' dme adjustment tendency (FV) ')
+ call addfld (dmetendnam(ixcldni),(/ 'lev' /), 'A','#/kg/s ', &
+ trim(cnst_name(ixcldni))//' dme adjustment tendency (FV) ')
+!AL
+ end if
+
+ if ( history_budget ) then
+!AL
+ call add_default (ptendnam(ixcldnc), history_budget_histfile_num, ' ')
+ call add_default (ptendnam(ixcldni), history_budget_histfile_num, ' ')
+!AL
+ end if
+
+ ! outfld calls in diag_physvar_ic
+
+ call addfld ('QCWAT&IC', (/ 'lev' /), 'I','kg/kg','q associated with cloud water' )
+ call addfld ('TCWAT&IC', (/ 'lev' /), 'I','kg/kg','T associated with cloud water' )
+ call addfld ('LCWAT&IC', (/ 'lev' /), 'I','kg/kg','Cloud water (ice + liq' )
+ call addfld ('CLOUD&IC', (/ 'lev' /), 'I','fraction','Cloud fraction' )
+ call addfld ('CONCLD&IC', (/ 'lev' /), 'I','fraction','Convective cloud fraction' )
+ call addfld ('TKE&IC', (/ 'ilev' /), 'I','m2/s2','Turbulent Kinetic Energy' )
+ call addfld ('CUSH&IC', horiz_only, 'I','m','Convective Scale Height' )
+ call addfld ('KVH&IC', (/ 'ilev' /), 'I','m2/s','Vertical diffusion diffusivities (heat/moisture)' )
+ call addfld ('KVM&IC', (/ 'ilev' /), 'I','m2/s','Vertical diffusion diffusivities (momentum)' )
+ call addfld ('PBLH&IC', horiz_only, 'I','m','PBL height' )
+ call addfld ('TPERT&IC', horiz_only, 'I','K','Perturbation temperature (eddies in PBL)' )
+ call addfld ('QPERT&IC', horiz_only, 'I','kg/kg','Perturbation specific humidity (eddies in PBL)' )
+
+ ! CAM export state
+ call addfld('a2x_BCPHIWET', horiz_only, 'A', 'kg/m2/s', 'wetdep of hydrophilic black carbon')
+ call addfld('a2x_BCPHIDRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophilic black carbon')
+ call addfld('a2x_BCPHODRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophobic black carbon')
+ call addfld('a2x_OCPHIWET', horiz_only, 'A', 'kg/m2/s', 'wetdep of hydrophilic organic carbon')
+ call addfld('a2x_OCPHIDRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophilic organic carbon')
+ call addfld('a2x_OCPHODRY', horiz_only, 'A', 'kg/m2/s', 'drydep of hydrophobic organic carbon')
+ call addfld('a2x_DSTWET1', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin1)')
+ call addfld('a2x_DSTDRY1', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin1)')
+ call addfld('a2x_DSTWET2', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin2)')
+ call addfld('a2x_DSTDRY2', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin2)')
+ call addfld('a2x_DSTWET3', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin3)')
+ call addfld('a2x_DSTDRY3', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin3)')
+ call addfld('a2x_DSTWET4', horiz_only, 'A', 'kg/m2/s', 'wetdep of dust (bin4)')
+ call addfld('a2x_DSTDRY4', horiz_only, 'A', 'kg/m2/s', 'drydep of dust (bin4)')
+
+#ifdef AEROCOM
+ call add_default ('RHW ', 1, ' ')
+#endif ! aerocom
+
+ ! defaults
+ if (history_amwg) then
+ call add_default (cnst_name(1), 1, ' ')
+ call add_default ('VQ ', 1, ' ')
+ call add_default ('TMQ ', 1, ' ')
+ call add_default ('PSL ', 1, ' ')
+ call add_default ('RELHUM ', 1, ' ')
+
+ call add_default ('DTCOND ', 1, ' ')
+ call add_default ('PRECL ', 1, ' ')
+ call add_default ('PRECC ', 1, ' ')
+ call add_default ('PRECSL ', 1, ' ')
+ call add_default ('PRECSC ', 1, ' ')
+ call add_default ('SHFLX ', 1, ' ')
+ call add_default ('LHFLX ', 1, ' ')
+ call add_default ('QFLX ', 1, ' ')
+ call add_default ('TAUX ', 1, ' ')
+ call add_default ('TAUY ', 1, ' ')
+ call add_default ('TREFHT ', 1, ' ')
+ call add_default ('LANDFRAC', 1, ' ')
+ call add_default ('OCNFRAC ', 1, ' ')
+ call add_default ('QREFHT ', 1, ' ')
+ call add_default ('U10 ', 1, ' ')
+ call add_default ('ICEFRAC ', 1, ' ')
+ call add_default ('TS ', 1, ' ')
+ call add_default ('TSMN ', 1, ' ')
+ call add_default ('TSMX ', 1, ' ')
+ call add_default ('SNOWHLND', 1, ' ')
+ call add_default ('SNOWHICE', 1, ' ')
+ end if
+
+ if (dycore_is('SE')) then
+ call add_default ('PSDRY', 1, ' ')
+ call add_default ('PMID', 1, ' ')
+ end if
+
+ if (history_eddy) then
+ call add_default ('VQ ', 1, ' ')
+ endif
+
+ if ( history_budget ) then
+ call add_default (cnst_name(1), history_budget_histfile_num, ' ')
+ call add_default ('PTTEND' , history_budget_histfile_num, ' ')
+ call add_default (ptendnam( 1), history_budget_histfile_num, ' ')
+ if (ixcldliq > 0) then
+ call add_default (ptendnam(ixcldliq), history_budget_histfile_num, ' ')
+ end if
+ if (ixcldice > 0) then
+ call add_default (ptendnam(ixcldice), history_budget_histfile_num, ' ')
+ end if
+ if ( dycore_is('LR') )then
+ call add_default(dmetendnam(1) , history_budget_histfile_num, ' ')
+ if (ixcldliq > 0) then
+ call add_default(dmetendnam(ixcldliq), history_budget_histfile_num, ' ')
+ end if
+ if (ixcldice > 0) then
+ call add_default(dmetendnam(ixcldice), history_budget_histfile_num, ' ')
+ end if
+ end if
+ if( history_budget_histfile_num > 1 ) then
+ call add_default ('DTCOND ' , history_budget_histfile_num, ' ')
+ end if
+ end if
+
+ if (history_vdiag) then
+ call add_default ('PRECT ', 2, ' ')
+ call add_default ('PRECT ', 3, ' ')
+ call add_default ('PRECT ', 4, ' ')
+ end if
+
+ ! Initial file - Optional fields
+ if (inithist_all.or.single_column) then
+ call add_default ('CONCLD&IC ',0, 'I')
+ call add_default ('QCWAT&IC ',0, 'I')
+ call add_default ('TCWAT&IC ',0, 'I')
+ call add_default ('LCWAT&IC ',0, 'I')
+ call add_default ('PBLH&IC ',0, 'I')
+ call add_default ('TPERT&IC ',0, 'I')
+ call add_default ('QPERT&IC ',0, 'I')
+ call add_default ('CLOUD&IC ',0, 'I')
+ call add_default ('TKE&IC ',0, 'I')
+ call add_default ('CUSH&IC ',0, 'I')
+ call add_default ('KVH&IC ',0, 'I')
+ call add_default ('KVM&IC ',0, 'I')
+ end if
+
+ ! determine number of constituents for which convective tendencies must be computed
+ if (history_budget) then
+ dqcond_num = pcnst
+ else
+ if (diag_cnst_conv_tend == 'none') dqcond_num = 0
+ if (diag_cnst_conv_tend == 'q_only') dqcond_num = 1
+ if (diag_cnst_conv_tend == 'all') dqcond_num = pcnst
+ end if
+
+ do m = 1, dqcond_num
+ dcconnam(m) = 'DC'//cnst_name(m)
+ end do
+
+ if ((diag_cnst_conv_tend == 'q_only') .or. (diag_cnst_conv_tend == 'all') .or. history_budget) then
+ call addfld (dcconnam(1),(/ 'lev' /),'A', 'kg/kg/s',trim(cnst_name(1))//' tendency due to moist processes')
+ if ( diag_cnst_conv_tend == 'q_only' .or. diag_cnst_conv_tend == 'all' ) then
+ call add_default (dcconnam(1), 1, ' ')
+ end if
+ if( history_budget ) then
+ call add_default (dcconnam(1), history_budget_histfile_num, ' ')
+ end if
+ if (diag_cnst_conv_tend == 'all' .or. history_budget) then
+ do m = 2, pcnst
+ call addfld (dcconnam(m),(/ 'lev' /),'A', 'kg/kg/s',trim(cnst_name(m))//' tendency due to moist processes')
+ if( diag_cnst_conv_tend == 'all' ) then
+ call add_default (dcconnam(m), 1, ' ')
+ end if
+ if( history_budget .and. (m == ixcldliq .or. m == ixcldice) ) then
+ call add_default (dcconnam(m), history_budget_histfile_num, ' ')
+ end if
+ end do
+ end if
+ end if
+
+ ! Pbuf field indices for collecting output data
+ relhum_idx = pbuf_get_index('RELHUM', errcode=ierr)
+ qcwat_idx = pbuf_get_index('QCWAT', errcode=ierr)
+ tcwat_idx = pbuf_get_index('TCWAT', errcode=ierr)
+ lcwat_idx = pbuf_get_index('LCWAT', errcode=ierr)
+ cld_idx = pbuf_get_index('CLD', errcode=ierr)
+ concld_idx = pbuf_get_index('CONCLD', errcode=ierr)
+
+ tke_idx = pbuf_get_index('tke', errcode=ierr)
+ kvm_idx = pbuf_get_index('kvm', errcode=ierr)
+ kvh_idx = pbuf_get_index('kvh', errcode=ierr)
+ cush_idx = pbuf_get_index('cush', errcode=ierr)
+
+ pblh_idx = pbuf_get_index('pblh', errcode=ierr)
+ tpert_idx = pbuf_get_index('tpert', errcode=ierr)
+ qpert_idx = pbuf_get_index('qpert', errcode=ierr)
+
+ prec_dp_idx = pbuf_get_index('PREC_DP', errcode=ierr)
+ snow_dp_idx = pbuf_get_index('SNOW_DP', errcode=ierr)
+ prec_sh_idx = pbuf_get_index('PREC_SH', errcode=ierr)
+ snow_sh_idx = pbuf_get_index('SNOW_SH', errcode=ierr)
+ prec_sed_idx = pbuf_get_index('PREC_SED', errcode=ierr)
+ snow_sed_idx = pbuf_get_index('SNOW_SED', errcode=ierr)
+ prec_pcw_idx = pbuf_get_index('PREC_PCW', errcode=ierr)
+ snow_pcw_idx = pbuf_get_index('SNOW_PCW', errcode=ierr)
+
+ if (is_first_step()) then
+ call pbuf_set_field(pbuf2d, trefmxav_idx, -1.0e36_r8)
+ call pbuf_set_field(pbuf2d, trefmnav_idx, 1.0e36_r8)
+ end if
+
+ end subroutine diag_init_moist
+
+ subroutine diag_init(pbuf2d)
+ use cam_history, only: addfld
+
+ ! Declare the history fields for which this module contains outfld calls.
+
+ type(physics_buffer_desc), pointer, intent(in) :: pbuf2d(:,:)
+
+ ! ----------------------------
+ ! determine default variables
+ ! ----------------------------
+ call phys_getopts(history_amwg_out = history_amwg , &
+ history_vdiag_out = history_vdiag , &
+ history_eddy_out = history_eddy , &
+ history_budget_out = history_budget , &
+ history_budget_histfile_num_out = history_budget_histfile_num, &
+ history_waccm_out = history_waccm)
+
+ call diag_init_dry(pbuf2d)
+ if (moist_physics) then
+ call diag_init_moist(pbuf2d)
+ end if
+
+ end subroutine diag_init
+
+!===============================================================================
+
+ subroutine diag_allocate_dry()
+ use infnan, only: nan, assignment(=)
+
+ ! Allocate memory for module variables.
+ ! Done at the begining of a physics step at same point as the pbuf allocate
+ ! for variables with "physpkg" scope.
+
+ ! Local variables
+ character(len=*), parameter :: sub = 'diag_allocate_dry'
+ character(len=128) :: errmsg
+ integer :: istat
+
+ allocate(dtcond(pcols,pver,begchunk:endchunk), stat=istat)
+ if ( istat /= 0 ) then
+ write(errmsg, '(2a,i0)') sub, ': allocate failed, stat = ',istat
+ call endrun (errmsg)
+ end if
+ dtcond = nan
+ end subroutine diag_allocate_dry
+
+ subroutine diag_allocate_moist()
+ use infnan, only: nan, assignment(=)
+
+ ! Allocate memory for module variables.
+ ! Done at the begining of a physics step at same point as the pbuf allocate
+ ! for variables with "physpkg" scope.
+
+ ! Local variables
+ character(len=*), parameter :: sub = 'diag_allocate_moist'
+ character(len=128) :: errmsg
+ integer :: i, istat
+
+ if (dqcond_num > 0) then
+ allocate(dqcond(dqcond_num))
+ do i = 1, dqcond_num
+ allocate(dqcond(i)%cnst(pcols,pver,begchunk:endchunk), stat=istat)
+ if ( istat /= 0 ) then
+ write(errmsg, '(2a,i0)') sub, ': allocate failed, stat = ',istat
+ call endrun (errmsg)
+ end if
+ dqcond(i)%cnst = nan
+ end do
+ end if
+
+ end subroutine diag_allocate_moist
+
+ subroutine diag_allocate()
+
+ call diag_allocate_dry()
+ if (moist_physics) then
+ call diag_allocate_moist()
+ end if
+
+ end subroutine diag_allocate
+
+!===============================================================================
+
+ subroutine diag_deallocate_dry()
+ ! Deallocate memory for module variables.
+ ! Done at the end of a physics step at same point as the pbuf deallocate for
+ ! variables with "physpkg" scope.
+
+ ! Local variables
+ character(len=*), parameter :: sub = 'diag_deallocate_dry'
+ integer :: istat
+
+ deallocate(dtcond, stat=istat)
+ if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed')
+ end subroutine diag_deallocate_dry
+
+ subroutine diag_deallocate_moist()
+
+ ! Deallocate memory for module variables.
+ ! Done at the end of a physics step at same point as the pbuf deallocate for
+ ! variables with "physpkg" scope.
+
+ ! Local variables
+ character(len=*), parameter :: sub = 'diag_deallocate_moist'
+ integer :: i, istat
+
+ if (dqcond_num > 0) then
+ do i = 1, dqcond_num
+ deallocate(dqcond(i)%cnst, stat=istat)
+ if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed')
+ end do
+ deallocate(dqcond, stat=istat)
+ if ( istat /= 0 ) call endrun (sub//': ERROR: deallocate failed')
+ end if
+ end subroutine diag_deallocate_moist
+
+ subroutine diag_deallocate()
+
+ call diag_deallocate_dry()
+ if (moist_physics) then
+ call diag_deallocate_moist()
+ end if
+
+ end subroutine diag_deallocate
+
+!===============================================================================
+
+ subroutine diag_conv_tend_ini(state,pbuf)
+
+ ! Initialize convective tendency calcs.
+
+ ! Arguments:
+ type(physics_state), intent(in) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! Local variables:
+
+ integer :: i, k, m, lchnk, ncol
+ real(r8), pointer, dimension(:,:) :: t_ttend
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ do k = 1, pver
+ do i = 1, ncol
+ dtcond(i,k,lchnk) = state%t(i,k)
+ end do
+ end do
+
+ do m = 1, dqcond_num
+ do k = 1, pver
+ do i = 1, ncol
+ dqcond(m)%cnst(i,k,lchnk) = state%q(i,k,m)
+ end do
+ end do
+ end do
+
+ !! initialize to pbuf T_TTEND to temperature at first timestep
+ if (is_first_step()) then
+ do m = 1, dyn_time_lvls
+ call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,m/), kount=(/pcols,pver,1/))
+ t_ttend(:ncol,:) = state%t(:ncol,:)
+ end do
+ end if
+
+ end subroutine diag_conv_tend_ini
+
+!===============================================================================
+
+ subroutine diag_phys_writeout_dry(state, pbuf, p_surf_t)
+
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose: output dry physics diagnostics
+ !
+ !-----------------------------------------------------------------------
+ use physconst, only: gravit, rga, rair, cpair, latvap, rearth, pi, cappa
+ use time_manager, only: get_nstep
+ use interpolate_data, only: vertinterp
+ use constituent_burden, only: constituent_burden_comp
+ use co2_cycle, only: c_i, co2_transport
+
+ use tidal_diag, only: tidal_diag_write
+ !-----------------------------------------------------------------------
+ !
+ ! Arguments
+ !
+ type(physics_state), intent(inout) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ real(r8), intent(out) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+ real(r8) :: ftem(pcols,pver) ! temporary workspace
+ real(r8) :: ftem1(pcols,pver) ! another temporary workspace
+ real(r8) :: ftem2(pcols,pver) ! another temporary workspace
+ real(r8) :: z3(pcols,pver) ! geo-potential height
+ real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface
+ real(r8) :: tem2(pcols,pver) ! temporary workspace
+ real(r8) :: timestep(pcols) ! used for outfld call
+ real(r8) :: esl(pcols,pver) ! saturation vapor pressures
+ real(r8) :: esi(pcols,pver) !
+ real(r8) :: dlon(pcols) ! width of grid cell (meters)
+
+ real(r8), pointer :: psl(:) ! Sea Level Pressure
+
+ integer :: i, k, m, lchnk, ncol, nstep
+ !
+ !-----------------------------------------------------------------------
+ !
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ ! Output NSTEP for debugging
+ nstep = get_nstep()
+ timestep(:ncol) = nstep
+ call outfld ('NSTEP ',timestep, pcols, lchnk)
+
+ call outfld('T ',state%t , pcols ,lchnk )
+ call outfld('PS ',state%ps, pcols ,lchnk )
+ call outfld('U ',state%u , pcols ,lchnk )
+ call outfld('V ',state%v , pcols ,lchnk )
+
+ call outfld('PHIS ',state%phis, pcols, lchnk )
+
+#if (defined BFB_CAM_SCAM_IOP )
+ call outfld('phis ',state%phis, pcols, lchnk )
+#endif
+
+ do m = 1, pcnst
+ if (cnst_cam_outfld(m)) then
+ call outfld(cnst_name(m), state%q(1,1,m), pcols, lchnk)
+ end if
+ end do
+
+ !
+ ! Add height of surface to midpoint height above surface
+ !
+ do k = 1, pver
+ z3(:ncol,k) = state%zm(:ncol,k) + state%phis(:ncol)*rga
+ end do
+ call outfld('Z3 ',z3,pcols,lchnk)
+ !
+ ! Output Z3 on pressure surfaces
+ !
+ if (hist_fld_active('Z1000')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, z3, p_surf, &
+ extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver))
+ call outfld('Z1000 ', p_surf, pcols, lchnk)
+ end if
+ if (hist_fld_active('Z700')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, z3, p_surf, &
+ extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver))
+ call outfld('Z700 ', p_surf, pcols, lchnk)
+ end if
+ if (hist_fld_active('Z500')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, z3, p_surf, &
+ extrapolate='Z', ln_interp=.true., ps=state%ps, phis=state%phis, tbot=state%t(:,pver))
+ call outfld('Z500 ', p_surf, pcols, lchnk)
+ end if
+ if (hist_fld_active('Z300')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 30000._r8, z3, p_surf, ln_interp=.true.)
+ call outfld('Z300 ', p_surf, pcols, lchnk)
+ end if
+ if (hist_fld_active('Z200')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, z3, p_surf, ln_interp=.true.)
+ call outfld('Z200 ', p_surf, pcols, lchnk)
+ end if
+ if (hist_fld_active('Z100')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 10000._r8, z3, p_surf, ln_interp=.true.)
+ call outfld('Z100 ', p_surf, pcols, lchnk)
+ end if
+ if (hist_fld_active('Z050')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 5000._r8, z3, p_surf, ln_interp=.true.)
+ call outfld('Z050 ', p_surf, pcols, lchnk)
+ end if
+ if (hist_fld_active('Z010')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 1000._r8, z3, p_surf, ln_interp=.true.)
+ call outfld('Z010 ', p_surf, pcols, lchnk)
+ end if
+ if (hist_fld_active('UA010')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 1000._r8, state%u, p_surf, ln_interp=.true.)
+ call outfld('UA010 ', p_surf, pcols, lchnk)
+ end if
+ !
+ ! Quadratic height fiels Z3*Z3
+ !
+ ftem(:ncol,:) = z3(:ncol,:)*z3(:ncol,:)
+ call outfld('ZZ ',ftem,pcols,lchnk)
+
+ ftem(:ncol,:) = z3(:ncol,:)*state%v(:ncol,:)
+ call outfld('VZ ',ftem, pcols,lchnk)
+ !
+ ! Meridional advection fields
+ !
+ ftem(:ncol,:) = state%v(:ncol,:)*state%t(:ncol,:)
+ call outfld ('VT ',ftem ,pcols ,lchnk )
+
+ if (hist_fld_active('VT100')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 10000._r8, ftem, p_surf, ln_interp=.true.)
+ call outfld('VT100 ', p_surf, pcols, lchnk)
+ end if
+
+ ftem(:ncol,:) = state%v(:ncol,:)**2
+ call outfld ('VV ',ftem ,pcols ,lchnk )
+
+ ftem(:ncol,:) = state%v(:ncol,:) * state%u(:ncol,:)
+ call outfld ('VU ',ftem ,pcols ,lchnk )
+ !
+ ! zonal advection
+ !
+ ftem(:ncol,:) = state%u(:ncol,:)**2
+ call outfld ('UU ',ftem ,pcols ,lchnk )
+
+ ! Wind speed
+ ftem(:ncol,:) = sqrt( state%u(:ncol,:)**2 + state%v(:ncol,:)**2)
+ call outfld ('WSPEED ',ftem ,pcols ,lchnk )
+ call outfld ('WSPDSRFMX',ftem(:,pver) ,pcols ,lchnk )
+ call outfld ('WSPDSRFAV',ftem(:,pver) ,pcols ,lchnk )
+
+ ! Vertical velocity and advection
+
+ if (single_column) then
+ call outfld('OMEGA ',wfld, pcols, lchnk )
+ else
+ call outfld('OMEGA ',state%omega, pcols, lchnk )
+ endif
+
+#if (defined BFB_CAM_SCAM_IOP )
+ call outfld('omega ',state%omega, pcols, lchnk )
+#endif
+
+ ftem(:ncol,:) = state%omega(:ncol,:)*state%t(:ncol,:)
+ call outfld('OMEGAT ',ftem, pcols, lchnk )
+ ftem(:ncol,:) = state%omega(:ncol,:)*state%u(:ncol,:)
+ call outfld('OMEGAU ',ftem, pcols, lchnk )
+ ftem(:ncol,:) = state%omega(:ncol,:)*state%v(:ncol,:)
+ call outfld('OMEGAV ',ftem, pcols, lchnk )
+ ftem(:ncol,:) = state%omega(:ncol,:)*state%omega(:ncol,:)
+ call outfld('OMGAOMGA',ftem, pcols, lchnk )
+ !
+ ! Output omega at 850 and 500 mb pressure levels
+ !
+ if (hist_fld_active('OMEGA850')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%omega, p_surf)
+ call outfld('OMEGA850', p_surf, pcols, lchnk)
+ end if
+ if (hist_fld_active('OMEGA500')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%omega, p_surf)
+ call outfld('OMEGA500', p_surf, pcols, lchnk)
+ end if
+
+ ! Sea level pressure
+ call pbuf_get_field(pbuf, psl_idx, psl)
+ call cpslec(ncol, state%pmid, state%phis, state%ps, state%t, psl, gravit, rair)
+ call outfld('PSL', psl, pcols, lchnk)
+
+ ! Output T,u,v fields on pressure surfaces
+ !
+ if (hist_fld_active('T850')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf, &
+ extrapolate='T', ps=state%ps, phis=state%phis)
+ call outfld('T850 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('T500')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%t, p_surf, &
+ extrapolate='T', ps=state%ps, phis=state%phis)
+ call outfld('T500 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('T400')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 40000._r8, state%t, p_surf, &
+ extrapolate='T', ps=state%ps, phis=state%phis)
+ call outfld('T400 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('T300')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 30000._r8, state%t, p_surf)
+ call outfld('T300 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('T200')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%t, p_surf)
+ call outfld('T200 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('U850')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%u, p_surf)
+ call outfld('U850 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('U500')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%u, p_surf)
+ call outfld('U500 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('U250')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 25000._r8, state%u, p_surf)
+ call outfld('U250 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('U200')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%u, p_surf)
+ call outfld('U200 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('U010')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 1000._r8, state%u, p_surf)
+ call outfld('U010 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('V850')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%v, p_surf)
+ call outfld('V850 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('V500')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 50000._r8, state%v, p_surf)
+ call outfld('V500 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('V250')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 25000._r8, state%v, p_surf)
+ call outfld('V250 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('V200')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%v, p_surf)
+ call outfld('V200 ', p_surf, pcols, lchnk )
+ end if
+
+ ftem(:ncol,:) = state%t(:ncol,:)*state%t(:ncol,:)
+ call outfld('TT ',ftem ,pcols ,lchnk )
+ !
+ ! Output U, V, T, P and Z at bottom level
+ !
+ call outfld ('UBOT ', state%u(1,pver) , pcols, lchnk)
+ call outfld ('VBOT ', state%v(1,pver) , pcols, lchnk)
+ call outfld ('ZBOT ', state%zm(1,pver) , pcols, lchnk)
+
+ !! Boundary layer atmospheric stability, temperature, water vapor diagnostics
+
+ p_surf_t = -99.0_r8 ! Uninitialized to impossible value
+ if (hist_fld_active('T1000') .or. &
+ hist_fld_active('T9251000') .or. &
+ hist_fld_active('TH9251000') .or. &
+ hist_fld_active('T8501000') .or. &
+ hist_fld_active('TH8501000') .or. &
+ hist_fld_active('T7001000') .or. &
+ hist_fld_active('TH7001000')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%t, p_surf_t(:,surf_100000))
+ end if
+
+ if ( hist_fld_active('T925') .or. &
+ hist_fld_active('T9251000') .or. &
+ hist_fld_active('TH9251000')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%t, p_surf_t(:,surf_092500))
+ end if
+
+!!! at 1000 mb and 925 mb
+ if (hist_fld_active('T1000')) then
+ call outfld('T1000 ', p_surf_t(:,surf_100000), pcols, lchnk )
+ end if
+
+ if (hist_fld_active('T925')) then
+ call outfld('T925 ', p_surf_t(:,surf_092500), pcols, lchnk )
+ end if
+
+ if (hist_fld_active('T9251000')) then
+ p_surf = p_surf_t(:,surf_092500) - p_surf_t(:,surf_100000)
+ call outfld('T9251000 ', p_surf, pcols, lchnk )
+ end if
+
+ if (hist_fld_active('TH9251000')) then
+ p_surf = (p_surf_t(:,surf_092500)*(1000.0_r8/925.0_r8)**cappa) - (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)
+ call outfld('TH9251000 ', p_surf, pcols, lchnk )
+ end if
+
+ if (hist_fld_active('T8501000') .or. &
+ hist_fld_active('TH8501000')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf_t(:,surf_085000))
+ end if
+
+!!! at 1000 mb and 850 mb
+ if (hist_fld_active('T8501000')) then
+ p_surf = p_surf_t(:,surf_085000)-p_surf_t(:,surf_100000)
+ call outfld('T8501000 ', p_surf, pcols, lchnk )
+ end if
+
+ if (hist_fld_active('TH8501000')) then
+ p_surf = (p_surf_t(:,surf_085000)*(1000.0_r8/850.0_r8)**cappa)-(p_surf_t(:,surf_100000)*(1.0_r8)**cappa)
+ call outfld('TH8501000 ', p_surf, pcols, lchnk )
+ end if
+
+ if (hist_fld_active('T7001000') .or. &
+ hist_fld_active('TH7001000') .or. &
+ hist_fld_active('T700')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%t, p_surf_t(:,surf_070000))
+ end if
+
+!!! at 700 mb
+ if (hist_fld_active('T700')) then
+ call outfld('T700 ', p_surf_t(:,surf_070000), pcols, lchnk )
+ end if
+
+!!! at 1000 mb and 700 mb
+ if (hist_fld_active('T7001000')) then
+ p_surf = p_surf_t(:,surf_070000)-p_surf_t(:,surf_100000)
+ call outfld('T7001000 ', p_surf, pcols, lchnk )
+ end if
+
+ if (hist_fld_active('TH7001000')) then
+ p_surf = (p_surf_t(:,surf_070000)*(1000.0_r8/700.0_r8)**cappa)-(p_surf_t(:,surf_100000)*(1.0_r8)**cappa)
+ call outfld('TH7001000 ', p_surf, pcols, lchnk )
+ end if
+
+ if (hist_fld_active('T010')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 1000._r8, state%t, p_surf)
+ call outfld('T010 ', p_surf, pcols, lchnk )
+ end if
+
+ !---------------------------------------------------------
+ ! tidal diagnostics
+ !---------------------------------------------------------
+ call tidal_diag_write(state)
+
+ return
+ end subroutine diag_phys_writeout_dry
+
+!===============================================================================
+
+ subroutine diag_phys_writeout_moist(state, pbuf, p_surf_t)
+
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose: record dynamics variables on physics grid
+ !
+ !-----------------------------------------------------------------------
+ use physconst, only: gravit, rga, rair, cpair, latvap, rearth, pi, cappa, &
+ epsilo, rh2o
+ use interpolate_data, only: vertinterp
+ use constituent_burden, only: constituent_burden_comp
+ use co2_cycle, only: c_i, co2_transport
+ !-----------------------------------------------------------------------
+ !
+ ! Arguments
+ !
+ type(physics_state), intent(inout) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ real(r8), intent(inout) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+ real(r8) :: ftem(pcols,pver) ! temporary workspace
+ real(r8) :: ftem1(pcols,pver) ! another temporary workspace
+ real(r8) :: ftem2(pcols,pver) ! another temporary workspace
+ real(r8) :: z3(pcols,pver) ! geo-potential height
+ real(r8) :: p_surf(pcols) ! data interpolated to a pressure surface
+ real(r8) :: p_surf_q1(pcols) ! data interpolated to a pressure surface
+ real(r8) :: p_surf_q2(pcols) ! data interpolated to a pressure surface
+ real(r8) :: tem2(pcols,pver) ! temporary workspace
+ real(r8) :: esl(pcols,pver) ! saturation vapor pressures
+ real(r8) :: esi(pcols,pver) !
+
+ real(r8), pointer :: ftem_ptr(:,:)
+
+ integer :: i, k, m, lchnk, ncol
+ !
+ !-----------------------------------------------------------------------
+ !
+ lchnk = state%lchnk
+ ncol = state%ncol
+ do m=1,pcnst
+ if ( cnst_cam_outfld(m) ) then
+ call outfld(cnst_name(m),state%q(1,1,m),pcols ,lchnk )
+ end if
+ end do
+
+ if (co2_transport()) then
+ do m = 1,4
+ call outfld(trim(cnst_name(c_i(m)))//'_BOT', state%q(1,pver,c_i(m)), pcols, lchnk)
+ end do
+ end if
+
+ ! column burdens of all constituents except water vapor
+ call constituent_burden_comp(state)
+
+ call outfld('PSDRY', state%psdry, pcols, lchnk)
+ call outfld('PMID', state%pmid, pcols, lchnk)
+ call outfld('PDELDRY', state%pdeldry, pcols, lchnk)
+
+ !
+ ! Meridional advection fields
+ !
+ ftem(:ncol,:) = state%v(:ncol,:)*state%q(:ncol,:,1)
+ call outfld ('VQ ',ftem ,pcols ,lchnk )
+
+ ftem(:ncol,:) = state%q(:ncol,:,1)*state%q(:ncol,:,1)
+ call outfld ('QQ ',ftem ,pcols ,lchnk )
+
+ ! Vertical velocity and advection
+ ftem(:ncol,:) = state%omega(:ncol,:)*state%q(:ncol,:,1)
+ call outfld('OMEGAQ ',ftem, pcols, lchnk )
+ !
+ ! Mass of q, by layer and vertically integrated
+ !
+ ftem(:ncol,:) = state%q(:ncol,:,1) * state%pdel(:ncol,:) * rga
+ call outfld ('MQ ',ftem ,pcols ,lchnk )
+
+ do k=2,pver
+ ftem(:ncol,1) = ftem(:ncol,1) + ftem(:ncol,k)
+ end do
+ call outfld ('TMQ ',ftem, pcols ,lchnk )
+
+ ! Relative humidity
+ if (hist_fld_active('RELHUM')) then
+ if (relhum_idx > 0) then
+ call pbuf_get_field(pbuf, relhum_idx, ftem_ptr)
+ ftem(:ncol,:) = ftem_ptr(:ncol,:)
+ else
+ call qsat(state%t(:ncol,:), state%pmid(:ncol,:), &
+ tem2(:ncol,:), ftem(:ncol,:))
+ ftem(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8
+ end if
+ call outfld ('RELHUM ',ftem ,pcols ,lchnk )
+ end if
+
+#ifdef AEROCOM
+ ! We want RHW output always when AEROCOM is on (not only if added to a namelist)
+ ! RH w.r.t liquid (water)
+ call qsat_water (state%t(:ncol,:), state%pmid(:ncol,:), &
+ esl(:ncol,:), ftem(:ncol,:))
+ ftem(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8
+ call outfld ('RHW ',ftem ,pcols ,lchnk )
+#endif
+
+ if (hist_fld_active('RHW') .or. hist_fld_active('RHI') .or. hist_fld_active('RHCFMIP') ) then
+
+#ifndef AEROCOM
+ ! RH w.r.t liquid (water)
+ call qsat_water (state%t(:ncol,:), state%pmid(:ncol,:), &
+ esl(:ncol,:), ftem(:ncol,:))
+ ftem(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8
+ call outfld ('RHW ',ftem ,pcols ,lchnk )
+#endif AEROCOM
+
+ ! Convert to RHI (ice)
+ do i=1,ncol
+ do k=1,pver
+ esi(i,k)=svp_ice(state%t(i,k))
+ ftem1(i,k)=ftem(i,k)*esl(i,k)/esi(i,k)
+ end do
+ end do
+ call outfld ('RHI ',ftem1 ,pcols ,lchnk )
+
+ ! use temperature to decide if you populate with ftem (liquid, above 0 C) or ftem1 (ice, below 0 C)
+
+ ftem2(:ncol,:)=ftem(:ncol,:)
+
+ do i=1,ncol
+ do k=1,pver
+ if (state%t(i,k) .gt. 273) then
+ ftem2(i,k)=ftem(i,k) !!wrt water
+ else
+ ftem2(i,k)=ftem1(i,k) !!wrt ice
+ end if
+ end do
+ end do
+
+ call outfld ('RHCFMIP ',ftem2 ,pcols ,lchnk )
+
+ end if
+ !
+ ! Output q field on pressure surfaces
+ !
+ if (hist_fld_active('Q850')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,1), p_surf)
+ call outfld('Q850 ', p_surf, pcols, lchnk )
+ end if
+ if (hist_fld_active('Q200')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 20000._r8, state%q(1,1,1), p_surf)
+ call outfld('Q200 ', p_surf, pcols, lchnk )
+ end if
+ !
+ ! Output Q at bottom level
+ !
+ call outfld ('QBOT ', state%q(1,pver,1), pcols, lchnk)
+
+ ! Total energy of the atmospheric column for atmospheric heat storage calculations
+
+ !! temporary variable to get surface geopotential in dimensions of (ncol,pver)
+ do k=1,pver
+ ftem1(:ncol,k)=state%phis(:ncol) !! surface geopotential in units (m2/s2)
+ end do
+
+ !! calculate sum of sensible, kinetic, latent, and surface geopotential energy
+ !! E=CpT+PHIS+Lv*q+(0.5)*(u^2+v^2)
+ ftem(:ncol,:) = (cpair*state%t(:ncol,:) + ftem1(:ncol,:) + latvap*state%q(:ncol,:,1) + &
+ 0.5_r8*(state%u(:ncol,:)**2+state%v(:ncol,:)**2))*(state%pdel(:ncol,:)/gravit)
+ !! vertically integrate
+ do k=2,pver
+ ftem(:ncol,1) = ftem(:ncol,1) + ftem(:ncol,k)
+ end do
+ call outfld ('ATMEINT ',ftem(:ncol,1) ,pcols ,lchnk )
+
+ !! Boundary layer atmospheric stability, temperature, water vapor diagnostics
+
+ if ( hist_fld_active('THE9251000') .or. &
+ hist_fld_active('THE8501000') .or. &
+ hist_fld_active('THE7001000')) then
+ if (p_surf_t(1, surf_100000) < 0.0_r8) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%t, p_surf_t(:, surf_100000))
+ end if
+ end if
+
+ if ( hist_fld_active('TH9251000') .or. &
+ hist_fld_active('THE9251000')) then
+ if (p_surf_t(1, surf_092500) < 0.0_r8) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%t, p_surf_t(:, surf_092500))
+ end if
+ end if
+
+ if ( hist_fld_active('Q1000') .or. &
+ hist_fld_active('THE9251000') .or. &
+ hist_fld_active('THE8501000') .or. &
+ hist_fld_active('THE7001000')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 100000._r8, state%q(1,1,1), p_surf_q1)
+ end if
+
+ if (hist_fld_active('THE9251000')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 92500._r8, state%q(1,1,1), p_surf_q2)
+ end if
+
+!!! at 1000 mb and 925 mb
+ if (hist_fld_active('Q1000')) then
+ call outfld('Q1000 ', p_surf_q1, pcols, lchnk )
+ end if
+
+ if (hist_fld_active('Q925')) then
+ call outfld('Q925 ', p_surf_q2, pcols, lchnk )
+ end if
+
+ if (hist_fld_active('THE9251000')) then
+ p_surf = ((p_surf_t(:, surf_092500)*(1000.0_r8/925.0_r8)**cappa) * &
+ exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_092500)))) - &
+ (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000)))
+ call outfld('THE9251000 ', p_surf, pcols, lchnk )
+ end if
+
+ if (hist_fld_active('THE8501000')) then
+ if (p_surf_t(1, surf_085000) < 0.0_r8) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%t, p_surf_t(:, surf_085000))
+ end if
+ end if
+
+!!! at 1000 mb and 850 mb
+ if (hist_fld_active('THE8501000')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 85000._r8, state%q(1,1,1), p_surf_q2)
+ p_surf = ((p_surf_t(:, surf_085000)*(1000.0_r8/850.0_r8)**cappa) * &
+ exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_085000)))) - &
+ (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000)))
+ call outfld('THE8501000 ', p_surf, pcols, lchnk )
+ end if
+
+ if (hist_fld_active('THE7001000')) then
+ if (p_surf_t(1, surf_070000) < 0.0_r8) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%t, p_surf_t(:, surf_070000))
+ end if
+ end if
+
+!!! at 1000 mb and 700 mb
+ if (hist_fld_active('THE7001000')) then
+ call vertinterp(ncol, pcols, pver, state%pmid, 70000._r8, state%q(1,1,1), p_surf_q2)
+ p_surf = ((p_surf_t(:, surf_070000)*(1000.0_r8/700.0_r8)**cappa) * &
+ exp((2500000.0_r8*p_surf_q2)/(1004.0_r8*p_surf_t(:, surf_070000)))) - &
+ (p_surf_t(:,surf_100000)*(1.0_r8)**cappa)*exp((2500000.0_r8*p_surf_q1)/(1004.0_r8*p_surf_t(:,surf_100000)))
+ call outfld('THE7001000 ', p_surf, pcols, lchnk )
+ end if
+
+ return
+ end subroutine diag_phys_writeout_moist
+
+!===============================================================================
+
+ subroutine diag_phys_writeout(state, pbuf)
+
+ !-----------------------------------------------------------------------
+ !
+ ! Arguments
+ !
+ type(physics_state), intent(inout) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ !
+ ! Local variable
+ !
+ real(r8) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface
+
+ call diag_phys_writeout_dry(state, pbuf, p_surf_t)
+
+ if (moist_physics) then
+ call diag_phys_writeout_moist(state, pbuf, p_surf_t)
+ end if
+
+ end subroutine diag_phys_writeout
+
+!===============================================================================
+
+ subroutine diag_conv(state, ztodt, pbuf)
+
+ !-----------------------------------------------------------------------
+ !
+ ! Output diagnostics associated with all convective processes.
+ !
+ !-----------------------------------------------------------------------
+ use physconst, only: cpair
+ use tidal_diag, only: get_tidal_coeffs
+
+ ! Arguments:
+
+ real(r8), intent(in) :: ztodt ! timestep for computing physics tendencies
+ type(physics_state), intent(in) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! convective precipitation variables
+ real(r8), pointer :: prec_dp(:) ! total precipitation from ZM convection
+ real(r8), pointer :: snow_dp(:) ! snow from ZM convection
+ real(r8), pointer :: prec_sh(:) ! total precipitation from Hack convection
+ real(r8), pointer :: snow_sh(:) ! snow from Hack convection
+ real(r8), pointer :: prec_sed(:) ! total precipitation from ZM convection
+ real(r8), pointer :: snow_sed(:) ! snow from ZM convection
+ real(r8), pointer :: prec_pcw(:) ! total precipitation from Hack convection
+ real(r8), pointer :: snow_pcw(:) ! snow from Hack convection
+
+ ! Local variables:
+
+ integer :: i, k, m, lchnk, ncol
+
+ real(r8) :: rtdt
+
+ real(r8):: precc(pcols) ! convective precip rate
+ real(r8):: precl(pcols) ! stratiform precip rate
+ real(r8):: snowc(pcols) ! convective snow rate
+ real(r8):: snowl(pcols) ! stratiform snow rate
+ real(r8):: prect(pcols) ! total (conv+large scale) precip rate
+ real(r8) :: dcoef(6) ! for tidal component of T tend
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ rtdt = 1._r8/ztodt
+
+ if (moist_physics) then
+ if (prec_dp_idx > 0) then
+ call pbuf_get_field(pbuf, prec_dp_idx, prec_dp)
+ else
+ nullify(prec_dp)
+ end if
+ if (snow_dp_idx > 0) then
+ call pbuf_get_field(pbuf, snow_dp_idx, snow_dp)
+ else
+ nullify(snow_dp)
+ end if
+ if (prec_sh_idx > 0) then
+ call pbuf_get_field(pbuf, prec_sh_idx, prec_sh)
+ else
+ nullify(prec_sh)
+ end if
+ if (snow_sh_idx > 0) then
+ call pbuf_get_field(pbuf, snow_sh_idx, snow_sh)
+ else
+ nullify(snow_sh)
+ end if
+ if (prec_sed_idx > 0) then
+ call pbuf_get_field(pbuf, prec_sed_idx, prec_sed)
+ else
+ nullify(prec_sed)
+ end if
+ if (snow_sed_idx > 0) then
+ call pbuf_get_field(pbuf, snow_sed_idx, snow_sed)
+ else
+ nullify(snow_sed)
+ end if
+ if (prec_pcw_idx > 0) then
+ call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw)
+ else
+ nullify(prec_pcw)
+ end if
+ if (snow_pcw_idx > 0) then
+ call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw)
+ else
+ nullify(snow_pcw)
+ end if
+
+ ! Precipitation rates (multi-process)
+ if (associated(prec_dp) .and. associated(prec_sh)) then
+ precc(:ncol) = prec_dp(:ncol) + prec_sh(:ncol)
+ else if (associated(prec_dp)) then
+ precc(:ncol) = prec_dp(:ncol)
+ else if (associated(prec_sh)) then
+ precc(:ncol) = prec_sh(:ncol)
+ else
+ precc(:ncol) = 0._r8
+ end if
+ if (associated(prec_sed) .and. associated(prec_pcw)) then
+ precl(:ncol) = prec_sed(:ncol) + prec_pcw(:ncol)
+ else if (associated(prec_sed)) then
+ precl(:ncol) = prec_sed(:ncol)
+ else if (associated(prec_pcw)) then
+ precl(:ncol) = prec_pcw(:ncol)
+ else
+ precl(:ncol) = 0._r8
+ end if
+ if (associated(snow_dp) .and. associated(snow_sh)) then
+ snowc(:ncol) = snow_dp(:ncol) + snow_sh(:ncol)
+ else if (associated(snow_dp)) then
+ snowc(:ncol) = snow_dp(:ncol)
+ else if (associated(snow_sh)) then
+ snowc(:ncol) = snow_sh(:ncol)
+ else
+ snowc(:ncol) = 0._r8
+ end if
+ if (associated(snow_sed) .and. associated(snow_pcw)) then
+ snowl(:ncol) = snow_sed(:ncol) + snow_pcw(:ncol)
+ else if (associated(snow_sed)) then
+ snowl(:ncol) = snow_sed(:ncol)
+ else if (associated(snow_pcw)) then
+ snowl(:ncol) = snow_pcw(:ncol)
+ else
+ snowl(:ncol) = 0._r8
+ end if
+ prect(:ncol) = precc(:ncol) + precl(:ncol)
+
+ call outfld('PRECC ', precc, pcols, lchnk )
+ call outfld('PRECL ', precl, pcols, lchnk )
+ if (associated(prec_pcw)) then
+ call outfld('PREC_PCW', prec_pcw,pcols ,lchnk )
+ end if
+ if (associated(prec_dp)) then
+ call outfld('PREC_zmc', prec_dp ,pcols ,lchnk )
+ end if
+ call outfld('PRECSC ', snowc, pcols, lchnk )
+ call outfld('PRECSL ', snowl, pcols, lchnk )
+ call outfld('PRECT ', prect, pcols, lchnk )
+ call outfld('PRECTMX ', prect, pcols, lchnk )
+
+ call outfld('PRECLav ', precl, pcols, lchnk )
+ call outfld('PRECCav ', precc, pcols, lchnk )
+
+#if ( defined BFB_CAM_SCAM_IOP )
+ call outfld('Prec ' , prect, pcols, lchnk )
+#endif
+
+ ! Total convection tendencies.
+
+ do k = 1, pver
+ do i = 1, ncol
+ dtcond(i,k,lchnk) = (state%t(i,k) - dtcond(i,k,lchnk))*rtdt
+ end do
+ end do
+ call outfld('DTCOND ', dtcond(:,:,lchnk), pcols, lchnk)
+
+ ! output tidal coefficients
+ call get_tidal_coeffs( dcoef )
+ call outfld( 'DTCOND_24_SIN', dtcond(:ncol,:,lchnk)*dcoef(1), ncol, lchnk )
+ call outfld( 'DTCOND_24_COS', dtcond(:ncol,:,lchnk)*dcoef(2), ncol, lchnk )
+ call outfld( 'DTCOND_12_SIN', dtcond(:ncol,:,lchnk)*dcoef(3), ncol, lchnk )
+ call outfld( 'DTCOND_12_COS', dtcond(:ncol,:,lchnk)*dcoef(4), ncol, lchnk )
+ call outfld( 'DTCOND_08_SIN', dtcond(:ncol,:,lchnk)*dcoef(5), ncol, lchnk )
+ call outfld( 'DTCOND_08_COS', dtcond(:ncol,:,lchnk)*dcoef(6), ncol, lchnk )
+
+ do m = 1, dqcond_num
+ if ( cnst_cam_outfld(m) ) then
+ do k = 1, pver
+ do i = 1, ncol
+ dqcond(m)%cnst(i,k,lchnk) = (state%q(i,k,m) - dqcond(m)%cnst(i,k,lchnk))*rtdt
+ end do
+ end do
+ call outfld(dcconnam(m), dqcond(m)%cnst(:,:,lchnk), pcols, lchnk)
+ end if
+ end do
+
+ end if
+ end subroutine diag_conv
+
+!===============================================================================
+
+ subroutine diag_surf (cam_in, cam_out, state, pbuf)
+
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose: record surface diagnostics
+ !
+ !-----------------------------------------------------------------------
+
+ use time_manager, only: is_end_curr_day
+ use co2_cycle, only: c_i, co2_transport
+ use constituents, only: sflxnam
+
+ !-----------------------------------------------------------------------
+ !
+ ! Input arguments
+ !
+ type(cam_in_t), intent(in) :: cam_in
+ type(cam_out_t), intent(in) :: cam_out
+ type(physics_state), intent(in) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+ integer :: i, k, m ! indexes
+ integer :: lchnk ! chunk identifier
+ integer :: ncol ! longitude dimension
+ real(r8) tem2(pcols) ! temporary workspace
+ real(r8) ftem(pcols) ! temporary workspace
+
+ real(r8), pointer :: trefmnav(:) ! daily minimum tref
+ real(r8), pointer :: trefmxav(:) ! daily maximum tref
+
+ !
+ !-----------------------------------------------------------------------
+ !
+ lchnk = cam_in%lchnk
+ ncol = cam_in%ncol
+
+ if (moist_physics) then
+ call outfld('SHFLX', cam_in%shf, pcols, lchnk)
+ call outfld('LHFLX', cam_in%lhf, pcols, lchnk)
+ call outfld('QFLX', cam_in%cflx(1,1), pcols, lchnk)
+
+ call outfld('TAUX', cam_in%wsx, pcols, lchnk)
+ call outfld('TAUY', cam_in%wsy, pcols, lchnk)
+ call outfld('TREFHT ', cam_in%tref, pcols, lchnk)
+ call outfld('TREFHTMX', cam_in%tref, pcols, lchnk)
+ call outfld('TREFHTMN', cam_in%tref, pcols, lchnk)
+ call outfld('QREFHT', cam_in%qref, pcols, lchnk)
+ call outfld('U10', cam_in%u10, pcols, lchnk)
+ !
+ ! Calculate and output reference height RH (RHREFHT)
+
+ call qsat(cam_in%tref(:ncol), state%ps(:ncol), tem2(:ncol), ftem(:ncol))
+ ftem(:ncol) = cam_in%qref(:ncol)/ftem(:ncol)*100._r8
+
+
+ call outfld('RHREFHT', ftem, pcols, lchnk)
+
+
+#if (defined BFB_CAM_SCAM_IOP )
+ call outfld('shflx ',cam_in%shf, pcols, lchnk)
+ call outfld('lhflx ',cam_in%lhf, pcols, lchnk)
+ call outfld('trefht ',cam_in%tref, pcols, lchnk)
+#endif
+ !
+ ! Ouput ocn and ice fractions
+ !
+ call outfld('LANDFRAC', cam_in%landfrac, pcols, lchnk)
+ call outfld('ICEFRAC', cam_in%icefrac, pcols, lchnk)
+ call outfld('OCNFRAC', cam_in%ocnfrac, pcols, lchnk)
+ !
+ ! Compute daily minimum and maximum of TREF
+ !
+ call pbuf_get_field(pbuf, trefmxav_idx, trefmxav)
+ call pbuf_get_field(pbuf, trefmnav_idx, trefmnav)
+ do i = 1,ncol
+ trefmxav(i) = max(cam_in%tref(i),trefmxav(i))
+ trefmnav(i) = min(cam_in%tref(i),trefmnav(i))
+ end do
+ if (is_end_curr_day()) then
+ call outfld('TREFMXAV', trefmxav,pcols, lchnk )
+ call outfld('TREFMNAV', trefmnav,pcols, lchnk )
+ trefmxav(:ncol) = -1.0e36_r8
+ trefmnav(:ncol) = 1.0e36_r8
+ endif
+
+ call outfld('TBOT', cam_out%tbot, pcols, lchnk)
+ call outfld('TS', cam_in%ts, pcols, lchnk)
+ call outfld('TSMN', cam_in%ts, pcols, lchnk)
+ call outfld('TSMX', cam_in%ts, pcols, lchnk)
+ call outfld('SNOWHLND', cam_in%snowhland, pcols, lchnk)
+ call outfld('SNOWHICE', cam_in%snowhice, pcols, lchnk)
+ call outfld('ASDIR', cam_in%asdir, pcols, lchnk)
+ call outfld('ASDIF', cam_in%asdif, pcols, lchnk)
+ call outfld('ALDIR', cam_in%aldir, pcols, lchnk)
+ call outfld('ALDIF', cam_in%aldif, pcols, lchnk)
+ call outfld('SST', cam_in%sst, pcols, lchnk)
+
+ if (co2_transport()) then
+ do m = 1,4
+ call outfld(sflxnam(c_i(m)), cam_in%cflx(:,c_i(m)), pcols, lchnk)
+ end do
+ end if
+ end if
+
+ end subroutine diag_surf
+
+!===============================================================================
+
+ subroutine diag_export(cam_out)
+
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose: Write export state to history file
+ !
+ !-----------------------------------------------------------------------
+
+ ! arguments
+ type(cam_out_t), intent(inout) :: cam_out
+
+ ! Local variables:
+ integer :: lchnk ! chunk identifier
+ logical :: atm_dep_flux ! true ==> sending deposition fluxes to coupler.
+ ! Otherwise, set them to zero.
+ !-----------------------------------------------------------------------
+
+ lchnk = cam_out%lchnk
+
+ call phys_getopts(atm_dep_flux_out=atm_dep_flux)
+
+ if (.not. atm_dep_flux) then
+ ! set the fluxes to zero before outfld and sending them to the
+ ! coupler
+ cam_out%bcphiwet = 0.0_r8
+ cam_out%bcphidry = 0.0_r8
+ cam_out%bcphodry = 0.0_r8
+ cam_out%ocphiwet = 0.0_r8
+ cam_out%ocphidry = 0.0_r8
+ cam_out%ocphodry = 0.0_r8
+ cam_out%dstwet1 = 0.0_r8
+ cam_out%dstdry1 = 0.0_r8
+ cam_out%dstwet2 = 0.0_r8
+ cam_out%dstdry2 = 0.0_r8
+ cam_out%dstwet3 = 0.0_r8
+ cam_out%dstdry3 = 0.0_r8
+ cam_out%dstwet4 = 0.0_r8
+ cam_out%dstdry4 = 0.0_r8
+ end if
+
+ if (moist_physics) then
+ call outfld('a2x_BCPHIWET', cam_out%bcphiwet, pcols, lchnk)
+ call outfld('a2x_BCPHIDRY', cam_out%bcphidry, pcols, lchnk)
+ call outfld('a2x_BCPHODRY', cam_out%bcphodry, pcols, lchnk)
+ call outfld('a2x_OCPHIWET', cam_out%ocphiwet, pcols, lchnk)
+ call outfld('a2x_OCPHIDRY', cam_out%ocphidry, pcols, lchnk)
+ call outfld('a2x_OCPHODRY', cam_out%ocphodry, pcols, lchnk)
+ call outfld('a2x_DSTWET1', cam_out%dstwet1, pcols, lchnk)
+ call outfld('a2x_DSTDRY1', cam_out%dstdry1, pcols, lchnk)
+ call outfld('a2x_DSTWET2', cam_out%dstwet2, pcols, lchnk)
+ call outfld('a2x_DSTDRY2', cam_out%dstdry2, pcols, lchnk)
+ call outfld('a2x_DSTWET3', cam_out%dstwet3, pcols, lchnk)
+ call outfld('a2x_DSTDRY3', cam_out%dstdry3, pcols, lchnk)
+ call outfld('a2x_DSTWET4', cam_out%dstwet4, pcols, lchnk)
+ call outfld('a2x_DSTDRY4', cam_out%dstdry4, pcols, lchnk)
+ end if
+
+ end subroutine diag_export
+
+!#######################################################################
+
+ subroutine diag_physvar_ic (lchnk, pbuf, cam_out, cam_in)
+ !
+ !---------------------------------------------
+ !
+ ! Purpose: record physics variables on IC file
+ !
+ !---------------------------------------------
+ !
+
+ !
+ ! Arguments
+ !
+ integer , intent(in) :: lchnk ! chunk identifier
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ type(cam_out_t), intent(inout) :: cam_out
+ type(cam_in_t), intent(inout) :: cam_in
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+ integer :: k ! indices
+ integer :: itim_old ! indices
+
+ real(r8), pointer, dimension(:,:) :: cwat_var
+ real(r8), pointer, dimension(:,:) :: conv_var_3d
+ real(r8), pointer, dimension(: ) :: conv_var_2d
+ real(r8), pointer :: tpert(:), pblh(:), qpert(:)
+ !
+ !-----------------------------------------------------------------------
+ !
+ if( write_inithist() .and. moist_physics ) then
+
+ !
+ ! Associate pointers with physics buffer fields
+ !
+ itim_old = pbuf_old_tim_idx()
+
+ if (qcwat_idx > 0) then
+ call pbuf_get_field(pbuf, qcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call outfld('QCWAT&IC ',cwat_var, pcols,lchnk)
+ end if
+
+ if (tcwat_idx > 0) then
+ call pbuf_get_field(pbuf, tcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call outfld('TCWAT&IC ',cwat_var, pcols,lchnk)
+ end if
+
+ if (lcwat_idx > 0) then
+ call pbuf_get_field(pbuf, lcwat_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call outfld('LCWAT&IC ',cwat_var, pcols,lchnk)
+ end if
+
+ if (cld_idx > 0) then
+ call pbuf_get_field(pbuf, cld_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call outfld('CLOUD&IC ',cwat_var, pcols,lchnk)
+ end if
+
+ if (concld_idx > 0) then
+ call pbuf_get_field(pbuf, concld_idx, cwat_var, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call outfld('CONCLD&IC ',cwat_var, pcols,lchnk)
+ end if
+
+ if (cush_idx > 0) then
+ call pbuf_get_field(pbuf, cush_idx, conv_var_2d ,(/1,itim_old/), (/pcols,1/))
+ call outfld('CUSH&IC ',conv_var_2d, pcols,lchnk)
+
+ end if
+
+ if (tke_idx > 0) then
+ call pbuf_get_field(pbuf, tke_idx, conv_var_3d)
+ call outfld('TKE&IC ',conv_var_3d, pcols,lchnk)
+ end if
+
+ if (kvm_idx > 0) then
+ call pbuf_get_field(pbuf, kvm_idx, conv_var_3d)
+ call outfld('KVM&IC ',conv_var_3d, pcols,lchnk)
+ end if
+
+ if (kvh_idx > 0) then
+ call pbuf_get_field(pbuf, kvh_idx, conv_var_3d)
+ call outfld('KVH&IC ',conv_var_3d, pcols,lchnk)
+ end if
+
+ if (qpert_idx > 0) then
+ call pbuf_get_field(pbuf, qpert_idx, qpert)
+ call outfld('QPERT&IC ', qpert, pcols, lchnk)
+ end if
+
+ if (pblh_idx > 0) then
+ call pbuf_get_field(pbuf, pblh_idx, pblh)
+ call outfld('PBLH&IC ', pblh, pcols, lchnk)
+ end if
+
+ if (tpert_idx > 0) then
+ call pbuf_get_field(pbuf, tpert_idx, tpert)
+ call outfld('TPERT&IC ', tpert, pcols, lchnk)
+ end if
+
+ end if
+
+ end subroutine diag_physvar_ic
+
+
+!#######################################################################
+
+ !subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt)
+ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt, tmp_t, eflx, dsema) !tht
+
+ !---------------------------------------------------------------
+ !
+ ! Purpose: Dump physics tendencies for temperature
+ !
+ !---------------------------------------------------------------
+
+ use check_energy, only: check_energy_get_integrals
+ use physconst, only: cpair
+
+ ! Arguments
+
+ type(physics_state), intent(in) :: state
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ type(physics_tend ), intent(in) :: tend
+ real(r8), intent(in) :: ztodt ! physics timestep
+
+ real(r8) , intent(inout) :: tmp_t (pcols,pver) !tht: holds last physics_updated T (FV)
+ real(r8) , intent(in), optional ::eflx (pcols ) !tht: surface sensible heat flux assoc.with mass adj.
+ real(r8) , intent(in), optional ::dsema(pcols ) !tht: column enthalpy tendency assoc. with mass adj.
+
+ !---------------------------Local workspace-----------------------------
+
+ integer :: lchnk ! chunk index
+ integer :: ncol ! number of columns in chunk
+ real(r8) :: ftem2(pcols) ! Temporary workspace for outfld variables
+ real(r8) :: ftem3(pcols,pver) ! Temporary workspace for outfld variables
+ real(r8) :: heat_glob ! tht: T-tend from fixer (FV only)
+ real(r8) :: tedif_glob !+tht energy flux from fixer (FV only)
+ ! CAM pointers to get variables from the physics buffer
+ real(r8), pointer, dimension(:,:) :: t_ttend
+ integer :: itim_old,m
+
+ !-----------------------------------------------------------------------
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ ! Dump out post-physics state (FV only)
+
+ call outfld('TAP', state%t, pcols, lchnk )
+ call outfld('UAP', state%u, pcols, lchnk )
+ call outfld('VAP', state%v, pcols, lchnk )
+
+ !tht: heat tendencies from dme_adjust
+ if (dycore_is('LR')) then
+ tmp_t(:ncol,:pver) = (state%t(:ncol,:pver) - tmp_t(:ncol,:pver))/ztodt ! T tendency
+ call outfld('PTTEND_DME', tmp_t, pcols, lchnk )
+ if(present(dsema))call outfld('IETEND_DME', dsema, pcols, lchnk) ! dry enthalpy
+ if(present(eflx) )call outfld('EFLX' , eflx, pcols, lchnk) ! moist enthalpy
+ end if
+
+ ! Total physics tendency for Temperature
+ ! (remove global fixer tendency from total for FV and SE dycores)
+
+ if (dycore_is('LR') .or. dycore_is('SE')) then
+ call check_energy_get_integrals( heat_glob_out=heat_glob , tedif_glob_out=tedif_glob ) !+tht tedif
+ ftem2(:ncol) = heat_glob/cpair
+ call outfld('TFIX', ftem2, pcols, lchnk )
+!+tht
+ ftem2(:ncol) = tedif_glob/ztodt
+ call outfld('EBREAK', ftem2, pcols, lchnk )
+!-tht
+ ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver) - heat_glob/cpair
+ else
+ ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver)
+ end if
+ call outfld('PTTEND',ftem3, pcols, lchnk )
+
+ ! Total (physics+dynamics, everything!) tendency for Temperature
+
+ !! get temperature stored in physics buffer
+ itim_old = pbuf_old_tim_idx()
+ call pbuf_get_field(pbuf, t_ttend_idx, t_ttend, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+
+ !! calculate and outfld the total temperature tendency
+ ftem3(:ncol,:) = (state%t(:ncol,:) - t_ttend(:ncol,:))/ztodt
+ call outfld('TTEND_TOT', ftem3, pcols, lchnk)
+
+ !! update physics buffer with this time-step's temperature
+ t_ttend(:ncol,:) = state%t(:ncol,:)
+
+ end subroutine diag_phys_tend_writeout_dry
+
+!#######################################################################
+
+ subroutine diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, &
+ tmp_q, tmp_cldliq, tmp_cldice, tmp_cldnc, tmp_cldni &
+ ,qini, cldliqini, cldiceini , cldncini, cldniini )
+
+ !---------------------------------------------------------------
+ !
+ ! Purpose: Dump physics tendencies for moisture
+ !
+ !---------------------------------------------------------------
+
+ ! Arguments
+
+ type(physics_state), intent(in) :: state
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ type(physics_tend ), intent(in) :: tend
+ real(r8), intent(in) :: ztodt ! physics timestep
+ real(r8), intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV)
+ real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV)
+ real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV)
+ real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics
+ real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics
+ real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics
+!AL
+ real(r8) , intent(inout) :: tmp_cldnc(pcols,pver) ! As input, holds pre-adjusted tracers (FV)
+ real(r8) , intent(inout) :: tmp_cldni(pcols,pver) ! As input, holds pre-adjusted tracers (FV)
+ real(r8) , intent(in ) :: cldncini (pcols,pver) ! tracer fields at beginning of physics
+ real(r8) , intent(in ) :: cldniini (pcols,pver) ! tracer fields at beginning of physics
+!AL
+ !---------------------------Local workspace-----------------------------
+
+ integer :: lchnk ! chunk index
+ integer :: ncol ! number of columns in chunk
+ real(r8) :: ftem3(pcols,pver) ! Temporary workspace for outfld variables
+ real(r8) :: rtdt
+ integer :: ixcldice, ixcldliq! constituent indices for cloud liquid and ice water.
+!AL
+ integer :: ixnumice, ixnumliq! constituent indices for cloud liquid and ice water.
+!AL
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+ rtdt = 1._r8/ztodt
+ call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.)
+ call cnst_get_ind('CLDICE', ixcldice, abort=.false.)
+!AL
+ call cnst_get_ind('NUMLIQ', ixnumliq)
+ call cnst_get_ind('NUMICE', ixnumice)
+!AL
+
+ if ( cnst_cam_outfld( 1) ) then
+ call outfld (apcnst( 1), state%q(1,1, 1), pcols, lchnk)
+ end if
+ if (ixcldliq > 0) then
+ if (cnst_cam_outfld(ixcldliq)) then
+ call outfld (apcnst(ixcldliq), state%q(1,1,ixcldliq), pcols, lchnk)
+ end if
+ end if
+ if (ixcldice > 0) then
+ if ( cnst_cam_outfld(ixcldice) ) then
+ call outfld (apcnst(ixcldice), state%q(1,1,ixcldice), pcols, lchnk)
+ end if
+ end if
+
+ ! Tendency for dry mass adjustment of q (FV only)
+
+ if (dycore_is('LR')) then
+ tmp_q (:ncol,:pver) = (state%q(:ncol,:pver, 1) - tmp_q (:ncol,:pver))*rtdt
+ if (ixcldliq > 0) then
+ tmp_cldliq(:ncol,:pver) = (state%q(:ncol,:pver,ixcldliq) - tmp_cldliq(:ncol,:pver))*rtdt
+ else
+ tmp_cldliq(:ncol,:pver) = 0.0_r8
+ end if
+ if (ixcldice > 0) then
+ tmp_cldice(:ncol,:pver) = (state%q(:ncol,:pver,ixcldice) - tmp_cldice(:ncol,:pver))*rtdt
+ else
+ tmp_cldice(:ncol,:pver) = 0.0_r8
+ end if
+ if ( cnst_cam_outfld( 1) ) then
+ call outfld (dmetendnam( 1), tmp_q , pcols, lchnk)
+ end if
+ if (ixcldliq > 0) then
+ if ( cnst_cam_outfld(ixcldliq) ) then
+ call outfld (dmetendnam(ixcldliq), tmp_cldliq, pcols, lchnk)
+ end if
+ end if
+ if (ixcldice > 0) then
+ if ( cnst_cam_outfld(ixcldice) ) then
+ call outfld (dmetendnam(ixcldice), tmp_cldice, pcols, lchnk)
+ end if
+ end if
+!AL
+ tmp_cldnc(:ncol,:pver) = (state%q(:ncol,:pver,ixnumliq) - tmp_cldnc(:ncol,:pver))*rtdt
+ tmp_cldni(:ncol,:pver) = (state%q(:ncol,:pver,ixnumice) - tmp_cldni(:ncol,:pver))*rtdt
+ if ( cnst_cam_outfld(ixnumliq) ) call outfld (dmetendnam(ixnumliq), tmp_cldnc, pcols, lchnk)
+ if ( cnst_cam_outfld(ixnumice) ) call outfld (dmetendnam(ixnumice), tmp_cldni, pcols, lchnk)
+!AL
+ end if
+
+ ! Total physics tendency for moisture and other tracers
+
+ if ( cnst_cam_outfld( 1) ) then
+ ftem3(:ncol,:pver) = (state%q(:ncol,:pver, 1) - qini (:ncol,:pver) )*rtdt
+ call outfld (ptendnam( 1), ftem3, pcols, lchnk)
+ end if
+ if (ixcldliq > 0) then
+ if (cnst_cam_outfld(ixcldliq) ) then
+ ftem3(:ncol,:pver) = (state%q(:ncol,:pver,ixcldliq) - cldliqini(:ncol,:pver) )*rtdt
+ call outfld (ptendnam(ixcldliq), ftem3, pcols, lchnk)
+ end if
+ end if
+ if (ixcldice > 0) then
+ if ( cnst_cam_outfld(ixcldice) ) then
+ ftem3(:ncol,:pver) = (state%q(:ncol,:pver,ixcldice) - cldiceini(:ncol,:pver) )*rtdt
+ call outfld (ptendnam(ixcldice), ftem3, pcols, lchnk)
+ end if
+ end if
+!AL
+ if ( cnst_cam_outfld(ixnumliq) ) then
+ ftem3(:ncol,:pver) = (state%q(:ncol,:pver,ixnumliq) - cldncini(:ncol,:pver) )*rtdt
+ call outfld (ptendnam(ixnumliq), ftem3, pcols, lchnk)
+ end if
+ if ( cnst_cam_outfld(ixnumice) ) then
+ ftem3(:ncol,:pver) = (state%q(:ncol,:pver,ixnumice) - cldniini(:ncol,:pver) )*rtdt
+ call outfld (ptendnam(ixnumice), ftem3, pcols, lchnk)
+ end if
+
+!AL
+
+ end subroutine diag_phys_tend_writeout_moist
+
+!#######################################################################
+
+!AL
+! subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, &
+! tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini)
+!AL
+ subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt &
+ , tmp_q, tmp_t, tmp_cldliq, tmp_cldice, tmp_cldnc,tmp_cldni &
+ , qini, cldliqini, cldiceini,cldncini, cldniini, eflx, dsema)
+ !---------------------------------------------------------------
+ !
+ ! Purpose: Dump physics tendencies for moisture and temperature
+ !
+ !---------------------------------------------------------------
+
+ ! Arguments
+
+ type(physics_state), intent(in) :: state
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ type(physics_tend ), intent(in) :: tend
+ real(r8), intent(in) :: ztodt ! physics timestep
+ real(r8) , intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV)
+ real(r8) , intent(inout) :: tmp_t (pcols,pver) !tht: holds last physics_updated T (FV)
+ real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV)
+ real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV)
+ real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics
+ real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics
+ real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics
+!AL
+ real(r8) , intent(inout) :: tmp_cldnc(pcols,pver) ! As input, holds pre-adjusted tracers (FV)
+ real(r8) , intent(inout) :: tmp_cldni(pcols,pver) ! As input, holds pre-adjusted tracers (FV)
+ real(r8) , intent(in ) :: cldncini (pcols,pver) ! tracer fields at beginning of physics
+ real(r8) , intent(in ) :: cldniini (pcols,pver) ! tracer fields at beginning of physics
+!AL
+ real(r8) , intent(in), optional ::eflx (pcols ) !tht: surface sensible heat flux assoc.with mass adj.
+ real(r8) , intent(in), optional ::dsema(pcols ) !tht: column enthalpy tendency assoc. with mass adj.
+
+ !-----------------------------------------------------------------------
+
+ !call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt)
+ call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt, tmp_t, eflx, dsema) !tht
+ if (moist_physics) then
+ call diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, &
+ tmp_q, tmp_cldliq, tmp_cldice, tmp_cldnc, tmp_cldni &
+ ,qini, cldliqini, cldiceini , cldncini, cldniini)
+ end if
+
+ end subroutine diag_phys_tend_writeout
+
+!#######################################################################
+
+ subroutine diag_state_b4_phys_write_dry (state)
+ !
+ !---------------------------------------------------------------
+ !
+ ! Purpose: Dump dry state just prior to executing physics
+ !
+ !---------------------------------------------------------------
+ !
+ ! Arguments
+ !
+ type(physics_state), intent(in) :: state
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+ integer :: lchnk ! chunk index
+ !
+ !-----------------------------------------------------------------------
+ !
+ lchnk = state%lchnk
+
+ call outfld('TBP', state%t, pcols, lchnk )
+
+ end subroutine diag_state_b4_phys_write_dry
+
+ subroutine diag_state_b4_phys_write_moist (state)
+ !
+ !---------------------------------------------------------------
+ !
+ ! Purpose: Dump moist state just prior to executing physics
+ !
+ !---------------------------------------------------------------
+ !
+ ! Arguments
+ !
+ type(physics_state), intent(in) :: state
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+ integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water.
+ integer :: lchnk ! chunk index
+ !
+ !-----------------------------------------------------------------------
+ !
+ lchnk = state%lchnk
+
+ call cnst_get_ind('CLDLIQ', ixcldliq, abort=.false.)
+ call cnst_get_ind('CLDICE', ixcldice, abort=.false.)
+
+ if ( cnst_cam_outfld( 1) ) then
+ call outfld (bpcnst( 1), state%q(1,1, 1), pcols, lchnk)
+ end if
+ if (ixcldliq > 0) then
+ if (cnst_cam_outfld(ixcldliq)) then
+ call outfld (bpcnst(ixcldliq), state%q(1,1,ixcldliq), pcols, lchnk)
+ end if
+ end if
+ if (ixcldice > 0) then
+ if (cnst_cam_outfld(ixcldice)) then
+ call outfld (bpcnst(ixcldice), state%q(1,1,ixcldice), pcols, lchnk)
+ end if
+ end if
+
+ end subroutine diag_state_b4_phys_write_moist
+
+ subroutine diag_state_b4_phys_write (state)
+ !
+ !---------------------------------------------------------------
+ !
+ ! Purpose: Dump state just prior to executing physics
+ !
+ !---------------------------------------------------------------
+ !
+ ! Arguments
+ !
+ type(physics_state), intent(in) :: state
+ !
+
+ call diag_state_b4_phys_write_dry(state)
+ if (moist_physics) then
+ call diag_state_b4_phys_write_moist(state)
+ end if
+ end subroutine diag_state_b4_phys_write
+
+end module cam_diagnostics
diff --git a/src/NorESM/cldfrc2m.F90 b/src/NorESM/cldfrc2m.F90
new file mode 100644
index 0000000000..337ec40cd4
--- /dev/null
+++ b/src/NorESM/cldfrc2m.F90
@@ -0,0 +1,1161 @@
+module cldfrc2m
+
+! cloud fraction calculations
+
+use shr_kind_mod, only: r8=>shr_kind_r8
+use spmd_utils, only: masterproc
+use ppgrid, only: pcols
+use physconst, only: rair
+use wv_saturation, only: qsat_water, svp_water, svp_ice
+use cam_logfile, only: iulog
+use cam_abortutils, only: endrun
+
+implicit none
+private
+save
+
+public :: &
+ cldfrc2m_readnl, &
+ cldfrc2m_init, &
+ astG_PDF_single, &
+ astG_PDF, &
+ astG_RHU_single, &
+ astG_RHU, &
+ aist_single, &
+ aist_vector, &
+ CAMstfrac, &
+ rhmini_const, &
+ rhmaxi_const, &
+ rhminis_const, &
+ rhmaxis_const
+
+! Namelist variables
+real(r8) :: cldfrc2m_rhmini ! Minimum rh for ice cloud fraction > 0.
+real(r8) :: cldfrc2m_rhmaxi
+real(r8) :: cldfrc2m_rhminis ! Minimum rh for ice cloud fraction > 0 in the stratsophere.
+real(r8) :: cldfrc2m_rhmaxis
+logical :: cldfrc2m_do_subgrid_growth = .false.
+! -------------------------- !
+! Parameters for Ice Stratus !
+! -------------------------- !
+real(r8), protected :: rhmini_const ! Minimum rh for ice cloud fraction > 0.
+real(r8), protected :: rhmaxi_const
+real(r8), protected :: rhminis_const ! Minimum rh for ice cloud fraction > 0.
+real(r8), protected :: rhmaxis_const
+
+!real(r8), parameter :: qist_min = 1.e-7_r8 ! Minimum in-stratus ice IWC constraint [ kg/kg ]
+real(r8), parameter :: qist_min = 4.e-6_r8 ! Minimum in-stratus ice IWC constraint [ kg/kg ]
+real(r8), parameter :: qist_max = 2.5e-4_r8 ! Maximum in-stratus ice IWC constraint [ kg/kg ]
+
+! ----------------------------- !
+! Parameters for Liquid Stratus !
+! ----------------------------- !
+
+logical, parameter :: CAMstfrac = .false. ! If .true. (.false.),
+ ! use Slingo (triangular PDF-based) liquid stratus fraction
+logical, parameter :: freeze_dry = .false. ! If .true., use 'freeze dry' in liquid stratus fraction formula
+real(r8) :: rhminl_const ! Critical RH for low-level liquid stratus clouds
+real(r8) :: rhminl_adj_land_const ! rhminl adjustment for snowfree land
+real(r8) :: rhminh_const ! Critical RH for high-level liquid stratus clouds
+real(r8) :: premit ! Top height for mid-level liquid stratus fraction
+real(r8) :: premib ! Bottom height for mid-level liquid stratus fraction
+integer :: iceopt ! option for ice cloud closure
+ ! 1=wang & sassen 2=schiller (iciwc)
+ ! 3=wood & field, 4=Wilson (based on smith)
+ ! 5=modified slingo (ssat & empyt cloud)
+real(r8) :: icecrit ! Critical RH for ice clouds in Wilson & Ballard closure
+ ! ( smaller = more ice clouds )
+
+!================================================================================================
+contains
+!================================================================================================
+
+subroutine cldfrc2m_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use spmd_utils, only: mpicom, masterprocid, mpi_logical, mpi_real8
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'cldfrc2m_readnl'
+
+ namelist /cldfrc2m_nl/ cldfrc2m_rhmini, cldfrc2m_rhmaxi, cldfrc2m_rhminis, cldfrc2m_rhmaxis, cldfrc2m_do_subgrid_growth
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'cldfrc2m_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, cldfrc2m_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+
+ ! set local variables
+ rhmini_const = cldfrc2m_rhmini
+ rhmaxi_const = cldfrc2m_rhmaxi
+ rhminis_const = cldfrc2m_rhminis
+ rhmaxis_const = cldfrc2m_rhmaxis
+
+ end if
+
+ ! Broadcast namelist variables
+ call mpi_bcast(rhmini_const, 1, mpi_real8, masterprocid, mpicom, ierr)
+ call mpi_bcast(rhmaxi_const, 1, mpi_real8, masterprocid, mpicom, ierr)
+ call mpi_bcast(rhminis_const, 1, mpi_real8, masterprocid, mpicom, ierr)
+ call mpi_bcast(rhmaxis_const, 1, mpi_real8, masterprocid, mpicom, ierr)
+ call mpi_bcast(cldfrc2m_do_subgrid_growth, 1, mpi_logical,masterprocid, mpicom, ierr)
+
+end subroutine cldfrc2m_readnl
+
+!================================================================================================
+
+subroutine cldfrc2m_init()
+
+ use cloud_fraction, only: cldfrc_getparams
+
+ call cldfrc_getparams(rhminl_out=rhminl_const, rhminl_adj_land_out=rhminl_adj_land_const, &
+ rhminh_out=rhminh_const, premit_out=premit, premib_out=premib, &
+ iceopt_out=iceopt, icecrit_out=icecrit)
+
+ if( masterproc ) then
+ write(iulog,*) 'cldfrc2m parameters:'
+ write(iulog,*) ' rhminl = ', rhminl_const
+ write(iulog,*) ' rhminl_adj_land = ', rhminl_adj_land_const
+ write(iulog,*) ' rhminh = ', rhminh_const
+ write(iulog,*) ' premit = ', premit
+ write(iulog,*) ' premib = ', premib
+ write(iulog,*) ' iceopt = ', iceopt
+ write(iulog,*) ' icecrit = ', icecrit
+ write(iulog,*) ' rhmini = ', rhmini_const
+ write(iulog,*) ' rhmaxi = ', rhmaxi_const
+ write(iulog,*) ' rhminis = ', rhminis_const
+ write(iulog,*) ' rhmaxis = ', rhmaxis_const
+ write(iulog,*) ' do_subgrid_growth = ', cldfrc2m_do_subgrid_growth
+ end if
+
+end subroutine cldfrc2m_init
+
+!================================================================================================
+
+
+subroutine astG_PDF_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, &
+ rhminl_in, rhminl_adj_land_in, rhminh_in )
+
+ ! --------------------------------------------------------- !
+ ! Compute 'stratus fraction(a)' and Gs=(dU/da) from the !
+ ! analytical formulation of triangular PDF. !
+ ! Here, 'dV' is the ratio of 'half-width of PDF / qs(p,T)', !
+ ! so using constant 'dV' assume that width is proportional !
+ ! to the saturation specific humidity. !
+ ! dV ~ 0.1. !
+ ! cldrh : RH of in-stratus( = 1 if no supersaturation) !
+ ! Note that if U > 1, Ga = 1.e10 instead of Ga = 0, that is !
+ ! G is discontinuous across U = 1. In fact, it does not !
+ ! matter whether Ga = 1.e10 or 0 at a = 1: I derived that !
+ ! they will produce the same results. !
+ ! --------------------------------------------------------- !
+
+ real(r8), intent(in) :: U ! Relative humidity
+ real(r8), intent(in) :: p ! Pressure [Pa]
+ real(r8), intent(in) :: qv ! Grid-mean water vapor specific humidity [kg/kg]
+ real(r8), intent(in) :: landfrac ! Land fraction
+ real(r8), intent(in) :: snowh ! Snow depth (liquid water equivalent)
+
+ real(r8), intent(out) :: a ! Stratus fraction
+ real(r8), intent(out) :: Ga ! dU/da
+ real(r8), optional, intent(out) :: orhmin ! Critical RH
+
+ real(r8), optional, intent(in) :: rhminl_in ! Critical relative humidity for low-level liquid stratus
+ real(r8), optional, intent(in) :: rhminl_adj_land_in ! Adjustment drop of rhminl over the land
+ real(r8), optional, intent(in) :: rhminh_in ! Critical relative humidity for high-level liquid stratus
+
+ ! Local variables
+ integer :: i ! Loop indexes
+ real(r8) dV ! Width of triangular PDF
+ real(r8) cldrh ! RH of stratus cloud
+ real(r8) rhmin ! Critical RH
+ real(r8) rhwght
+
+ real(r8) :: rhminl
+ real(r8) :: rhminl_adj_land
+ real(r8) :: rhminh
+
+ ! Statement functions
+ logical land
+ land = nint(landfrac) == 1
+
+ ! ---------- !
+ ! Parameters !
+ ! ---------- !
+
+ cldrh = 1.0_r8
+
+ rhminl = rhminl_const
+ if (present(rhminl_in)) rhminl = rhminl_in
+ rhminl_adj_land = rhminl_adj_land_const
+ if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in
+ rhminh = rhminh_const
+ if (present(rhminh_in)) rhminh = rhminh_in
+
+ ! ---------------- !
+ ! Main computation !
+ ! ---------------- !
+
+ if( p .ge. premib ) then
+
+ if( land .and. (snowh.le.0.000001_r8) ) then
+ rhmin = rhminl - rhminl_adj_land
+ else
+ rhmin = rhminl
+ endif
+
+ dV = cldrh - rhmin
+
+ if( U .ge. 1._r8 ) then
+ a = 1._r8
+ Ga = 1.e10_r8
+ elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then
+ a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8)
+ Ga = dV/sqrt(2._r8)*sqrt(1._r8-a)
+ elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then
+ a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* &
+ (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8
+ Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a))
+ elseif( U .le. (cldrh-dV) ) then
+ a = 0._r8
+ Ga = 1.e10_r8
+ endif
+
+ if( freeze_dry ) then
+ a = a *max(0.15_r8,min(1.0_r8,qv/0.0030_r8))
+ Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8))
+ endif
+
+ elseif( p .lt. premit ) then
+
+ rhmin = rhminh
+ dV = cldrh - rhmin
+
+ if( U .ge. 1._r8 ) then
+ a = 1._r8
+ Ga = 1.e10_r8
+ elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then
+ a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8)
+ Ga = dV/sqrt(2._r8)*sqrt(1._r8-a)
+ elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then
+ a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* &
+ (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8
+ Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a))
+ elseif( U .le. (cldrh-dV) ) then
+ a = 0._r8
+ Ga = 1.e10_r8
+ endif
+
+ else
+
+ rhwght = (premib-(max(p,premit)))/(premib-premit)
+
+ ! if( land .and. (snowh.le.0.000001_r8) ) then
+ ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght)
+ ! else
+ rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght)
+ ! endif
+
+ dV = cldrh - rhmin
+
+ if( U .ge. 1._r8 ) then
+ a = 1._r8
+ Ga = 1.e10_r8
+ elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then
+ a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8)
+ Ga = dV/sqrt(2._r8)*sqrt(1._r8-a)
+ elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then
+ a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* &
+ (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8
+ Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a))
+ elseif( U .le. (cldrh-dV) ) then
+ a = 0._r8
+ Ga = 1.e10_r8
+ endif
+
+ endif
+
+ if (present(orhmin)) orhmin = rhmin
+
+end subroutine astG_PDF_single
+
+!================================================================================================
+
+subroutine astG_PDF(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, ncol, &
+ rhminl_in, rhminl_adj_land_in, rhminh_in )
+
+ ! --------------------------------------------------------- !
+ ! Compute 'stratus fraction(a)' and Gs=(dU/da) from the !
+ ! analytical formulation of triangular PDF. !
+ ! Here, 'dV' is the ratio of 'half-width of PDF / qs(p,T)', !
+ ! so using constant 'dV' assume that width is proportional !
+ ! to the saturation specific humidity. !
+ ! dV ~ 0.1. !
+ ! cldrh : RH of in-stratus( = 1 if no supersaturation) !
+ ! Note that if U > 1, Ga = 1.e10 instead of Ga = 0, that is !
+ ! G is discontinuous across U = 1. In fact, it does not !
+ ! matter whether Ga = 1.e10 or 0 at a = 1: I derived that !
+ ! they will produce the same results. !
+ ! --------------------------------------------------------- !
+
+ real(r8), intent(in) :: U_in(pcols) ! Relative humidity
+ real(r8), intent(in) :: p_in(pcols) ! Pressure [Pa]
+ real(r8), intent(in) :: qv_in(pcols) ! Grid-mean water vapor specific humidity [kg/kg]
+ real(r8), intent(in) :: landfrac_in(pcols) ! Land fraction
+ real(r8), intent(in) :: snowh_in(pcols) ! Snow depth (liquid water equivalent)
+
+ real(r8), intent(out) :: a_out(pcols) ! Stratus fraction
+ real(r8), intent(out) :: Ga_out(pcols) ! dU/da
+ integer, intent(in) :: ncol
+
+ real(r8), optional, intent(in) :: rhminl_in(pcols) ! Critical relative humidity for low-level liquid stratus
+ real(r8), optional, intent(in) :: rhminl_adj_land_in(pcols) ! Adjustment drop of rhminl over the land
+ real(r8), optional, intent(in) :: rhminh_in(pcols) ! Critical relative humidity for high-level liquid stratus
+
+ real(r8) :: rhminl ! Critical relative humidity for low-level liquid stratus
+ real(r8) :: rhminl_adj_land ! Adjustment drop of rhminl over the land
+ real(r8) :: rhminh ! Critical relative humidity for high-level liquid stratus
+
+ real(r8) :: U ! Relative humidity
+ real(r8) :: p ! Pressure [Pa]
+ real(r8) :: qv ! Grid-mean water vapor specific humidity [kg/kg]
+ real(r8) :: landfrac ! Land fraction
+ real(r8) :: snowh ! Snow depth (liquid water equivalent)
+
+ real(r8) :: a ! Stratus fraction
+ real(r8) :: Ga ! dU/da
+
+ ! Local variables
+ integer :: i ! Loop indexes
+ real(r8) dV ! Width of triangular PDF
+ real(r8) cldrh ! RH of stratus cloud
+ real(r8) rhmin ! Critical RH
+ real(r8) rhwght
+
+ ! Statement functions
+ logical land
+ land(i) = nint(landfrac_in(i)) == 1
+
+ ! ---------- !
+ ! Parameters !
+ ! ---------- !
+
+ cldrh = 1.0_r8
+
+ rhminl = rhminl_const
+ rhminl_adj_land = rhminl_adj_land_const
+ rhminh = rhminh_const
+
+ ! ---------------- !
+ ! Main computation !
+ ! ---------------- !
+
+ a_out(:) = 0._r8
+ Ga_out(:) = 0._r8
+
+ do i = 1, ncol
+
+ U = U_in(i)
+ p = p_in(i)
+ qv = qv_in(i)
+ landfrac = landfrac_in(i)
+ snowh = snowh_in(i)
+
+ if (present(rhminl_in)) rhminl = rhminl_in(i)
+ if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in(i)
+ if (present(rhminh_in)) rhminh = rhminh_in(i)
+
+ if( p .ge. premib ) then
+
+ if( land(i) .and. (snowh.le.0.000001_r8) ) then
+ rhmin = rhminl - rhminl_adj_land
+ else
+ rhmin = rhminl
+ endif
+
+ dV = cldrh - rhmin
+
+ if( U .ge. 1._r8 ) then
+ a = 1._r8
+ Ga = 1.e10_r8
+ elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then
+ a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8)
+ Ga = dV/sqrt(2._r8)*sqrt(1._r8-a)
+ elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then
+ a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* &
+ (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8
+ Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a))
+ elseif( U .le. (cldrh-dV) ) then
+ a = 0._r8
+ Ga = 1.e10_r8
+ endif
+
+ if( freeze_dry ) then
+ a = a *max(0.15_r8,min(1.0_r8,qv/0.0030_r8))
+ Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8))
+ endif
+
+ elseif( p .lt. premit ) then
+
+ rhmin = rhminh
+ dV = cldrh - rhmin
+
+ if( U .ge. 1._r8 ) then
+ a = 1._r8
+ Ga = 1.e10_r8
+ elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then
+ a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8)
+ Ga = dV/sqrt(2._r8)*sqrt(1._r8-a)
+ elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then
+ a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* &
+ (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8
+ Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a))
+ elseif( U .le. (cldrh-dV) ) then
+ a = 0._r8
+ Ga = 1.e10_r8
+ endif
+
+ else
+
+ rhwght = (premib-(max(p,premit)))/(premib-premit)
+
+ ! if( land(i) .and. (snowh.le.0.000001_r8) ) then
+ ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght)
+ ! else
+ rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght)
+ ! endif
+
+ dV = cldrh - rhmin
+
+ if( U .ge. 1._r8 ) then
+ a = 1._r8
+ Ga = 1.e10_r8
+ elseif( U .gt. (cldrh-dV/6._r8) .and. U .lt. 1._r8 ) then
+ a = 1._r8 - (-3._r8/sqrt(2._r8)*(U-cldrh)/dV)**(2._r8/3._r8)
+ Ga = dV/sqrt(2._r8)*sqrt(1._r8-a)
+ elseif( U .gt. (cldrh-dV) .and. U .le. (cldrh-dV/6._r8) ) then
+ a = 4._r8*(cos((1._r8/3._r8)*(acos((3._r8/2._r8/sqrt(2._r8))* &
+ (1._r8+(U-cldrh)/dV))-2._r8*3.141592_r8)))**2._r8
+ Ga = dV/sqrt(2._r8)*(1._r8/sqrt(a)-sqrt(a))
+ elseif( U .le. (cldrh-dV) ) then
+ a = 0._r8
+ Ga = 1.e10_r8
+ endif
+
+ endif
+
+ a_out(i) = a
+ Ga_out(i) = Ga
+
+ enddo
+
+end subroutine astG_PDF
+!================================================================================================
+
+subroutine astG_RHU_single(U, p, qv, landfrac, snowh, a, Ga, orhmin, &
+ rhminl_in, rhminl_adj_land_in, rhminh_in )
+
+ ! --------------------------------------------------------- !
+ ! Compute 'stratus fraction(a)' and Gs=(dU/da) from the !
+ ! CAM35 cloud fraction formula. !
+ ! Below is valid only for CAMUW at 1.9x2.5 fv dynamics core !
+ ! For the other cases, I should re-define 'rhminl,rhminh' & !
+ ! 'premib,premit'. !
+ ! Note that if U > 1, Ga = 1.e10 instead of Ga = 0, that is !
+ ! G is discontinuous across U = 1. !
+ ! --------------------------------------------------------- !
+
+ real(r8), intent(in) :: U ! Relative humidity
+ real(r8), intent(in) :: p ! Pressure [Pa]
+ real(r8), intent(in) :: qv ! Grid-mean water vapor specific humidity [kg/kg]
+ real(r8), intent(in) :: landfrac ! Land fraction
+ real(r8), intent(in) :: snowh ! Snow depth (liquid water equivalent)
+
+ real(r8), intent(out) :: a ! Stratus fraction
+ real(r8), intent(out) :: Ga ! dU/da
+ real(r8), optional, intent(out) :: orhmin ! Critical RH
+
+ real(r8), optional, intent(in) :: rhminl_in ! Critical relative humidity for low-level liquid stratus
+ real(r8), optional, intent(in) :: rhminl_adj_land_in ! Adjustment drop of rhminl over the land
+ real(r8), optional, intent(in) :: rhminh_in ! Critical relative humidity for high-level liquid stratus
+
+ ! Local variables
+ real(r8) rhmin ! Critical RH
+ real(r8) rhdif ! Factor for stratus fraction
+ real(r8) rhwght
+
+ real(r8) :: rhminl
+ real(r8) :: rhminl_adj_land
+ real(r8) :: rhminh
+
+ ! Statement functions
+ logical land
+ land = nint(landfrac) == 1
+
+ rhminl = rhminl_const
+ if (present(rhminl_in)) rhminl = rhminl_in
+ rhminl_adj_land = rhminl_adj_land_const
+ if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in
+ rhminh = rhminh_const
+ if (present(rhminh_in)) rhminh = rhminh_in
+
+ ! ---------------- !
+ ! Main computation !
+ ! ---------------- !
+
+ if( p .ge. premib ) then
+
+ if( land .and. (snowh.le.0.000001_r8) ) then
+ rhmin = rhminl - rhminl_adj_land
+ else
+ rhmin = rhminl
+ endif
+ rhdif = (U-rhmin)/(1.0_r8-rhmin)
+ a = min(1._r8,(max(rhdif,0.0_r8))**2)
+ if( (U.ge.1._r8) .or. (U.le.rhmin) ) then
+ Ga = 1.e20_r8
+ else
+ Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin))
+ endif
+ if( freeze_dry ) then
+ a = a*max(0.15_r8,min(1.0_r8,qv/0.0030_r8))
+ Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8))
+ endif
+
+ elseif( p .lt. premit ) then
+
+ rhmin = rhminh
+ rhdif = (U-rhmin)/(1.0_r8-rhmin)
+ a = min(1._r8,(max(rhdif,0._r8))**2)
+ if( (U.ge.1._r8) .or. (U.le.rhmin) ) then
+ Ga = 1.e20_r8
+ else
+ Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin))
+ endif
+
+ else
+
+ rhwght = (premib-(max(p,premit)))/(premib-premit)
+
+ ! if( land .and. (snowh.le.0.000001_r8) ) then
+ ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght)
+ ! else
+ rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght)
+ ! endif
+
+ rhdif = (U-rhmin)/(1.0_r8-rhmin)
+ a = min(1._r8,(max(rhdif,0._r8))**2)
+ if( (U.ge.1._r8) .or. (U.le.rhmin) ) then
+ Ga = 1.e10_r8
+ else
+ Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin))
+ endif
+
+ endif
+
+ if (present(orhmin)) orhmin = rhmin
+
+end subroutine astG_RHU_single
+
+!================================================================================================
+
+subroutine astG_RHU(U_in, p_in, qv_in, landfrac_in, snowh_in, a_out, Ga_out, ncol, &
+ rhminl_in, rhminl_adj_land_in, rhminh_in )
+
+ ! --------------------------------------------------------- !
+ ! Compute 'stratus fraction(a)' and Gs=(dU/da) from the !
+ ! CAM35 cloud fraction formula. !
+ ! Below is valid only for CAMUW at 1.9x2.5 fv dynamics core !
+ ! For the other cases, I should re-define 'rhminl,rhminh' & !
+ ! 'premib,premit'. !
+ ! Note that if U > 1, Ga = 1.e10 instead of Ga = 0, that is !
+ ! G is discontinuous across U = 1. !
+ ! --------------------------------------------------------- !
+
+ real(r8), intent(in) :: U_in(pcols) ! Relative humidity
+ real(r8), intent(in) :: p_in(pcols) ! Pressure [Pa]
+ real(r8), intent(in) :: qv_in(pcols) ! Grid-mean water vapor specific humidity [kg/kg]
+ real(r8), intent(in) :: landfrac_in(pcols) ! Land fraction
+ real(r8), intent(in) :: snowh_in(pcols) ! Snow depth (liquid water equivalent)
+
+ real(r8), intent(out) :: a_out(pcols) ! Stratus fraction
+ real(r8), intent(out) :: Ga_out(pcols) ! dU/da
+ integer, intent(in) :: ncol
+
+ real(r8), optional, intent(in) :: rhminl_in(pcols) ! Critical relative humidity for low-level liquid stratus
+ real(r8), optional, intent(in) :: rhminl_adj_land_in(pcols) ! Adjustment drop of rhminl over the land
+ real(r8), optional, intent(in) :: rhminh_in(pcols) ! Critical relative humidity for high-level liquid stratus
+
+ real(r8) :: U ! Relative humidity
+ real(r8) :: p ! Pressure [Pa]
+ real(r8) :: qv ! Grid-mean water vapor specific humidity [kg/kg]
+ real(r8) :: landfrac ! Land fraction
+ real(r8) :: snowh ! Snow depth (liquid water equivalent)
+
+ real(r8) :: rhminl ! Critical relative humidity for low-level liquid stratus
+ real(r8) :: rhminl_adj_land ! Adjustment drop of rhminl over the land
+ real(r8) :: rhminh ! Critical relative humidity for high-level liquid stratus
+
+ real(r8) :: a ! Stratus fraction
+ real(r8) :: Ga ! dU/da
+
+ ! Local variables
+ integer i
+ real(r8) rhmin ! Critical RH
+ real(r8) rhdif ! Factor for stratus fraction
+ real(r8) rhwght
+
+ ! Statement functions
+ logical land
+ land(i) = nint(landfrac_in(i)) == 1
+
+ rhminl = rhminl_const
+ rhminl_adj_land = rhminl_adj_land_const
+ rhminh = rhminh_const
+
+ ! ---------------- !
+ ! Main computation !
+ ! ---------------- !
+
+ a_out(:) = 0._r8
+ Ga_out(:) = 0._r8
+
+ do i = 1, ncol
+
+ U = U_in(i)
+ p = p_in(i)
+ qv = qv_in(i)
+ landfrac = landfrac_in(i)
+ snowh = snowh_in(i)
+
+ if (present(rhminl_in)) rhminl = rhminl_in(i)
+ if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in(i)
+ if (present(rhminh_in)) rhminh = rhminh_in(i)
+
+ if( p .ge. premib ) then
+
+ if( land(i) .and. (snowh.le.0.000001_r8) ) then
+ rhmin = rhminl - rhminl_adj_land
+ else
+ rhmin = rhminl
+ endif
+ rhdif = (U-rhmin)/(1.0_r8-rhmin)
+ a = min(1._r8,(max(rhdif,0.0_r8))**2)
+ if( (U.ge.1._r8) .or. (U.le.rhmin) ) then
+ Ga = 1.e20_r8
+ else
+ Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin))
+ endif
+ if( freeze_dry ) then
+ a = a*max(0.15_r8,min(1.0_r8,qv/0.0030_r8))
+ Ga = Ga/max(0.15_r8,min(1.0_r8,qv/0.0030_r8))
+ endif
+
+ elseif( p .lt. premit ) then
+
+ rhmin = rhminh
+ rhdif = (U-rhmin)/(1.0_r8-rhmin)
+ a = min(1._r8,(max(rhdif,0._r8))**2)
+ if( (U.ge.1._r8) .or. (U.le.rhmin) ) then
+ Ga = 1.e20_r8
+ else
+ Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin))
+ endif
+
+ else
+
+ rhwght = (premib-(max(p,premit)))/(premib-premit)
+
+ ! if( land(i) .and. (snowh.le.0.000001_r8) ) then
+ ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght)
+ ! else
+ rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght)
+ ! endif
+
+ rhdif = (U-rhmin)/(1.0_r8-rhmin)
+ a = min(1._r8,(max(rhdif,0._r8))**2)
+ if( (U.ge.1._r8) .or. (U.le.rhmin) ) then
+ Ga = 1.e10_r8
+ else
+ Ga = 0.5_r8*(1._r8-rhmin)*((1._r8-rhmin)/(U-rhmin))
+ endif
+
+ endif
+
+ a_out(i) = a
+ Ga_out(i) = Ga
+
+ enddo
+
+end subroutine astG_RHU
+
+!================================================================================================
+
+subroutine aist_single(qv, T, p, qi, landfrac, snowh, aist, &
+ rhmaxi_in, rhmini_in, rhminl_in, rhminl_adj_land_in, rhminh_in, &
+ qsatfac_out)
+
+ ! --------------------------------------------------------- !
+ ! Compute non-physical ice stratus fraction !
+ ! --------------------------------------------------------- !
+
+ real(r8), intent(in) :: qv ! Grid-mean water vapor[kg/kg]
+ real(r8), intent(in) :: T ! Temperature
+ real(r8), intent(in) :: p ! Pressure [Pa]
+ real(r8), intent(in) :: qi ! Grid-mean ice water content [kg/kg]
+ real(r8), intent(in) :: landfrac ! Land fraction
+ real(r8), intent(in) :: snowh ! Snow depth (liquid water equivalent)
+
+ real(r8), intent(out) :: aist ! Non-physical ice stratus fraction ( 0<= aist <= 1 )
+
+ real(r8), optional, intent(in) :: rhmaxi_in
+ real(r8), optional, intent(in) :: rhmini_in ! Critical relative humidity for ice stratus
+ real(r8), optional, intent(in) :: rhminl_in ! Critical relative humidity for low-level liquid stratus
+ real(r8), optional, intent(in) :: rhminl_adj_land_in ! Adjustment drop of rhminl over the land
+ real(r8), optional, intent(in) :: rhminh_in ! Critical relative humidity for high-level liquid stratus
+ real(r8), optional, intent(out) :: qsatfac_out ! Subgrid scaling factor for qsat
+
+ ! Local variables
+ real(r8) rhmin ! Critical RH
+ real(r8) rhwght
+
+ real(r8) a,b,c,as,bs,cs ! Fit parameters
+ real(r8) Kc ! Constant for ice cloud calc (wood & field)
+ real(r8) ttmp ! Limited temperature
+ real(r8) icicval ! Empirical IWC value [ kg/kg ]
+ real(r8) rho ! Local air density
+ real(r8) esl ! Liq sat vapor pressure
+ real(r8) esi ! Ice sat vapor pressure
+ real(r8) ncf,phi ! Wilson and Ballard parameters
+ real(r8) es, qs
+
+ real(r8) rhi ! grid box averaged relative humidity over ice
+ real(r8) minice ! minimum grid box avg ice for having a 'cloud'
+ real(r8) mincld ! minimum ice cloud fraction threshold
+ real(r8) icimr ! in cloud ice mixing ratio
+ real(r8) rhdif ! working variable for slingo scheme
+
+ real(r8) :: rhmaxi
+ real(r8) :: rhmini
+ real(r8) :: rhminl
+ real(r8) :: rhminl_adj_land
+ real(r8) :: rhminh
+
+ ! Statement functions
+ logical land
+ land = nint(landfrac) == 1
+
+ ! --------- !
+ ! Constants !
+ ! --------- !
+
+ ! Wang and Sassen IWC paramters ( Option.1 )
+ a = 26.87_r8
+ b = 0.569_r8
+ c = 0.002892_r8
+ ! Schiller parameters ( Option.2 )
+ as = -68.4202_r8
+ bs = 0.983917_r8
+ cs = 2.81795_r8
+ ! Wood and Field parameters ( Option.3 )
+ Kc = 75._r8
+ ! Wilson & Ballard closure ( Option.4. smaller = more ice clouds)
+ ! Slingo modified (option 5)
+ minice = 1.e-12_r8
+ mincld = 1.e-4_r8
+
+ rhmaxi = rhmaxi_const
+ if (present(rhmaxi_in)) rhmaxi = rhmaxi_in
+ rhmini = rhmini_const
+ if (present(rhmini_in)) rhmini = rhmini_in
+ rhminl = rhminl_const
+ if (present(rhminl_in)) rhminl = rhminl_in
+ rhminl_adj_land = rhminl_adj_land_const
+ if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in
+ rhminh = rhminh_const
+ if (present(rhminh_in)) rhminh = rhminh_in
+ if (present(qsatfac_out)) qsatfac_out = 1.0_r8
+
+
+ ! ---------------- !
+ ! Main computation !
+ ! ---------------- !
+
+ call qsat_water(T, p, es, qs)
+ esl = svp_water(T)
+ esi = svp_ice(T)
+
+ if( iceopt.lt.3 ) then
+ if( iceopt.eq.1 ) then
+ ttmp = max(195._r8,min(T,253._r8)) - 273.16_r8
+ icicval = a + b * ttmp + c * ttmp**2._r8
+ rho = p/(rair*T)
+ icicval = icicval * 1.e-6_r8 / rho
+ else
+ ttmp = max(190._r8,min(T,273.16_r8))
+ icicval = 10._r8 **(as * bs**ttmp + cs)
+ icicval = icicval * 1.e-6_r8 * 18._r8 / 28.97_r8
+ endif
+ aist = max(0._r8,min(qi/icicval,1._r8))
+ elseif( iceopt.eq.3 ) then
+ aist = 1._r8 - exp(-Kc*qi/(qs*(esi/esl)))
+ aist = max(0._r8,min(aist,1._r8))
+ elseif( iceopt.eq.4) then
+ if( p .ge. premib ) then
+ if( land .and. (snowh.le.0.000001_r8) ) then
+ rhmin = rhminl - rhminl_adj_land
+ else
+ rhmin = rhminl
+ endif
+ elseif( p .lt. premit ) then
+ rhmin = rhminh
+ else
+ rhwght = (premib-(max(p,premit)))/(premib-premit)
+ ! if( land .and. (snowh.le.0.000001_r8) ) then
+ ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght)
+ ! else
+ rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght)
+ ! endif
+ endif
+ ncf = qi/((1._r8 - icecrit)*qs)
+ if( ncf.le.0._r8 ) then
+ aist = 0._r8
+ elseif( ncf.gt.0._r8 .and. ncf.le.1._r8/6._r8 ) then
+ aist = 0.5_r8*(6._r8 * ncf)**(2._r8/3._r8)
+ elseif( ncf.gt.1._r8/6._r8 .and. ncf.lt.1._r8 ) then
+ phi = (acos(3._r8*(1._r8-ncf)/2._r8**(3._r8/2._r8))+4._r8*3.1415927_r8)/3._r8
+ aist = (1._r8 - 4._r8 * cos(phi) * cos(phi))
+ else
+ aist = 1._r8
+ endif
+ aist = max(0._r8,min(aist,1._r8))
+ elseif (iceopt.eq.5) then
+ ! set rh ice cloud fraction
+ rhi= (qv+qi)/qs * (esl/esi)
+ if (rhmaxi .eq. rhmini) then
+ if (rhi .gt. rhmini) then
+ rhdif = 1._r8
+ else
+ rhdif = 0._r8
+ end if
+ else
+ rhdif = (rhi-rhmini) / (rhmaxi - rhmini)
+ end if
+ aist = min(1.0_r8, max(rhdif,0._r8)**2)
+
+ ! Similar to alpha in Wilson & Ballard (1999), determine a
+ ! scaling factor for saturation vapor pressure that reflects
+ ! the cloud fraction, rhmini, and rhmaxi.
+ !
+ ! NOTE: Limit qsatfac so that adjusted RHliq would be 1. or less.
+ if (present(qsatfac_out) .and. cldfrc2m_do_subgrid_growth) then
+ qsatfac_out = max(min(qv / qs, 1._r8), (1._r8 - aist) * rhmini + aist * rhmaxi)
+ end if
+
+ ! limiter to remove empty cloud and ice with no cloud
+ ! and set icecld fraction to mincld if ice exists
+
+ if (qi.lt.minice) then
+ aist=0._r8
+ else
+ aist=max(mincld,aist)
+ endif
+
+ ! enforce limits on icimr
+ if (qi.ge.minice) then
+ icimr=qi/aist
+
+ !minimum
+ if (icimr.lt.qist_min) then
+ !aist = max(0._r8,min(1._r8,qi/qist_min))
+ aist = max(0._r8,min(1._r8,sqrt(aist*qi/qist_min)))
+ endif
+ !maximum
+ if (icimr.gt.qist_max) then
+ aist = max(0._r8,min(1._r8,qi/qist_max))
+ endif
+
+ endif
+ endif
+
+ ! 0.999_r8 is added to prevent infinite 'ql_st' at the end of instratus_condensate
+ ! computed after updating 'qi_st'.
+
+ aist = max(0._r8,min(aist,0.999_r8))
+
+end subroutine aist_single
+
+!================================================================================================
+
+subroutine aist_vector(qv_in, T_in, p_in, qi_in, ni_in, landfrac_in, snowh_in, aist_out, ncol, &
+ rhmaxi_in, rhmini_in, rhminl_in, rhminl_adj_land_in, rhminh_in, &
+ qsatfac_out )
+
+ ! --------------------------------------------------------- !
+ ! Compute non-physical ice stratus fraction !
+ ! --------------------------------------------------------- !
+
+ real(r8), intent(in) :: qv_in(pcols) ! Grid-mean water vapor[kg/kg]
+ real(r8), intent(in) :: T_in(pcols) ! Temperature
+ real(r8), intent(in) :: p_in(pcols) ! Pressure [Pa]
+ real(r8), intent(in) :: qi_in(pcols) ! Grid-mean ice water content [kg/kg]
+ real(r8), intent(in) :: ni_in(pcols) ! Grid-mean ice water number concentration [#/kg]
+ real(r8), intent(in) :: landfrac_in(pcols) ! Land fraction
+ real(r8), intent(in) :: snowh_in(pcols) ! Snow depth (liquid water equivalent)
+
+ real(r8), intent(out) :: aist_out(pcols) ! Non-physical ice stratus fraction ( 0<= aist <= 1 )
+ integer, intent(in) :: ncol
+
+ real(r8), optional, intent(in) :: rhmaxi_in(pcols)
+ real(r8), optional, intent(in) :: rhmini_in(pcols) ! Critical relative humidity for ice stratus
+ real(r8), optional, intent(in) :: rhminl_in(pcols) ! Critical relative humidity for low-level liquid stratus
+ real(r8), optional, intent(in) :: rhminl_adj_land_in(pcols) ! Adjustment drop of rhminl over the land
+ real(r8), optional, intent(in) :: rhminh_in(pcols) ! Critical relative humidity for high-level liquid stratus
+ real(r8), optional, intent(out) :: qsatfac_out(pcols) ! Subgrid scaling factor for qsat
+
+ ! Local variables
+
+ real(r8) qv ! Grid-mean water vapor[kg/kg]
+ real(r8) T ! Temperature
+ real(r8) p ! Pressure [Pa]
+ real(r8) qi ! Grid-mean ice water content [kg/kg]
+ real(r8) ni
+ real(r8) landfrac ! Land fraction
+ real(r8) snowh ! Snow depth (liquid water equivalent)
+
+ real(r8) rhmaxi ! Critical relative humidity for ice stratus
+ real(r8) rhmini ! Critical relative humidity for ice stratus
+ real(r8) rhminl ! Critical relative humidity for low-level liquid stratus
+ real(r8) rhminl_adj_land ! Adjustment drop of rhminl over the land
+ real(r8) rhminh ! Critical relative humidity for high-level liquid stratus
+
+ real(r8) aist ! Non-physical ice stratus fraction ( 0<= aist <= 1 )
+
+ real(r8) rhmin ! Critical RH
+ real(r8) rhwght
+
+ real(r8) a,b,c,as,bs,cs,ah,bh,ch ! Fit parameters
+ real(r8) nil
+ real(r8) Kc ! Constant for ice cloud calc (wood & field)
+ real(r8) ttmp ! Limited temperature
+ real(r8) icicval ! Empirical IWC value [ kg/kg ]
+ real(r8) rho ! Local air density
+ real(r8) esl ! Liq sat vapor pressure
+ real(r8) esi ! Ice sat vapor pressure
+ real(r8) ncf,phi ! Wilson and Ballard parameters
+ real(r8) qs
+ real(r8) esat_in(pcols)
+ real(r8) qsat_in(pcols)
+
+ real(r8) rhi ! grid box averaged relative humidity over ice
+ real(r8) minice ! minimum grid box avg ice for having a 'cloud'
+ real(r8) mincld ! minimum ice cloud fraction threshold
+ real(r8) icimr ! in cloud ice mixing ratio
+ real(r8) rhdif ! working variable for slingo scheme
+
+ integer i
+
+
+ ! Statement functions
+ logical land
+ land(i) = nint(landfrac_in(i)) == 1
+
+ ! --------- !
+ ! Constants !
+ ! --------- !
+
+ ! Wang and Sassen IWC paramters ( Option.1 )
+ a = 26.87_r8
+ b = 0.569_r8
+ c = 0.002892_r8
+ ! Schiller parameters ( Option.2 )
+ as = -68.4202_r8
+ bs = 0.983917_r8
+ cs = 2.81795_r8
+ ! Wood and Field parameters ( Option.3 )
+ Kc = 75._r8
+ ! Wilson & Ballard closure ( Option.4. smaller = more ice clouds)
+ ! Slingo modified (option 5)
+ minice = 1.e-12_r8
+ mincld = 1.e-4_r8
+
+ rhmaxi = rhmaxi_const
+
+ rhmini = rhmini_const
+ rhminl = rhminl_const
+ rhminl_adj_land = rhminl_adj_land_const
+ rhminh = rhminh_const
+
+ if (present(qsatfac_out)) qsatfac_out = 1.0_r8
+
+ ! ---------------- !
+ ! Main computation !
+ ! ---------------- !
+
+ aist_out(:) = 0._r8
+ esat_in(:) = 0._r8
+ qsat_in(:) = 0._r8
+
+ call qsat_water(T_in(1:ncol), p_in(1:ncol), &
+ esat_in(1:ncol), qsat_in(1:ncol))
+
+ do i = 1, ncol
+
+ landfrac = landfrac_in(i)
+ snowh = snowh_in(i)
+ T = T_in(i)
+ qv = qv_in(i)
+ p = p_in(i)
+ qi = qi_in(i)
+ ni = ni_in(i)
+ qs = qsat_in(i)
+ esl = svp_water(T)
+ esi = svp_ice(T)
+
+ if (present(rhmaxi_in)) rhmaxi = rhmaxi_in(i)
+ if (present(rhmini_in)) rhmini = rhmini_in(i)
+ if (present(rhminl_in)) rhminl = rhminl_in(i)
+ if (present(rhminl_adj_land_in)) rhminl_adj_land = rhminl_adj_land_in(i)
+ if (present(rhminh_in)) rhminh = rhminh_in(i)
+
+ if( iceopt.lt.3 ) then
+ if( iceopt.eq.1 ) then
+ ttmp = max(195._r8,min(T,253._r8)) - 273.16_r8
+ icicval = a + b * ttmp + c * ttmp**2._r8
+ rho = p/(rair*T)
+ icicval = icicval * 1.e-6_r8 / rho
+ else
+ ttmp = max(190._r8,min(T,273.16_r8))
+ icicval = 10._r8 **(as * bs**ttmp + cs)
+ icicval = icicval * 1.e-6_r8 * 18._r8 / 28.97_r8
+ endif
+ aist = max(0._r8,min(qi/icicval,1._r8))
+ elseif( iceopt.eq.3 ) then
+ aist = 1._r8 - exp(-Kc*qi/(qs*(esi/esl)))
+ aist = max(0._r8,min(aist,1._r8))
+ elseif( iceopt.eq.4) then
+ if( p .ge. premib ) then
+ if( land(i) .and. (snowh.le.0.000001_r8) ) then
+ rhmin = rhminl - rhminl_adj_land
+ else
+ rhmin = rhminl
+ endif
+ elseif( p .lt. premit ) then
+ rhmin = rhminh
+ else
+ rhwght = (premib-(max(p,premit)))/(premib-premit)
+ ! if( land(i) .and. (snowh.le.0.000001_r8) ) then
+ ! rhmin = rhminh*rhwght + (rhminl - rhminl_adj_land)*(1.0_r8-rhwght)
+ ! else
+ rhmin = rhminh*rhwght + rhminl*(1.0_r8-rhwght)
+ ! endif
+ endif
+ ncf = qi/((1._r8 - icecrit)*qs)
+ if( ncf.le.0._r8 ) then
+ aist = 0._r8
+ elseif( ncf.gt.0._r8 .and. ncf.le.1._r8/6._r8 ) then
+ aist = 0.5_r8*(6._r8 * ncf)**(2._r8/3._r8)
+ elseif( ncf.gt.1._r8/6._r8 .and. ncf.lt.1._r8 ) then
+ phi = (acos(3._r8*(1._r8-ncf)/2._r8**(3._r8/2._r8))+4._r8*3.1415927_r8)/3._r8
+ aist = (1._r8 - 4._r8 * cos(phi) * cos(phi))
+ else
+ aist = 1._r8
+ endif
+ aist = max(0._r8,min(aist,1._r8))
+ elseif (iceopt.eq.5) then
+ ! set rh ice cloud fraction
+ rhi= (qv+qi)/qs * (esl/esi)
+ if (rhmaxi .eq. rhmini) then
+ if (rhi .gt. rhmini) then
+ rhdif = 1._r8
+ else
+ rhdif = 0._r8
+ end if
+ else
+ rhdif = (rhi-rhmini) / (rhmaxi - rhmini)
+ end if
+ aist = min(1.0_r8, max(rhdif,0._r8)**2)
+
+ elseif (iceopt.eq.6) then
+ !----- ICE CLOUD OPTION 6: fit based on T and Number (Gettelman: based on Heymsfield obs)
+ ! Use observations from Heymsfield et al 2012 of IWC and Ni v. Temp
+ ! Multivariate fit follows form of Boudala 2002: ICIWC = a * exp(b*T) * N^c
+ ! a=6.73e-8, b=0.05, c=0.349
+ ! N is #/L, so need to convert Ni_L=N*rhoa/1000.
+ ah= 6.73834e-08_r8
+ bh= 0.0533110_r8
+ ch= 0.3493813_r8
+ rho=p/(rair*T)
+ nil=ni*rho/1000._r8
+ icicval = ah * exp(bh*T) * nil**ch
+ !result is in g m-3, convert to kg H2O / kg air (icimr...)
+ icicval = icicval / rho / 1000._r8
+ aist = max(0._r8,min(qi/icicval,1._r8))
+ aist = min(aist,1._r8)
+
+ endif
+
+ if (iceopt.eq.5 .or. iceopt.eq.6) then
+
+ ! Similar to alpha in Wilson & Ballard (1999), determine a
+ ! scaling factor for saturation vapor pressure that reflects
+ ! the cloud fraction, rhmini, and rhmaxi.
+ !
+ ! NOTE: Limit qsatfac so that adjusted RHliq would be 1. or less.
+ if (present(qsatfac_out) .and. cldfrc2m_do_subgrid_growth) then
+ qsatfac_out(i) = max(min(qv / qs, 1._r8), (1._r8 - aist) * rhmini + aist * rhmaxi)
+ end if
+
+ ! limiter to remove empty cloud and ice with no cloud
+ ! and set icecld fraction to mincld if ice exists
+
+ if (qi.lt.minice) then
+ aist=0._r8
+ else
+ aist=max(mincld,aist)
+ endif
+
+ ! enforce limits on icimr
+ if (qi.ge.minice) then
+ icimr=qi/aist
+
+ !minimum
+ if (icimr.lt.qist_min) then
+ !aist = max(0._r8,min(1._r8,qi/qist_min))
+ aist = max(0._r8,min(1._r8,sqrt(aist*qi/qist_min)))
+ endif
+ !maximum
+ if (icimr.gt.qist_max) then
+ aist = max(0._r8,min(1._r8,qi/qist_max))
+ endif
+
+ endif
+ endif
+
+ ! 0.999_r8 is added to prevent infinite 'ql_st' at the end of instratus_condensate
+ ! computed after updating 'qi_st'.
+
+ aist = max(0._r8,min(aist,0.999_r8))
+
+ aist_out(i) = aist
+
+ enddo
+
+end subroutine aist_vector
+
+!================================================================================================
+
+end module cldfrc2m
diff --git a/src/NorESM/ctem.F90 b/src/NorESM/ctem.F90
new file mode 100644
index 0000000000..d63729c755
--- /dev/null
+++ b/src/NorESM/ctem.F90
@@ -0,0 +1,616 @@
+!-----------------------------------------------------------------------------
+! circulation diagnostics -- terms of the Transformed Eulerian Mean (TEM) equation
+!-----------------------------------------------------------------------------
+module ctem
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use spmd_utils, only: masterproc
+ use pmgrid, only: plon, plev, plevp
+ use cam_logfile, only: iulog
+ use cam_history, only: addfld, outfld, add_default, horiz_only
+ use cam_abortutils, only: endrun
+
+ implicit none
+ private
+
+ public :: ctem_readnl
+ public :: ctem_init
+ public :: ctem_diags
+ public :: do_circulation_diags
+
+ real(r8) :: rplon
+ real(r8) :: iref_p(plevp) ! interface reference pressure for vertical interpolation
+ integer :: ip_b ! level index where hybrid levels become purely pressure
+ integer :: zm_limit
+
+ logical :: do_circulation_diags = .false.
+
+contains
+
+!================================================================================
+
+ subroutine ctem_diags( u3, v3, omga, pt, h2o, ps, pe, grid)
+
+ use physconst, only : zvir, cappa
+ use dynamics_vars, only : T_FVDYCORE_GRID
+ use hycoef, only : ps0
+ use interpolate_data, only : vertinterp
+#ifdef SPMD
+ use mpishorthand, only : mpilog, mpiint
+ use parutilitiesmodule, only : pargatherint
+#endif
+
+!-------------------------------------------------------------
+! ... dummy arguments
+!-------------------------------------------------------------
+ type(T_FVDYCORE_GRID), intent(in) :: grid ! FV Dynamics grid
+
+ real(r8), intent(in) :: ps(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) ! surface pressure (pa)
+ real(r8), intent(in) :: u3(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! zonal velocity (m/s)
+ real(r8), intent(in) :: v3(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! meridional velocity (m/s)
+ real(r8), intent(in) :: omga(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! pressure velocity
+ real(r8), intent(in) :: pe(grid%ifirstxy:grid%ilastxy,plevp,grid%jfirstxy:grid%jlastxy) ! interface pressure (pa)
+ real(r8), intent(in) :: pt(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,plev) ! virtual temperature
+ real(r8), intent(in) :: h2o(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,plev) ! water constituent (kg/kg)
+
+!-------------------------------------------------------------
+! ... local variables
+!-------------------------------------------------------------
+ real(r8), parameter :: hscale = 7000._r8 ! pressure scale height
+ real(r8), parameter :: navp = 1.e35_r8 !+tht use this only for T, missing winds are set to zero
+
+ real(r8) :: pinterp
+ real(r8) :: w(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! vertical velocity
+ real(r8) :: th(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! pot. temperature
+
+ real(r8) :: pm(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! mid-point pressure
+
+ real(r8) :: pexf ! Exner function
+ real(r8) :: psurf
+
+ real(r8) :: ui(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated zonal velocity
+ real(r8) :: vi(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated meridional velocity
+ real(r8) :: wi(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated vertical velocity
+ real(r8) :: thi(grid%ifirstxy:grid%ilastxy,plevp) ! interpolated pot. temperature
+
+ real(r8) :: um(plevp) ! zonal mean zonal velocity
+ real(r8) :: vm(plevp) ! zonal mean meridional velocity
+ real(r8) :: wm(plevp) ! zonal mean vertical velocity
+ real(r8) :: thm(plevp) ! zonal mean pot. temperature
+
+ real(r8) :: ud(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of zonal velocity
+ real(r8) :: vd(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of meridional velocity
+ real(r8) :: wd(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of vertical velocity
+ real(r8) :: thd(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of pot. temperature
+
+ real(r8) :: vthp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of zonal velocity
+ real(r8) :: wthp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of meridional velocity
+ real(r8) :: uvp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of vertical velocity
+ real(r8) :: uwp(grid%ifirstxy:grid%ilastxy,plevp) ! zonal deviation of pot. temperature
+
+ real(r8) :: rdiv(plevp)
+
+ integer :: ip_gm1g(plon,grid%jfirstxy:grid%jlastxy) ! contains level index-1 where blocked points begin
+ integer :: zm_cnt(plevp) ! counter
+ integer :: i,j,k
+ integer :: nlons
+
+ logical :: has_zm(plevp,grid%jfirstxy:grid%jlastxy) ! .true. the (z,y) point is a valid zonal mean
+ integer :: ip_gm1(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy) ! contains level index-1 where blocked points begin
+
+ real(r8) :: vth(plevp,grid%jfirstxy:grid%jlastxy) ! VTH flux
+ real(r8) :: uv(plevp,grid%jfirstxy:grid%jlastxy) ! UV flux
+ real(r8) :: wth(plevp,grid%jfirstxy:grid%jlastxy) ! WTH flux
+ real(r8) :: uw(plevp,grid%jfirstxy:grid%jlastxy) ! UW flux
+ real(r8) :: u2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged U
+ real(r8) :: v2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged V
+ real(r8) :: th2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged TH
+ real(r8) :: w2d(plevp,grid%jfirstxy:grid%jlastxy) ! zonally averaged W
+ real(r8) :: thig(grid%ifirstxy:grid%ilastxy,plevp,grid%jfirstxy:grid%jlastxy) ! interpolated pot. temperature
+
+ real(r8) :: tmp2(grid%ifirstxy:grid%ilastxy)
+ real(r8) :: tmp3(grid%ifirstxy:grid%ilastxy,plevp)
+
+ integer :: beglat, endlat ! begin,end latitude indicies
+ integer :: beglon, endlon ! begin,end longitude indicies
+
+ beglon = grid%ifirstxy
+ endlon = grid%ilastxy
+ beglat = grid%jfirstxy
+ endlat = grid%jlastxy
+
+!omp parallel do private (i,j,k,pexf,psurf)
+lat_loop1 : &
+ do j = beglat, endlat
+ do k = 1, plev
+ do i = beglon, endlon
+!-------------------------------------------------------------
+! Calculate pressure and Exner function
+!-------------------------------------------------------------
+ pm(i,k,j) = 0.5_r8 * ( pe(i,k,j) + pe(i,k+1,j) )
+ pexf = (ps0 / pm(i,k,j))**cappa
+!-------------------------------------------------------------
+! Convert virtual temperature to temperature and calculate potential temperature
+!-------------------------------------------------------------
+ th(i,k,j) = pt(i,j,k) / (1._r8 + zvir*h2o(i,j,k))
+ th(i,k,j) = th(i,k,j) * pexf
+!-------------------------------------------------------------
+! Calculate vertical velocity
+!-------------------------------------------------------------
+ w(i,k,j) = - hscale * omga(i,k,j) / pm(i,k,j)
+ end do
+ end do
+!-------------------------------------------------------------
+! Keep track of where the bottom is in each column
+! (i.e., largest index for which P(k) <= PS)
+!-------------------------------------------------------------
+ ip_gm1(:,j) = plevp
+ do i = beglon, endlon
+ psurf = ps(i,j)
+ do k = ip_b+1, plevp
+ if( iref_p(k) <= psurf ) then
+ ip_gm1(i,j) = k
+ end if
+ end do
+ end do
+ end do lat_loop1
+
+ nlons = endlon - beglon + 1
+
+#ifdef SPMD
+ if( grid%twod_decomp == 1 ) then
+ if (grid%iam .lt. grid%npes_xy) then
+ call pargatherint( grid%commxy_x, 0, ip_gm1, grid%strip2dx, ip_gm1g )
+ endif
+ else
+ ip_gm1g(:,:) = ip_gm1(:,:)
+ end if
+#else
+ ip_gm1g(:,:) = ip_gm1(:,:)
+#endif
+#ifdef CTEM_DIAGS
+ write(iulog,*) '===================================================='
+ do j = beglat,endlat
+ write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j
+ write(iulog,'(20i3)') ip_gm1(:,j)
+ end do
+ if( grid%myidxy_x == 0 ) then
+ do j = beglat,endlat
+ write(iulog,*) '===================================================='
+ write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j
+ write(iulog,'(20i3)') ip_gm1g(:,j)
+ end do
+ write(iulog,*) '===================================================='
+#else
+#ifdef SPMD
+ if( grid%myidxy_x == 0 ) then
+#endif
+#endif
+lat_loop2 : &
+ do j = beglat, endlat
+ zm_cnt(:ip_b) = plon
+ do k = ip_b+1, plevp
+ zm_cnt(k) = count( ip_gm1g(:,j) >= k )
+ end do
+ has_zm(:ip_b,j) = .true.
+ do k = ip_b+1, plevp
+ has_zm(k,j) = zm_cnt(k) >= zm_limit
+ end do
+ end do lat_loop2
+#ifdef SPMD
+ end if
+ if( grid%twod_decomp == 1 ) then
+ call mpibcast( has_zm, plevp*(endlat-beglat+1), mpilog, 0, grid%commxy_x )
+ call mpibcast( ip_gm1g, plon*(endlat-beglat+1), mpiint, 0, grid%commxy_x )
+ end if
+#endif
+
+#ifdef CTEM_DIAGS
+ if( grid%myidxy_y == 12 ) then
+ write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
+ write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,beglat
+ write(iulog,*) 'has_zm'
+ write(iulog,'(20l2)') has_zm(:,beglat)
+ write(iulog,*) 'ip_gm1g'
+ write(iulog,'(20i4)') ip_gm1g(:,beglat)
+ write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
+ end if
+#endif
+
+lat_loop3 : &
+ do j = beglat, endlat
+!-------------------------------------------------------------
+! Vertical interpolation
+!-------------------------------------------------------------
+ do k = 1, plevp
+ pinterp = iref_p(k)
+!-------------------------------------------------------------
+! Zonal velocity
+!-------------------------------------------------------------
+ call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, &
+ u3(beglon,1,j), ui(beglon,k) )
+!-------------------------------------------------------------
+! Meridional velocity
+!-------------------------------------------------------------
+ call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, &
+ v3(beglon,1,j), vi(beglon,k) )
+!-------------------------------------------------------------
+! Vertical velocity
+!-------------------------------------------------------------
+ call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, &
+ w(beglon,1,j), wi(beglon,k) )
+!-------------------------------------------------------------
+! Pot. Temperature
+!-------------------------------------------------------------
+ call vertinterp( nlons, nlons, plev, pm(beglon,1,j), pinterp, &
+ th(beglon,1,j), thi(beglon,k) )
+ end do
+#ifdef CTEM_DIAGS
+ if( j == endlat ) then
+ write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
+ write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j
+ write(iulog,*) 'iref_p'
+ write(iulog,'(5g15.7)') iref_p(:)
+ write(iulog,'(''pm(endlon,:,'',i2,'')'')') j
+ write(iulog,'(5g15.7)') pm(endlon,:,j)
+ write(iulog,'(''u3(endlon,:,'',i2,'')'')') j
+ write(iulog,'(5g15.7)') u3(endlon,:,j)
+ write(iulog,*) 'ui(endlon,:)'
+ write(iulog,'(5g15.7)') ui(endlon,:)
+ write(iulog,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'
+ end if
+#endif
+
+!-------------------------------------------------------------
+! Calculate zonal averages
+!-------------------------------------------------------------
+ do k = ip_b+1, plevp
+ if( has_zm(k,j) ) then
+ where( ip_gm1(beglon:endlon,j) < k )
+ ui(beglon:endlon,k) = 0._r8
+ vi(beglon:endlon,k) = 0._r8
+ wi(beglon:endlon,k) = 0._r8
+ thi(beglon:endlon,k) = 0._r8
+ endwhere
+ end if
+ end do
+
+ call par_xsum( grid, ui, plevp, um )
+ call par_xsum( grid, vi, plevp, vm )
+ call par_xsum( grid, wi, plevp, wm )
+ call par_xsum( grid, thi, plevp, thm )
+#ifdef CTEM_DIAGS
+ if( j == endlat .and. grid%myidxy_y == 12 ) then
+ write(iulog,*) '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$'
+ write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j
+ write(iulog,*) 'um after par_xsum'
+ write(iulog,'(5g15.7)') um(:)
+ write(iulog,*) '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$'
+ end if
+#endif
+ do k = 1, ip_b
+ um(k) = um(k) * rplon
+ vm(k) = vm(k) * rplon
+ wm(k) = wm(k) * rplon
+ thm(k) = thm(k) * rplon
+ u2d(k,j) = um(k)
+ v2d(k,j) = vm(k)
+ th2d(k,j) = thm(k)
+ w2d(k,j) = wm(k)
+ end do
+ do k = ip_b+1, plevp
+ if( has_zm(k,j) ) then
+ rdiv(k) = 1._r8/count( ip_gm1g(:,j) >= k )
+!+tht define zonal mean winds taking zero for below-ground value
+ u2d(k,j) = um(k) * rplon
+ v2d(k,j) = vm(k) * rplon
+ w2d(k,j) = wm(k) * rplon
+!-tht
+ um(k) = um(k) * rdiv(k)
+ vm(k) = vm(k) * rdiv(k)
+ wm(k) = wm(k) * rdiv(k)
+ thm(k) = thm(k) * rdiv(k)
+ !u2d(k,j) = um(k) !+tht c'd out
+ !v2d(k,j) = vm(k) !+tht c'd out
+ th2d(k,j) = thm(k)
+ !w2d(k,j) = wm(k) !+tht c'd out
+ else
+ u2d(k,j) = 0._r8 ! navp
+ v2d(k,j) = 0._r8 ! navp
+ th2d(k,j) = navp
+ w2d(k,j) = 0._r8 ! navp
+ end if
+ end do
+
+!-------------------------------------------------------------
+! Calculate zonal deviations
+!-------------------------------------------------------------
+ do k = 1, ip_b
+ ud(beglon:endlon,k) = ui(beglon:endlon,k) - um(k)
+ vd(beglon:endlon,k) = vi(beglon:endlon,k) - vm(k)
+ wd(beglon:endlon,k) = wi(beglon:endlon,k) - wm(k)
+ thd(beglon:endlon,k) = thi(beglon:endlon,k) - thm(k)
+ end do
+
+ do k = ip_b+1, plevp
+ if( has_zm(k,j) ) then
+ where( ip_gm1g(beglon:endlon,j) >= k )
+ ud(beglon:endlon,k) = ui(beglon:endlon,k) - um(k)
+ vd(beglon:endlon,k) = vi(beglon:endlon,k) - vm(k)
+ wd(beglon:endlon,k) = wi(beglon:endlon,k) - wm(k)
+ thd(beglon:endlon,k) = thi(beglon:endlon,k) - thm(k)
+ elsewhere
+ ud(beglon:endlon,k) = 0._r8
+ vd(beglon:endlon,k) = 0._r8
+ wd(beglon:endlon,k) = 0._r8
+ thd(beglon:endlon,k) = 0._r8
+ endwhere
+ end if
+ end do
+
+!-------------------------------------------------------------
+! Calculate fluxes
+!-------------------------------------------------------------
+ do k = 1, ip_b
+ vthp(:,k) = vd(:,k) * thd(:,k)
+ wthp(:,k) = wd(:,k) * thd(:,k)
+ uwp(:,k) = wd(:,k) * ud(:,k)
+ uvp(:,k) = vd(:,k) * ud(:,k)
+ end do
+
+ do k = ip_b+1, plevp
+ if( has_zm(k,j) ) then
+ vthp(:,k) = vd(:,k) * thd(:,k)
+ wthp(:,k) = wd(:,k) * thd(:,k)
+ uwp(:,k) = wd(:,k) * ud(:,k)
+ uvp(:,k) = vd(:,k) * ud(:,k)
+ else
+ vthp(:,k) = 0._r8
+ wthp(:,k) = 0._r8
+ uwp(:,k) = 0._r8
+ uvp(:,k) = 0._r8
+ end if
+ end do
+
+#ifdef CTEM_DIAGS
+ if( j == endlat .and. grid%myidxy_y == 12 ) then
+ write(iulog,*) '#################################################'
+ write(iulog,*) 'DIAGNOSTICS before par_xsum'
+ write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j
+ write(iulog,*) 'has_zm'
+ write(iulog,*) has_zm(:,j)
+ write(iulog,*) 'rdiv'
+ write(iulog,'(5g15.7)') rdiv(:)
+ write(iulog,*) 'wm'
+ write(iulog,'(5g15.7)') wm(:)
+ write(iulog,*) 'um'
+ write(iulog,'(5g15.7)') um(:)
+ write(iulog,*) 'uw'
+ write(iulog,'(5g15.7)') uw(:)
+ write(iulog,*) '#################################################'
+ end if
+#endif
+ call par_xsum( grid, vthp, plevp, vth(1,j) )
+ call par_xsum( grid, wthp, plevp, wth(1,j) )
+ call par_xsum( grid, uvp, plevp, uv(1,j) )
+ call par_xsum( grid, uwp, plevp, uw(1,j) )
+#ifdef CTEM_DIAGS
+ if( j == endlat .and. grid%myidxy_y == 12 ) then
+ write(iulog,*) '#################################################'
+ write(iulog,'(''iam,myidxy_x,myidxy_y,j = '',4i4)') grid%iam,grid%myidxy_x,grid%myidxy_y,j
+ write(iulog,*) 'uw after par_xsum'
+ write(iulog,'(5g15.7)') uw(:,j)
+ write(iulog,*) '#################################################'
+ end if
+#endif
+ do k = 1, ip_b
+ vth(k,j) = vth(k,j) * rplon
+ wth(k,j) = wth(k,j) * rplon
+ uw(k,j) = uw(k,j) * rplon
+ uv(k,j) = uv(k,j) * rplon
+ end do
+ do k = ip_b+1, plevp
+ if( has_zm(k,j) ) then
+ vth(k,j) = vth(k,j) * rdiv(k)
+ wth(k,j) = wth(k,j) * rdiv(k)
+ uw(k,j) = uw(k,j) * rdiv(k)
+ uv(k,j) = uv(k,j) * rdiv(k)
+ else
+ vth(k,j) = 0._r8 ! navp
+ wth(k,j) = 0._r8 ! navp
+ uw(k,j) = 0._r8 ! navp
+ uv(k,j) = 0._r8 ! navp
+ end if
+ end do
+
+ thig(:,:,j) = thi(:,:)
+ end do lat_loop3
+
+!-------------------------------------------------------------
+! Do the output
+!-------------------------------------------------------------
+ latloop: do j = beglat,endlat
+
+!-------------------------------------------------------------
+! zonal-mean output
+!-------------------------------------------------------------
+ do k = 1,plevp
+ tmp3(grid%ifirstxy,k) = vth(k,j)
+ enddo
+ call outfld( 'VTHzm', tmp3(grid%ifirstxy,:), 1, j )
+
+ do k = 1,plevp
+ tmp3(grid%ifirstxy,k) = wth(k,j)
+ enddo
+ call outfld( 'WTHzm', tmp3(grid%ifirstxy,:), 1, j )
+
+ do k = 1,plevp
+ tmp3(grid%ifirstxy,k) = uv(k,j)
+ enddo
+ call outfld( 'UVzm', tmp3(grid%ifirstxy,:), 1, j )
+
+ do k = 1,plevp
+ tmp3(grid%ifirstxy,k) = uw(k,j)
+ enddo
+ call outfld( 'UWzm', tmp3(grid%ifirstxy,:), 1, j )
+ do k = 1,plevp
+ tmp3(grid%ifirstxy,k) = u2d(k,j)
+ enddo
+ call outfld( 'Uzm', tmp3(grid%ifirstxy,:), 1, j )
+ do k = 1,plevp
+ tmp3(grid%ifirstxy,k) = v2d(k,j)
+ enddo
+ call outfld( 'Vzm', tmp3(grid%ifirstxy,:), 1, j )
+ do k = 1,plevp
+ tmp3(grid%ifirstxy,k) = w2d(k,j)
+ enddo
+ call outfld( 'Wzm', tmp3(grid%ifirstxy,:), 1, j )
+ do k = 1,plevp
+ tmp3(grid%ifirstxy,k) = th2d(k,j)
+ enddo
+ call outfld( 'THzm', tmp3(grid%ifirstxy,:), 1, j )
+
+!-------------------------------------------------------------
+! 3D output
+!-------------------------------------------------------------
+ do k = 1,plevp
+ do i = beglon,endlon
+ tmp3(i,k) = thig(i,k,j)
+ enddo
+ enddo
+ call outfld( 'TH', tmp3, nlons, j )
+
+!-------------------------------------------------------------
+! horizontal output
+!-------------------------------------------------------------
+ tmp2(beglon:endlon) = ip_gm1(beglon:endlon,j)
+ call outfld( 'MSKtem', tmp2, nlons, j )
+
+ enddo latloop
+
+ end subroutine ctem_diags
+
+!=================================================================================
+
+ subroutine ctem_init()
+
+ use hycoef, only : hyai, hybi, ps0
+ use phys_control, only : phys_getopts
+
+!-------------------------------------------------------------
+! ... local variables
+!-------------------------------------------------------------
+ integer :: k
+ logical :: history_waccm
+
+ if (.not.do_circulation_diags) return
+
+ rplon = 1._r8/plon
+ zm_limit = plon/3
+
+!-------------------------------------------------------------
+! Calculate reference pressure
+!-------------------------------------------------------------
+ do k = 1, plevp
+ iref_p(k) = (hyai(k) + hybi(k)) * ps0
+ end do
+ if( masterproc ) then
+ write(iulog,*) 'ctem_inti: iref_p'
+ write(iulog,'(1p5g15.7)') iref_p(:)
+ end if
+
+!-------------------------------------------------------------
+! Find level where hybrid levels become purely pressure
+!-------------------------------------------------------------
+ ip_b = -1
+ do k = 1,plev
+ if( hybi(k) == 0._r8 ) ip_b = k
+ end do
+
+ call phys_getopts( history_waccm_out = history_waccm )
+
+!-------------------------------------------------------------
+! Initialize output buffer
+!-------------------------------------------------------------
+ call addfld ('VTHzm',(/ 'ilev' /),'A','MK/S','Meridional Heat Flux: 3D zon. mean', gridname='fv_centers_zonal' )
+ call addfld ('WTHzm',(/ 'ilev' /),'A','MK/S','Vertical Heat Flux: 3D zon. mean', gridname='fv_centers_zonal' )
+ call addfld ('UVzm', (/ 'ilev' /),'A','M2/S2','Meridional Flux of Zonal Momentum: 3D zon. mean', gridname='fv_centers_zonal' )
+ call addfld ('UWzm', (/ 'ilev' /),'A','M2/S2','Vertical Flux of Zonal Momentum: 3D zon. mean', gridname='fv_centers_zonal' )
+
+ call addfld ('Uzm', (/ 'ilev' /),'A','M/S','Zonal-Mean zonal wind - defined on ilev', gridname='fv_centers_zonal' )
+ call addfld ('Vzm', (/ 'ilev' /),'A','M/S','Zonal-Mean meridional wind - defined on ilev', gridname='fv_centers_zonal' )
+ call addfld ('Wzm', (/ 'ilev' /),'A','M/S','Zonal-Mean vertical wind - defined on ilev', gridname='fv_centers_zonal' )
+ call addfld ('THzm', (/ 'ilev' /),'A', 'K','Zonal-Mean potential temp - defined on ilev', gridname='fv_centers_zonal' )
+
+ call addfld ('TH', (/ 'ilev' /),'A','K', 'Potential Temperature', gridname='fv_centers' )
+ call addfld ('MSKtem',horiz_only, 'A','1', 'TEM mask', gridname='fv_centers' )
+
+!-------------------------------------------------------------
+! primary tapes: 3D fields
+!-------------------------------------------------------------
+ call add_default ('VTHzm', 1, ' ')
+ call add_default ('WTHzm', 1, ' ')
+ call add_default ('UVzm' , 1, ' ')
+ call add_default ('UWzm' , 1, ' ')
+ call add_default ('TH' , 1, ' ')
+ call add_default ('MSKtem',1, ' ')
+! LSG 20190604: add Uzm, Vzm, Wzm and THzm to defaults
+ call add_default ('Uzm', 1, ' ')
+ call add_default ('Vzm', 1, ' ')
+ call add_default ('Wzm', 1, ' ')
+ call add_default ('THzm', 1, ' ')
+
+ if (history_waccm) then
+ call add_default ('MSKtem',7, ' ')
+ call add_default ('VTHzm', 7, ' ')
+ call add_default ('UVzm', 7, ' ')
+ call add_default ('UWzm', 7, ' ')
+ call add_default ('Uzm', 7, ' ')
+ call add_default ('Vzm', 7, ' ')
+ call add_default ('Wzm', 7, ' ')
+ call add_default ('THzm', 7, ' ')
+ end if
+
+ if (masterproc) then
+ write(iulog,*) 'ctem_inti: do_circulation_diags = ',do_circulation_diags
+ endif
+
+ end subroutine ctem_init
+
+!================================================================================
+
+subroutine ctem_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'ctem_readnl'
+
+ namelist /circ_diag_nl/ do_circulation_diags
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'circ_diag_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, circ_diag_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+ end if
+
+ call mpi_bcast(do_circulation_diags, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(subname//": FATAL: mpi_bcast: do_circulation_diags")
+
+end subroutine ctem_readnl
+
+end module ctem
diff --git a/src/NorESM/fv/dp_coupling.F90 b/src/NorESM/fv/dp_coupling.F90
new file mode 100644
index 0000000000..e74d54c6f3
--- /dev/null
+++ b/src/NorESM/fv/dp_coupling.F90
@@ -0,0 +1,998 @@
+module dp_coupling
+!BOP
+!
+! !MODULE: dp_coupling --- dynamics-physics coupling module
+!
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use ppgrid, only: pcols, pver
+ use phys_grid
+
+ use physics_types, only: physics_state, physics_tend
+ use constituents, only: pcnst
+ use physconst, only: gravit, zvir, cpairv, rairv
+ use geopotential, only: geopotential_t
+ use check_energy, only: check_energy_timestep_init
+ use dynamics_vars, only: T_FVDYCORE_GRID, t_fvdycore_state
+ use dyn_internal_state,only: get_dyn_state
+ use dyn_comp, only: dyn_import_t, dyn_export_t, fv_print_dpcoup_warn
+ use cam_abortutils, only: endrun
+#if defined ( SPMD )
+ use spmd_dyn, only: local_dp_map, block_buf_nrecs, chunk_buf_nrecs
+#endif
+ use perf_mod
+ use cam_logfile, only: iulog
+
+!--------------------------------------------
+! Variables needed for WACCM-X
+!--------------------------------------------
+ use constituents, only: cnst_get_ind !Needed to access constituent indices
+!
+! !PUBLIC MEMBER FUNCTIONS:
+ PUBLIC d_p_coupling, p_d_coupling
+
+!
+! !DESCRIPTION:
+!
+! This module provides
+!
+! \begin{tabular}{|l|l|} \hline \hline
+! d\_p\_coupling & dynamics output to physics input \\ \hline
+! p\_d\_coupling & physics output to dynamics input \\ \hline
+! \hline
+! \end{tabular}
+!
+! !REVISION HISTORY:
+! 00.06.01 Boville Creation
+! 01.10.01 Lin Various revisions
+! 01.03.26 Sawyer Added ProTeX documentation
+! 01.06.27 Mirin Separate noncoupling coding into new routines
+! 01.07.13 Mirin Some support for multi-2D decompositions
+! 02.03.01 Worley Support for nontrivial physics remapping
+! 03.03.28 Boville set all physics_state elements, add check_energy_timestep_init
+! 03.08.13 Sawyer Removed ghost N1 region in u3sxy
+! 05.06.28 Sawyer Simplified interfaces -- only XY decomposition
+! 05.10.25 Sawyer Extensive refactoring, dyn_interface
+! 05.11.10 Sawyer Now using dyn_import/export_t containers
+! 06.07.01 Sawyer Transitioned constituents to T_TRACERS
+!
+!EOP
+!-----------------------------------------------------------------------
+
+ private
+ real(r8), parameter :: D0_5 = 0.5_r8
+ real(r8), parameter :: D1_0 = 1.0_r8
+
+CONTAINS
+
+!-----------------------------------------------------------------------
+!BOP
+! !IROUTINE: d_p_coupling --- convert dynamics output to physics input
+!
+! !INTERFACE:
+ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out)
+
+! !USES:
+ use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, &
+ pbuf_get_field
+ use constituents, only: qmin
+ use physics_types, only: set_state_pdry, set_wet_to_dry
+
+ use pmgrid, only: plev
+ use ctem, only: ctem_diags, do_circulation_diags
+ use diag_module, only: fv_diag_am_calc
+ use gravity_waves_sources, only: gws_src_fnct
+ use physconst, only: physconst_update
+ use shr_const_mod, only: shr_const_rwv
+ use dyn_comp, only: frontgf_idx, frontga_idx, uzm_idx
+ use qbo, only: qbo_use_forcing
+ use phys_control, only: use_gw_front, use_gw_front_igw, waccmx_is
+ use zonal_mean, only: zonal_mean_3D
+ use d2a3dikj_mod, only: d2a3dikj
+ use qneg_module, only: qneg3
+
+!-----------------------------------------------------------------------
+ implicit none
+!-----------------------------------------------------------------------
+! !INPUT PARAMETERS:
+!
+ type(t_fvdycore_grid), intent(in) :: grid
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+ type(dyn_export_t), intent(in) :: dyn_out ! dynamics export
+
+! !OUTPUT PARAMETERS:
+
+ type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state
+ type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend
+
+
+! !DESCRIPTION:
+!
+! Coupler for converting dynamics output variables into physics
+! input variables
+!
+! !REVISION HISTORY:
+! 00.06.01 Boville Creation
+! 01.07.13 AAM Some support for multi-2D decompositions
+! 02.03.01 Worley Support for nontrivial physics remapping
+! 02.05.02 Sawyer u3s made inout due to ghosting in d2a3dikj
+! 03.08.05 Sawyer Removed pe11k, pe11kln (for defunct Rayl fric)
+! 04.08.29 Eaton Added lat, lon coords to physics_state type
+! 05.06.28 Sawyer Simplified interface -- on XY decomp vars.
+! 05.07.06 Sawyer Added dyn_state as argument
+! 05.10.31 Sawyer Refactoring, replaced dyn_state by dyn_interface
+!
+!EOP
+!-----------------------------------------------------------------------
+!BOC
+! !LOCAL VARIABLES:
+
+ type(t_fvdycore_state), pointer :: dyn_state
+
+! Variables from dynamics export container
+ real(r8), pointer :: phisxy(:,:) ! surface geopotential
+ real(r8), pointer :: psxy (:,:) ! surface pressure
+ real(r8), pointer :: u3sxy(:,:,:) ! u-wind on d-grid
+ real(r8), pointer :: v3sxy(:,:,:) ! v-wind on d-grid
+ real(r8), pointer :: du3sxy(:,:,:) ! u-wind increment on d-grid
+ real(r8), pointer :: dv3sxy(:,:,:) ! v-wind increment on d-grid
+ real(r8), pointer :: dua3sxy(:,:,:) ! u-wind adv. inc. on d-grid
+ real(r8), pointer :: dva3sxy(:,:,:) ! v-wind adv. inc. on d-grid
+ real(r8), pointer :: duf3sxy(:,:,:) ! u-wind fixer inc.on d-grid
+ real(r8), pointer :: ptxy (:,:,:) ! Virtual pot temp
+ real(r8), pointer :: tracer(:,:,:,:) ! constituents
+ real(r8), pointer :: omgaxy(:,:,:) ! vertical velocity
+ real(r8), pointer :: pexy (:,:,:) ! edge pressure
+ real(r8), pointer :: pelnxy(:,:,:) ! log(pe)
+ real(r8), pointer :: pkxy (:,:,:) ! pe**cappa
+ real(r8), pointer :: pkzxy (:,:,:) ! f-v mean of pk
+
+ integer :: i,ib,j,k,m,lchnk ! indices
+ integer :: ncol ! number of columns in current chunk
+ integer :: lats(pcols) ! array of latitude indices
+ integer :: lons(pcols) ! array of longitude indices
+ integer :: blksiz ! number of columns in 2D block
+ integer :: tsize ! amount of data per grid point passed to physics
+ integer, allocatable, dimension(:,:) :: bpter
+ ! offsets into block buffer for packing data
+ integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for unpacking data
+
+ real(r8) :: qmavl ! available q at level pver-1
+ real(r8) :: dqreq ! q change at pver-1 required to remove q get_dyn_state()
+
+ if (use_gw_front .or. use_gw_front_igw) then
+
+ allocate(frontgf(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy), stat=astat)
+ if( astat /= 0 ) then
+ write(iulog,*) 'd_p_coupling: failed to allocate frontgf; error = ',astat
+ call endrun
+ end if
+
+ allocate(frontga(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy), stat=astat)
+ if( astat /= 0 ) then
+ write(iulog,*) 'd_p_coupling: failed to allocate frontga; error = ',astat
+ call endrun
+ end if
+
+ end if
+
+ nullify(pbuf_chnk)
+ nullify(pbuf_frontgf)
+ nullify(pbuf_frontga)
+ nullify(pbuf_uzm)
+
+ fraction = 0.1_r8
+
+ phisxy => dyn_out%phis
+ psxy => dyn_out%ps
+ u3sxy => dyn_out%u3s
+ v3sxy => dyn_out%v3s
+ ptxy => dyn_out%pt
+ tracer => dyn_out%tracer
+
+ omgaxy => dyn_out%omga
+ pexy => dyn_out%pe
+ pelnxy => dyn_out%peln
+ pkxy => dyn_out%pk
+ pkzxy => dyn_out%pkz
+
+ km = grid%km
+ kmp1 = km + 1
+
+ ifirstxy = grid%ifirstxy
+ ilastxy = grid%ilastxy
+ jfirstxy = grid%jfirstxy
+ jlastxy = grid%jlastxy
+
+ iam = grid%iam
+!-----------------------------------------------------------------------
+! Transform dynamics staggered winds to physics grid (D=>A)
+!-----------------------------------------------------------------------
+
+ call t_startf ('d2a3dikj')
+ allocate (u3(ifirstxy:ilastxy, km, jfirstxy:jlastxy))
+ allocate (v3(ifirstxy:ilastxy, km, jfirstxy:jlastxy))
+
+ if (iam .lt. grid%npes_xy) then
+ call d2a3dikj(grid, dyn_state%am_correction, u3sxy, v3sxy, u3, v3)
+ end if ! (iam .lt. grid%npes_xy)
+
+ call t_stopf ('d2a3dikj')
+
+ if ( do_circulation_diags ) then
+ call t_startf('DP_CPLN_ctem')
+ call ctem_diags( u3, v3, omgaxy, ptxy(:,jfirstxy:jlastxy,:), tracer(:,jfirstxy:jlastxy,:,1), &
+ psxy, pexy, grid)
+ call t_stopf('DP_CPLN_ctem')
+ endif
+
+ if (dyn_state%am_diag) then
+ du3sxy => dyn_out%du3s
+ dv3sxy => dyn_out%dv3s
+ dua3sxy => dyn_out%dua3s
+ dva3sxy => dyn_out%dva3s
+ duf3sxy => dyn_out%duf3s
+ allocate (du3 (ifirstxy:ilastxy, km, jfirstxy:jlastxy))
+ allocate (dv3 (ifirstxy:ilastxy, km, jfirstxy:jlastxy))
+ allocate (dua3(ifirstxy:ilastxy, km, jfirstxy:jlastxy))
+ allocate (dva3(ifirstxy:ilastxy, km, jfirstxy:jlastxy))
+ allocate (duf3(ifirstxy:ilastxy, km, jfirstxy:jlastxy))
+ allocate (dummy(ifirstxy:ilastxy,jfirstxy:jlastxy, km))
+ du3(:,:,:) = 0._r8
+ dv3(:,:,:) = 0._r8
+ dua3(:,:,:) = 0._r8
+ dva3(:,:,:) = 0._r8
+ duf3(:,:,:) = 0._r8
+ dummy(:,:,:) = 0._r8
+
+ if (iam .lt. grid%npes_xy) then
+ ! (note dummy use of dva3 hence call order matters)
+ call d2a3dikj(grid, dyn_state%am_correction,duf3sxy, dummy, duf3 ,dva3)
+ call d2a3dikj(grid, dyn_state%am_correction,dua3sxy, dva3sxy, dua3, dva3)
+ call d2a3dikj(grid, dyn_state%am_correction, du3sxy, dv3sxy, du3 , dv3 )
+ end if ! (iam .lt. grid%npes_xy)
+
+ call t_startf('DP_CPLN_fv_am')
+ call fv_diag_am_calc(grid, psxy, pexy, du3, dv3, dua3, dva3, duf3)
+ call t_stopf('DP_CPLN_fv_am')
+ endif
+
+ if (use_gw_front .or. use_gw_front_igw) then
+ call t_startf('DP_CPLN_gw_sources')
+ call gws_src_fnct(grid, u3, v3, ptxy, tracer(:,jfirstxy:jlastxy,:,1), pexy, frontgf, frontga)
+ call t_stopf('DP_CPLN_gw_sources')
+ end if
+ if (qbo_use_forcing) then
+ call zonal_mean_3D(grid, plev, u3, uzm)
+ end if
+
+!-----------------------------------------------------------------------
+! Copy data from dynamics data structure to physics data structure
+!-----------------------------------------------------------------------
+has_local_map : &
+ if (local_dp_map) then
+
+! This declaration is too long; this parallel section needs some stuff
+! pulled out into routines.
+!$omp parallel do private (lchnk, ncol, i, k, m, ic, jc, lons, lats, pic, pbuf_chnk, pbuf_uzm, pbuf_frontgf, pbuf_frontga)
+chnk_loop1 : &
+ do lchnk = begchunk,endchunk
+ ncol = phys_state(lchnk)%ncol
+ call get_lon_all_p(lchnk, ncol, lons)
+ call get_lat_all_p(lchnk, ncol, lats)
+
+ pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk)
+
+ if (use_gw_front .or. use_gw_front_igw) then
+ call pbuf_get_field(pbuf_chnk, frontgf_idx, pbuf_frontgf)
+ call pbuf_get_field(pbuf_chnk, frontga_idx, pbuf_frontga)
+ end if
+
+ if (qbo_use_forcing) then
+ call pbuf_get_field(pbuf_chnk, uzm_idx, pbuf_uzm)
+ end if
+
+ do i=1,ncol
+ ic = lons(i)
+ jc = lats(i)
+ phys_state(lchnk)%ps(i) = psxy(ic,jc)
+ phys_state(lchnk)%phis(i) = phisxy(ic,jc)
+ pic(i) = pkxy(ic,jc,pver+1)
+ enddo
+ do k=1,km
+ do i=1,ncol
+ ic = lons(i)
+ jc = lats(i)
+ phys_state(lchnk)%u (i,k) = u3(ic,k,jc)
+ phys_state(lchnk)%v (i,k) = v3(ic,k,jc)
+ phys_state(lchnk)%omega(i,k) = omgaxy(ic,k,jc)
+ phys_state(lchnk)%t (i,k) = ptxy(ic,jc,k) / (D1_0 + zvir*tracer(ic,jc,k,1))
+ phys_state(lchnk)%exner(i,k) = pic(i) / pkzxy(ic,jc,k)
+
+ if (use_gw_front .or. use_gw_front_igw) then
+ pbuf_frontgf(i,k) = frontgf(ic,k,jc)
+ pbuf_frontga(i,k) = frontga(ic,k,jc)
+ endif
+
+ if (qbo_use_forcing) then
+ pbuf_uzm(i,k) = uzm(k,jc)
+ end if
+
+ end do
+ end do
+
+ do k=1,kmp1
+ do i=1,ncol
+!
+! edge-level pressure arrays: copy from the arrays computed by dynpkg
+!
+ ic = lons(i)
+ jc = lats(i)
+ phys_state(lchnk)%pint (i,k) = pexy (ic,k,jc)
+ phys_state(lchnk)%lnpint(i,k) = pelnxy(ic,k,jc)
+ end do
+ end do
+
+!
+! Copy constituents
+! Dry types converted from moist to dry m.r. at bottom of this routine
+!
+ do m=1,pcnst
+ do k=1,km
+ do i=1,ncol
+ phys_state(lchnk)%q(i,k,m) = &
+ tracer(lons(i),lats(i),k,m)
+ end do
+ end do
+ end do
+
+ end do chnk_loop1
+
+ else has_local_map
+
+ boff = 6
+ if (use_gw_front .or. use_gw_front_igw) boff = boff+2
+ if (qbo_use_forcing) boff = boff+1
+
+ tsize = boff + 1 + pcnst
+
+ blksiz = (jlastxy-jfirstxy+1)*(ilastxy-ifirstxy+1)
+ allocate( bpter(blksiz,0:km),stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'd_p_coupling: failed to allocate bpter; error = ',astat
+ call endrun
+ end if
+ allocate( bbuffer(tsize*block_buf_nrecs),stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'd_p_coupling: failed to allocate bbuffer; error = ',astat
+ call endrun
+ end if
+ allocate( cbuffer(tsize*chunk_buf_nrecs),stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'd_p_coupling: failed to allocate cbuffer; error = ',astat
+ call endrun
+ end if
+
+ if (iam .lt. grid%npes_xy) then
+ call block_to_chunk_send_pters(iam+1,blksiz,kmp1,tsize,bpter)
+ endif
+
+!$omp parallel do private (j, i, ib, k, m)
+ do j=jfirstxy,jlastxy
+ do i=ifirstxy,ilastxy
+ ib = (j-jfirstxy)*(ilastxy-ifirstxy+1) + (i-ifirstxy+1)
+
+ bbuffer(bpter(ib,0)+4:bpter(ib,0)+boff+pcnst) = 0.0_r8
+
+ bbuffer(bpter(ib,0)) = pexy(i,kmp1,j)
+ bbuffer(bpter(ib,0)+1) = pelnxy(i,kmp1,j)
+ bbuffer(bpter(ib,0)+2) = psxy(i,j)
+ bbuffer(bpter(ib,0)+3) = phisxy(i,j)
+
+ do k=1,km
+
+ bbuffer(bpter(ib,k)) = pexy(i,k,j)
+ bbuffer(bpter(ib,k)+1) = pelnxy(i,k,j)
+ bbuffer(bpter(ib,k)+2) = u3 (i,k,j)
+ bbuffer(bpter(ib,k)+3) = v3 (i,k,j)
+ bbuffer(bpter(ib,k)+4) = omgaxy(i,k,j)
+ bbuffer(bpter(ib,k)+5) = ptxy(i,j,k) / (D1_0 + zvir*tracer(i,j,k,1))
+ bbuffer(bpter(ib,k)+6) = pkxy(i,j,pver+1) / pkzxy(i,j,k)
+
+ if (use_gw_front .or. use_gw_front_igw) then
+ bbuffer(bpter(ib,k)+7) = frontgf(i,k,j)
+ bbuffer(bpter(ib,k)+8) = frontga(i,k,j)
+ end if
+
+ if (qbo_use_forcing) then
+ bbuffer(bpter(ib,k)+9) = uzm(k,j)
+ end if
+
+ do m=1,pcnst
+ bbuffer(bpter(ib,k)+boff+m) = tracer(i,j,k,m)
+ end do
+
+ end do
+ end do
+ end do
+
+ call t_barrierf('sync_blk_to_chk', grid%commxy)
+ call t_startf ('block_to_chunk')
+ call transpose_block_to_chunk(tsize, bbuffer, cbuffer)
+ call t_stopf ('block_to_chunk')
+
+!$omp parallel do private (lchnk, ncol, i, k, m, cpter, pbuf_chnk, pbuf_uzm, pbuf_frontgf, pbuf_frontga)
+chnk_loop2 : &
+ do lchnk = begchunk,endchunk
+ ncol = phys_state(lchnk)%ncol
+
+ pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk)
+
+ if (use_gw_front .or. use_gw_front_igw) then
+ call pbuf_get_field(pbuf_chnk, frontgf_idx, pbuf_frontgf)
+ call pbuf_get_field(pbuf_chnk, frontga_idx, pbuf_frontga)
+ end if
+
+ if (qbo_use_forcing) then
+ call pbuf_get_field(pbuf_chnk, uzm_idx, pbuf_uzm)
+ end if
+
+ call block_to_chunk_recv_pters(lchnk,pcols,pver+1,tsize,cpter)
+
+ do i=1,ncol
+
+ phys_state(lchnk)%pint (i,pver+1) = cbuffer(cpter(i,0))
+ phys_state(lchnk)%lnpint(i,pver+1) = cbuffer(cpter(i,0)+1)
+ phys_state(lchnk)%ps(i) = cbuffer(cpter(i,0)+2)
+ phys_state(lchnk)%phis(i) = cbuffer(cpter(i,0)+3)
+
+ do k=1,km
+
+ phys_state(lchnk)%pint (i,k) = cbuffer(cpter(i,k))
+ phys_state(lchnk)%lnpint(i,k) = cbuffer(cpter(i,k)+1)
+ phys_state(lchnk)%u (i,k) = cbuffer(cpter(i,k)+2)
+ phys_state(lchnk)%v (i,k) = cbuffer(cpter(i,k)+3)
+ phys_state(lchnk)%omega (i,k) = cbuffer(cpter(i,k)+4)
+ phys_state(lchnk)%t (i,k) = cbuffer(cpter(i,k)+5)
+ phys_state(lchnk)%exner (i,k) = cbuffer(cpter(i,k)+6)
+
+ if (use_gw_front .or. use_gw_front_igw) then
+ pbuf_frontgf(i,k) = cbuffer(cpter(i,k)+7)
+ pbuf_frontga(i,k) = cbuffer(cpter(i,k)+8)
+ end if
+
+ if (qbo_use_forcing) then
+ pbuf_uzm(i,k) = cbuffer(cpter(i,k)+9)
+ end if
+
+ ! dry type constituents converted from moist to dry at bottom of routine
+ do m=1,pcnst
+ phys_state(lchnk)%q(i,k,m) = cbuffer(cpter(i,k)+boff+m)
+ end do
+
+ end do
+ end do
+
+ end do chnk_loop2
+
+ deallocate(bpter)
+ deallocate(bbuffer)
+ deallocate(cbuffer)
+
+ endif has_local_map
+
+!+tht (dlw/jgo)
+!--------------------------------------------
+! Check for negative water constituents later
+!--------------------------------------------
+ call cnst_get_ind('CLDICE', ixcldice)
+ call cnst_get_ind('CLDLIQ', ixcldliq)
+!-tht
+!------------------------------------------------------
+! Get indices to access O, O2, H, H2, and N species
+!------------------------------------------------------
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ call cnst_get_ind('O', ixo)
+ call cnst_get_ind('O2', ixo2)
+ call cnst_get_ind('H', ixh)
+ call cnst_get_ind('H2', ixh2)
+ call cnst_get_ind('N', ixn)
+ endif
+!
+! Evaluate derived quantities
+!
+ call t_startf ('derived_fields')
+!$omp parallel do private (lchnk, ncol, i, k, m, qmavl, dqreq, qbot, qbotm1, zvirv, pbuf_chnk, mmrSum_O_O2_H)
+ do lchnk = begchunk,endchunk
+ ncol = phys_state(lchnk)%ncol
+ do k=1,km
+ do i=1,ncol
+ phys_state(lchnk)%pdel (i,k) = phys_state(lchnk)%pint(i,k+1) - phys_state(lchnk)%pint(i,k)
+ phys_state(lchnk)%rpdel(i,k) = D1_0/phys_state(lchnk)%pdel(i,k)
+ phys_state(lchnk)%pmid (i,k) = D0_5*(phys_state(lchnk)%pint(i,k) + phys_state(lchnk)%pint(i,k+1))
+ phys_state(lchnk)%lnpmid(i,k) = log(phys_state(lchnk)%pmid(i,k))
+ end do
+ end do
+
+! Attempt to remove negative constituents in bottom layer only by moving from next level
+! This is a BAB kludge to avoid masses of warning messages for cloud water and ice, since
+! the vertical remapping operator currently being used for cam is not strictly monotonic
+! at the endpoints.
+ do m=1,pcnst
+ do i=1,ncol
+ if (phys_state(lchnk)%q(i,pver,m) < qmin(m)) then
+! available q in 2nd level
+ qmavl = phys_state(lchnk)%q (i,pver-1,m) - qmin(m)
+! required q change in bottom level rescaled to mass fraction in 2nd level
+ dqreq = (qmin(m) - phys_state(lchnk)%q(i,pver,m)) &
+ * phys_state(lchnk)%pdel(i,pver) / phys_state(lchnk)%pdel(i,pver-1)
+ qbot = phys_state(lchnk)%q(i,pver ,m)
+ qbotm1 = phys_state(lchnk)%q(i,pver-1,m)
+ if (dqreq < qmavl) then
+ phys_state(lchnk)%q(i,pver ,m) = qmin(m)
+ phys_state(lchnk)%q(i,pver-1,m) = phys_state(lchnk)%q(i,pver-1,m) - dqreq
+ ! Comment out these log messages since they can make the log files so
+ ! large that they're unusable.
+ if (dqreq>qmin(m) .and. dqreq>fraction*qbotm1 .and. (trim(fv_print_dpcoup_warn) == "full")) &
+ write(iulog,*) 'dpcoup dqreq', m, lchnk, i, qbot, qbotm1, dqreq
+ else
+ ! Comment out these log messages since they can make the log files so
+ ! large that they're unusable.
+ if (dqreq>qmin(m) .and. (trim(fv_print_dpcoup_warn) == "full")) then
+ write(iulog,*) 'dpcoup cant adjust', m, lchnk, i, qbot, qbotm1, dqreq
+ end if
+ end if
+ end if
+ end do
+ end do
+
+!-----------------------------------------------------------------------------------------------------------------
+! Ensure O2 + O + H (N2) mmr greater than one. Check for unusually large H2 values and set to lower value
+!-----------------------------------------------------------------------------------------------------------------
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ do i=1,ncol
+ do k=1,pver
+
+ if (phys_state(lchnk)%q(i,k,ixo) < mmrMin) phys_state(lchnk)%q(i,k,ixo) = mmrMin
+ if (phys_state(lchnk)%q(i,k,ixo2) < mmrMin) phys_state(lchnk)%q(i,k,ixo2) = mmrMin
+
+ mmrSum_O_O2_H = phys_state(lchnk)%q(i,k,ixo)+phys_state(lchnk)%q(i,k,ixo2)+phys_state(lchnk)%q(i,k,ixh)
+
+ if ((1._r8-mmrMin-mmrSum_O_O2_H) < 0._r8) then
+
+ phys_state(lchnk)%q(i,k,ixo) = phys_state(lchnk)%q(i,k,ixo) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H
+
+ phys_state(lchnk)%q(i,k,ixo2) = phys_state(lchnk)%q(i,k,ixo2) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H
+
+ phys_state(lchnk)%q(i,k,ixh) = phys_state(lchnk)%q(i,k,ixh) * (1._r8 - N2mmrMin) / mmrSum_O_O2_H
+
+ endif
+
+ if(phys_state(lchnk)%q(i,k,ixh2) .gt. 6.e-5_r8) then
+ phys_state(lchnk)%q(i,k,ixh2) = 6.e-5_r8
+ endif
+
+ end do
+ end do
+ endif
+
+!-----------------------------------------------------------------------------
+! Call physconst_update to compute cpairv, rairv, mbarv, and cappav as constituent dependent variables
+! and compute molecular viscosity(kmvis) and conductivity(kmcnd)
+!-----------------------------------------------------------------------------
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ call physconst_update(phys_state(lchnk)%q, phys_state(lchnk)%t, lchnk, ncol)
+ endif
+
+!------------------------------------------------------------------------
+! Fill local zvirv variable; calculated for WACCM-X
+!------------------------------------------------------------------------
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ zvirv(:,:) = shr_const_rwv / rairv(:,:,lchnk) -1._r8
+ else
+ zvirv(:,:) = zvir
+ endif
+!
+! Compute initial geopotential heights
+ call geopotential_t (phys_state(lchnk)%lnpint, phys_state(lchnk)%lnpmid , phys_state(lchnk)%pint , &
+ phys_state(lchnk)%pmid , phys_state(lchnk)%pdel , phys_state(lchnk)%rpdel , &
+ phys_state(lchnk)%t , phys_state(lchnk)%q(:,:,1), rairv(:,:,lchnk), gravit, zvirv, &
+ phys_state(lchnk)%zi , phys_state(lchnk)%zm , ncol )
+
+! Compute initial dry static energy, include surface geopotential
+ do k = 1, pver
+ do i=1,ncol
+ phys_state(lchnk)%s(i,k) = cpairv(i,k,lchnk)*phys_state(lchnk)%t(i,k) &
+ + gravit*phys_state(lchnk)%zm(i,k) + phys_state(lchnk)%phis(i)
+ end do
+ end do
+
+!
+! Convert dry type constituents from moist to dry mixing ratio
+!
+ call set_state_pdry(phys_state(lchnk)) ! First get dry pressure to use for this timestep
+ call set_wet_to_dry(phys_state(lchnk)) ! Dynamics had moist, physics wants dry.
+
+!+tht (dlw/jgo)
+!
+!
+! Ensure tracers are all positive
+!
+ call qneg3('D_P_COUPLING',lchnk ,ncol ,pcols ,pver , &
+ 1, pcnst, qmin ,phys_state(lchnk)%q)
+ m = ixcldliq
+ call qneg3('D_P_COUPLING/CLDLIQ',lchnk ,ncol ,pcols ,pver , &
+ m, m, qmin(m) ,phys_state(lchnk)%q(1,1,m) )
+ m = ixcldice
+ call qneg3('D_P_COUPLING/CLDICE',lchnk ,ncol ,pcols ,pver , &
+ m, m, qmin(m) ,phys_state(lchnk)%q(1,1,m) )
+!-tht
+
+! Compute energy and water integrals of input state
+
+ pbuf_chnk => pbuf_get_chunk(pbuf2d, lchnk)
+ call check_energy_timestep_init(phys_state(lchnk), phys_tend(lchnk), pbuf_chnk)
+
+ end do
+ call t_stopf('derived_fields')
+
+ deallocate (u3)
+ deallocate (v3)
+ if (dyn_state%am_diag) then
+ deallocate (du3)
+ deallocate (dv3)
+ deallocate (dua3)
+ deallocate (dva3)
+ deallocate (duf3)
+ deallocate (dummy)
+ end if
+
+ end subroutine d_p_coupling
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!BOP
+! !IROUTINE: p_d_coupling --- convert physics output to dynamics input
+!
+! !INTERFACE:
+ subroutine p_d_coupling(grid, phys_state, phys_tend, &
+ dyn_in, dtime, zvir, cappa, ptop)
+
+! !USES:
+#if ( defined OFFLINE_DYN )
+ use metdata, only: get_met_fields
+#endif
+ use physics_buffer, only: physics_buffer_desc
+ use physconst, only: physconst_calc_kappav
+
+!-----------------------------------------------------------------------
+ implicit none
+
+! Variables ending in xy are xy-decomposition instanciations.
+
+ type(T_FVDYCORE_GRID), intent(in) :: grid ! FV Dynamics grid
+
+! !INPUT PARAMETERS:
+ type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state
+ type(physics_tend), intent(inout), dimension(begchunk:endchunk) :: phys_tend
+ type(dyn_import_t), intent(inout) :: dyn_in
+
+ real(r8), intent(in) :: dtime
+ real(r8), intent(in) :: zvir
+ real(r8), intent(in) :: cappa
+ real(r8), intent(in) :: ptop
+
+! !DESCRIPTION:
+!
+! Coupler for converting physics output variables into dynamics input variables
+!
+! !REVISION HISTORY:
+! 00.06.01 Boville Creation
+! 01.06.08 AAM Compactified
+! 01.07.13 AAM Some support for multi-2D decompositions
+! 02.03.01 Worley Support for nontrivial physics remapping
+! 02.08.06 Sawyer T3 added -- updated to current temperature
+! 05.07.12 Sawyer Added dyn_state as argument
+! 05.09.23 Sawyer Transitioned to XY decomposition vars. only
+! 05.10.31 Sawyer Replaced dyn_state with dyn_interface
+!
+!EOP
+!-----------------------------------------------------------------------
+!BOC
+! !LOCAL VARIABLES:
+
+ type(t_fvdycore_state), pointer :: dyn_state
+
+! Variables from the dynamics import container
+
+ real(r8), pointer :: psxy(:,:)
+ real(r8), pointer :: u3sxy(:,:,:)
+ real(r8), pointer :: v3sxy(:,:,:)
+ real(r8), pointer :: t3xy(:,:,:) ! Temperature
+ real(r8), pointer :: ptxy(:,:,:) ! Virt. pot. temp.
+ real(r8), pointer :: tracer(:,:,:,:) ! Constituents
+
+ real(r8), pointer :: pexy(:,:,:)
+ real(r8), pointer :: delpxy(:,:,:)
+ real(r8), pointer :: pkxy(:,:,:)
+ real(r8), pointer :: pkzxy(:,:,:)
+
+! Local workspace
+
+ real(r8):: dudtxy(grid%ifirstxy:grid%ilastxy,&
+ grid%km,grid%jfirstxy:grid%jlastxy)
+ real(r8):: dvdtxy(grid%ifirstxy:grid%ilastxy,&
+ grid%km,grid%jfirstxy:grid%jlastxy)
+ real(r8):: dummy_pelnxy(grid%ifirstxy:grid%ilastxy,grid%km+1, &
+ grid%jfirstxy:grid%jlastxy)
+
+ integer :: i, ib, k, m, j, lchnk ! indices
+ integer :: ncol ! number of columns in current chunk
+ integer :: lats(pcols) ! array of latitude indices
+ integer :: lons(pcols) ! array of longitude indices
+ integer :: blksiz ! number of columns in 2D block
+ integer :: tsize ! amount of data per grid point passed to physics
+ integer, allocatable, dimension(:,:) :: bpter
+ ! offsets into block buffer for unpacking data
+ integer :: cpter(pcols,0:pver) ! offsets into chunk buffer for packing data
+
+ real(r8) :: dt5
+ real(r8), allocatable, dimension(:) :: &
+ bbuffer, cbuffer ! transpose buffers
+#if (! defined SPMD)
+ integer :: block_buf_nrecs = 0
+ integer :: chunk_buf_nrecs = 0
+ logical :: local_dp_map=.true.
+#endif
+ integer :: km, iam
+ integer :: ifirstxy, ilastxy, jfirstxy, jlastxy
+
+ real(r8) :: cappa3v( grid%ifirstxy:grid%ilastxy,&
+ grid%jfirstxy:grid%jlastxy, grid%km )
+
+ dyn_state => get_dyn_state()
+
+! Pull the variables out of the dynamics export container
+
+ psxy => dyn_in%ps
+ u3sxy => dyn_in%u3s
+ v3sxy => dyn_in%v3s
+ t3xy => dyn_in%t3
+ ptxy => dyn_in%pt
+ tracer => dyn_in%tracer
+
+ pexy => dyn_in%pe
+ delpxy => dyn_in%delp
+ pkxy => dyn_in%pk
+ pkzxy => dyn_in%pkz
+
+ km = grid%km
+
+ ifirstxy = grid%ifirstxy
+ ilastxy = grid%ilastxy
+ jfirstxy = grid%jfirstxy
+ jlastxy = grid%jlastxy
+
+ iam = grid%iam
+
+!---------------------------End Local workspace-------------------------
+
+#if ( defined OFFLINE_DYN )
+!
+! set the dyn flds to offline meteorological data
+!
+ call get_met_fields( phys_state, phys_tend, dtime )
+#endif
+! -------------------------------------------------------------------------
+! Copy temperature, tendencies and constituents to dynamics data structures
+! -------------------------------------------------------------------------
+
+! -------------------------------------------------------------------------
+! Copy onto xy decomposition, then transpose to yz decomposition
+! -------------------------------------------------------------------------
+
+ if (local_dp_map) then
+
+!$omp parallel do private(lchnk, i, k, ncol, m, lons, lats)
+
+ do lchnk = begchunk,endchunk
+ ncol = get_ncols_p(lchnk)
+ call get_lon_all_p(lchnk, ncol, lons)
+ call get_lat_all_p(lchnk, ncol, lats)
+
+ do k = 1, km
+ do i = 1, ncol
+ dvdtxy(lons(i),k,lats(i)) = phys_tend(lchnk)%dvdt(i,k)
+ dudtxy(lons(i),k,lats(i)) = phys_tend(lchnk)%dudt(i,k)
+ ptxy (lons(i),lats(i),k) = phys_state(lchnk)%t(i,k)
+ delpxy(lons(i),lats(i),k) = phys_state(lchnk)%pdel(i,k)
+ enddo
+ enddo
+
+ do m=1,pcnst
+ do k=1,km
+ do i=1,ncol
+ tracer(lons(i),lats(i),k,m) = &
+ phys_state(lchnk)%q(i,k,m)
+ end do
+ end do
+ end do
+
+ enddo
+
+ else
+
+ tsize = 4 + pcnst
+
+ blksiz = (jlastxy-jfirstxy+1)*(ilastxy-ifirstxy+1)
+ allocate(bpter(blksiz,0:km))
+ allocate(bbuffer(tsize*block_buf_nrecs))
+ allocate(cbuffer(tsize*chunk_buf_nrecs))
+
+!$omp parallel do private (lchnk, ncol, i, k, m, cpter)
+ do lchnk = begchunk,endchunk
+ ncol = get_ncols_p(lchnk)
+
+ call chunk_to_block_send_pters(lchnk,pcols,km+1,tsize,cpter)
+
+ do i=1,ncol
+ cbuffer(cpter(i,0):cpter(i,0)+3+pcnst) = 0.0_r8
+ end do
+
+ do k=1,km
+ do i=1,ncol
+
+ cbuffer(cpter(i,k)) = phys_tend(lchnk)%dvdt(i,k)
+ cbuffer(cpter(i,k)+1) = phys_tend(lchnk)%dudt(i,k)
+ cbuffer(cpter(i,k)+2) = phys_state(lchnk)%t(i,k)
+ cbuffer(cpter(i,k)+3) = phys_state(lchnk)%pdel(i,k)
+
+ do m=1,pcnst
+ cbuffer(cpter(i,k)+3+m) = phys_state(lchnk)%q(i,k,m)
+ end do
+
+ end do
+
+ end do
+
+ end do
+
+ call t_barrierf('sync_chk_to_blk', grid%commxy)
+ call t_startf ('chunk_to_block')
+ call transpose_chunk_to_block(tsize, cbuffer, bbuffer)
+ call t_stopf ('chunk_to_block')
+
+ if (iam .lt. grid%npes_xy) then
+ call chunk_to_block_recv_pters(iam+1,blksiz,km+1,tsize,bpter)
+ endif
+
+!$omp parallel do private (j, i, ib, k, m)
+ do j=jfirstxy,jlastxy
+ do k=1,km
+ do i=ifirstxy,ilastxy
+ ib = (j-jfirstxy)*(ilastxy-ifirstxy+1) + (i-ifirstxy+1)
+
+ dvdtxy(i,k,j) = bbuffer(bpter(ib,k))
+ dudtxy(i,k,j) = bbuffer(bpter(ib,k)+1)
+ ptxy (i,j,k) = bbuffer(bpter(ib,k)+2)
+ delpxy(i,j,k) = bbuffer(bpter(ib,k)+3)
+
+ do m=1,pcnst
+ tracer(i,j,k,m) = bbuffer(bpter(ib,k)+3+m)
+ end do
+
+ enddo
+ enddo
+ enddo
+
+ deallocate(bpter)
+ deallocate(bbuffer)
+ deallocate(cbuffer)
+
+ endif
+
+! WS: 02.08.06: Update t3 to temperature
+!$omp parallel do private(i,j,k)
+ do k=1,km
+ do j = jfirstxy,jlastxy
+ do i = ifirstxy,ilastxy
+ t3xy(i,j,k) = ptxy(i,j,k)
+ enddo
+ enddo
+ enddo
+
+! -------------------------------------------------------------------------
+! Update u3s and v3s from tendencies dudt and dvdt.
+! -------------------------------------------------------------------------
+ dt5 = D0_5*dtime
+
+ call t_barrierf('sync_uv3s_update', grid%commxy)
+ call t_startf('uv3s_update')
+ if (iam .lt. grid%npes_xy) then
+ call uv3s_update(grid, dudtxy, u3sxy, dvdtxy, v3sxy, dt5, &
+ dyn_state%am_correction)
+ end if ! (iam .lt. grid%npes_xy)
+ call t_stopf('uv3s_update')
+
+! -------------------------------------------------------------------------
+! Compute pt, q3, pe, delp, ps, peln, pkz and pk.
+! For 2-D decomposition, delp is transposed to delpxy, pexy is computed
+! from delpxy (and ptop), and pexy is transposed back to pe.
+! Note that pt, q3, delp and pe are input parameters as well.
+! -------------------------------------------------------------------------
+ call t_barrierf('sync_p_d_adjust', grid%commxy)
+ call t_startf ('p_d_adjust')
+ if (iam .lt. grid%npes_xy) then
+ if (grid%high_alt) then
+ call physconst_calc_kappav(ifirstxy,ilastxy,jfirstxy,jlastxy,1,km, grid%ntotq, tracer, cappa3v )
+ else
+ cappa3v = cappa
+ endif
+ call p_d_adjust(grid, tracer, dummy_pelnxy, pkxy, pkzxy, zvir, cappa3v, &
+ delpxy, ptxy, pexy, psxy, ptop)
+ end if ! (iam .lt. grid%npes_xy)
+ call t_stopf ('p_d_adjust')
+
+!EOC
+ end subroutine p_d_coupling
+!-----------------------------------------------------------------------
+end module dp_coupling
diff --git a/src/NorESM/fv/metdata.F90 b/src/NorESM/fv/metdata.F90
new file mode 100644
index 0000000000..fd8faafcdf
--- /dev/null
+++ b/src/NorESM/fv/metdata.F90
@@ -0,0 +1,2445 @@
+module metdata
+!-----------------------------------------------------------------------
+!
+! BOP
+!
+! !MODULE: metdata
+!
+! !DESCRIPTION
+! Handles reading and interpolating offline meteorological data which
+! is used to drive the dynamics.
+!
+! !USES
+ use shr_kind_mod, only: r8 => shr_kind_r8, r4 => shr_kind_r4
+ use shr_cal_mod, only: shr_cal_gregorian
+ use time_manager, only: get_curr_date, get_step_size, timemgr_is_caltype
+ use spmd_utils, only: masterproc
+ use ppgrid, only: pcols, pver, begchunk, endchunk
+ use time_manager, only: get_curr_calday, get_curr_date, get_step_size
+ use cam_abortutils, only: endrun
+ use dynamics_vars, only: T_FVDYCORE_GRID
+
+#if ( defined SPMD )
+ use mpishorthand, only: mpicom, mpir8, mpiint,mpichar
+ use mod_comm, only: mp_sendirr,mp_recvirr
+#endif
+ use perf_mod
+ use cam_logfile, only: iulog
+ use pio, only: file_desc_t, pio_put_att, pio_global, pio_get_att, pio_inq_att, &
+ pio_inq_dimid, pio_inq_dimlen, pio_closefile, pio_get_var, pio_inq_varid, &
+ pio_offset_kind
+ use cam_pio_utils, only: cam_pio_openfile
+
+
+ implicit none
+
+ private ! all unless made public
+ save
+
+! !PUBLIC MEMBERS
+
+ public :: metdata_dyn_init ! subroutine to open files, allocate blocked arrays, etc
+ public :: metdata_phys_init ! subroutine to allocate chunked arrays
+ public :: advance_met ! subroutine to read more data and interpolate
+ public :: get_met_fields ! interface to set meteorology fields
+ public :: get_met_srf1
+ public :: get_met_srf2
+ public :: get_us_vs
+ public :: metdata_readnl
+ public :: met_winds_on_walls
+ public :: write_met_restart
+ public :: read_met_restart
+ public :: met_rlx
+ public :: met_fix_mass
+ public :: met_srf_feedback
+ !++ IH
+ public :: met_nudge_only_uvps
+ !-- IH
+
+ interface write_met_restart
+ Module procedure write_met_restart_bin
+ Module procedure write_met_restart_pio
+ end interface
+
+ interface read_met_restart
+ Module procedure read_met_restart_bin
+ Module procedure read_met_restart_pio
+ end interface
+
+
+ !------------------------------------------------------------------
+ ! Interface to access the meteorology fields. Possible invocations
+ ! are as follows:
+ ! call get_met_fields( physics_state, us, vs , tend, dt )
+ ! call get_met_fields( u, v )
+ ! call get_met_fields( cam_in_t )
+ !------------------------------------------------------------------
+ Interface get_met_fields ! overload accessors
+ Module Procedure get_dyn_flds
+ Module Procedure get_uv_centered
+ Module Procedure get_ps
+ Module Procedure get_ocn_ice_frcs
+ End Interface
+
+ real(r8), allocatable :: met_ps_next(:,:) ! PS interpolated to next timestep
+ real(r8), allocatable :: met_ps_curr(:,:) ! PS interpolated to next timestep
+
+ logical :: met_cell_wall_winds = .false. ! true => met data winds are defined on model grid cell walls
+ logical :: met_remove_file = .false. ! delete metdata file when finished with it
+
+ character(len=16) :: met_shflx_name = 'SHFLX'
+ character(len=16) :: met_qflx_name = 'QFLX'
+ real(r8) :: met_snowh_factor = 1._r8
+ real(r8) :: met_shflx_factor = 1._r8
+ real(r8) :: met_qflx_factor = 1._r8
+ logical :: met_srf_feedback = .true.
+ logical :: met_srf_nudge_flux = .true. ! wsx, wsy, shf, and cflx nudged rather than forced.
+ ! This is done primarily to prevent unrealistic
+ ! surface temperatures.
+
+ logical :: met_srf_land = .true. ! nudge surface fields over land (if false ignores
+ ! all surface nudging for gridboxes with LANDFRAC=1)
+ logical :: met_srf_land_scale = .false. ! when met_srf_land is false, nudges proportional
+ ! to the non land fraction, rather than just where
+ ! LANDFRAC=1
+ logical :: met_srf_rad = .false. ! nudge albedo and lwup?
+ logical :: met_srf_refs = .false. ! nudge 2m Q and T and 10m wind
+ logical :: met_srf_sst = .false. ! nudge sea surface temperature
+ logical :: met_srf_tau = .true. ! nudge taux and tauy
+ logical :: met_nudge_temp = .true. ! nudge atmospheric temperature
+
+
+ ! radiation/albedo surface field fill value (where there is no sunlight) read in from input data file
+ real(r8) :: srf_fill_value
+
+ !++ IH
+ logical :: met_nudge_only_uvps = .true. ! When true, only U, V and PS is nudged.
+ ! When false, other variables can also be nudged
+ ! (T, Q, TAUY, TAUX, SHFLX, QFLX, TS, SHOWH,...)
+ !-- IH
+
+! !REVISION HISTORY:
+! 31 Oct 2003 Francis Vitt Creation
+! 05 Feb 2004 F Vitt Removed reading/inperpolating PS for current timestep
+! -- only met_ps_next is needed
+! 10 Nov 2004 F Vitt Implemented ability to read from series of files
+! 16 Dec 2004 F Vitt Added offline_met_defaultopts and offline_met_setopts
+! 14 Jul 2005 W Sawyer Removed pmgrid, spmd_dyn dependencies
+! 12 Apr 2006 W Sawyer Removed unneeded ghosting of met_us, met_vs
+! 08 Apr 2010 J Edwards Replaced serial netcdf calls with pio interface
+! 16 Sep 2016 IH Karset Implemented ability to nudge only U, V and PS and change
+! the relaxation time
+!
+! EOP
+!-----------------------------------------------------------------------
+! $Id$
+! $Author$
+!-----------------------------------------------------------------------
+
+ type input2d
+ real(r8), dimension(:,:), pointer :: data => null()
+ endtype input2d
+
+ type input3d
+ real(r8), dimension(:,:,:), pointer :: data => null()
+ endtype input3d
+
+ real(r8), allocatable :: met_t(:,:,:) ! interpolated temperature
+ real(r8), allocatable :: met_u(:,:,:) ! interpolated zonal wind
+ real(r8), allocatable :: met_v(:,:,:) ! interpolated meridional wind
+ real(r8), allocatable :: met_us(:,:,:) ! interpolated zonal wind -staggered
+ real(r8), allocatable :: met_vs(:,:,:) ! interpolated meridional wind -staggered
+ real(r8), allocatable :: met_q(:,:,:) ! interpolated water vapor
+
+ real(r8), allocatable :: met_lhflx(:,:)! interpolated latent heat flux
+ real(r8), allocatable :: met_shflx(:,:)! interpolated sensible heat flux
+ real(r8), allocatable :: met_qflx(:,:) ! interpolated water vapor flux
+ real(r8), allocatable :: met_taux(:,:) ! interpolated
+ real(r8), allocatable :: met_tauy(:,:) ! interpolated
+ real(r8), allocatable :: met_snowh(:,:) ! interpolated snow height
+
+ real(r8), allocatable :: met_ts(:,:) ! interpolated
+
+ real(r8), allocatable :: met_asdir(:,:) ! interpolated VIS direct albedo
+ real(r8), allocatable :: met_asdif(:,:) ! interpolated VIS diffuse albedo
+ real(r8), allocatable :: met_aldir(:,:) ! interpolated NIR direct albedo
+ real(r8), allocatable :: met_aldif(:,:) ! interpolated NIR diffuse albedo
+ real(r8), allocatable :: met_lwup(:,:) ! interpolated upwelling LW flux
+ real(r8), allocatable :: met_sst(:,:) ! interpolated sea surface temperature
+ real(r8), allocatable :: met_icefrac(:,:) ! interpolated ice fraction
+ real(r8), allocatable :: met_qref(:,:) ! interpolated reference (2m) specific humidity
+ real(r8), allocatable :: met_tref(:,:) ! interpolated reference (2m) temperature
+ real(r8), allocatable :: met_u10(:,:) ! interpolated 10m wind speed
+
+ type(input3d) :: met_ti(2)
+ type(input3d) :: met_ui(2)
+ type(input3d) :: met_vi(2)
+ type(input3d) :: met_usi(2)
+ type(input3d) :: met_vsi(2)
+ type(input3d) :: met_qi(2)
+
+ type(input2d) :: met_psi_next(2)
+ type(input2d) :: met_psi_curr(2)
+ type(input2d) :: met_lhflxi(2)
+ type(input2d) :: met_shflxi(2)
+ type(input2d) :: met_qflxi(2)
+ type(input2d) :: met_tauxi(2)
+ type(input2d) :: met_tauyi(2)
+ type(input2d) :: met_tsi(2)
+ type(input2d) :: met_snowhi(2)
+ type(input2d) :: met_asdiri(2)
+ type(input2d) :: met_asdifi(2)
+ type(input2d) :: met_aldiri(2)
+ type(input2d) :: met_aldifi(2)
+ type(input2d) :: met_lwupi(2)
+ type(input2d) :: met_ssti(2)
+ type(input2d) :: met_icefraci(2)
+ type(input2d) :: met_qrefi(2)
+ type(input2d) :: met_trefi(2)
+ type(input2d) :: met_u10i(2)
+
+ integer :: dateid ! var id of the date in the netCDF
+ integer :: secid ! var id of the sec data
+ real(r8) :: datatimem = -1.e36_r8 ! time of prv. values read in
+ real(r8) :: datatimep = -1.e36_r8 ! time of nxt. values read in
+ real(r8) :: datatimemn = -1.e36_r8 ! time of prv. values read in for next timestep
+ real(r8) :: datatimepn = -1.e36_r8 ! time of nxt. values read in for next timestep
+
+ integer, parameter :: nm=1 ! array index for previous (minus) data
+ integer, parameter :: np=2 ! array indes for next (plus) data
+
+ real(r8) :: curr_mod_time ! model time - calendar day
+ real(r8) :: next_mod_time ! model time - calendar day - next time step
+
+ character(len=256) :: curr_filename, next_filename, met_data_file
+ character(len=256) :: met_filenames_list = ''
+ character(len=256) :: met_data_path = ''
+ type(file_desc_t) :: curr_fileid, next_fileid ! the id of the NetCDF file
+ real(r8), pointer, dimension(:) :: curr_data_times => null()
+ real(r8), pointer, dimension(:) :: next_data_times => null()
+
+ real(r8) :: alpha = 1.0_r8 ! don't read in water vapor
+ ! real(r8), private :: alpha = 0.0 ! read in water vaper each time step
+
+ real(r8), parameter :: D0_0 = 0.0_r8
+ real(r8), parameter :: D0_5 = 0.5_r8
+ real(r8), parameter :: D0_75 = 0.75_r8
+ real(r8), parameter :: D1_0 = 1.0_r8
+ real(r8), parameter :: days_per_month = 30.6_r8
+ real(r8), parameter :: days_per_non_leapyear = 365.0_r8
+ real(r8), parameter :: days_per_year = 365.25_r8
+ real(r8), parameter :: seconds_per_day = 86400.0_r8
+ real(r8), parameter :: fill_value = -9999.0_r8
+
+ logical :: online_test = .false.
+ logical :: debug = .false.
+
+ real(r8) :: met_rlx(pver)
+ integer :: met_levels
+ integer :: num_met_levels
+
+ real(r8) :: met_rlx_top = 60._r8
+ real(r8) :: met_rlx_bot = 50._r8
+
+ real(r8) :: met_rlx_bot_top = 0._r8
+ real(r8) :: met_rlx_bot_bot = 0._r8
+
+ real(r8) :: met_rlx_time = 0._r8
+
+#if ( defined OFFLINE_DYN )
+ logical :: met_fix_mass = .true.
+#else
+ logical :: met_fix_mass = .false.
+#endif
+ logical :: has_ts = .false.
+ logical :: has_lhflx = .false. ! Is LHFLX present in the met file?
+
+contains
+
+!-------------------------------------------------------------------------
+! meteorology data options
+!-------------------------------------------------------------------------
+ subroutine metdata_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use mpishorthand
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'metdata_readnl'
+
+ namelist /metdata_nl/ &
+ met_data_file, &
+ met_data_path, &
+ met_remove_file, &
+ met_cell_wall_winds, &
+ met_filenames_list, &
+ met_rlx_top, &
+ met_rlx_bot, &
+ met_rlx_bot_top, &
+ met_rlx_bot_bot, &
+ met_rlx_time, &
+ !++ IH: new option for uvps
+ met_nudge_only_uvps, &
+ !-- IH
+ met_fix_mass, &
+ met_shflx_name, &
+ met_shflx_factor, &
+ met_snowh_factor, &
+ met_qflx_name, &
+ met_qflx_factor, &
+ met_srf_feedback, &
+ met_srf_nudge_flux, &
+ met_srf_land, &
+ met_srf_land_scale, &
+ met_srf_rad, &
+ met_srf_refs, &
+ met_srf_sst, &
+ met_srf_tau, &
+ met_nudge_temp
+
+ ! Read namelist
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'metdata_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, metdata_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+ end if
+
+#if ( defined SPMD )
+
+ ! Broadcast namelist variables
+
+ call mpibcast (met_data_file ,len(met_data_file) ,mpichar,0,mpicom)
+ call mpibcast (met_data_path ,len(met_data_path) ,mpichar,0,mpicom)
+ call mpibcast (met_remove_file ,1 ,mpilog, 0, mpicom )
+ call mpibcast (met_cell_wall_winds,1 ,mpilog, 0, mpicom )
+ call mpibcast (met_filenames_list ,len(met_filenames_list),mpichar,0,mpicom)
+ call mpibcast (met_rlx_top, 1 ,mpir8, 0, mpicom )
+ call mpibcast (met_rlx_bot, 1 ,mpir8, 0, mpicom )
+ call mpibcast (met_rlx_bot_top, 1 ,mpir8, 0, mpicom )
+ call mpibcast (met_rlx_bot_bot, 1 ,mpir8, 0, mpicom )
+ call mpibcast (met_rlx_time, 1 ,mpir8, 0, mpicom )
+ call mpibcast (met_fix_mass, 1 ,mpilog, 0, mpicom )
+ call mpibcast (met_qflx_name ,len(met_qflx_name), mpichar,0,mpicom)
+ call mpibcast (met_shflx_name ,len(met_shflx_name), mpichar,0,mpicom)
+ call mpibcast (met_qflx_factor ,1, mpir8, 0, mpicom )
+ call mpibcast (met_shflx_factor ,1, mpir8, 0, mpicom )
+ call mpibcast (met_snowh_factor ,1, mpir8, 0, mpicom )
+ call mpibcast (met_srf_feedback ,1 ,mpilog, 0, mpicom )
+ call mpibcast (met_srf_nudge_flux ,1 ,mpilog, 0, mpicom )
+ call mpibcast (met_srf_land ,1 ,mpilog, 0, mpicom )
+ call mpibcast (met_srf_land_scale ,1 ,mpilog, 0, mpicom )
+ call mpibcast (met_srf_rad ,1 ,mpilog, 0, mpicom )
+ call mpibcast (met_srf_refs ,1 ,mpilog, 0, mpicom )
+ call mpibcast (met_srf_sst ,1 ,mpilog, 0, mpicom )
+ call mpibcast (met_srf_tau ,1 ,mpilog, 0, mpicom )
+ call mpibcast (met_nudge_temp ,1 ,mpilog, 0, mpicom )
+ !++ IH
+ call mpibcast (met_nudge_only_uvps ,1 ,mpilog, 0, mpicom )
+ !-- IH
+#endif
+
+ if (masterproc) then
+ write(iulog,*)'Time-variant meteorological dataset (met_data_file) is: ', trim(met_data_file)
+ write(iulog,*)'Meteorological data file will be removed (met_remove_file): ', met_remove_file
+ write(iulog,*)'Meteorological winds are on cell walls (met_cell_wall_winds): ', met_cell_wall_winds
+ write(iulog,*)'Meteorological file names list file: ', trim(met_filenames_list)
+ write(iulog,*)'Meteorological relax ramp region top at top is (km): ', met_rlx_top
+ write(iulog,*)'Meteorological relax ramp region bottom at top is (km): ', met_rlx_bot
+ write(iulog,*)'Meteorological relax ramp region top at bottom is (km): ', met_rlx_bot_top
+ write(iulog,*)'Meteorological relax ramp region bottom at bottom is (km): ', met_rlx_bot_bot
+ write(iulog,*)'Meteorological relaxation time (hours): ',met_rlx_time
+ write(iulog,*)'Offline driver mass fixer is trurned on (met_fix_mass): ',met_fix_mass
+ write(iulog,*)'Meteorological shflx field name : ', trim(met_shflx_name)
+ write(iulog,*)'Meteorological shflx multiplication factor : ', met_shflx_factor
+ write(iulog,*)'Meteorological qflx field name : ', trim(met_qflx_name)
+ write(iulog,*)'Meteorological qflx multiplication factor : ', met_qflx_factor
+ write(iulog,*)'Meteorological snowh multiplication factor : ', met_snowh_factor
+ write(iulog,*)'Meteorological allow srf models feedbacks : ', met_srf_feedback
+ write(iulog,*)'Meteorological allow srf land nudging : ', met_srf_land
+ write(iulog,*)'Meteorological scale srf land nudging : ', met_srf_land_scale
+ write(iulog,*)'Meteorological allow srf radiation nudging : ', met_srf_rad
+ write(iulog,*)'Meteorological allow srf reference field nudging : ', met_srf_refs
+ write(iulog,*)'Meteorological allow srf sst nudging : ', met_srf_sst
+ write(iulog,*)'Meteorological allow srf tau nudging : ', met_srf_tau
+ write(iulog,*)'Meteorological allow atm tempature nudging : ',met_nudge_temp
+ !++ IH
+ write(iulog,*)'Meteorological fields to nudge (u, v and ps, or more) : ', met_nudge_only_uvps
+ !-- IH
+ endif
+
+ end subroutine metdata_readnl
+
+!--------------------------------------------------------------------------
+! Opens file, allocates arrays
+!--------------------------------------------------------------------------
+ subroutine metdata_dyn_init(grid)
+ use infnan, only : nan, assignment(=)
+ use cam_control_mod, only : restart_run
+ implicit none
+
+! !INPUT PARAMETERS:
+ type (T_FVDYCORE_GRID), intent(in) :: grid
+
+
+ integer :: im, km, jfirst, jlast, kfirst, klast
+ integer :: ng_d, ng_s
+
+ im = grid%im
+ km = grid%km
+ jfirst = grid%jfirst
+ jlast = grid%jlast
+ kfirst = grid%kfirst
+ klast = grid%klast
+ ng_d = grid%ng_d
+ ng_s = grid%ng_s
+
+
+ if (.not. restart_run) then ! initial run or branch run
+ curr_filename = met_data_file
+ next_filename = ''
+ else
+ ! restart run
+ ! curr_filename & next_filename already set by restart_dynamics
+ endif
+
+ call open_met_datafile( curr_filename, curr_fileid, curr_data_times, met_data_path, check_dims=.true., grid=grid)
+
+ if ( len_trim(next_filename) > 0 ) &
+ call open_met_datafile( next_filename, next_fileid, next_data_times, met_data_path )
+
+!
+! allocate space for data arrays ...
+!
+ ! dynamics grid
+
+ allocate( met_psi_next(nm)%data(im, jfirst:jlast) )
+ allocate( met_psi_next(np)%data(im, jfirst:jlast) )
+ allocate( met_psi_curr(nm)%data(im, jfirst:jlast) )
+ allocate( met_psi_curr(np)%data(im, jfirst:jlast) )
+ allocate( met_ps_next(im, jfirst:jlast) )
+ allocate( met_ps_curr(im, jfirst:jlast) )
+
+ allocate( met_us(im, jfirst-ng_d:jlast+ng_s, kfirst:klast) )
+ allocate( met_vs(im, jfirst-ng_s:jlast+ng_d, kfirst:klast) )
+
+ met_us = nan
+ met_vs = nan
+
+ if (met_cell_wall_winds) then
+ allocate( met_usi(nm)%data(im, jfirst:jlast, kfirst:klast) )
+ allocate( met_usi(np)%data(im, jfirst:jlast, kfirst:klast) )
+ allocate( met_vsi(nm)%data(im, jfirst:jlast, kfirst:klast) )
+ allocate( met_vsi(np)%data(im, jfirst:jlast, kfirst:klast) )
+ endif
+
+ if (.not. met_cell_wall_winds) then
+
+ allocate( met_u(im, jfirst-ng_d:jlast+ng_d, kfirst:klast) )
+ allocate( met_ui(nm)%data(im, jfirst:jlast, kfirst:klast) )
+ allocate( met_ui(np)%data(im, jfirst:jlast, kfirst:klast) )
+
+ allocate( met_v(im, jfirst-ng_s:jlast+ng_d, kfirst:klast) )
+ allocate( met_vi(nm)%data(im, jfirst:jlast, kfirst:klast) )
+ allocate( met_vi(np)%data(im, jfirst:jlast, kfirst:klast) )
+
+ endif
+
+ end subroutine metdata_dyn_init
+
+!=================================================================================
+
+ subroutine metdata_phys_init
+ use infnan, only : nan, assignment(=)
+ use cam_history, only : addfld, horiz_only
+
+ call addfld ('MET_RLX', (/ 'lev' /), 'A', ' ', 'Meteorology relax function', gridname='fv_centers')
+ call addfld ('MET_TAUX', horiz_only, 'A', ' ', 'Meteorology taux', gridname='physgrid')
+ call addfld ('MET_TAUY', horiz_only, 'A', ' ', 'Meteorology tauy', gridname='physgrid')
+ call addfld ('MET_LHFX', horiz_only, 'A', ' ', 'Meteorology lhflx', gridname='physgrid')
+ call addfld ('MET_SHFX', horiz_only, 'A', ' ', 'Meteorology shflx', gridname='physgrid')
+ call addfld ('MET_QFLX', horiz_only, 'A', ' ', 'Meteorology qflx', gridname='physgrid')
+ call addfld ('MET_PS', horiz_only, 'A', ' ', 'Meteorology PS', gridname='fv_centers')
+ call addfld ('MET_T', (/ 'lev' /), 'A', ' ', 'Meteorology T', gridname='physgrid')
+ call addfld ('MET_U', (/ 'lev' /), 'A', ' ', 'Meteorology U', gridname='fv_centers')
+ call addfld ('MET_V', (/ 'lev' /), 'A', ' ', 'Meteorology V', gridname='fv_centers')
+ call addfld ('MET_SNOWH', horiz_only, 'A', ' ', 'Meteorology snow height', gridname='physgrid')
+
+ call addfld ('MET_TS', horiz_only, 'A', 'K', 'Meteorology TS', gridname='physgrid')
+ call addfld ('MET_OCNFRC', horiz_only, 'A', 'fraction', 'Ocean frac derived from met TS', gridname='physgrid')
+ call addfld ('MET_ICEFRC', horiz_only, 'A', 'fraction', 'Sea ice frac derived from met TS', gridname='physgrid')
+
+ call addfld ('MET_ASDIR', horiz_only, 'A', '1', 'Meteorology ASDIR', gridname='physgrid')
+ call addfld ('MET_ASDIF', horiz_only, 'A', '1', 'Meteorology ASDIF', gridname='physgrid')
+ call addfld ('MET_ALDIR', horiz_only, 'A', '1', 'Meteorology ALDIR', gridname='physgrid')
+ call addfld ('MET_ALDIF', horiz_only, 'A', '1', 'Meteorology ALDIF', gridname='physgrid')
+ call addfld ('MET_LWUP', horiz_only, 'A', 'Wm-2', 'Meteorology LWUP', gridname='physgrid')
+ call addfld ('MET_SST', horiz_only, 'A', 'K', 'Meteorology SST', gridname='physgrid')
+ call addfld ('MET_ICEFRAC', horiz_only, 'A', 'K', 'Meteorology ICEFRAC', gridname='physgrid')
+ call addfld ('MET_QREF', horiz_only, 'A', 'kg/kg', 'Meteorology QREF', gridname='physgrid')
+ call addfld ('MET_TREF', horiz_only, 'A', 'K', 'Meteorology TREF', gridname='physgrid')
+ call addfld ('MET_U10', horiz_only, 'A', 'ms-1', 'Meteorology U10', gridname='physgrid')
+
+! allocate chunked arrays
+
+ allocate( met_ti(nm)%data(pcols,pver,begchunk:endchunk) )
+ allocate( met_ti(np)%data(pcols,pver,begchunk:endchunk) )
+ allocate( met_t(pcols,pver,begchunk:endchunk) )
+
+ allocate( met_qi(nm)%data(pcols,pver,begchunk:endchunk) )
+ allocate( met_qi(np)%data(pcols,pver,begchunk:endchunk) )
+ allocate( met_q(pcols,pver,begchunk:endchunk) )
+
+ allocate( met_lhflxi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_lhflxi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_lhflx(pcols,begchunk:endchunk) )
+
+ allocate( met_shflxi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_shflxi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_shflx(pcols,begchunk:endchunk) )
+
+ allocate( met_qflxi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_qflxi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_qflx(pcols,begchunk:endchunk) )
+
+ allocate( met_tauxi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_tauxi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_taux(pcols,begchunk:endchunk) )
+
+ allocate( met_tauyi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_tauyi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_tauy(pcols,begchunk:endchunk) )
+
+ allocate( met_tsi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_tsi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_ts(pcols,begchunk:endchunk) )
+ met_ts(:,:) = nan
+
+ if(.not.met_srf_feedback) then
+ allocate( met_snowhi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_snowhi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_snowh(pcols,begchunk:endchunk) )
+ met_snowh(:,:) = nan
+ endif
+
+ if(met_srf_rad) then
+ allocate( met_asdiri(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_asdiri(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_asdir(pcols,begchunk:endchunk) )
+
+ allocate( met_asdifi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_asdifi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_asdif(pcols,begchunk:endchunk) )
+
+ allocate( met_aldiri(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_aldiri(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_aldir(pcols,begchunk:endchunk) )
+
+ allocate( met_aldifi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_aldifi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_aldif(pcols,begchunk:endchunk) )
+
+ allocate( met_lwupi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_lwupi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_lwup(pcols,begchunk:endchunk) )
+ end if
+
+ if(met_srf_refs) then
+ allocate( met_qrefi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_qrefi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_qref(pcols,begchunk:endchunk) )
+
+ allocate( met_trefi(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_trefi(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_tref(pcols,begchunk:endchunk) )
+
+ allocate( met_u10i(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_u10i(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_u10(pcols,begchunk:endchunk) )
+ end if
+
+ if(met_srf_sst) then
+ allocate( met_ssti(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_ssti(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_sst(pcols,begchunk:endchunk) )
+
+ allocate( met_icefraci(nm)%data(pcols,begchunk:endchunk) )
+ allocate( met_icefraci(np)%data(pcols,begchunk:endchunk) )
+ allocate( met_icefrac(pcols,begchunk:endchunk) )
+ end if
+
+ call set_met_rlx()
+
+ ! initialize phys surface fields...
+ call get_model_time()
+ call check_files()
+ call read_phys_srf_flds()
+ call interp_phys_srf_flds()
+ datatimem = -1.e36_r8
+ datatimep = -1.e36_r8
+ end subroutine metdata_phys_init
+
+
+!-----------------------------------------------------------------------
+! Reads more data if needed and interpolates data to current model time
+!-----------------------------------------------------------------------
+ subroutine advance_met(grid)
+ use cam_history, only : outfld
+ implicit none
+
+ type (T_FVDYCORE_GRID), intent(in) :: grid
+
+ real(r8) :: met_rlx_2d(grid%ifirstxy:grid%ilastxy,grid%km)
+ integer :: i,j,k, idim
+
+ call t_startf('MET__advance')
+
+!
+!
+ call get_model_time()
+
+ if ( ( curr_mod_time > datatimep ) .or. &
+ ( next_mod_time > datatimepn ) ) then
+ call check_files()
+ endif
+
+ if ( curr_mod_time > datatimep ) then
+ call read_next_metdata(grid)
+ end if
+
+ if ( next_mod_time > datatimepn ) then
+ call read_next_ps(grid)
+ end if
+
+! need to inperpolate the data, regardless !
+! each mpi tasks needs to interpolate
+ call interpolate_metdata(grid)
+
+ call t_stopf('MET__advance')
+
+ idim = grid%ilastxy - grid%ifirstxy + 1
+ do j = grid%jfirstxy, grid%jlastxy
+ do k = 1, grid%km
+ do i = grid%ifirstxy, grid%ilastxy
+ met_rlx_2d(i,k) = met_rlx(k)
+ enddo
+ enddo
+ call outfld('MET_RLX',met_rlx_2d, idim, j)
+ enddo
+ end subroutine advance_met
+
+!-------------------------------------------------------------------
+! Method to get some the meteorology data.
+! Sets the following cam_in_t member fields to the
+! meteorology data :
+! qflx
+! lhflx
+! shflx
+! taux
+! tauy
+! snowh
+!-------------------------------------------------------------------
+ subroutine get_met_srf2( cam_in )
+ use camsrfexch, only: cam_in_t
+ use phys_grid, only: get_ncols_p
+ use cam_history, only: outfld
+ use shr_const_mod, only: shr_const_stebol
+ use physconst, only: latvap, latice
+
+ implicit none
+
+ type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in
+
+ integer :: c,ncol,i
+ real(r8) :: met_rlx_sfc(pcols)
+ real(r8) :: lcl_rlx(pcols)
+
+ !++ IH don't nudge the stress and the heat fluxes if met_nudge_only_uvps is true
+ if (.not. met_nudge_only_uvps) then
+ !-- IH
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+
+ ! Nudge or force the surface fields?
+ if (met_srf_nudge_flux) then
+ met_rlx_sfc(:ncol) = met_rlx(pver)
+ else
+ met_rlx_sfc(:ncol) = 1._r8
+ end if
+
+ ! Don't nudge the surface for locations that are entirely land?
+ if (.not. met_srf_land) then
+
+ ! Nudging land and forcing ocean.
+ if (met_srf_land_scale) then
+ met_rlx_sfc(:ncol) = (1._r8 - cam_in(c)%landfrac(:ncol)) * met_rlx_sfc(:ncol) + cam_in(c)%landfrac(:ncol) * met_rlx(pver)
+ else
+ where(cam_in(c)%landfrac(:ncol) .eq. 1._r8) met_rlx_sfc(:ncol) = 0._r8
+ end if
+ end if
+
+ if (met_srf_tau) then
+ cam_in(c)%wsx(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%wsx(:ncol) + met_rlx_sfc(:ncol) * met_taux(:ncol,c)
+ cam_in(c)%wsy(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%wsy(:ncol) + met_rlx_sfc(:ncol) * met_tauy(:ncol,c)
+ end if
+
+ cam_in(c)%shf(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%shf(:ncol) + &
+ met_rlx_sfc(:ncol) * (met_shflx(:ncol,c) * met_shflx_factor)
+ cam_in(c)%cflx(:ncol,1) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%cflx(:ncol,1) + &
+ met_rlx_sfc(:ncol) * (met_qflx(:ncol,c) * met_qflx_factor)
+
+ ! If present, nudge the latent heat; otherwise, make an approximation by scaling the
+ ! water vapor flux.
+ if (has_lhflx) then
+ cam_in(c)%lhf(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%lhf(:ncol) + &
+ met_rlx_sfc(:ncol) * (met_lhflx(:ncol,c) * met_qflx_factor)
+ else
+ cam_in(c)%lhf(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%lhf(:ncol) + &
+ met_rlx_sfc(:ncol) * (met_qflx(:ncol,c) * met_qflx_factor * latvap)
+ end if
+
+ if (met_srf_rad) then
+
+ ! There can be fill values in the albedos from the met fields, so use the cam_in value
+ ! if fill is detected. This could be jumpy if that value gets used, but should be in
+ ! an area with no downwelling solar. Time interpolate around the terminator could cause
+ ! problems, but the interpolation provides a non-fill value if either endpoint of the
+ ! interpolation is not fill.
+ lcl_rlx(:ncol) = met_rlx_sfc(:ncol)
+ where(met_asdir(:ncol,c) .eq. srf_fill_value) lcl_rlx(:ncol) = 0._r8
+ cam_in(c)%asdir(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%asdir(:ncol) + lcl_rlx(:ncol) * met_asdir(:ncol,c)
+
+ lcl_rlx(:ncol) = met_rlx_sfc(:ncol)
+ where(met_asdif(:ncol,c) .eq. srf_fill_value) lcl_rlx(:ncol) = 0._r8
+ cam_in(c)%asdif(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%asdif(:ncol) + lcl_rlx(:ncol) * met_asdif(:ncol,c)
+
+ lcl_rlx(:ncol) = met_rlx_sfc(:ncol)
+ where(met_aldir(:ncol,c) .eq. srf_fill_value) lcl_rlx(:ncol) = 0._r8
+ cam_in(c)%aldir(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%aldir(:ncol) + lcl_rlx(:ncol) * met_aldir(:ncol,c)
+
+ lcl_rlx(:ncol) = met_rlx_sfc(:ncol)
+ where(met_aldif(:ncol,c) .eq. srf_fill_value) lcl_rlx(:ncol) = 0._r8
+ cam_in(c)%aldif(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%aldif(:ncol) + lcl_rlx(:ncol) * met_aldif(:ncol,c)
+
+ cam_in(c)%lwup(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%lwup(:ncol) + met_rlx_sfc(:ncol) * met_lwup(:ncol,c)
+ end if
+
+ if (met_srf_refs) then
+ cam_in(c)%qref(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%qref(:ncol) + met_rlx_sfc(:ncol) * met_qref(:ncol,c)
+ cam_in(c)%tref(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%tref(:ncol) + met_rlx_sfc(:ncol) * met_tref(:ncol,c)
+ cam_in(c)%u10(:ncol) = (1._r8-met_rlx_sfc(:ncol)) * cam_in(c)%u10(:ncol) + met_rlx_sfc(:ncol) * met_u10(:ncol,c)
+ end if
+
+ if (met_srf_sst) then
+
+ ! Meteorological sst is 0 over 100% land, so use the cam_in value if the meteorology thinks
+ ! it is land.
+ lcl_rlx(:ncol) = met_rlx_sfc(:ncol)
+ where(met_sst(:ncol,c) .eq. srf_fill_value) lcl_rlx(:ncol) = 0._r8
+ cam_in(c)%sst(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%sst(:ncol) + lcl_rlx(:ncol) * met_sst(:ncol,c)
+
+ cam_in(c)%icefrac(:ncol) = (1._r8-lcl_rlx(:ncol)) * cam_in(c)%icefrac(:ncol) + lcl_rlx(:ncol) * met_icefrac(:ncol,c)
+ end if
+ end do ! Chunk loop
+
+ !++ IH
+ end if
+ !-- IH
+
+ if (debug) then
+ if (masterproc) then
+ write(iulog,*)'METDATA maxval(met_taux),minval(met_taux): ',maxval(met_taux),minval(met_taux)
+ write(iulog,*)'METDATA maxval(met_tauy),minval(met_tauy): ',maxval(met_tauy),minval(met_tauy)
+ write(iulog,*)'METDATA maxval(met_lhflx),minval(met_lhflx): ',maxval(met_lhflx),minval(met_lhflx)
+ write(iulog,*)'METDATA maxval(met_shflx),minval(met_shflx): ',maxval(met_shflx),minval(met_shflx)
+ write(iulog,*)'METDATA maxval(met_qflx),minval(met_qflx): ',maxval(met_qflx),minval(met_qflx)
+ write(iulog,*)'METDATA maxval(met_asdir),minval(met_asdir): ',maxval(met_asdir),minval(met_asdir)
+ write(iulog,*)'METDATA maxval(met_asdif),minval(met_asdif): ',maxval(met_asdif),minval(met_asdif)
+ write(iulog,*)'METDATA maxval(met_aldir),minval(met_aldir): ',maxval(met_aldir),minval(met_aldir)
+ write(iulog,*)'METDATA maxval(met_aldif),minval(met_aldif): ',maxval(met_aldif),minval(met_aldif)
+ write(iulog,*)'METDATA maxval(met_lwup),minval(met_lwup): ',maxval(met_lwup),minval(met_lwup)
+ write(iulog,*)'METDATA maxval(met_qref),minval(met_qref): ',maxval(met_qref),minval(met_qref)
+ write(iulog,*)'METDATA maxval(met_tref),minval(met_tref): ',maxval(met_tref),minval(met_tref)
+ write(iulog,*)'METDATA maxval(met_u10),minval(met_u10): ',maxval(met_u10),minval(met_u10)
+ write(iulog,*)'METDATA maxval(met_sst),minval(met_sst): ',maxval(met_sst),minval(met_sst)
+ write(iulog,*)'METDATA maxval(met_icefrac),minval(met_icefrac): ',maxval(met_icefrac),minval(met_icefrac)
+ endif
+ endif
+
+ do c = begchunk, endchunk
+ call outfld('MET_TAUX',cam_in(c)%wsx , pcols ,c )
+ call outfld('MET_TAUY',cam_in(c)%wsy , pcols ,c )
+ call outfld('MET_LHFX',cam_in(c)%lhf , pcols ,c )
+ call outfld('MET_SHFX',cam_in(c)%shf , pcols ,c )
+ call outfld('MET_QFLX',cam_in(c)%cflx(:,1) , pcols ,c )
+ call outfld('MET_ASDIR',cam_in(c)%asdir , pcols ,c )
+ call outfld('MET_ASDIF',cam_in(c)%asdif , pcols ,c )
+ call outfld('MET_ALDIR',cam_in(c)%aldir , pcols ,c )
+ call outfld('MET_ALDIF',cam_in(c)%aldif , pcols ,c )
+ call outfld('MET_LWUP',cam_in(c)%lwup , pcols ,c )
+ call outfld('MET_QREF',cam_in(c)%qref , pcols ,c )
+ call outfld('MET_TREF',cam_in(c)%tref , pcols ,c )
+ call outfld('MET_U10',cam_in(c)%u10 , pcols ,c )
+ call outfld('MET_SST',cam_in(c)%sst , pcols ,c )
+ call outfld('MET_ICEFRAC',cam_in(c)%icefrac , pcols ,c )
+ enddo
+
+ end subroutine get_met_srf2
+
+!-------------------------------------------------------------------
+!-------------------------------------------------------------------
+ subroutine get_met_srf1( cam_in )
+ use camsrfexch, only: cam_in_t
+ use phys_grid, only: get_ncols_p
+ use cam_history, only: outfld
+ use shr_const_mod, only: shr_const_stebol
+
+ implicit none
+
+ type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in
+
+ integer :: c,ncol,i
+
+ if (met_srf_feedback) return
+ if (.not.has_ts) then
+ call endrun('The meteorolgy input must have TS to run with met_srf_feedback set to FALSE')
+ endif
+
+ !++ IH don't nudge TS and SNOWH if met_nudge_only_uvps is true
+ if (.not. met_nudge_only_uvps) then
+ !-- IH
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+ cam_in(c)%ts(:ncol) = met_ts(:ncol,c)
+ do i = 1,ncol
+ cam_in(c)%snowhland(i) = met_snowh(i,c)*cam_in(c)%landfrac(i) * met_snowh_factor
+ enddo
+ end do ! Chunk loop
+ !++ IH
+ end if
+ !-- IH
+
+ if (debug) then
+ if (masterproc) then
+ write(iulog,*)'METDATA maxval(met_ts),minval(met_ts): ',maxval(met_ts),minval(met_ts)
+ write(iulog,*)'METDATA maxval(met_snowh),minval(met_snowh): ',maxval(met_snowh),minval(met_snowh)
+ endif
+ endif
+
+ do c = begchunk, endchunk
+ call outfld('MET_SNOWH',cam_in(c)%snowhland, pcols ,c )
+ enddo
+
+ end subroutine get_met_srf1
+
+!-------------------------------------------------------------------
+!-------------------------------------------------------------------
+ subroutine get_ocn_ice_frcs( lndfrc, ocnfrc, icefrc, lchnk, ncol )
+
+ use shr_const_mod, only: SHR_CONST_TKFRZSW
+ use shr_const_mod, only: SHR_CONST_TKFRZ
+ use cam_history, only: outfld
+
+ ! args
+ real(r8), intent( in) :: lndfrc (pcols)
+ real(r8), intent(out) :: ocnfrc (pcols)
+ real(r8), intent(out) :: icefrc (pcols)
+
+ integer, intent(in) :: lchnk
+ integer, intent(in) :: ncol
+
+ ! local vars
+ integer :: i
+
+ if (met_srf_sst) then
+ do i = 1,ncol
+
+ ! If configured for using SST, and ICEFRAC, then get icefrc
+ ! directly from the meteorological data.
+ icefrc(i) = min(met_icefrac(i,lchnk), 1._r8 - lndfrc(i))
+ ocnfrc(i) = 1._r8 - lndfrc(i) - icefrc(i)
+ enddo
+ else
+
+ if (.not.has_ts) then
+ if (masterproc) then
+ write(iulog,*) 'get_ocn_ice_frcs: TS is not in the met dataset and cannot set ocnfrc and icefrc'
+ write(iulog,*) ' try setting drydep_method to xactive_atm or table'
+ call endrun('get_ocn_ice_frcs: TS is not in the met dataset')
+ endif
+ endif
+
+ do i = 1,ncol
+
+ if ( met_ts(i,lchnk) < SHR_CONST_TKFRZ-2._r8 ) then
+ ocnfrc(i) = 0._r8
+ icefrc(i) = 1._r8 - lndfrc(i)
+ else
+ icefrc(i) = 0._r8
+ ocnfrc(i) = 1._r8 - lndfrc(i)
+ endif
+
+ enddo
+ end if
+
+ call outfld('MET_TS', met_ts(:ncol,lchnk) , ncol ,lchnk )
+ call outfld('MET_OCNFRC', ocnfrc(:ncol) , ncol ,lchnk )
+ call outfld('MET_ICEFRC', icefrc(:ncol) , ncol ,lchnk )
+
+ endsubroutine get_ocn_ice_frcs
+
+!-------------------------------------------------------------------
+! allows access to physics state fields
+! q : water vapor
+! ps : surface pressure
+! t : temperature
+!-------------------------------------------------------------------
+ subroutine get_dyn_flds( state, tend, dt )
+
+ use physics_types, only: physics_state, physics_tend, physics_dme_adjust
+ use ppgrid, only: pcols, pver, begchunk, endchunk
+ use phys_grid, only: get_ncols_p
+ use cam_history, only: outfld
+
+ implicit none
+
+ type(physics_state), intent(inout), dimension(begchunk:endchunk) :: state
+ type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: tend
+ real(r8), intent(in ) :: dt ! model physics timestep
+
+ integer :: lats(pcols) ! array of latitude indices
+ integer :: lons(pcols) ! array of longitude indices
+ integer :: c, ncol, i,j,k
+ real(r8):: qini(pcols,pver) ! initial specific humidity
+
+ real(r8) :: tmp(pcols,pver)
+
+ call t_startf('MET__GET_DYN2')
+
+ !++ IH don't nudge T and Q if met_nudge_only_uvps is true
+ ! (I don't think Q is nudged by the defalut settings anyways since alpha is 1)
+ if (.not. met_nudge_only_uvps) then
+ !-- IH
+ do c = begchunk, endchunk
+ ncol = get_ncols_p(c)
+ do k=1,pver
+ do i=1,ncol
+ if (met_nudge_temp) then
+ state(c)%t(i,k) = (1._r8-met_rlx(k))*state(c)%t(i,k) + met_rlx(k)*met_t(i,k,c)
+ end if
+
+ qini(i,k) = state(c)%q(i,k,1)
+
+ ! at this point tracer mixing ratios have already been
+ ! converted from dry to moist
+ state(c)%q(i,k,1) = alpha*state(c)%q(i,k,1) + (D1_0-alpha)*met_q(i,k,c)
+
+ if ((state(c)%q(i,k,1) < D0_0).and. (alpha .ne. D1_0 )) state(c)%q(i,k,1) = D0_0
+
+ end do
+
+ end do
+
+ ! now adjust mass of each layer now that water vapor has changed
+ if (( .not. online_test ) .and. (alpha .ne. D1_0 )) then
+ call physics_dme_adjust(state(c), tend(c), qini, dt)
+ endif
+
+ end do
+ !++ IH
+ endif
+ !-- IH
+
+ if (debug) then
+ if (masterproc) then
+ write(iulog,*)'METDATA maxval(met_t),minval(met_t): ', maxval(met_t),minval(met_t)
+ write(iulog,*)'METDATA maxval(met_ps_next),minval(met_ps_next): ', maxval(met_ps_next),minval(met_ps_next)
+ endif
+ endif
+
+ do c = begchunk, endchunk
+ call outfld('MET_T ',state(c)%t , pcols ,c )
+ enddo
+ call t_stopf('MET__GET_DYN2')
+
+ end subroutine get_dyn_flds
+
+!------------------------------------------------------------------------
+! get the meteorological winds on the grid cell centers (A-grid)
+!------------------------------------------------------------------------
+ subroutine get_uv_centered( grid, u, v )
+
+ use cam_history, only: outfld
+
+ implicit none
+
+ type (T_FVDYCORE_GRID), intent(in) :: grid
+ real(r8), intent(out) :: u(grid%im, grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d, &
+ grid%kfirst:grid%klast) ! u-wind on A-grid
+ real(r8), intent(out) :: v(grid%im, grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d, &
+ grid%kfirst:grid%klast) ! v-wind on A-grid
+
+ integer :: i,j,k
+
+ integer :: jm, jfirst, jlast, jfirstxy, jlastxy, kfirst, klast, ng_d, ng_s, ifirstxy, ilastxy
+
+ real(r8) :: u3s_tmp(grid%ifirstxy:grid%ilastxy,grid%km)
+ real(r8) :: v3s_tmp(grid%ifirstxy:grid%ilastxy,grid%km)
+
+ jm = grid%jm
+ jfirstxy= grid%jfirstxy
+ jlastxy = grid%jlastxy
+ jfirst = grid%jfirst
+ jlast = grid%jlast
+ kfirst = grid%kfirst
+ klast = grid%klast
+ ifirstxy= grid%ifirstxy
+ ilastxy = grid%ilastxy
+
+ ng_d = grid%ng_d
+ ng_s = grid%ng_s
+
+ u(:,:,:) = D0_0
+ v(:,:,:) = D0_0
+
+ u( :, max(1,jfirst-ng_d):min(jm,jlast+ng_d), kfirst:klast ) = &
+ met_u(:, max(1,jfirst-ng_d):min(jm,jlast+ng_d), kfirst:klast )
+
+ v( :, max(1,jfirst-ng_s):min(jm,jlast+ng_d), kfirst:klast ) = &
+ met_v(:, max(1,jfirst-ng_s):min(jm,jlast+ng_d), kfirst:klast )
+
+ if (masterproc) then
+ if (debug) write(iulog,*)'METDATA maxval(u),minval(u),maxval(v),minval(v) : ',&
+ maxval(u(:, max(1,jfirst-ng_d):min(jm,jlast+ng_d), kfirst:klast )),&
+ minval(u(:, max(1,jfirst-ng_d):min(jm,jlast+ng_d), kfirst:klast )),&
+ maxval(v(:, max(1,jfirst-ng_s):min(jm,jlast+ng_d), kfirst:klast )),&
+ minval(v(:, max(1,jfirst-ng_s):min(jm,jlast+ng_d), kfirst:klast ))
+ endif
+
+ if ( grid%twod_decomp .eq. 0 ) then
+ do j = jfirst, jlast
+ do k = kfirst, klast
+ do i = 1, grid%im
+ u3s_tmp(i,k) = u(i,j,k)
+ v3s_tmp(i,k) = v(i,j,k)
+ enddo
+ enddo
+ call outfld ('MET_U ', u3s_tmp, grid%im, j )
+ call outfld ('MET_V ', v3s_tmp, grid%im, j )
+ enddo
+ endif
+
+ end subroutine get_uv_centered
+
+!------------------------------------------------------------------------
+! get the meteorological surface pressure interp to dyn substep
+!------------------------------------------------------------------------
+ subroutine get_ps( grid, ps, nsubsteps, n )
+
+ use cam_history, only: outfld
+
+ implicit none
+
+ type (T_FVDYCORE_GRID), intent(in) :: grid
+ real(r8), intent(out) :: ps(grid%im, grid%jfirst:grid%jlast)
+ integer, intent(in) :: nsubsteps
+ integer, intent(in) :: n
+
+ real(r8) :: num1, num2
+ integer :: j
+
+ num1 = n
+ num2 = nsubsteps
+
+ ps(:,:) = met_ps_curr(:,:) + num1*(met_ps_next(:,:)-met_ps_curr(:,:))/num2
+
+ if ( grid%twod_decomp .eq. 0 ) then
+ do j = grid%jfirst, grid%jlast
+ call outfld('MET_PS',ps(:,j), grid%im ,j )
+ enddo
+ endif
+ end subroutine get_ps
+
+!------------------------------------------------------------------------
+! get the meteorological winds on the grid cell walls (vorticity winds)
+! us : staggered zonal wind
+! vs : staggered meridional wind
+!------------------------------------------------------------------------
+ subroutine get_us_vs( grid, us, vs )
+
+ implicit none
+
+ type (T_FVDYCORE_GRID), intent(in) :: grid
+ real(r8), intent(inout) :: us(grid%im, grid%jfirst-grid%ng_d:grid%jlast+grid%ng_s, &
+ grid%kfirst:grid%klast) ! u-wind on d-grid
+ real(r8), intent(inout) :: vs(grid%im, grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d, &
+ grid%kfirst:grid%klast) ! v-wind on d-grid
+
+ integer :: i,j,k
+
+ integer :: jm, jfirst, jlast, kfirst, klast, ng_d, ng_s
+
+ jm = grid%jm
+ jfirst = grid%jfirst
+ jlast = grid%jlast
+ kfirst = grid%kfirst
+ klast = grid%klast
+ ng_d = grid%ng_d
+ ng_s = grid%ng_s
+
+ call t_startf('MET__get_us_vs')
+
+ ! vertical relaxation (blending) occurs in dyn_run (dyn_comp.F90)
+
+ us(:,:,:) = 1.e36_r8
+ vs(:,:,:) = 1.e36_r8
+ us( :, max(2,jfirst): min(jm,jlast), kfirst:klast) = &
+ met_us( :, max(2,jfirst): min(jm,jlast), kfirst:klast)
+ vs( :, max(1,jfirst): min(jm,jlast), kfirst:klast) = &
+ met_vs( :, max(1,jfirst): min(jm,jlast), kfirst:klast)
+ if (masterproc) then
+ if (debug) write(iulog,*)grid%iam,': METDATA maxval(us),minval(us),maxval(vs),minval(vs) : ',&
+ maxval(us( :, max(2,jfirst): min(jm,jlast), kfirst:klast)),&
+ minval(us( :, max(2,jfirst): min(jm,jlast), kfirst:klast)),&
+ maxval(vs( :, max(1,jfirst): min(jm,jlast), kfirst:klast)),&
+ minval(vs( :, max(1,jfirst): min(jm,jlast), kfirst:klast))
+ endif
+
+!!$ if (debug) then
+!!$ u3s_tmp = 1.e36
+!!$ do j = jfirst, jlast
+!!$ do k = kfirst, klast
+!!$ do i = 1, im
+!!$ if (j >= 2) u3s_tmp(i,k) = us(i,j,k)
+!!$ v3s_tmp(i,k) = vs(i,j,k)
+!!$ enddo
+!!$ enddo
+!!$ call outfld ('MET_US ', u3s_tmp, im, j )
+!!$ call outfld ('MET_VS ', v3s_tmp, im, j )
+!!$ enddo
+!!$ endif
+!!$
+ call t_stopf('MET__get_us_vs')
+
+ end subroutine get_us_vs
+
+!-------------------------------------------------------------------------
+! writes file names to restart file
+!-------------------------------------------------------------------------
+
+ subroutine write_met_restart_pio(File)
+ type(file_desc_t), intent(inout) :: File
+ integer :: ierr
+ ierr = pio_put_att(File, PIO_GLOBAL, 'current_metdata_filename', curr_filename)
+ ierr = pio_put_att(File, PIO_GLOBAL, 'next_metdata_filename', next_filename)
+
+ end subroutine write_met_restart_pio
+ subroutine read_met_restart_pio(File)
+ type(file_desc_t), intent(inout) :: File
+
+ integer :: ierr, xtype
+ integer(pio_offset_kind) :: slen
+
+ ierr = pio_inq_att(File, PIO_GLOBAL, 'current_metdata_filename',xtype, slen)
+ ierr = pio_get_att(File, PIO_GLOBAL, 'current_metdata_filename', curr_filename)
+ curr_filename(slen+1:256) = ''
+
+ ierr = pio_inq_att(File, PIO_GLOBAL, 'next_metdata_filename',xtype, slen)
+ ierr = pio_get_att(File, PIO_GLOBAL, 'next_metdata_filename', next_filename)
+ next_filename(slen+1:256) = ''
+
+ end subroutine read_met_restart_pio
+
+ subroutine write_met_restart_bin( nrg )
+ implicit none
+ integer,intent(in) :: nrg ! Unit number
+ integer :: ioerr ! error status
+
+ if (masterproc) then
+ write(nrg, iostat=ioerr) curr_filename
+ if (ioerr /= 0 ) then
+ write(iulog,*) 'WRITE ioerror ',ioerr,' on i/o unit = ',nrg
+ call endrun ('WRITE_RESTART_DYNAMICS')
+ end if
+ write(nrg, iostat=ioerr) next_filename
+ if (ioerr /= 0 ) then
+ write(iulog,*) 'WRITE ioerror ',ioerr,' on i/o unit = ',nrg
+ call endrun ('WRITE_RESTART_DYNAMICS')
+ end if
+ end if
+ end subroutine write_met_restart_bin
+
+!-------------------------------------------------------------------------
+! reads file names from restart file
+!-------------------------------------------------------------------------
+ subroutine read_met_restart_bin( nrg )
+ implicit none
+ integer,intent(in) :: nrg ! Unit number
+ integer :: ioerr ! error status
+
+ if (masterproc) then
+ read(nrg, iostat=ioerr) curr_filename
+ if (ioerr /= 0 ) then
+ write(iulog,*) 'READ ioerror ',ioerr,' on i/o unit = ',nrg
+ call endrun ('READ_RESTART_DYNAMICS')
+ end if
+ read(nrg, iostat=ioerr) next_filename
+ if (ioerr /= 0 ) then
+ write(iulog,*) 'READ ioerror ',ioerr,' on i/o unit = ',nrg
+ call endrun ('READ_RESTART_DYNAMICS')
+ end if
+ end if
+
+#if ( defined SPMD )
+ call mpibcast ( curr_filename ,len(curr_filename) ,mpichar,0,mpicom)
+ call mpibcast ( next_filename ,len(next_filename) ,mpichar,0,mpicom)
+#endif
+ end subroutine read_met_restart_bin
+
+!-------------------------------------------------------------------------
+! returns true if the met winds are defined on cell walls
+!-------------------------------------------------------------------------
+ function met_winds_on_walls()
+ logical :: met_winds_on_walls
+
+ met_winds_on_walls = met_cell_wall_winds
+ end function met_winds_on_walls
+
+! internal methods :
+
+!-------------------------------------------------------------------------
+! transfers cell-centered winds to cell walls
+!-------------------------------------------------------------------------
+ subroutine transfer_windsToWalls(grid)
+
+ implicit none
+
+ type (T_FVDYCORE_GRID), intent(in) :: grid
+ integer :: i,j,k
+ integer :: im, jfirst, jlast, kfirst, klast
+
+ im = grid%im
+ jfirst = grid%jfirst
+ jlast = grid%jlast
+ kfirst = grid%kfirst
+ klast = grid%klast
+
+ call t_startf('MET__transfer_windsToWalls')
+
+!$omp parallel do private (i, j, k)
+ do k = kfirst, klast
+
+ do j = jfirst+1,jlast
+ do i = 1,im
+ met_us(i,j,k) = ( met_u(i,j,k) + met_u(i,j-1,k) )*D0_5
+ end do
+ end do
+
+#if defined( SPMD )
+ if ( jfirst .gt. 1 ) then
+ do i = 1, im
+ ! met_u is alread ghosted at this point
+ met_us(i,jfirst,k) = ( met_u(i,jfirst,k) + met_u(i,jfirst-1,k) )*D0_5
+ enddo
+ endif
+#endif
+
+ do j = jfirst,jlast
+ met_vs(1,j,k) = ( met_v(1,j,k) + met_v(im,j,k) )*D0_5
+ do i = 2,im
+ met_vs(i,j,k) = ( met_v(i,j,k) + met_v(i-1,j,k) )*D0_5
+ end do
+ end do
+ end do
+
+ call t_stopf('MET__transfer_windsToWalls')
+
+ end subroutine transfer_windsToWalls
+
+ subroutine get_model_time()
+ implicit none
+ integer yr, mon, day, ncsec ! components of a date
+
+ call t_startf('MET__get_model_time')
+
+ call get_curr_date(yr, mon, day, ncsec)
+
+ curr_mod_time = get_time_float( yr, mon, day, ncsec )
+ next_mod_time = curr_mod_time + get_step_size()/seconds_per_day
+
+ call t_stopf('MET__get_model_time')
+
+ end subroutine get_model_time
+
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
+ subroutine check_files()
+
+ use shr_sys_mod, only: shr_sys_system
+ use ioFileMod, only: getfil
+
+ implicit none
+
+!-----------------------------------------------------------------------
+! ... local variables
+!-----------------------------------------------------------------------
+ character(len=256) :: ctmp
+ character(len=256) :: loc_fname
+ integer :: istat
+
+
+ if (next_mod_time > curr_data_times(size(curr_data_times))) then
+ if ( .not. associated(next_data_times) ) then
+ ! open next file...
+ next_filename = incr_filename( curr_filename )
+ call open_met_datafile( next_filename, next_fileid, next_data_times, met_data_path )
+ endif
+ endif
+
+ if ( associated(next_data_times) ) then
+ if (curr_mod_time >= next_data_times(1)) then
+
+ ! close current file ...
+ call pio_closefile( curr_fileid )
+ if (masterproc) then
+ ! remove if requested
+ if( met_remove_file ) then
+ call getfil( curr_filename, loc_fname, 0 )
+ write(iulog,*) 'check_files: removing file = ',trim(loc_fname)
+ ctmp = 'rm -f ' // trim(loc_fname)
+ write(iulog,*) 'check_files: fsystem issuing command - '
+ write(iulog,*) trim(ctmp)
+ call shr_sys_system( ctmp, istat )
+ end if
+ endif
+
+ curr_filename = next_filename
+ curr_fileid = next_fileid
+
+ deallocate( curr_data_times )
+ allocate( curr_data_times( size( next_data_times ) ) )
+ curr_data_times(:) = next_data_times(:)
+
+ next_filename = ''
+
+ deallocate( next_data_times )
+ nullify( next_data_times )
+
+ endif
+ endif
+
+ end subroutine check_files
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ function incr_filename( filename )
+
+ !-----------------------------------------------------------------------
+ ! ... Increment or decrement a date string withing a filename
+ ! the filename date section is assumed to be of the form
+ ! yyyy-dd-mm
+ !-----------------------------------------------------------------------
+
+ use string_utils, only : incstr
+ use shr_file_mod, only : shr_file_getunit, shr_file_freeunit
+
+ implicit none
+
+
+ character(len=*), intent(in) :: filename ! present dynamical dataset filename
+ character(len=256) :: incr_filename ! next filename in the sequence
+
+ ! set new next_filename ...
+
+ !-----------------------------------------------------------------------
+ ! ... local variables
+ !-----------------------------------------------------------------------
+ integer :: pos, pos1, istat
+ character(len=256) :: fn_new, line
+ character(len=6) :: seconds
+ character(len=5) :: num
+ integer :: ios,unitnumber
+
+ if ( len_trim(met_filenames_list) .eq. 0) then
+ !-----------------------------------------------------------------------
+ ! ... ccm type filename
+ !-----------------------------------------------------------------------
+ pos = len_trim( filename )
+ fn_new = filename(:pos)
+ if (masterproc) write(iulog,*) 'incr_flnm: old filename = ',trim(fn_new)
+ if( fn_new(pos-2:) == '.nc' ) then
+ pos = pos - 3
+ end if
+ istat = incstr( fn_new(:pos), 1 )
+ if( istat /= 0 ) then
+ write(iulog,*) 'incr_flnm: incstr returned ', istat
+ write(iulog,*) ' while trying to decrement ',trim( fn_new )
+ call endrun
+ end if
+
+ else
+
+ ! open met_filenames_list
+ if (masterproc) write(iulog,*) 'incr_flnm: old filename = ',trim(filename)
+ if (masterproc) write(iulog,*) 'incr_flnm: open met_filenames_list : ',met_filenames_list
+ unitnumber = shr_file_getUnit()
+ open( unit=unitnumber, file=met_filenames_list, iostat=ios, status="OLD")
+ if (ios /= 0) then
+ call endrun('not able to open met_filenames_list file: '//met_filenames_list)
+ endif
+
+ ! read file names
+ read( unit=unitnumber, fmt='(A)', iostat=ios ) line
+ if (ios /= 0) then
+ call endrun('not able to increment file name from met_filenames_list file: '//met_filenames_list)
+ endif
+ do while( trim(line) /= trim(filename) )
+ read( unit=unitnumber, fmt='(A)', iostat=ios ) line
+ if (ios /= 0) then
+ call endrun('not able to increment file name from met_filenames_list file: '//met_filenames_list)
+ endif
+ enddo
+
+ read( unit=unitnumber, fmt='(A)', iostat=ios ) line
+ if (ios /= 0) then
+ call endrun('not able to increment file name from met_filenames_list file: '//met_filenames_list)
+ endif
+ fn_new = trim(line)
+
+ close(unit=unitnumber)
+ call shr_file_freeUnit(unitnumber)
+ endif
+ incr_filename = trim(fn_new)
+ if (masterproc) write(iulog,*) 'incr_flnm: new filename = ',incr_filename
+
+ end function incr_filename
+
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
+ subroutine find_times( itms, fids, datatm, datatp, time )
+
+ implicit none
+
+ integer, intent(out) :: itms(2) ! record numbers that bracket time
+ type(file_desc_t), intent(out) :: fids(2) ! ids of files that contains these recs
+ real(r8), intent(in) :: time ! time of interest
+ real(r8), intent(out):: datatm, datatp
+
+ integer np1 ! current forward time index of dataset
+ integer n,i !
+ integer :: curr_tsize, next_tsize, all_tsize
+
+ real(r8), allocatable, dimension(:):: all_data_times
+
+ curr_tsize = size(curr_data_times)
+ next_tsize = 0
+ if ( associated(next_data_times)) next_tsize = size(next_data_times)
+
+ all_tsize = curr_tsize + next_tsize
+
+ allocate( all_data_times( all_tsize ) )
+
+ all_data_times(:curr_tsize) = curr_data_times(:)
+ if (next_tsize > 0) all_data_times(curr_tsize+1:all_tsize) = next_data_times(:)
+
+ ! find bracketing times
+ do n=1, all_tsize-1
+ np1 = n + 1
+ datatm = all_data_times(n)
+ datatp = all_data_times(np1)
+ if ( (time .ge. datatm) .and. (time .le. datatp) ) then
+ goto 20
+ endif
+ enddo
+
+ write(iulog,*)'FIND_TIMES: Failed to find dates bracketing desired time =', time
+ write(iulog,*)' datatm = ',datatm
+ write(iulog,*)' datatp = ',datatp
+ write(iulog,*)' all_data_times = ',all_data_times
+
+ call endrun
+
+20 continue
+
+ deallocate( all_data_times )
+
+ itms(1) = n
+ itms(2) = np1
+ fids(:) = curr_fileid
+
+ do i=1,2
+ if ( itms(i) > curr_tsize ) then
+ itms(i) = itms(i) - curr_tsize
+ fids(i) = next_fileid
+ endif
+ enddo
+
+ end subroutine find_times
+
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
+ subroutine read_next_ps(grid)
+ use ncdio_atm, only: infld
+
+ implicit none
+
+ type (T_FVDYCORE_GRID), intent(in) :: grid
+
+ integer :: recnos(2)
+ type(file_desc_t) :: fids(2)
+ character(len=8) :: varname
+ integer :: ifirstxy, ilastxy, jfirstxy, jlastxy
+
+ real(r8) :: wrk_xy(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy )
+
+ logical :: readvar
+
+ if(online_test) then
+ varname='arch_PS'
+ else
+ varname='PS'
+ end if
+
+ jfirstxy= grid%jfirstxy
+ jlastxy = grid%jlastxy
+ ifirstxy= grid%ifirstxy
+ ilastxy = grid%ilastxy
+
+ call find_times( recnos, fids, datatimemn, datatimepn, next_mod_time )
+
+ call infld(varname, fids(1), 'lon', 'lat', ifirstxy, ilastxy, jfirstxy, jlastxy, &
+ wrk_xy, readvar, gridname='fv_centers', timelevel=recnos(1))
+
+ ! transpose xy -> yz decomposition
+ call transpose_xy2yz_2d( wrk_xy, met_psi_next(nm)%data, grid )
+
+ call infld(varname, fids(2), 'lon', 'lat', ifirstxy, ilastxy, jfirstxy, jlastxy, &
+ wrk_xy, readvar, gridname='fv_centers', timelevel=recnos(2))
+
+ ! transpose xy -> yz decomposition
+ call transpose_xy2yz_2d( wrk_xy, met_psi_next(np)%data, grid )
+
+ if(masterproc) write(iulog,*)'READ_NEXT_PS: Read meteorological data '
+
+ end subroutine read_next_ps
+
+!------------------------------------------------------------------------
+!------------------------------------------------------------------------
+ subroutine transpose_xy2yz_2d( xy_2d, yz_2d, grid )
+
+ implicit none
+ type (T_FVDYCORE_GRID), intent(in) :: grid
+ real(r8), intent(in) :: xy_2d(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy)
+ real(r8), intent(out) :: yz_2d(1:grid%im, grid%jfirst:grid%jlast)
+
+ real(r8) :: xy3(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, 1:grid%npr_z )
+ integer :: i,j,k
+
+ if (grid%iam .lt. grid%npes_xy) then
+ if ( grid%twod_decomp .eq. 1 ) then
+
+#if defined( SPMD )
+!$omp parallel do private(i,j,k)
+ do k=1,grid%npr_z
+ do j=grid%jfirstxy,grid%jlastxy
+ do i=grid%ifirstxy,grid%ilastxy
+ xy3(i,j,k) = xy_2d(i,j)
+ enddo
+ enddo
+ enddo
+
+ call mp_sendirr(grid%commxy, grid%xy2d_to_yz2d%SendDesc, &
+ grid%xy2d_to_yz2d%RecvDesc, xy3, yz_2d, &
+ modc=grid%modc_dynrun )
+ call mp_recvirr(grid%commxy, grid%xy2d_to_yz2d%SendDesc, &
+ grid%xy2d_to_yz2d%RecvDesc, xy3, yz_2d, &
+ modc=grid%modc_dynrun )
+#endif
+
+ else
+ yz_2d(:,:) = xy_2d(:,:)
+ endif
+ endif ! (grid%iam .lt. grid%npes_xy)
+
+ end subroutine transpose_xy2yz_2d
+
+!------------------------------------------------------------------------
+!------------------------------------------------------------------------
+ subroutine transpose_xy2yz_3d( xy_3d, yz_3d, grid )
+
+ implicit none
+ type (T_FVDYCORE_GRID), intent(in) :: grid
+ real(r8), intent(in) :: xy_3d(grid%ifirstxy:grid%ilastxy, grid%jfirstxy:grid%jlastxy, 1:grid%km )
+ real(r8), intent(out) :: yz_3d(1:grid%im, grid%jfirst:grid%jlast, grid%kfirst:grid%klast)
+
+ if (grid%iam .lt. grid%npes_xy) then
+ if ( grid%twod_decomp .eq. 1 ) then
+#if defined( SPMD )
+ call mp_sendirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, &
+ grid%ijk_xy_to_yz%RecvDesc, xy_3d, yz_3d, &
+ modc=grid%modc_dynrun )
+ call mp_recvirr( grid%commxy, grid%ijk_xy_to_yz%SendDesc, &
+ grid%ijk_xy_to_yz%RecvDesc, xy_3d, yz_3d, &
+ modc=grid%modc_dynrun )
+#endif
+ else
+ yz_3d(:,:,:) = xy_3d(:,:,:)
+ endif
+ endif ! (grid%iam .lt. grid%npes_xy)
+
+ end subroutine transpose_xy2yz_3d
+
+
+
+!------------------------------------------------------------------------
+!------------------------------------------------------------------------
+ subroutine read_next_metdata(grid)
+ use ncdio_atm, only: infld
+ use cam_grid_support, only: cam_grid_check, cam_grid_id
+ use cam_grid_support, only: cam_grid_get_dim_names
+
+ implicit none
+
+ type (T_FVDYCORE_GRID), intent(in) :: grid
+ integer recnos(2), i !
+ type(file_desc_t) :: fids(2)
+
+ character(len=8) :: Uname, Vname, Tname, Qname, psname
+ character(len=8) :: dim1name, dim2name
+ integer :: im, jm, km
+ logical :: readvar
+ integer :: ifirstxy, ilastxy, jfirstxy, jlastxy
+ real(r8), allocatable :: wrk2_xy(:,:)
+ real(r8), allocatable :: wrk3_xy(:,:,:)
+ real(r8), allocatable :: tmp_data(:,:,:)
+ integer :: elev1,blev1, elev2,blev2
+ integer :: elev3,blev3, elev4,blev4
+ integer :: grid_id ! grid ID for data mapping
+
+ call t_startf('MET__read_next_metdata')
+
+ jfirstxy= grid%jfirstxy
+ jlastxy = grid%jlastxy
+ ifirstxy= grid%ifirstxy
+ ilastxy = grid%ilastxy
+
+ im = grid%im
+ jm = grid%jm
+ km = grid%km
+
+ call find_times( recnos, fids, datatimem, datatimep, curr_mod_time )
+ !
+ ! Set up hyperslab corners
+ !
+
+ if(online_test) then
+ Tname='arch_T'
+ Qname='arch_Q'
+ PSname='arch_PS'
+ if(met_cell_wall_winds) then
+ Uname='arch_US'
+ Vname='arch_VS'
+ else
+ Uname='arch_U'
+ Vname='arch_V'
+ end if
+ else
+ Tname='T'
+ Qname='Q'
+ PSname='PS'
+ if(met_cell_wall_winds) then
+ Uname='US'
+ Vname='VS'
+ else
+ Uname='U'
+ Vname='V'
+ end if
+
+ end if
+
+
+ if ( num_met_levels>km ) then
+
+ blev1 = 1
+ elev1 = km
+
+ blev2 = num_met_levels-km+1
+ elev2 = num_met_levels
+
+ blev3 = num_met_levels-km+1
+ elev3 = num_met_levels
+
+ blev4 = 1
+ elev4 = num_met_levels
+
+ else
+
+ blev1 = km-num_met_levels+1
+ elev1 = km
+
+ blev2 = 1
+ elev2 = num_met_levels
+
+ blev3 = 1
+ elev3 = km
+
+ blev4 = km-num_met_levels+1
+ elev4 = km
+
+ endif
+
+ allocate(tmp_data(pcols, 1:num_met_levels, begchunk:endchunk))
+ allocate(wrk2_xy(ifirstxy:ilastxy, jfirstxy:jlastxy))
+ allocate(wrk3_xy(ifirstxy:ilastxy, jfirstxy:jlastxy, 1:max(km,num_met_levels)))
+
+ ! physgrid intput for FV is probably always lon/lat but let's be pedantic
+ grid_id = cam_grid_id('physgrid')
+ if (.not. cam_grid_check(grid_id)) then
+ call endrun('read_next_metdata: Internal error, no "physgrid" grid')
+ end if
+ call cam_grid_get_dim_names(grid_id, dim1name, dim2name)
+
+ do i=1,2
+
+ met_ti(i)%data = 0._r8
+
+ call infld(Tname, fids(i), dim1name, 'lev', dim2name, 1, pcols, 1,num_met_levels , &
+ begchunk, endchunk, tmp_data, readvar, gridname='physgrid',timelevel=recnos(i))
+
+ met_ti(i)%data(:,blev1:elev1,:) = tmp_data(:, blev2:elev2, :)
+
+ met_qi(i)%data = 0._r8
+
+ call infld(Qname, fids(i), dim1name, 'lev', dim2name, 1, pcols, 1,num_met_levels, &
+ begchunk, endchunk, tmp_data, readvar, gridname='physgrid',timelevel=recnos(i))
+
+ met_qi(i)%data(:,blev1:elev1,:) = tmp_data(:, blev2:elev2, :)
+
+ if (met_cell_wall_winds) then
+
+ wrk3_xy = 0._r8
+ met_usi(i)%data(:,:,:) = 0._r8
+ call infld(Uname, fids(i), 'lon', 'slat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, &
+ 1,num_met_levels, wrk3_xy(:,:,blev4:elev4), readvar, gridname='fv_u_stagger',timelevel=recnos(i))
+
+ ! transpose xy -> yz decomposition
+ call transpose_xy2yz_3d( wrk3_xy(:,:,blev3:elev3), met_usi(i)%data(:,:,:), grid )
+
+ wrk3_xy = 0._r8
+ met_vsi(i)%data(:,:,:) = 0._r8
+ call infld(Vname, fids(i), 'slon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, &
+ 1,num_met_levels, wrk3_xy(:,:,blev4:elev4), readvar, gridname='fv_v_stagger',timelevel=recnos(i))
+
+ ! transpose xy -> yz decomposition
+ call transpose_xy2yz_3d( wrk3_xy(:,:,blev3:elev3), met_vsi(i)%data(:,:,:), grid )
+
+ else
+
+ ! read into lower portion of the array...
+
+ wrk3_xy = 0._r8
+ met_ui(i)%data = 0._r8
+ call infld(Uname, fids(i), 'lon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, &
+ 1,num_met_levels, wrk3_xy(:,:,blev4:elev4), readvar, gridname='fv_centers',timelevel=recnos(i))
+
+ ! transpose xy -> yz decomposition
+ call transpose_xy2yz_3d( wrk3_xy(:,:,blev3:elev3), met_ui(i)%data(:,:,:), grid )
+
+ wrk3_xy = 0._r8
+ met_vi(i)%data = 0._r8
+ call infld(Vname, fids(i), 'lon', 'lat', 'lev', ifirstxy, ilastxy, jfirstxy, jlastxy, &
+ 1,num_met_levels, wrk3_xy(:,:,blev4:elev4), readvar, gridname='fv_centers',timelevel=recnos(i))
+
+ ! transpose xy -> yz decomposition
+ call transpose_xy2yz_3d( wrk3_xy(:,:,blev3:elev3), met_vi(i)%data(:,:,:), grid )
+
+ endif ! met_cell_wall_winds
+
+ call infld(PSname, fids(i), 'lon', 'lat', ifirstxy, ilastxy, jfirstxy, jlastxy, &
+ wrk2_xy, readvar, gridname='fv_centers', timelevel=recnos(i))
+
+ ! transpose xy -> yz decomposition
+ call transpose_xy2yz_2d( wrk2_xy, met_psi_curr(i)%data, grid )
+
+ enddo
+
+ deallocate(tmp_data)
+ deallocate(wrk3_xy)
+ deallocate(wrk2_xy)
+
+ ! 2-D feilds
+ call read_phys_srf_flds( )
+
+ if(masterproc) write(iulog,*)'READ_NEXT_METDATA: Read meteorological data '
+
+ call t_stopf('MET__read_next_metdata')
+
+ end subroutine read_next_metdata
+
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
+ subroutine read_phys_srf_flds( )
+ use ncdio_atm, only: infld
+
+ integer :: i, recnos(2)
+ type(file_desc_t) :: fids(2)
+ logical :: readvar
+
+ call find_times( recnos, fids, datatimem, datatimep, curr_mod_time )
+ do i=1,2
+
+ call infld(met_shflx_name, fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_shflxi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+
+ if (has_lhflx) then
+ call infld('LHFLX', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_lhflxi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ end if
+
+ call infld(met_qflx_name, fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_qflxi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ call infld('TAUX', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_tauxi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ call infld('TAUY', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_tauyi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+
+ if ( .not.met_srf_feedback ) then
+ call infld('SNOWH', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_snowhi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ endif
+
+ if (has_ts) then
+ call infld('TS', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_tsi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ endif
+
+ if (met_srf_rad) then
+ call infld('ASDIR', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_asdiri(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ call infld('ASDIF', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_asdifi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ call infld('ALDIR', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_aldiri(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ call infld('ALDIF', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_aldifi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ call infld('LWUP', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_lwupi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ endif
+
+ if (met_srf_refs) then
+ call infld('QREF', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_qrefi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ call infld('TREF', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_trefi(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ call infld('U10', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_u10i(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ endif
+
+ if (met_srf_sst) then
+ call infld('SST', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_ssti(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ call infld('ICEFRAC', fids(i), 'lon', 'lat', 1, pcols, begchunk, endchunk, &
+ met_icefraci(i)%data, readvar, gridname='physgrid',timelevel=recnos(i))
+ endif
+ enddo
+ end subroutine read_phys_srf_flds
+
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
+ subroutine interp_phys_srf_flds( )
+ use phys_grid, only: get_ncols_p
+ real(r4) :: fact1, fact2
+ real(r8) :: deltat
+ integer :: i, c, ncol
+
+ deltat = datatimep - datatimem
+ fact1 = (datatimep - curr_mod_time)/deltat
+ fact2 = D1_0-fact1
+
+
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+ do i=1,ncol
+ if (has_lhflx) then
+ met_lhflx(i,c) = fact1*met_lhflxi(nm)%data(i,c) + fact2*met_lhflxi(np)%data(i,c)
+ end if
+ met_shflx(i,c) = fact1*met_shflxi(nm)%data(i,c) + fact2*met_shflxi(np)%data(i,c)
+ met_qflx(i,c) = fact1*met_qflxi(nm)%data(i,c) + fact2*met_qflxi(np)%data(i,c)
+ met_taux(i,c) = fact1*met_tauxi(nm)%data(i,c) + fact2*met_tauxi(np)%data(i,c)
+ met_tauy(i,c) = fact1*met_tauyi(nm)%data(i,c) + fact2*met_tauyi(np)%data(i,c)
+ enddo
+ enddo
+ if ( .not.met_srf_feedback ) then
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+ do i=1,ncol
+ met_snowh(i,c) = fact1*met_snowhi(nm)%data(i,c) + fact2*met_snowhi(np)%data(i,c)
+ enddo
+ enddo
+ endif
+ if (has_ts) then
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+ do i=1,ncol
+ met_ts(i,c) = fact1*met_tsi(nm)%data(i,c) + fact2*met_tsi(np)%data(i,c)
+ enddo
+ enddo
+ endif
+ if (met_srf_rad) then
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+ do i=1,ncol
+ ! Albedo can be fillValue from the meteorology where the is no downwelling
+ ! solar. However, this changes slowly, so for interpolation use either end-point
+ ! if nothing is present. If there is no solar, then the albedo won't matter, so
+ ! should not cause problems.
+ if (met_asdiri(nm)%data(i,c) .eq. srf_fill_value) then
+ met_asdir(i,c) = met_asdiri(np)%data(i,c)
+ else if (met_asdiri(np)%data(i,c) .eq. srf_fill_value) then
+ met_asdir(i,c) = met_asdiri(nm)%data(i,c)
+ else
+ met_asdir(i,c) = fact1*met_asdiri(nm)%data(i,c) + fact2*met_asdiri(np)%data(i,c)
+ endif
+
+ if (met_asdifi(nm)%data(i,c) .eq. srf_fill_value) then
+ met_asdif(i,c) = met_asdifi(np)%data(i,c)
+ else if (met_asdifi(np)%data(i,c) .eq. srf_fill_value) then
+ met_asdif(i,c) = met_asdifi(nm)%data(i,c)
+ else
+ met_asdif(i,c) = fact1*met_asdifi(nm)%data(i,c) + fact2*met_asdifi(np)%data(i,c)
+ endif
+
+ if (met_aldiri(nm)%data(i,c) .eq. srf_fill_value) then
+ met_aldir(i,c) = met_aldiri(np)%data(i,c)
+ else if (met_aldiri(np)%data(i,c) .eq. srf_fill_value) then
+ met_aldir(i,c) = met_aldiri(nm)%data(i,c)
+ else
+ met_aldir(i,c) = fact1*met_aldiri(nm)%data(i,c) + fact2*met_aldiri(np)%data(i,c)
+ endif
+
+ if (met_aldifi(nm)%data(i,c) .eq. srf_fill_value) then
+ met_aldif(i,c) = met_aldifi(np)%data(i,c)
+ else if (met_aldifi(np)%data(i,c) .eq. srf_fill_value) then
+ met_aldif(i,c) = met_aldifi(nm)%data(i,c)
+ else
+ met_aldif(i,c) = fact1*met_aldifi(nm)%data(i,c) + fact2*met_aldifi(np)%data(i,c)
+ endif
+
+ met_lwup(i,c) = fact1*met_lwupi(nm)%data(i,c) + fact2*met_lwupi(np)%data(i,c)
+ enddo
+ enddo
+ endif
+ if (met_srf_refs) then
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+ do i=1,ncol
+ met_qref(i,c) = fact1*met_qrefi(nm)%data(i,c) + fact2*met_qrefi(np)%data(i,c)
+ met_tref(i,c) = fact1*met_trefi(nm)%data(i,c) + fact2*met_trefi(np)%data(i,c)
+ met_u10(i,c) = fact1*met_u10i(nm)%data(i,c) + fact2*met_u10i(np)%data(i,c)
+ enddo
+ enddo
+ endif
+ if (met_srf_sst) then
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+ do i=1,ncol
+ ! The sst is fill value over land, which should not change from timestep to
+ ! timestep, but just in case use the sst value if only one is present.
+ if (met_ssti(nm)%data(i,c) .eq. srf_fill_value) then
+ met_sst(i,c) = met_ssti(np)%data(i,c)
+ else if (met_ssti(np)%data(i,c) .eq. srf_fill_value) then
+ met_sst(i,c) = met_ssti(nm)%data(i,c)
+ else
+ met_sst(i,c) = fact1*met_ssti(nm)%data(i,c) + fact2*met_ssti(np)%data(i,c)
+ endif
+ met_icefrac(i,c) = fact1*met_icefraci(nm)%data(i,c) + fact2*met_icefraci(np)%data(i,c)
+ enddo
+ enddo
+ endif
+
+ end subroutine interp_phys_srf_flds
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
+ subroutine interpolate_metdata(grid)
+ use phys_grid, only: get_ncols_p
+#if defined( SPMD )
+ use mod_comm, only : mp_send4d_ns, mp_recv4d_ns
+#endif
+
+ implicit none
+ type (T_FVDYCORE_GRID), intent(in) :: grid
+
+ real(r4) fact1, fact2
+ real(r4) nfact1, nfact2
+ real(r8) deltat,deltatn
+ integer :: i,c,k, ncol
+ integer :: im, jm, km, jfirst, jlast, kfirst, klast, ng_d, ng_s
+
+ im = grid%im
+ jm = grid%jm
+ km = grid%km
+ jfirst = grid%jfirst
+ jlast = grid%jlast
+ kfirst = grid%kfirst
+ klast = grid%klast
+ ng_d = grid%ng_d
+ ng_s = grid%ng_s
+
+ call t_startf('MET__interpolate_metdata')
+
+ deltat = datatimep - datatimem
+ deltatn = datatimepn - datatimemn
+
+ fact1 = (datatimep - curr_mod_time)/deltat
+! fact2 = (curr_mod_time - datatimem)/deltat
+ fact2 = D1_0-fact1
+
+ nfact1 = (datatimepn - next_mod_time)/deltatn
+! nfact2 = (next_mod_time - datatimemn)/deltatn
+ nfact2 = D1_0-nfact1
+
+ met_q = 0.0_r8
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+ do k=1,pver
+ do i=1,ncol
+ met_t(i,k,c) = fact1*met_ti(nm)%data(i,k,c) + fact2*met_ti(np)%data(i,k,c)
+ met_q(i,k,c) = fact1*met_qi(nm)%data(i,k,c) + fact2*met_qi(np)%data(i,k,c)
+ enddo
+ enddo
+ enddo
+
+ if (.not. online_test) where (met_q .lt. D0_0) met_q = D0_0
+
+ met_ps_next(:,:) = nfact1*met_psi_next(nm)%data(:,:) + nfact2*met_psi_next(np)%data(:,:)
+ met_ps_curr(:,:) = fact1*met_psi_curr(nm)%data(:,:) + fact2*met_psi_curr(np)%data(:,:)
+
+ call interp_phys_srf_flds()
+
+ if (has_ts) then
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+ do i=1,ncol
+ met_ts(i,c) = fact1*met_tsi(nm)%data(i,c) + fact2*met_tsi(np)%data(i,c)
+ enddo
+ enddo
+ endif
+
+ if ( .not. met_cell_wall_winds ) then
+
+ met_u(1:im,jfirst:jlast,kfirst:klast) = fact1*met_ui(nm)%data(1:im,jfirst:jlast,kfirst:klast) &
+ + fact2*met_ui(np)%data(1:im,jfirst:jlast,kfirst:klast)
+ met_v(1:im,jfirst:jlast,kfirst:klast) = fact1*met_vi(nm)%data(1:im,jfirst:jlast,kfirst:klast) &
+ + fact2*met_vi(np)%data(1:im,jfirst:jlast,kfirst:klast)
+
+ ! ghost u,v
+#if defined( SPMD )
+ call mp_send4d_ns( grid%commxy, im, jm, km, 1, jfirst, jlast, &
+ kfirst, klast, ng_d, ng_d, met_u )
+ call mp_send4d_ns( grid%commxy, im, jm, km, 1, jfirst, jlast, &
+ kfirst, klast, ng_d, ng_s, met_v )
+ call mp_recv4d_ns( grid%commxy, im, jm, km, 1, jfirst, jlast, &
+ kfirst, klast, ng_d, ng_d, met_u )
+ call mp_recv4d_ns( grid%commxy, im, jm, km, 1, jfirst, jlast, &
+ kfirst, klast, ng_d, ng_s, met_v )
+#endif
+
+ ! average to cell walls (vorticity winds)
+ call transfer_windsToWalls(grid)
+ else
+ met_us(:,jfirst:jlast,kfirst:klast) = fact1*met_usi(nm)%data(:,jfirst:jlast,kfirst:klast) + &
+ fact2*met_usi(np)%data(:,jfirst:jlast,kfirst:klast)
+ met_vs(:,jfirst:jlast,kfirst:klast) = fact1*met_vsi(nm)%data(:,jfirst:jlast,kfirst:klast) + &
+ fact2*met_vsi(np)%data(:,jfirst:jlast,kfirst:klast)
+
+ endif
+
+ ! ghost staggered u,v
+ ! WS 2006.04.11: not necessary here since it will be done in cd_core
+
+! write(iulog,*)'INTERPOLATE_METDATA: complete.'
+
+ call t_stopf('MET__interpolate_metdata')
+
+ end subroutine interpolate_metdata
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ subroutine get_dimension( fid, dname, dsize )
+ implicit none
+ type(file_desc_t), intent(in) :: fid
+ character(*), intent(in) :: dname
+ integer, intent(out) :: dsize
+
+ integer :: dimid, ierr
+
+ ierr = pio_inq_dimid( fid, dname, dimid )
+ ierr = pio_inq_dimlen( fid, dimid, dsize )
+
+ end subroutine get_dimension
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ subroutine open_met_datafile( fname, fileid, times, datapath, check_dims, grid )
+
+ use ioFileMod, only: getfil
+ use pio, only: pio_seterrorhandling, PIO_INTERNAL_ERROR, PIO_BCAST_ERROR, PIO_NOERR
+
+ implicit none
+
+ character(*), intent(in) :: fname
+ type(file_desc_t), intent(inout) :: fileid
+ real(r8), pointer, intent(inout) :: times(:)
+ character(*), intent(in) :: datapath
+ logical, optional, intent(in) :: check_dims
+ type (T_FVDYCORE_GRID), optional, intent(in) :: grid
+
+ character(len=256) :: filepath
+ character(len=256) :: filen
+ integer :: year, month, day, dsize, i, timesize
+ integer :: dateid,secid
+ integer, allocatable , dimension(:) :: dates, datesecs
+ integer :: ierr
+ integer :: im, jm, km
+ integer :: varid
+
+ !
+ ! open file and get fileid
+ !
+ if (len_trim( datapath )>0) then
+ filepath = trim(datapath)//'/'//trim(fname)
+ else
+ filepath = trim(fname)
+ endif
+ call getfil( filepath, filen, 0 )
+
+ call cam_pio_openfile( fileid, filen, 0 )
+
+ call pio_seterrorhandling(fileid, PIO_BCAST_ERROR)
+
+ ierr = pio_inq_varid( fileid, 'TS', varid )
+ !++IH
+ if (.not. met_nudge_only_uvps) then
+ !--IH
+ has_ts = ierr==PIO_NOERR
+ !++IH
+ endif
+ !--IH
+
+ ierr = pio_inq_varid( fileid, 'LHFLX', varid )
+ !++IH
+ if (.not. met_nudge_only_uvps) then
+ !--IH
+ has_lhflx = ierr==PIO_NOERR
+ !++IH
+ endif
+ !--IH
+
+ call pio_seterrorhandling(fileid, PIO_INTERNAL_ERROR)
+
+ if (masterproc) write(iulog,*) 'open_met_datafile: ',trim(filen)
+
+ call get_dimension( fileid, 'time', timesize )
+
+ if ( associated(times) ) deallocate(times)
+ allocate( times(timesize) )
+
+ allocate( dates(timesize) )
+ allocate( datesecs(timesize) )
+
+ ierr = pio_inq_varid( fileid, 'date', dateid )
+ ierr = pio_inq_varid( fileid, 'datesec', secid )
+
+ ierr = pio_get_var( fileid, dateid, dates )
+ ierr = pio_get_var( fileid, secid, datesecs )
+
+ do i=1,timesize
+ year = dates(i) / 10000
+ month = mod(dates(i),10000)/100
+ day = mod(dates(i),100)
+ times(i) = get_time_float( year, month, day, datesecs(i) )
+ enddo
+
+ deallocate( dates )
+ deallocate( datesecs )
+
+
+!
+! check that the data dim sizes match models dimensions
+!
+ if (present(check_dims) .and. present(grid)) then
+ im = grid%im
+ jm = grid%jm
+ km = grid%km
+
+ if (check_dims) then
+
+ call get_dimension( fileid, 'lon', dsize )
+ if (dsize /= im) then
+ write(iulog,*)'open_met_datafile: lonsiz=',dsize,' must = ',im
+ call endrun
+ endif
+ call get_dimension( fileid, 'lat', dsize )
+ if (dsize /= jm) then
+ write(iulog,*)'open_met_datafile: latsiz=',dsize,' must = ',jm
+ call endrun
+ endif
+ call get_dimension( fileid, 'lev', dsize )
+ met_levels = min( dsize, km )
+ num_met_levels = dsize
+ endif
+ endif
+
+ if (met_srf_rad) then
+ ierr = pio_inq_varid( fileid, 'ASDIR', varid )
+ ierr = pio_get_att( fileid, varid, '_FillValue', srf_fill_value)
+ endif
+
+ end subroutine open_met_datafile
+
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
+ function get_time_float( year, month, day, sec )
+
+! returns float representation of time -- number of days
+! since 1 jan 0001 00:00:00.000
+
+ implicit none
+
+ integer, intent(in) :: year, month, day
+ integer, intent(in) :: sec
+ real(r8) :: get_time_float
+
+! ref date is 1 jan 0001
+
+ integer :: refyr, refmn, refdy
+ real(r8) :: refsc, fltdy
+ integer :: doy(12)
+
+! jan feb mar apr may jun jul aug sep oct nov dec
+! 31 28 31 30 31 30 31 31 31 31 30 31
+ data doy / 1, 32, 60, 91,121,152,182,213,244,274,305,335 /
+
+ refyr = 1
+ refmn = 1
+ refdy = 1
+ refsc = D0_0
+
+ if ( timemgr_is_caltype(trim(shr_cal_gregorian))) then
+ fltdy = greg2jday(year, month, day) - greg2jday(refyr,refmn,refdy)
+ else ! assume no_leap (all years are 365 days)
+ fltdy = (year - refyr)*days_per_non_leapyear + &
+ (doy(month)-doy(refmn)) + &
+ (day-refdy)
+ endif
+
+ get_time_float = fltdy + ((sec-refsc)/seconds_per_day)
+
+ endfunction get_time_float
+
+!-----------------------------------------------------------------------
+! ... Return Julian day number given Gregorian date.
+!
+! Algorithm from Hatcher,D.A., Simple Formulae for Julian Day Numbers
+! and Calendar Dates, Q.Jl.R.astr.Soc. (1984) v25, pp 53-55.
+!-----------------------------------------------------------------------
+ function greg2jday( year, month, day )
+
+ implicit none
+
+ integer, intent(in) :: year, month, day
+ integer :: greg2jday
+
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ integer :: ap, mp
+ integer :: y, d, n, g
+
+ !-----------------------------------------------------------------------
+ ! ... Modify year and month numbers
+ !-----------------------------------------------------------------------
+ ap = year - (12 - month)/10
+ mp = MOD( month-3,12 )
+ if( mp < 0 ) then
+ mp = mp + 12
+ end if
+
+ !-----------------------------------------------------------------------
+ ! ... Julian day
+ !-----------------------------------------------------------------------
+ y = INT( days_per_year*( ap + 4712 ) )
+ d = INT( days_per_month*mp + D0_5 )
+ n = y + d + day + 59
+ g = INT( D0_75*INT( ap/100 + 49 ) ) - 38
+ greg2jday = n - g
+
+ end function greg2jday
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ subroutine set_met_rlx( )
+ !++ IH
+ ! The relaxation time between surface and met_rlx_bot is given by
+ ! namelist input met_rlx (hours). This will decay exponentially between
+ ! met_rlx_bot and met_rlx_top. 6h relaxation time when dt is 1800s gives
+ ! met_rlx = 1800/(6*3600) = 0.8333.
+ !-- IH
+
+ use pmgrid, only: plev
+ use hycoef, only: hypm, ps0
+
+ integer :: k, k_cnt, k_top
+ real(r8), parameter :: h0 = 7._r8 ! scale height (km)
+ real(r8), parameter :: hsec = 3600._r8 ! seconds per hour
+ real(r8) :: p_top, p_bot
+ real(r8) :: p_bot_top, p_bot_bot
+ real(r8) :: met_max_rlxdt, dtime_hrs
+
+996 format( 'set_met_rlx: ',a15, I10 )
+997 format( 'set_met_rlx: ',a15, E10.2 )
+998 format( 'set_met_rlx: ',a15, PLEV(E10.2))
+999 format( 'set_met_rlx: ',a15, PLEV(F10.5))
+993 format( 'set_met_rlx: ',a25, E10.2 )
+991 format( 'set_met_rlx: ',a25, I4, E10.2, E10.2 )
+
+ met_rlx(:) = 999._r8
+
+ dtime_hrs = get_step_size()/hsec ! hours
+
+ if (met_rlx_time > dtime_hrs) then
+ met_max_rlxdt = dtime_hrs/met_rlx_time
+ elseif (met_rlx_time < 0._r8) then
+ met_max_rlxdt = 0._r8
+ else
+ met_max_rlxdt = 1._r8
+ endif
+
+ if (masterproc) then
+ write(iulog,fmt=993) ' met_rlx_time in hrs= ', met_rlx_time
+ write(iulog,fmt=993) ' met_max_rlxdt in % = ', met_max_rlxdt*100._r8
+ endif
+
+ p_top = ps0 * exp( - met_rlx_top/h0 )
+ p_bot = ps0 * exp( - met_rlx_bot/h0 )
+
+ p_bot_top = ps0 * exp( - met_rlx_bot_top/h0 )
+ p_bot_bot = ps0 * exp( - met_rlx_bot_bot/h0 )
+
+ if (masterproc) then
+ write(iulog,fmt=997) 'p_top = ',p_top
+ write(iulog,fmt=997) 'p_bot = ',p_bot
+ write(iulog,fmt=997) 'p_bot_top = ',p_bot_top
+ write(iulog,fmt=997) 'p_bot_bot = ',p_bot_bot
+ endif
+
+ if ( p_bot < hypm( pver-met_levels+1 ) .and. ( met_levels < pver ) ) then
+ call endrun( 'set_met_rlx: met_rlx_bot is too high ' )
+ endif
+
+ met_rlx = 0._r8
+
+ where (p_top <= hypm .and. hypm < p_bot)
+ met_rlx = 999._r8
+ endwhere
+
+ where( p_bot <= hypm .and. hypm <= p_bot_top )
+ met_rlx = met_max_rlxdt
+ endwhere
+
+ where(p_bot_top < hypm .and. hypm <= p_bot_bot)
+ met_rlx = -999._r8
+ endwhere
+
+ if ( any( met_rlx(:) /= met_max_rlxdt) ) then
+ k_top = max(plev - met_levels, 1)
+
+ ! ramp region at model top
+ k_cnt = count(p_top < hypm .and. hypm < p_bot)
+ if (k_cnt > 0) then
+ k_top = max(plev - met_levels, 1)
+ do while ( met_rlx(k_top) /= 999._r8 )
+ k_top = k_top + 1
+ if ( k_top == pver ) then
+ call endrun ( 'set_met_rlx: cannot find ramped region ')
+ endif
+ enddo
+
+ met_rlx(1:k_top) = 0._r8
+
+ k_cnt = count( met_rlx == 999._r8 )
+
+ if (masterproc) then
+ write(iulog,*) 'top of model ramped region:'
+ write(iulog,fmt=996) 'k_cnt = ',k_cnt
+ write(iulog,fmt=996) 'k_top = ',k_top
+ endif
+
+ do k = k_top,k_top+k_cnt
+ met_rlx(k) = met_max_rlxdt*real( k - k_top ) / real(k_cnt)
+ enddo
+ endif
+
+ ! ramp region at model bottom
+ k_cnt = count(p_bot_top < hypm .and. hypm < p_bot_bot)
+ if (k_cnt > 0) then
+ k_top = max(plev - met_levels, 1)
+ do while ( met_rlx(k_top) /= -999._r8 )
+ k_top = k_top + 1
+ if ( k_top == pver ) then
+ call endrun ( 'set_met_rlx: cannot find ramped region ')
+ endif
+ enddo
+
+ if (masterproc) then
+ write(iulog,*) 'bottom of model ramped region:'
+ write(iulog,fmt=996) 'k_cnt = ',k_cnt
+ write(iulog,fmt=996) 'k_top = ',k_top
+ endif
+
+ do k = k_top,k_top+k_cnt-1
+ met_rlx(k) = met_max_rlxdt*(1._r8 - real( k - k_top +1) / real(k_cnt))
+ enddo
+ endif
+
+ endif
+
+ if (masterproc) then
+ write(iulog,fmt=996) ' met_levels = ',met_levels
+ write(iulog,fmt=996) 'non-zero terms:',count( met_rlx /= 0._r8 )
+ endif
+
+ if ( met_levels < count( met_rlx /= 0._r8 ) ) then
+ call endrun('set_met_rlx: met_rlx_top is too high for the meteorology data')
+ endif
+
+ if (masterproc) then
+ do k = max(plev - met_levels, 1), pver
+ write(iulog,fmt=991) 'press levels, met_rlx = ', k, hypm(k), met_rlx(k)
+ end do
+ endif
+
+ if ( any( (met_rlx > 1._r8) .or. (met_rlx < 0._r8) ) ) then
+ if (masterproc) then
+ write(iulog,fmt=993) 'set_met_rlx: dtime_hrs in hrs = ', dtime_hrs
+ write(iulog,fmt=993) 'set_met_rlx:met_rlx_time in hrs = ', met_rlx_time
+ write(iulog,fmt=993) 'set_met_rlx: met_max_rlxdt = ', met_max_rlxdt
+ write(iulog,fmt=999) 'set_met_rlx: met_rlx = ', met_rlx
+ endif
+ call endrun('Offline meteorology relaxation function not set correctly.')
+ endif
+
+ end subroutine set_met_rlx
+
+end module metdata
diff --git a/src/NorESM/macrop_driver.F90 b/src/NorESM/macrop_driver.F90
new file mode 100644
index 0000000000..8defa67d42
--- /dev/null
+++ b/src/NorESM/macrop_driver.F90
@@ -0,0 +1,1219 @@
+ module macrop_driver
+
+ !-------------------------------------------------------------------------------------------------------
+ ! Purpose:
+ !
+ ! Provides the CAM interface to the prognostic cloud macrophysics
+ !
+ ! Author: Andrew Gettelman, Cheryl Craig October 2010
+ ! Origin: modified from stratiform.F90 elements
+ ! (Boville 2002, Coleman 2004, Park 2009, Kay 2010)
+ !-------------------------------------------------------------------------------------------------------
+
+ use shr_kind_mod, only: r8=>shr_kind_r8
+ use spmd_utils, only: masterproc
+ use ppgrid, only: pcols, pver, pverp
+ use physconst, only: latice, latvap
+ use phys_control, only: phys_getopts
+ use constituents, only: cnst_get_ind, pcnst
+ use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_field, pbuf_old_tim_idx
+ use time_manager, only: is_first_step
+ use cldwat2m_macro, only: ini_macro
+ use perf_mod, only: t_startf, t_stopf
+ use cam_logfile, only: iulog
+ use cam_abortutils, only: endrun
+ use zm_conv_intr, only: zmconv_microp
+
+ implicit none
+ private
+ save
+
+ public :: macrop_driver_readnl
+ public :: macrop_driver_register
+ public :: macrop_driver_init
+ public :: macrop_driver_tend
+ public :: liquid_macro_tend
+
+ logical, public :: do_cldice ! .true., park macrophysics is prognosing cldice
+ logical, public :: do_cldliq ! .true., park macrophysics is prognosing cldliq
+ logical, public :: do_detrain ! .true., park macrophysics is detraining ice into stratiform
+
+ ! ------------------------- !
+ ! Private Module Parameters !
+ ! ------------------------- !
+
+ ! 'cu_det_st' : If .true. (.false.), detrain cumulus liquid condensate into the pre-existing liquid stratus
+ ! (environment) without (with) macrophysical evaporation. If there is no pre-esisting stratus,
+ ! evaporate cumulus liquid condensate. This option only influences the treatment of cumulus
+ ! liquid condensate, not cumulus ice condensate.
+
+ logical, parameter :: cu_det_st = .false.
+
+ ! Parameters used for selecting generalized critical RH for liquid and ice stratus
+ integer :: rhminl_opt = 0
+ integer :: rhmini_opt = 0
+
+
+ character(len=16) :: shallow_scheme
+ logical :: use_shfrc ! Local copy of flag from convect_shallow_use_shfrc
+
+ integer :: &
+ ixcldliq, &! cloud liquid amount index
+ ixcldice, &! cloud ice amount index
+ ixnumliq, &! cloud liquid number index
+ ixnumice, &! cloud ice water index
+ qcwat_idx, &! qcwat index in physics buffer
+ lcwat_idx, &! lcwat index in physics buffer
+ iccwat_idx, &! iccwat index in physics buffer
+ nlwat_idx, &! nlwat index in physics buffer
+ niwat_idx, &! niwat index in physics buffer
+ tcwat_idx, &! tcwat index in physics buffer
+ CC_T_idx, &!
+ CC_qv_idx, &!
+ CC_ql_idx, &!
+ CC_qi_idx, &!
+ CC_nl_idx, &!
+ CC_ni_idx, &!
+ CC_qlst_idx, &!
+ cld_idx, &! cld index in physics buffer
+ ast_idx, &! stratiform cloud fraction index in physics buffer
+ aist_idx, &! ice stratiform cloud fraction index in physics buffer
+ alst_idx, &! liquid stratiform cloud fraction index in physics buffer
+ qist_idx, &! ice stratiform in-cloud IWC
+ qlst_idx, &! liquid stratiform in-cloud LWC
+ concld_idx, &! concld index in physics buffer
+ fice_idx, &
+ cmeliq_idx, &
+ shfrc_idx
+
+ integer :: &
+ dlfzm_idx = -1, & ! ZM detrained convective cloud water mixing ratio.
+ difzm_idx = -1, & ! ZM detrained convective cloud ice mixing ratio.
+ dnlfzm_idx = -1, & ! ZM detrained convective cloud water num concen.
+ dnifzm_idx = -1 ! ZM detrained convective cloud ice num concen.
+
+
+ integer :: &
+ tke_idx = -1, &! tke defined at the model interfaces
+ qtl_flx_idx = -1, &! overbar(w'qtl' where qtl = qv + ql) from the PBL scheme
+ qti_flx_idx = -1, &! overbar(w'qti' where qti = qv + qi) from the PBL scheme
+ cmfr_det_idx = -1, &! detrained convective mass flux from UNICON
+ qlr_det_idx = -1, &! detrained convective ql from UNICON
+ qir_det_idx = -1, &! detrained convective qi from UNICON
+ cmfmc_sh_idx = -1
+
+ contains
+
+ ! ===============================================================================
+ subroutine macrop_driver_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use mpishorthand
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Namelist variables
+ logical :: macro_park_do_cldice = .true. ! do_cldice = .true., park macrophysics is prognosing cldice
+ logical :: macro_park_do_cldliq = .true. ! do_cldliq = .true., park macrophysics is prognosing cldliq
+ logical :: macro_park_do_detrain = .true. ! do_detrain = .true., park macrophysics is detraining ice into stratiform
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'macrop_driver_readnl'
+
+ namelist /macro_park_nl/ macro_park_do_cldice, macro_park_do_cldliq, macro_park_do_detrain
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'macro_park_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, macro_park_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+
+ ! set local variables
+
+ do_cldice = macro_park_do_cldice
+ do_cldliq = macro_park_do_cldliq
+ do_detrain = macro_park_do_detrain
+
+ end if
+
+#ifdef SPMD
+ ! Broadcast namelist variables
+ call mpibcast(do_cldice, 1, mpilog, 0, mpicom)
+ call mpibcast(do_cldliq, 1, mpilog, 0, mpicom)
+ call mpibcast(do_detrain, 1, mpilog, 0, mpicom)
+#endif
+
+end subroutine macrop_driver_readnl
+
+ !================================================================================================
+
+ subroutine macrop_driver_register
+
+ !---------------------------------------------------------------------- !
+ ! !
+ ! Register the constituents (cloud liquid and cloud ice) and the fields !
+ ! in the physics buffer. !
+ ! !
+ !---------------------------------------------------------------------- !
+
+
+ use physics_buffer, only : pbuf_add_field, dtype_r8, dyn_time_lvls
+
+ !-----------------------------------------------------------------------
+
+ call phys_getopts(shallow_scheme_out=shallow_scheme)
+
+ call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx)
+ call pbuf_add_field('AIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), aist_idx)
+ call pbuf_add_field('ALST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), alst_idx)
+ call pbuf_add_field('QIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qist_idx)
+ call pbuf_add_field('QLST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx)
+ call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx)
+ call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx)
+
+ call pbuf_add_field('QCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qcwat_idx)
+ call pbuf_add_field('LCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), lcwat_idx)
+ call pbuf_add_field('ICCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), iccwat_idx)
+ call pbuf_add_field('NLWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), nlwat_idx)
+ call pbuf_add_field('NIWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), niwat_idx)
+ call pbuf_add_field('TCWAT', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), tcwat_idx)
+
+ call pbuf_add_field('FICE', 'physpkg', dtype_r8, (/pcols,pver/), fice_idx)
+
+ call pbuf_add_field('CMELIQ', 'physpkg', dtype_r8, (/pcols,pver/), cmeliq_idx)
+
+ end subroutine macrop_driver_register
+
+ !============================================================================ !
+ ! !
+ !============================================================================ !
+
+ subroutine macrop_driver_init(pbuf2d)
+
+ !-------------------------------------------- !
+ ! !
+ ! Initialize the cloud water parameterization !
+ ! !
+ !-------------------------------------------- !
+ use physics_buffer, only : pbuf_get_index
+ use cam_history, only: addfld, add_default
+ use convect_shallow, only: convect_shallow_use_shfrc
+
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ logical :: history_aerosol ! Output the MAM aerosol tendencies
+ logical :: history_budget ! Output tendencies and state variables for CAM4
+ ! temperature, water vapor, cloud ice and cloud
+ ! liquid budgets.
+ integer :: history_budget_histfile_num ! output history file number for budget fields
+ integer :: istat
+
+ character(len=*), parameter :: subname = 'macrop_driver_init'
+ !-----------------------------------------------------------------------
+
+ ! Initialization routine for cloud macrophysics
+ if (shallow_scheme .eq. 'UNICON') rhminl_opt = 1
+ call ini_macro(rhminl_opt, rhmini_opt)
+
+ call phys_getopts(history_aerosol_out = history_aerosol , &
+ history_budget_out = history_budget , &
+ history_budget_histfile_num_out = history_budget_histfile_num )
+
+ ! Find out whether shfrc from convect_shallow will be used in cldfrc
+
+ if( convect_shallow_use_shfrc() ) then
+ use_shfrc = .true.
+ shfrc_idx = pbuf_get_index('shfrc')
+ else
+ use_shfrc = .false.
+ endif
+
+ call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection' )
+ call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection' )
+ call addfld ('SHDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from shallow convection' )
+ call addfld ('SHDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from shallow convection' )
+ call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment' )
+ call addfld ('SHDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to shallow convective detrainment' )
+
+ call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection' )
+
+ call addfld ('MACPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Revised macrophysics' )
+ call addfld ('MACPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Revised macrophysics' )
+ call addfld ('MACPDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ tendency - Revised macrophysics' )
+ call addfld ('MACPDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency - Revised macrophysics' )
+
+ call addfld ('CLDVAPADJ', (/ 'lev' /), 'A', 'kg/kg/s', &
+ 'Q tendency associated with liq/ice adjustment - Revised macrophysics' )
+ call addfld ('CLDLIQADJ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ adjustment tendency - Revised macrophysics' )
+ call addfld ('CLDICEADJ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE adjustment tendency - Revised macrophysics' )
+ call addfld ('CLDLIQDET', (/ 'lev' /), 'A', 'kg/kg/s', &
+ 'Detrainment of conv cld liq into envrionment - Revised macrophysics' )
+ call addfld ('CLDICEDET', (/ 'lev' /), 'A', 'kg/kg/s', &
+ 'Detrainment of conv cld ice into envrionment - Revised macrophysics' )
+ call addfld ('CLDLIQLIM', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ limiting tendency - Revised macrophysics' )
+ call addfld ('CLDICELIM', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE limiting tendency - Revised macrophysics' )
+
+ call addfld ('AST', (/ 'lev' /), 'A', '1', 'Stratus cloud fraction' )
+ call addfld ('LIQCLDF', (/ 'lev' /), 'A', '1', 'Stratus Liquid cloud fraction' )
+ call addfld ('ICECLDF', (/ 'lev' /), 'A', '1', 'Stratus ICE cloud fraction' )
+
+ call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction' )
+ call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover' )
+
+ call addfld ('CLR_LIQ', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for liquid stratus' )
+ call addfld ('CLR_ICE', (/ 'lev' /), 'A', 'fraction', 'Clear sky fraction for ice stratus' )
+
+ call addfld ('CLDLIQSTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDLIQ' )
+ call addfld ('CLDICESTR', (/ 'lev' /), 'A', 'kg/kg', 'Stratiform CLDICE' )
+ call addfld ('CLDLIQCON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDLIQ' )
+ call addfld ('CLDICECON', (/ 'lev' /), 'A', 'kg/kg', 'Convective CLDICE' )
+
+ call addfld ('CLDSICE', (/ 'lev' /), 'A', 'kg/kg', 'CloudSat equivalent ice mass mixing ratio' )
+ call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud' )
+
+ call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment' )
+ call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment' )
+ call addfld ('QITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment' )
+ call addfld ('NITENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment' )
+!AL
+ call addfld ('DPDLFNC ', (/ 'lev' /), 'A', '#/kg/s ', 'Detrained liquid number from deep convection' )
+ call addfld ('DPDLFNI ', (/ 'lev' /), 'A', '#/kg/s ', 'Detrained ice number from deep convection' )
+ call addfld ('SHDLFNC ', (/ 'lev' /), 'A', '#/kg/s ', 'Detrained liquid number from shallow convection')
+ call addfld ('SHDLFNI ', (/ 'lev' /), 'A', '#/kg/s ', 'Detrained ice number from shallow convection' )
+ call addfld ('MACPDNC ', (/ 'lev' /), 'A', '#/kg/s ', 'NC tendency - Revised macrophysics' )
+ call addfld ('MACPDNI ', (/ 'lev' /), 'A', '#/kg/s ', 'NI tendency - Revised macrophysics' )
+!AL
+ if ( history_budget ) then
+
+ call add_default ('DPDLFLIQ ', history_budget_histfile_num, ' ')
+ call add_default ('DPDLFICE ', history_budget_histfile_num, ' ')
+ call add_default ('SHDLFLIQ ', history_budget_histfile_num, ' ')
+ call add_default ('SHDLFICE ', history_budget_histfile_num, ' ')
+ call add_default ('DPDLFT ', history_budget_histfile_num, ' ')
+ call add_default ('SHDLFT ', history_budget_histfile_num, ' ')
+ call add_default ('ZMDLF ', history_budget_histfile_num, ' ')
+
+ call add_default ('MACPDT ', history_budget_histfile_num, ' ')
+ call add_default ('MACPDQ ', history_budget_histfile_num, ' ')
+ call add_default ('MACPDLIQ ', history_budget_histfile_num, ' ')
+ call add_default ('MACPDICE ', history_budget_histfile_num, ' ')
+
+ call add_default ('CLDVAPADJ', history_budget_histfile_num, ' ')
+ call add_default ('CLDLIQLIM', history_budget_histfile_num, ' ')
+ call add_default ('CLDLIQDET', history_budget_histfile_num, ' ')
+ call add_default ('CLDLIQADJ', history_budget_histfile_num, ' ')
+ call add_default ('CLDICELIM', history_budget_histfile_num, ' ')
+ call add_default ('CLDICEDET', history_budget_histfile_num, ' ')
+ call add_default ('CLDICEADJ', history_budget_histfile_num, ' ')
+
+ call add_default ('CMELIQ ', history_budget_histfile_num, ' ')
+
+!AL
+ call add_default ('DPDLFNC ', history_budget_histfile_num, ' ')
+ call add_default ('DPDLFNI ', history_budget_histfile_num, ' ')
+ call add_default ('SHDLFNC ', history_budget_histfile_num, ' ')
+ call add_default ('SHDLFNI ', history_budget_histfile_num, ' ')
+ call add_default ('MACPDNC ', history_budget_histfile_num, ' ')
+ call add_default ('MACPDNI ', history_budget_histfile_num, ' ')
+!AL
+ end if
+
+ ! Get constituent indices
+ call cnst_get_ind('CLDLIQ', ixcldliq)
+ call cnst_get_ind('CLDICE', ixcldice)
+ call cnst_get_ind('NUMLIQ', ixnumliq)
+ call cnst_get_ind('NUMICE', ixnumice)
+
+ ! Get physics buffer indices
+ CC_T_idx = pbuf_get_index('CC_T')
+ CC_qv_idx = pbuf_get_index('CC_qv')
+ CC_ql_idx = pbuf_get_index('CC_ql')
+ CC_qi_idx = pbuf_get_index('CC_qi')
+ CC_nl_idx = pbuf_get_index('CC_nl')
+ CC_ni_idx = pbuf_get_index('CC_ni')
+ CC_qlst_idx = pbuf_get_index('CC_qlst')
+ cmfmc_sh_idx = pbuf_get_index('CMFMC_SH')
+
+ if (zmconv_microp) then
+ dlfzm_idx = pbuf_get_index('DLFZM')
+ difzm_idx = pbuf_get_index('DIFZM')
+ dnlfzm_idx = pbuf_get_index('DNLFZM')
+ dnifzm_idx = pbuf_get_index('DNIFZM')
+ end if
+
+
+ if (rhminl_opt > 0 .or. rhmini_opt > 0) then
+ cmfr_det_idx = pbuf_get_index('cmfr_det', istat)
+ if (istat < 0) call endrun(subname//': macrop option requires cmfr_det in pbuf')
+ if (rhminl_opt > 0) then
+ qlr_det_idx = pbuf_get_index('qlr_det', istat)
+ if (istat < 0) call endrun(subname//': macrop option requires qlr_det in pbuf')
+ end if
+ if (rhmini_opt > 0) then
+ qir_det_idx = pbuf_get_index('qir_det', istat)
+ if (istat < 0) call endrun(subname//': macrop option requires qir_det in pbuf')
+ end if
+ end if
+
+ if (rhminl_opt == 2 .or. rhmini_opt == 2) then
+ tke_idx = pbuf_get_index('tke')
+ if (rhminl_opt == 2) then
+ qtl_flx_idx = pbuf_get_index('qtl_flx', istat)
+ if (istat < 0) call endrun(subname//': macrop option requires qtl_flx in pbuf')
+ end if
+ if (rhmini_opt == 2) then
+ qti_flx_idx = pbuf_get_index('qti_flx', istat)
+ if (istat < 0) call endrun(subname//': macrop option requires qti_flx in pbuf')
+ end if
+ end if
+
+ ! Init pbuf fields. Note that the fields CLD, CONCLD, QCWAT, LCWAT,
+ ! ICCWAT, and TCWAT are initialized in phys_inidat.
+ if (is_first_step()) then
+ call pbuf_set_field(pbuf2d, ast_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, aist_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, alst_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, qist_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, qlst_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, nlwat_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, niwat_idx, 0._r8)
+ end if
+
+ ! the following are physpkg, so they need to be init every time
+ call pbuf_set_field(pbuf2d, fice_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, cmeliq_idx, 0._r8)
+
+ end subroutine macrop_driver_init
+
+ !============================================================================ !
+ ! !
+ !============================================================================ !
+
+
+ subroutine macrop_driver_tend( &
+ state, ptend, dtime, landfrac, &
+ ocnfrac, snowh, &
+ dlf, dlf2, cmfmc, ts, &
+ sst, zdu, &
+ pbuf, &
+ det_s, det_ice)
+
+ !-------------------------------------------------------- !
+ ! !
+ ! Purpose: !
+ ! !
+ ! Interface to detrain, cloud fraction and !
+ ! cloud macrophysics subroutines !
+ ! !
+ ! Author: A. Gettelman, C. Craig, Oct 2010 !
+ ! based on stratiform_tend by D.B. Coleman 4/2010 !
+ ! !
+ !-------------------------------------------------------- !
+
+ use cloud_fraction, only: cldfrc, cldfrc_fice
+ use physics_types, only: physics_state, physics_ptend
+ use physics_types, only: physics_ptend_init, physics_update
+ use physics_types, only: physics_ptend_sum, physics_state_copy
+ use physics_types, only: physics_state_dealloc
+ use cam_history, only: outfld
+ use constituents, only: cnst_get_ind, pcnst
+ use cldwat2m_macro, only: mmacro_pcond
+ use physconst, only: cpair, tmelt, gravit
+ use time_manager, only: get_nstep
+
+ use ref_pres, only: top_lev => trop_cloud_top_lev
+
+ !
+ ! Input arguments
+ !
+
+ type(physics_state), intent(in) :: state ! State variables
+ type(physics_ptend), intent(out) :: ptend ! macrophysics parameterization tendencies
+ type(physics_buffer_desc), pointer :: pbuf(:) ! Physics buffer
+
+ real(r8), intent(in) :: dtime ! Timestep
+ real(r8), intent(in) :: landfrac(pcols) ! Land fraction (fraction)
+ real(r8), intent(in) :: ocnfrac (pcols) ! Ocean fraction (fraction)
+ real(r8), intent(in) :: snowh(pcols) ! Snow depth over land, water equivalent (m)
+ real(r8), intent(in) :: dlf(pcols,pver) ! Detrained water from convection schemes
+ real(r8), intent(in) :: dlf2(pcols,pver) ! Detrained water from shallow convection scheme
+ real(r8), intent(in) :: cmfmc(pcols,pverp) ! Deep + Shallow Convective mass flux [ kg /s/m^2 ]
+
+ real(r8), intent(in) :: ts(pcols) ! Surface temperature
+ real(r8), intent(in) :: sst(pcols) ! Sea surface temperature
+ real(r8), intent(in) :: zdu(pcols,pver) ! Detrainment rate from deep convection
+
+
+ ! These two variables are needed for energy check
+ real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice
+ real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check
+
+ !
+ ! Local variables
+ !
+
+ type(physics_state) :: state_loc ! Local copy of the state variable
+ type(physics_ptend) :: ptend_loc ! Local parameterization tendencies
+
+ integer i,k
+ integer :: lchnk ! Chunk identifier
+ integer :: ncol ! Number of atmospheric columns
+
+ ! Physics buffer fields
+
+ integer itim_old
+ real(r8), pointer, dimension(:,:) :: qcwat ! Cloud water old q
+ real(r8), pointer, dimension(:,:) :: tcwat ! Cloud water old temperature
+ real(r8), pointer, dimension(:,:) :: lcwat ! Cloud liquid water old q
+ real(r8), pointer, dimension(:,:) :: iccwat ! Cloud ice water old q
+ real(r8), pointer, dimension(:,:) :: nlwat ! Cloud liquid droplet number condentration. old.
+ real(r8), pointer, dimension(:,:) :: niwat ! Cloud ice droplet number condentration. old.
+ real(r8), pointer, dimension(:,:) :: CC_T ! Grid-mean microphysical tendency
+ real(r8), pointer, dimension(:,:) :: CC_qv ! Grid-mean microphysical tendency
+ real(r8), pointer, dimension(:,:) :: CC_ql ! Grid-mean microphysical tendency
+ real(r8), pointer, dimension(:,:) :: CC_qi ! Grid-mean microphysical tendency
+ real(r8), pointer, dimension(:,:) :: CC_nl ! Grid-mean microphysical tendency
+ real(r8), pointer, dimension(:,:) :: CC_ni ! Grid-mean microphysical tendency
+ real(r8), pointer, dimension(:,:) :: CC_qlst ! In-liquid stratus microphysical tendency
+ real(r8), pointer, dimension(:,:) :: cld ! Total cloud fraction
+ real(r8), pointer, dimension(:,:) :: ast ! Relative humidity cloud fraction
+ real(r8), pointer, dimension(:,:) :: aist ! Physical ice stratus fraction
+ real(r8), pointer, dimension(:,:) :: alst ! Physical liquid stratus fraction
+ real(r8), pointer, dimension(:,:) :: qist ! Physical in-cloud IWC
+ real(r8), pointer, dimension(:,:) :: qlst ! Physical in-cloud LWC
+ real(r8), pointer, dimension(:,:) :: concld ! Convective cloud fraction
+
+ real(r8), pointer, dimension(:,:) :: shfrc ! Cloud fraction from shallow convection scheme
+ real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux (pcols,pverp) [ kg/s/m^2 ]
+
+ real(r8), pointer, dimension(:,:) :: cmeliq
+
+ real(r8), pointer, dimension(:,:) :: tke
+ real(r8), pointer, dimension(:,:) :: qtl_flx
+ real(r8), pointer, dimension(:,:) :: qti_flx
+ real(r8), pointer, dimension(:,:) :: cmfr_det
+ real(r8), pointer, dimension(:,:) :: qlr_det
+ real(r8), pointer, dimension(:,:) :: qir_det
+
+ ! Convective cloud to the physics buffer for purposes of ql contrib. to radn.
+
+ real(r8), pointer, dimension(:,:) :: fice_ql ! Cloud ice/water partitioning ratio.
+
+ ! ZM microphysics
+ real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio.
+ real(r8), pointer :: difzm(:,:) ! ZM detrained convective cloud ice mixing ratio.
+ real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen.
+ real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen.
+
+ real(r8) :: latsub
+
+ ! tendencies for ice saturation adjustment
+ real(r8) :: stend(pcols,pver)
+ real(r8) :: qvtend(pcols,pver)
+ real(r8) :: qitend(pcols,pver)
+ real(r8) :: initend(pcols,pver)
+
+ ! Local variables for cldfrc
+
+ real(r8) cldst(pcols,pver) ! Stratus cloud fraction
+ real(r8) rhcloud(pcols,pver) ! Relative humidity cloud (last timestep)
+ real(r8) clc(pcols) ! Column convective cloud amount
+ real(r8) rhu00(pcols,pver) ! RH threshold for cloud
+ real(r8) icecldf(pcols,pver) ! Ice cloud fraction
+ real(r8) liqcldf(pcols,pver) ! Liquid cloud fraction (combined into cloud)
+ real(r8) relhum(pcols,pver) ! RH, output to determine drh/da
+
+ ! Local variables for macrophysics
+
+ real(r8) rdtime ! 1./dtime
+ real(r8) qtend(pcols,pver) ! Moisture tendencies
+ real(r8) ttend(pcols,pver) ! Temperature tendencies
+ real(r8) ltend(pcols,pver) ! Cloud liquid water tendencies
+ real(r8) fice(pcols,pver) ! Fractional ice content within cloud
+ real(r8) fsnow(pcols,pver) ! Fractional snow production
+ real(r8) homoo(pcols,pver)
+ real(r8) qcreso(pcols,pver)
+ real(r8) prcio(pcols,pver)
+ real(r8) praio(pcols,pver)
+ real(r8) qireso(pcols,pver)
+ real(r8) ftem(pcols,pver)
+ real(r8) pracso (pcols,pver)
+ real(r8) dpdlfliq(pcols,pver)
+ real(r8) dpdlfice(pcols,pver)
+ real(r8) shdlfliq(pcols,pver)
+ real(r8) shdlfice(pcols,pver)
+ real(r8) dpdlft (pcols,pver)
+ real(r8) shdlft (pcols,pver)
+!AL
+ real(r8) dpdlfnc(pcols,pver)
+ real(r8) dpdlfni(pcols,pver)
+ real(r8) shdlfnc(pcols,pver)
+ real(r8) shdlfni(pcols,pver)
+!AL
+
+ real(r8) dum1
+ real(r8) qc(pcols,pver)
+ real(r8) qi(pcols,pver)
+ real(r8) nc(pcols,pver)
+ real(r8) ni(pcols,pver)
+
+ logical lq(pcnst)
+
+ ! Output from mmacro_pcond
+
+ real(r8) tlat(pcols,pver)
+ real(r8) qvlat(pcols,pver)
+ real(r8) qcten(pcols,pver)
+ real(r8) qiten(pcols,pver)
+ real(r8) ncten(pcols,pver)
+ real(r8) niten(pcols,pver)
+
+ ! Output from mmacro_pcond
+
+ real(r8) qvadj(pcols,pver) ! Macro-physics adjustment tendency from "positive_moisture" call (vapor)
+ real(r8) qladj(pcols,pver) ! Macro-physics adjustment tendency from "positive_moisture" call (liquid)
+ real(r8) qiadj(pcols,pver) ! Macro-physics adjustment tendency from "positive_moisture" call (ice)
+ real(r8) qllim(pcols,pver) ! Macro-physics tendency from "instratus_condensate" call (liquid)
+ real(r8) qilim(pcols,pver) ! Macro-physics tendency from "instratus_condensate" call (ice)
+
+ ! For revised macophysics, mmacro_pcond
+
+ real(r8) itend(pcols,pver)
+ real(r8) lmitend(pcols,pver)
+ real(r8) zeros(pcols,pver)
+ real(r8) t_inout(pcols,pver)
+ real(r8) qv_inout(pcols,pver)
+ real(r8) ql_inout(pcols,pver)
+ real(r8) qi_inout(pcols,pver)
+ real(r8) concld_old(pcols,pver)
+
+ ! Note that below 'clr_old' is defined using 'alst_old' not 'ast_old' for full consistency with the
+ ! liquid condensation process which is using 'alst' not 'ast'.
+ ! For microconsistency use 'concld_old', since 'alst_old' was computed using 'concld_old'.
+ ! Since convective updraft fractional area is small, it does not matter whether 'concld' or 'concld_old' is used.
+ ! Note also that 'clri_old' is defined using 'ast_old' since current microphysics is operating on 'ast_old'
+ real(r8) clrw_old(pcols,pver) ! (1 - concld_old - alst_old)
+ real(r8) clri_old(pcols,pver) ! (1 - concld_old - ast_old)
+
+ real(r8) nl_inout(pcols,pver)
+ real(r8) ni_inout(pcols,pver)
+
+ real(r8) nltend(pcols,pver)
+ real(r8) nitend(pcols,pver)
+
+
+ ! For detraining cumulus condensate into the 'stratus' without evaporation
+ ! This is for use in mmacro_pcond
+
+ real(r8) dlf_T(pcols,pver)
+ real(r8) dlf_qv(pcols,pver)
+ real(r8) dlf_ql(pcols,pver)
+ real(r8) dlf_qi(pcols,pver)
+ real(r8) dlf_nl(pcols,pver)
+ real(r8) dlf_ni(pcols,pver)
+
+ ! Local variables for CFMIP calculations
+ real(r8) :: mr_lsliq(pcols,pver) ! mixing_ratio_large_scale_cloud_liquid (kg/kg)
+ real(r8) :: mr_lsice(pcols,pver) ! mixing_ratio_large_scale_cloud_ice (kg/kg)
+ real(r8) :: mr_ccliq(pcols,pver) ! mixing_ratio_convective_cloud_liquid (kg/kg)
+ real(r8) :: mr_ccice(pcols,pver) ! mixing_ratio_convective_cloud_ice (kg/kg)
+
+ ! CloudSat equivalent ice mass mixing ratio (kg/kg)
+ real(r8) :: cldsice(pcols,pver)
+
+ ! ======================================================================
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ call physics_state_copy(state, state_loc) ! Copy state to local state_loc.
+
+ ! Associate pointers with physics buffer fields
+
+ itim_old = pbuf_old_tim_idx()
+
+ call pbuf_get_field(pbuf, qcwat_idx, qcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, tcwat_idx, tcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, lcwat_idx, lcwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, iccwat_idx, iccwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, nlwat_idx, nlwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, niwat_idx, niwat, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+ call pbuf_get_field(pbuf, cc_t_idx, cc_t, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, cc_qv_idx, cc_qv, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, cc_ql_idx, cc_ql, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, cc_qi_idx, cc_qi, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, cc_nl_idx, cc_nl, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, cc_ni_idx, cc_ni, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, cc_qlst_idx, cc_qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+ call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, aist_idx, aist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, alst_idx, alst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, qist_idx, qist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, qlst_idx, qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+ call pbuf_get_field(pbuf, cmeliq_idx, cmeliq)
+
+! For purposes of convective ql.
+
+ call pbuf_get_field(pbuf, fice_idx, fice_ql )
+
+ call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh)
+
+ ! check that qcwat and tcwat were initialized; if not then do it now.
+ if (qcwat(1,1) == huge(1._r8)) then
+ qcwat(:ncol,:) = state%q(:ncol,:,1)
+ end if
+ if (tcwat(1,1) == huge(1._r8)) then
+ tcwat(:ncol,:) = state%t(:ncol,:)
+ end if
+
+ ! Initialize convective detrainment tendency
+
+ dlf_T(:,:) = 0._r8
+ dlf_qv(:,:) = 0._r8
+ dlf_ql(:,:) = 0._r8
+ dlf_qi(:,:) = 0._r8
+ dlf_nl(:,:) = 0._r8
+ dlf_ni(:,:) = 0._r8
+
+ ! ------------------------------------- !
+ ! From here, process computation begins !
+ ! ------------------------------------- !
+
+ ! ----------------------------------------------------------------------------- !
+ ! Detrainment of convective condensate into the environment or stratiform cloud !
+ ! ----------------------------------------------------------------------------- !
+
+ lq(:) = .FALSE.
+ lq(ixcldliq) = .TRUE.
+ lq(ixcldice) = .TRUE.
+ lq(ixnumliq) = .TRUE.
+ lq(ixnumice) = .TRUE.
+ call physics_ptend_init(ptend_loc, state%psetcols, 'pcwdetrain', ls=.true., lq=lq) ! Initialize local physics_ptend object
+
+ ! Procedures :
+ ! (1) Partition detrained convective cloud water into liquid and ice based on T.
+ ! This also involves heating.
+ ! If convection scheme can handle this internally, this step is not necssary.
+ ! (2) Assuming a certain effective droplet radius, computes number concentration
+ ! of detrained convective cloud liquid and ice.
+ ! (3) If 'cu_det_st = .true' ('false'), detrain convective cloud 'liquid' into
+ ! the pre-existing 'liquid' stratus ( mean environment ). The former does
+ ! not involve any macrophysical evaporation while the latter does. This is
+ ! a kind of 'targetted' deposition. Then, force in-stratus LWC to be bounded
+ ! by qcst_min and qcst_max in mmacro_pcond.
+ ! (4) In contrast to liquid, convective ice is detrained into the environment
+ ! and involved in the sublimation. Similar bounds as liquid stratus are imposed.
+ ! This is the key procesure generating upper-level cirrus clouds.
+ ! The unit of dlf : [ kg/kg/s ]
+
+ if (zmconv_microp) then
+ call pbuf_get_field(pbuf, dlfzm_idx, dlfzm)
+ call pbuf_get_field(pbuf, difzm_idx, difzm)
+ call pbuf_get_field(pbuf, dnlfzm_idx, dnlfzm)
+ call pbuf_get_field(pbuf, dnifzm_idx, dnifzm)
+ end if
+
+ det_s(:) = 0._r8
+ det_ice(:) = 0._r8
+
+ dpdlfliq = 0._r8
+ dpdlfice = 0._r8
+ shdlfliq = 0._r8
+ shdlfice = 0._r8
+ dpdlft = 0._r8
+ shdlft = 0._r8
+
+ do k = top_lev, pver
+ do i = 1, state_loc%ncol
+ if( state_loc%t(i,k) > 268.15_r8 ) then
+ dum1 = 0.0_r8
+ elseif( state_loc%t(i,k) < 238.15_r8 ) then
+ dum1 = 1.0_r8
+ else
+ dum1 = ( 268.15_r8 - state_loc%t(i,k) ) / 30._r8
+ endif
+
+ ! If detrainment was done elsewhere, still update the variables used for output
+ ! assuming that the temperature split between liquid and ice is the same as assumed
+ ! here.
+ if (zmconv_microp) then
+ ptend_loc%q(i,k,ixcldliq) = dlfzm(i,k) + dlf2(i,k) * ( 1._r8 - dum1 )
+ ptend_loc%q(i,k,ixcldice) = difzm(i,k) + dlf2(i,k) * dum1
+
+ ptend_loc%q(i,k,ixnumliq) = dnlfzm(i,k) + 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) &
+ / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection
+ ptend_loc%q(i,k,ixnumice) = dnifzm(i,k) + 3._r8 * ( dlf2(i,k) * dum1 ) &
+ / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection
+ ptend_loc%s(i,k) = dlf2(i,k) * dum1 * latice
+
+ else
+ if (do_detrain) then
+ ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 )
+ ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1
+ ! dum2 = dlf(i,k) * ( 1._r8 - dum1 )
+ ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) / &
+ (4._r8*3.14_r8* 8.e-6_r8**3*997._r8) + & ! Deep Convection
+ 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) / &
+ (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection
+ ! dum2 = dlf(i,k) * dum1
+ ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) / &
+ (4._r8*3.14_r8*25.e-6_r8**3*500._r8) + & ! Deep Convection
+ 3._r8 * ( dlf2(i,k) * dum1 ) / &
+ (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection
+ ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice
+ else
+ ptend_loc%q(i,k,ixcldliq) = 0._r8
+ ptend_loc%q(i,k,ixcldice) = 0._r8
+ ptend_loc%q(i,k,ixnumliq) = 0._r8
+ ptend_loc%q(i,k,ixnumice) = 0._r8
+ ptend_loc%s(i,k) = 0._r8
+ end if
+
+
+ end if
+
+ ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep
+ ! track of the integrals of ice and static energy that is effected from conversion to ice
+ ! so that the energy checker doesn't complain.
+ det_s(i) = det_s(i) + ptend_loc%s(i,k)*state_loc%pdel(i,k)/gravit
+ det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state_loc%pdel(i,k)/gravit
+
+ ! Targetted detrainment of convective liquid water either directly into the
+ ! existing liquid stratus or into the environment.
+ if( cu_det_st ) then
+ dlf_T(i,k) = ptend_loc%s(i,k)/cpair
+ dlf_qv(i,k) = 0._r8
+ dlf_ql(i,k) = ptend_loc%q(i,k,ixcldliq)
+ dlf_qi(i,k) = ptend_loc%q(i,k,ixcldice)
+ dlf_nl(i,k) = ptend_loc%q(i,k,ixnumliq)
+ dlf_ni(i,k) = ptend_loc%q(i,k,ixnumice)
+ ptend_loc%q(i,k,ixcldliq) = 0._r8
+ ptend_loc%q(i,k,ixcldice) = 0._r8
+ ptend_loc%q(i,k,ixnumliq) = 0._r8
+ ptend_loc%q(i,k,ixnumice) = 0._r8
+ ptend_loc%s(i,k) = 0._r8
+ dpdlfliq(i,k) = 0._r8
+ dpdlfice(i,k) = 0._r8
+ shdlfliq(i,k) = 0._r8
+ shdlfice(i,k) = 0._r8
+ dpdlft (i,k) = 0._r8
+ shdlft (i,k) = 0._r8
+ else
+ if (zmconv_microp) then
+ dpdlfliq(i,k) = dlfzm(i,k)
+ dpdlfice(i,k) = difzm(i,k)
+ dpdlft (i,k) = 0._r8
+ else
+ dpdlfliq(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( 1._r8 - dum1 )
+ dpdlfice(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( dum1 )
+ dpdlft (i,k) = ( dlf(i,k) - dlf2(i,k) ) * dum1 * latice/cpair
+ end if
+
+ shdlfliq(i,k) = dlf2(i,k) * ( 1._r8 - dum1 )
+ shdlfice(i,k) = dlf2(i,k) * ( dum1 )
+ shdlft (i,k) = dlf2(i,k) * dum1 * latice/cpair
+!AL
+ dpdlfnc(i,k) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) / (4._r8*3.14_r8* 8.e-6_r8**3*997._r8) ! Deep Convection liq
+ dpdlfni(i,k) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) / (4._r8*3.14_r8*25.e-6_r8**3*500._r8) ! Deep Convection ice
+ shdlfnc(i,k) = 3._r8 * ( dlf2(i,k)* ( 1._r8 - dum1 ) ) / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection liq
+ shdlfni(i,k) = 3._r8 * ( dlf2(i,k)* dum1 ) / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection ice
+!AL
+ endif
+ end do
+ end do
+
+ call outfld( 'DPDLFLIQ ', dpdlfliq, pcols, lchnk )
+ call outfld( 'DPDLFICE ', dpdlfice, pcols, lchnk )
+ call outfld( 'SHDLFLIQ ', shdlfliq, pcols, lchnk )
+ call outfld( 'SHDLFICE ', shdlfice, pcols, lchnk )
+ call outfld( 'DPDLFT ', dpdlft , pcols, lchnk )
+ call outfld( 'SHDLFT ', shdlft , pcols, lchnk )
+!AL
+ call outfld( 'DPDLFNC ', dpdlfnc, pcols, lchnk )
+ call outfld( 'DPDLFNI ', dpdlfni, pcols, lchnk )
+ call outfld( 'SHDLFNC ', shdlfnc, pcols, lchnk )
+ call outfld( 'SHDLFNI ', shdlfni, pcols, lchnk )
+!AL
+ call outfld( 'ZMDLF', dlf , pcols, state_loc%lchnk )
+
+ det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water
+
+ ! Add the detrainment tendency to the output tendency
+ call physics_ptend_init(ptend, state%psetcols, 'macrop')
+ call physics_ptend_sum(ptend_loc, ptend, ncol)
+
+ ! update local copy of state with the detrainment tendency
+ ! ptend_loc is reset to zero by this call
+ call physics_update(state_loc, ptend_loc, dtime)
+
+ ! -------------------------------------- !
+ ! Computation of Various Cloud Fractions !
+ ! -------------------------------------- !
+
+ ! ----------------------------------------------------------------------------- !
+ ! Treatment of cloud fraction in CAM4 and CAM5 differs !
+ ! (1) CAM4 !
+ ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + !
+ ! Shallow Cumulus AMT ( empirical fcn of mass flux ) !
+ ! . Stratus AMT = max( RH stratus AMT, Stability Stratus AMT ) !
+ ! . Cumulus and Stratus are 'minimally' overlapped without hierarchy. !
+ ! . Cumulus LWC,IWC is assumed to be the same as Stratus LWC,IWC !
+ ! (2) CAM5 !
+ ! . Cumulus AMT = Deep Cumulus AMT ( empirical fcn of mass flux ) + !
+ ! Shallow Cumulus AMT ( internally fcn of mass flux and w ) !
+ ! . Stratus AMT = fcn of environmental-mean RH ( no Stability Stratus ) !
+ ! . Cumulus and Stratus are non-overlapped with higher priority on Cumulus !
+ ! . Cumulus ( both Deep and Shallow ) has its own LWC and IWC. !
+ ! ----------------------------------------------------------------------------- !
+
+ concld_old(:ncol,top_lev:pver) = concld(:ncol,top_lev:pver)
+
+ nullify(tke, qtl_flx, qti_flx, cmfr_det, qlr_det, qir_det)
+ if (tke_idx > 0) call pbuf_get_field(pbuf, tke_idx, tke)
+ if (qtl_flx_idx > 0) call pbuf_get_field(pbuf, qtl_flx_idx, qtl_flx)
+ if (qti_flx_idx > 0) call pbuf_get_field(pbuf, qti_flx_idx, qti_flx)
+ if (cmfr_det_idx > 0) call pbuf_get_field(pbuf, cmfr_det_idx, cmfr_det)
+ if (qlr_det_idx > 0) call pbuf_get_field(pbuf, qlr_det_idx, qlr_det)
+ if (qir_det_idx > 0) call pbuf_get_field(pbuf, qir_det_idx, qir_det)
+
+ clrw_old(:ncol,:top_lev-1) = 0._r8
+ clri_old(:ncol,:top_lev-1) = 0._r8
+ do k = top_lev, pver
+ do i = 1, ncol
+ clrw_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - alst(i,k) ) )
+ clri_old(i,k) = max( 0._r8, min( 1._r8, 1._r8 - concld(i,k) - ast(i,k) ) )
+ end do
+ end do
+
+ if( use_shfrc ) then
+ call pbuf_get_field(pbuf, shfrc_idx, shfrc )
+ else
+ allocate(shfrc(pcols,pver))
+ shfrc(:,:) = 0._r8
+ endif
+
+ ! CAM5 only uses 'concld' output from the below subroutine.
+ ! Stratus ('ast' = max(alst,aist)) and total cloud fraction ('cld = ast + concld')
+ ! will be computed using this updated 'concld' in the stratiform macrophysics
+ ! scheme (mmacro_pcond) later below.
+
+ call t_startf("cldfrc")
+
+ call cldfrc( lchnk, ncol, pbuf, &
+ state_loc%pmid, state_loc%t, state_loc%q(:,:,1), state_loc%omega, &
+ state_loc%phis, shfrc, use_shfrc, &
+ cld, rhcloud, clc, state_loc%pdel, &
+ cmfmc, cmfmc_sh, landfrac,snowh, concld, cldst, &
+ ts, sst, state_loc%pint(:,pverp), zdu, ocnfrac, rhu00, &
+ state_loc%q(:,:,ixcldice), icecldf, liqcldf, &
+ relhum, 0 )
+
+ call t_stopf("cldfrc")
+
+ ! ---------------------------------------------- !
+ ! Stratiform Cloud Macrophysics and Microphysics !
+ ! ---------------------------------------------- !
+
+ lchnk = state_loc%lchnk
+ ncol = state_loc%ncol
+ rdtime = 1._r8/dtime
+
+ ! Define fractional amount of stratus condensate and precipitation in ice phase.
+ ! This uses a ramp ( -30 ~ -10 for fice, -5 ~ 0 for fsnow ).
+ ! The ramp within convective cloud may be different
+
+ call cldfrc_fice( ncol, state_loc%t, fice, fsnow )
+
+
+ lq(:) = .FALSE.
+
+ lq(1) = .true.
+ lq(ixcldice) = .true.
+ lq(ixcldliq) = .true.
+
+ lq(ixnumliq) = .true.
+ lq(ixnumice) = .true.
+
+ ! Initialize local physics_ptend object again
+ call physics_ptend_init(ptend_loc, state%psetcols, 'macro_park', &
+ ls=.true., lq=lq )
+
+ ! --------------------------------- !
+ ! Liquid Macrop_Driver Macrophysics !
+ ! --------------------------------- !
+
+ call t_startf('mmacro_pcond')
+
+ zeros(:ncol,top_lev:pver) = 0._r8
+ qc(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixcldliq)
+ qi(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixcldice)
+ nc(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumliq)
+ ni(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,ixnumice)
+
+ ! In CAM5, 'microphysical forcing' ( CC_... ) and 'the other advective forcings' ( ttend, ... )
+ ! are separately provided into the prognostic microp_driver macrophysics scheme. This is an
+ ! attempt to resolve in-cloud and out-cloud forcings.
+
+ if( get_nstep() .le. 1 ) then
+ tcwat(:ncol,top_lev:pver) = state_loc%t(:ncol,top_lev:pver)
+ qcwat(:ncol,top_lev:pver) = state_loc%q(:ncol,top_lev:pver,1)
+ lcwat(:ncol,top_lev:pver) = qc(:ncol,top_lev:pver) + qi(:ncol,top_lev:pver)
+ iccwat(:ncol,top_lev:pver) = qi(:ncol,top_lev:pver)
+ nlwat(:ncol,top_lev:pver) = nc(:ncol,top_lev:pver)
+ niwat(:ncol,top_lev:pver) = ni(:ncol,top_lev:pver)
+ ttend(:ncol,:) = 0._r8
+ qtend(:ncol,:) = 0._r8
+ ltend(:ncol,:) = 0._r8
+ itend(:ncol,:) = 0._r8
+ nltend(:ncol,:) = 0._r8
+ nitend(:ncol,:) = 0._r8
+ CC_T(:ncol,:) = 0._r8
+ CC_qv(:ncol,:) = 0._r8
+ CC_ql(:ncol,:) = 0._r8
+ CC_qi(:ncol,:) = 0._r8
+ CC_nl(:ncol,:) = 0._r8
+ CC_ni(:ncol,:) = 0._r8
+ CC_qlst(:ncol,:) = 0._r8
+ else
+ ttend(:ncol,top_lev:pver) = ( state_loc%t(:ncol,top_lev:pver) - tcwat(:ncol,top_lev:pver)) * rdtime &
+ - CC_T(:ncol,top_lev:pver)
+ qtend(:ncol,top_lev:pver) = ( state_loc%q(:ncol,top_lev:pver,1) - qcwat(:ncol,top_lev:pver)) * rdtime &
+ - CC_qv(:ncol,top_lev:pver)
+ ltend(:ncol,top_lev:pver) = ( qc(:ncol,top_lev:pver) + qi(:ncol,top_lev:pver) - lcwat(:ncol,top_lev:pver) ) * rdtime &
+ - (CC_ql(:ncol,top_lev:pver) + CC_qi(:ncol,top_lev:pver))
+ itend(:ncol,top_lev:pver) = ( qi(:ncol,top_lev:pver) - iccwat(:ncol,top_lev:pver)) * rdtime &
+ - CC_qi(:ncol,top_lev:pver)
+ nltend(:ncol,top_lev:pver) = ( nc(:ncol,top_lev:pver) - nlwat(:ncol,top_lev:pver)) * rdtime &
+ - CC_nl(:ncol,top_lev:pver)
+ nitend(:ncol,top_lev:pver) = ( ni(:ncol,top_lev:pver) - niwat(:ncol,top_lev:pver)) * rdtime &
+ - CC_ni(:ncol,top_lev:pver)
+ endif
+ lmitend(:ncol,top_lev:pver) = ltend(:ncol,top_lev:pver) - itend(:ncol,top_lev:pver)
+
+ t_inout(:ncol,top_lev:pver) = tcwat(:ncol,top_lev:pver)
+ qv_inout(:ncol,top_lev:pver) = qcwat(:ncol,top_lev:pver)
+ ql_inout(:ncol,top_lev:pver) = lcwat(:ncol,top_lev:pver) - iccwat(:ncol,top_lev:pver)
+ qi_inout(:ncol,top_lev:pver) = iccwat(:ncol,top_lev:pver)
+ nl_inout(:ncol,top_lev:pver) = nlwat(:ncol,top_lev:pver)
+ ni_inout(:ncol,top_lev:pver) = niwat(:ncol,top_lev:pver)
+
+ ! Liquid Microp_Driver Macrophysics.
+ ! The main roles of this subroutines are
+ ! (1) compute net condensation rate of stratiform liquid ( cmeliq )
+ ! (2) compute liquid stratus and ice stratus fractions.
+ ! Note 'ttend...' are advective tendencies except microphysical process while
+ ! 'CC...' are microphysical tendencies.
+
+ call mmacro_pcond( lchnk, ncol, dtime, state_loc%pmid, state_loc%pdel, &
+ t_inout, qv_inout, ql_inout, qi_inout, nl_inout, ni_inout, &
+ ttend, qtend, lmitend, itend, nltend, nitend, &
+ CC_T, CC_qv, CC_ql, CC_qi, CC_nl, CC_ni, CC_qlst, &
+ dlf_T, dlf_qv, dlf_ql, dlf_qi, dlf_nl, dlf_ni, &
+ concld_old, concld, clrw_old, clri_old, landfrac, snowh, &
+ tke, qtl_flx, qti_flx, cmfr_det, qlr_det, qir_det, &
+ tlat, qvlat, qcten, qiten, ncten, niten, &
+ cmeliq, qvadj, qladj, qiadj, qllim, qilim, &
+ cld, alst, aist, qlst, qist, do_cldice )
+
+ ! Copy of concld/fice to put in physics buffer
+ ! Below are used only for convective cloud.
+
+ fice_ql(:ncol,:top_lev-1) = 0._r8
+ fice_ql(:ncol,top_lev:pver) = fice(:ncol,top_lev:pver)
+
+
+ ! Compute net stratus fraction using maximum over-lapping assumption
+ ast(:ncol,:top_lev-1) = 0._r8
+ ast(:ncol,top_lev:pver) = max( alst(:ncol,top_lev:pver), aist(:ncol,top_lev:pver) )
+
+ call t_stopf('mmacro_pcond')
+
+ do k = top_lev, pver
+ do i = 1, ncol
+ ptend_loc%s(i,k) = tlat(i,k)
+ ptend_loc%q(i,k,1) = qvlat(i,k)
+ ptend_loc%q(i,k,ixcldliq) = qcten(i,k)
+ ptend_loc%q(i,k,ixcldice) = qiten(i,k)
+ ptend_loc%q(i,k,ixnumliq) = ncten(i,k)
+ ptend_loc%q(i,k,ixnumice) = niten(i,k)
+
+ ! Check to make sure that the macrophysics code is respecting the flags that control
+ ! whether cldwat should be prognosing cloud ice and cloud liquid or not.
+ if ((.not. do_cldice) .and. (qiten(i,k) /= 0.0_r8)) then
+ call endrun("macrop_driver:ERROR - "// &
+ "Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice mass tendencies.")
+ end if
+ if ((.not. do_cldice) .and. (niten(i,k) /= 0.0_r8)) then
+ call endrun("macrop_driver:ERROR -"// &
+ " Cldwat is configured not to prognose cloud ice, but mmacro_pcond has ice number tendencies.")
+ end if
+
+ if ((.not. do_cldliq) .and. (qcten(i,k) /= 0.0_r8)) then
+ call endrun("macrop_driver:ERROR - "// &
+ "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid mass tendencies.")
+ end if
+ if ((.not. do_cldliq) .and. (ncten(i,k) /= 0.0_r8)) then
+ call endrun("macrop_driver:ERROR - "// &
+ "Cldwat is configured not to prognose cloud liquid, but mmacro_pcond has liquid number tendencies.")
+ end if
+ end do
+ end do
+
+ ! update the output tendencies with the mmacro_pcond tendencies
+ call physics_ptend_sum(ptend_loc, ptend, ncol)
+
+ ! state_loc is the equlibrium state after macrophysics
+ call physics_update(state_loc, ptend_loc, dtime)
+
+ call outfld('CLR_LIQ', clrw_old, pcols, lchnk)
+ call outfld('CLR_ICE', clri_old, pcols, lchnk)
+
+ call outfld( 'MACPDT ', tlat , pcols, lchnk )
+ call outfld( 'MACPDQ ', qvlat, pcols, lchnk )
+ call outfld( 'MACPDLIQ ', qcten, pcols, lchnk )
+ call outfld( 'MACPDICE ', qiten, pcols, lchnk )
+ call outfld( 'CLDVAPADJ', qvadj, pcols, lchnk )
+ call outfld( 'CLDLIQADJ', qladj, pcols, lchnk )
+ call outfld( 'CLDICEADJ', qiadj, pcols, lchnk )
+ call outfld( 'CLDLIQDET', dlf_ql, pcols, lchnk )
+ call outfld( 'CLDICEDET', dlf_qi, pcols, lchnk )
+ call outfld( 'CLDLIQLIM', qllim, pcols, lchnk )
+ call outfld( 'CLDICELIM', qilim, pcols, lchnk )
+
+ call outfld( 'ICECLDF ', aist, pcols, lchnk )
+ call outfld( 'LIQCLDF ', alst, pcols, lchnk )
+ call outfld( 'AST', ast, pcols, lchnk )
+
+ call outfld( 'CONCLD ', concld, pcols, lchnk )
+ call outfld( 'CLDST ', cldst, pcols, lchnk )
+
+ call outfld( 'CMELIQ' , cmeliq, pcols, lchnk )
+
+!AL
+ call outfld( 'MACPDNC ', ncten, pcols, lchnk )
+ call outfld( 'MACPDNI ', niten, pcols, lchnk )
+!AL
+
+ ! calculations and outfld calls for CLDLIQSTR, CLDICESTR, CLDLIQCON, CLDICECON for CFMIP
+
+ ! initialize local variables
+ mr_ccliq = 0._r8 !! not seen by radiation, so setting to 0
+ mr_ccice = 0._r8 !! not seen by radiation, so setting to 0
+ mr_lsliq = 0._r8
+ mr_lsice = 0._r8
+
+ do k=top_lev,pver
+ do i=1,ncol
+ if (cld(i,k) .gt. 0._r8) then
+ mr_lsliq(i,k) = state_loc%q(i,k,ixcldliq)
+ mr_lsice(i,k) = state_loc%q(i,k,ixcldice)
+ else
+ mr_lsliq(i,k) = 0._r8
+ mr_lsice(i,k) = 0._r8
+ end if
+ end do
+ end do
+
+ call outfld( 'CLDLIQSTR ', mr_lsliq, pcols, lchnk )
+ call outfld( 'CLDICESTR ', mr_lsice, pcols, lchnk )
+ call outfld( 'CLDLIQCON ', mr_ccliq, pcols, lchnk )
+ call outfld( 'CLDICECON ', mr_ccice, pcols, lchnk )
+
+ ! ------------------------------------------------- !
+ ! Save equilibrium state variables for macrophysics !
+ ! at the next time step !
+ ! ------------------------------------------------- !
+ cldsice = 0._r8
+ do k = top_lev, pver
+ tcwat(:ncol,k) = state_loc%t(:ncol,k)
+ qcwat(:ncol,k) = state_loc%q(:ncol,k,1)
+ lcwat(:ncol,k) = state_loc%q(:ncol,k,ixcldliq) + state_loc%q(:ncol,k,ixcldice)
+ iccwat(:ncol,k) = state_loc%q(:ncol,k,ixcldice)
+ nlwat(:ncol,k) = state_loc%q(:ncol,k,ixnumliq)
+ niwat(:ncol,k) = state_loc%q(:ncol,k,ixnumice)
+ cldsice(:ncol,k) = lcwat(:ncol,k) * min(1.0_r8, max(0.0_r8, (tmelt - tcwat(:ncol,k)) / 20._r8))
+ end do
+
+ call outfld( 'CLDSICE' , cldsice, pcols, lchnk )
+
+ ! ptend_loc is deallocated in physics_update above
+ call physics_state_dealloc(state_loc)
+
+end subroutine macrop_driver_tend
+
+
+! Saturation adjustment for liquid
+!
+! With CLUBB, we are seeing relative humidity with respect to water
+! greater than 1. This should not be happening and is not what the
+! microphsyics expects from the macrophysics. As a work around while
+! this issue is investigated in CLUBB, this routine will enfornce a
+! maximum RHliq of 1 everywhere in the atmosphere. Any excess water will
+! be converted into cloud drops.
+elemental subroutine liquid_macro_tend(npccn,t,p,qv,qc,nc,xxlv,deltat,stend,qvtend,qctend,nctend)
+
+ use wv_sat_methods, only: wv_sat_qsat_ice, wv_sat_qsat_water
+ use micro_mg_utils, only: rhow
+ use physconst, only: rair
+ use cldfrc2m, only: rhmini_const, rhmaxi_const
+
+ real(r8), intent(in) :: npccn !Activated number of cloud condensation nuclei
+ real(r8), intent(in) :: t !temperature (k)
+ real(r8), intent(in) :: p !pressure (pa)
+ real(r8), intent(in) :: qv !water vapor mixing ratio
+ real(r8), intent(in) :: qc !liquid mixing ratio
+ real(r8), intent(in) :: nc !liquid number concentration
+ real(r8), intent(in) :: xxlv !latent heat of vaporization
+ real(r8), intent(in) :: deltat !timestep
+ real(r8), intent(out) :: stend ! 'temperature' tendency
+ real(r8), intent(out) :: qvtend !vapor tendency
+ real(r8), intent(out) :: qctend !liquid mass tendency
+ real(r8), intent(out) :: nctend !liquid number tendency
+
+
+ real(r8) :: ESL
+ real(r8) :: QSL
+
+ stend = 0._r8
+ qvtend = 0._r8
+ qctend = 0._r8
+ nctend = 0._r8
+
+ ! calculate qsatl from t,p,q
+ call wv_sat_qsat_water(t, p, ESL, QSL)
+
+ ! Don't allow supersaturation with respect to liquid.
+ if (qv.gt.QSL) then
+
+ qctend = (qv - QSL) / deltat
+ qvtend = 0._r8 - qctend
+ stend = qctend * xxlv ! moist static energy tend...[J/kg/s] !
+
+ ! If drops exists (more than 1 L-1) and there is condensation,
+ ! do not add to number (= growth), otherwise add 6um drops.
+ !
+ ! This is somewhat arbitrary, but ensures that some reasonable droplet
+ ! size is create to remove the excess water. This could be enhanced to
+ ! look at npccn, but ideally this entire routine should go away.
+ if (nc*p/rair/t.lt.1e3_r8.and.(qc+qctend*deltat).gt.1e-18_r8) then
+ nctend = nctend + 3._r8 * qctend/(4._r8*3.14_r8*6.e-6_r8**3*rhow)
+ endif
+ endif
+end subroutine liquid_macro_tend
+
+end module macrop_driver
diff --git a/src/NorESM/micro_mg1_0.F90 b/src/NorESM/micro_mg1_0.F90
new file mode 100644
index 0000000000..880021d9ee
--- /dev/null
+++ b/src/NorESM/micro_mg1_0.F90
@@ -0,0 +1,3905 @@
+module micro_mg1_0
+
+!---------------------------------------------------------------------------------
+! Purpose:
+! MG microphysics
+!
+! Author: Andrew Gettelman, Hugh Morrison.
+! Contributions from: Xiaohong Liu and Steve Ghan
+! December 2005-May 2010
+! Description in: Morrison and Gettelman, 2008. J. Climate (MG2008)
+! Gettelman et al., 2010 J. Geophys. Res. - Atmospheres (G2010)
+! for questions contact Hugh Morrison, Andrew Gettelman
+! e-mail: morrison@ucar.edu, andrew@ucar.edu
+!
+! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice
+! microphysics in cooperation with the MG liquid microphysics. This is
+! controlled by the do_cldice variable.
+!
+! NOTE: If do_cldice is false, then MG microphysics should not update CLDICE
+! or NUMICE; however, it is assumed that the other microphysics scheme will have
+! updated CLDICE and NUMICE. The other microphysics should handle the following
+! processes that would have been done by MG:
+! - Detrainment (liquid and ice)
+! - Homogeneous ice nucleation
+! - Heterogeneous ice nucleation
+! - Bergeron process
+! - Melting of ice
+! - Freezing of cloud drops
+! - Autoconversion (ice -> snow)
+! - Growth/Sublimation of ice
+! - Sedimentation of ice
+!---------------------------------------------------------------------------------
+! modification for sub-columns, HM, (orig 8/11/10)
+! This is done using the logical 'microp_uniform' set to .true. = uniform for subcolumns
+!---------------------------------------------------------------------------------
+
+! Procedures required:
+! 1) An implementation of the gamma function (if not intrinsic).
+! 2) saturation vapor pressure to specific humidity formula
+! 3) svp over water
+! 4) svp over ice
+
+#ifndef HAVE_GAMMA_INTRINSICS
+use shr_spfn_mod, only: gamma => shr_spfn_gamma
+#endif
+
+ use wv_sat_methods, only: &
+ svp_water => wv_sat_svp_water, &
+ svp_ice => wv_sat_svp_ice, &
+ svp_to_qsat => wv_sat_svp_to_qsat
+
+ use phys_control, only: phys_getopts
+
+implicit none
+private
+save
+
+! Note: The liu_in option has been removed, as there was a serious bug with this
+! option being set to false. The code now behaves as if the default liu_in=.true.
+! is always on. Addition/reinstatement of ice nucleation options will likely be
+! done outside of this module.
+
+public :: &
+ micro_mg_init, &
+ micro_mg_get_cols, &
+ micro_mg_tend
+
+integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real
+
+real(r8) :: g !gravity
+real(r8) :: r !Dry air Gas constant
+real(r8) :: rv !water vapor gas contstant
+real(r8) :: cpp !specific heat of dry air
+real(r8) :: rhow !density of liquid water
+real(r8) :: tmelt ! Freezing point of water (K)
+real(r8) :: xxlv ! latent heat of vaporization
+real(r8) :: xlf !latent heat of freezing
+real(r8) :: xxls !latent heat of sublimation
+
+real(r8) :: rhosn ! bulk density snow
+real(r8) :: rhoi ! bulk density ice
+
+real(r8) :: ac,bc,as,bs,ai,bi,ar,br !fall speed parameters
+real(r8) :: ci,di !ice mass-diameter relation parameters
+real(r8) :: cs,ds !snow mass-diameter relation parameters
+real(r8) :: cr,dr !drop mass-diameter relation parameters
+real(r8) :: f1s,f2s !ventilation param for snow
+real(r8) :: Eii !collection efficiency aggregation of ice
+real(r8) :: Ecr !collection efficiency cloud droplets/rain
+real(r8) :: f1r,f2r !ventilation param for rain
+real(r8) :: DCS !autoconversion size threshold
+real(r8) :: qsmall !min mixing ratio
+real(r8) :: bimm,aimm !immersion freezing
+real(r8) :: rhosu !typical 850mn air density
+real(r8) :: mi0 ! new crystal mass
+real(r8) :: rin ! radius of contact nuclei
+real(r8) :: pi ! pi
+
+! Additional constants to help speed up code
+
+real(r8) :: cons1
+real(r8) :: cons4
+real(r8) :: cons5
+real(r8) :: cons6
+real(r8) :: cons7
+real(r8) :: cons8
+real(r8) :: cons11
+real(r8) :: cons13
+real(r8) :: cons14
+real(r8) :: cons16
+real(r8) :: cons17
+real(r8) :: cons22
+real(r8) :: cons23
+real(r8) :: cons24
+real(r8) :: cons25
+real(r8) :: cons27
+real(r8) :: cons28
+
+real(r8) :: lammini
+real(r8) :: lammaxi
+real(r8) :: lamminr
+real(r8) :: lammaxr
+real(r8) :: lammins
+real(r8) :: lammaxs
+
+! parameters for snow/rain fraction for convective clouds
+real(r8) :: tmax_fsnow ! max temperature for transition to convective snow
+real(r8) :: tmin_fsnow ! min temperature for transition to convective snow
+
+!needed for findsp
+real(r8) :: tt0 ! Freezing temperature
+
+real(r8) :: csmin,csmax,minrefl,mindbz
+
+real(r8) :: rhmini ! Minimum rh for ice cloud fraction > 0.
+
+logical :: use_hetfrz_classnuc ! option to use heterogeneous freezing
+
+character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method
+real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor
+
+! Switches for specification rather than prediction of droplet and crystal number
+! note: number will be adjusted as needed to keep mean size within bounds,
+! even when specified droplet or ice number is used
+!
+! If constant cloud ice number is set (nicons = .true.),
+! then all microphysical processes except mass transfer due to ice nucleation
+! (mnuccd) are based on the fixed cloud ice number. Calculation of
+! mnuccd follows from the prognosed ice crystal number ni.
+logical :: nccons ! nccons=.true. to specify constant cloud droplet number
+logical :: nicons ! nicons=.true. to specify constant cloud ice number
+
+! parameters for specified ice and droplet number concentration
+! note: these are local in-cloud values, not grid-mean
+real(r8) :: ncnst ! droplet num concentration when nccons=.true. (m-3)
+real(r8) :: ninst ! ice num concentration when nicons=.true. (m-3)
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine micro_mg_init( &
+ kind, gravit, rair, rh2o, cpair, &
+ rhoh2o, tmelt_in, latvap, latice, &
+ rhmini_in, micro_mg_dcs, use_hetfrz_classnuc_in, &
+ micro_mg_precip_frac_method_in, micro_mg_berg_eff_factor_in, &
+ nccons_in, nicons_in, ncnst_in, ninst_in, errstring)
+
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! initialize constants for the morrison microphysics
+!
+! Author: Andrew Gettelman Dec 2005
+!
+!-----------------------------------------------------------------------
+
+integer, intent(in) :: kind ! Kind used for reals
+real(r8), intent(in) :: gravit
+real(r8), intent(in) :: rair
+real(r8), intent(in) :: rh2o
+real(r8), intent(in) :: cpair
+real(r8), intent(in) :: rhoh2o
+real(r8), intent(in) :: tmelt_in ! Freezing point of water (K)
+real(r8), intent(in) :: latvap
+real(r8), intent(in) :: latice
+real(r8), intent(in) :: rhmini_in ! Minimum rh for ice cloud fraction > 0.
+real(r8), intent(in) :: micro_mg_dcs
+logical, intent(in) :: use_hetfrz_classnuc_in
+character(len=16),intent(in) :: micro_mg_precip_frac_method_in ! type of precipitation fraction method
+real(r8), intent(in) :: micro_mg_berg_eff_factor_in ! berg efficiency factor
+logical, intent(in) :: nccons_in
+logical, intent(in) :: nicons_in
+real(r8), intent(in) :: ncnst_in
+real(r8), intent(in) :: ninst_in
+
+character(128), intent(out) :: errstring ! Output status (non-blank for error return)
+
+integer k
+
+integer l,m, iaer
+real(r8) surften ! surface tension of water w/respect to air (N/m)
+real(r8) arg
+!-----------------------------------------------------------------------
+
+errstring = ' '
+
+if( kind .ne. r8 ) then
+ errstring = 'micro_mg_init: KIND of reals does not match'
+ return
+end if
+
+!declarations for morrison codes (transforms variable names)
+
+g= gravit !gravity
+r= rair !Dry air Gas constant: note units(phys_constants are in J/K/kmol)
+rv= rh2o !water vapor gas contstant
+cpp = cpair !specific heat of dry air
+rhow = rhoh2o !density of liquid water
+tmelt = tmelt_in
+rhmini = rhmini_in
+micro_mg_precip_frac_method = micro_mg_precip_frac_method_in
+micro_mg_berg_eff_factor = micro_mg_berg_eff_factor_in
+
+nccons = nccons_in
+nicons = nicons_in
+ncnst = ncnst_in
+ninst = ninst_in
+
+! latent heats
+
+xxlv = latvap ! latent heat vaporization
+xlf = latice ! latent heat freezing
+xxls = xxlv + xlf ! latent heat of sublimation
+
+! flags
+use_hetfrz_classnuc = use_hetfrz_classnuc_in
+
+! parameters for snow/rain fraction for convective clouds
+
+tmax_fsnow = tmelt
+tmin_fsnow = tmelt-5._r8
+
+! parameters below from Reisner et al. (1998)
+! density parameters (kg/m3)
+
+rhosn = 250._r8 ! bulk density snow (++ ceh)
+rhoi = 500._r8 ! bulk density ice
+rhow = 1000._r8 ! bulk density liquid
+
+
+! fall speed parameters, V = aD^b
+! V is in m/s
+
+! droplets
+ac = 3.e7_r8
+bc = 2._r8
+
+! snow
+as = 11.72_r8
+bs = 0.41_r8
+
+! cloud ice
+ai = 700._r8
+bi = 1._r8
+
+! rain
+ar = 841.99667_r8
+br = 0.8_r8
+
+! particle mass-diameter relationship
+! currently we assume spherical particles for cloud ice/snow
+! m = cD^d
+
+pi= 3.1415927_r8
+
+! cloud ice mass-diameter relationship
+
+ci = rhoi*pi/6._r8
+di = 3._r8
+
+! snow mass-diameter relationship
+
+cs = rhosn*pi/6._r8
+ds = 3._r8
+
+! drop mass-diameter relationship
+
+cr = rhow*pi/6._r8
+dr = 3._r8
+
+! ventilation parameters for snow
+! hall and prupacher
+
+f1s = 0.86_r8
+f2s = 0.28_r8
+
+! collection efficiency, aggregation of cloud ice and snow
+
+Eii = 0.1_r8
+
+! collection efficiency, accretion of cloud water by rain
+
+Ecr = 1.0_r8
+
+! ventilation constants for rain
+
+f1r = 0.78_r8
+f2r = 0.32_r8
+
+! autoconversion size threshold for cloud ice to snow (m)
+
+Dcs = micro_mg_dcs
+
+! smallest mixing ratio considered in microphysics
+
+qsmall = 1.e-18_r8
+
+! immersion freezing parameters, bigg 1953
+
+bimm = 100._r8
+aimm = 0.66_r8
+
+! typical air density at 850 mb
+
+rhosu = 85000._r8/(rair * tmelt)
+
+! mass of new crystal due to aerosol freezing and growth (kg)
+
+mi0 = 4._r8/3._r8*pi*rhoi*(10.e-6_r8)*(10.e-6_r8)*(10.e-6_r8)
+
+! radius of contact nuclei aerosol (m)
+
+rin = 0.1e-6_r8
+
+! freezing temperature
+tt0=273.15_r8
+
+pi=4._r8*atan(1.0_r8)
+
+!Range of cloudsat reflectivities (dBz) for analytic simulator
+csmin= -30._r8
+csmax= 26._r8
+mindbz = -99._r8
+! minrefl = 10._r8**(mindbz/10._r8)
+minrefl = 1.26e-10_r8
+
+! Define constants to help speed up code (limit calls to gamma function)
+
+cons1=gamma(1._r8+di)
+cons4=gamma(1._r8+br)
+cons5=gamma(4._r8+br)
+cons6=gamma(1._r8+ds)
+cons7=gamma(1._r8+bs)
+cons8=gamma(4._r8+bs)
+cons11=gamma(3._r8+bs)
+cons13=gamma(5._r8/2._r8+br/2._r8)
+cons14=gamma(5._r8/2._r8+bs/2._r8)
+cons16=gamma(1._r8+bi)
+cons17=gamma(4._r8+bi)
+cons22=(4._r8/3._r8*pi*rhow*(25.e-6_r8)**3)
+cons23=dcs**3
+cons24=dcs**2
+cons25=dcs**bs
+cons27=xxlv**2
+cons28=xxls**2
+
+lammaxi = 1._r8/10.e-6_r8
+lammini = 1._r8/(2._r8*dcs)
+lammaxr = 1._r8/20.e-6_r8
+lamminr = 1._r8/500.e-6_r8
+lammaxs = 1._r8/10.e-6_r8
+lammins = 1._r8/2000.e-6_r8
+
+end subroutine micro_mg_init
+
+!===============================================================================
+!microphysics routine for each timestep goes here...
+
+subroutine micro_mg_tend ( &
+ microp_uniform, pcols, pver, ncol, top_lev, deltatin,&
+ tn, qn, qc, qi, nc, &
+ ni, p, pdel, cldn, liqcldf, &
+ relvar, accre_enhan, &
+ icecldf, rate1ord_cw2pr_st, naai, npccnin, &
+ rndst, nacon, tlat, qvlat, qctend, &
+ qitend, nctend, nitend, effc, effc_fn, &
+ effi, prect, preci, nevapr, evapsnow, am_evp_st, &
+ prain, prodsnow, cmeout, deffi, pgamrad, &
+ lamcrad, qsout, dsout, rflx, sflx, &
+ qrout, reff_rain, reff_snow, qcsevap, qisevap, &
+ qvres, cmeiout, vtrmc, vtrmi, qcsedten, &
+ qisedten, prao, prco, mnuccco, mnuccto, &
+ msacwio, psacwso, bergso, bergo, melto, &
+ homoo, qcreso, prcio, praio, qireso, &
+ mnuccro, pracso, meltsdt, frzrdt, mnuccdo, &
+ nrout, nsout, refl, arefl, areflz, &
+ frefl, csrfl, acsrfl, fcsrfl, rercld, &
+ ncai, ncal, qrout2, qsout2, nrout2, &
+ nsout2, drout2, dsout2, freqs, freqr, &
+ nfice, prer_evap, do_cldice, errstring, &
+ tnd_qsnow, tnd_nsnow, re_ice, &
+ frzimm, frzcnt, frzdep , &
+!AL
+ nnuccco, nnuccto, npsacwso, nsubco, nprao, &
+ nprc1o, nqcsedten, nqisedten, nmelto, nhomoo, &
+ nimelto, nihomoo, nsacwio, nsubio, nprcio, &
+ npraio, nnudepo, npccno, nnuccdo, mnudepo, &
+ nctncons,nctnnbmn,nctnszmn, &
+ nctnszmx,nctnncld,nitncons,nitnszmn, &
+ nitnszmx,nitnncld)
+
+!AL
+
+! input arguments
+logical, intent(in) :: microp_uniform ! True = configure uniform for sub-columns False = use w/o sub-columns (standard)
+integer, intent(in) :: pcols ! size of column (first) index
+integer, intent(in) :: pver ! number of layers in columns
+integer, intent(in) :: ncol ! number of columns
+integer, intent(in) :: top_lev ! top level microphys is applied
+real(r8), intent(in) :: deltatin ! time step (s)
+real(r8), intent(in) :: tn(pcols,pver) ! input temperature (K)
+real(r8), intent(in) :: qn(pcols,pver) ! input h20 vapor mixing ratio (kg/kg)
+real(r8), intent(in) :: relvar(pcols,pver) ! relative variance of cloud water (-)
+real(r8), intent(in) :: accre_enhan(pcols,pver) ! optional accretion enhancement factor (-)
+
+! note: all input cloud variables are grid-averaged
+real(r8), intent(inout) :: qc(pcols,pver) ! cloud water mixing ratio (kg/kg)
+real(r8), intent(inout) :: qi(pcols,pver) ! cloud ice mixing ratio (kg/kg)
+real(r8), intent(inout) :: nc(pcols,pver) ! cloud water number conc (1/kg)
+real(r8), intent(inout) :: ni(pcols,pver) ! cloud ice number conc (1/kg)
+real(r8), intent(in) :: p(pcols,pver) ! air pressure (pa)
+real(r8), intent(in) :: pdel(pcols,pver) ! pressure difference across level (pa)
+real(r8), intent(in) :: cldn(pcols,pver) ! cloud fraction
+real(r8), intent(in) :: icecldf(pcols,pver) ! ice cloud fraction
+real(r8), intent(in) :: liqcldf(pcols,pver) ! liquid cloud fraction
+
+real(r8), intent(out) :: rate1ord_cw2pr_st(pcols,pver) ! 1st order rate for direct cw to precip conversion
+! used for scavenging
+! Inputs for aerosol activation
+real(r8), intent(in) :: naai(pcols,pver) ! ice nulceation number (from microp_aero_ts)
+real(r8), intent(in) :: npccnin(pcols,pver) ! ccn activated number tendency (from microp_aero_ts)
+real(r8), intent(in) :: rndst(pcols,pver,4) ! radius of 4 dust bins for contact freezing (from microp_aero_ts)
+real(r8), intent(in) :: nacon(pcols,pver,4) ! number in 4 dust bins for contact freezing (from microp_aero_ts)
+
+! Used with CARMA cirrus microphysics
+! (or similar external microphysics model)
+logical, intent(in) :: do_cldice ! Prognosing cldice
+
+! output arguments
+
+real(r8), intent(out) :: tlat(pcols,pver) ! latent heating rate (W/kg)
+real(r8), intent(out) :: qvlat(pcols,pver) ! microphysical tendency qv (1/s)
+real(r8), intent(out) :: qctend(pcols,pver) ! microphysical tendency qc (1/s)
+real(r8), intent(out) :: qitend(pcols,pver) ! microphysical tendency qi (1/s)
+real(r8), intent(out) :: nctend(pcols,pver) ! microphysical tendency nc (1/(kg*s))
+real(r8), intent(out) :: nitend(pcols,pver) ! microphysical tendency ni (1/(kg*s))
+real(r8), intent(out) :: effc(pcols,pver) ! droplet effective radius (micron)
+real(r8), intent(out) :: effc_fn(pcols,pver) ! droplet effective radius, assuming nc = 1.e8 kg-1
+real(r8), intent(out) :: effi(pcols,pver) ! cloud ice effective radius (micron)
+real(r8), intent(out) :: prect(pcols) ! surface precip rate (m/s)
+real(r8), intent(out) :: preci(pcols) ! cloud ice/snow precip rate (m/s)
+real(r8), intent(out) :: nevapr(pcols,pver) ! evaporation rate of rain + snow
+real(r8), intent(out) :: evapsnow(pcols,pver)! sublimation rate of snow
+real(r8), intent(out) :: am_evp_st(pcols,pver)! stratiform evaporation area
+real(r8), intent(out) :: prain(pcols,pver) ! production of rain + snow
+real(r8), intent(out) :: prodsnow(pcols,pver)! production of snow
+real(r8), intent(out) :: cmeout(pcols,pver) ! evap/sub of cloud
+real(r8), intent(out) :: deffi(pcols,pver) ! ice effective diameter for optics (radiation)
+real(r8), intent(out) :: pgamrad(pcols,pver) ! ice gamma parameter for optics (radiation)
+real(r8), intent(out) :: lamcrad(pcols,pver) ! slope of droplet distribution for optics (radiation)
+real(r8), intent(out) :: qsout(pcols,pver) ! snow mixing ratio (kg/kg)
+real(r8), intent(out) :: dsout(pcols,pver) ! snow diameter (m)
+real(r8), intent(out) :: rflx(pcols,pver+1) ! grid-box average rain flux (kg m^-2 s^-1)
+real(r8), intent(out) :: sflx(pcols,pver+1) ! grid-box average snow flux (kg m^-2 s^-1)
+real(r8), intent(out) :: qrout(pcols,pver) ! grid-box average rain mixing ratio (kg/kg)
+real(r8), intent(inout) :: reff_rain(pcols,pver) ! rain effective radius (micron)
+real(r8), intent(inout) :: reff_snow(pcols,pver) ! snow effective radius (micron)
+real(r8), intent(out) :: qcsevap(pcols,pver) ! cloud water evaporation due to sedimentation
+real(r8), intent(out) :: qisevap(pcols,pver) ! cloud ice sublimation due to sublimation
+real(r8), intent(out) :: qvres(pcols,pver) ! residual condensation term to ensure RH < 100%
+real(r8), intent(out) :: cmeiout(pcols,pver) ! grid-mean cloud ice sub/dep
+real(r8), intent(out) :: vtrmc(pcols,pver) ! mass-weighted cloud water fallspeed
+real(r8), intent(out) :: vtrmi(pcols,pver) ! mass-weighted cloud ice fallspeed
+real(r8), intent(out) :: qcsedten(pcols,pver) ! qc sedimentation tendency
+real(r8), intent(out) :: qisedten(pcols,pver) ! qi sedimentation tendency
+! microphysical process rates for output (mixing ratio tendencies)
+real(r8), intent(out) :: prao(pcols,pver) ! accretion of cloud by rain
+real(r8), intent(out) :: prco(pcols,pver) ! autoconversion of cloud to rain
+real(r8), intent(out) :: mnuccco(pcols,pver) ! mixing rat tend due to immersion freezing
+real(r8), intent(out) :: mnuccto(pcols,pver) ! mixing ratio tend due to contact freezing
+real(r8), intent(out) :: msacwio(pcols,pver) ! mixing ratio tend due to H-M splintering
+real(r8), intent(out) :: psacwso(pcols,pver) ! collection of cloud water by snow
+real(r8), intent(out) :: bergso(pcols,pver) ! bergeron process on snow
+real(r8), intent(out) :: bergo(pcols,pver) ! bergeron process on cloud ice
+real(r8), intent(out) :: melto(pcols,pver) ! melting of cloud ice
+real(r8), intent(out) :: homoo(pcols,pver) ! homogeneos freezign cloud water
+real(r8), intent(out) :: qcreso(pcols,pver) ! residual cloud condensation due to removal of excess supersat
+real(r8), intent(out) :: prcio(pcols,pver) ! autoconversion of cloud ice to snow
+real(r8), intent(out) :: praio(pcols,pver) ! accretion of cloud ice by snow
+real(r8), intent(out) :: qireso(pcols,pver) ! residual ice deposition due to removal of excess supersat
+real(r8), intent(out) :: mnuccro(pcols,pver) ! mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s)
+real(r8), intent(out) :: pracso (pcols,pver) ! mixing ratio tendency due to accretion of rain by snow (1/s)
+real(r8), intent(out) :: meltsdt(pcols,pver) ! latent heating rate due to melting of snow (W/kg)
+real(r8), intent(out) :: frzrdt (pcols,pver) ! latent heating rate due to homogeneous freezing of rain (W/kg)
+real(r8), intent(out) :: mnuccdo(pcols,pver) ! mass tendency from ice nucleation
+real(r8), intent(out) :: nrout(pcols,pver) ! rain number concentration (1/m3)
+real(r8), intent(out) :: nsout(pcols,pver) ! snow number concentration (1/m3)
+real(r8), intent(out) :: refl(pcols,pver) ! analytic radar reflectivity
+real(r8), intent(out) :: arefl(pcols,pver) !average reflectivity will zero points outside valid range
+real(r8), intent(out) :: areflz(pcols,pver) !average reflectivity in z.
+real(r8), intent(out) :: frefl(pcols,pver)
+real(r8), intent(out) :: csrfl(pcols,pver) !cloudsat reflectivity
+real(r8), intent(out) :: acsrfl(pcols,pver) !cloudsat average
+real(r8), intent(out) :: fcsrfl(pcols,pver)
+real(r8), intent(out) :: rercld(pcols,pver) ! effective radius calculation for rain + cloud
+real(r8), intent(out) :: ncai(pcols,pver) ! output number conc of ice nuclei available (1/m3)
+real(r8), intent(out) :: ncal(pcols,pver) ! output number conc of CCN (1/m3)
+real(r8), intent(out) :: qrout2(pcols,pver)
+real(r8), intent(out) :: qsout2(pcols,pver)
+real(r8), intent(out) :: nrout2(pcols,pver)
+real(r8), intent(out) :: nsout2(pcols,pver)
+real(r8), intent(out) :: drout2(pcols,pver) ! mean rain particle diameter (m)
+real(r8), intent(out) :: dsout2(pcols,pver) ! mean snow particle diameter (m)
+real(r8), intent(out) :: freqs(pcols,pver)
+real(r8), intent(out) :: freqr(pcols,pver)
+real(r8), intent(out) :: nfice(pcols,pver)
+real(r8), intent(out) :: prer_evap(pcols,pver)
+
+real(r8) :: nevapr2(pcols,pver)
+
+character(128), intent(out) :: errstring ! Output status (non-blank for error return)
+!AL
+real(r8), intent(out) :: nnuccco(pcols,pver) ! immersion freezing
+real(r8), intent(out) :: nnuccto(pcols,pver) ! contact freezing
+real(r8), intent(out) :: npsacwso(pcols,pver) ! accr. snow
+real(r8), intent(out) :: nsubco(pcols,pver) ! evaporation of droplet
+real(r8), intent(out) :: nprao(pcols,pver) ! accretion
+real(r8), intent(out) :: nprc1o(pcols,pver) ! autoconversion
+real(r8), intent(out) :: nqcsedten(pcols,pver) ! nqc sedimentation tendency
+real(r8), intent(out) :: nqisedten(pcols,pver) ! nqc sedimentation tendency
+real(r8), intent(out) :: nmelto(pcols,pver) ! melting of cloud ice
+real(r8), intent(out) :: nhomoo(pcols,pver) ! homogeneos freezign cloud water
+real(r8), intent(out) :: nimelto(pcols,pver) ! melting of cloud ice
+real(r8), intent(out) :: nihomoo(pcols,pver) ! homogeneos freezign cloud water
+real(r8), intent(out) :: nsacwio(pcols,pver) ! numb conc tend due to HM ice multiplication
+real(r8), intent(out) :: nsubio(pcols,pver) ! evaporation of cloud ice number (sublimation?)
+real(r8), intent(out) :: nprcio(pcols,pver) ! numb conc tend due to auto of cloud ice to snow
+real(r8), intent(out) :: npraio(pcols,pver) ! numb conc tend due to accr of cloud ice by snow
+real(r8), intent(out) :: nnudepo(pcols,pver) ! deposition?
+real(r8), intent(out) :: npccno(pcols,pver) ! activation
+real(r8), intent(out) :: nnuccdo(pcols,pver) ! ni nucleation
+real(r8), intent(out) :: mnudepo(pcols,pver) ! deposition (mass)
+real(r8), intent(out) :: nctncons(pcols,pver) ! nc tuning to conserve number in substeps
+real(r8), intent(out) :: nctnnbmn(pcols,pver) ! nc tuning: minimum droplet number
+real(r8), intent(out) :: nctnszmn(pcols,pver) ! nc tuning: minimum slope
+real(r8), intent(out) :: nctnszmx(pcols,pver) ! nc tuning: maximum slope
+real(r8), intent(out) :: nctnncld(pcols,pver) ! nc tuning: removal of nc when qc is zero after mg
+real(r8), intent(out) :: nitncons(pcols,pver) ! ni tuning to conserve number in substeps
+real(r8), intent(out) :: nitnszmn(pcols,pver) ! ni tuning: minimum slope
+real(r8), intent(out) :: nitnszmx(pcols,pver) ! ni tuning: maximum slope
+real(r8), intent(out) :: nitnncld(pcols,pver) ! ni tuning: removal of ni when qi is zero after mg
+!AL
+
+
+
+! Tendencies calculated by external schemes that can replace MG's native
+! process tendencies.
+
+! Used with CARMA cirrus microphysics
+! (or similar external microphysics model)
+real(r8), intent(in) :: tnd_qsnow(:,:) ! snow mass tendency (kg/kg/s)
+real(r8), intent(in) :: tnd_nsnow(:,:) ! snow number tendency (#/kg/s)
+real(r8), intent(in) :: re_ice(:,:) ! ice effective radius (m)
+
+! From external ice nucleation.
+real(r8), intent(in) :: frzimm(:,:) ! Number tendency due to immersion freezing (1/cm3)
+real(r8), intent(in) :: frzcnt(:,:) ! Number tendency due to contact freezing (1/cm3)
+real(r8), intent(in) :: frzdep(:,:) ! Number tendency due to deposition nucleation (1/cm3)
+
+! local workspace
+! all units mks unless otherwise stated
+
+! Additional constants to help speed up code
+real(r8) :: cons2
+real(r8) :: cons3
+real(r8) :: cons9
+real(r8) :: cons10
+real(r8) :: cons12
+real(r8) :: cons15
+real(r8) :: cons18
+real(r8) :: cons19
+real(r8) :: cons20
+
+! temporary variables for sub-stepping
+real(r8) :: t1(pcols,pver)
+real(r8) :: q1(pcols,pver)
+real(r8) :: qc1(pcols,pver)
+real(r8) :: qi1(pcols,pver)
+real(r8) :: nc1(pcols,pver)
+real(r8) :: ni1(pcols,pver)
+real(r8) :: tlat1(pcols,pver)
+real(r8) :: qvlat1(pcols,pver)
+real(r8) :: qctend1(pcols,pver)
+real(r8) :: qitend1(pcols,pver)
+real(r8) :: nctend1(pcols,pver)
+real(r8) :: nitend1(pcols,pver)
+real(r8) :: prect1(pcols)
+real(r8) :: preci1(pcols)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+real(r8) :: deltat ! sub-time step (s)
+real(r8) :: omsm ! number near unity for round-off issues
+real(r8) :: dto2 ! dt/2 (s)
+real(r8) :: mincld ! minimum allowed cloud fraction
+real(r8) :: q(pcols,pver) ! water vapor mixing ratio (kg/kg)
+real(r8) :: t(pcols,pver) ! temperature (K)
+real(r8) :: rho(pcols,pver) ! air density (kg m-3)
+real(r8) :: dv(pcols,pver) ! diffusivity of water vapor in air
+real(r8) :: mu(pcols,pver) ! viscocity of air
+real(r8) :: sc(pcols,pver) ! schmidt number
+real(r8) :: kap(pcols,pver) ! thermal conductivity of air
+real(r8) :: rhof(pcols,pver) ! air density correction factor for fallspeed
+real(r8) :: cldmax(pcols,pver) ! precip fraction assuming maximum overlap
+real(r8) :: cldm(pcols,pver) ! cloud fraction
+real(r8) :: icldm(pcols,pver) ! ice cloud fraction
+real(r8) :: lcldm(pcols,pver) ! liq cloud fraction
+real(r8) :: icwc(pcols) ! in cloud water content (liquid+ice)
+real(r8) :: calpha(pcols) ! parameter for cond/evap (Zhang et al. 2003)
+real(r8) :: cbeta(pcols) ! parameter for cond/evap (Zhang et al. 2003)
+real(r8) :: cbetah(pcols) ! parameter for cond/evap (Zhang et al. 2003)
+real(r8) :: cgamma(pcols) ! parameter for cond/evap (Zhang et al. 2003)
+real(r8) :: cgamah(pcols) ! parameter for cond/evap (Zhang et al. 2003)
+real(r8) :: rcgama(pcols) ! parameter for cond/evap (Zhang et al. 2003)
+real(r8) :: cmec1(pcols) ! parameter for cond/evap (Zhang et al. 2003)
+real(r8) :: cmec2(pcols) ! parameter for cond/evap (Zhang et al. 2003)
+real(r8) :: cmec3(pcols) ! parameter for cond/evap (Zhang et al. 2003)
+real(r8) :: cmec4(pcols) ! parameter for cond/evap (Zhang et al. 2003)
+real(r8) :: qtmp ! dummy qv
+real(r8) :: dum ! temporary dummy variable
+
+real(r8) :: cme(pcols,pver) ! total (liquid+ice) cond/evap rate of cloud
+
+real(r8) :: cmei(pcols,pver) ! dep/sublimation rate of cloud ice
+real(r8) :: cwml(pcols,pver) ! cloud water mixing ratio
+real(r8) :: cwmi(pcols,pver) ! cloud ice mixing ratio
+real(r8) :: nnuccd(pver) ! ice nucleation rate from deposition/cond.-freezing
+real(r8) :: mnuccd(pver) ! mass tendency from ice nucleation
+real(r8) :: qcld ! total cloud water
+real(r8) :: lcldn(pcols,pver) ! fractional coverage of new liquid cloud
+real(r8) :: lcldo(pcols,pver) ! fractional coverage of old liquid cloud
+real(r8) :: nctend_mixnuc(pcols,pver)
+real(r8) :: arg ! argument of erfc
+
+! for calculation of rate1ord_cw2pr_st
+real(r8) :: qcsinksum_rate1ord(pver) ! sum over iterations of cw to precip sink
+real(r8) :: qcsum_rate1ord(pver) ! sum over iterations of cloud water
+
+real(r8) :: alpha
+
+real(r8) :: dum1,dum2 !general dummy variables
+
+real(r8) :: npccn(pver) ! droplet activation rate
+real(r8) :: qcic(pcols,pver) ! in-cloud cloud liquid mixing ratio
+real(r8) :: qiic(pcols,pver) ! in-cloud cloud ice mixing ratio
+real(r8) :: qniic(pcols,pver) ! in-precip snow mixing ratio
+real(r8) :: qric(pcols,pver) ! in-precip rain mixing ratio
+real(r8) :: ncic(pcols,pver) ! in-cloud droplet number conc
+real(r8) :: niic(pcols,pver) ! in-cloud cloud ice number conc
+real(r8) :: nsic(pcols,pver) ! in-precip snow number conc
+real(r8) :: nric(pcols,pver) ! in-precip rain number conc
+real(r8) :: lami(pver) ! slope of cloud ice size distr
+real(r8) :: n0i(pver) ! intercept of cloud ice size distr
+real(r8) :: lamc(pver) ! slope of cloud liquid size distr
+real(r8) :: n0c(pver) ! intercept of cloud liquid size distr
+real(r8) :: lams(pver) ! slope of snow size distr
+real(r8) :: n0s(pver) ! intercept of snow size distr
+real(r8) :: lamr(pver) ! slope of rain size distr
+real(r8) :: n0r(pver) ! intercept of rain size distr
+real(r8) :: cdist1(pver) ! size distr parameter to calculate droplet freezing
+! combined size of precip & cloud drops
+real(r8) :: arcld(pcols,pver) ! averaging control flag
+real(r8) :: Actmp !area cross section of drops
+real(r8) :: Artmp !area cross section of rain
+
+real(r8) :: pgam(pver) ! spectral width parameter of droplet size distr
+real(r8) :: lammax ! maximum allowed slope of size distr
+real(r8) :: lammin ! minimum allowed slope of size distr
+real(r8) :: nacnt ! number conc of contact ice nuclei
+real(r8) :: mnuccc(pver) ! mixing ratio tendency due to freezing of cloud water
+real(r8) :: nnuccc(pver) ! number conc tendency due to freezing of cloud water
+
+real(r8) :: mnucct(pver) ! mixing ratio tendency due to contact freezing of cloud water
+real(r8) :: nnucct(pver) ! number conc tendency due to contact freezing of cloud water
+real(r8) :: msacwi(pver) ! mixing ratio tendency due to HM ice multiplication
+real(r8) :: nsacwi(pver) ! number conc tendency due to HM ice multiplication
+
+real(r8) :: prc(pver) ! qc tendency due to autoconversion of cloud droplets
+real(r8) :: nprc(pver) ! number conc tendency due to autoconversion of cloud droplets
+real(r8) :: nprc1(pver) ! qr tendency due to autoconversion of cloud droplets
+real(r8) :: nsagg(pver) ! ns tendency due to self-aggregation of snow
+real(r8) :: dc0 ! mean size droplet size distr
+real(r8) :: ds0 ! mean size snow size distr (area weighted)
+real(r8) :: eci ! collection efficiency for riming of snow by droplets
+real(r8) :: psacws(pver) ! mixing rat tendency due to collection of droplets by snow
+real(r8) :: npsacws(pver) ! number conc tendency due to collection of droplets by snow
+real(r8) :: uni ! number-weighted cloud ice fallspeed
+real(r8) :: umi ! mass-weighted cloud ice fallspeed
+real(r8) :: uns(pver) ! number-weighted snow fallspeed
+real(r8) :: ums(pver) ! mass-weighted snow fallspeed
+real(r8) :: unr(pver) ! number-weighted rain fallspeed
+real(r8) :: umr(pver) ! mass-weighted rain fallspeed
+real(r8) :: unc ! number-weighted cloud droplet fallspeed
+real(r8) :: umc ! mass-weighted cloud droplet fallspeed
+real(r8) :: pracs(pver) ! mixing rat tendency due to collection of rain by snow
+real(r8) :: npracs(pver) ! number conc tendency due to collection of rain by snow
+real(r8) :: mnuccr(pver) ! mixing rat tendency due to freezing of rain
+real(r8) :: nnuccr(pver) ! number conc tendency due to freezing of rain
+real(r8) :: pra(pver) ! mixing rat tendnency due to accretion of droplets by rain
+real(r8) :: npra(pver) ! nc tendnency due to accretion of droplets by rain
+real(r8) :: nragg(pver) ! nr tendency due to self-collection of rain
+real(r8) :: prci(pver) ! mixing rat tendency due to autoconversion of cloud ice to snow
+real(r8) :: nprci(pver) ! number conc tendency due to autoconversion of cloud ice to snow
+real(r8) :: prai(pver) ! mixing rat tendency due to accretion of cloud ice by snow
+real(r8) :: nprai(pver) ! number conc tendency due to accretion of cloud ice by snow
+real(r8) :: qvs ! liquid saturation vapor mixing ratio
+real(r8) :: qvi ! ice saturation vapor mixing ratio
+real(r8) :: dqsdt ! change of sat vapor mixing ratio with temperature
+real(r8) :: dqsidt ! change of ice sat vapor mixing ratio with temperature
+real(r8) :: ab ! correction factor for rain evap to account for latent heat
+real(r8) :: qclr ! water vapor mixing ratio in clear air
+real(r8) :: abi ! correction factor for snow sublimation to account for latent heat
+real(r8) :: epss ! 1/ sat relaxation timescale for snow
+real(r8) :: epsr ! 1/ sat relaxation timescale for rain
+real(r8) :: pre(pver) ! rain mixing rat tendency due to evaporation
+real(r8) :: prds(pver) ! snow mixing rat tendency due to sublimation
+real(r8) :: qce ! dummy qc for conservation check
+real(r8) :: qie ! dummy qi for conservation check
+real(r8) :: nce ! dummy nc for conservation check
+real(r8) :: nie ! dummy ni for conservation check
+real(r8) :: ratio ! parameter for conservation check
+real(r8) :: dumc(pcols,pver) ! dummy in-cloud qc
+real(r8) :: dumnc(pcols,pver) ! dummy in-cloud nc
+real(r8) :: dumi(pcols,pver) ! dummy in-cloud qi
+real(r8) :: dumni(pcols,pver) ! dummy in-cloud ni
+real(r8) :: dums(pcols,pver) ! dummy in-cloud snow mixing rat
+real(r8) :: dumns(pcols,pver) ! dummy in-cloud snow number conc
+real(r8) :: dumr(pcols,pver) ! dummy in-cloud rain mixing rat
+real(r8) :: dumnr(pcols,pver) ! dummy in-cloud rain number conc
+! below are parameters for cloud water and cloud ice sedimentation calculations
+real(r8) :: fr(pver)
+real(r8) :: fnr(pver)
+real(r8) :: fc(pver)
+real(r8) :: fnc(pver)
+real(r8) :: fi(pver)
+real(r8) :: fni(pver)
+real(r8) :: fs(pver)
+real(r8) :: fns(pver)
+real(r8) :: faloutr(pver)
+real(r8) :: faloutnr(pver)
+real(r8) :: faloutc(pver)
+real(r8) :: faloutnc(pver)
+real(r8) :: falouti(pver)
+real(r8) :: faloutni(pver)
+real(r8) :: falouts(pver)
+real(r8) :: faloutns(pver)
+real(r8) :: faltndr
+real(r8) :: faltndnr
+real(r8) :: faltndc
+real(r8) :: faltndnc
+real(r8) :: faltndi
+real(r8) :: faltndni
+real(r8) :: faltnds
+real(r8) :: faltndns
+real(r8) :: faltndqie
+real(r8) :: faltndqce
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+real(r8) :: relhum(pcols,pver) ! relative humidity
+real(r8) :: csigma(pcols) ! parameter for cond/evap of cloud water/ice
+real(r8) :: rgvm ! max fallspeed for all species
+real(r8) :: arn(pcols,pver) ! air density corrected rain fallspeed parameter
+real(r8) :: asn(pcols,pver) ! air density corrected snow fallspeed parameter
+real(r8) :: acn(pcols,pver) ! air density corrected cloud droplet fallspeed parameter
+real(r8) :: ain(pcols,pver) ! air density corrected cloud ice fallspeed parameter
+real(r8) :: nsubi(pver) ! evaporation of cloud ice number
+real(r8) :: nsubc(pver) ! evaporation of droplet number
+real(r8) :: nsubs(pver) ! evaporation of snow number
+real(r8) :: nsubr(pver) ! evaporation of rain number
+real(r8) :: mtime ! factor to account for droplet activation timescale
+real(r8) :: dz(pcols,pver) ! height difference across model vertical level
+
+
+!! add precip flux variables for sub-stepping
+real(r8) :: rflx1(pcols,pver+1)
+real(r8) :: sflx1(pcols,pver+1)
+
+! returns from function/subroutine calls
+real(r8) :: tsp(pcols,pver) ! saturation temp (K)
+real(r8) :: qsp(pcols,pver) ! saturation mixing ratio (kg/kg)
+real(r8) :: qsphy(pcols,pver) ! saturation mixing ratio (kg/kg): hybrid rh
+real(r8) :: qs(pcols) ! liquid-ice weighted sat mixing rat (kg/kg)
+real(r8) :: es(pcols) ! liquid-ice weighted sat vapor press (pa)
+real(r8) :: esl(pcols,pver) ! liquid sat vapor pressure (pa)
+real(r8) :: esi(pcols,pver) ! ice sat vapor pressure (pa)
+
+! sum of source/sink terms for diagnostic precip
+
+real(r8) :: qnitend(pcols,pver) ! snow mixing ratio source/sink term
+real(r8) :: nstend(pcols,pver) ! snow number concentration source/sink term
+real(r8) :: qrtend(pcols,pver) ! rain mixing ratio source/sink term
+real(r8) :: nrtend(pcols,pver) ! rain number concentration source/sink term
+real(r8) :: qrtot ! vertically-integrated rain mixing rat source/sink term
+real(r8) :: nrtot ! vertically-integrated rain number conc source/sink term
+real(r8) :: qstot ! vertically-integrated snow mixing rat source/sink term
+real(r8) :: nstot ! vertically-integrated snow number conc source/sink term
+
+! new terms for Bergeron process
+
+real(r8) :: dumnnuc ! provisional ice nucleation rate (for calculating bergeron)
+real(r8) :: ninew ! provisional cloud ice number conc (for calculating bergeron)
+real(r8) :: qinew ! provisional cloud ice mixing ratio (for calculating bergeron)
+real(r8) :: qvl ! liquid sat mixing ratio
+real(r8) :: epsi ! 1/ sat relaxation timecale for cloud ice
+real(r8) :: prd ! provisional deposition rate of cloud ice at water sat
+real(r8) :: berg(pcols,pver) ! mixing rat tendency due to bergeron process for cloud ice
+real(r8) :: bergs(pver) ! mixing rat tendency due to bergeron process for snow
+
+!bergeron terms
+real(r8) :: bergtsf !bergeron timescale to remove all liquid
+real(r8) :: rhin !modified RH for vapor deposition
+
+! diagnostic rain/snow for output to history
+! values are in-precip (local) !!!!
+
+real(r8) :: drout(pcols,pver) ! rain diameter (m)
+
+!averageed rain/snow for history
+real(r8) :: dumfice
+
+!ice nucleation, droplet activation
+real(r8) :: dum2i(pcols,pver) ! number conc of ice nuclei available (1/kg)
+real(r8) :: dum2l(pcols,pver) ! number conc of CCN (1/kg)
+real(r8) :: ncmax
+real(r8) :: nimax
+
+real(r8) :: qcvar ! 1/relative variance of sub-grid qc
+
+! loop array variables
+integer i,k,nstep,n, l
+integer ii,kk, m
+
+! loop variables for sub-step solution
+integer iter,it,ltrue(pcols)
+
+! used in contact freezing via dust particles
+real(r8) tcnt, viscosity, mfp
+real(r8) slip1, slip2, slip3, slip4
+! real(r8) dfaer1, dfaer2, dfaer3, dfaer4
+! real(r8) nacon1,nacon2,nacon3,nacon4
+real(r8) ndfaer1, ndfaer2, ndfaer3, ndfaer4
+real(r8) nslip1, nslip2, nslip3, nslip4
+
+! used in ice effective radius
+real(r8) bbi, cci, ak, iciwc, rvi
+
+! used in Bergeron processe and water vapor deposition
+real(r8) Tk, deles, Aprpr, Bprpr, Cice, qi0, Crate, qidep
+
+! mean cloud fraction over the time step
+real(r8) cldmw(pcols,pver)
+
+! used in secondary ice production
+real(r8) ni_secp
+
+! variabels to check for RH after rain evap
+
+real(r8) :: esn
+real(r8) :: qsn
+real(r8) :: ttmp
+
+
+
+real(r8) :: rainrt(pcols,pver) ! rain rate for reflectivity calculation
+real(r8) :: rainrt1(pcols,pver)
+real(r8) :: tmp
+
+real(r8) dmc,ssmc,dstrn ! variables for modal scheme.
+
+real(r8), parameter :: cdnl = 0.e6_r8 ! cloud droplet number limiter
+
+! heterogeneous freezing
+real(r8) :: mnudep(pver) ! mixing ratio tendency due to deposition of water vapor
+real(r8) :: nnudep(pver) ! number conc tendency due to deposition of water vapor
+real(r8) :: con1 ! work cnstant
+real(r8) :: r3lx ! Mean volume radius (m)
+real(r8) :: mi0l
+real(r8) :: frztmp
+
+logical :: do_clubb_sgs
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+! Return error message
+errstring = ' '
+
+call phys_getopts(do_clubb_sgs_out = do_clubb_sgs)
+
+! initialize output fields for number conc qand ice nucleation
+ncai(1:ncol,1:pver)=0._r8
+ncal(1:ncol,1:pver)=0._r8
+
+!Initialize rain size
+rercld(1:ncol,1:pver)=0._r8
+arcld(1:ncol,1:pver)=0._r8
+
+!initialize radiation output variables
+pgamrad(1:ncol,1:pver)=0._r8 ! liquid gamma parameter for optics (radiation)
+lamcrad(1:ncol,1:pver)=0._r8 ! slope of droplet distribution for optics (radiation)
+deffi (1:ncol,1:pver)=0._r8 ! slope of droplet distribution for optics (radiation)
+!initialize radiation output variables
+!initialize water vapor tendency term output
+qcsevap(1:ncol,1:pver)=0._r8
+qisevap(1:ncol,1:pver)=0._r8
+qvres (1:ncol,1:pver)=0._r8
+cmeiout (1:ncol,1:pver)=0._r8
+vtrmc (1:ncol,1:pver)=0._r8
+vtrmi (1:ncol,1:pver)=0._r8
+qcsedten (1:ncol,1:pver)=0._r8
+qisedten (1:ncol,1:pver)=0._r8
+
+prao(1:ncol,1:pver)=0._r8
+prco(1:ncol,1:pver)=0._r8
+mnuccco(1:ncol,1:pver)=0._r8
+mnuccto(1:ncol,1:pver)=0._r8
+msacwio(1:ncol,1:pver)=0._r8
+psacwso(1:ncol,1:pver)=0._r8
+bergso(1:ncol,1:pver)=0._r8
+bergo(1:ncol,1:pver)=0._r8
+melto(1:ncol,1:pver)=0._r8
+homoo(1:ncol,1:pver)=0._r8
+qcreso(1:ncol,1:pver)=0._r8
+prcio(1:ncol,1:pver)=0._r8
+praio(1:ncol,1:pver)=0._r8
+qireso(1:ncol,1:pver)=0._r8
+mnuccro(1:ncol,1:pver)=0._r8
+pracso (1:ncol,1:pver)=0._r8
+meltsdt(1:ncol,1:pver)=0._r8
+frzrdt (1:ncol,1:pver)=0._r8
+mnuccdo(1:ncol,1:pver)=0._r8
+
+!AL
+nnuccco(1:ncol,1:pver)=0._r8
+nnuccto(1:ncol,1:pver)=0._r8
+npsacwso(1:ncol,1:pver)=0._r8
+nsubco(1:ncol,1:pver)=0._r8
+nprao(1:ncol,1:pver)=0._r8
+nprc1o(1:ncol,1:pver)=0._r8
+nqcsedten(1:ncol,1:pver)=0._r8
+nmelto(1:ncol,1:pver)=0._r8
+nhomoo(1:ncol,1:pver)=0._r8
+nqisedten(1:ncol,1:pver)=0._r8
+nimelto(1:ncol,1:pver)=0._r8
+nihomoo(1:ncol,1:pver)=0._r8
+nsacwio(1:ncol,1:pver)=0._r8
+nsubio(1:ncol,1:pver)=0._r8
+nprcio(1:ncol,1:pver)=0._r8
+npraio(1:ncol,1:pver)=0._r8
+nnudepo(1:ncol,1:pver)=0._r8
+mnudepo(1:ncol,1:pver)=0._r8
+npccno(1:ncol,1:pver)=0._r8
+nnuccdo(1:ncol,1:pver)=0._r8
+nctncons(1:ncol,1:pver)=0._r8
+nctnnbmn(1:ncol,1:pver)=0._r8
+nctnszmn(1:ncol,1:pver)=0._r8
+nctnszmx(1:ncol,1:pver)=0._r8
+nctnncld(1:ncol,1:pver)=0._r8
+nitncons(1:ncol,1:pver)=0._r8
+nitnszmn(1:ncol,1:pver)=0._r8
+nitnszmx(1:ncol,1:pver)=0._r8
+nitnncld(1:ncol,1:pver)=0._r8
+
+!AL
+
+
+rflx(:,:)=0._r8
+sflx(:,:)=0._r8
+effc(:,:)=0._r8
+effc_fn(:,:)=0._r8
+effi(:,:)=0._r8
+
+! assign variable deltat for sub-stepping...
+deltat=deltatin
+
+! parameters for scheme
+
+omsm=0.99999_r8
+dto2=0.5_r8*deltat
+mincld=0.0001_r8
+
+! initialize multi-level fields
+q(1:ncol,1:pver)=qn(1:ncol,1:pver)
+t(1:ncol,1:pver)=tn(1:ncol,1:pver)
+
+! initialize time-varying parameters
+
+do k=1,pver
+ do i=1,ncol
+ rho(i,k)=p(i,k)/(r*t(i,k))
+ dv(i,k) = 8.794E-5_r8*t(i,k)**1.81_r8/p(i,k)
+ mu(i,k) = 1.496E-6_r8*t(i,k)**1.5_r8/(t(i,k)+120._r8)
+ sc(i,k) = mu(i,k)/(rho(i,k)*dv(i,k))
+ kap(i,k) = 1.414e3_r8*1.496e-6_r8*t(i,k)**1.5_r8/(t(i,k)+120._r8)
+
+ ! air density adjustment for fallspeed parameters
+ ! includes air density correction factor to the
+ ! power of 0.54 following Heymsfield and Bansemer 2007
+
+ rhof(i,k)=(rhosu/rho(i,k))**0.54_r8
+
+ arn(i,k)=ar*rhof(i,k)
+ asn(i,k)=as*rhof(i,k)
+ acn(i,k)=ac*rhof(i,k)
+ ain(i,k)=ai*rhof(i,k)
+
+ ! get dz from dp and hydrostatic approx
+ ! keep dz positive (define as layer k-1 - layer k)
+
+ dz(i,k)= pdel(i,k)/(rho(i,k)*g)
+
+ end do
+end do
+
+! initialization
+qc(1:ncol,1:top_lev-1) = 0._r8
+qi(1:ncol,1:top_lev-1) = 0._r8
+nc(1:ncol,1:top_lev-1) = 0._r8
+ni(1:ncol,1:top_lev-1) = 0._r8
+t1(1:ncol,1:pver) = t(1:ncol,1:pver)
+q1(1:ncol,1:pver) = q(1:ncol,1:pver)
+qc1(1:ncol,1:pver) = qc(1:ncol,1:pver)
+qi1(1:ncol,1:pver) = qi(1:ncol,1:pver)
+nc1(1:ncol,1:pver) = nc(1:ncol,1:pver)
+ni1(1:ncol,1:pver) = ni(1:ncol,1:pver)
+
+! initialize tendencies to zero
+tlat1(1:ncol,1:pver)=0._r8
+qvlat1(1:ncol,1:pver)=0._r8
+qctend1(1:ncol,1:pver)=0._r8
+qitend1(1:ncol,1:pver)=0._r8
+nctend1(1:ncol,1:pver)=0._r8
+nitend1(1:ncol,1:pver)=0._r8
+
+! initialize precip output
+qrout(1:ncol,1:pver)=0._r8
+qsout(1:ncol,1:pver)=0._r8
+nrout(1:ncol,1:pver)=0._r8
+nsout(1:ncol,1:pver)=0._r8
+dsout(1:ncol,1:pver)=0._r8
+
+drout(1:ncol,1:pver)=0._r8
+
+reff_rain(1:ncol,1:pver)=0._r8
+reff_snow(1:ncol,1:pver)=0._r8
+
+! initialize variables for trop_mozart
+nevapr(1:ncol,1:pver) = 0._r8
+nevapr2(1:ncol,1:pver) = 0._r8
+evapsnow(1:ncol,1:pver) = 0._r8
+prain(1:ncol,1:pver) = 0._r8
+prodsnow(1:ncol,1:pver) = 0._r8
+cmeout(1:ncol,1:pver) = 0._r8
+
+am_evp_st(1:ncol,1:pver) = 0._r8
+
+! for refl calc
+rainrt1(1:ncol,1:pver) = 0._r8
+
+! initialize precip fraction and output tendencies
+cldmax(1:ncol,1:pver)=mincld
+
+!initialize aerosol number
+! naer2(1:ncol,1:pver,:)=0._r8
+dum2l(1:ncol,1:pver)=0._r8
+dum2i(1:ncol,1:pver)=0._r8
+
+! initialize avg precip rate
+prect1(1:ncol)=0._r8
+preci1(1:ncol)=0._r8
+
+!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+!Get humidity and saturation vapor pressures
+
+do k=top_lev,pver
+
+ do i=1,ncol
+
+ ! find wet bulk temperature and saturation value for provisional t and q without
+ ! condensation
+
+ es(i) = svp_water(t(i,k))
+ qs(i) = svp_to_qsat(es(i), p(i,k))
+
+ ! Prevents negative values.
+ if (qs(i) < 0.0_r8) then
+ qs(i) = 1.0_r8
+ es(i) = p(i,k)
+ end if
+
+ esl(i,k)=svp_water(t(i,k))
+ esi(i,k)=svp_ice(t(i,k))
+
+ ! hm fix, make sure when above freezing that esi=esl, not active yet
+ if (t(i,k).gt.tmelt)esi(i,k)=esl(i,k)
+
+ relhum(i,k)=q(i,k)/qs(i)
+
+ ! get cloud fraction, check for minimum
+
+ cldm(i,k)=max(cldn(i,k),mincld)
+ cldmw(i,k)=max(cldn(i,k),mincld)
+
+ icldm(i,k)=max(icecldf(i,k),mincld)
+ lcldm(i,k)=max(liqcldf(i,k),mincld)
+
+ ! subcolumns, set cloud fraction variables to one
+ ! if cloud water or ice is present, if not present
+ ! set to mincld (mincld used instead of zero, to prevent
+ ! possible division by zero errors
+
+ if (microp_uniform) then
+
+ cldm(i,k)=mincld
+ cldmw(i,k)=mincld
+ icldm(i,k)=mincld
+ lcldm(i,k)=mincld
+
+ if (qc(i,k).ge.qsmall) then
+ lcldm(i,k)=1._r8
+ cldm(i,k)=1._r8
+ cldmw(i,k)=1._r8
+ end if
+
+ if (qi(i,k).ge.qsmall) then
+ cldm(i,k)=1._r8
+ icldm(i,k)=1._r8
+ end if
+
+ end if ! sub-columns
+
+ ! calculate nfice based on liquid and ice mmr (no rain and snow mmr available yet)
+
+ nfice(i,k)=0._r8
+ dumfice=qc(i,k)+qi(i,k)
+ if (dumfice.gt.qsmall .and. qi(i,k).gt.qsmall) then
+ nfice(i,k)=qi(i,k)/dumfice
+ endif
+
+ if (do_cldice .and. (t(i,k).lt.tmelt - 5._r8)) then
+
+ ! if aerosols interact with ice set number of activated ice nuclei
+ dum2=naai(i,k)
+
+ dumnnuc=(dum2-ni(i,k)/icldm(i,k))/deltat*icldm(i,k)
+ dumnnuc=max(dumnnuc,0._r8)
+ ! get provisional ni and qi after nucleation in order to calculate
+ ! Bergeron process below
+ ninew=ni(i,k)+dumnnuc*deltat
+ qinew=qi(i,k)+dumnnuc*deltat*mi0
+
+ !T>268
+ else
+ ninew=ni(i,k)
+ qinew=qi(i,k)
+ end if
+
+ ! Initialize CME components
+
+ cme(i,k) = 0._r8
+ cmei(i,k)=0._r8
+
+
+ !-------------------------------------------------------------------
+ !Bergeron process
+
+ ! make sure to initialize bergeron process to zero
+ berg(i,k)=0._r8
+ prd = 0._r8
+
+ !condensation loop.
+
+ ! get in-cloud qi and ni after nucleation
+ if (icldm(i,k) .gt. 0._r8) then
+ qiic(i,k)=qinew/icldm(i,k)
+ niic(i,k)=ninew/icldm(i,k)
+ else
+ qiic(i,k)=0._r8
+ niic(i,k)=0._r8
+ endif
+
+ if (nicons) then
+ niic(i,k) = ninst/rho(i,k)
+ end if
+
+ !if T < 0 C then bergeron.
+ if (do_cldice .and. (t(i,k).lt.273.15_r8)) then
+
+ !if ice exists
+ if (qi(i,k).gt.qsmall) then
+
+ bergtsf = 0._r8 ! bergeron time scale (fraction of timestep)
+
+ qvi = svp_to_qsat(esi(i,k), p(i,k))
+ qvl = svp_to_qsat(esl(i,k), p(i,k))
+
+ dqsidt = xxls*qvi/(rv*t(i,k)**2)
+ abi = 1._r8+dqsidt*xxls/cpp
+
+ ! get ice size distribution parameters
+
+ if (qiic(i,k).ge.qsmall) then
+ lami(k) = (cons1*ci* &
+ niic(i,k)/qiic(i,k))**(1._r8/di)
+ n0i(k) = niic(i,k)*lami(k)
+
+ ! check for slope
+ ! adjust vars
+ if (lami(k).lt.lammini) then
+
+ lami(k) = lammini
+ n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1)
+ else if (lami(k).gt.lammaxi) then
+ lami(k) = lammaxi
+ n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1)
+ end if
+
+ epsi = 2._r8*pi*n0i(k)*rho(i,k)*Dv(i,k)/(lami(k)*lami(k))
+
+ !if liquid exists
+ if (qc(i,k).gt. qsmall) then
+
+ !begin bergeron process
+ ! do bergeron (vapor deposition with RHw=1)
+ ! code to find berg (a rate) goes here
+
+ ! calculate Bergeron process
+
+ prd = epsi*(qvl-qvi)/abi
+
+ else
+ prd = 0._r8
+ end if
+
+ ! multiply by cloud fraction
+
+ prd = prd*min(icldm(i,k),lcldm(i,k))
+
+ ! transfer of existing cloud liquid to ice
+
+ berg(i,k)=max(0._r8,prd)
+
+ end if !end liquid exists bergeron
+
+ if (berg(i,k).gt.0._r8) then
+ bergtsf=max(0._r8,(qc(i,k)/berg(i,k))/deltat)
+
+ if(bergtsf.lt.1._r8) berg(i,k) = max(0._r8,qc(i,k)/deltat)
+
+ endif
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ if (bergtsf.lt.1._r8.or.icldm(i,k).gt.lcldm(i,k)) then
+
+ if (qiic(i,k).ge.qsmall) then
+
+ ! first case is for case when liquid water is present, but is completely depleted
+ ! in time step, i.e., bergrsf > 0 but < 1
+
+ if (qc(i,k).ge.qsmall) then
+ rhin = (1.0_r8 + relhum(i,k)) / 2._r8
+ if ((rhin*esl(i,k)/esi(i,k)) > 1._r8) then
+ prd = epsi*(rhin*qvl-qvi)/abi
+
+ ! multiply by cloud fraction assuming liquid/ice maximum overlap
+ prd = prd*min(icldm(i,k),lcldm(i,k))
+
+ ! add to cmei
+ cmei(i,k) = cmei(i,k) + (prd * (1._r8- bergtsf))
+
+ end if ! rhin
+ end if ! qc > qsmall
+
+ ! second case is for pure ice cloud, either no liquid, or icldm > lcldm
+
+ if (qc(i,k).lt.qsmall.or.icldm(i,k).gt.lcldm(i,k)) then
+
+ ! note: for case of no liquid, need to set liquid cloud fraction to zero
+ ! store liquid cloud fraction in 'dum'
+
+ if (qc(i,k).lt.qsmall) then
+ dum=0._r8
+ else
+ dum=lcldm(i,k)
+ end if
+
+ ! set RH to grid-mean value for pure ice cloud
+ rhin = relhum(i,k)
+
+ if ((rhin*esl(i,k)/esi(i,k)) > 1._r8) then
+
+ prd = epsi*(rhin*qvl-qvi)/abi
+
+ ! multiply by relevant cloud fraction for pure ice cloud
+ ! assuming maximum overlap of liquid/ice
+ prd = prd*max((icldm(i,k)-dum),0._r8)
+ cmei(i,k) = cmei(i,k) + prd
+
+ end if ! rhin
+ end if ! qc or icldm > lcldm
+ end if ! qiic
+ end if ! bergtsf or icldm > lcldm
+
+ ! if deposition, it should not reduce grid mean rhi below 1.0
+ if(cmei(i,k) > 0.0_r8 .and. (relhum(i,k)*esl(i,k)/esi(i,k)) > 1._r8 ) &
+ cmei(i,k)=min(cmei(i,k),(q(i,k)-qs(i)*esi(i,k)/esl(i,k))/abi/deltat)
+
+ end if !end ice exists loop
+ !this ends temperature < 0. loop
+
+ !-------------------------------------------------------------------
+ end if !
+ !..............................................................
+
+ ! evaporation should not exceed available water
+
+ if ((-berg(i,k)).lt.-qc(i,k)/deltat) berg(i,k) = max(qc(i,k)/deltat,0._r8)
+
+ !sublimation process...
+ if (do_cldice .and. ((relhum(i,k)*esl(i,k)/esi(i,k)).lt.1._r8 .and. qiic(i,k).ge.qsmall )) then
+
+ qvi = svp_to_qsat(esi(i,k), p(i,k))
+ qvl = svp_to_qsat(esl(i,k), p(i,k))
+ dqsidt = xxls*qvi/(rv*t(i,k)**2)
+ abi = 1._r8+dqsidt*xxls/cpp
+
+ ! get ice size distribution parameters
+
+ lami(k) = (cons1*ci* &
+ niic(i,k)/qiic(i,k))**(1._r8/di)
+ n0i(k) = niic(i,k)*lami(k)
+
+ ! check for slope
+ ! adjust vars
+ if (lami(k).lt.lammini) then
+
+ lami(k) = lammini
+ n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1)
+ else if (lami(k).gt.lammaxi) then
+ lami(k) = lammaxi
+ n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1)
+ end if
+
+ epsi = 2._r8*pi*n0i(k)*rho(i,k)*Dv(i,k)/(lami(k)*lami(k))
+
+ ! modify for ice fraction below
+ prd = epsi*(relhum(i,k)*qvl-qvi)/abi * icldm(i,k)
+ cmei(i,k)=min(prd,0._r8)
+
+ endif
+
+ ! sublimation should not exceed available ice
+ if (cmei(i,k).lt.-qi(i,k)/deltat) cmei(i,k)=-qi(i,k)/deltat
+
+ ! sublimation should not increase grid mean rhi above 1.0
+ if(cmei(i,k) < 0.0_r8 .and. (relhum(i,k)*esl(i,k)/esi(i,k)) < 1._r8 ) &
+ cmei(i,k)=min(0._r8,max(cmei(i,k),(q(i,k)-qs(i)*esi(i,k)/esl(i,k))/abi/deltat))
+
+ ! limit cmei due for roundoff error
+
+ cmei(i,k)=cmei(i,k)*omsm
+
+ ! conditional for ice nucleation
+ if (do_cldice .and. (t(i,k).lt.(tmelt - 5._r8))) then
+
+ ! using Liu et al. (2007) ice nucleation with hooks into simulated aerosol
+ ! ice nucleation rate (dum2) has already been calculated and read in (naai)
+
+ dum2i(i,k)=naai(i,k)
+ else
+ dum2i(i,k)=0._r8
+ end if
+
+ end do ! i loop
+end do ! k loop
+
+
+!! initialize sub-step precip flux variables
+do i=1,ncol
+ !! flux is zero at top interface, so these should stay as 0.
+ rflx1(i,1)=0._r8
+ sflx1(i,1)=0._r8
+ do k=top_lev,pver
+
+ ! initialize normal and sub-step precip flux variables
+ rflx1(i,k+1)=0._r8
+ sflx1(i,k+1)=0._r8
+ end do ! i loop
+end do ! k loop
+!! initialize final precip flux variables.
+do i=1,ncol
+ !! flux is zero at top interface, so these should stay as 0.
+ rflx(i,1)=0._r8
+ sflx(i,1)=0._r8
+ do k=top_lev,pver
+ ! initialize normal and sub-step precip flux variables
+ rflx(i,k+1)=0._r8
+ sflx(i,k+1)=0._r8
+ end do ! i loop
+end do ! k loop
+
+do i=1,ncol
+ ltrue(i)=0
+ do k=top_lev,pver
+ ! skip microphysical calculations if no cloud water
+
+ if (qc(i,k).ge.qsmall.or.qi(i,k).ge.qsmall.or.cmei(i,k).ge.qsmall) ltrue(i)=1
+ end do
+end do
+
+! assign number of sub-steps to iter
+! use 2 sub-steps, following tests described in MG2008
+iter = 2
+
+! get sub-step time step
+deltat=deltat/real(iter)
+
+! since activation/nucleation processes are fast, need to take into account
+! factor mtime = mixing timescale in cloud / model time step
+! mixing time can be interpreted as cloud depth divided by sub-grid vertical velocity
+! for now mixing timescale is assumed to be 1 timestep for modal aerosols, 20 min bulk
+
+! note: mtime for bulk aerosols was set to: mtime=deltat/1200._r8
+
+mtime=1._r8
+rate1ord_cw2pr_st(:,:)=0._r8 ! rce 2010/05/01
+
+!!!! skip calculations if no cloud water
+do i=1,ncol
+ if (ltrue(i).eq.0) then
+ tlat(i,1:pver)=0._r8
+ qvlat(i,1:pver)=0._r8
+ qctend(i,1:pver)=0._r8
+ qitend(i,1:pver)=0._r8
+ qnitend(i,1:pver)=0._r8
+ qrtend(i,1:pver)=0._r8
+ nctend(i,1:pver)=0._r8
+ nitend(i,1:pver)=0._r8
+ nrtend(i,1:pver)=0._r8
+ nstend(i,1:pver)=0._r8
+ prect(i)=0._r8
+ preci(i)=0._r8
+ rflx(i,1:pver+1)=0._r8
+ sflx(i,1:pver+1)=0._r8
+ qniic(i,1:pver)=0._r8
+ qric(i,1:pver)=0._r8
+ nsic(i,1:pver)=0._r8
+ nric(i,1:pver)=0._r8
+ rainrt(i,1:pver)=0._r8
+ goto 300
+ end if
+
+ qcsinksum_rate1ord(1:pver)=0._r8
+ qcsum_rate1ord(1:pver)=0._r8
+
+
+!!!!!!!!! begin sub-step!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !.....................................................................................................
+ do it=1,iter
+
+ ! initialize sub-step microphysical tendencies
+
+ tlat(i,1:pver)=0._r8
+ qvlat(i,1:pver)=0._r8
+ qctend(i,1:pver)=0._r8
+ qitend(i,1:pver)=0._r8
+ qnitend(i,1:pver)=0._r8
+ qrtend(i,1:pver)=0._r8
+ nctend(i,1:pver)=0._r8
+ nitend(i,1:pver)=0._r8
+ nrtend(i,1:pver)=0._r8
+ nstend(i,1:pver)=0._r8
+
+ ! initialize diagnostic precipitation to zero
+
+ qniic(i,1:pver)=0._r8
+ qric(i,1:pver)=0._r8
+ nsic(i,1:pver)=0._r8
+ nric(i,1:pver)=0._r8
+
+ rainrt(i,1:pver)=0._r8
+
+
+ ! begin new i,k loop, calculate new cldmax after adjustment to cldm above
+
+ ! initialize vertically-integrated rain and snow tendencies
+
+ qrtot = 0._r8
+ nrtot = 0._r8
+ qstot = 0._r8
+ nstot = 0._r8
+
+ ! initialize precip at surface
+
+ prect(i)=0._r8
+ preci(i)=0._r8
+
+ ! initialize fluxes
+ rflx(i,1:pver+1)=0._r8
+ sflx(i,1:pver+1)=0._r8
+
+ do k=top_lev,pver
+
+ qcvar=relvar(i,k)
+ cons2=gamma(qcvar+2.47_r8)
+ cons3=gamma(qcvar)
+ cons9=gamma(qcvar+2._r8)
+ cons10=gamma(qcvar+1._r8)
+ cons12=gamma(qcvar+1.15_r8)
+ cons15=gamma(qcvar+bc/3._r8)
+ cons18=qcvar**2.47_r8
+ cons19=qcvar**2
+ cons20=qcvar**1.15_r8
+
+ ! set cwml and cwmi to current qc and qi
+
+ cwml(i,k)=qc(i,k)
+ cwmi(i,k)=qi(i,k)
+
+ ! initialize precip fallspeeds to zero
+
+ ums(k)=0._r8
+ uns(k)=0._r8
+ umr(k)=0._r8
+ unr(k)=0._r8
+
+ ! calculate precip fraction based on maximum overlap assumption
+
+ ! for sub-columns cldm has already been set to 1 if cloud
+ ! water or ice is present, so cldmax will be correctly set below
+ ! and nothing extra needs to be done here
+
+ if (k.eq.top_lev) then
+ cldmax(i,k)=cldm(i,k)
+ else
+ ! if rain or snow mix ratio is smaller than
+ ! threshold, then set cldmax to cloud fraction at current level
+
+ if (do_clubb_sgs) then
+ if (qc(i,k).ge.qsmall.or.qi(i,k).ge.qsmall) then
+ cldmax(i,k)=cldm(i,k)
+ else
+ cldmax(i,k)=cldmax(i,k-1)
+ end if
+ else
+
+ if (qric(i,k-1).ge.qsmall.or.qniic(i,k-1).ge.qsmall) then
+ cldmax(i,k)=max(cldmax(i,k-1),cldm(i,k))
+ else
+ cldmax(i,k)=cldm(i,k)
+ end if
+ endif
+ end if
+
+ ! decrease in number concentration due to sublimation/evap
+ ! divide by cloud fraction to get in-cloud decrease
+ ! don't reduce Nc due to bergeron process
+
+ if (cmei(i,k) < 0._r8 .and. qi(i,k) > qsmall .and. cldm(i,k) > mincld) then
+ nsubi(k)=cmei(i,k)/qi(i,k)*ni(i,k)/cldm(i,k)
+ else
+ nsubi(k)=0._r8
+ end if
+ nsubc(k)=0._r8
+
+
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ ! ice nucleation if activated nuclei exist at t<-5C AND rhmini + 5%
+
+ if (do_cldice .and. dum2i(i,k).gt.0._r8.and.t(i,k).lt.(tmelt - 5._r8).and. &
+ relhum(i,k)*esl(i,k)/esi(i,k).gt. rhmini+0.05_r8) then
+
+ !if NCAI > 0. then set numice = ncai (as before)
+ !note: this is gridbox averaged
+
+ nnuccd(k)=(dum2i(i,k)-ni(i,k)/icldm(i,k))/deltat*icldm(i,k)
+ nnuccd(k)=max(nnuccd(k),0._r8)
+ nimax = dum2i(i,k)*icldm(i,k)
+
+ !Calc mass of new particles using new crystal mass...
+ !also this will be multiplied by mtime as nnuccd is...
+
+ mnuccd(k) = nnuccd(k) * mi0
+
+ ! add mnuccd to cmei....
+ cmei(i,k)= cmei(i,k) + mnuccd(k) * mtime
+
+ ! limit cmei
+
+ qvi = svp_to_qsat(esi(i,k), p(i,k))
+ dqsidt = xxls*qvi/(rv*t(i,k)**2)
+ abi = 1._r8+dqsidt*xxls/cpp
+ cmei(i,k)=min(cmei(i,k),(q(i,k)-qvi)/abi/deltat)
+
+ ! limit for roundoff error
+ cmei(i,k)=cmei(i,k)*omsm
+
+ else
+ nnuccd(k)=0._r8
+ nimax = 0._r8
+ mnuccd(k) = 0._r8
+ end if
+
+ !c............................................................................
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! obtain in-cloud values of cloud water/ice mixing ratios and number concentrations
+ ! for microphysical process calculations
+ ! units are kg/kg for mixing ratio, 1/kg for number conc
+
+ ! limit in-cloud values to 0.005 kg/kg
+
+ qcic(i,k)=min(cwml(i,k)/lcldm(i,k),5.e-3_r8)
+ qiic(i,k)=min(cwmi(i,k)/icldm(i,k),5.e-3_r8)
+ ncic(i,k)=max(nc(i,k)/lcldm(i,k),0._r8)
+ niic(i,k)=max(ni(i,k)/icldm(i,k),0._r8)
+
+ if (nccons) then
+ ncic(i,k) = ncnst/rho(i,k)
+ end if
+ if (nicons) then
+ niic(i,k) = ninst/rho(i,k)
+ end if
+
+ if (qc(i,k) - berg(i,k)*deltat.lt.qsmall) then
+ qcic(i,k)=0._r8
+ ncic(i,k)=0._r8
+ if (qc(i,k)-berg(i,k)*deltat.lt.0._r8) then
+ berg(i,k)=qc(i,k)/deltat*omsm
+ end if
+ end if
+
+ if (do_cldice .and. qi(i,k)+(cmei(i,k)+berg(i,k))*deltat.lt.qsmall) then
+ qiic(i,k)=0._r8
+ niic(i,k)=0._r8
+ if (qi(i,k)+(cmei(i,k)+berg(i,k))*deltat.lt.0._r8) then
+ cmei(i,k)=(-qi(i,k)/deltat-berg(i,k))*omsm
+ end if
+ end if
+
+ ! add to cme output
+
+ cmeout(i,k) = cmeout(i,k)+cmei(i,k)
+
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! droplet activation
+ ! calculate potential for droplet activation if cloud water is present
+ ! formulation from Abdul-Razzak and Ghan (2000) and Abdul-Razzak et al. (1998), AR98
+ ! number tendency (npccnin) is read in from companion routine
+
+ ! assume aerosols already activated are equal to number of existing droplets for simplicity
+ ! multiply by cloud fraction to obtain grid-average tendency
+
+ if (qcic(i,k).ge.qsmall) then
+ npccn(k) = max(0._r8,npccnin(i,k))
+ dum2l(i,k)=(nc(i,k)+npccn(k)*deltat)/lcldm(i,k)
+ dum2l(i,k)=max(dum2l(i,k),cdnl/rho(i,k)) ! sghan minimum in #/cm3
+ ncmax = dum2l(i,k)*lcldm(i,k)
+ else
+ npccn(k)=0._r8
+ dum2l(i,k)=0._r8
+ ncmax = 0._r8
+ end if
+
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! get size distribution parameters based on in-cloud cloud water/ice
+ ! these calculations also ensure consistency between number and mixing ratio
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ !......................................................................
+ ! cloud ice
+
+ if (qiic(i,k).ge.qsmall) then
+
+ ! add upper limit to in-cloud number concentration to prevent numerical error
+ niic(i,k)=min(niic(i,k),qiic(i,k)*1.e20_r8)
+
+ lami(k) = (cons1*ci*niic(i,k)/qiic(i,k))**(1._r8/di)
+ n0i(k) = niic(i,k)*lami(k)
+
+ ! check for slope
+ ! adjust vars
+
+ if (lami(k).lt.lammini) then
+
+ lami(k) = lammini
+ n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1)
+ niic(i,k) = n0i(k)/lami(k)
+ else if (lami(k).gt.lammaxi) then
+ lami(k) = lammaxi
+ n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*cons1)
+ niic(i,k) = n0i(k)/lami(k)
+ end if
+
+ else
+ lami(k) = 0._r8
+ n0i(k) = 0._r8
+ end if
+
+ if (qcic(i,k).ge.qsmall) then
+
+ ! add upper limit to in-cloud number concentration to prevent numerical error
+ ncic(i,k)=min(ncic(i,k),qcic(i,k)*1.e20_r8)
+
+ ncic(i,k)=max(ncic(i,k),cdnl/rho(i,k)) ! sghan minimum in #/cm
+
+ ! get pgam from fit to observations of martin et al. 1994
+
+ pgam(k)=0.0005714_r8*(ncic(i,k)/1.e6_r8*rho(i,k))+0.2714_r8
+ pgam(k)=1._r8/(pgam(k)**2)-1._r8
+ pgam(k)=max(pgam(k),2._r8)
+ pgam(k)=min(pgam(k),15._r8)
+
+ ! calculate lamc
+
+ lamc(k) = (pi/6._r8*rhow*ncic(i,k)*gamma(pgam(k)+4._r8)/ &
+ (qcic(i,k)*gamma(pgam(k)+1._r8)))**(1._r8/3._r8)
+
+ ! lammin, 50 micron diameter max mean size
+
+ lammin = (pgam(k)+1._r8)/50.e-6_r8
+ lammax = (pgam(k)+1._r8)/2.e-6_r8
+
+ if (lamc(k).lt.lammin) then
+ lamc(k) = lammin
+ ncic(i,k) = 6._r8*lamc(k)**3*qcic(i,k)* &
+ gamma(pgam(k)+1._r8)/(pi*rhow*gamma(pgam(k)+4._r8))
+ else if (lamc(k).gt.lammax) then
+ lamc(k) = lammax
+ ncic(i,k) = 6._r8*lamc(k)**3*qcic(i,k)* &
+ gamma(pgam(k)+1._r8)/(pi*rhow*gamma(pgam(k)+4._r8))
+ end if
+
+ ! parameter to calculate droplet freezing
+
+ cdist1(k) = ncic(i,k)/gamma(pgam(k)+1._r8)
+
+ else
+ lamc(k) = 0._r8
+ cdist1(k) = 0._r8
+ end if
+
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! begin micropysical process calculations
+ !.................................................................
+ ! autoconversion of cloud liquid water to rain
+ ! formula from Khrouditnov and Kogan (2000), modified for sub-grid distribution of qc
+ ! minimum qc of 1 x 10^-8 prevents floating point error
+
+ if (qcic(i,k).ge.1.e-8_r8) then
+
+ ! nprc is increase in rain number conc due to autoconversion
+ ! nprc1 is decrease in cloud droplet conc due to autoconversion
+
+ ! assume exponential sub-grid distribution of qc, resulting in additional
+ ! factor related to qcvar below
+
+ ! hm switch for sub-columns, don't include sub-grid qc
+ if (microp_uniform) then
+
+ prc(k) = 1350._r8*qcic(i,k)**2.47_r8* &
+ (ncic(i,k)/1.e6_r8*rho(i,k))**(-1.79_r8)
+ nprc(k) = prc(k)/(4._r8/3._r8*pi*rhow*(25.e-6_r8)**3)
+ nprc1(k) = prc(k)/(qcic(i,k)/ncic(i,k))
+
+ else
+
+ prc(k) = cons2/(cons3*cons18)*1350._r8*qcic(i,k)**2.47_r8* &
+ (ncic(i,k)/1.e6_r8*rho(i,k))**(-1.79_r8)
+ nprc(k) = prc(k)/cons22
+ nprc1(k) = prc(k)/(qcic(i,k)/ncic(i,k))
+
+ end if ! sub-column switch
+
+ else
+ prc(k)=0._r8
+ nprc(k)=0._r8
+ nprc1(k)=0._r8
+ end if
+
+ ! add autoconversion to precip from above to get provisional rain mixing ratio
+ ! and number concentration (qric and nric)
+
+ ! 0.45 m/s is fallspeed of new rain drop (80 micron diameter)
+
+ dum=0.45_r8
+ dum1=0.45_r8
+
+ if (k.eq.top_lev) then
+ qric(i,k)=prc(k)*lcldm(i,k)*dz(i,k)/cldmax(i,k)/dum
+ nric(i,k)=nprc(k)*lcldm(i,k)*dz(i,k)/cldmax(i,k)/dum
+ else
+ if (qric(i,k-1).ge.qsmall) then
+ dum=umr(k-1)
+ dum1=unr(k-1)
+ end if
+
+ ! no autoconversion of rain number if rain/snow falling from above
+ ! this assumes that new drizzle drops formed by autoconversion are rapidly collected
+ ! by the existing rain/snow particles from above
+
+ if (qric(i,k-1).ge.1.e-9_r8.or.qniic(i,k-1).ge.1.e-9_r8) then
+ nprc(k)=0._r8
+ end if
+
+ qric(i,k) = (rho(i,k-1)*umr(k-1)*qric(i,k-1)*cldmax(i,k-1)+ &
+ (rho(i,k)*dz(i,k)*((pra(k-1)+prc(k))*lcldm(i,k)+(pre(k-1)-pracs(k-1)-mnuccr(k-1))*cldmax(i,k))))&
+ /(dum*rho(i,k)*cldmax(i,k))
+ nric(i,k) = (rho(i,k-1)*unr(k-1)*nric(i,k-1)*cldmax(i,k-1)+ &
+ (rho(i,k)*dz(i,k)*(nprc(k)*lcldm(i,k)+(nsubr(k-1)-npracs(k-1)-nnuccr(k-1)+nragg(k-1))*cldmax(i,k))))&
+ /(dum1*rho(i,k)*cldmax(i,k))
+
+ end if
+
+ !.......................................................................
+ ! Autoconversion of cloud ice to snow
+ ! similar to Ferrier (1994)
+
+ if (do_cldice) then
+ if (t(i,k).le.273.15_r8.and.qiic(i,k).ge.qsmall) then
+
+ ! note: assumes autoconversion timescale of 180 sec
+
+ nprci(k) = n0i(k)/(lami(k)*180._r8)*exp(-lami(k)*dcs)
+
+ prci(k) = pi*rhoi*n0i(k)/(6._r8*180._r8)* &
+ (cons23/lami(k)+3._r8*cons24/lami(k)**2+ &
+ 6._r8*dcs/lami(k)**3+6._r8/lami(k)**4)*exp(-lami(k)*dcs)
+ else
+ prci(k)=0._r8
+ nprci(k)=0._r8
+ end if
+ else
+ ! Add in the particles that we have already converted to snow, and
+ ! don't do any further autoconversion of ice.
+ prci(k) = tnd_qsnow(i, k) / cldm(i,k)
+ nprci(k) = tnd_nsnow(i, k) / cldm(i,k)
+ end if
+
+ ! add autoconversion to flux from level above to get provisional snow mixing ratio
+ ! and number concentration (qniic and nsic)
+
+ dum=(asn(i,k)*cons25)
+ dum1=(asn(i,k)*cons25)
+
+ if (k.eq.top_lev) then
+ qniic(i,k)=prci(k)*icldm(i,k)*dz(i,k)/cldmax(i,k)/dum
+ nsic(i,k)=nprci(k)*icldm(i,k)*dz(i,k)/cldmax(i,k)/dum
+ else
+ if (qniic(i,k-1).ge.qsmall) then
+ dum=ums(k-1)
+ dum1=uns(k-1)
+ end if
+
+ qniic(i,k) = (rho(i,k-1)*ums(k-1)*qniic(i,k-1)*cldmax(i,k-1)+ &
+ (rho(i,k)*dz(i,k)*((prci(k)+prai(k-1)+psacws(k-1)+bergs(k-1))*icldm(i,k)+(prds(k-1)+ &
+ pracs(k-1)+mnuccr(k-1))*cldmax(i,k))))&
+ /(dum*rho(i,k)*cldmax(i,k))
+
+ nsic(i,k) = (rho(i,k-1)*uns(k-1)*nsic(i,k-1)*cldmax(i,k-1)+ &
+ (rho(i,k)*dz(i,k)*(nprci(k)*icldm(i,k)+(nsubs(k-1)+nsagg(k-1)+nnuccr(k-1))*cldmax(i,k))))&
+ /(dum1*rho(i,k)*cldmax(i,k))
+
+ end if
+
+ ! if precip mix ratio is zero so should number concentration
+
+ if (qniic(i,k).lt.qsmall) then
+ qniic(i,k)=0._r8
+ nsic(i,k)=0._r8
+ end if
+
+ if (qric(i,k).lt.qsmall) then
+ qric(i,k)=0._r8
+ nric(i,k)=0._r8
+ end if
+
+ ! make sure number concentration is a positive number to avoid
+ ! taking root of negative later
+
+ nric(i,k)=max(nric(i,k),0._r8)
+ nsic(i,k)=max(nsic(i,k),0._r8)
+
+ !.......................................................................
+ ! get size distribution parameters for precip
+ !......................................................................
+ ! rain
+
+ if (qric(i,k).ge.qsmall) then
+ lamr(k) = (pi*rhow*nric(i,k)/qric(i,k))**(1._r8/3._r8)
+ n0r(k) = nric(i,k)*lamr(k)
+
+ ! check for slope
+ ! adjust vars
+
+ if (lamr(k).lt.lamminr) then
+
+ lamr(k) = lamminr
+
+ n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow)
+ nric(i,k) = n0r(k)/lamr(k)
+ else if (lamr(k).gt.lammaxr) then
+ lamr(k) = lammaxr
+ n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow)
+ nric(i,k) = n0r(k)/lamr(k)
+ end if
+
+ ! provisional rain number and mass weighted mean fallspeed (m/s)
+
+ unr(k) = min(arn(i,k)*cons4/lamr(k)**br,9.1_r8*rhof(i,k))
+ umr(k) = min(arn(i,k)*cons5/(6._r8*lamr(k)**br),9.1_r8*rhof(i,k))
+
+ else
+ lamr(k) = 0._r8
+ n0r(k) = 0._r8
+ umr(k) = 0._r8
+ unr(k) = 0._r8
+ end if
+
+ !......................................................................
+ ! snow
+
+ if (qniic(i,k).ge.qsmall) then
+ lams(k) = (cons6*cs*nsic(i,k)/qniic(i,k))**(1._r8/ds)
+ n0s(k) = nsic(i,k)*lams(k)
+
+ ! check for slope
+ ! adjust vars
+
+ if (lams(k).lt.lammins) then
+ lams(k) = lammins
+ n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*cons6)
+ nsic(i,k) = n0s(k)/lams(k)
+
+ else if (lams(k).gt.lammaxs) then
+ lams(k) = lammaxs
+ n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*cons6)
+ nsic(i,k) = n0s(k)/lams(k)
+ end if
+
+ ! provisional snow number and mass weighted mean fallspeed (m/s)
+
+ ums(k) = min(asn(i,k)*cons8/(6._r8*lams(k)**bs),1.2_r8*rhof(i,k))
+ uns(k) = min(asn(i,k)*cons7/lams(k)**bs,1.2_r8*rhof(i,k))
+
+ else
+ lams(k) = 0._r8
+ n0s(k) = 0._r8
+ ums(k) = 0._r8
+ uns(k) = 0._r8
+ end if
+
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ ! heterogeneous freezing of cloud water
+
+ if (.not. use_hetfrz_classnuc) then
+
+!AL
+!Make sure zero output for deposition freezing
+!If no classnuc this is included in NNUCCD (Meyers 1992)
+ nnudep(k) = 0.0_r8
+ mnudep(k) = 0.0_r8
+!AL
+ if (do_cldice .and. qcic(i,k).ge.qsmall .and. t(i,k).lt.269.15_r8) then
+
+ ! immersion freezing (Bigg, 1953)
+
+
+ ! subcolumns
+
+ if (microp_uniform) then
+
+ mnuccc(k) = &
+ pi*pi/36._r8*rhow* &
+ cdist1(k)*gamma(7._r8+pgam(k))* &
+ bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/ &
+ lamc(k)**3/lamc(k)**3
+
+ nnuccc(k) = &
+ pi/6._r8*cdist1(k)*gamma(pgam(k)+4._r8) &
+ *bimm* &
+ (exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamc(k)**3
+
+ else
+
+ mnuccc(k) = cons9/(cons3*cons19)* &
+ pi*pi/36._r8*rhow* &
+ cdist1(k)*gamma(7._r8+pgam(k))* &
+ bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/ &
+ lamc(k)**3/lamc(k)**3
+
+ nnuccc(k) = cons10/(cons3*qcvar)* &
+ pi/6._r8*cdist1(k)*gamma(pgam(k)+4._r8) &
+ *bimm* &
+ (exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamc(k)**3
+ end if ! sub-columns
+
+
+ ! contact freezing (-40= qsmall) then
+ con1 = 1._r8/(1.333_r8*pi)**0.333_r8
+ r3lx = con1*(rho(i,k)*qcic(i,k)/(rhow*max(ncic(i,k)*rho(i,k), 1.0e6_r8)))**0.333_r8 ! in m
+ r3lx = max(4.e-6_r8, r3lx)
+ mi0l = 4._r8/3._r8*pi*rhow*r3lx**3_r8
+
+ nnuccc(k) = frzimm(i,k)*1.0e6_r8/rho(i,k)
+ mnuccc(k) = nnuccc(k)*mi0l
+
+ nnucct(k) = frzcnt(i,k)*1.0e6_r8/rho(i,k)
+ mnucct(k) = nnucct(k)*mi0l
+
+ nnudep(k) = frzdep(i,k)*1.0e6_r8/rho(i,k)
+ mnudep(k) = nnudep(k)*mi0
+ else
+ nnuccc(k) = 0._r8
+ mnuccc(k) = 0._r8
+
+ nnucct(k) = 0._r8
+ mnucct(k) = 0._r8
+
+ nnudep(k) = 0._r8
+ mnudep(k) = 0._r8
+ end if
+ endif
+
+
+ !.......................................................................
+ ! snow self-aggregation from passarelli, 1978, used by reisner, 1998
+ ! this is hard-wired for bs = 0.4 for now
+ ! ignore self-collection of cloud ice
+
+ if (qniic(i,k).ge.qsmall .and. t(i,k).le.273.15_r8) then
+ nsagg(k) = -1108._r8*asn(i,k)*Eii* &
+ pi**((1._r8-bs)/3._r8)*rhosn**((-2._r8-bs)/3._r8)*rho(i,k)** &
+ ((2._r8+bs)/3._r8)*qniic(i,k)**((2._r8+bs)/3._r8)* &
+ (nsic(i,k)*rho(i,k))**((4._r8-bs)/3._r8)/ &
+ (4._r8*720._r8*rho(i,k))
+ else
+ nsagg(k)=0._r8
+ end if
+
+ !.......................................................................
+ ! accretion of cloud droplets onto snow/graupel
+ ! here use continuous collection equation with
+ ! simple gravitational collection kernel
+ ! ignore collisions between droplets/cloud ice
+ ! since minimum size ice particle for accretion is 50 - 150 micron
+
+ ! ignore collision of snow with droplets above freezing
+
+ if (qniic(i,k).ge.qsmall .and. t(i,k).le.tmelt .and. &
+ qcic(i,k).ge.qsmall) then
+
+ ! put in size dependent collection efficiency
+ ! mean diameter of snow is area-weighted, since
+ ! accretion is function of crystal geometric area
+ ! collection efficiency is approximation based on stoke's law (Thompson et al. 2004)
+
+ dc0 = (pgam(k)+1._r8)/lamc(k)
+ ds0 = 1._r8/lams(k)
+ dum = dc0*dc0*uns(k)*rhow/(9._r8*mu(i,k)*ds0)
+ eci = dum*dum/((dum+0.4_r8)*(dum+0.4_r8))
+
+ eci = max(eci,0._r8)
+ eci = min(eci,1._r8)
+
+
+ ! no impact of sub-grid distribution of qc since psacws
+ ! is linear in qc
+
+ psacws(k) = pi/4._r8*asn(i,k)*qcic(i,k)*rho(i,k)* &
+ n0s(k)*Eci*cons11/ &
+ lams(k)**(bs+3._r8)
+ npsacws(k) = pi/4._r8*asn(i,k)*ncic(i,k)*rho(i,k)* &
+ n0s(k)*Eci*cons11/ &
+ lams(k)**(bs+3._r8)
+ else
+ psacws(k)=0._r8
+ npsacws(k)=0._r8
+ end if
+
+ ! add secondary ice production due to accretion of droplets by snow
+ ! (Hallet-Mossop process) (from Cotton et al., 1986)
+
+ if (.not. do_cldice) then
+ ni_secp = 0.0_r8
+ nsacwi(k) = 0.0_r8
+ msacwi(k) = 0.0_r8
+ else if((t(i,k).lt.270.16_r8) .and. (t(i,k).ge.268.16_r8)) then
+ ni_secp = 3.5e8_r8*(270.16_r8-t(i,k))/2.0_r8*psacws(k)
+ nsacwi(k) = ni_secp
+ msacwi(k) = min(ni_secp*mi0,psacws(k))
+ else if((t(i,k).lt.268.16_r8) .and. (t(i,k).ge.265.16_r8)) then
+ ni_secp = 3.5e8_r8*(t(i,k)-265.16_r8)/3.0_r8*psacws(k)
+ nsacwi(k) = ni_secp
+ msacwi(k) = min(ni_secp*mi0,psacws(k))
+ else
+ ni_secp = 0.0_r8
+ nsacwi(k) = 0.0_r8
+ msacwi(k) = 0.0_r8
+ endif
+ psacws(k) = max(0.0_r8,psacws(k)-ni_secp*mi0)
+
+ !.......................................................................
+ ! accretion of rain water by snow
+ ! formula from ikawa and saito, 1991, used by reisner et al., 1998
+
+ if (qric(i,k).ge.1.e-8_r8 .and. qniic(i,k).ge.1.e-8_r8 .and. &
+ t(i,k).le.273.15_r8) then
+
+ pracs(k) = pi*pi*ecr*(((1.2_r8*umr(k)-0.95_r8*ums(k))**2+ &
+ 0.08_r8*ums(k)*umr(k))**0.5_r8*rhow*rho(i,k)* &
+ n0r(k)*n0s(k)* &
+ (5._r8/(lamr(k)**6*lams(k))+ &
+ 2._r8/(lamr(k)**5*lams(k)**2)+ &
+ 0.5_r8/(lamr(k)**4*lams(k)**3)))
+
+ npracs(k) = pi/2._r8*rho(i,k)*ecr*(1.7_r8*(unr(k)-uns(k))**2+ &
+ 0.3_r8*unr(k)*uns(k))**0.5_r8*n0r(k)*n0s(k)* &
+ (1._r8/(lamr(k)**3*lams(k))+ &
+ 1._r8/(lamr(k)**2*lams(k)**2)+ &
+ 1._r8/(lamr(k)*lams(k)**3))
+
+ else
+ pracs(k)=0._r8
+ npracs(k)=0._r8
+ end if
+
+ !.......................................................................
+ ! heterogeneous freezing of rain drops
+ ! follows from Bigg (1953)
+
+ if (t(i,k).lt.269.15_r8 .and. qric(i,k).ge.qsmall) then
+
+ mnuccr(k) = 20._r8*pi*pi*rhow*nric(i,k)*bimm* &
+ (exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamr(k)**3 &
+ /lamr(k)**3
+
+ nnuccr(k) = pi*nric(i,k)*bimm* &
+ (exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamr(k)**3
+ else
+ mnuccr(k)=0._r8
+ nnuccr(k)=0._r8
+ end if
+
+ !.......................................................................
+ ! accretion of cloud liquid water by rain
+ ! formula from Khrouditnov and Kogan (2000)
+ ! gravitational collection kernel, droplet fall speed neglected
+
+ if (qric(i,k).ge.qsmall .and. qcic(i,k).ge.qsmall) then
+
+ ! include sub-grid distribution of cloud water
+
+ ! add sub-column switch
+
+ if (microp_uniform) then
+
+ pra(k) = 67._r8*(qcic(i,k)*qric(i,k))**1.15_r8
+ npra(k) = pra(k)/(qcic(i,k)/ncic(i,k))
+
+ else
+
+ pra(k) = accre_enhan(i,k)*(cons12/(cons3*cons20)*67._r8*(qcic(i,k)*qric(i,k))**1.15_r8)
+ npra(k) = pra(k)/(qcic(i,k)/ncic(i,k))
+
+ end if ! sub-column switch
+
+ else
+ pra(k)=0._r8
+ npra(k)=0._r8
+ end if
+
+ !.......................................................................
+ ! Self-collection of rain drops
+ ! from Beheng(1994)
+
+ if (qric(i,k).ge.qsmall) then
+ nragg(k) = -8._r8*nric(i,k)*qric(i,k)*rho(i,k)
+ else
+ nragg(k)=0._r8
+ end if
+
+ !.......................................................................
+ ! Accretion of cloud ice by snow
+ ! For this calculation, it is assumed that the Vs >> Vi
+ ! and Ds >> Di for continuous collection
+
+ if (do_cldice .and. qniic(i,k).ge.qsmall.and.qiic(i,k).ge.qsmall &
+ .and.t(i,k).le.273.15_r8) then
+
+ prai(k) = pi/4._r8*asn(i,k)*qiic(i,k)*rho(i,k)* &
+ n0s(k)*Eii*cons11/ &
+ lams(k)**(bs+3._r8)
+ nprai(k) = pi/4._r8*asn(i,k)*niic(i,k)* &
+ rho(i,k)*n0s(k)*Eii*cons11/ &
+ lams(k)**(bs+3._r8)
+ else
+ prai(k)=0._r8
+ nprai(k)=0._r8
+ end if
+
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! calculate evaporation/sublimation of rain and snow
+ ! note: evaporation/sublimation occurs only in cloud-free portion of grid cell
+ ! in-cloud condensation/deposition of rain and snow is neglected
+ ! except for transfer of cloud water to snow through bergeron process
+
+ ! initialize evap/sub tendncies
+ pre(k)=0._r8
+ prds(k)=0._r8
+
+ ! evaporation of rain
+ ! only calculate if there is some precip fraction > cloud fraction
+
+ if (qcic(i,k)+qiic(i,k).lt.1.e-6_r8.or.cldmax(i,k).gt.lcldm(i,k)) then
+
+ ! set temporary cloud fraction to zero if cloud water + ice is very small
+ ! this will ensure that evaporation/sublimation of precip occurs over
+ ! entire grid cell, since min cloud fraction is specified otherwise
+ if (qcic(i,k)+qiic(i,k).lt.1.e-6_r8) then
+ dum=0._r8
+ else
+ dum=lcldm(i,k)
+ end if
+
+ ! saturation vapor pressure
+ esn=svp_water(t(i,k))
+ qsn=svp_to_qsat(esn, p(i,k))
+
+ ! recalculate saturation vapor pressure for liquid and ice
+ esl(i,k)=esn
+ esi(i,k)=svp_ice(t(i,k))
+ ! hm fix, make sure when above freezing that esi=esl, not active yet
+ if (t(i,k).gt.tmelt)esi(i,k)=esl(i,k)
+
+ ! calculate q for out-of-cloud region
+ qclr=(q(i,k)-dum*qsn)/(1._r8-dum)
+
+ if (qric(i,k).ge.qsmall) then
+
+ qvs=svp_to_qsat(esl(i,k), p(i,k))
+ dqsdt = xxlv*qvs/(rv*t(i,k)**2)
+ ab = 1._r8+dqsdt*xxlv/cpp
+ epsr = 2._r8*pi*n0r(k)*rho(i,k)*Dv(i,k)* &
+ (f1r/(lamr(k)*lamr(k))+ &
+ f2r*(arn(i,k)*rho(i,k)/mu(i,k))**0.5_r8* &
+ sc(i,k)**(1._r8/3._r8)*cons13/ &
+ (lamr(k)**(5._r8/2._r8+br/2._r8)))
+
+ pre(k) = epsr*(qclr-qvs)/ab
+
+ ! only evaporate in out-of-cloud region
+ ! and distribute across cldmax
+ pre(k)=min(pre(k)*(cldmax(i,k)-dum),0._r8)
+ pre(k)=pre(k)/cldmax(i,k)
+ am_evp_st(i,k) = max(cldmax(i,k)-dum, 0._r8)
+ end if
+
+ ! sublimation of snow
+ if (qniic(i,k).ge.qsmall) then
+ qvi=svp_to_qsat(esi(i,k), p(i,k))
+ dqsidt = xxls*qvi/(rv*t(i,k)**2)
+ abi = 1._r8+dqsidt*xxls/cpp
+ epss = 2._r8*pi*n0s(k)*rho(i,k)*Dv(i,k)* &
+ (f1s/(lams(k)*lams(k))+ &
+ f2s*(asn(i,k)*rho(i,k)/mu(i,k))**0.5_r8* &
+ sc(i,k)**(1._r8/3._r8)*cons14/ &
+ (lams(k)**(5._r8/2._r8+bs/2._r8)))
+ prds(k) = epss*(qclr-qvi)/abi
+
+ ! only sublimate in out-of-cloud region and distribute over cldmax
+ prds(k)=min(prds(k)*(cldmax(i,k)-dum),0._r8)
+ prds(k)=prds(k)/cldmax(i,k)
+ am_evp_st(i,k) = max(cldmax(i,k)-dum, 0._r8)
+ end if
+
+ ! make sure RH not pushed above 100% due to rain evaporation/snow sublimation
+ ! get updated RH at end of time step based on cloud water/ice condensation/evap
+
+ qtmp=q(i,k)-(cmei(i,k)+(pre(k)+prds(k))*cldmax(i,k))*deltat
+ ttmp=t(i,k)+((pre(k)*cldmax(i,k))*xxlv+ &
+ (cmei(i,k)+prds(k)*cldmax(i,k))*xxls)*deltat/cpp
+
+ !limit range of temperatures!
+ ttmp=max(180._r8,min(ttmp,323._r8))
+
+ esn=svp_water(ttmp) ! use rhw to allow ice supersaturation
+ qsn=svp_to_qsat(esn, p(i,k))
+
+ ! modify precip evaporation rate if q > qsat
+ if (qtmp.gt.qsn) then
+ if (pre(k)+prds(k).lt.-1.e-20_r8) then
+ dum1=pre(k)/(pre(k)+prds(k))
+ ! recalculate q and t after cloud water cond but without precip evap
+ qtmp=q(i,k)-(cmei(i,k))*deltat
+ ttmp=t(i,k)+(cmei(i,k)*xxls)*deltat/cpp
+ esn=svp_water(ttmp) ! use rhw to allow ice supersaturation
+ qsn=svp_to_qsat(esn, p(i,k))
+ dum=(qtmp-qsn)/(1._r8 + cons27*qsn/(cpp*rv*ttmp**2))
+ dum=min(dum,0._r8)
+
+ ! modify rates if needed, divide by cldmax to get local (in-precip) value
+ pre(k)=dum*dum1/deltat/cldmax(i,k)
+
+ ! do separately using RHI for prds....
+ esn=svp_ice(ttmp) ! use rhi to allow ice supersaturation
+ qsn=svp_to_qsat(esn, p(i,k))
+ dum=(qtmp-qsn)/(1._r8 + cons28*qsn/(cpp*rv*ttmp**2))
+ dum=min(dum,0._r8)
+
+ ! modify rates if needed, divide by cldmax to get local (in-precip) value
+ prds(k)=dum*(1._r8-dum1)/deltat/cldmax(i,k)
+ end if
+ end if
+ end if
+
+ ! bergeron process - evaporation of droplets and deposition onto snow
+
+ if (qniic(i,k).ge.qsmall.and.qcic(i,k).ge.qsmall.and.t(i,k).lt.tmelt) then
+ qvi=svp_to_qsat(esi(i,k), p(i,k))
+ qvs=svp_to_qsat(esl(i,k), p(i,k))
+ dqsidt = xxls*qvi/(rv*t(i,k)**2)
+ abi = 1._r8+dqsidt*xxls/cpp
+ epss = 2._r8*pi*n0s(k)*rho(i,k)*Dv(i,k)* &
+ (f1s/(lams(k)*lams(k))+ &
+ f2s*(asn(i,k)*rho(i,k)/mu(i,k))**0.5_r8* &
+ sc(i,k)**(1._r8/3._r8)*cons14/ &
+ (lams(k)**(5._r8/2._r8+bs/2._r8)))
+ bergs(k)=epss*(qvs-qvi)/abi
+ else
+ bergs(k)=0._r8
+ end if
+
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! conservation to ensure no negative values of cloud water/precipitation
+ ! in case microphysical process rates are large
+
+ ! make sure and use end-of-time step values for cloud water, ice, due
+ ! condensation/deposition
+
+ ! note: for check on conservation, processes are multiplied by omsm
+ ! to prevent problems due to round off error
+
+ ! include mixing timescale (mtime)
+
+ qce=(qc(i,k) - berg(i,k)*deltat)
+ nce=(nc(i,k)+npccn(k)*deltat*mtime)
+ qie=(qi(i,k)+(cmei(i,k)+berg(i,k))*deltat)
+ nie=(ni(i,k)+nnuccd(k)*deltat*mtime)
+
+ ! conservation of qc
+
+ dum = (prc(k)+pra(k)+mnuccc(k)+mnucct(k)+msacwi(k)+ &
+ psacws(k)+bergs(k))*lcldm(i,k)*deltat
+
+ if (dum.gt.qce) then
+ ratio = qce/deltat/lcldm(i,k)/(prc(k)+pra(k)+mnuccc(k)+mnucct(k)+msacwi(k)+psacws(k)+bergs(k))*omsm
+
+ prc(k) = prc(k)*ratio
+ pra(k) = pra(k)*ratio
+ mnuccc(k) = mnuccc(k)*ratio
+ mnucct(k) = mnucct(k)*ratio
+ msacwi(k) = msacwi(k)*ratio
+ psacws(k) = psacws(k)*ratio
+ bergs(k) = bergs(k)*ratio
+ end if
+
+ ! conservation of nc
+
+ dum = (nprc1(k)+npra(k)+nnuccc(k)+nnucct(k)+ &
+ npsacws(k)-nsubc(k))*lcldm(i,k)*deltat
+
+ if (dum.gt.nce) then
+ ratio = nce/deltat/((nprc1(k)+npra(k)+nnuccc(k)+nnucct(k)+&
+ npsacws(k)-nsubc(k))*lcldm(i,k))*omsm
+
+ nprc1(k) = nprc1(k)*ratio
+ npra(k) = npra(k)*ratio
+ nnuccc(k) = nnuccc(k)*ratio
+ nnucct(k) = nnucct(k)*ratio
+ npsacws(k) = npsacws(k)*ratio
+ nsubc(k)=nsubc(k)*ratio
+ end if
+
+ ! conservation of qi
+
+ if (do_cldice) then
+
+ frztmp = -mnuccc(k) - mnucct(k) - msacwi(k)
+ if (use_hetfrz_classnuc) frztmp = -mnuccc(k)-mnucct(k)-mnudep(k)-msacwi(k)
+ dum = ( frztmp*lcldm(i,k) + (prci(k)+prai(k))*icldm(i,k) )*deltat
+
+ if (dum.gt.qie) then
+
+ frztmp = mnuccc(k) + mnucct(k) + msacwi(k)
+ if (use_hetfrz_classnuc) frztmp = mnuccc(k) + mnucct(k) + mnudep(k) + msacwi(k)
+ ratio = (qie/deltat + frztmp*lcldm(i,k))/((prci(k)+prai(k))*icldm(i,k))*omsm
+ prci(k) = prci(k)*ratio
+ prai(k) = prai(k)*ratio
+ end if
+
+ ! conservation of ni
+ frztmp = -nnucct(k) - nsacwi(k)
+ if (use_hetfrz_classnuc) frztmp = -nnucct(k) - nnuccc(k) - nnudep(k) - nsacwi(k)
+ dum = ( frztmp*lcldm(i,k) + (nprci(k)+nprai(k)-nsubi(k))*icldm(i,k) )*deltat
+
+ if (dum.gt.nie) then
+
+ frztmp = nnucct(k) + nsacwi(k)
+ if (use_hetfrz_classnuc) frztmp = nnucct(k) + nnuccc(k) + nnudep(k) + nsacwi(k)
+ ratio = (nie/deltat + frztmp*lcldm(i,k))/ &
+ ((nprci(k)+nprai(k)-nsubi(k))*icldm(i,k))*omsm
+ nprci(k) = nprci(k)*ratio
+ nprai(k) = nprai(k)*ratio
+ nsubi(k) = nsubi(k)*ratio
+ end if
+ end if
+
+ ! for precipitation conservation, use logic that vertical integral
+ ! of tendency from current level to top of model (i.e., qrtot) cannot be negative
+
+ ! conservation of rain mixing rat
+
+ if (((prc(k)+pra(k))*lcldm(i,k)+(-mnuccr(k)+pre(k)-pracs(k))*&
+ cldmax(i,k))*dz(i,k)*rho(i,k)+qrtot.lt.0._r8) then
+
+ if (-pre(k)+pracs(k)+mnuccr(k).ge.qsmall) then
+
+ ratio = (qrtot/(dz(i,k)*rho(i,k))+(prc(k)+pra(k))*lcldm(i,k))/&
+ ((-pre(k)+pracs(k)+mnuccr(k))*cldmax(i,k))*omsm
+
+ pre(k) = pre(k)*ratio
+ pracs(k) = pracs(k)*ratio
+ mnuccr(k) = mnuccr(k)*ratio
+ end if
+ end if
+
+ ! conservation of nr
+ ! for now neglect evaporation of nr
+ nsubr(k)=0._r8
+
+ if ((nprc(k)*lcldm(i,k)+(-nnuccr(k)+nsubr(k)-npracs(k)&
+ +nragg(k))*cldmax(i,k))*dz(i,k)*rho(i,k)+nrtot.lt.0._r8) then
+
+ if (-nsubr(k)-nragg(k)+npracs(k)+nnuccr(k).ge.qsmall) then
+
+ ratio = (nrtot/(dz(i,k)*rho(i,k))+nprc(k)*lcldm(i,k))/&
+ ((-nsubr(k)-nragg(k)+npracs(k)+nnuccr(k))*cldmax(i,k))*omsm
+
+ nsubr(k) = nsubr(k)*ratio
+ npracs(k) = npracs(k)*ratio
+ nnuccr(k) = nnuccr(k)*ratio
+ nragg(k) = nragg(k)*ratio
+ end if
+ end if
+
+ ! conservation of snow mix ratio
+
+ if (((bergs(k)+psacws(k))*lcldm(i,k)+(prai(k)+prci(k))*icldm(i,k)+(pracs(k)+&
+ mnuccr(k)+prds(k))*cldmax(i,k))*dz(i,k)*rho(i,k)+qstot.lt.0._r8) then
+
+ if (-prds(k).ge.qsmall) then
+
+ ratio = (qstot/(dz(i,k)*rho(i,k))+(bergs(k)+psacws(k))*lcldm(i,k)+(prai(k)+prci(k))*icldm(i,k)+&
+ (pracs(k)+mnuccr(k))*cldmax(i,k))/(-prds(k)*cldmax(i,k))*omsm
+
+ prds(k) = prds(k)*ratio
+ end if
+ end if
+
+ ! conservation of ns
+
+ ! calculate loss of number due to sublimation
+ ! for now neglect sublimation of ns
+ nsubs(k)=0._r8
+
+ if ((nprci(k)*icldm(i,k)+(nnuccr(k)+nsubs(k)+nsagg(k))*cldmax(i,k))*&
+ dz(i,k)*rho(i,k)+nstot.lt.0._r8) then
+
+ if (-nsubs(k)-nsagg(k).ge.qsmall) then
+
+ ratio = (nstot/(dz(i,k)*rho(i,k))+nprci(k)*icldm(i,k)+&
+ nnuccr(k)*cldmax(i,k))/((-nsubs(k)-nsagg(k))*cldmax(i,k))*omsm
+
+ nsubs(k) = nsubs(k)*ratio
+ nsagg(k) = nsagg(k)*ratio
+ end if
+ end if
+
+ ! get tendencies due to microphysical conversion processes
+ ! note: tendencies are multiplied by appropaiate cloud/precip
+ ! fraction to get grid-scale values
+ ! note: cmei is already grid-average values
+
+ qvlat(i,k) = qvlat(i,k)-(pre(k)+prds(k))*cldmax(i,k)-cmei(i,k)
+
+ tlat(i,k) = tlat(i,k)+((pre(k)*cldmax(i,k)) &
+ *xxlv+(prds(k)*cldmax(i,k)+cmei(i,k))*xxls+ &
+ ((bergs(k)+psacws(k)+mnuccc(k)+mnucct(k)+msacwi(k))*lcldm(i,k)+(mnuccr(k)+ &
+ pracs(k))*cldmax(i,k)+berg(i,k))*xlf)
+
+ qctend(i,k) = qctend(i,k)+ &
+ (-pra(k)-prc(k)-mnuccc(k)-mnucct(k)-msacwi(k)- &
+ psacws(k)-bergs(k))*lcldm(i,k)-berg(i,k)
+
+ if (do_cldice) then
+
+ frztmp = mnuccc(k) + mnucct(k) + msacwi(k)
+ if (use_hetfrz_classnuc) frztmp = mnuccc(k) + mnucct(k) + mnudep(k) + msacwi(k)
+ qitend(i,k) = qitend(i,k) + frztmp*lcldm(i,k) + &
+ (-prci(k)-prai(k))*icldm(i,k) + cmei(i,k) + berg(i,k)
+
+ end if
+
+ qrtend(i,k) = qrtend(i,k)+ &
+ (pra(k)+prc(k))*lcldm(i,k)+(pre(k)-pracs(k)- &
+ mnuccr(k))*cldmax(i,k)
+
+ qnitend(i,k) = qnitend(i,k)+ &
+ (prai(k)+prci(k))*icldm(i,k)+(psacws(k)+bergs(k))*lcldm(i,k)+(prds(k)+ &
+ pracs(k)+mnuccr(k))*cldmax(i,k)
+
+ ! add output for cmei (accumulate)
+ cmeiout(i,k) = cmeiout(i,k) + cmei(i,k)
+
+ ! assign variables for trop_mozart, these are grid-average
+ ! evaporation/sublimation is stored here as positive term
+
+ evapsnow(i,k) = evapsnow(i,k)-prds(k)*cldmax(i,k)
+ nevapr(i,k) = nevapr(i,k)-pre(k)*cldmax(i,k)
+ nevapr2(i,k) = nevapr2(i,k)-pre(k)*cldmax(i,k)
+
+ ! change to make sure prain is positive: do not remove snow from
+ ! prain used for wet deposition
+ prain(i,k) = prain(i,k)+(pra(k)+prc(k))*lcldm(i,k)+(-pracs(k)- &
+ mnuccr(k))*cldmax(i,k)
+ prodsnow(i,k) = prodsnow(i,k)+(prai(k)+prci(k))*icldm(i,k)+(psacws(k)+bergs(k))*lcldm(i,k)+(&
+ pracs(k)+mnuccr(k))*cldmax(i,k)
+
+ ! following are used to calculate 1st order conversion rate of cloud water
+ ! to rain and snow (1/s), for later use in aerosol wet removal routine
+ ! previously, wetdepa used (prain/qc) for this, and the qc in wetdepa may be smaller than the qc
+ ! used to calculate pra, prc, ... in this routine
+ ! qcsinksum_rate1ord = sum over iterations{ rate of direct transfer of cloud water to rain & snow }
+ ! (no cloud ice or bergeron terms)
+ ! qcsum_rate1ord = sum over iterations{ qc used in calculation of the transfer terms }
+
+ qcsinksum_rate1ord(k) = qcsinksum_rate1ord(k) + (pra(k)+prc(k)+psacws(k))*lcldm(i,k)
+ qcsum_rate1ord(k) = qcsum_rate1ord(k) + qc(i,k)
+
+ ! microphysics output, note this is grid-averaged
+ prao(i,k)=prao(i,k)+pra(k)*lcldm(i,k)
+ prco(i,k)=prco(i,k)+prc(k)*lcldm(i,k)
+ mnuccco(i,k)=mnuccco(i,k)+mnuccc(k)*lcldm(i,k)
+ mnuccto(i,k)=mnuccto(i,k)+mnucct(k)*lcldm(i,k)
+ mnuccdo(i,k)=mnuccdo(i,k)+mnuccd(k)*lcldm(i,k)
+ msacwio(i,k)=msacwio(i,k)+msacwi(k)*lcldm(i,k)
+ psacwso(i,k)=psacwso(i,k)+psacws(k)*lcldm(i,k)
+ bergso(i,k)=bergso(i,k)+bergs(k)*lcldm(i,k)
+ bergo(i,k)=bergo(i,k)+berg(i,k)
+ prcio(i,k)=prcio(i,k)+prci(k)*icldm(i,k)
+ praio(i,k)=praio(i,k)+prai(k)*icldm(i,k)
+ mnuccro(i,k)=mnuccro(i,k)+mnuccr(k)*cldmax(i,k)
+ pracso (i,k)=pracso (i,k)+pracs (k)*cldmax(i,k)
+!AL
+ mnudepo(i,k)=mnudepo(i,k)+mnudep(k)*lcldm(i,k)
+
+ ! microphysics output for number concentration tendencies
+ ! for liq.
+ nnuccco(i,k)=nnuccco(i,k)+nnuccc(k)*lcldm(i,k)
+ nnuccto(i,k)=nnuccto(i,k)+nnucct(k)*lcldm(i,k)
+ npsacwso(i,k)=npsacwso(i,k)+npsacws(k)*lcldm(i,k)
+ nsubco(i,k)=nsubco(i,k)+nsubc(k)*lcldm(i,k)
+ nprao(i,k)=nprao(i,k)+npra(k)*lcldm(i,k)
+ nprc1o(i,k)=nprc1o(i,k)+nprc1(k)*lcldm(i,k)
+ npccno(i,k)=npccno(i,k)+npccn(k)*mtime
+
+ ! for ice
+ nsacwio(i,k)=nsacwio(i,k)+nsacwi(k)*lcldm(i,k)
+ nsubio(i,k)=nsubio(i,k)+nsubi(k)*icldm(i,k)
+ nprcio(i,k)=nprcio(i,k)+nprci(k)*icldm(i,k)
+ npraio(i,k)=npraio(i,k)+nprai(k)*icldm(i,k)
+ nnudepo(i,k)=nnudepo(i,k)+nnudep(k)*lcldm(i,k)
+ nnuccdo(i,k)=nnuccdo(i,k)+nnuccd(k)*mtime
+!AL
+
+ ! multiply activation/nucleation by mtime to account for fast timescale
+
+ nctend(i,k) = nctend(i,k)+ npccn(k)*mtime+&
+ (-nnuccc(k)-nnucct(k)-npsacws(k)+nsubc(k) &
+ -npra(k)-nprc1(k))*lcldm(i,k)
+
+ if (do_cldice) then
+
+ frztmp = nnucct(k) + nsacwi(k)
+ if (use_hetfrz_classnuc) frztmp = nnucct(k) + nnuccc(k) + nnudep(k) + nsacwi(k)
+ nitend(i,k) = nitend(i,k) + nnuccd(k)*mtime + &
+ frztmp*lcldm(i,k) + (nsubi(k)-nprci(k)-nprai(k))*icldm(i,k)
+
+ end if
+
+ nstend(i,k) = nstend(i,k)+(nsubs(k)+ &
+ nsagg(k)+nnuccr(k))*cldmax(i,k)+nprci(k)*icldm(i,k)
+
+ nrtend(i,k) = nrtend(i,k)+ &
+ nprc(k)*lcldm(i,k)+(nsubr(k)-npracs(k)-nnuccr(k) &
+ +nragg(k))*cldmax(i,k)
+
+ ! make sure that nc and ni at advanced time step do not exceed
+ ! maximum (existing N + source terms*dt), which is possible due to
+ ! fast nucleation timescale
+
+ if (nctend(i,k).gt.0._r8.and.nc(i,k)+nctend(i,k)*deltat.gt.ncmax) then
+ nctncons(i,k) = nctncons(i,k) + nctend(i,k)-max(0._r8,(ncmax-nc(i,k))/deltat) !AL
+ nctend(i,k)=max(0._r8,(ncmax-nc(i,k))/deltat)
+ end if
+
+ if (do_cldice .and. nitend(i,k).gt.0._r8.and.ni(i,k)+nitend(i,k)*deltat.gt.nimax) then
+ nitncons(i,k) = nitncons(i,k) + nitend(i,k)-max(0._r8,(nimax-ni(i,k))/deltat) !AL
+ nitend(i,k)=max(0._r8,(nimax-ni(i,k))/deltat)
+ end if
+
+ ! get final values for precipitation q and N, based on
+ ! flux of precip from above, source/sink term, and terminal fallspeed
+ ! see eq. 15-16 in MG2008
+
+ ! rain
+
+ if (qric(i,k).ge.qsmall) then
+ if (k.eq.top_lev) then
+ qric(i,k)=qrtend(i,k)*dz(i,k)/cldmax(i,k)/umr(k)
+ nric(i,k)=nrtend(i,k)*dz(i,k)/cldmax(i,k)/unr(k)
+ else
+ qric(i,k) = (rho(i,k-1)*umr(k-1)*qric(i,k-1)*cldmax(i,k-1)+ &
+ (rho(i,k)*dz(i,k)*qrtend(i,k)))/(umr(k)*rho(i,k)*cldmax(i,k))
+ nric(i,k) = (rho(i,k-1)*unr(k-1)*nric(i,k-1)*cldmax(i,k-1)+ &
+ (rho(i,k)*dz(i,k)*nrtend(i,k)))/(unr(k)*rho(i,k)*cldmax(i,k))
+
+ end if
+ else
+ qric(i,k)=0._r8
+ nric(i,k)=0._r8
+ end if
+
+ ! snow
+
+ if (qniic(i,k).ge.qsmall) then
+ if (k.eq.top_lev) then
+ qniic(i,k)=qnitend(i,k)*dz(i,k)/cldmax(i,k)/ums(k)
+ nsic(i,k)=nstend(i,k)*dz(i,k)/cldmax(i,k)/uns(k)
+ else
+ qniic(i,k) = (rho(i,k-1)*ums(k-1)*qniic(i,k-1)*cldmax(i,k-1)+ &
+ (rho(i,k)*dz(i,k)*qnitend(i,k)))/(ums(k)*rho(i,k)*cldmax(i,k))
+ nsic(i,k) = (rho(i,k-1)*uns(k-1)*nsic(i,k-1)*cldmax(i,k-1)+ &
+ (rho(i,k)*dz(i,k)*nstend(i,k)))/(uns(k)*rho(i,k)*cldmax(i,k))
+ end if
+ else
+ qniic(i,k)=0._r8
+ nsic(i,k)=0._r8
+ end if
+
+ ! calculate precipitation flux at surface
+ ! divide by density of water to get units of m/s
+
+ prect(i) = prect(i)+(qrtend(i,k)*dz(i,k)*rho(i,k)+&
+ qnitend(i,k)*dz(i,k)*rho(i,k))/rhow
+ preci(i) = preci(i)+qnitend(i,k)*dz(i,k)*rho(i,k)/rhow
+
+ ! convert rain rate from m/s to mm/hr
+
+ rainrt(i,k)=qric(i,k)*rho(i,k)*umr(k)/rhow*3600._r8*1000._r8
+
+ ! vertically-integrated precip source/sink terms (note: grid-averaged)
+
+ qrtot = max(qrtot+qrtend(i,k)*dz(i,k)*rho(i,k),0._r8)
+ qstot = max(qstot+qnitend(i,k)*dz(i,k)*rho(i,k),0._r8)
+ nrtot = max(nrtot+nrtend(i,k)*dz(i,k)*rho(i,k),0._r8)
+ nstot = max(nstot+nstend(i,k)*dz(i,k)*rho(i,k),0._r8)
+
+ ! calculate melting and freezing of precip
+
+ ! melt snow at +2 C
+
+ if (t(i,k)+tlat(i,k)/cpp*deltat > 275.15_r8) then
+ if (qstot > 0._r8) then
+
+ ! make sure melting snow doesn't reduce temperature below threshold
+ dum = -xlf/cpp*qstot/(dz(i,k)*rho(i,k))
+ if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt.275.15_r8) then
+ dum = (t(i,k)+tlat(i,k)/cpp*deltat-275.15_r8)*cpp/xlf
+ dum = dum/(xlf/cpp*qstot/(dz(i,k)*rho(i,k)))
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+
+ qric(i,k)=qric(i,k)+dum*qniic(i,k)
+ nric(i,k)=nric(i,k)+dum*nsic(i,k)
+ qniic(i,k)=(1._r8-dum)*qniic(i,k)
+ nsic(i,k)=(1._r8-dum)*nsic(i,k)
+ ! heating tendency
+ tmp=-xlf*dum*qstot/(dz(i,k)*rho(i,k))
+ meltsdt(i,k)=meltsdt(i,k) + tmp
+
+ tlat(i,k)=tlat(i,k)+tmp
+ qrtot=qrtot+dum*qstot
+ nrtot=nrtot+dum*nstot
+ qstot=(1._r8-dum)*qstot
+ nstot=(1._r8-dum)*nstot
+ preci(i)=(1._r8-dum)*preci(i)
+ end if
+ end if
+
+ ! freeze all rain at -5C for Arctic
+
+ if (t(i,k)+tlat(i,k)/cpp*deltat < (tmelt - 5._r8)) then
+
+ if (qrtot > 0._r8) then
+
+ ! make sure freezing rain doesn't increase temperature above threshold
+ dum = xlf/cpp*qrtot/(dz(i,k)*rho(i,k))
+ if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.(tmelt - 5._r8)) then
+ dum = -(t(i,k)+tlat(i,k)/cpp*deltat-(tmelt-5._r8))*cpp/xlf
+ dum = dum/(xlf/cpp*qrtot/(dz(i,k)*rho(i,k)))
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+
+ qniic(i,k)=qniic(i,k)+dum*qric(i,k)
+ nsic(i,k)=nsic(i,k)+dum*nric(i,k)
+ qric(i,k)=(1._r8-dum)*qric(i,k)
+ nric(i,k)=(1._r8-dum)*nric(i,k)
+ ! heating tendency
+ tmp = xlf*dum*qrtot/(dz(i,k)*rho(i,k))
+ frzrdt(i,k)=frzrdt(i,k) + tmp
+
+ tlat(i,k)=tlat(i,k)+tmp
+ qstot=qstot+dum*qrtot
+ qrtot=(1._r8-dum)*qrtot
+ nstot=nstot+dum*nrtot
+ nrtot=(1._r8-dum)*nrtot
+ preci(i)=preci(i)+dum*(prect(i)-preci(i))
+ end if
+ end if
+
+ ! Precip Flux Calculation (Diagnostic)
+ rflx(i,k+1)=(prect(i)-preci(i)) * rhow
+ sflx(i,k+1)=preci(i) * rhow
+
+ ! if rain/snow mix ratio is zero so should number concentration
+
+ if (qniic(i,k).lt.qsmall) then
+ qniic(i,k)=0._r8
+ nsic(i,k)=0._r8
+ end if
+
+ if (qric(i,k).lt.qsmall) then
+ qric(i,k)=0._r8
+ nric(i,k)=0._r8
+ end if
+
+ ! make sure number concentration is a positive number to avoid
+ ! taking root of negative
+
+ nric(i,k)=max(nric(i,k),0._r8)
+ nsic(i,k)=max(nsic(i,k),0._r8)
+
+ !.......................................................................
+ ! get size distribution parameters for fallspeed calculations
+ !......................................................................
+ ! rain
+
+ if (qric(i,k).ge.qsmall) then
+ lamr(k) = (pi*rhow*nric(i,k)/qric(i,k))**(1._r8/3._r8)
+ n0r(k) = nric(i,k)*lamr(k)
+
+ ! check for slope
+ ! change lammax and lammin for rain and snow
+ ! adjust vars
+
+ if (lamr(k).lt.lamminr) then
+
+ lamr(k) = lamminr
+
+ n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow)
+ nric(i,k) = n0r(k)/lamr(k)
+ else if (lamr(k).gt.lammaxr) then
+ lamr(k) = lammaxr
+ n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow)
+ nric(i,k) = n0r(k)/lamr(k)
+ end if
+
+
+ ! 'final' values of number and mass weighted mean fallspeed for rain (m/s)
+
+ unr(k) = min(arn(i,k)*cons4/lamr(k)**br,9.1_r8*rhof(i,k))
+ umr(k) = min(arn(i,k)*cons5/(6._r8*lamr(k)**br),9.1_r8*rhof(i,k))
+
+ else
+ lamr(k) = 0._r8
+ n0r(k) = 0._r8
+ umr(k)=0._r8
+ unr(k)=0._r8
+ end if
+
+ !calculate mean size of combined rain and snow
+
+ if (lamr(k).gt.0._r8) then
+ Artmp = n0r(k) * pi / (2._r8 * lamr(k)**3._r8)
+ else
+ Artmp = 0._r8
+ endif
+
+ if (lamc(k).gt.0._r8) then
+ Actmp = cdist1(k) * pi * gamma(pgam(k)+3._r8)/(4._r8 * lamc(k)**2._r8)
+ else
+ Actmp = 0._r8
+ endif
+
+ if (Actmp.gt.0_r8.or.Artmp.gt.0) then
+ rercld(i,k)=rercld(i,k) + 3._r8 *(qric(i,k) + qcic(i,k)) / (4._r8 * rhow * (Actmp + Artmp))
+ arcld(i,k)=arcld(i,k)+1._r8
+ endif
+
+ !......................................................................
+ ! snow
+
+ if (qniic(i,k).ge.qsmall) then
+ lams(k) = (cons6*cs*nsic(i,k)/ &
+ qniic(i,k))**(1._r8/ds)
+ n0s(k) = nsic(i,k)*lams(k)
+
+ ! check for slope
+ ! adjust vars
+
+ if (lams(k).lt.lammins) then
+ lams(k) = lammins
+ n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*cons6)
+ nsic(i,k) = n0s(k)/lams(k)
+
+ else if (lams(k).gt.lammaxs) then
+ lams(k) = lammaxs
+ n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*cons6)
+ nsic(i,k) = n0s(k)/lams(k)
+ end if
+
+ ! 'final' values of number and mass weighted mean fallspeed for snow (m/s)
+
+ ums(k) = min(asn(i,k)*cons8/(6._r8*lams(k)**bs),1.2_r8*rhof(i,k))
+ uns(k) = min(asn(i,k)*cons7/lams(k)**bs,1.2_r8*rhof(i,k))
+
+ else
+ lams(k) = 0._r8
+ n0s(k) = 0._r8
+ ums(k) = 0._r8
+ uns(k) = 0._r8
+ end if
+
+ !c........................................................................
+ ! sum over sub-step for average process rates
+
+ ! convert rain/snow q and N for output to history, note,
+ ! output is for gridbox average
+
+ qrout(i,k)=qrout(i,k)+qric(i,k)*cldmax(i,k)
+ qsout(i,k)=qsout(i,k)+qniic(i,k)*cldmax(i,k)
+ nrout(i,k)=nrout(i,k)+nric(i,k)*rho(i,k)*cldmax(i,k)
+ nsout(i,k)=nsout(i,k)+nsic(i,k)*rho(i,k)*cldmax(i,k)
+
+ tlat1(i,k)=tlat1(i,k)+tlat(i,k)
+ qvlat1(i,k)=qvlat1(i,k)+qvlat(i,k)
+ qctend1(i,k)=qctend1(i,k)+qctend(i,k)
+ qitend1(i,k)=qitend1(i,k)+qitend(i,k)
+ nctend1(i,k)=nctend1(i,k)+nctend(i,k)
+ nitend1(i,k)=nitend1(i,k)+nitend(i,k)
+
+ t(i,k)=t(i,k)+tlat(i,k)*deltat/cpp
+ q(i,k)=q(i,k)+qvlat(i,k)*deltat
+ qc(i,k)=qc(i,k)+qctend(i,k)*deltat
+ qi(i,k)=qi(i,k)+qitend(i,k)*deltat
+ nc(i,k)=nc(i,k)+nctend(i,k)*deltat
+ ni(i,k)=ni(i,k)+nitend(i,k)*deltat
+
+ rainrt1(i,k)=rainrt1(i,k)+rainrt(i,k)
+
+ !divide rain radius over substeps for average
+ if (arcld(i,k) .gt. 0._r8) then
+ rercld(i,k)=rercld(i,k)/arcld(i,k)
+ end if
+
+ !! add to summing sub-stepping variable
+ rflx1(i,k+1)=rflx1(i,k+1)+rflx(i,k+1)
+ sflx1(i,k+1)=sflx1(i,k+1)+sflx(i,k+1)
+
+ !c........................................................................
+
+ end do ! k loop
+
+ prect1(i)=prect1(i)+prect(i)
+ preci1(i)=preci1(i)+preci(i)
+
+ end do ! it loop, sub-step
+
+ do k = top_lev, pver
+ rate1ord_cw2pr_st(i,k) = qcsinksum_rate1ord(k)/max(qcsum_rate1ord(k),1.0e-30_r8)
+ end do
+
+300 continue ! continue if no cloud water
+end do ! i loop
+
+! convert dt from sub-step back to full time step
+deltat=deltat*real(iter)
+
+!c.............................................................................
+
+do i=1,ncol
+
+ ! skip all calculations if no cloud water
+ if (ltrue(i).eq.0) then
+
+ do k=1,top_lev-1
+ ! assign zero values for effective radius above 1 mbar
+ effc(i,k)=0._r8
+ effi(i,k)=0._r8
+ effc_fn(i,k)=0._r8
+ lamcrad(i,k)=0._r8
+ pgamrad(i,k)=0._r8
+ deffi(i,k)=0._r8
+ end do
+
+ do k=top_lev,pver
+ ! assign default values for effective radius
+ effc(i,k)=10._r8
+ effi(i,k)=25._r8
+ effc_fn(i,k)=10._r8
+ lamcrad(i,k)=0._r8
+ pgamrad(i,k)=0._r8
+ deffi(i,k)=0._r8
+ end do
+ goto 500
+ end if
+
+ ! initialize nstep for sedimentation sub-steps
+ nstep = 1
+
+ ! divide precip rate by number of sub-steps to get average over time step
+
+ prect(i)=prect1(i)/real(iter)
+ preci(i)=preci1(i)/real(iter)
+
+ do k=top_lev,pver
+
+ ! assign variables back to start-of-timestep values before updating after sub-steps
+
+ t(i,k)=t1(i,k)
+ q(i,k)=q1(i,k)
+ qc(i,k)=qc1(i,k)
+ qi(i,k)=qi1(i,k)
+ nc(i,k)=nc1(i,k)
+ ni(i,k)=ni1(i,k)
+
+ ! divide microphysical tendencies by number of sub-steps to get average over time step
+
+ tlat(i,k)=tlat1(i,k)/real(iter)
+ qvlat(i,k)=qvlat1(i,k)/real(iter)
+ qctend(i,k)=qctend1(i,k)/real(iter)
+ qitend(i,k)=qitend1(i,k)/real(iter)
+ nctend(i,k)=nctend1(i,k)/real(iter)
+ nitend(i,k)=nitend1(i,k)/real(iter)
+
+ rainrt(i,k)=rainrt1(i,k)/real(iter)
+
+ ! divide by number of sub-steps to find final values
+ rflx(i,k+1)=rflx1(i,k+1)/real(iter)
+ sflx(i,k+1)=sflx1(i,k+1)/real(iter)
+
+ ! divide output precip q and N by number of sub-steps to get average over time step
+
+ qrout(i,k)=qrout(i,k)/real(iter)
+ qsout(i,k)=qsout(i,k)/real(iter)
+ nrout(i,k)=nrout(i,k)/real(iter)
+ nsout(i,k)=nsout(i,k)/real(iter)
+
+ ! divide trop_mozart variables by number of sub-steps to get average over time step
+
+ nevapr(i,k) = nevapr(i,k)/real(iter)
+ nevapr2(i,k) = nevapr2(i,k)/real(iter)
+ evapsnow(i,k) = evapsnow(i,k)/real(iter)
+ prain(i,k) = prain(i,k)/real(iter)
+ prodsnow(i,k) = prodsnow(i,k)/real(iter)
+ cmeout(i,k) = cmeout(i,k)/real(iter)
+
+ cmeiout(i,k) = cmeiout(i,k)/real(iter)
+ meltsdt(i,k) = meltsdt(i,k)/real(iter)
+ frzrdt (i,k) = frzrdt (i,k)/real(iter)
+
+
+ ! microphysics output
+ prao(i,k)=prao(i,k)/real(iter)
+ prco(i,k)=prco(i,k)/real(iter)
+ mnuccco(i,k)=mnuccco(i,k)/real(iter)
+ mnuccto(i,k)=mnuccto(i,k)/real(iter)
+ msacwio(i,k)=msacwio(i,k)/real(iter)
+ psacwso(i,k)=psacwso(i,k)/real(iter)
+ bergso(i,k)=bergso(i,k)/real(iter)
+ bergo(i,k)=bergo(i,k)/real(iter)
+ prcio(i,k)=prcio(i,k)/real(iter)
+ praio(i,k)=praio(i,k)/real(iter)
+
+ mnuccro(i,k)=mnuccro(i,k)/real(iter)
+ pracso (i,k)=pracso (i,k)/real(iter)
+
+ mnuccdo(i,k)=mnuccdo(i,k)/real(iter)
+
+!AL
+ mnudepo(i,k)=mnudepo(i,k)/real(iter)
+ nnuccco(i,k)=nnuccco(i,k)/real(iter)
+ nnuccto(i,k)=nnuccto(i,k)/real(iter)
+ npsacwso(i,k)=npsacwso(i,k)/real(iter)
+ nsubco(i,k)=nsubco(i,k)/real(iter)
+ nprao(i,k)=nprao(i,k)/real(iter)
+ nprc1o(i,k)=nprc1o(i,k)/real(iter)
+ nsacwio(i,k)=nsacwio(i,k)/real(iter)
+ nsubio(i,k)=nsubio(i,k)/real(iter)
+ nprcio(i,k)=nprcio(i,k)/real(iter)
+ npraio(i,k)=npraio(i,k)/real(iter)
+ nnudepo(i,k)=nnudepo(i,k)/real(iter)
+ nnuccdo(i,k)=nnuccdo(i,k)/real(iter)
+ npccno(i,k)=npccno(i,k)/real(iter)
+ nctncons(i,k)=nctncons(i,k)/real(iter)
+ nitncons(i,k)=nitncons(i,k)/real(iter)
+!AL
+
+ ! modify to include snow. in prain & evap (diagnostic here: for wet dep)
+ nevapr(i,k) = nevapr(i,k) + evapsnow(i,k)
+ prer_evap(i,k) = nevapr2(i,k)
+ prain(i,k) = prain(i,k) + prodsnow(i,k)
+
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! calculate sedimentation for cloud water and ice
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ ! update in-cloud cloud mixing ratio and number concentration
+ ! with microphysical tendencies to calculate sedimentation, assign to dummy vars
+ ! note: these are in-cloud values***, hence we divide by cloud fraction
+
+ dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat)/lcldm(i,k)
+ dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat)/icldm(i,k)
+ dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat)/lcldm(i,k),0._r8)
+ dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat)/icldm(i,k),0._r8)
+
+ if (nccons) then
+ dumnc(i,k) = ncnst/rho(i,k)
+ end if
+ if (nicons) then
+ dumni(i,k) = ninst/rho(i,k)
+ end if
+
+ ! obtain new slope parameter to avoid possible singularity
+
+ if (dumi(i,k).ge.qsmall) then
+ ! add upper limit to in-cloud number concentration to prevent numerical error
+ dumni(i,k)=min(dumni(i,k),dumi(i,k)*1.e20_r8)
+
+ lami(k) = (cons1*ci* &
+ dumni(i,k)/dumi(i,k))**(1._r8/di)
+ lami(k)=max(lami(k),lammini)
+ lami(k)=min(lami(k),lammaxi)
+ else
+ lami(k)=0._r8
+ end if
+
+ if (dumc(i,k).ge.qsmall) then
+ ! add upper limit to in-cloud number concentration to prevent numerical error
+ dumnc(i,k)=min(dumnc(i,k),dumc(i,k)*1.e20_r8)
+ ! add lower limit to in-cloud number concentration
+ dumnc(i,k)=max(dumnc(i,k),cdnl/rho(i,k)) ! sghan minimum in #/cm3
+ pgam(k)=0.0005714_r8*(ncic(i,k)/1.e6_r8*rho(i,k))+0.2714_r8
+ pgam(k)=1._r8/(pgam(k)**2)-1._r8
+ pgam(k)=max(pgam(k),2._r8)
+ pgam(k)=min(pgam(k),15._r8)
+
+ lamc(k) = (pi/6._r8*rhow*dumnc(i,k)*gamma(pgam(k)+4._r8)/ &
+ (dumc(i,k)*gamma(pgam(k)+1._r8)))**(1._r8/3._r8)
+ lammin = (pgam(k)+1._r8)/50.e-6_r8
+ lammax = (pgam(k)+1._r8)/2.e-6_r8
+ lamc(k)=max(lamc(k),lammin)
+ lamc(k)=min(lamc(k),lammax)
+ else
+ lamc(k)=0._r8
+ end if
+
+ ! calculate number and mass weighted fall velocity for droplets
+ ! include effects of sub-grid distribution of cloud water
+
+
+ if (dumc(i,k).ge.qsmall) then
+ unc = acn(i,k)*gamma(1._r8+bc+pgam(k))/(lamc(k)**bc*gamma(pgam(k)+1._r8))
+ umc = acn(i,k)*gamma(4._r8+bc+pgam(k))/(lamc(k)**bc*gamma(pgam(k)+4._r8))
+ ! fallspeed for output
+ vtrmc(i,k)=umc
+ else
+ umc = 0._r8
+ unc = 0._r8
+ end if
+
+ ! calculate number and mass weighted fall velocity for cloud ice
+
+ if (dumi(i,k).ge.qsmall) then
+ uni = ain(i,k)*cons16/lami(k)**bi
+ umi = ain(i,k)*cons17/(6._r8*lami(k)**bi)
+ uni=min(uni,1.2_r8*rhof(i,k))
+ umi=min(umi,1.2_r8*rhof(i,k))
+
+ ! fallspeed
+ vtrmi(i,k)=umi
+ else
+ umi = 0._r8
+ uni = 0._r8
+ end if
+
+ fi(k) = g*rho(i,k)*umi
+ fni(k) = g*rho(i,k)*uni
+ fc(k) = g*rho(i,k)*umc
+ fnc(k) = g*rho(i,k)*unc
+
+ ! calculate number of split time steps to ensure courant stability criteria
+ ! for sedimentation calculations
+
+ rgvm = max(fi(k),fc(k),fni(k),fnc(k))
+ nstep = max(int(rgvm*deltat/pdel(i,k)+1._r8),nstep)
+
+ ! redefine dummy variables - sedimentation is calculated over grid-scale
+ ! quantities to ensure conservation
+
+ dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat)
+ dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat)
+ dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat),0._r8)
+ dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat),0._r8)
+
+ if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8
+ if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8
+
+ end do !!! vertical loop
+ do n = 1,nstep !! loop over sub-time step to ensure stability
+
+ do k = top_lev,pver
+ if (do_cldice) then
+ falouti(k) = fi(k)*dumi(i,k)
+ faloutni(k) = fni(k)*dumni(i,k)
+ else
+ falouti(k) = 0._r8
+ faloutni(k) = 0._r8
+ end if
+
+ faloutc(k) = fc(k)*dumc(i,k)
+ faloutnc(k) = fnc(k)*dumnc(i,k)
+ end do
+
+ ! top of model
+
+ k = top_lev
+ faltndi = falouti(k)/pdel(i,k)
+ faltndni = faloutni(k)/pdel(i,k)
+ faltndc = faloutc(k)/pdel(i,k)
+ faltndnc = faloutnc(k)/pdel(i,k)
+
+ ! add fallout terms to microphysical tendencies
+
+ qitend(i,k) = qitend(i,k)-faltndi/nstep
+ nitend(i,k) = nitend(i,k)-faltndni/nstep
+ qctend(i,k) = qctend(i,k)-faltndc/nstep
+ nctend(i,k) = nctend(i,k)-faltndnc/nstep
+
+ ! sedimentation tendencies for output
+ qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep
+ qisedten(i,k)=qisedten(i,k)-faltndi/nstep
+!AL
+ nqcsedten(i,k)=nqcsedten(i,k)-faltndnc/nstep
+ nqisedten(i,k)=nqisedten(i,k)-faltndni/nstep
+!AL
+
+ dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep
+ dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep
+ dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep
+ dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep
+
+ do k = top_lev+1,pver
+
+ ! for cloud liquid and ice, if cloud fraction increases with height
+ ! then add flux from above to both vapor and cloud water of current level
+ ! this means that flux entering clear portion of cell from above evaporates
+ ! instantly
+
+ dum=lcldm(i,k)/lcldm(i,k-1)
+ dum=min(dum,1._r8)
+ dum1=icldm(i,k)/icldm(i,k-1)
+ dum1=min(dum1,1._r8)
+
+ faltndqie=(falouti(k)-falouti(k-1))/pdel(i,k)
+ faltndi=(falouti(k)-dum1*falouti(k-1))/pdel(i,k)
+ faltndni=(faloutni(k)-dum1*faloutni(k-1))/pdel(i,k)
+ faltndqce=(faloutc(k)-faloutc(k-1))/pdel(i,k)
+ faltndc=(faloutc(k)-dum*faloutc(k-1))/pdel(i,k)
+ faltndnc=(faloutnc(k)-dum*faloutnc(k-1))/pdel(i,k)
+
+ ! add fallout terms to eulerian tendencies
+
+ qitend(i,k) = qitend(i,k)-faltndi/nstep
+ nitend(i,k) = nitend(i,k)-faltndni/nstep
+ qctend(i,k) = qctend(i,k)-faltndc/nstep
+ nctend(i,k) = nctend(i,k)-faltndnc/nstep
+
+ ! sedimentation tendencies for output
+ qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep
+ qisedten(i,k)=qisedten(i,k)-faltndi/nstep
+!AL
+ nqcsedten(i,k)=nqcsedten(i,k)-faltndnc/nstep
+ nqisedten(i,k)=nqisedten(i,k)-faltndni/nstep
+!AL
+ ! add terms to to evap/sub of cloud water
+
+ qvlat(i,k)=qvlat(i,k)-(faltndqie-faltndi)/nstep
+ ! for output
+ qisevap(i,k)=qisevap(i,k)-(faltndqie-faltndi)/nstep
+ qvlat(i,k)=qvlat(i,k)-(faltndqce-faltndc)/nstep
+ ! for output
+ qcsevap(i,k)=qcsevap(i,k)-(faltndqce-faltndc)/nstep
+
+ tlat(i,k)=tlat(i,k)+(faltndqie-faltndi)*xxls/nstep
+ tlat(i,k)=tlat(i,k)+(faltndqce-faltndc)*xxlv/nstep
+
+ dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep
+ dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep
+ dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep
+ dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep
+
+ Fni(K)=MAX(Fni(K)/pdel(i,K),Fni(K-1)/pdel(i,K-1))*pdel(i,K)
+ FI(K)=MAX(FI(K)/pdel(i,K),FI(K-1)/pdel(i,K-1))*pdel(i,K)
+ fnc(k)=max(fnc(k)/pdel(i,k),fnc(k-1)/pdel(i,k-1))*pdel(i,k)
+ Fc(K)=MAX(Fc(K)/pdel(i,K),Fc(K-1)/pdel(i,K-1))*pdel(i,K)
+
+ end do !! k loop
+
+ ! units below are m/s
+ ! cloud water/ice sedimentation flux at surface
+ ! is added to precip flux at surface to get total precip (cloud + precip water)
+ ! rate
+
+ prect(i) = prect(i)+(faloutc(pver)+falouti(pver))/g/nstep/1000._r8
+ preci(i) = preci(i)+(falouti(pver))/g/nstep/1000._r8
+
+ ! Add fallout to Precip Flux: note unit change m/s *kg/m3 = kg/m2
+ do k = top_lev,pver
+ rflx(i,k+1)=rflx(i,k+1)+(faloutc(k))/g/nstep/1000._r8 * rhow
+ sflx(i,k+1)=sflx(i,k+1)+(falouti(k))/g/nstep/1000._r8 * rhow
+ end do
+
+ end do !! nstep loop
+
+ ! end sedimentation
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ ! get new update for variables that includes sedimentation tendency
+ ! note : here dum variables are grid-average, NOT in-cloud
+
+ do k=top_lev,pver
+
+ dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8)
+ dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8)
+ dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8)
+ dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8)
+
+ if (nccons) then
+ dumnc(i,k) = ncnst/rho(i,k)*lcldm(i,k)
+ end if
+ if (nicons) then
+ dumni(i,k) = ninst/rho(i,k)*icldm(i,k)
+ end if
+
+ if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8
+ if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8
+
+ ! calculate instantaneous processes (melting, homogeneous freezing)
+ if (do_cldice) then
+
+ if (t(i,k)+tlat(i,k)/cpp*deltat > tmelt) then
+ if (dumi(i,k) > 0._r8) then
+
+ ! limit so that melting does not push temperature below freezing
+ dum = -dumi(i,k)*xlf/cpp
+ if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt.tmelt) then
+ dum = (t(i,k)+tlat(i,k)/cpp*deltat-tmelt)*cpp/xlf
+ dum = dum/dumi(i,k)*xlf/cpp
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+
+ qctend(i,k)=qctend(i,k)+dum*dumi(i,k)/deltat
+
+ ! for output
+ melto(i,k)=dum*dumi(i,k)/deltat
+
+ ! assume melting ice produces droplet
+ ! mean volume radius of 8 micron
+
+ nctend(i,k)=nctend(i,k)+3._r8*dum*dumi(i,k)/deltat/ &
+ (4._r8*pi*5.12e-16_r8*rhow)
+!AL
+ ! for output
+ nmelto(i,k)=3._r8*dum*dumi(i,k)/deltat/ &
+ (4._r8*pi*5.12e-16_r8*rhow)
+ nimelto(i,k)=nitend(i,k)-((1._r8-dum)*dumni(i,k)-ni(i,k))/deltat
+!AL
+ qitend(i,k)=((1._r8-dum)*dumi(i,k)-qi(i,k))/deltat
+ nitend(i,k)=((1._r8-dum)*dumni(i,k)-ni(i,k))/deltat
+ tlat(i,k)=tlat(i,k)-xlf*dum*dumi(i,k)/deltat
+
+ end if
+ end if
+
+ ! homogeneously freeze droplets at -40 C
+
+ if (t(i,k)+tlat(i,k)/cpp*deltat < 233.15_r8) then
+ if (dumc(i,k) > 0._r8) then
+
+ ! limit so that freezing does not push temperature above threshold
+ dum = dumc(i,k)*xlf/cpp
+ if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.233.15_r8) then
+ dum = -(t(i,k)+tlat(i,k)/cpp*deltat-233.15_r8)*cpp/xlf
+ dum = dum/dumc(i,k)*xlf/cpp
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+
+ qitend(i,k)=qitend(i,k)+dum*dumc(i,k)/deltat
+ ! for output
+ homoo(i,k)=dum*dumc(i,k)/deltat
+
+ ! assume 25 micron mean volume radius of homogeneously frozen droplets
+ ! consistent with size of detrained ice in stratiform.F90
+ nitend(i,k)=nitend(i,k)+dum*3._r8*dumc(i,k)/(4._r8*3.14_r8*1.563e-14_r8* &
+ 500._r8)/deltat
+ qctend(i,k)=((1._r8-dum)*dumc(i,k)-qc(i,k))/deltat
+!AL
+ nhomoo(i,k)=nctend(i,k)-((1._r8-dum)*dumnc(i,k)-nc(i,k))/deltat
+ nihomoo(i,k)=dum*3._r8*dumc(i,k)/(4._r8*3.14_r8*1.563e-14_r8* &
+ 500._r8)/deltat
+!AL
+ nctend(i,k)=((1._r8-dum)*dumnc(i,k)-nc(i,k))/deltat
+ tlat(i,k)=tlat(i,k)+xlf*dum*dumc(i,k)/deltat
+ end if
+ end if
+
+ ! remove any excess over-saturation, which is possible due to non-linearity when adding
+ ! together all microphysical processes
+ ! follow code similar to old CAM scheme
+
+ qtmp=q(i,k)+qvlat(i,k)*deltat
+ ttmp=t(i,k)+tlat(i,k)/cpp*deltat
+
+ esn = svp_water(ttmp) ! use rhw to allow ice supersaturation
+ qsn = svp_to_qsat(esn, p(i,k))
+
+ if (qtmp > qsn .and. qsn > 0) then
+ ! expression below is approximate since there may be ice deposition
+ dum = (qtmp-qsn)/(1._r8+cons27*qsn/(cpp*rv*ttmp**2))/deltat
+ ! add to output cme
+ cmeout(i,k) = cmeout(i,k)+dum
+ ! now add to tendencies, partition between liquid and ice based on temperature
+ if (ttmp > 268.15_r8) then
+ dum1=0.0_r8
+ ! now add to tendencies, partition between liquid and ice based on te
+ else if (ttmp < 238.15_r8) then
+ dum1=1.0_r8
+ else
+ dum1=(268.15_r8-ttmp)/30._r8
+ end if
+
+ dum = (qtmp-qsn)/(1._r8+(xxls*dum1+xxlv*(1._r8-dum1))**2 &
+ *qsn/(cpp*rv*ttmp**2))/deltat
+ qctend(i,k)=qctend(i,k)+dum*(1._r8-dum1)
+ ! for output
+ qcreso(i,k)=dum*(1._r8-dum1)
+ qitend(i,k)=qitend(i,k)+dum*dum1
+ qireso(i,k)=dum*dum1
+ qvlat(i,k)=qvlat(i,k)-dum
+ ! for output
+ qvres(i,k)=-dum
+ tlat(i,k)=tlat(i,k)+dum*(1._r8-dum1)*xxlv+dum*dum1*xxls
+ end if
+ end if
+
+ !...............................................................................
+ ! calculate effective radius for pass to radiation code
+ ! if no cloud water, default value is 10 micron for droplets,
+ ! 25 micron for cloud ice
+
+ ! update cloud variables after instantaneous processes to get effective radius
+ ! variables are in-cloud to calculate size dist parameters
+
+ dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8)/lcldm(i,k)
+ dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8)/icldm(i,k)
+ dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8)/lcldm(i,k)
+ dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8)/icldm(i,k)
+
+ if (nccons) then
+ dumnc(i,k) = ncnst/rho(i,k)
+ end if
+ if (nicons) then
+ dumni(i,k) = ninst/rho(i,k)
+ end if
+
+ ! limit in-cloud mixing ratio to reasonable value of 5 g kg-1
+
+ dumc(i,k)=min(dumc(i,k),5.e-3_r8)
+ dumi(i,k)=min(dumi(i,k),5.e-3_r8)
+
+ !...................
+ ! cloud ice effective radius
+
+ if (dumi(i,k).ge.qsmall) then
+
+ if (nicons) then
+ ! make sure ni is consistent with the constant N by adjusting
+ ! tendency, need to multiply by cloud fraction
+ ! note that nitend may be further adjusted below if mean crystal
+ ! size is out of bounds
+ nitend(i,k) = (ninst/rho(i,k)*icldm(i,k) - ni(i,k))/deltat
+ end if
+
+ ! add upper limit to in-cloud number concentration to prevent numerical error
+ dumni(i,k)=min(dumni(i,k),dumi(i,k)*1.e20_r8)
+ lami(k) = (cons1*ci*dumni(i,k)/dumi(i,k))**(1._r8/di)
+
+ if (lami(k).lt.lammini) then
+ lami(k) = lammini
+ n0i(k) = lami(k)**(di+1._r8)*dumi(i,k)/(ci*cons1)
+ niic(i,k) = n0i(k)/lami(k)
+ ! adjust number conc if needed to keep mean size in reasonable range
+ if (do_cldice) then
+ nitnszmn(i,k)=nitnszmn(i,k) + nitend(i,k)-(niic(i,k)*icldm(i,k)-ni(i,k))/deltat !AL
+ nitend(i,k)=(niic(i,k)*icldm(i,k)-ni(i,k))/deltat
+ endif
+ else if (lami(k).gt.lammaxi) then
+ lami(k) = lammaxi
+ n0i(k) = lami(k)**(di+1._r8)*dumi(i,k)/(ci*cons1)
+ niic(i,k) = n0i(k)/lami(k)
+ ! adjust number conc if needed to keep mean size in reasonable range
+ if (do_cldice)then
+ nitnszmx(i,k)=nitnszmx(i,k) + nitend(i,k)-(niic(i,k)*icldm(i,k)-ni(i,k))/deltat !AL
+ nitend(i,k)=(niic(i,k)*icldm(i,k)-ni(i,k))/deltat
+ endif
+ end if
+ effi(i,k) = 1.5_r8/lami(k)*1.e6_r8
+
+ else
+ effi(i,k) = 25._r8
+ end if
+
+ ! NOTE: If CARMA is doing the ice microphysics, then the ice effective
+ ! radius has already been determined from the size distribution.
+ if (.not. do_cldice) then
+ effi(i,k) = re_ice(i,k) * 1e6_r8 ! m -> um
+ end if
+
+ !...................
+ ! cloud droplet effective radius
+
+ if (dumc(i,k).ge.qsmall) then
+
+ if (nccons) then
+ ! make sure nc is consistent with the constant N by adjusting
+ ! tendency, need to multiply by cloud fraction
+ ! note that nctend may be further adjusted below if mean droplet
+ ! size is out of bounds
+ nctend(i,k) = (ncnst/rho(i,k)*lcldm(i,k) - nc(i,k))/deltat
+ end if
+
+ ! add upper limit to in-cloud number concentration to prevent numerical error
+ dumnc(i,k)=min(dumnc(i,k),dumc(i,k)*1.e20_r8)
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! set tendency to ensure minimum droplet concentration
+ ! after update by microphysics, except when lambda exceeds bounds on mean drop
+ ! size or if there is no cloud water
+ if (dumnc(i,k).lt.cdnl/rho(i,k)) then
+!AL
+ nctnnbmn(i,k)=nctnnbmn(i,k) + nctend(i,k)-(cdnl/rho(i,k)*lcldm(i,k)-nc(i,k))/deltat
+!AL
+ nctend(i,k)=(cdnl/rho(i,k)*lcldm(i,k)-nc(i,k))/deltat
+ end if
+ dumnc(i,k)=max(dumnc(i,k),cdnl/rho(i,k)) ! sghan minimum in #/cm3
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ pgam(k)=0.0005714_r8*(ncic(i,k)/1.e6_r8*rho(i,k))+0.2714_r8
+ pgam(k)=1._r8/(pgam(k)**2)-1._r8
+ pgam(k)=max(pgam(k),2._r8)
+ pgam(k)=min(pgam(k),15._r8)
+
+ lamc(k) = (pi/6._r8*rhow*dumnc(i,k)*gamma(pgam(k)+4._r8)/ &
+ (dumc(i,k)*gamma(pgam(k)+1._r8)))**(1._r8/3._r8)
+ lammin = (pgam(k)+1._r8)/50.e-6_r8
+ ! Multiply by omsm to fit within RRTMG's table.
+ lammax = (pgam(k)+1._r8)*omsm/2.e-6_r8
+ if (lamc(k).lt.lammin) then
+ lamc(k) = lammin
+ ncic(i,k) = 6._r8*lamc(k)**3*dumc(i,k)* &
+ gamma(pgam(k)+1._r8)/ &
+ (pi*rhow*gamma(pgam(k)+4._r8))
+ ! adjust number conc if needed to keep mean size in reasonable range
+!AL
+ nctnszmn(i,k)=nctnszmn(i,k) + nctend(i,k)-(ncic(i,k)*lcldm(i,k)-nc(i,k))/deltat
+!AL
+ nctend(i,k)=(ncic(i,k)*lcldm(i,k)-nc(i,k))/deltat
+
+ else if (lamc(k).gt.lammax) then
+ lamc(k) = lammax
+ ncic(i,k) = 6._r8*lamc(k)**3*dumc(i,k)* &
+ gamma(pgam(k)+1._r8)/ &
+ (pi*rhow*gamma(pgam(k)+4._r8))
+ ! adjust number conc if needed to keep mean size in reasonable range
+!AL
+ nctnszmx(i,k)=nctnszmx(i,k) + nctend(i,k)-(ncic(i,k)*lcldm(i,k)-nc(i,k))/deltat
+!AL
+ nctend(i,k)=(ncic(i,k)*lcldm(i,k)-nc(i,k))/deltat
+ end if
+
+ effc(i,k) = &
+ gamma(pgam(k)+4._r8)/ &
+ gamma(pgam(k)+3._r8)/lamc(k)/2._r8*1.e6_r8
+ !assign output fields for shape here
+ lamcrad(i,k)=lamc(k)
+ pgamrad(i,k)=pgam(k)
+
+ else
+ effc(i,k) = 10._r8
+ lamcrad(i,k)=0._r8
+ pgamrad(i,k)=0._r8
+ end if
+
+ ! ice effective diameter for david mitchell's optics
+ if (do_cldice) then
+ deffi(i,k)=effi(i,k)*rhoi/917._r8*2._r8
+ else
+ deffi(i,k)=effi(i,k) * 2._r8
+ end if
+
+
+!!! recalculate effective radius for constant number, in order to separate
+ ! first and second indirect effects
+ ! assume constant number of 10^8 kg-1
+
+ dumnc(i,k)=1.e8_r8
+
+ if (dumc(i,k).ge.qsmall) then
+ pgam(k)=0.0005714_r8*(ncic(i,k)/1.e6_r8*rho(i,k))+0.2714_r8
+ pgam(k)=1._r8/(pgam(k)**2)-1._r8
+ pgam(k)=max(pgam(k),2._r8)
+ pgam(k)=min(pgam(k),15._r8)
+
+ lamc(k) = (pi/6._r8*rhow*dumnc(i,k)*gamma(pgam(k)+4._r8)/ &
+ (dumc(i,k)*gamma(pgam(k)+1._r8)))**(1._r8/3._r8)
+ lammin = (pgam(k)+1._r8)/50.e-6_r8
+ lammax = (pgam(k)+1._r8)/2.e-6_r8
+ if (lamc(k).lt.lammin) then
+ lamc(k) = lammin
+ else if (lamc(k).gt.lammax) then
+ lamc(k) = lammax
+ end if
+ effc_fn(i,k) = &
+ gamma(pgam(k)+4._r8)/ &
+ gamma(pgam(k)+3._r8)/lamc(k)/2._r8*1.e6_r8
+
+ else
+ effc_fn(i,k) = 10._r8
+ end if
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1!
+
+ end do ! vertical k loop
+
+500 continue
+
+ do k=top_lev,pver
+ ! if updated q (after microphysics) is zero, then ensure updated n is also zero
+
+ if (qc(i,k)+qctend(i,k)*deltat.lt.qsmall) then !AL
+ nctnncld(i,k) = nctnncld(i,k) + nctend(i,k) +nc(i,k)/deltat
+ nctend(i,k)=-nc(i,k)/deltat
+ endif
+ if (do_cldice .and. qi(i,k)+qitend(i,k)*deltat.lt.qsmall)then !AL
+ nitnncld(i,k) = nitnncld(i,k) + nitend(i,k) +ni(i,k)/deltat
+ nitend(i,k)=-ni(i,k)/deltat
+ endif
+ end do
+
+end do ! i loop
+
+! add snow ouptut
+do i = 1,ncol
+ do k=top_lev,pver
+ if (qsout(i,k).gt.1.e-7_r8.and.nsout(i,k).gt.0._r8) then
+ dsout(i,k)=3._r8*rhosn/917._r8*(pi * rhosn * nsout(i,k)/qsout(i,k))**(-1._r8/3._r8)
+ endif
+ end do
+end do
+
+!calculate effective radius of rain and snow in microns for COSP using Eq. 9 of COSP v1.3 manual
+do i = 1,ncol
+ do k=top_lev,pver
+ !! RAIN
+ if (qrout(i,k).gt.1.e-7_r8.and.nrout(i,k).gt.0._r8) then
+ reff_rain(i,k)=1.5_r8*(pi * rhow * nrout(i,k)/qrout(i,k))**(-1._r8/3._r8)*1.e6_r8
+ endif
+ !! SNOW
+ if (qsout(i,k).gt.1.e-7_r8.and.nsout(i,k).gt.0._r8) then
+ reff_snow(i,k)=1.5_r8*(pi * rhosn * nsout(i,k)/qsout(i,k))**(-1._r8/3._r8)*1.e6_r8
+ end if
+ end do
+end do
+
+! analytic radar reflectivity
+! formulas from Matthew Shupe, NOAA/CERES
+! *****note: radar reflectivity is local (in-precip average)
+! units of mm^6/m^3
+
+do i = 1,ncol
+ do k=top_lev,pver
+ if (qc(i,k)+qctend(i,k)*deltat.ge.qsmall .and. nc(i,k)+nctend(i,k)*deltat.gt.10._r8) then
+ dum=((qc(i,k)+qctend(i,k)*deltat)/lcldm(i,k)*rho(i,k)*1000._r8)**2 &
+ /(0.109_r8*(nc(i,k)+nctend(i,k)*deltat)/lcldm(i,k)*rho(i,k)/1.e6_r8)*lcldm(i,k)/cldmax(i,k)
+ else
+ dum=0._r8
+ end if
+ if (qi(i,k)+qitend(i,k)*deltat.ge.qsmall) then
+ dum1=((qi(i,k)+qitend(i,k)*deltat)*rho(i,k)/icldm(i,k)*1000._r8/0.1_r8)**(1._r8/0.63_r8)*icldm(i,k)/cldmax(i,k)
+ else
+ dum1=0._r8
+ end if
+
+ if (qsout(i,k).ge.qsmall) then
+ dum1=dum1+(qsout(i,k)*rho(i,k)*1000._r8/0.1_r8)**(1._r8/0.63_r8)
+ end if
+
+ refl(i,k)=dum+dum1
+
+ ! add rain rate, but for 37 GHz formulation instead of 94 GHz
+ ! formula approximated from data of Matrasov (2007)
+ ! rainrt is the rain rate in mm/hr
+ ! reflectivity (dum) is in DBz
+
+ if (rainrt(i,k).ge.0.001_r8) then
+ dum=log10(rainrt(i,k)**6._r8)+16._r8
+
+ ! convert from DBz to mm^6/m^3
+
+ dum = 10._r8**(dum/10._r8)
+ else
+ ! don't include rain rate in R calculation for values less than 0.001 mm/hr
+ dum=0._r8
+ end if
+
+ ! add to refl
+
+ refl(i,k)=refl(i,k)+dum
+
+ !output reflectivity in Z.
+ areflz(i,k)=refl(i,k)
+
+ ! convert back to DBz
+
+ if (refl(i,k).gt.minrefl) then
+ refl(i,k)=10._r8*log10(refl(i,k))
+ else
+ refl(i,k)=-9999._r8
+ end if
+
+ !set averaging flag
+ if (refl(i,k).gt.mindbz) then
+ arefl(i,k)=refl(i,k)
+ frefl(i,k)=1.0_r8
+ else
+ arefl(i,k)=0._r8
+ areflz(i,k)=0._r8
+ frefl(i,k)=0._r8
+ end if
+
+ ! bound cloudsat reflectivity
+
+ csrfl(i,k)=min(csmax,refl(i,k))
+
+ !set averaging flag
+ if (csrfl(i,k).gt.csmin) then
+ acsrfl(i,k)=refl(i,k)
+ fcsrfl(i,k)=1.0_r8
+ else
+ acsrfl(i,k)=0._r8
+ fcsrfl(i,k)=0._r8
+ end if
+
+ end do
+end do
+
+
+! averaging for snow and rain number and diameter
+
+qrout2(:,:)=0._r8
+qsout2(:,:)=0._r8
+nrout2(:,:)=0._r8
+nsout2(:,:)=0._r8
+drout2(:,:)=0._r8
+dsout2(:,:)=0._r8
+freqs(:,:)=0._r8
+freqr(:,:)=0._r8
+do i = 1,ncol
+ do k=top_lev,pver
+ if (qrout(i,k).gt.1.e-7_r8.and.nrout(i,k).gt.0._r8) then
+ qrout2(i,k)=qrout(i,k)
+ nrout2(i,k)=nrout(i,k)
+ drout2(i,k)=(pi * rhow * nrout(i,k)/qrout(i,k))**(-1._r8/3._r8)
+ freqr(i,k)=1._r8
+ endif
+ if (qsout(i,k).gt.1.e-7_r8.and.nsout(i,k).gt.0._r8) then
+ qsout2(i,k)=qsout(i,k)
+ nsout2(i,k)=nsout(i,k)
+ dsout2(i,k)=(pi * rhosn * nsout(i,k)/qsout(i,k))**(-1._r8/3._r8)
+ freqs(i,k)=1._r8
+ endif
+ end do
+end do
+
+! output activated liquid and ice (convert from #/kg -> #/m3)
+do i = 1,ncol
+ do k=top_lev,pver
+ ncai(i,k)=dum2i(i,k)*rho(i,k)
+ ncal(i,k)=dum2l(i,k)*rho(i,k)
+ end do
+end do
+
+
+!redefine fice here....
+nfice(:,:)=0._r8
+do k=top_lev,pver
+ do i=1,ncol
+ dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat)
+ dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat)
+ dumfice=qsout(i,k) + qrout(i,k) + dumc(i,k) + dumi(i,k)
+
+ if (dumfice.gt.qsmall.and.(qsout(i,k)+dumi(i,k).gt.qsmall)) then
+ nfice(i,k)=(qsout(i,k) + dumi(i,k))/dumfice
+ endif
+
+ if (nfice(i,k).gt.1._r8) then
+ nfice(i,k)=1._r8
+ endif
+
+ enddo
+enddo
+
+
+end subroutine micro_mg_tend
+
+!========================================================================
+!UTILITIES
+!========================================================================
+
+pure subroutine micro_mg_get_cols(ncol, nlev, top_lev, qcn, qin, &
+ mgncol, mgcols)
+
+ ! Determines which columns microphysics should operate over by
+ ! checking for non-zero cloud water/ice.
+
+ integer, intent(in) :: ncol ! Number of columns with meaningful data
+ integer, intent(in) :: nlev ! Number of levels to use
+ integer, intent(in) :: top_lev ! Top level for microphysics
+
+ real(r8), intent(in) :: qcn(:,:) ! cloud water mixing ratio (kg/kg)
+ real(r8), intent(in) :: qin(:,:) ! cloud ice mixing ratio (kg/kg)
+
+ integer, intent(out) :: mgncol ! Number of columns MG will use
+ integer, allocatable, intent(out) :: mgcols(:) ! column indices
+
+ integer :: lev_offset ! top_lev - 1 (defined here for consistency)
+ logical :: ltrue(ncol) ! store tests for each column
+
+ integer :: i, ii ! column indices
+
+ if (allocated(mgcols)) deallocate(mgcols)
+
+ lev_offset = top_lev - 1
+
+ ! Using "any" along dimension 2 collapses across levels, but
+ ! not columns, so we know if water is present at any level
+ ! in each column.
+
+ ltrue = any(qcn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2)
+ ltrue = ltrue .or. any(qin(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2)
+
+ ! Scan for true values to get a usable list of indices.
+
+ mgncol = count(ltrue)
+ allocate(mgcols(mgncol))
+ i = 0
+ do ii = 1,ncol
+ if (ltrue(ii)) then
+ i = i + 1
+ mgcols(i) = ii
+ end if
+ end do
+
+end subroutine micro_mg_get_cols
+
+end module micro_mg1_0
diff --git a/src/NorESM/micro_mg2_0.F90 b/src/NorESM/micro_mg2_0.F90
new file mode 100644
index 0000000000..97567f491e
--- /dev/null
+++ b/src/NorESM/micro_mg2_0.F90
@@ -0,0 +1,3325 @@
+module micro_mg2_0
+!---------------------------------------------------------------------------------
+! Purpose:
+! MG microphysics version 2.0 - Update of MG microphysics with
+! prognostic precipitation.
+!
+! Author: Andrew Gettelman, Hugh Morrison, Sean Santos
+! Contributions from: Peter Caldwell, Xiaohong Liu and Steve Ghan
+! Version 2 history: Sep 2011: Development begun.
+! Feb 2013: Added of prognostic precipitation.
+! Aug 2015: Published and released version
+!
+! invoked in CAM by specifying -microphys=mg2.0
+!
+! References:
+!
+! Gettelman, A. and H. Morrison, Advanced Two-Moment Microphysics for Global Models.
+!
+! Part I: Off line tests and comparisons with other schemes.
+!
+! J. Climate, 28, 1268-1287. doi: 10.1175/JCLI-D-14-00102.1, 2015.
+!
+!
+!
+! Gettelman, A., H. Morrison, S. Santos, P. Bogenschutz and P. H. Caldwell
+!
+! Advanced Two-Moment Microphysics for Global Models.
+!
+! Part II: Global model solutions and Aerosol-Cloud Interactions.
+!
+! J. Climate, 28, 1288-1307. doi:10.1175/JCLI-D-14-00103.1 , 2015.
+!
+! for questions contact Hugh Morrison, Andrew Gettelman
+! e-mail: morrison@ucar.edu, andrew@ucar.edu
+!---------------------------------------------------------------------------------
+!
+! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice
+! microphysics in cooperation with the MG liquid microphysics. This is
+! controlled by the do_cldice variable.
+!
+! If do_cldice is false, then MG microphysics should not update CLDICE or
+! NUMICE; it is assumed that the other microphysics scheme will have updated
+! CLDICE and NUMICE. The other microphysics should handle the following
+! processes that would have been done by MG:
+! - Detrainment (liquid and ice)
+! - Homogeneous ice nucleation
+! - Heterogeneous ice nucleation
+! - Bergeron process
+! - Melting of ice
+! - Freezing of cloud drops
+! - Autoconversion (ice -> snow)
+! - Growth/Sublimation of ice
+! - Sedimentation of ice
+!
+! This option has not been updated since the introduction of prognostic
+! precipitation, and probably should be adjusted to cover snow as well.
+!
+!---------------------------------------------------------------------------------
+! Based on micro_mg (restructuring of former cldwat2m_micro)
+! Author: Andrew Gettelman, Hugh Morrison.
+! Contributions from: Xiaohong Liu and Steve Ghan
+! December 2005-May 2010
+! Description in: Morrison and Gettelman, 2008. J. Climate (MG2008)
+! Gettelman et al., 2010 J. Geophys. Res. - Atmospheres (G2010)
+! for questions contact Hugh Morrison, Andrew Gettelman
+! e-mail: morrison@ucar.edu, andrew@ucar.edu
+!---------------------------------------------------------------------------------
+! Code comments added by HM, 093011
+! General code structure:
+!
+! Code is divided into two main subroutines:
+! subroutine micro_mg_init --> initializes microphysics routine, should be called
+! once at start of simulation
+! subroutine micro_mg_tend --> main microphysics routine to be called each time step
+! this also calls several smaller subroutines to calculate
+! microphysical processes and other utilities
+!
+! List of external functions:
+! qsat_water --> for calculating saturation vapor pressure with respect to liquid water
+! qsat_ice --> for calculating saturation vapor pressure with respect to ice
+! gamma --> standard mathematical gamma function
+! .........................................................................
+! List of inputs through use statement in fortran90:
+! Variable Name Description Units
+! .........................................................................
+! gravit acceleration due to gravity m s-2
+! rair dry air gas constant for air J kg-1 K-1
+! tmelt temperature of melting point for water K
+! cpair specific heat at constant pressure for dry air J kg-1 K-1
+! rh2o gas constant for water vapor J kg-1 K-1
+! latvap latent heat of vaporization J kg-1
+! latice latent heat of fusion J kg-1
+! qsat_water external function for calculating liquid water
+! saturation vapor pressure/humidity -
+! qsat_ice external function for calculating ice
+! saturation vapor pressure/humidity pa
+! rhmini relative humidity threshold parameter for
+! nucleating ice -
+! .........................................................................
+! NOTE: List of all inputs/outputs passed through the call/subroutine statement
+! for micro_mg_tend is given below at the start of subroutine micro_mg_tend.
+!---------------------------------------------------------------------------------
+
+! Procedures required:
+! 1) An implementation of the gamma function (if not intrinsic).
+! 2) saturation vapor pressure and specific humidity over water
+! 3) svp over ice
+
+#ifndef HAVE_GAMMA_INTRINSICS
+use shr_spfn_mod, only: gamma => shr_spfn_gamma
+#endif
+
+use wv_sat_methods, only: &
+ qsat_water => wv_sat_qsat_water, &
+ qsat_ice => wv_sat_qsat_ice
+
+! Parameters from the utilities module.
+use micro_mg_utils, only: &
+ r8, &
+ pi, &
+ omsm, &
+ qsmall, &
+ mincld, &
+ rhosn, &
+ rhoi, &
+ rhow, &
+ rhows, &
+ ac, bc, &
+ ai, bi, &
+ aj, bj, &
+ ar, br, &
+ as, bs, &
+ mi0, &
+ rising_factorial
+
+implicit none
+private
+save
+
+public :: &
+ micro_mg_init, &
+ micro_mg_get_cols, &
+ micro_mg_tend
+
+! Switches for specification rather than prediction of droplet and crystal number
+! note: number will be adjusted as needed to keep mean size within bounds,
+! even when specified droplet or ice number is used
+!
+! If constant cloud ice number is set (nicons = .true.),
+! then all microphysical processes except mass transfer due to ice nucleation
+! (mnuccd) are based on the fixed cloud ice number. Calculation of
+! mnuccd follows from the prognosed ice crystal number ni.
+
+logical :: nccons ! nccons = .true. to specify constant cloud droplet number
+logical :: nicons ! nicons = .true. to specify constant cloud ice number
+
+! specified ice and droplet number concentrations
+! note: these are local in-cloud values, not grid-mean
+real(r8) :: ncnst ! droplet num concentration when nccons=.true. (m-3)
+real(r8) :: ninst ! ice num concentration when nicons=.true. (m-3)
+
+!=========================================================
+! Private module parameters
+!=========================================================
+
+!Range of cloudsat reflectivities (dBz) for analytic simulator
+real(r8), parameter :: csmin = -30._r8
+real(r8), parameter :: csmax = 26._r8
+real(r8), parameter :: mindbz = -99._r8
+real(r8), parameter :: minrefl = 1.26e-10_r8 ! minrefl = 10._r8**(mindbz/10._r8)
+
+! autoconversion size threshold for cloud ice to snow (m)
+real(r8) :: dcs
+
+! minimum mass of new crystal due to freezing of cloud droplets done
+! externally (kg)
+real(r8), parameter :: mi0l_min = 4._r8/3._r8*pi*rhow*(4.e-6_r8)**3
+
+! Ice number sublimation parameter. Assume some decrease in ice number with sublimation if non-zero. Else, no decrease in number with sublimation.
+ real(r8), parameter :: sublim_factor =0.0_r8 !number sublimation factor.
+
+
+!=========================================================
+! Constants set in initialization
+!=========================================================
+
+! Set using arguments to micro_mg_init
+real(r8) :: g ! gravity
+real(r8) :: r ! dry air gas constant
+real(r8) :: rv ! water vapor gas constant
+real(r8) :: cpp ! specific heat of dry air
+real(r8) :: tmelt ! freezing point of water (K)
+
+! latent heats of:
+real(r8) :: xxlv ! vaporization
+real(r8) :: xlf ! freezing
+real(r8) :: xxls ! sublimation
+
+real(r8) :: rhmini ! Minimum rh for ice cloud fraction > 0.
+
+! flags
+logical :: microp_uniform
+logical :: do_cldice
+logical :: use_hetfrz_classnuc
+
+real(r8) :: rhosu ! typical 850mn air density
+
+real(r8) :: icenuct ! ice nucleation temperature: currently -5 degrees C
+
+real(r8) :: snowmelt ! what temp to melt all snow: currently 2 degrees C
+real(r8) :: rainfrze ! what temp to freeze all rain: currently -5 degrees C
+
+! additional constants to help speed up code
+real(r8) :: gamma_br_plus1
+real(r8) :: gamma_br_plus4
+real(r8) :: gamma_bs_plus1
+real(r8) :: gamma_bs_plus4
+real(r8) :: gamma_bi_plus1
+real(r8) :: gamma_bi_plus4
+real(r8) :: gamma_bj_plus1
+real(r8) :: gamma_bj_plus4
+real(r8) :: xxlv_squared
+real(r8) :: xxls_squared
+
+character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method
+real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor
+
+logical :: allow_sed_supersat ! Allow supersaturated conditions after sedimentation loop
+logical :: do_sb_physics ! do SB 2001 autoconversion or accretion physics
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine micro_mg_init( &
+ kind, gravit, rair, rh2o, cpair, &
+ tmelt_in, latvap, latice, &
+ rhmini_in, micro_mg_dcs, &
+ microp_uniform_in, do_cldice_in, use_hetfrz_classnuc_in, &
+ micro_mg_precip_frac_method_in, micro_mg_berg_eff_factor_in, &
+ allow_sed_supersat_in, do_sb_physics_in, &
+ nccons_in, nicons_in, ncnst_in, ninst_in, errstring)
+
+ use micro_mg_utils, only: micro_mg_utils_init
+
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! initialize constants for MG microphysics
+ !
+ ! Author: Andrew Gettelman Dec 2005
+ !
+ !-----------------------------------------------------------------------
+
+ integer, intent(in) :: kind ! Kind used for reals
+ real(r8), intent(in) :: gravit
+ real(r8), intent(in) :: rair
+ real(r8), intent(in) :: rh2o
+ real(r8), intent(in) :: cpair
+ real(r8), intent(in) :: tmelt_in ! Freezing point of water (K)
+ real(r8), intent(in) :: latvap
+ real(r8), intent(in) :: latice
+ real(r8), intent(in) :: rhmini_in ! Minimum rh for ice cloud fraction > 0.
+ real(r8), intent(in) :: micro_mg_dcs
+
+ logical, intent(in) :: microp_uniform_in ! .true. = configure uniform for sub-columns
+ ! .false. = use w/o sub-columns (standard)
+ logical, intent(in) :: do_cldice_in ! .true. = do all processes (standard)
+ ! .false. = skip all processes affecting
+ ! cloud ice
+ logical, intent(in) :: use_hetfrz_classnuc_in ! use heterogeneous freezing
+
+ character(len=16),intent(in) :: micro_mg_precip_frac_method_in ! type of precipitation fraction method
+ real(r8), intent(in) :: micro_mg_berg_eff_factor_in ! berg efficiency factor
+ logical, intent(in) :: allow_sed_supersat_in ! allow supersaturated conditions after sedimentation loop
+ logical, intent(in) :: do_sb_physics_in ! do SB autoconversion and accretion physics
+
+ logical, intent(in) :: nccons_in
+ logical, intent(in) :: nicons_in
+ real(r8), intent(in) :: ncnst_in
+ real(r8), intent(in) :: ninst_in
+
+ character(128), intent(out) :: errstring ! Output status (non-blank for error return)
+
+ !-----------------------------------------------------------------------
+
+ dcs = micro_mg_dcs
+
+ ! Initialize subordinate utilities module.
+ call micro_mg_utils_init(kind, rh2o, cpair, tmelt_in, latvap, latice, &
+ dcs, errstring)
+
+ if (trim(errstring) /= "") return
+
+ ! declarations for MG code (transforms variable names)
+
+ g= gravit ! gravity
+ r= rair ! dry air gas constant: note units(phys_constants are in J/K/kmol)
+ rv= rh2o ! water vapor gas constant
+ cpp = cpair ! specific heat of dry air
+ tmelt = tmelt_in
+ rhmini = rhmini_in
+ micro_mg_precip_frac_method = micro_mg_precip_frac_method_in
+ micro_mg_berg_eff_factor = micro_mg_berg_eff_factor_in
+ allow_sed_supersat = allow_sed_supersat_in
+ do_sb_physics = do_sb_physics_in
+
+ nccons = nccons_in
+ nicons = nicons_in
+ ncnst = ncnst_in
+ ninst = ninst_in
+
+ ! latent heats
+
+ xxlv = latvap ! latent heat vaporization
+ xlf = latice ! latent heat freezing
+ xxls = xxlv + xlf ! latent heat of sublimation
+
+ ! flags
+ microp_uniform = microp_uniform_in
+ do_cldice = do_cldice_in
+ use_hetfrz_classnuc = use_hetfrz_classnuc_in
+
+ ! typical air density at 850 mb
+
+ rhosu = 85000._r8/(rair * tmelt)
+
+ ! Maximum temperature at which snow is allowed to exist
+ snowmelt = tmelt + 2._r8
+ ! Minimum temperature at which rain is allowed to exist
+ rainfrze = tmelt - 40._r8
+
+ ! Ice nucleation temperature
+ icenuct = tmelt - 5._r8
+
+ ! Define constants to help speed up code (this limits calls to gamma function)
+ gamma_br_plus1=gamma(1._r8+br)
+ gamma_br_plus4=gamma(4._r8+br)
+ gamma_bs_plus1=gamma(1._r8+bs)
+ gamma_bs_plus4=gamma(4._r8+bs)
+ gamma_bi_plus1=gamma(1._r8+bi)
+ gamma_bi_plus4=gamma(4._r8+bi)
+ gamma_bj_plus1=gamma(1._r8+bj)
+ gamma_bj_plus4=gamma(4._r8+bj)
+
+ xxlv_squared=xxlv**2
+ xxls_squared=xxls**2
+
+end subroutine micro_mg_init
+
+!===============================================================================
+!microphysics routine for each timestep goes here...
+
+subroutine micro_mg_tend ( &
+ mgncol, nlev, deltatin, &
+ t, q, &
+ qcn, qin, &
+ ncn, nin, &
+ qrn, qsn, &
+ nrn, nsn, &
+ relvar, accre_enhan, &
+ p, pdel, &
+ cldn, liqcldf, icecldf, qsatfac, &
+ qcsinksum_rate1ord, &
+ naai, npccn, &
+ rndst, nacon, &
+ tlat, qvlat, &
+ qctend, qitend, &
+ nctend, nitend, &
+ qrtend, qstend, &
+ nrtend, nstend, &
+ effc, effc_fn, effi, &
+ sadice, sadsnow, &
+ prect, preci, &
+ nevapr, evapsnow, &
+ am_evp_st, &
+ prain, prodsnow, &
+ cmeout, deffi, &
+ pgamrad, lamcrad, &
+ qsout, dsout, &
+ lflx, iflx, &
+ rflx, sflx, qrout, &
+ reff_rain, reff_snow, &
+ qcsevap, qisevap, qvres, &
+ cmeitot, vtrmc, vtrmi, &
+ umr, ums, &
+ qcsedten, qisedten, &
+ qrsedten, qssedten, &
+ pratot, prctot, &
+ mnuccctot, mnuccttot, msacwitot, &
+ psacwstot, bergstot, bergtot, &
+ melttot, homotot, &
+ qcrestot, prcitot, praitot, &
+ qirestot, mnuccrtot, pracstot, &
+ meltsdttot, frzrdttot, mnuccdtot, &
+ nrout, nsout, &
+ refl, arefl, areflz, &
+ frefl, csrfl, acsrfl, &
+ fcsrfl, rercld, &
+ ncai, ncal, &
+ qrout2, qsout2, &
+ nrout2, nsout2, &
+ drout2, dsout2, &
+ freqs, freqr, &
+ nfice, qcrat, &
+ errstring, &
+!AL right names?
+ nnuccctot, nnuccttot, npsacwstot, nsubctot, npratot, &
+ nprc1tot, ncsedtentot, nisedtentot, nmelttot, nhomotot, &
+ nimelttot, nihomotot, nsacwitot, nsubitot, nprcitot, &
+ npraitot, nnudeptot, npccntot, nnuccdtot, mnudeptot, &
+ frzr,nfrzr, nnuccritot, mnuccritot, &
+!
+ nctnszmx,nctnszmn, nctnncld, nitncons, nitnszmx,nitnszmn, nitnncld, &
+!AL
+ ! Below arguments are "optional" (pass null pointers to omit).
+ tnd_qsnow, tnd_nsnow, re_ice, &
+ prer_evap, &
+ frzimm, frzcnt, frzdep)
+
+ ! Constituent properties.
+ use micro_mg_utils, only: &
+ mg_liq_props, &
+ mg_ice_props, &
+ mg_rain_props, &
+ mg_snow_props
+
+ ! Size calculation functions.
+ use micro_mg_utils, only: &
+ size_dist_param_liq, &
+ size_dist_param_basic, &
+ avg_diameter
+
+ ! Microphysical processes.
+ use micro_mg_utils, only: &
+ ice_deposition_sublimation, &
+ sb2001v2_liq_autoconversion,&
+ sb2001v2_accre_cld_water_rain,&
+ kk2000_liq_autoconversion, &
+ ice_autoconversion, &
+ immersion_freezing, &
+ contact_freezing, &
+ snow_self_aggregation, &
+ accrete_cloud_water_snow, &
+ secondary_ice_production, &
+ accrete_rain_snow, &
+ heterogeneous_rain_freezing, &
+ accrete_cloud_water_rain, &
+ self_collection_rain, &
+ accrete_cloud_ice_snow, &
+ evaporate_sublimate_precip, &
+ bergeron_process_snow
+
+ !Authors: Hugh Morrison, Andrew Gettelman, NCAR, Peter Caldwell, LLNL
+ ! e-mail: morrison@ucar.edu, andrew@ucar.edu
+
+ ! input arguments
+ integer, intent(in) :: mgncol ! number of microphysics columns
+ integer, intent(in) :: nlev ! number of layers
+ real(r8), intent(in) :: deltatin ! time step (s)
+ real(r8), intent(in) :: t(mgncol,nlev) ! input temperature (K)
+ real(r8), intent(in) :: q(mgncol,nlev) ! input h20 vapor mixing ratio (kg/kg)
+
+ ! note: all input cloud variables are grid-averaged
+ real(r8), intent(in) :: qcn(mgncol,nlev) ! cloud water mixing ratio (kg/kg)
+ real(r8), intent(in) :: qin(mgncol,nlev) ! cloud ice mixing ratio (kg/kg)
+ real(r8), intent(in) :: ncn(mgncol,nlev) ! cloud water number conc (1/kg)
+ real(r8), intent(in) :: nin(mgncol,nlev) ! cloud ice number conc (1/kg)
+
+ real(r8), intent(in) :: qrn(mgncol,nlev) ! rain mixing ratio (kg/kg)
+ real(r8), intent(in) :: qsn(mgncol,nlev) ! snow mixing ratio (kg/kg)
+ real(r8), intent(in) :: nrn(mgncol,nlev) ! rain number conc (1/kg)
+ real(r8), intent(in) :: nsn(mgncol,nlev) ! snow number conc (1/kg)
+
+ real(r8), intent(in) :: relvar(mgncol,nlev) ! cloud water relative variance (-)
+ real(r8), intent(in) :: accre_enhan(mgncol,nlev) ! optional accretion
+ ! enhancement factor (-)
+
+ real(r8), intent(in) :: p(mgncol,nlev) ! air pressure (pa)
+ real(r8), intent(in) :: pdel(mgncol,nlev) ! pressure difference across level (pa)
+
+ real(r8), intent(in) :: cldn(mgncol,nlev) ! cloud fraction (no units)
+ real(r8), intent(in) :: liqcldf(mgncol,nlev) ! liquid cloud fraction (no units)
+ real(r8), intent(in) :: icecldf(mgncol,nlev) ! ice cloud fraction (no units)
+ real(r8), intent(in) :: qsatfac(mgncol,nlev) ! subgrid cloud water saturation scaling factor (no units)
+
+ ! used for scavenging
+ ! Inputs for aerosol activation
+ real(r8), intent(in) :: naai(mgncol,nlev) ! ice nucleation number (from microp_aero_ts) (1/kg)
+ real(r8), intent(in) :: npccn(mgncol,nlev) ! ccn activated number tendency (from microp_aero_ts) (1/kg*s)
+
+ ! Note that for these variables, the dust bin is assumed to be the last index.
+ ! (For example, in CAM, the last dimension is always size 4.)
+ real(r8), intent(in) :: rndst(:,:,:) ! radius of each dust bin, for contact freezing (from microp_aero_ts) (m)
+ real(r8), intent(in) :: nacon(:,:,:) ! number in each dust bin, for contact freezing (from microp_aero_ts) (1/m^3)
+
+ ! output arguments
+
+ real(r8), intent(out) :: qcsinksum_rate1ord(mgncol,nlev) ! 1st order rate for
+ ! direct cw to precip conversion
+ real(r8), intent(out) :: tlat(mgncol,nlev) ! latent heating rate (W/kg)
+ real(r8), intent(out) :: qvlat(mgncol,nlev) ! microphysical tendency qv (1/s)
+ real(r8), intent(out) :: qctend(mgncol,nlev) ! microphysical tendency qc (1/s)
+ real(r8), intent(out) :: qitend(mgncol,nlev) ! microphysical tendency qi (1/s)
+ real(r8), intent(out) :: nctend(mgncol,nlev) ! microphysical tendency nc (1/(kg*s))
+ real(r8), intent(out) :: nitend(mgncol,nlev) ! microphysical tendency ni (1/(kg*s))
+
+ real(r8), intent(out) :: qrtend(mgncol,nlev) ! microphysical tendency qr (1/s)
+ real(r8), intent(out) :: qstend(mgncol,nlev) ! microphysical tendency qs (1/s)
+ real(r8), intent(out) :: nrtend(mgncol,nlev) ! microphysical tendency nr (1/(kg*s))
+ real(r8), intent(out) :: nstend(mgncol,nlev) ! microphysical tendency ns (1/(kg*s))
+ real(r8), intent(out) :: effc(mgncol,nlev) ! droplet effective radius (micron)
+ real(r8), intent(out) :: effc_fn(mgncol,nlev) ! droplet effective radius, assuming nc = 1.e8 kg-1
+ real(r8), intent(out) :: effi(mgncol,nlev) ! cloud ice effective radius (micron)
+ real(r8), intent(out) :: sadice(mgncol,nlev) ! cloud ice surface area density (cm2/cm3)
+ real(r8), intent(out) :: sadsnow(mgncol,nlev) ! cloud snow surface area density (cm2/cm3)
+ real(r8), intent(out) :: prect(mgncol) ! surface precip rate (m/s)
+ real(r8), intent(out) :: preci(mgncol) ! cloud ice/snow precip rate (m/s)
+ real(r8), intent(out) :: nevapr(mgncol,nlev) ! evaporation rate of rain + snow (1/s)
+ real(r8), intent(out) :: evapsnow(mgncol,nlev) ! sublimation rate of snow (1/s)
+ real(r8), intent(out) :: am_evp_st(mgncol,nlev) ! stratiform evaporation area (frac)
+ real(r8), intent(out) :: prain(mgncol,nlev) ! production of rain + snow (1/s)
+ real(r8), intent(out) :: prodsnow(mgncol,nlev) ! production of snow (1/s)
+ real(r8), intent(out) :: cmeout(mgncol,nlev) ! evap/sub of cloud (1/s)
+ real(r8), intent(out) :: deffi(mgncol,nlev) ! ice effective diameter for optics (radiation) (micron)
+ real(r8), intent(out) :: pgamrad(mgncol,nlev) ! ice gamma parameter for optics (radiation) (no units)
+ real(r8), intent(out) :: lamcrad(mgncol,nlev) ! slope of droplet distribution for optics (radiation) (1/m)
+ real(r8), intent(out) :: qsout(mgncol,nlev) ! snow mixing ratio (kg/kg)
+ real(r8), intent(out) :: dsout(mgncol,nlev) ! snow diameter (m)
+ real(r8), intent(out) :: lflx(mgncol,nlev+1) ! grid-box average liquid condensate flux (kg m^-2 s^-1)
+ real(r8), intent(out) :: iflx(mgncol,nlev+1) ! grid-box average ice condensate flux (kg m^-2 s^-1)
+ real(r8), intent(out) :: rflx(mgncol,nlev+1) ! grid-box average rain flux (kg m^-2 s^-1)
+ real(r8), intent(out) :: sflx(mgncol,nlev+1) ! grid-box average snow flux (kg m^-2 s^-1)
+ real(r8), intent(out) :: qrout(mgncol,nlev) ! grid-box average rain mixing ratio (kg/kg)
+ real(r8), intent(out) :: reff_rain(mgncol,nlev) ! rain effective radius (micron)
+ real(r8), intent(out) :: reff_snow(mgncol,nlev) ! snow effective radius (micron)
+ real(r8), intent(out) :: qcsevap(mgncol,nlev) ! cloud water evaporation due to sedimentation (1/s)
+ real(r8), intent(out) :: qisevap(mgncol,nlev) ! cloud ice sublimation due to sublimation (1/s)
+ real(r8), intent(out) :: qvres(mgncol,nlev) ! residual condensation term to ensure RH < 100% (1/s)
+ real(r8), intent(out) :: cmeitot(mgncol,nlev) ! grid-mean cloud ice sub/dep (1/s)
+ real(r8), intent(out) :: vtrmc(mgncol,nlev) ! mass-weighted cloud water fallspeed (m/s)
+ real(r8), intent(out) :: vtrmi(mgncol,nlev) ! mass-weighted cloud ice fallspeed (m/s)
+ real(r8), intent(out) :: umr(mgncol,nlev) ! mass weighted rain fallspeed (m/s)
+ real(r8), intent(out) :: ums(mgncol,nlev) ! mass weighted snow fallspeed (m/s)
+ real(r8), intent(out) :: qcsedten(mgncol,nlev) ! qc sedimentation tendency (1/s)
+ real(r8), intent(out) :: qisedten(mgncol,nlev) ! qi sedimentation tendency (1/s)
+ real(r8), intent(out) :: qrsedten(mgncol,nlev) ! qr sedimentation tendency (1/s)
+ real(r8), intent(out) :: qssedten(mgncol,nlev) ! qs sedimentation tendency (1/s)
+
+ ! microphysical process rates for output (mixing ratio tendencies) (all have units of 1/s)
+ real(r8), intent(out) :: pratot(mgncol,nlev) ! accretion of cloud by rain
+ real(r8), intent(out) :: prctot(mgncol,nlev) ! autoconversion of cloud to rain
+ real(r8), intent(out) :: mnuccctot(mgncol,nlev) ! mixing ratio tend due to immersion freezing
+ real(r8), intent(out) :: mnuccttot(mgncol,nlev) ! mixing ratio tend due to contact freezing
+ real(r8), intent(out) :: msacwitot(mgncol,nlev) ! mixing ratio tend due to H-M splintering
+ real(r8), intent(out) :: psacwstot(mgncol,nlev) ! collection of cloud water by snow
+ real(r8), intent(out) :: bergstot(mgncol,nlev) ! bergeron process on snow
+ real(r8), intent(out) :: bergtot(mgncol,nlev) ! bergeron process on cloud ice
+ real(r8), intent(out) :: melttot(mgncol,nlev) ! melting of cloud ice
+ real(r8), intent(out) :: homotot(mgncol,nlev) ! homogeneous freezing cloud water
+ real(r8), intent(out) :: qcrestot(mgncol,nlev) ! residual cloud condensation due to removal of excess supersat
+ real(r8), intent(out) :: prcitot(mgncol,nlev) ! autoconversion of cloud ice to snow
+ real(r8), intent(out) :: praitot(mgncol,nlev) ! accretion of cloud ice by snow
+ real(r8), intent(out) :: qirestot(mgncol,nlev) ! residual ice deposition due to removal of excess supersat
+ real(r8), intent(out) :: mnuccrtot(mgncol,nlev) ! mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s)
+ real(r8), intent(out) :: pracstot(mgncol,nlev) ! mixing ratio tendency due to accretion of rain by snow (1/s)
+ real(r8), intent(out) :: meltsdttot(mgncol,nlev) ! latent heating rate due to melting of snow (W/kg)
+ real(r8), intent(out) :: frzrdttot(mgncol,nlev) ! latent heating rate due to homogeneous freezing of rain (W/kg)
+ real(r8), intent(out) :: mnuccdtot(mgncol,nlev) ! mass tendency from ice nucleation
+ real(r8), intent(out) :: nrout(mgncol,nlev) ! rain number concentration (1/m3)
+ real(r8), intent(out) :: nsout(mgncol,nlev) ! snow number concentration (1/m3)
+ real(r8), intent(out) :: refl(mgncol,nlev) ! analytic radar reflectivity
+ real(r8), intent(out) :: arefl(mgncol,nlev) ! average reflectivity will zero points outside valid range
+ real(r8), intent(out) :: areflz(mgncol,nlev) ! average reflectivity in z.
+ real(r8), intent(out) :: frefl(mgncol,nlev) ! fractional occurrence of radar reflectivity
+ real(r8), intent(out) :: csrfl(mgncol,nlev) ! cloudsat reflectivity
+ real(r8), intent(out) :: acsrfl(mgncol,nlev) ! cloudsat average
+ real(r8), intent(out) :: fcsrfl(mgncol,nlev) ! cloudsat fractional occurrence of radar reflectivity
+ real(r8), intent(out) :: rercld(mgncol,nlev) ! effective radius calculation for rain + cloud
+ real(r8), intent(out) :: ncai(mgncol,nlev) ! output number conc of ice nuclei available (1/m3)
+ real(r8), intent(out) :: ncal(mgncol,nlev) ! output number conc of CCN (1/m3)
+ real(r8), intent(out) :: qrout2(mgncol,nlev) ! copy of qrout as used to compute drout2
+ real(r8), intent(out) :: qsout2(mgncol,nlev) ! copy of qsout as used to compute dsout2
+ real(r8), intent(out) :: nrout2(mgncol,nlev) ! copy of nrout as used to compute drout2
+ real(r8), intent(out) :: nsout2(mgncol,nlev) ! copy of nsout as used to compute dsout2
+ real(r8), intent(out) :: drout2(mgncol,nlev) ! mean rain particle diameter (m)
+ real(r8), intent(out) :: dsout2(mgncol,nlev) ! mean snow particle diameter (m)
+ real(r8), intent(out) :: freqs(mgncol,nlev) ! fractional occurrence of snow
+ real(r8), intent(out) :: freqr(mgncol,nlev) ! fractional occurrence of rain
+ real(r8), intent(out) :: nfice(mgncol,nlev) ! fractional occurrence of ice
+ real(r8), intent(out) :: qcrat(mgncol,nlev) ! limiter for qc process rates (1=no limit --> 0. no qc)
+
+ real(r8), intent(out) :: prer_evap(mgncol,nlev)
+
+ character(128), intent(out) :: errstring ! output status (non-blank for error return)
+
+!AL change these to tot? output is now called tot and packed in interface?
+ real(r8), intent(out) :: nnuccctot(mgncol,nlev) ! immersion freezing
+ real(r8), intent(out) :: nnuccttot(mgncol,nlev) ! contact freezing
+ real(r8), intent(out) :: npsacwstot(mgncol,nlev) ! accr. snow
+ real(r8), intent(out) :: nsubctot(mgncol,nlev) ! evaporation of droplet
+ real(r8), intent(out) :: npratot(mgncol,nlev) ! accretion
+ real(r8), intent(out) :: nprc1tot(mgncol,nlev) ! autoconversion
+ real(r8), intent(out) :: ncsedtentot(mgncol,nlev) ! nqc sedimentation tendency
+ real(r8), intent(out) :: nisedtentot(mgncol,nlev) ! nqi sedimentation tendency
+ real(r8), intent(out) :: nmelttot(mgncol,nlev) ! nc melting of cloud ice
+ real(r8), intent(out) :: nhomotot(mgncol,nlev) ! nc homogeneos freezign cloud water
+ real(r8), intent(out) :: nimelttot(mgncol,nlev) ! ni melting of cloud ice
+ real(r8), intent(out) :: nihomotot(mgncol,nlev) ! ni homogeneos freezign cloud water
+ real(r8), intent(out) :: nsacwitot(mgncol,nlev) ! numb conc tend due to HM ice multiplication
+ real(r8), intent(out) :: nsubitot(mgncol,nlev) ! evaporation of cloud ice number (sublimation?)
+ real(r8), intent(out) :: nprcitot(mgncol,nlev) ! numb conc tend due to auto of cloud ice to snow
+ real(r8), intent(out) :: npraitot(mgncol,nlev) ! numb conc tend due to accr of cloud ice by snow
+ real(r8), intent(out) :: nnudeptot(mgncol,nlev) ! deposition?
+ real(r8), intent(out) :: npccntot(mgncol,nlev) ! droplet activation
+ real(r8), intent(out) :: nnuccdtot(mgncol,nlev) ! ni nucleation
+ real(r8), intent(out) :: mnudeptot(mgncol,nlev) ! deposition (mass)
+!
+ real(r8), intent(out) :: nctnszmx(mgncol,nlev) ! nc tuning: maximum slope (reduction of number)
+ real(r8), intent(out) :: nctnszmn(mgncol,nlev) ! nc tuning: minimum slope (increase of numer)
+ real(r8), intent(out) :: nctnncld(mgncol,nlev) ! nc tuning: removal of nc when qc is zero after mg
+ real(r8), intent(out) :: nitncons(mgncol,nlev) ! ni tuning to conserve numberi in substeps
+ real(r8), intent(out) :: nitnszmx(mgncol,nlev) ! ni tuning: maximum slope
+ real(r8), intent(out) :: nitnszmn(mgncol,nlev) ! ni tuning: minimum minimum slope
+ real(r8), intent(out) :: nitnncld(mgncol,nlev) ! ni tuning: removal of ni when qi is zero after mg
+ real(r8), intent(out) :: mnuccritot(mgncol,nlev)! mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s)
+ real(r8), intent(out) :: nnuccritot(mgncol,nlev)! mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s)
+ real(r8), intent(out) :: frzr(mgncol,nlev)! mixing ratio tendency due to heterogeneous freezing of rain to ice (1/s)
+ real(r8), intent(out) :: nfrzr(mgncol,nlev)! ni tendency due to heterogeneous freezing of rain to ice (1/s)
+!AL
+
+
+
+
+ ! Tendencies calculated by external schemes that can replace MG's native
+ ! process tendencies.
+
+ ! Used with CARMA cirrus microphysics
+ ! (or similar external microphysics model)
+ real(r8), intent(in) :: tnd_qsnow(:,:) ! snow mass tendency (kg/kg/s)
+ real(r8), intent(in) :: tnd_nsnow(:,:) ! snow number tendency (#/kg/s)
+ real(r8), intent(in) :: re_ice(:,:) ! ice effective radius (m)
+
+ ! From external ice nucleation.
+ real(r8), intent(in) :: frzimm(:,:) ! Number tendency due to immersion freezing (1/cm3)
+ real(r8), intent(in) :: frzcnt(:,:) ! Number tendency due to contact freezing (1/cm3)
+ real(r8), intent(in) :: frzdep(:,:) ! Number tendency due to deposition nucleation (1/cm3)
+
+ ! local workspace
+ ! all units mks unless otherwise stated
+
+ ! local copies of input variables
+ real(r8) :: qc(mgncol,nlev) ! cloud liquid mixing ratio (kg/kg)
+ real(r8) :: qi(mgncol,nlev) ! cloud ice mixing ratio (kg/kg)
+ real(r8) :: nc(mgncol,nlev) ! cloud liquid number concentration (1/kg)
+ real(r8) :: ni(mgncol,nlev) ! cloud liquid number concentration (1/kg)
+ real(r8) :: qr(mgncol,nlev) ! rain mixing ratio (kg/kg)
+ real(r8) :: qs(mgncol,nlev) ! snow mixing ratio (kg/kg)
+ real(r8) :: nr(mgncol,nlev) ! rain number concentration (1/kg)
+ real(r8) :: ns(mgncol,nlev) ! snow number concentration (1/kg)
+
+ ! general purpose variables
+ real(r8) :: deltat ! sub-time step (s)
+ real(r8) :: mtime ! the assumed ice nucleation timescale
+
+ ! physical properties of the air at a given point
+ real(r8) :: rho(mgncol,nlev) ! density (kg m-3)
+ real(r8) :: dv(mgncol,nlev) ! diffusivity of water vapor
+ real(r8) :: mu(mgncol,nlev) ! viscosity
+ real(r8) :: sc(mgncol,nlev) ! schmidt number
+ real(r8) :: rhof(mgncol,nlev) ! density correction factor for fallspeed
+
+ ! cloud fractions
+ real(r8) :: precip_frac(mgncol,nlev) ! precip fraction assuming maximum overlap
+ real(r8) :: cldm(mgncol,nlev) ! cloud fraction
+ real(r8) :: icldm(mgncol,nlev) ! ice cloud fraction
+ real(r8) :: lcldm(mgncol,nlev) ! liq cloud fraction
+ real(r8) :: qsfm(mgncol,nlev) ! subgrid cloud water saturation scaling factor
+
+ ! mass mixing ratios
+ real(r8) :: qcic(mgncol,nlev) ! in-cloud cloud liquid
+ real(r8) :: qiic(mgncol,nlev) ! in-cloud cloud ice
+ real(r8) :: qsic(mgncol,nlev) ! in-precip snow
+ real(r8) :: qric(mgncol,nlev) ! in-precip rain
+
+ ! number concentrations
+ real(r8) :: ncic(mgncol,nlev) ! in-cloud droplet
+ real(r8) :: niic(mgncol,nlev) ! in-cloud cloud ice
+ real(r8) :: nsic(mgncol,nlev) ! in-precip snow
+ real(r8) :: nric(mgncol,nlev) ! in-precip rain
+ ! maximum allowed ni value
+ real(r8) :: nimax(mgncol,nlev)
+
+ ! Size distribution parameters for:
+ ! cloud ice
+ real(r8) :: lami(mgncol,nlev) ! slope
+ real(r8) :: n0i(mgncol,nlev) ! intercept
+ ! cloud liquid
+ real(r8) :: lamc(mgncol,nlev) ! slope
+ real(r8) :: pgam(mgncol,nlev) ! spectral width parameter
+ ! snow
+ real(r8) :: lams(mgncol,nlev) ! slope
+ real(r8) :: n0s(mgncol,nlev) ! intercept
+ ! rain
+ real(r8) :: lamr(mgncol,nlev) ! slope
+ real(r8) :: n0r(mgncol,nlev) ! intercept
+
+ ! Rates/tendencies due to:
+
+ ! Instantaneous snow melting
+ real(r8) :: minstsm(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: ninstsm(mgncol,nlev) ! number concentration
+ ! Instantaneous rain freezing
+ real(r8) :: minstrf(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: ninstrf(mgncol,nlev) ! number concentration
+
+ ! deposition of cloud ice
+ real(r8) :: vap_dep(mgncol,nlev) ! deposition from vapor to ice PMC 12/3/12
+ ! sublimation of cloud ice
+ real(r8) :: ice_sublim(mgncol,nlev) ! sublimation from ice to vapor PMC 12/3/12
+ ! ice nucleation
+ real(r8) :: nnuccd(mgncol,nlev) ! number rate from deposition/cond.-freezing
+ real(r8) :: mnuccd(mgncol,nlev) ! mass mixing ratio
+ ! freezing of cloud water
+ real(r8) :: mnuccc(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: nnuccc(mgncol,nlev) ! number concentration
+ ! contact freezing of cloud water
+ real(r8) :: mnucct(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: nnucct(mgncol,nlev) ! number concentration
+ ! deposition nucleation in mixed-phase clouds (from external scheme)
+ real(r8) :: mnudep(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: nnudep(mgncol,nlev) ! number concentration
+ ! ice multiplication
+ real(r8) :: msacwi(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: nsacwi(mgncol,nlev) ! number concentration
+ ! autoconversion of cloud droplets
+ real(r8) :: prc(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: nprc(mgncol,nlev) ! number concentration (rain)
+ real(r8) :: nprc1(mgncol,nlev) ! number concentration (cloud droplets)
+ ! self-aggregation of snow
+ real(r8) :: nsagg(mgncol,nlev) ! number concentration
+ ! self-collection of rain
+ real(r8) :: nragg(mgncol,nlev) ! number concentration
+ ! collection of droplets by snow
+ real(r8) :: psacws(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: npsacws(mgncol,nlev) ! number concentration
+ ! collection of rain by snow
+ real(r8) :: pracs(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: npracs(mgncol,nlev) ! number concentration
+ ! freezing of rain
+ real(r8) :: mnuccr(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: nnuccr(mgncol,nlev) ! number concentration
+ ! freezing of rain to form ice (mg add 4/26/13)
+ real(r8) :: mnuccri(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: nnuccri(mgncol,nlev) ! number concentration
+ ! accretion of droplets by rain
+ real(r8) :: pra(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: npra(mgncol,nlev) ! number concentration
+ ! autoconversion of cloud ice to snow
+ real(r8) :: prci(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: nprci(mgncol,nlev) ! number concentration
+ ! accretion of cloud ice by snow
+ real(r8) :: prai(mgncol,nlev) ! mass mixing ratio
+ real(r8) :: nprai(mgncol,nlev) ! number concentration
+ ! evaporation of rain
+ real(r8) :: pre(mgncol,nlev) ! mass mixing ratio
+ ! sublimation of snow
+ real(r8) :: prds(mgncol,nlev) ! mass mixing ratio
+ ! number evaporation
+ real(r8) :: nsubi(mgncol,nlev) ! cloud ice
+ real(r8) :: nsubc(mgncol,nlev) ! droplet
+ real(r8) :: nsubs(mgncol,nlev) ! snow
+ real(r8) :: nsubr(mgncol,nlev) ! rain
+ ! bergeron process
+ real(r8) :: berg(mgncol,nlev) ! mass mixing ratio (cloud ice)
+ real(r8) :: bergs(mgncol,nlev) ! mass mixing ratio (snow)
+
+ ! fallspeeds
+ ! number-weighted
+ real(r8) :: uns(mgncol,nlev) ! snow
+ real(r8) :: unr(mgncol,nlev) ! rain
+ ! air density corrected fallspeed parameters
+ real(r8) :: arn(mgncol,nlev) ! rain
+ real(r8) :: asn(mgncol,nlev) ! snow
+ real(r8) :: acn(mgncol,nlev) ! cloud droplet
+ real(r8) :: ain(mgncol,nlev) ! cloud ice
+ real(r8) :: ajn(mgncol,nlev) ! cloud small ice
+
+ ! Mass of liquid droplets used with external heterogeneous freezing.
+ real(r8) :: mi0l(mgncol)
+
+ ! saturation vapor pressures
+ real(r8) :: esl(mgncol,nlev) ! liquid
+ real(r8) :: esi(mgncol,nlev) ! ice
+ real(r8) :: esn ! checking for RH after rain evap
+
+ ! saturation vapor mixing ratios
+ real(r8) :: qvl(mgncol,nlev) ! liquid
+ real(r8) :: qvi(mgncol,nlev) ! ice
+ real(r8) :: qvn ! checking for RH after rain evap
+
+ ! relative humidity
+ real(r8) :: relhum(mgncol,nlev)
+
+ ! parameters for cloud water and cloud ice sedimentation calculations
+ real(r8) :: fc(mgncol,nlev)
+ real(r8) :: fnc(mgncol,nlev)
+ real(r8) :: fi(mgncol,nlev)
+ real(r8) :: fni(mgncol,nlev)
+
+ real(r8) :: fr(mgncol,nlev)
+ real(r8) :: fnr(mgncol,nlev)
+ real(r8) :: fs(mgncol,nlev)
+ real(r8) :: fns(mgncol,nlev)
+
+ real(r8) :: faloutc(nlev)
+ real(r8) :: faloutnc(nlev)
+ real(r8) :: falouti(nlev)
+ real(r8) :: faloutni(nlev)
+
+ real(r8) :: faloutr(nlev)
+ real(r8) :: faloutnr(nlev)
+ real(r8) :: falouts(nlev)
+ real(r8) :: faloutns(nlev)
+
+ real(r8) :: faltndc
+ real(r8) :: faltndnc
+ real(r8) :: faltndi
+ real(r8) :: faltndni
+ real(r8) :: faltndqie
+ real(r8) :: faltndqce
+
+ real(r8) :: faltndr
+ real(r8) :: faltndnr
+ real(r8) :: faltnds
+ real(r8) :: faltndns
+
+ real(r8) :: rainrt(mgncol,nlev) ! rain rate for reflectivity calculation
+
+ ! dummy variables
+ real(r8) :: dum
+ real(r8) :: dum1
+ real(r8) :: dum2
+ real(r8) :: dumni0
+ real(r8) :: dumns0
+ ! dummies for checking RH
+ real(r8) :: qtmp
+ real(r8) :: ttmp
+ ! dummies for conservation check
+ real(r8) :: ratio
+ real(r8) :: tmpfrz
+ ! dummies for in-cloud variables
+ real(r8) :: dumc(mgncol,nlev) ! qc
+ real(r8) :: dumnc(mgncol,nlev) ! nc
+ real(r8) :: dumi(mgncol,nlev) ! qi
+ real(r8) :: dumni(mgncol,nlev) ! ni
+ real(r8) :: dumr(mgncol,nlev) ! rain mixing ratio
+ real(r8) :: dumnr(mgncol,nlev) ! rain number concentration
+ real(r8) :: dums(mgncol,nlev) ! snow mixing ratio
+ real(r8) :: dumns(mgncol,nlev) ! snow number concentration
+ ! Array dummy variable
+ real(r8) :: dum_2D(mgncol,nlev)
+ real(r8) :: pdel_inv(mgncol,nlev)
+
+ ! loop array variables
+ ! "i" and "k" are column/level iterators for internal (MG) variables
+ ! "n" is used for other looping (currently just sedimentation)
+ integer i, k, n
+
+ ! number of sub-steps for loops over "n" (for sedimentation)
+ integer nstep
+ integer mdust
+
+ ! Varaibles to scale fall velocity between small and regular ice regimes.
+ real(r8) :: irad
+ real(r8) :: ifrac
+
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ ! Return error message
+ errstring = ' '
+
+ ! Process inputs
+
+ ! assign variable deltat to deltatin
+ deltat = deltatin
+
+ ! Copies of input concentrations that may be changed internally.
+ qc = qcn
+ nc = ncn
+ qi = qin
+ ni = nin
+ qr = qrn
+ nr = nrn
+ qs = qsn
+ ns = nsn
+
+ ! cldn: used to set cldm, unused for subcolumns
+ ! liqcldf: used to set lcldm, unused for subcolumns
+ ! icecldf: used to set icldm, unused for subcolumns
+
+ if (microp_uniform) then
+ ! subcolumns, set cloud fraction variables to one
+ ! if cloud water or ice is present, if not present
+ ! set to mincld (mincld used instead of zero, to prevent
+ ! possible division by zero errors).
+
+ where (qc >= qsmall)
+ lcldm = 1._r8
+ elsewhere
+ lcldm = mincld
+ end where
+
+ where (qi >= qsmall)
+ icldm = 1._r8
+ elsewhere
+ icldm = mincld
+ end where
+
+ cldm = max(icldm, lcldm)
+ qsfm = 1._r8
+
+ else
+ ! get cloud fraction, check for minimum
+ cldm = max(cldn,mincld)
+ lcldm = max(liqcldf,mincld)
+ icldm = max(icecldf,mincld)
+ qsfm = qsatfac
+ end if
+
+ ! Initialize local variables
+
+ ! local physical properties
+ rho = p/(r*t)
+ dv = 8.794E-5_r8 * t**1.81_r8 / p
+ mu = 1.496E-6_r8 * t**1.5_r8 / (t + 120._r8)
+ sc = mu/(rho*dv)
+
+ ! air density adjustment for fallspeed parameters
+ ! includes air density correction factor to the
+ ! power of 0.54 following Heymsfield and Bansemer 2007
+
+ rhof=(rhosu/rho)**0.54_r8
+
+ arn=ar*rhof
+ asn=as*rhof
+ acn=g*rhow/(18._r8*mu)
+ ain=ai*(rhosu/rho)**0.35_r8
+ ajn=aj*(rhosu/rho)**0.35_r8
+
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! Get humidity and saturation vapor pressures
+
+ do k=1,nlev
+ do i=1,mgncol
+
+ call qsat_water(t(i,k), p(i,k), esl(i,k), qvl(i,k))
+
+ ! make sure when above freezing that esi=esl, not active yet
+ if (t(i,k) >= tmelt) then
+ esi(i,k)=esl(i,k)
+ qvi(i,k)=qvl(i,k)
+ else
+ call qsat_ice(t(i,k), p(i,k), esi(i,k), qvi(i,k))
+
+ ! Scale the water saturation values to reflect subgrid scale
+ ! ice cloud fraction, where ice clouds begin forming at a
+ ! gridbox average relative humidity of rhmini (not 1).
+ !
+ ! NOTE: For subcolumns and other non-subgrid clouds, qsfm willi
+ ! be 1.
+ qvi(i,k) = qsfm(i,k) * qvi(i,k)
+ esi(i,k) = qsfm(i,k) * esi(i,k)
+ qvl(i,k) = qsfm(i,k) * qvl(i,k)
+ esl(i,k) = qsfm(i,k) * esl(i,k)
+ end if
+
+ end do
+ end do
+
+ relhum = q / max(qvl, qsmall)
+
+ !===============================================
+
+ ! set mtime here to avoid answer-changing
+ mtime=deltat
+
+ ! initialize microphysics output
+ qcsevap=0._r8
+ qisevap=0._r8
+ qvres =0._r8
+ cmeitot =0._r8
+ vtrmc =0._r8
+ vtrmi =0._r8
+ qcsedten =0._r8
+ qisedten =0._r8
+ qrsedten =0._r8
+ qssedten =0._r8
+
+ pratot=0._r8
+ prctot=0._r8
+ mnuccctot=0._r8
+ mnuccttot=0._r8
+ msacwitot=0._r8
+ psacwstot=0._r8
+ bergstot=0._r8
+ bergtot=0._r8
+ melttot=0._r8
+ homotot=0._r8
+ qcrestot=0._r8
+ prcitot=0._r8
+ praitot=0._r8
+ qirestot=0._r8
+ mnuccrtot=0._r8
+ pracstot=0._r8
+ meltsdttot=0._r8
+ frzrdttot=0._r8
+ mnuccdtot=0._r8
+
+!AL this is correct since output now is tot? add new term!
+ nnuccctot=0._r8
+ nnuccttot=0._r8
+ npsacwstot=0._r8
+ nsubctot=0._r8
+ npratot=0._r8
+ nprc1tot=0._r8
+ ncsedtentot=0._r8
+ nisedtentot=0._r8
+ nmelttot=0._r8
+ nhomotot=0._r8
+ nimelttot=0._r8
+ nihomotot=0._r8
+ nsacwitot=0._r8
+ nsubitot=0._r8
+ nprcitot=0._r8
+ npraitot=0._r8
+ nnudeptot=0._r8
+ npccntot=0._r8
+ nnuccdtot=0._r8
+ mnudeptot=0._r8
+ mnuccritot=0._r8
+ nnuccritot=0._r8
+
+ nctnszmx=0._r8
+ nctnszmn=0._r8
+ nctnncld=0._r8
+ nitncons=0._r8
+ nitnszmx=0._r8
+ nitnszmn=0._r8
+ nitnncld=0._r8
+
+ frzr=0._r8
+ nfrzr=0._r8
+
+!AL
+
+ rflx=0._r8
+ sflx=0._r8
+ lflx=0._r8
+ iflx=0._r8
+
+ ! initialize precip output
+
+ qrout=0._r8
+ qsout=0._r8
+ nrout=0._r8
+ nsout=0._r8
+
+ ! for refl calc
+ rainrt = 0._r8
+
+ ! initialize rain size
+ rercld=0._r8
+
+ qcsinksum_rate1ord = 0._r8
+
+ ! initialize variables for trop_mozart
+ nevapr = 0._r8
+ prer_evap = 0._r8
+ evapsnow = 0._r8
+ am_evp_st = 0._r8
+ prain = 0._r8
+ prodsnow = 0._r8
+ cmeout = 0._r8
+
+ precip_frac = mincld
+
+ lamc=0._r8
+
+ ! initialize microphysical tendencies
+
+ tlat=0._r8
+ qvlat=0._r8
+ qctend=0._r8
+ qitend=0._r8
+ qstend = 0._r8
+ qrtend = 0._r8
+ nctend=0._r8
+ nitend=0._r8
+ nrtend = 0._r8
+ nstend = 0._r8
+
+ ! initialize in-cloud and in-precip quantities to zero
+ qcic = 0._r8
+ qiic = 0._r8
+ qsic = 0._r8
+ qric = 0._r8
+
+ ncic = 0._r8
+ niic = 0._r8
+ nsic = 0._r8
+ nric = 0._r8
+
+ ! initialize precip at surface
+
+ prect = 0._r8
+ preci = 0._r8
+
+ ! initialize precip fallspeeds to zero
+ ums = 0._r8
+ uns = 0._r8
+ umr = 0._r8
+ unr = 0._r8
+
+ ! initialize limiter for output
+ qcrat = 1._r8
+
+ ! Many outputs have to be initialized here at the top to work around
+ ! ifort problems, even if they are always overwritten later.
+ effc = 10._r8
+ lamcrad = 0._r8
+ pgamrad = 0._r8
+ effc_fn = 10._r8
+ effi = 25._r8
+ sadice = 0._r8
+ sadsnow = 0._r8
+ deffi = 50._r8
+
+ qrout2 = 0._r8
+ nrout2 = 0._r8
+ drout2 = 0._r8
+ qsout2 = 0._r8
+ nsout2 = 0._r8
+ dsout = 0._r8
+ dsout2 = 0._r8
+
+ freqr = 0._r8
+ freqs = 0._r8
+
+ reff_rain = 0._r8
+ reff_snow = 0._r8
+
+ refl = -9999._r8
+ arefl = 0._r8
+ areflz = 0._r8
+ frefl = 0._r8
+ csrfl = 0._r8
+ acsrfl = 0._r8
+ fcsrfl = 0._r8
+
+ ncal = 0._r8
+ ncai = 0._r8
+
+ nfice = 0._r8
+
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! droplet activation
+ ! get provisional droplet number after activation. This is used for
+ ! all microphysical process calculations, for consistency with update of
+ ! droplet mass before microphysics
+
+ ! calculate potential for droplet activation if cloud water is present
+ ! tendency from activation (npccn) is read in from companion routine
+
+ ! output activated liquid and ice (convert from #/kg -> #/m3)
+ !--------------------------------------------------
+ where (qc >= qsmall)
+ nc = max(nc + npccn*deltat, 0._r8)
+ ncal = nc*rho/lcldm ! sghan minimum in #/cm3
+ elsewhere
+ ncal = 0._r8
+ end where
+
+ where (t < icenuct)
+ ncai = naai*rho
+ elsewhere
+ ncai = 0._r8
+ end where
+
+ !===============================================
+
+ ! ice nucleation if activated nuclei exist at t<-5C AND rhmini + 5%
+ !
+ ! NOTE: If using gridbox average values, condensation will not occur until rh=1,
+ ! so the threshold seems like it should be 1.05 and not rhmini + 0.05. For subgrid
+ ! clouds (using rhmini and qsfacm), the relhum has already been adjusted, and thus
+ ! the nucleation threshold should also be 1.05 and not rhmini + 0.05.
+
+ !-------------------------------------------------------
+
+ if (do_cldice) then
+ where (naai > 0._r8 .and. t < icenuct .and. &
+ relhum*esl/esi > 1.05_r8)
+
+ !if NAAI > 0. then set numice = naai (as before)
+ !note: this is gridbox averaged
+ nnuccd = (naai-ni/icldm)/mtime*icldm
+ nnuccd = max(nnuccd,0._r8)
+ nimax = naai*icldm
+
+ !Calc mass of new particles using new crystal mass...
+ !also this will be multiplied by mtime as nnuccd is...
+
+ mnuccd = nnuccd * mi0
+
+ elsewhere
+ nnuccd = 0._r8
+ nimax = 0._r8
+ mnuccd = 0._r8
+ end where
+
+ end if
+
+
+ !=============================================================================
+ do k=1,nlev
+
+ do i=1,mgncol
+
+ ! calculate instantaneous precip processes (melting and homogeneous freezing)
+
+ ! melting of snow at +2 C
+
+ if (t(i,k) > snowmelt) then
+ if (qs(i,k) > 0._r8) then
+
+ ! make sure melting snow doesn't reduce temperature below threshold
+ dum = -xlf/cpp*qs(i,k)
+ if (t(i,k)+dum < snowmelt) then
+ dum = (t(i,k)-snowmelt)*cpp/xlf
+ dum = dum/qs(i,k)
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+
+ minstsm(i,k) = dum*qs(i,k)
+ ninstsm(i,k) = dum*ns(i,k)
+
+ dum1=-xlf*minstsm(i,k)/deltat
+ tlat(i,k)=tlat(i,k)+dum1
+ meltsdttot(i,k)=meltsdttot(i,k) + dum1
+
+ qs(i,k) = max(qs(i,k) - minstsm(i,k), 0._r8)
+ ns(i,k) = max(ns(i,k) - ninstsm(i,k), 0._r8)
+ qr(i,k) = max(qr(i,k) + minstsm(i,k), 0._r8)
+ nr(i,k) = max(nr(i,k) + ninstsm(i,k), 0._r8)
+ end if
+ end if
+
+ end do
+ end do
+
+ do k=1,nlev
+ do i=1,mgncol
+ ! freezing of rain at -5 C
+
+ if (t(i,k) < rainfrze) then
+
+ if (qr(i,k) > 0._r8) then
+
+ ! make sure freezing rain doesn't increase temperature above threshold
+ dum = xlf/cpp*qr(i,k)
+ if (t(i,k)+dum > rainfrze) then
+ dum = -(t(i,k)-rainfrze)*cpp/xlf
+ dum = dum/qr(i,k)
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+
+ minstrf(i,k) = dum*qr(i,k)
+ ninstrf(i,k) = dum*nr(i,k)
+
+ ! heating tendency
+ dum1 = xlf*minstrf(i,k)/deltat
+ tlat(i,k)=tlat(i,k)+dum1
+ frzrdttot(i,k)=frzrdttot(i,k) + dum1
+
+ qr(i,k) = max(qr(i,k) - minstrf(i,k), 0._r8)
+ nr(i,k) = max(nr(i,k) - ninstrf(i,k), 0._r8)
+ qs(i,k) = max(qs(i,k) + minstrf(i,k), 0._r8)
+ ns(i,k) = max(ns(i,k) + ninstrf(i,k), 0._r8)
+
+ end if
+ end if
+ end do
+ end do
+
+ do k=1,nlev
+ do i=1,mgncol
+ ! obtain in-cloud values of cloud water/ice mixing ratios and number concentrations
+ !-------------------------------------------------------
+ ! for microphysical process calculations
+ ! units are kg/kg for mixing ratio, 1/kg for number conc
+
+ if (qc(i,k).ge.qsmall) then
+ ! limit in-cloud values to 0.005 kg/kg
+ qcic(i,k)=min(qc(i,k)/lcldm(i,k),5.e-3_r8)
+ ncic(i,k)=max(nc(i,k)/lcldm(i,k),0._r8)
+
+ ! specify droplet concentration
+ if (nccons) then
+ ncic(i,k)=ncnst/rho(i,k)
+ end if
+ else
+ qcic(i,k)=0._r8
+ ncic(i,k)=0._r8
+ end if
+
+ if (qi(i,k).ge.qsmall) then
+ ! limit in-cloud values to 0.005 kg/kg
+ qiic(i,k)=min(qi(i,k)/icldm(i,k),5.e-3_r8)
+ niic(i,k)=max(ni(i,k)/icldm(i,k),0._r8)
+
+ ! switch for specification of cloud ice number
+ if (nicons) then
+ niic(i,k)=ninst/rho(i,k)
+ end if
+ else
+ qiic(i,k)=0._r8
+ niic(i,k)=0._r8
+ end if
+
+ end do
+ end do
+
+ !========================================================================
+
+ ! for sub-columns cldm has already been set to 1 if cloud
+ ! water or ice is present, so precip_frac will be correctly set below
+ ! and nothing extra needs to be done here
+
+ precip_frac = cldm
+
+ micro_vert_loop: do k=1,nlev
+
+ if (trim(micro_mg_precip_frac_method) == 'in_cloud') then
+
+ if (k /= 1) then
+ where (qc(:,k) < qsmall .and. qi(:,k) < qsmall)
+ precip_frac(:,k) = precip_frac(:,k-1)
+ end where
+ endif
+
+ else if (trim(micro_mg_precip_frac_method) == 'max_overlap') then
+
+ ! calculate precip fraction based on maximum overlap assumption
+
+ ! if rain or snow mix ratios are smaller than threshold,
+ ! then leave precip_frac as cloud fraction at current level
+ if (k /= 1) then
+ where (qr(:,k-1) >= qsmall .or. qs(:,k-1) >= qsmall)
+ precip_frac(:,k)=max(precip_frac(:,k-1),precip_frac(:,k))
+ end where
+ end if
+
+ endif
+
+
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! get size distribution parameters based on in-cloud cloud water
+ ! these calculations also ensure consistency between number and mixing ratio
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ ! cloud liquid
+ !-------------------------------------------
+
+ call size_dist_param_liq(mg_liq_props, qcic(1:mgncol,k), ncic(1:mgncol,k),&
+ rho(1:mgncol,k), pgam(1:mgncol,k), lamc(1:mgncol,k), mgncol)
+
+
+ !========================================================================
+ ! autoconversion of cloud liquid water to rain
+ ! formula from Khrouditnov and Kogan (2000), modified for sub-grid distribution of qc
+ ! minimum qc of 1 x 10^-8 prevents floating point error
+
+ if (.not. do_sb_physics) then
+ call kk2000_liq_autoconversion(microp_uniform, qcic(1:mgncol,k), &
+ ncic(:,k), rho(:,k), relvar(:,k), prc(:,k), nprc(:,k), nprc1(:,k), mgncol)
+ endif
+
+ ! assign qric based on prognostic qr, using assumed precip fraction
+ ! note: this could be moved above for consistency with qcic and qiic calculations
+ qric(:,k) = qr(:,k)/precip_frac(:,k)
+ nric(:,k) = nr(:,k)/precip_frac(:,k)
+
+ ! limit in-precip mixing ratios to 10 g/kg
+ qric(:,k)=min(qric(:,k),0.01_r8)
+
+ ! add autoconversion to precip from above to get provisional rain mixing ratio
+ ! and number concentration (qric and nric)
+
+ where (qric(:,k).lt.qsmall)
+ qric(:,k)=0._r8
+ nric(:,k)=0._r8
+ end where
+
+ ! make sure number concentration is a positive number to avoid
+ ! taking root of negative later
+
+ nric(:,k)=max(nric(:,k),0._r8)
+
+ ! Get size distribution parameters for cloud ice
+
+ call size_dist_param_basic(mg_ice_props, qiic(:,k), niic(:,k), &
+ lami(:,k), mgncol, n0=n0i(:,k))
+
+ ! Alternative autoconversion
+ if (do_sb_physics) then
+ call sb2001v2_liq_autoconversion(pgam(:,k),qcic(1:mgncol,k),ncic(:,k), &
+ qric(:,k),rho(:,k),relvar(:,k),prc(:,k),nprc(:,k),nprc1(:,k), mgncol)
+ endif
+
+ !.......................................................................
+ ! Autoconversion of cloud ice to snow
+ ! similar to Ferrier (1994)
+
+ if (do_cldice) then
+ call ice_autoconversion(t(:,k), qiic(:,k), lami(:,k), n0i(:,k), &
+ dcs, prci(:,k), nprci(:,k), mgncol)
+ else
+ ! Add in the particles that we have already converted to snow, and
+ ! don't do any further autoconversion of ice.
+ prci(:,k) = tnd_qsnow(:,k) / cldm(:,k)
+ nprci(:,k) = tnd_nsnow(:,k) / cldm(:,k)
+ end if
+
+ ! note, currently we don't have this
+ ! inside the do_cldice block, should be changed later
+ ! assign qsic based on prognostic qs, using assumed precip fraction
+ qsic(:,k) = qs(:,k)/precip_frac(:,k)
+ nsic(:,k) = ns(:,k)/precip_frac(:,k)
+
+ ! limit in-precip mixing ratios to 10 g/kg
+ qsic(:,k)=min(qsic(:,k),0.01_r8)
+
+ ! if precip mix ratio is zero so should number concentration
+
+ where (qsic(:,k) < qsmall)
+ qsic(:,k)=0._r8
+ nsic(:,k)=0._r8
+ end where
+
+ ! make sure number concentration is a positive number to avoid
+ ! taking root of negative later
+
+ nsic(:,k)=max(nsic(:,k),0._r8)
+
+ !.......................................................................
+ ! get size distribution parameters for precip
+ !......................................................................
+ ! rain
+
+ call size_dist_param_basic(mg_rain_props, qric(:,k), nric(:,k), &
+ lamr(:,k), mgncol, n0=n0r(:,k))
+
+ where (lamr(:,k) >= qsmall)
+
+ ! provisional rain number and mass weighted mean fallspeed (m/s)
+
+ unr(:,k) = min(arn(:,k)*gamma_br_plus1/lamr(:,k)**br,9.1_r8*rhof(:,k))
+ umr(:,k) = min(arn(:,k)*gamma_br_plus4/(6._r8*lamr(:,k)**br),9.1_r8*rhof(:,k))
+
+ elsewhere
+ umr(:,k) = 0._r8
+ unr(:,k) = 0._r8
+ end where
+
+ !......................................................................
+ ! snow
+
+ call size_dist_param_basic(mg_snow_props, qsic(:,k), nsic(:,k), &
+ lams(:,k), mgncol, n0=n0s(:,k))
+
+ where (lams(:,k) > 0._r8)
+
+ ! provisional snow number and mass weighted mean fallspeed (m/s)
+
+ ums(:,k) = min(asn(:,k)*gamma_bs_plus4/(6._r8*lams(:,k)**bs),1.2_r8*rhof(:,k))
+ uns(:,k) = min(asn(:,k)*gamma_bs_plus1/lams(:,k)**bs,1.2_r8*rhof(:,k))
+
+ elsewhere
+ ums(:,k) = 0._r8
+ uns(:,k) = 0._r8
+ end where
+
+ if (do_cldice) then
+ if (.not. use_hetfrz_classnuc) then
+
+ ! heterogeneous freezing of cloud water
+ !----------------------------------------------
+
+ call immersion_freezing(microp_uniform, t(:,k), pgam(:,k), lamc(:,k), &
+ qcic(1:mgncol,k), ncic(:,k), relvar(:,k), mnuccc(:,k), nnuccc(:,k), mgncol)
+
+ ! make sure number of droplets frozen does not exceed available ice nuclei concentration
+ ! this prevents 'runaway' droplet freezing
+
+ where (qcic(1:mgncol,k).ge.qsmall .and. t(:,k).lt.269.15_r8)
+ where (nnuccc(:,k)*lcldm(:,k).gt.nnuccd(:,k))
+ ! scale mixing ratio of droplet freezing with limit
+ mnuccc(:,k)=mnuccc(:,k)*(nnuccd(:,k)/(nnuccc(:,k)*lcldm(:,k)))
+ nnuccc(:,k)=nnuccd(:,k)/lcldm(:,k)
+ end where
+ end where
+
+ mdust = size(rndst,3)
+ call contact_freezing(microp_uniform, t(:,k), p(:,k), rndst(:,k,:), &
+ nacon(:,k,:), pgam(:,k), lamc(:,k), qcic(1:mgncol,k), ncic(:,k), &
+ relvar(:,k), mnucct(:,k), nnucct(:,k), mgncol, mdust)
+
+ mnudep(:,k)=0._r8
+ nnudep(:,k)=0._r8
+
+ else
+
+ ! Mass of droplets frozen is the average droplet mass, except
+ ! with two limiters: concentration must be at least 1/cm^3, and
+ ! mass must be at least the minimum defined above.
+ mi0l = qcic(1:mgncol,k)/max(ncic(:,k), 1.0e6_r8/rho(:,k))
+ mi0l = max(mi0l_min, mi0l)
+
+ where (qcic(1:mgncol,k) >= qsmall)
+ nnuccc(:,k) = frzimm(:,k)*1.0e6_r8/rho(:,k)
+ mnuccc(:,k) = nnuccc(:,k)*mi0l
+
+ nnucct(:,k) = frzcnt(:,k)*1.0e6_r8/rho(:,k)
+ mnucct(:,k) = nnucct(:,k)*mi0l
+
+ nnudep(:,k) = frzdep(:,k)*1.0e6_r8/rho(:,k)
+ mnudep(:,k) = nnudep(:,k)*mi0
+ elsewhere
+ nnuccc(:,k) = 0._r8
+ mnuccc(:,k) = 0._r8
+
+ nnucct(:,k) = 0._r8
+ mnucct(:,k) = 0._r8
+
+ nnudep(:,k) = 0._r8
+ mnudep(:,k) = 0._r8
+ end where
+
+ end if
+
+ else
+ mnuccc(:,k)=0._r8
+ nnuccc(:,k)=0._r8
+ mnucct(:,k)=0._r8
+ nnucct(:,k)=0._r8
+ mnudep(:,k)=0._r8
+ nnudep(:,k)=0._r8
+ end if
+
+ call snow_self_aggregation(t(:,k), rho(:,k), asn(:,k), rhosn, qsic(:,k), nsic(:,k), &
+ nsagg(:,k), mgncol)
+
+ call accrete_cloud_water_snow(t(:,k), rho(:,k), asn(:,k), uns(:,k), mu(:,k), &
+ qcic(1:mgncol,k), ncic(:,k), qsic(:,k), pgam(:,k), lamc(:,k), lams(:,k), n0s(:,k), &
+ psacws(:,k), npsacws(:,k), mgncol)
+
+ if (do_cldice) then
+ call secondary_ice_production(t(:,k), psacws(:,k), msacwi(:,k), nsacwi(:,k), mgncol)
+ else
+ nsacwi(:,k) = 0.0_r8
+ msacwi(:,k) = 0.0_r8
+ end if
+
+ call accrete_rain_snow(t(:,k), rho(:,k), umr(:,k), ums(:,k), unr(:,k), uns(:,k), &
+ qric(:,k), qsic(:,k), lamr(:,k), n0r(:,k), lams(:,k), n0s(:,k), &
+ pracs(:,k), npracs(:,k), mgncol)
+
+ call heterogeneous_rain_freezing(t(:,k), qric(:,k), nric(:,k), lamr(:,k), &
+ mnuccr(:,k), nnuccr(:,k), mgncol)
+
+ if (do_sb_physics) then
+ call sb2001v2_accre_cld_water_rain(qcic(1:mgncol,k), ncic(:,k), qric(:,k), &
+ rho(:,k), relvar(:,k), pra(:,k), npra(:,k), mgncol)
+ else
+ call accrete_cloud_water_rain(microp_uniform, qric(:,k), qcic(1:mgncol,k), &
+ ncic(:,k), relvar(:,k), accre_enhan(:,k), pra(:,k), npra(:,k), mgncol)
+ endif
+
+ call self_collection_rain(rho(:,k), qric(:,k), nric(:,k), nragg(:,k), mgncol)
+
+ if (do_cldice) then
+ call accrete_cloud_ice_snow(t(:,k), rho(:,k), asn(:,k), qiic(:,k), niic(:,k), &
+ qsic(:,k), lams(:,k), n0s(:,k), prai(:,k), nprai(:,k), mgncol)
+ else
+ prai(:,k) = 0._r8
+ nprai(:,k) = 0._r8
+ end if
+
+ call evaporate_sublimate_precip(t(:,k), rho(:,k), &
+ dv(:,k), mu(:,k), sc(:,k), q(:,k), qvl(:,k), qvi(:,k), &
+ lcldm(:,k), precip_frac(:,k), arn(:,k), asn(:,k), qcic(1:mgncol,k), qiic(:,k), &
+ qric(:,k), qsic(:,k), lamr(:,k), n0r(:,k), lams(:,k), n0s(:,k), &
+ pre(:,k), prds(:,k), am_evp_st(:,k), mgncol)
+
+ call bergeron_process_snow(t(:,k), rho(:,k), dv(:,k), mu(:,k), sc(:,k), &
+ qvl(:,k), qvi(:,k), asn(:,k), qcic(1:mgncol,k), qsic(:,k), lams(:,k), n0s(:,k), &
+ bergs(:,k), mgncol)
+
+ bergs(:,k)=bergs(:,k)*micro_mg_berg_eff_factor
+
+ !+++PMC 12/3/12 - NEW VAPOR DEP/SUBLIMATION GOES HERE!!!
+ if (do_cldice) then
+
+ call ice_deposition_sublimation(t(:,k), q(:,k), qi(:,k), ni(:,k), &
+ icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), &
+ berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol)
+
+ berg(:,k)=berg(:,k)*micro_mg_berg_eff_factor
+
+ where (ice_sublim(:,k) < 0._r8 .and. qi(:,k) > qsmall .and. icldm(:,k) > mincld)
+ nsubi(:,k) = sublim_factor*ice_sublim(:,k) / qi(:,k) * ni(:,k) / icldm(:,k)
+
+ elsewhere
+ nsubi(:,k) = 0._r8
+ end where
+
+ ! bergeron process should not reduce nc unless
+ ! all ql is removed (which is handled elsewhere)
+ !in fact, nothing in this entire file makes nsubc nonzero.
+ nsubc(:,k) = 0._r8
+
+ end if !do_cldice
+ !---PMC 12/3/12
+
+ do i=1,mgncol
+
+ ! conservation to ensure no negative values of cloud water/precipitation
+ ! in case microphysical process rates are large
+ !===================================================================
+
+ ! note: for check on conservation, processes are multiplied by omsm
+ ! to prevent problems due to round off error
+
+ ! conservation of qc
+ !-------------------------------------------------------------------
+
+ dum = ((prc(i,k)+pra(i,k)+mnuccc(i,k)+mnucct(i,k)+msacwi(i,k)+ &
+ psacws(i,k)+bergs(i,k))*lcldm(i,k)+berg(i,k))*deltat
+
+ if (dum.gt.qc(i,k)) then
+ ratio = qc(i,k)/deltat/((prc(i,k)+pra(i,k)+mnuccc(i,k)+mnucct(i,k)+ &
+ msacwi(i,k)+psacws(i,k)+bergs(i,k))*lcldm(i,k)+berg(i,k))*omsm
+ prc(i,k) = prc(i,k)*ratio
+ pra(i,k) = pra(i,k)*ratio
+ mnuccc(i,k) = mnuccc(i,k)*ratio
+ mnucct(i,k) = mnucct(i,k)*ratio
+ msacwi(i,k) = msacwi(i,k)*ratio
+ psacws(i,k) = psacws(i,k)*ratio
+ bergs(i,k) = bergs(i,k)*ratio
+ berg(i,k) = berg(i,k)*ratio
+ qcrat(i,k) = ratio
+ else
+ qcrat(i,k) = 1._r8
+ end if
+
+ !PMC 12/3/12: ratio is also frac of step w/ liquid.
+ !thus we apply berg for "ratio" of timestep and vapor
+ !deposition for the remaining frac of the timestep.
+ if (qc(i,k) >= qsmall) then
+ vap_dep(i,k) = vap_dep(i,k)*(1._r8-qcrat(i,k))
+ end if
+
+ end do
+
+ do i=1,mgncol
+
+ !=================================================================
+ ! apply limiter to ensure that ice/snow sublimation and rain evap
+ ! don't push conditions into supersaturation, and ice deposition/nucleation don't
+ ! push conditions into sub-saturation
+ ! note this is done after qc conservation since we don't know how large
+ ! vap_dep is before then
+ ! estimates are only approximate since other process terms haven't been limited
+ ! for conservation yet
+
+ ! first limit ice deposition/nucleation vap_dep + mnuccd
+ dum1 = vap_dep(i,k) + mnuccd(i,k)
+ if (dum1 > 1.e-20_r8) then
+ dum = (q(i,k)-qvi(i,k))/(1._r8 + xxls_squared*qvi(i,k)/(cpp*rv*t(i,k)**2))/deltat
+ dum = max(dum,0._r8)
+ if (dum1 > dum) then
+ ! Allocate the limited "dum" tendency to mnuccd and vap_dep
+ ! processes. Don't divide by cloud fraction; these are grid-
+ ! mean rates.
+ dum1 = mnuccd(i,k) / (vap_dep(i,k)+mnuccd(i,k))
+ mnuccd(i,k) = dum*dum1
+ vap_dep(i,k) = dum - mnuccd(i,k)
+ end if
+ end if
+
+ end do
+
+ do i=1,mgncol
+
+ !===================================================================
+ ! conservation of nc
+ !-------------------------------------------------------------------
+ dum = (nprc1(i,k)+npra(i,k)+nnuccc(i,k)+nnucct(i,k)+ &
+ npsacws(i,k)-nsubc(i,k))*lcldm(i,k)*deltat
+
+ if (dum.gt.nc(i,k)) then
+ ratio = nc(i,k)/deltat/((nprc1(i,k)+npra(i,k)+nnuccc(i,k)+nnucct(i,k)+&
+ npsacws(i,k)-nsubc(i,k))*lcldm(i,k))*omsm
+
+ nprc1(i,k) = nprc1(i,k)*ratio
+ npra(i,k) = npra(i,k)*ratio
+ nnuccc(i,k) = nnuccc(i,k)*ratio
+ nnucct(i,k) = nnucct(i,k)*ratio
+ npsacws(i,k) = npsacws(i,k)*ratio
+ nsubc(i,k)=nsubc(i,k)*ratio
+ end if
+
+ mnuccri(i,k)=0._r8
+ nnuccri(i,k)=0._r8
+
+ if (do_cldice) then
+
+ ! freezing of rain to produce ice if mean rain size is smaller than Dcs
+ if (lamr(i,k) > qsmall .and. 1._r8/lamr(i,k) < Dcs) then
+ mnuccri(i,k)=mnuccr(i,k)
+ nnuccri(i,k)=nnuccr(i,k)
+ mnuccr(i,k)=0._r8
+ nnuccr(i,k)=0._r8
+ end if
+ end if
+
+ end do
+
+ do i=1,mgncol
+
+ ! conservation of rain mixing ratio
+ !-------------------------------------------------------------------
+ dum = ((-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k))*precip_frac(i,k)- &
+ (pra(i,k)+prc(i,k))*lcldm(i,k))*deltat
+
+ ! note that qrtend is included below because of instantaneous freezing/melt
+ if (dum.gt.qr(i,k).and. &
+ (-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k)).ge.qsmall) then
+ ratio = (qr(i,k)/deltat+(pra(i,k)+prc(i,k))*lcldm(i,k))/ &
+ precip_frac(i,k)/(-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k))*omsm
+ pre(i,k)=pre(i,k)*ratio
+ pracs(i,k)=pracs(i,k)*ratio
+ mnuccr(i,k)=mnuccr(i,k)*ratio
+ mnuccri(i,k)=mnuccri(i,k)*ratio
+ end if
+
+ end do
+
+ do i=1,mgncol
+
+ ! conservation of rain number
+ !-------------------------------------------------------------------
+
+ ! Add evaporation of rain number.
+ if (pre(i,k) < 0._r8) then
+ !dum = pre(i,k)*deltat/qr(i,k)
+ !dum = max(-1._r8,dum)
+ !nsubr(i,k) = dum*nr(i,k)/deltat
+ nsubr(i,k) = pre(i,k)*nr(i,k)/qr(i,k)
+ else
+ nsubr(i,k) = 0._r8
+ end if
+
+ end do
+
+ do i=1,mgncol
+
+ dum = ((-nsubr(i,k)+npracs(i,k)+nnuccr(i,k)+nnuccri(i,k)-nragg(i,k))*precip_frac(i,k)- &
+ nprc(i,k)*lcldm(i,k))*deltat
+
+ if (dum.gt.nr(i,k)) then
+ ratio = (nr(i,k)/deltat+nprc(i,k)*lcldm(i,k))/precip_frac(i,k)/ &
+ (-nsubr(i,k)+npracs(i,k)+nnuccr(i,k)+nnuccri(i,k)-nragg(i,k))*omsm
+
+ nragg(i,k)=nragg(i,k)*ratio
+ npracs(i,k)=npracs(i,k)*ratio
+ nnuccr(i,k)=nnuccr(i,k)*ratio
+ nsubr(i,k)=nsubr(i,k)*ratio
+ nnuccri(i,k)=nnuccri(i,k)*ratio
+ end if
+
+ end do
+
+ if (do_cldice) then
+
+ do i=1,mgncol
+
+ ! conservation of qi
+ !-------------------------------------------------------------------
+
+ dum = ((-mnuccc(i,k)-mnucct(i,k)-mnudep(i,k)-msacwi(i,k))*lcldm(i,k)+(prci(i,k)+ &
+ prai(i,k))*icldm(i,k)-mnuccri(i,k)*precip_frac(i,k) &
+ -ice_sublim(i,k)-vap_dep(i,k)-berg(i,k)-mnuccd(i,k))*deltat
+
+ if (dum.gt.qi(i,k)) then
+ ratio = (qi(i,k)/deltat+vap_dep(i,k)+berg(i,k)+mnuccd(i,k)+ &
+ (mnuccc(i,k)+mnucct(i,k)+mnudep(i,k)+msacwi(i,k))*lcldm(i,k)+ &
+ mnuccri(i,k)*precip_frac(i,k))/ &
+ ((prci(i,k)+prai(i,k))*icldm(i,k)-ice_sublim(i,k))*omsm
+ prci(i,k) = prci(i,k)*ratio
+ prai(i,k) = prai(i,k)*ratio
+ ice_sublim(i,k) = ice_sublim(i,k)*ratio
+ end if
+
+ end do
+
+ end if
+
+ if (do_cldice) then
+
+ do i=1,mgncol
+
+ ! conservation of ni
+ !-------------------------------------------------------------------
+ if (use_hetfrz_classnuc) then
+ tmpfrz = nnuccc(i,k)
+ else
+ tmpfrz = 0._r8
+ end if
+ dum = ((-nnucct(i,k)-tmpfrz-nnudep(i,k)-nsacwi(i,k))*lcldm(i,k)+(nprci(i,k)+ &
+ nprai(i,k)-nsubi(i,k))*icldm(i,k)-nnuccri(i,k)*precip_frac(i,k)- &
+ nnuccd(i,k))*deltat
+
+ if (dum.gt.ni(i,k)) then
+ ratio = (ni(i,k)/deltat+nnuccd(i,k)+ &
+ (nnucct(i,k)+tmpfrz+nnudep(i,k)+nsacwi(i,k))*lcldm(i,k)+ &
+ nnuccri(i,k)*precip_frac(i,k))/ &
+ ((nprci(i,k)+nprai(i,k)-nsubi(i,k))*icldm(i,k))*omsm
+ nprci(i,k) = nprci(i,k)*ratio
+ nprai(i,k) = nprai(i,k)*ratio
+ nsubi(i,k) = nsubi(i,k)*ratio
+ end if
+
+ end do
+
+ end if
+
+ do i=1,mgncol
+
+ ! conservation of snow mixing ratio
+ !-------------------------------------------------------------------
+ dum = (-(prds(i,k)+pracs(i,k)+mnuccr(i,k))*precip_frac(i,k)-(prai(i,k)+prci(i,k))*icldm(i,k) &
+ -(bergs(i,k)+psacws(i,k))*lcldm(i,k))*deltat
+
+ if (dum.gt.qs(i,k).and.-prds(i,k).ge.qsmall) then
+ ratio = (qs(i,k)/deltat+(prai(i,k)+prci(i,k))*icldm(i,k)+ &
+ (bergs(i,k)+psacws(i,k))*lcldm(i,k)+(pracs(i,k)+mnuccr(i,k))*precip_frac(i,k))/ &
+ precip_frac(i,k)/(-prds(i,k))*omsm
+ prds(i,k)=prds(i,k)*ratio
+ end if
+
+ end do
+
+ do i=1,mgncol
+
+ ! conservation of snow number
+ !-------------------------------------------------------------------
+ ! calculate loss of number due to sublimation
+ ! for now neglect sublimation of ns
+ nsubs(i,k)=0._r8
+
+ dum = ((-nsagg(i,k)-nsubs(i,k)-nnuccr(i,k))*precip_frac(i,k)-nprci(i,k)*icldm(i,k))*deltat
+
+ if (dum.gt.ns(i,k)) then
+ ratio = (ns(i,k)/deltat+nnuccr(i,k)* &
+ precip_frac(i,k)+nprci(i,k)*icldm(i,k))/precip_frac(i,k)/ &
+ (-nsubs(i,k)-nsagg(i,k))*omsm
+ nsubs(i,k)=nsubs(i,k)*ratio
+ nsagg(i,k)=nsagg(i,k)*ratio
+ end if
+
+ end do
+
+ do i=1,mgncol
+
+ ! next limit ice and snow sublimation and rain evaporation
+ ! get estimate of q and t at end of time step
+ ! don't include other microphysical processes since they haven't
+ ! been limited via conservation checks yet
+
+ if ((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k) < -1.e-20_r8) then
+
+ qtmp=q(i,k)-(ice_sublim(i,k)+vap_dep(i,k)+mnuccd(i,k)+ &
+ (pre(i,k)+prds(i,k))*precip_frac(i,k))*deltat
+ ttmp=t(i,k)+((pre(i,k)*precip_frac(i,k))*xxlv+ &
+ (prds(i,k)*precip_frac(i,k)+vap_dep(i,k)+ice_sublim(i,k)+mnuccd(i,k))*xxls)*deltat/cpp
+
+ ! use rhw to allow ice supersaturation
+ call qsat_water(ttmp, p(i,k), esn, qvn)
+
+ ! modify ice/precip evaporation rate if q > qsat
+ if (qtmp > qvn) then
+
+ dum1=pre(i,k)*precip_frac(i,k)/((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k))
+ dum2=prds(i,k)*precip_frac(i,k)/((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k))
+ ! recalculate q and t after vap_dep and mnuccd but without evap or sublim
+ qtmp=q(i,k)-(vap_dep(i,k)+mnuccd(i,k))*deltat
+ ttmp=t(i,k)+((vap_dep(i,k)+mnuccd(i,k))*xxls)*deltat/cpp
+
+ ! use rhw to allow ice supersaturation
+ call qsat_water(ttmp, p(i,k), esn, qvn)
+
+ dum=(qtmp-qvn)/(1._r8 + xxlv_squared*qvn/(cpp*rv*ttmp**2))
+ dum=min(dum,0._r8)
+
+ ! modify rates if needed, divide by precip_frac to get local (in-precip) value
+ pre(i,k)=dum*dum1/deltat/precip_frac(i,k)
+
+ ! do separately using RHI for prds and ice_sublim
+ call qsat_ice(ttmp, p(i,k), esn, qvn)
+
+ dum=(qtmp-qvn)/(1._r8 + xxls_squared*qvn/(cpp*rv*ttmp**2))
+ dum=min(dum,0._r8)
+
+ ! modify rates if needed, divide by precip_frac to get local (in-precip) value
+ prds(i,k) = dum*dum2/deltat/precip_frac(i,k)
+
+ ! don't divide ice_sublim by cloud fraction since it is grid-averaged
+ dum1 = (1._r8-dum1-dum2)
+ ice_sublim(i,k) = dum*dum1/deltat
+ end if
+ end if
+
+ end do
+
+ ! Big "administration" loop enforces conservation, updates variables
+ ! that accumulate over substeps, and sets output variables.
+
+ do i=1,mgncol
+
+ ! get tendencies due to microphysical conversion processes
+ !==========================================================
+ ! note: tendencies are multiplied by appropriate cloud/precip
+ ! fraction to get grid-scale values
+ ! note: vap_dep is already grid-average values
+
+ ! The net tendencies need to be added to rather than overwritten,
+ ! because they may have a value already set for instantaneous
+ ! melting/freezing.
+
+ qvlat(i,k) = qvlat(i,k)-(pre(i,k)+prds(i,k))*precip_frac(i,k)-&
+ vap_dep(i,k)-ice_sublim(i,k)-mnuccd(i,k)-mnudep(i,k)*lcldm(i,k)
+
+ tlat(i,k) = tlat(i,k)+((pre(i,k)*precip_frac(i,k)) &
+ *xxlv+(prds(i,k)*precip_frac(i,k)+vap_dep(i,k)+ice_sublim(i,k)+mnuccd(i,k)+mnudep(i,k)*lcldm(i,k))*xxls+ &
+ ((bergs(i,k)+psacws(i,k)+mnuccc(i,k)+mnucct(i,k)+msacwi(i,k))*lcldm(i,k)+(mnuccr(i,k)+ &
+ pracs(i,k)+mnuccri(i,k))*precip_frac(i,k)+berg(i,k))*xlf)
+
+ qctend(i,k) = qctend(i,k)+ &
+ (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- &
+ psacws(i,k)-bergs(i,k))*lcldm(i,k)-berg(i,k)
+
+ if (do_cldice) then
+ qitend(i,k) = qitend(i,k)+ &
+ (mnuccc(i,k)+mnucct(i,k)+mnudep(i,k)+msacwi(i,k))*lcldm(i,k)+(-prci(i,k)- &
+ prai(i,k))*icldm(i,k)+vap_dep(i,k)+berg(i,k)+ice_sublim(i,k)+ &
+ mnuccd(i,k)+mnuccri(i,k)*precip_frac(i,k)
+ end if
+
+ qrtend(i,k) = qrtend(i,k)+ &
+ (pra(i,k)+prc(i,k))*lcldm(i,k)+(pre(i,k)-pracs(i,k)- &
+ mnuccr(i,k)-mnuccri(i,k))*precip_frac(i,k)
+
+ qstend(i,k) = qstend(i,k)+ &
+ (prai(i,k)+prci(i,k))*icldm(i,k)+(psacws(i,k)+bergs(i,k))*lcldm(i,k)+(prds(i,k)+ &
+ pracs(i,k)+mnuccr(i,k))*precip_frac(i,k)
+
+
+ cmeout(i,k) = vap_dep(i,k) + ice_sublim(i,k) + mnuccd(i,k)
+
+ ! add output for cmei (accumulate)
+ cmeitot(i,k) = vap_dep(i,k) + ice_sublim(i,k) + mnuccd(i,k)
+
+ ! assign variables for trop_mozart, these are grid-average
+ !-------------------------------------------------------------------
+ ! evaporation/sublimation is stored here as positive term
+
+ evapsnow(i,k) = -prds(i,k)*precip_frac(i,k)
+ nevapr(i,k) = -pre(i,k)*precip_frac(i,k)
+ prer_evap(i,k) = -pre(i,k)*precip_frac(i,k)
+
+ ! change to make sure prain is positive: do not remove snow from
+ ! prain used for wet deposition
+ prain(i,k) = (pra(i,k)+prc(i,k))*lcldm(i,k)+(-pracs(i,k)- &
+ mnuccr(i,k)-mnuccri(i,k))*precip_frac(i,k)
+ prodsnow(i,k) = (prai(i,k)+prci(i,k))*icldm(i,k)+(psacws(i,k)+bergs(i,k))*lcldm(i,k)+(&
+ pracs(i,k)+mnuccr(i,k))*precip_frac(i,k)
+
+ ! following are used to calculate 1st order conversion rate of cloud water
+ ! to rain and snow (1/s), for later use in aerosol wet removal routine
+ ! previously, wetdepa used (prain/qc) for this, and the qc in wetdepa may be smaller than the qc
+ ! used to calculate pra, prc, ... in this routine
+ ! qcsinksum_rate1ord = { rate of direct transfer of cloud water to rain & snow }
+ ! (no cloud ice or bergeron terms)
+ qcsinksum_rate1ord(i,k) = (pra(i,k)+prc(i,k)+psacws(i,k))*lcldm(i,k)
+ ! Avoid zero/near-zero division.
+ qcsinksum_rate1ord(i,k) = qcsinksum_rate1ord(i,k) / &
+ max(qc(i,k),1.0e-30_r8)
+
+
+ ! microphysics output, note this is grid-averaged
+ pratot(i,k) = pra(i,k)*lcldm(i,k)
+ prctot(i,k) = prc(i,k)*lcldm(i,k)
+ mnuccctot(i,k) = mnuccc(i,k)*lcldm(i,k)
+ mnuccttot(i,k) = mnucct(i,k)*lcldm(i,k)
+ msacwitot(i,k) = msacwi(i,k)*lcldm(i,k)
+ psacwstot(i,k) = psacws(i,k)*lcldm(i,k)
+ bergstot(i,k) = bergs(i,k)*lcldm(i,k)
+ bergtot(i,k) = berg(i,k)
+ prcitot(i,k) = prci(i,k)*icldm(i,k)
+ praitot(i,k) = prai(i,k)*icldm(i,k)
+ mnuccdtot(i,k) = mnuccd(i,k)*icldm(i,k)
+
+ pracstot(i,k) = pracs(i,k)*precip_frac(i,k)
+ mnuccrtot(i,k) = mnuccr(i,k)*precip_frac(i,k)
+!AL
+ mnuccritot(i,k) = mnuccri(i,k)*precip_frac(i,k)
+ mnudeptot(i,k)=mnudep(i,k)*lcldm(i,k)
+
+ ! microphysics output for number concentration tendencies
+ ! for liq.
+ nnuccctot(i,k)=nnuccc(i,k)*lcldm(i,k)
+ nnuccttot(i,k)=nnucct(i,k)*lcldm(i,k)
+ npsacwstot(i,k)=npsacws(i,k)*lcldm(i,k)
+ nsubctot(i,k)=nsubc(i,k)*lcldm(i,k)
+ npratot(i,k)=npra(i,k)*lcldm(i,k)
+ nprc1tot(i,k)=nprc1(i,k)*lcldm(i,k)
+
+ ! for ice
+ nsacwitot(i,k)=nsacwi(i,k)*lcldm(i,k)
+ nsubitot(i,k)=nsubi(i,k)*icldm(i,k)
+ nprcitot(i,k)=nprci(i,k)*icldm(i,k)
+ npraitot(i,k)=nprai(i,k)*icldm(i,k)
+ nnudeptot(i,k)=nnudep(i,k)*lcldm(i,k)
+ nnuccdtot(i,k)=nnuccd(i,k)
+ nnuccritot(i,k) = nnuccri(i,k)*precip_frac(i,k)
+
+!AL
+
+
+ nctend(i,k) = nctend(i,k)+&
+ (-nnuccc(i,k)-nnucct(i,k)-npsacws(i,k)+nsubc(i,k) &
+ -npra(i,k)-nprc1(i,k))*lcldm(i,k)
+
+ if (do_cldice) then
+ if (use_hetfrz_classnuc) then
+ tmpfrz = nnuccc(i,k)
+ else
+ tmpfrz = 0._r8
+ end if
+ nitend(i,k) = nitend(i,k)+ nnuccd(i,k)+ &
+ (nnucct(i,k)+tmpfrz+nnudep(i,k)+nsacwi(i,k))*lcldm(i,k)+(nsubi(i,k)-nprci(i,k)- &
+ nprai(i,k))*icldm(i,k)+nnuccri(i,k)*precip_frac(i,k)
+ end if
+
+ nstend(i,k) = nstend(i,k)+(nsubs(i,k)+ &
+ nsagg(i,k)+nnuccr(i,k))*precip_frac(i,k)+nprci(i,k)*icldm(i,k)
+
+ nrtend(i,k) = nrtend(i,k)+ &
+ nprc(i,k)*lcldm(i,k)+(nsubr(i,k)-npracs(i,k)-nnuccr(i,k) &
+ -nnuccri(i,k)+nragg(i,k))*precip_frac(i,k)
+
+ ! make sure that ni at advanced time step does not exceed
+ ! maximum (existing N + source terms*dt), which is possible if mtime < deltat
+ ! note that currently mtime = deltat
+ !================================================================
+
+ if (do_cldice .and. nitend(i,k).gt.0._r8.and.ni(i,k)+nitend(i,k)*deltat.gt.nimax(i,k)) then
+ nitncons(i,k) = nitncons(i,k) + nitend(i,k)-max(0._r8,(nimax(i,k)-ni(i,k))/deltat) !AL
+ nitend(i,k)=max(0._r8,(nimax(i,k)-ni(i,k))/deltat)
+ end if
+
+ end do
+
+ ! End of "administration" loop
+
+ end do micro_vert_loop ! end k loop
+
+ !-----------------------------------------------------
+ ! convert rain/snow q and N for output to history, note,
+ ! output is for gridbox average
+
+ qrout = qr
+ nrout = nr * rho
+ qsout = qs
+ nsout = ns * rho
+
+ ! calculate n0r and lamr from rain mass and number
+ ! divide by precip fraction to get in-precip (local) values of
+ ! rain mass and number, divide by rhow to get rain number in kg^-1
+
+ do k=1,nlev
+
+ call size_dist_param_basic(mg_rain_props, qric(:,k), nric(:,k), lamr(:,k), mgncol, n0=n0r(:,k))
+
+ ! Calculate rercld
+
+ ! calculate mean size of combined rain and cloud water
+
+ call calc_rercld(lamr(:,k), n0r(:,k), lamc(:,k), pgam(:,k), qric(:,k), qcic(1:mgncol,k), ncic(:,k), &
+ rercld(:,k), mgncol)
+
+ enddo
+
+ ! Assign variables back to start-of-timestep values
+ ! Some state variables are changed before the main microphysics loop
+ ! to make "instantaneous" adjustments. Afterward, we must move those changes
+ ! back into the tendencies.
+ ! These processes:
+ ! - Droplet activation (npccn, impacts nc)
+ ! - Instantaneous snow melting (minstsm/ninstsm, impacts qr/qs/nr/ns)
+ ! - Instantaneous rain freezing (minstfr/ninstrf, impacts qr/qs/nr/ns)
+ !================================================================================
+
+ ! Re-apply droplet activation tendency
+ nc = ncn
+ nctend = nctend + npccn
+!AL
+ npccntot = npccn
+!AL
+
+ ! Re-apply rain freezing and snow melting.
+ dum_2D = qs
+ qs = qsn
+ qstend = qstend + (dum_2D-qs)/deltat
+
+ dum_2D = ns
+ ns = nsn
+ nstend = nstend + (dum_2D-ns)/deltat
+
+ dum_2D = qr
+ qr = qrn
+ qrtend = qrtend + (dum_2D-qr)/deltat
+
+ dum_2D = nr
+ nr = nrn
+ nrtend = nrtend + (dum_2D-nr)/deltat
+
+ !.............................................................................
+
+ !================================================================================
+
+ ! modify to include snow. in prain & evap (diagnostic here: for wet dep)
+ nevapr = nevapr + evapsnow
+ prain = prain + prodsnow
+
+
+
+ do k=1,nlev
+
+ do i=1,mgncol
+
+ ! calculate sedimentation for cloud water and ice
+ !================================================================================
+
+ ! update in-cloud cloud mixing ratio and number concentration
+ ! with microphysical tendencies to calculate sedimentation, assign to dummy vars
+ ! note: these are in-cloud values***, hence we divide by cloud fraction
+
+ dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat)/lcldm(i,k)
+ dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat)/icldm(i,k)
+ dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat)/lcldm(i,k),0._r8)
+ dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat)/icldm(i,k),0._r8)
+
+ dumr(i,k) = (qr(i,k)+qrtend(i,k)*deltat)/precip_frac(i,k)
+ dumnr(i,k) = max((nr(i,k)+nrtend(i,k)*deltat)/precip_frac(i,k),0._r8)
+ dums(i,k) = (qs(i,k)+qstend(i,k)*deltat)/precip_frac(i,k)
+ dumns(i,k) = max((ns(i,k)+nstend(i,k)*deltat)/precip_frac(i,k),0._r8)
+
+
+ ! switch for specification of droplet and crystal number
+ if (nccons) then
+ dumnc(i,k)=ncnst/rho(i,k)
+ end if
+
+ ! switch for specification of cloud ice number
+ if (nicons) then
+ dumni(i,k)=ninst/rho(i,k)
+ end if
+ enddo
+ enddo
+
+ do k=1,nlev
+
+ ! obtain new slope parameter to avoid possible singularity
+
+ call size_dist_param_basic(mg_ice_props, dumi(:,k), dumni(:,k), &
+ lami(:,k), mgncol)
+
+ call size_dist_param_liq(mg_liq_props, dumc(:,k), dumnc(:,k), rho(:,k), &
+ pgam(:,k), lamc(:,k), mgncol)
+
+ enddo
+
+ do k=1,nlev
+ do i=1,mgncol
+
+ ! calculate number and mass weighted fall velocity for droplets and cloud ice
+ !-------------------------------------------------------------------
+
+
+ if (dumc(i,k).ge.qsmall) then
+
+ vtrmc(i,k)=acn(i,k)*gamma(4._r8+bc+pgam(i,k))/ &
+ (lamc(i,k)**bc*gamma(pgam(i,k)+4._r8))
+
+ fc(i,k) = g*rho(i,k)*vtrmc(i,k)
+
+ fnc(i,k) = g*rho(i,k)* &
+ acn(i,k)*gamma(1._r8+bc+pgam(i,k))/ &
+ (lamc(i,k)**bc*gamma(pgam(i,k)+1._r8))
+ else
+ fc(i,k) = 0._r8
+ fnc(i,k)= 0._r8
+ end if
+
+ ! calculate number and mass weighted fall velocity for cloud ice
+
+ if (dumi(i,k).ge.qsmall) then
+
+ vtrmi(i,k)=min(ain(i,k)*gamma_bi_plus4/(6._r8*lami(i,k)**bi), &
+ 1.2_r8*rhof(i,k))
+
+ fi(i,k) = g*rho(i,k)*vtrmi(i,k)
+ fni(i,k) = g*rho(i,k)* &
+ min(ain(i,k)*gamma_bi_plus1/lami(i,k)**bi,1.2_r8*rhof(i,k))
+
+ ! adjust the ice fall velocity for smaller (r < 20 um) ice
+ ! particles (blend over 18-20 um)
+ irad = 1.5_r8 / lami(i,k) * 1e6_r8
+ ifrac = min(1._r8, max(0._r8, (irad - 18._r8) / 2._r8))
+
+ if (ifrac .lt. 1._r8) then
+ vtrmi(i,k) = ifrac * vtrmi(i,k) + &
+ (1._r8 - ifrac) * &
+ min(ajn(i,k)*gamma_bj_plus4/(6._r8*lami(i,k)**bj), &
+ 1.2_r8*rhof(i,k))
+
+ fi(i,k) = g*rho(i,k)*vtrmi(i,k)
+ fni(i,k) = ifrac * fni(i,k) + &
+ (1._r8 - ifrac) * &
+ g*rho(i,k)* &
+ min(ajn(i,k)*gamma_bj_plus1/lami(i,k)**bj,1.2_r8*rhof(i,k))
+ end if
+ else
+ fi(i,k) = 0._r8
+ fni(i,k)= 0._r8
+ end if
+
+ enddo
+
+ enddo
+
+ do k=1,nlev
+
+ ! fallspeed for rain
+
+ call size_dist_param_basic(mg_rain_props, dumr(:,k), dumnr(:,k), &
+ lamr(:,k), mgncol)
+ enddo
+
+ do k=1,nlev
+
+ do i=1,mgncol
+ if (lamr(i,k).ge.qsmall) then
+
+ ! 'final' values of number and mass weighted mean fallspeed for rain (m/s)
+
+ unr(i,k) = min(arn(i,k)*gamma_br_plus1/lamr(i,k)**br,9.1_r8*rhof(i,k))
+ umr(i,k) = min(arn(i,k)*gamma_br_plus4/(6._r8*lamr(i,k)**br),9.1_r8*rhof(i,k))
+
+ fr(i,k) = g*rho(i,k)*umr(i,k)
+ fnr(i,k) = g*rho(i,k)*unr(i,k)
+
+ else
+ fr(i,k)=0._r8
+ fnr(i,k)=0._r8
+ end if
+
+ ! fallspeed for snow
+
+ call size_dist_param_basic(mg_snow_props, dums(i,k), dumns(i,k), &
+ lams(i,k))
+
+ if (lams(i,k).ge.qsmall) then
+
+ ! 'final' values of number and mass weighted mean fallspeed for snow (m/s)
+ ums(i,k) = min(asn(i,k)*gamma_bs_plus4/(6._r8*lams(i,k)**bs),1.2_r8*rhof(i,k))
+ uns(i,k) = min(asn(i,k)*gamma_bs_plus1/lams(i,k)**bs,1.2_r8*rhof(i,k))
+
+ fs(i,k) = g*rho(i,k)*ums(i,k)
+ fns(i,k) = g*rho(i,k)*uns(i,k)
+
+ else
+ fs(i,k)=0._r8
+ fns(i,k)=0._r8
+ end if
+
+ ! redefine dummy variables - sedimentation is calculated over grid-scale
+ ! quantities to ensure conservation
+
+ dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat)
+ dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat),0._r8)
+ dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat)
+ dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat),0._r8)
+ dumr(i,k) = (qr(i,k)+qrtend(i,k)*deltat)
+ dumnr(i,k) = max((nr(i,k)+nrtend(i,k)*deltat),0._r8)
+ dums(i,k) = (qs(i,k)+qstend(i,k)*deltat)
+ dumns(i,k) = max((ns(i,k)+nstend(i,k)*deltat),0._r8)
+
+ if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8
+ if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8
+ if (dumr(i,k).lt.qsmall) dumnr(i,k)=0._r8
+ if (dums(i,k).lt.qsmall) dumns(i,k)=0._r8
+
+ enddo
+ end do !!! vertical loop
+
+ do k=1,nlev
+ do i=1,mgncol
+ pdel_inv(i,k) = 1._r8/pdel(i,k)
+ enddo
+ enddo
+
+ ! initialize nstep for sedimentation sub-steps
+
+ ! calculate number of split time steps to ensure courant stability criteria
+ ! for sedimentation calculations
+ !-------------------------------------------------------------------
+ do i=1,mgncol
+ nstep = 1 + int(max( &
+ maxval( fi(i,:)*pdel_inv(i,:)), &
+ maxval(fni(i,:)*pdel_inv(i,:))) &
+ * deltat)
+
+
+ ! loop over sedimentation sub-time step to ensure stability
+ !==============================================================
+ do n = 1,nstep
+
+ if (do_cldice) then
+ falouti = fi(i,:) * dumi(i,:)
+ faloutni = fni(i,:) * dumni(i,:)
+ else
+ falouti = 0._r8
+ faloutni = 0._r8
+ end if
+
+ ! top of model
+
+ k = 1
+
+ ! add fallout terms to microphysical tendencies
+ faltndi = falouti(k)/pdel(i,k)
+ faltndni = faloutni(k)/pdel(i,k)
+ qitend(i,k) = qitend(i,k)-faltndi/nstep
+ nitend(i,k) = nitend(i,k)-faltndni/nstep
+
+ ! sedimentation tendency for output
+ qisedten(i,k)=qisedten(i,k)-faltndi/nstep
+!AL
+ nisedtentot(i,k)=nisedtentot(i,k)-faltndni/nstep
+!AL
+ dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep
+ dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep
+
+ do k = 2,nlev
+
+ ! for cloud liquid and ice, if cloud fraction increases with height
+ ! then add flux from above to both vapor and cloud water of current level
+ ! this means that flux entering clear portion of cell from above evaporates
+ ! instantly
+
+ ! note: this is not an issue with precip, since we assume max overlap
+ dum1=icldm(i,k)/icldm(i,k-1)
+ dum1=min(dum1,1._r8)
+
+ faltndqie=(falouti(k)-falouti(k-1))/pdel(i,k)
+ faltndi=(falouti(k)-dum1*falouti(k-1))/pdel(i,k)
+ faltndni=(faloutni(k)-dum1*faloutni(k-1))/pdel(i,k)
+
+ ! add fallout terms to eulerian tendencies
+
+ qitend(i,k) = qitend(i,k)-faltndi/nstep
+ nitend(i,k) = nitend(i,k)-faltndni/nstep
+
+ ! sedimentation tendency for output
+ qisedten(i,k)=qisedten(i,k)-faltndi/nstep
+!AL
+ nisedtentot(i,k)=nisedtentot(i,k)-faltndni/nstep
+!AL
+ ! add terms to to evap/sub of cloud water
+
+ qvlat(i,k)=qvlat(i,k)-(faltndqie-faltndi)/nstep
+ ! for output
+ qisevap(i,k)=qisevap(i,k)-(faltndqie-faltndi)/nstep
+
+ tlat(i,k)=tlat(i,k)+(faltndqie-faltndi)*xxls/nstep
+
+ dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep
+ dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep
+
+ end do
+
+ ! Ice flux
+ do k = 1,nlev
+ iflx(i,k+1) = iflx(i,k+1) + falouti(k) / g / real(nstep)
+ end do
+
+ ! units below are m/s
+ ! sedimentation flux at surface is added to precip flux at surface
+ ! to get total precip (cloud + precip water) rate
+
+ prect(i) = prect(i)+falouti(nlev)/g/real(nstep)/1000._r8
+ preci(i) = preci(i)+falouti(nlev)/g/real(nstep)/1000._r8
+
+ end do
+
+ ! calculate number of split time steps to ensure courant stability criteria
+ ! for sedimentation calculations
+ !-------------------------------------------------------------------
+ nstep = 1 + int(max( &
+ maxval( fc(i,:)*pdel_inv(i,:)), &
+ maxval(fnc(i,:)*pdel_inv(i,:))) &
+ * deltat)
+
+ ! loop over sedimentation sub-time step to ensure stability
+ !==============================================================
+ do n = 1,nstep
+
+ faloutc = fc(i,:) * dumc(i,:)
+ faloutnc = fnc(i,:) * dumnc(i,:)
+
+ ! top of model
+ k = 1
+
+ ! add fallout terms to microphysical tendencies
+ faltndc = faloutc(k)/pdel(i,k)
+ faltndnc = faloutnc(k)/pdel(i,k)
+ qctend(i,k) = qctend(i,k)-faltndc/nstep
+ nctend(i,k) = nctend(i,k)-faltndnc/nstep
+
+ ! sedimentation tendency for output
+ qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep
+!AL
+ ncsedtentot(i,k)=ncsedtentot(i,k)-faltndnc/nstep
+!AL
+ dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep
+ dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep
+
+ do k = 2,nlev
+
+ dum=lcldm(i,k)/lcldm(i,k-1)
+ dum=min(dum,1._r8)
+ faltndqce=(faloutc(k)-faloutc(k-1))/pdel(i,k)
+ faltndc=(faloutc(k)-dum*faloutc(k-1))/pdel(i,k)
+ faltndnc=(faloutnc(k)-dum*faloutnc(k-1))/pdel(i,k)
+
+ ! add fallout terms to eulerian tendencies
+ qctend(i,k) = qctend(i,k)-faltndc/nstep
+ nctend(i,k) = nctend(i,k)-faltndnc/nstep
+
+ ! sedimentation tendency for output
+ qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep
+!AL
+ ncsedtentot(i,k)=ncsedtentot(i,k)-faltndnc/nstep
+!AL
+ ! add terms to to evap/sub of cloud water
+ qvlat(i,k)=qvlat(i,k)-(faltndqce-faltndc)/nstep
+ ! for output
+ qcsevap(i,k)=qcsevap(i,k)-(faltndqce-faltndc)/nstep
+
+ tlat(i,k)=tlat(i,k)+(faltndqce-faltndc)*xxlv/nstep
+
+ dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep
+ dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep
+
+ end do
+
+ !Liquid condensate flux here
+ do k = 1,nlev
+ lflx(i,k+1) = lflx(i,k+1) + faloutc(k) / g / real(nstep)
+ end do
+
+ prect(i) = prect(i)+faloutc(nlev)/g/real(nstep)/1000._r8
+
+ end do
+
+ ! calculate number of split time steps to ensure courant stability criteria
+ ! for sedimentation calculations
+ !-------------------------------------------------------------------
+ nstep = 1 + int(max( &
+ maxval( fr(i,:)*pdel_inv(i,:)), &
+ maxval(fnr(i,:)*pdel_inv(i,:))) &
+ * deltat)
+
+ ! loop over sedimentation sub-time step to ensure stability
+ !==============================================================
+ do n = 1,nstep
+
+ faloutr = fr(i,:) * dumr(i,:)
+ faloutnr = fnr(i,:) * dumnr(i,:)
+
+ ! top of model
+ k = 1
+
+ ! add fallout terms to microphysical tendencies
+ faltndr = faloutr(k)/pdel(i,k)
+ faltndnr = faloutnr(k)/pdel(i,k)
+ qrtend(i,k) = qrtend(i,k)-faltndr/nstep
+ nrtend(i,k) = nrtend(i,k)-faltndnr/nstep
+
+ ! sedimentation tendency for output
+ qrsedten(i,k)=qrsedten(i,k)-faltndr/nstep
+
+ dumr(i,k) = dumr(i,k)-faltndr*deltat/real(nstep)
+ dumnr(i,k) = dumnr(i,k)-faltndnr*deltat/real(nstep)
+
+ do k = 2,nlev
+
+ faltndr=(faloutr(k)-faloutr(k-1))/pdel(i,k)
+ faltndnr=(faloutnr(k)-faloutnr(k-1))/pdel(i,k)
+
+ ! add fallout terms to eulerian tendencies
+ qrtend(i,k) = qrtend(i,k)-faltndr/nstep
+ nrtend(i,k) = nrtend(i,k)-faltndnr/nstep
+
+ ! sedimentation tendency for output
+ qrsedten(i,k)=qrsedten(i,k)-faltndr/nstep
+
+ dumr(i,k) = dumr(i,k)-faltndr*deltat/real(nstep)
+ dumnr(i,k) = dumnr(i,k)-faltndnr*deltat/real(nstep)
+
+ end do
+
+ ! Rain Flux
+ do k = 1,nlev
+ rflx(i,k+1) = rflx(i,k+1) + faloutr(k) / g / real(nstep)
+ end do
+
+ prect(i) = prect(i)+faloutr(nlev)/g/real(nstep)/1000._r8
+
+ end do
+
+ ! calculate number of split time steps to ensure courant stability criteria
+ ! for sedimentation calculations
+ !-------------------------------------------------------------------
+ nstep = 1 + int(max( &
+ maxval( fs(i,:)*pdel_inv(i,:)), &
+ maxval(fns(i,:)*pdel_inv(i,:))) &
+ * deltat)
+
+ ! loop over sedimentation sub-time step to ensure stability
+ !==============================================================
+ do n = 1,nstep
+
+ falouts = fs(i,:) * dums(i,:)
+ faloutns = fns(i,:) * dumns(i,:)
+
+ ! top of model
+ k = 1
+
+ ! add fallout terms to microphysical tendencies
+ faltnds = falouts(k)/pdel(i,k)
+ faltndns = faloutns(k)/pdel(i,k)
+ qstend(i,k) = qstend(i,k)-faltnds/nstep
+ nstend(i,k) = nstend(i,k)-faltndns/nstep
+
+ ! sedimentation tendency for output
+ qssedten(i,k)=qssedten(i,k)-faltnds/nstep
+
+ dums(i,k) = dums(i,k)-faltnds*deltat/real(nstep)
+ dumns(i,k) = dumns(i,k)-faltndns*deltat/real(nstep)
+
+ do k = 2,nlev
+
+ faltnds=(falouts(k)-falouts(k-1))/pdel(i,k)
+ faltndns=(faloutns(k)-faloutns(k-1))/pdel(i,k)
+
+ ! add fallout terms to eulerian tendencies
+ qstend(i,k) = qstend(i,k)-faltnds/nstep
+ nstend(i,k) = nstend(i,k)-faltndns/nstep
+
+ ! sedimentation tendency for output
+ qssedten(i,k)=qssedten(i,k)-faltnds/nstep
+
+ dums(i,k) = dums(i,k)-faltnds*deltat/real(nstep)
+ dumns(i,k) = dumns(i,k)-faltndns*deltat/real(nstep)
+
+ end do !! k loop
+
+ ! Snow Flux
+ do k = 1,nlev
+ sflx(i,k+1) = sflx(i,k+1) + falouts(k) / g / real(nstep)
+ end do
+
+ prect(i) = prect(i)+falouts(nlev)/g/real(nstep)/1000._r8
+ preci(i) = preci(i)+falouts(nlev)/g/real(nstep)/1000._r8
+
+ end do !! nstep loop
+
+ enddo
+ ! end sedimentation
+
+ !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ ! get new update for variables that includes sedimentation tendency
+ ! note : here dum variables are grid-average, NOT in-cloud
+
+ do k=1,nlev
+ do i=1,mgncol
+ dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8)
+ dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8)
+ dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8)
+ dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8)
+
+ dumr(i,k) = max(qr(i,k)+qrtend(i,k)*deltat,0._r8)
+ dumnr(i,k) = max(nr(i,k)+nrtend(i,k)*deltat,0._r8)
+ dums(i,k) = max(qs(i,k)+qstend(i,k)*deltat,0._r8)
+ dumns(i,k) = max(ns(i,k)+nstend(i,k)*deltat,0._r8)
+
+ ! switch for specification of droplet and crystal number
+ if (nccons) then
+ dumnc(i,k)=ncnst/rho(i,k)*lcldm(i,k)
+ end if
+
+ ! switch for specification of cloud ice number
+ if (nicons) then
+ dumni(i,k)=ninst/rho(i,k)*icldm(i,k)
+ end if
+
+ if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8
+ if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8
+ if (dumr(i,k).lt.qsmall) dumnr(i,k)=0._r8
+ if (dums(i,k).lt.qsmall) dumns(i,k)=0._r8
+
+ enddo
+
+ enddo
+
+ ! calculate instantaneous processes (melting, homogeneous freezing)
+ !====================================================================
+
+ ! melting of snow at +2 C
+ do k=1,nlev
+
+ do i=1,mgncol
+
+ if (t(i,k)+tlat(i,k)/cpp*deltat > snowmelt) then
+ if (dums(i,k) > 0._r8) then
+
+ ! make sure melting snow doesn't reduce temperature below threshold
+ dum = -xlf/cpp*dums(i,k)
+ if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt. snowmelt) then
+ dum = (t(i,k)+tlat(i,k)/cpp*deltat-snowmelt)*cpp/xlf
+ dum = dum/dums(i,k)
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+
+ qstend(i,k)=qstend(i,k)-dum*dums(i,k)/deltat
+ nstend(i,k)=nstend(i,k)-dum*dumns(i,k)/deltat
+ qrtend(i,k)=qrtend(i,k)+dum*dums(i,k)/deltat
+ nrtend(i,k)=nrtend(i,k)+dum*dumns(i,k)/deltat
+
+ dum1=-xlf*dum*dums(i,k)/deltat
+ tlat(i,k)=tlat(i,k)+dum1
+ meltsdttot(i,k)=meltsdttot(i,k) + dum1
+ end if
+ end if
+ enddo
+ enddo
+ do k=1,nlev
+ do i=1,mgncol
+
+ ! freezing of rain at -5 C
+
+ if (t(i,k)+tlat(i,k)/cpp*deltat < rainfrze) then
+
+ if (dumr(i,k) > 0._r8) then
+
+ ! make sure freezing rain doesn't increase temperature above threshold
+ dum = xlf/cpp*dumr(i,k)
+ if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.rainfrze) then
+ dum = -(t(i,k)+tlat(i,k)/cpp*deltat-rainfrze)*cpp/xlf
+ dum = dum/dumr(i,k)
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+
+ qrtend(i,k)=qrtend(i,k)-dum*dumr(i,k)/deltat
+ nrtend(i,k)=nrtend(i,k)-dum*dumnr(i,k)/deltat
+
+ ! get mean size of rain = 1/lamr, add frozen rain to either snow or cloud ice
+ ! depending on mean rain size
+
+ call size_dist_param_basic(mg_rain_props, dumr(i,k), dumnr(i,k), &
+ lamr(i,k))
+
+ if (lamr(i,k) < 1._r8/Dcs) then
+ qstend(i,k)=qstend(i,k)+dum*dumr(i,k)/deltat
+ nstend(i,k)=nstend(i,k)+dum*dumnr(i,k)/deltat
+ else
+ qitend(i,k)=qitend(i,k)+dum*dumr(i,k)/deltat
+ nitend(i,k)=nitend(i,k)+dum*dumnr(i,k)/deltat
+!AL
+ frzr(i,k)=frzr(i,k)+dum*dumr(i,k)/deltat
+ nfrzr(i,k)=nfrzr(i,k)+dum*dumnr(i,k)/deltat
+!AL
+ end if
+
+ ! heating tendency
+ dum1 = xlf*dum*dumr(i,k)/deltat
+ frzrdttot(i,k)=frzrdttot(i,k) + dum1
+ tlat(i,k)=tlat(i,k)+dum1
+
+ end if
+ end if
+
+ enddo
+ enddo
+ if (do_cldice) then
+ do k=1,nlev
+ do i=1,mgncol
+ if (t(i,k)+tlat(i,k)/cpp*deltat > tmelt) then
+ if (dumi(i,k) > 0._r8) then
+
+ ! limit so that melting does not push temperature below freezing
+ !-----------------------------------------------------------------
+ dum = -dumi(i,k)*xlf/cpp
+ if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt.tmelt) then
+ dum = (t(i,k)+tlat(i,k)/cpp*deltat-tmelt)*cpp/xlf
+ dum = dum/dumi(i,k)
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+
+ qctend(i,k)=qctend(i,k)+dum*dumi(i,k)/deltat
+
+ ! for output
+ melttot(i,k)=dum*dumi(i,k)/deltat
+
+ ! assume melting ice produces droplet
+ ! mean volume radius of 8 micron
+
+ nctend(i,k)=nctend(i,k)+3._r8*dum*dumi(i,k)/deltat/ &
+ (4._r8*pi*5.12e-16_r8*rhow)
+
+!AL
+ ! for output
+ nmelttot(i,k)=3._r8*dum*dumi(i,k)/deltat/ &
+ (4._r8*pi*5.12e-16_r8*rhow)
+ nimelttot(i,k)=nitend(i,k)-((1._r8-dum)*dumni(i,k)-ni(i,k))/deltat
+!AL
+
+ qitend(i,k)=((1._r8-dum)*dumi(i,k)-qi(i,k))/deltat
+ nitend(i,k)=((1._r8-dum)*dumni(i,k)-ni(i,k))/deltat
+ tlat(i,k)=tlat(i,k)-xlf*dum*dumi(i,k)/deltat
+ end if
+ end if
+ enddo
+ enddo
+
+ ! homogeneously freeze droplets at -40 C
+ !-----------------------------------------------------------------
+
+ do k=1,nlev
+ do i=1,mgncol
+ if (t(i,k)+tlat(i,k)/cpp*deltat < 233.15_r8) then
+ if (dumc(i,k) > 0._r8) then
+
+ ! limit so that freezing does not push temperature above threshold
+ dum = dumc(i,k)*xlf/cpp
+ if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.233.15_r8) then
+ dum = -(t(i,k)+tlat(i,k)/cpp*deltat-233.15_r8)*cpp/xlf
+ dum = dum/dumc(i,k)
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+
+ qitend(i,k)=qitend(i,k)+dum*dumc(i,k)/deltat
+ ! for output
+ homotot(i,k)=dum*dumc(i,k)/deltat
+
+ ! assume 25 micron mean volume radius of homogeneously frozen droplets
+ ! consistent with size of detrained ice in stratiform.F90
+ nitend(i,k)=nitend(i,k)+dum*3._r8*dumc(i,k)/(4._r8*3.14_r8*1.563e-14_r8* &
+ 500._r8)/deltat
+ qctend(i,k)=((1._r8-dum)*dumc(i,k)-qc(i,k))/deltat
+
+!AL
+ nhomotot(i,k)=nctend(i,k)-((1._r8-dum)*dumnc(i,k)-nc(i,k))/deltat
+ nihomotot(i,k)=dum*3._r8*dumc(i,k)/(4._r8*3.14_r8*1.563e-14_r8* &
+ 500._r8)/deltat
+!AL
+ nctend(i,k)=((1._r8-dum)*dumnc(i,k)-nc(i,k))/deltat
+ tlat(i,k)=tlat(i,k)+xlf*dum*dumc(i,k)/deltat
+ end if
+ end if
+ enddo
+ enddo
+ ! remove any excess over-saturation, which is possible due to non-linearity when adding
+ ! together all microphysical processes
+ !-----------------------------------------------------------------
+ ! follow code similar to old CAM scheme
+ do k=1,nlev
+ do i=1,mgncol
+
+ qtmp=q(i,k)+qvlat(i,k)*deltat
+ ttmp=t(i,k)+tlat(i,k)/cpp*deltat
+
+ ! use rhw to allow ice supersaturation
+ call qsat_water(ttmp, p(i,k), esn, qvn)
+
+ if (qtmp > qvn .and. qvn > 0 .and. allow_sed_supersat) then
+ ! expression below is approximate since there may be ice deposition
+ dum = (qtmp-qvn)/(1._r8+xxlv_squared*qvn/(cpp*rv*ttmp**2))/deltat
+ ! add to output cme
+ cmeout(i,k) = cmeout(i,k)+dum
+ ! now add to tendencies, partition between liquid and ice based on temperature
+ if (ttmp > 268.15_r8) then
+ dum1=0.0_r8
+ ! now add to tendencies, partition between liquid and ice based on te
+ !-------------------------------------------------------
+ else if (ttmp < 238.15_r8) then
+ dum1=1.0_r8
+ else
+ dum1=(268.15_r8-ttmp)/30._r8
+ end if
+
+ dum = (qtmp-qvn)/(1._r8+(xxls*dum1+xxlv*(1._r8-dum1))**2 &
+ *qvn/(cpp*rv*ttmp**2))/deltat
+ qctend(i,k)=qctend(i,k)+dum*(1._r8-dum1)
+ ! for output
+ qcrestot(i,k)=dum*(1._r8-dum1)
+ qitend(i,k)=qitend(i,k)+dum*dum1
+ qirestot(i,k)=dum*dum1
+ qvlat(i,k)=qvlat(i,k)-dum
+ ! for output
+ qvres(i,k)=-dum
+ tlat(i,k)=tlat(i,k)+dum*(1._r8-dum1)*xxlv+dum*dum1*xxls
+ end if
+ enddo
+ enddo
+ end if
+
+ ! calculate effective radius for pass to radiation code
+ !=========================================================
+ ! if no cloud water, default value is 10 micron for droplets,
+ ! 25 micron for cloud ice
+
+ ! update cloud variables after instantaneous processes to get effective radius
+ ! variables are in-cloud to calculate size dist parameters
+ do k=1,nlev
+ do i=1,mgncol
+ dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8)/lcldm(i,k)
+ dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8)/icldm(i,k)
+ dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8)/lcldm(i,k)
+ dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8)/icldm(i,k)
+
+ dumr(i,k) = max(qr(i,k)+qrtend(i,k)*deltat,0._r8)/precip_frac(i,k)
+ dumnr(i,k) = max(nr(i,k)+nrtend(i,k)*deltat,0._r8)/precip_frac(i,k)
+ dums(i,k) = max(qs(i,k)+qstend(i,k)*deltat,0._r8)/precip_frac(i,k)
+ dumns(i,k) = max(ns(i,k)+nstend(i,k)*deltat,0._r8)/precip_frac(i,k)
+
+ ! switch for specification of droplet and crystal number
+ if (nccons) then
+ dumnc(i,k)=ncnst/rho(i,k)
+ end if
+
+ ! switch for specification of cloud ice number
+ if (nicons) then
+ dumni(i,k)=ninst/rho(i,k)
+ end if
+
+ ! limit in-cloud mixing ratio to reasonable value of 5 g kg-1
+ dumc(i,k)=min(dumc(i,k),5.e-3_r8)
+ dumi(i,k)=min(dumi(i,k),5.e-3_r8)
+ ! limit in-precip mixing ratios
+ dumr(i,k)=min(dumr(i,k),10.e-3_r8)
+ dums(i,k)=min(dums(i,k),10.e-3_r8)
+ enddo
+ enddo
+ ! cloud ice effective radius
+ !-----------------------------------------------------------------
+
+ if (do_cldice) then
+ do k=1,nlev
+ do i=1,mgncol
+ if (dumi(i,k).ge.qsmall) then
+
+ dum_2D(i,k) = dumni(i,k)
+ call size_dist_param_basic(mg_ice_props, dumi(i,k), dumni(i,k), &
+ lami(i,k), dumni0)
+
+ if (dumni(i,k) /=dum_2D(i,k)) then
+ ! adjust number conc if needed to keep mean size in reasonable range
+ if (dumni(i,k) cm2/cm3
+
+ else
+ effi(i,k) = 25._r8
+ sadice(i,k) = 0._r8
+ end if
+
+ ! ice effective diameter for david mitchell's optics
+ deffi(i,k)=effi(i,k)*rhoi/rhows*2._r8
+ enddo
+ enddo
+ else
+ do k=1,nlev
+ do i=1,mgncol
+ ! NOTE: If CARMA is doing the ice microphysics, then the ice effective
+ ! radius has already been determined from the size distribution.
+ effi(i,k) = re_ice(i,k) * 1.e6_r8 ! m -> um
+ deffi(i,k)=effi(i,k) * 2._r8
+ sadice(i,k) = 4._r8*pi*(effi(i,k)**2)*ni(i,k)*rho(i,k)*1e-2_r8
+ enddo
+ enddo
+ end if
+
+ ! cloud droplet effective radius
+ !-----------------------------------------------------------------
+ do k=1,nlev
+ do i=1,mgncol
+ if (dumc(i,k).ge.qsmall) then
+
+
+ ! switch for specification of droplet and crystal number
+ if (nccons) then
+ ! make sure nc is consistence with the constant N by adjusting tendency, need
+ ! to multiply by cloud fraction
+ ! note that nctend may be further adjusted below if mean droplet size is
+ ! out of bounds
+
+ nctend(i,k)=(ncnst/rho(i,k)*lcldm(i,k)-nc(i,k))/deltat
+
+ end if
+
+ dum = dumnc(i,k)
+
+ call size_dist_param_liq(mg_liq_props, dumc(i,k), dumnc(i,k), rho(i,k), &
+ pgam(i,k), lamc(i,k))
+
+ if (dum /= dumnc(i,k)) then
+ ! adjust number conc if needed to keep mean size in reasonable range
+ if (dumnc(i,k) cm2/cm3
+
+ end if
+
+
+ end do ! vertical k loop
+ enddo
+ do k=1,nlev
+ do i=1,mgncol
+ ! if updated q (after microphysics) is zero, then ensure updated n is also zero
+ !=================================================================================
+ if (qc(i,k)+qctend(i,k)*deltat.lt.qsmall) then !AL
+ nctnncld(i,k) = nctnncld(i,k) + nctend(i,k) +nc(i,k)/deltat !AL
+ nctend(i,k)=-nc(i,k)/deltat
+ endif
+ if (do_cldice .and. qi(i,k)+qitend(i,k)*deltat.lt.qsmall)then !AL
+ nitnncld(i,k) = nitnncld(i,k) + nitend(i,k) +ni(i,k)/deltat
+ nitend(i,k)=-ni(i,k)/deltat
+ endif
+ if (qr(i,k)+qrtend(i,k)*deltat.lt.qsmall) nrtend(i,k)=-nr(i,k)/deltat
+ if (qs(i,k)+qstend(i,k)*deltat.lt.qsmall) nstend(i,k)=-ns(i,k)/deltat
+
+ end do
+
+ end do
+
+ ! DO STUFF FOR OUTPUT:
+ !==================================================
+
+ ! qc and qi are only used for output calculations past here,
+ ! so add qctend and qitend back in one more time
+ qc = qc + qctend*deltat
+ qi = qi + qitend*deltat
+
+ ! averaging for snow and rain number and diameter
+ !--------------------------------------------------
+
+ ! drout2/dsout2:
+ ! diameter of rain and snow
+ ! dsout:
+ ! scaled diameter of snow (passed to radiation in CAM)
+ ! reff_rain/reff_snow:
+ ! calculate effective radius of rain and snow in microns for COSP using Eq. 9 of COSP v1.3 manual
+
+ where (qrout .gt. 1.e-7_r8 &
+ .and. nrout.gt.0._r8)
+ qrout2 = qrout * precip_frac
+ nrout2 = nrout * precip_frac
+ ! The avg_diameter call does the actual calculation; other diameter
+ ! outputs are just drout2 times constants.
+ drout2 = avg_diameter(qrout, nrout, rho, rhow)
+ freqr = precip_frac
+
+ reff_rain=1.5_r8*drout2*1.e6_r8
+ elsewhere
+ qrout2 = 0._r8
+ nrout2 = 0._r8
+ drout2 = 0._r8
+ freqr = 0._r8
+ reff_rain = 0._r8
+ end where
+
+ where (qsout .gt. 1.e-7_r8 &
+ .and. nsout.gt.0._r8)
+ qsout2 = qsout * precip_frac
+ nsout2 = nsout * precip_frac
+ ! The avg_diameter call does the actual calculation; other diameter
+ ! outputs are just dsout2 times constants.
+ dsout2 = avg_diameter(qsout, nsout, rho, rhosn)
+ freqs = precip_frac
+
+ dsout=3._r8*rhosn/rhows*dsout2
+
+ reff_snow=1.5_r8*dsout2*1.e6_r8
+ elsewhere
+ dsout = 0._r8
+ qsout2 = 0._r8
+ nsout2 = 0._r8
+ dsout2 = 0._r8
+ freqs = 0._r8
+ reff_snow=0._r8
+ end where
+
+ ! analytic radar reflectivity
+ !--------------------------------------------------
+ ! formulas from Matthew Shupe, NOAA/CERES
+ ! *****note: radar reflectivity is local (in-precip average)
+ ! units of mm^6/m^3
+
+ do i = 1,mgncol
+ do k=1,nlev
+ if (qc(i,k).ge.qsmall .and. (nc(i,k)+nctend(i,k)*deltat).gt.10._r8) then
+ dum=(qc(i,k)/lcldm(i,k)*rho(i,k)*1000._r8)**2 &
+ /(0.109_r8*(nc(i,k)+nctend(i,k)*deltat)/lcldm(i,k)*rho(i,k)/1.e6_r8)*lcldm(i,k)/precip_frac(i,k)
+ else
+ dum=0._r8
+ end if
+ if (qi(i,k).ge.qsmall) then
+ dum1=(qi(i,k)*rho(i,k)/icldm(i,k)*1000._r8/0.1_r8)**(1._r8/0.63_r8)*icldm(i,k)/precip_frac(i,k)
+ else
+ dum1=0._r8
+ end if
+
+ if (qsout(i,k).ge.qsmall) then
+ dum1=dum1+(qsout(i,k)*rho(i,k)*1000._r8/0.1_r8)**(1._r8/0.63_r8)
+ end if
+
+ refl(i,k)=dum+dum1
+
+ ! add rain rate, but for 37 GHz formulation instead of 94 GHz
+ ! formula approximated from data of Matrasov (2007)
+ ! rainrt is the rain rate in mm/hr
+ ! reflectivity (dum) is in DBz
+
+ if (rainrt(i,k).ge.0.001_r8) then
+ dum=log10(rainrt(i,k)**6._r8)+16._r8
+
+ ! convert from DBz to mm^6/m^3
+
+ dum = 10._r8**(dum/10._r8)
+ else
+ ! don't include rain rate in R calculation for values less than 0.001 mm/hr
+ dum=0._r8
+ end if
+
+ ! add to refl
+
+ refl(i,k)=refl(i,k)+dum
+
+ !output reflectivity in Z.
+ areflz(i,k)=refl(i,k) * precip_frac(i,k)
+
+ ! convert back to DBz
+
+ if (refl(i,k).gt.minrefl) then
+ refl(i,k)=10._r8*log10(refl(i,k))
+ else
+ refl(i,k)=-9999._r8
+ end if
+
+ !set averaging flag
+ if (refl(i,k).gt.mindbz) then
+ arefl(i,k)=refl(i,k) * precip_frac(i,k)
+ frefl(i,k)=precip_frac(i,k)
+ else
+ arefl(i,k)=0._r8
+ areflz(i,k)=0._r8
+ frefl(i,k)=0._r8
+ end if
+
+ ! bound cloudsat reflectivity
+
+ csrfl(i,k)=min(csmax,refl(i,k))
+
+ !set averaging flag
+ if (csrfl(i,k).gt.csmin) then
+ acsrfl(i,k)=refl(i,k) * precip_frac(i,k)
+ fcsrfl(i,k)=precip_frac(i,k)
+ else
+ acsrfl(i,k)=0._r8
+ fcsrfl(i,k)=0._r8
+ end if
+
+ end do
+ end do
+
+ !redefine fice here....
+ dum_2D = qsout + qrout + qc + qi
+ dumi = qsout + qi
+ where (dumi .gt. qsmall .and. dum_2D .gt. qsmall)
+ nfice=min(dumi/dum_2D,1._r8)
+ elsewhere
+ nfice=0._r8
+ end where
+
+end subroutine micro_mg_tend
+
+!========================================================================
+!OUTPUT CALCULATIONS
+!========================================================================
+
+subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol)
+ integer, intent(in) :: mgncol
+ real(r8), dimension(mgncol), intent(in) :: lamr ! rain size parameter (slope)
+ real(r8), dimension(mgncol), intent(in) :: n0r ! rain size parameter (intercept)
+ real(r8), dimension(mgncol), intent(in) :: lamc ! size distribution parameter (slope)
+ real(r8), dimension(mgncol), intent(in) :: pgam ! droplet size parameter
+ real(r8), dimension(mgncol), intent(in) :: qric ! in-cloud rain mass mixing ratio
+ real(r8), dimension(mgncol), intent(in) :: qcic ! in-cloud cloud liquid
+ real(r8), dimension(mgncol), intent(in) :: ncic ! in-cloud droplet number concentration
+
+ real(r8), dimension(mgncol), intent(inout) :: rercld ! effective radius calculation for rain + cloud
+
+ ! combined size of precip & cloud drops
+ real(r8) :: Atmp
+
+ integer :: i
+
+ do i=1,mgncol
+ ! Rain drops
+ if (lamr(i) > 0._r8) then
+ Atmp = n0r(i) * pi / (2._r8 * lamr(i)**3._r8)
+ else
+ Atmp = 0._r8
+ end if
+
+ ! Add cloud drops
+ if (lamc(i) > 0._r8) then
+ Atmp = Atmp + &
+ ncic(i) * pi * rising_factorial(pgam(i)+1._r8, 2)/(4._r8 * lamc(i)**2._r8)
+ end if
+
+ if (Atmp > 0._r8) then
+ rercld(i) = rercld(i) + 3._r8 *(qric(i) + qcic(i)) / (4._r8 * rhow * Atmp)
+ end if
+ enddo
+end subroutine calc_rercld
+
+!========================================================================
+!UTILITIES
+!========================================================================
+
+pure subroutine micro_mg_get_cols(ncol, nlev, top_lev, qcn, qin, &
+ qrn, qsn, mgncol, mgcols)
+
+ ! Determines which columns microphysics should operate over by
+ ! checking for non-zero cloud water/ice.
+
+ integer, intent(in) :: ncol ! Number of columns with meaningful data
+ integer, intent(in) :: nlev ! Number of levels to use
+ integer, intent(in) :: top_lev ! Top level for microphysics
+
+ real(r8), intent(in) :: qcn(:,:) ! cloud water mixing ratio (kg/kg)
+ real(r8), intent(in) :: qin(:,:) ! cloud ice mixing ratio (kg/kg)
+ real(r8), intent(in) :: qrn(:,:) ! rain mixing ratio (kg/kg)
+ real(r8), intent(in) :: qsn(:,:) ! snow mixing ratio (kg/kg)
+
+ integer, intent(out) :: mgncol ! Number of columns MG will use
+ integer, allocatable, intent(out) :: mgcols(:) ! column indices
+
+ integer :: lev_offset ! top_lev - 1 (defined here for consistency)
+ logical :: ltrue(ncol) ! store tests for each column
+
+ integer :: i, ii ! column indices
+
+ if (allocated(mgcols)) deallocate(mgcols)
+
+ lev_offset = top_lev - 1
+
+ ! Using "any" along dimension 2 collapses across levels, but
+ ! not columns, so we know if water is present at any level
+ ! in each column.
+
+ ltrue = any(qcn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2)
+ ltrue = ltrue .or. any(qin(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2)
+ ltrue = ltrue .or. any(qrn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2)
+ ltrue = ltrue .or. any(qsn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2)
+
+ ! Scan for true values to get a usable list of indices.
+
+ mgncol = count(ltrue)
+ allocate(mgcols(mgncol))
+ i = 0
+ do ii = 1,ncol
+ if (ltrue(ii)) then
+ i = i + 1
+ mgcols(i) = ii
+ end if
+ end do
+
+end subroutine micro_mg_get_cols
+
+end module micro_mg2_0
diff --git a/src/NorESM/micro_mg_cam.F90 b/src/NorESM/micro_mg_cam.F90
new file mode 100644
index 0000000000..bbae68e378
--- /dev/null
+++ b/src/NorESM/micro_mg_cam.F90
@@ -0,0 +1,3375 @@
+module micro_mg_cam
+
+!---------------------------------------------------------------------------------
+!
+! CAM Interfaces for MG microphysics
+!
+!---------------------------------------------------------------------------------
+!
+! How to add new packed MG inputs to micro_mg_cam_tend:
+!
+! If you have an input with first dimension [psetcols, pver], the procedure
+! for adding inputs is as follows:
+!
+! 1) In addition to any variables you need to declare for the "unpacked"
+! (CAM format) version, you must declare an array for the "packed"
+! (MG format) version.
+!
+! 2) Add a call similar to the following line (look before the
+! micro_mg_tend calls to see similar lines):
+!
+! packed_array = packer%pack(original_array)
+!
+! The packed array can then be passed into any of the MG schemes.
+!
+! This same procedure will also work for 1D arrays of size psetcols, 3-D
+! arrays with psetcols and pver as the first dimensions, and for arrays of
+! dimension [psetcols, pverp]. You only have to modify the allocation of
+! the packed array before the "pack" call.
+!
+!---------------------------------------------------------------------------------
+!
+! How to add new packed MG outputs to micro_mg_cam_tend:
+!
+! 1) As with inputs, in addition to the unpacked outputs you must declare
+! an array for packed data. The unpacked and packed arrays must *also*
+! be targets or pointers (but cannot be both).
+!
+! 2) Add the field to post-processing as in the following line (again,
+! there are many examples before the micro_mg_tend calls):
+!
+! call post_proc%add_field(p(final_array),p(packed_array))
+!
+! *** IMPORTANT ** If the fields are only being passed to a certain version of
+! MG, you must only add them if that version is being called (see
+! the "if (micro_mg_version >1)" sections below
+!
+! This registers the field for post-MG averaging, and to scatter to the
+! final, unpacked version of the array.
+!
+! By default, any columns/levels that are not operated on by MG will be
+! set to 0 on output; this value can be adjusted using the "fillvalue"
+! optional argument to post_proc%add_field.
+!
+! Also by default, outputs from multiple substeps will be averaged after
+! MG's substepping is complete. Passing the optional argument
+! "accum_method=accum_null" will change this behavior so that the last
+! substep is always output.
+!
+! This procedure works on 1-D and 2-D outputs. Note that the final,
+! unpacked arrays are not set until the call to
+! "post_proc%process_and_unpack", which sets every single field that was
+! added with post_proc%add_field.
+!
+!---------------------------------------------------------------------------------
+
+use shr_kind_mod, only: r8=>shr_kind_r8
+use spmd_utils, only: masterproc
+use ppgrid, only: pcols, pver, pverp, psubcols
+use physconst, only: gravit, rair, tmelt, cpair, rh2o, rhoh2o, &
+ latvap, latice, mwh2o
+use phys_control, only: phys_getopts, use_hetfrz_classnuc
+
+
+use physics_types, only: physics_state, physics_ptend, &
+ physics_ptend_init, physics_state_copy, &
+ physics_update, physics_state_dealloc, &
+ physics_ptend_sum, physics_ptend_scale
+
+use physics_buffer, only: physics_buffer_desc, pbuf_add_field, dyn_time_lvls, &
+ pbuf_old_tim_idx, pbuf_get_index, dtype_r8, dtype_i4, &
+ pbuf_get_field, pbuf_set_field, col_type_subcol, &
+ pbuf_register_subcol
+use constituents, only: cnst_add, cnst_get_ind, &
+ cnst_name, cnst_longname, sflxnam, apcnst, bpcnst, pcnst
+
+use cldfrc2m, only: rhmini=>rhmini_const
+
+use cam_history, only: addfld, add_default, outfld, horiz_only
+
+use cam_logfile, only: iulog
+use cam_abortutils, only: endrun
+use scamMod, only: single_column
+use error_messages, only: handle_errmsg
+use ref_pres, only: top_lev=>trop_cloud_top_lev
+
+use subcol_utils, only: subcol_get_scheme
+
+implicit none
+private
+save
+
+public :: &
+ micro_mg_cam_readnl, &
+ micro_mg_cam_register, &
+ micro_mg_cam_init_cnst, &
+ micro_mg_cam_implements_cnst, &
+ micro_mg_cam_init, &
+ micro_mg_cam_tend, &
+ micro_mg_version
+
+integer :: micro_mg_version = 1 ! Version number for MG.
+integer :: micro_mg_sub_version = 0 ! Second part of version number.
+
+real(r8) :: micro_mg_dcs = -1._r8
+
+logical :: microp_uniform = .false.
+logical :: micro_mg_adjust_cpt = .false.
+
+character(len=16) :: micro_mg_precip_frac_method = 'max_overlap' ! type of precipitation fraction method
+
+real(r8) :: micro_mg_berg_eff_factor = 1.0_r8 ! berg efficiency factor
+
+logical, public :: do_cldliq ! Prognose cldliq flag
+logical, public :: do_cldice ! Prognose cldice flag
+
+integer :: num_steps ! Number of MG substeps
+
+integer :: ncnst = 4 ! Number of constituents
+
+! Namelist variables for option to specify constant cloud droplet/ice number
+logical :: micro_mg_nccons = .false. ! set .true. to specify constant cloud droplet number
+logical :: micro_mg_nicons = .false. ! set .true. to specify constant cloud ice number
+! parameters for specified ice and droplet number concentration
+! note: these are local in-cloud values, not grid-mean
+real(r8) :: micro_mg_ncnst = 100.e6_r8 ! constant droplet num concentration (m-3)
+real(r8) :: micro_mg_ninst = 0.1e6_r8 ! constant ice num concentration (m-3)
+
+character(len=8), parameter :: & ! Constituent names
+ cnst_names(8) = (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE', &
+ 'RAINQM', 'SNOWQM','NUMRAI','NUMSNO'/)
+
+integer :: &
+ ixcldliq = -1, &! cloud liquid amount index
+ ixcldice = -1, &! cloud ice amount index
+ ixnumliq = -1, &! cloud liquid number index
+ ixnumice = -1, &! cloud ice water index
+ ixrain = -1, &! rain index
+ ixsnow = -1, &! snow index
+ ixnumrain = -1, &! rain number index
+ ixnumsnow = -1 ! snow number index
+
+! Physics buffer indices for fields registered by this module
+integer :: &
+ cldo_idx, &
+ qme_idx, &
+ prain_idx, &
+ nevapr_idx, &
+ wsedl_idx, &
+ rei_idx, &
+ sadice_idx, &
+ sadsnow_idx, &
+ rel_idx, &
+ dei_idx, &
+ mu_idx, &
+ prer_evap_idx, &
+ lambdac_idx, &
+ iciwpst_idx, &
+ iclwpst_idx, &
+ des_idx, &
+ icswp_idx, &
+ cldfsnow_idx, &
+ rate1_cw2pr_st_idx = -1, &
+ ls_flxprc_idx, &
+ ls_flxsnw_idx, &
+ relvar_idx, &
+ cmeliq_idx, &
+ accre_enhan_idx
+
+! Fields for UNICON
+integer :: &
+ am_evp_st_idx, &! Evaporation area of stratiform precipitation
+ evprain_st_idx, &! Evaporation rate of stratiform rain [kg/kg/s]. >= 0.
+ evpsnow_st_idx ! Evaporation rate of stratiform snow [kg/kg/s]. >= 0.
+
+! Fields needed as inputs to COSP
+integer :: &
+ ls_mrprc_idx, ls_mrsnw_idx, &
+ ls_reffrain_idx, ls_reffsnow_idx, &
+ cv_reffliq_idx, cv_reffice_idx
+
+! Fields needed by Park macrophysics
+integer :: &
+ cc_t_idx, cc_qv_idx, &
+ cc_ql_idx, cc_qi_idx, &
+ cc_nl_idx, cc_ni_idx, &
+ cc_qlst_idx
+
+! Used to replace aspects of MG microphysics
+! (e.g. by CARMA)
+integer :: &
+ tnd_qsnow_idx = -1, &
+ tnd_nsnow_idx = -1, &
+ re_ice_idx = -1
+
+! Index fields for precipitation efficiency.
+integer :: &
+ acpr_idx = -1, &
+ acgcme_idx = -1, &
+ acnum_idx = -1
+
+! Physics buffer indices for fields registered by other modules
+integer :: &
+ ast_idx = -1, &
+ cld_idx = -1, &
+ concld_idx = -1, &
+ qsatfac_idx = -1
+
+! Pbuf fields needed for subcol_SILHS
+integer :: &
+ qrain_idx=-1, qsnow_idx=-1, &
+ nrain_idx=-1, nsnow_idx=-1
+
+integer :: &
+ naai_idx = -1, &
+ naai_hom_idx = -1, &
+ npccn_idx = -1, &
+ rndst_idx = -1, &
+ nacon_idx = -1, &
+ prec_str_idx = -1, &
+ snow_str_idx = -1, &
+ prec_pcw_idx = -1, &
+ snow_pcw_idx = -1, &
+ prec_sed_idx = -1, &
+ snow_sed_idx = -1
+
+! pbuf fields for heterogeneous freezing
+integer :: &
+ frzimm_idx = -1, &
+ frzcnt_idx = -1, &
+ frzdep_idx = -1
+
+ logical :: allow_sed_supersat ! allow supersaturated conditions after sedimentation loop
+ logical :: micro_do_sb_physics = .false. ! do SB 2001 autoconversion and accretion
+
+interface p
+ module procedure p1
+ module procedure p2
+end interface p
+
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine micro_mg_cam_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_real8, &
+ mpi_logical, mpi_character
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Namelist variables
+ logical :: micro_mg_do_cldice = .true. ! do_cldice = .true., MG microphysics is prognosing cldice
+ logical :: micro_mg_do_cldliq = .true. ! do_cldliq = .true., MG microphysics is prognosing cldliq
+ integer :: micro_mg_num_steps = 1 ! Number of substepping iterations done by MG (1.5 only for now).
+
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: sub = 'micro_mg_cam_readnl'
+
+ namelist /micro_mg_nl/ micro_mg_version, micro_mg_sub_version, &
+ micro_mg_do_cldice, micro_mg_do_cldliq, micro_mg_num_steps, &
+ microp_uniform, micro_mg_dcs, micro_mg_precip_frac_method, &
+ micro_mg_berg_eff_factor, micro_do_sb_physics, micro_mg_adjust_cpt, &
+ micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, micro_mg_ninst
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'micro_mg_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, micro_mg_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(sub // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+
+ ! set local variables
+ do_cldice = micro_mg_do_cldice
+ do_cldliq = micro_mg_do_cldliq
+ num_steps = micro_mg_num_steps
+
+ ! Verify that version numbers are valid.
+ select case (micro_mg_version)
+ case (1)
+ select case (micro_mg_sub_version)
+ case(0)
+ ! MG version 1.0
+ case default
+ call bad_version_endrun()
+ end select
+ case (2)
+ select case (micro_mg_sub_version)
+ case(0)
+ ! MG version 2.0
+ case default
+ call bad_version_endrun()
+ end select
+ case default
+ call bad_version_endrun()
+ end select
+
+ if (micro_mg_dcs < 0._r8) call endrun( "micro_mg_cam_readnl: &
+ µ_mg_dcs has not been set to a valid value.")
+ end if
+
+ ! Broadcast namelist variables
+ call mpi_bcast(micro_mg_version, 1, mpi_integer, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_version")
+
+ call mpi_bcast(micro_mg_sub_version, 1, mpi_integer, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_sub_version")
+
+ call mpi_bcast(do_cldice, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldice")
+
+ call mpi_bcast(do_cldliq, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: do_cldliq")
+
+ call mpi_bcast(num_steps, 1, mpi_integer, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: num_steps")
+
+ call mpi_bcast(microp_uniform, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: microp_uniform")
+
+ call mpi_bcast(micro_mg_dcs, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_dcs")
+
+ call mpi_bcast(micro_mg_berg_eff_factor, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_berg_eff_factor")
+
+ call mpi_bcast(micro_mg_precip_frac_method, 16, mpi_character, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_precip_frac_method")
+
+ call mpi_bcast(micro_do_sb_physics, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_do_sb_physics")
+
+ call mpi_bcast(micro_mg_adjust_cpt, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_adjust_cpt")
+
+ call mpi_bcast(micro_mg_nccons, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nccons")
+
+ call mpi_bcast(micro_mg_nicons, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_nicons")
+
+ call mpi_bcast(micro_mg_ncnst, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ncnst")
+
+ call mpi_bcast(micro_mg_ninst, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: micro_mg_ninst")
+
+ if (masterproc) then
+
+ write(iulog,*) 'MG microphysics namelist:'
+ write(iulog,*) ' micro_mg_version = ', micro_mg_version
+ write(iulog,*) ' micro_mg_sub_version = ', micro_mg_sub_version
+ write(iulog,*) ' micro_mg_do_cldice = ', do_cldice
+ write(iulog,*) ' micro_mg_do_cldliq = ', do_cldliq
+ write(iulog,*) ' micro_mg_num_steps = ', num_steps
+ write(iulog,*) ' microp_uniform = ', microp_uniform
+ write(iulog,*) ' micro_mg_dcs = ', micro_mg_dcs
+ write(iulog,*) ' micro_mg_berg_eff_factor = ', micro_mg_berg_eff_factor
+ write(iulog,*) ' micro_mg_precip_frac_method = ', micro_mg_precip_frac_method
+ write(iulog,*) ' micro_do_sb_physics = ', micro_do_sb_physics
+ write(iulog,*) ' micro_mg_adjust_cpt = ', micro_mg_adjust_cpt
+ write(iulog,*) ' micro_mg_nccons = ', micro_mg_nccons
+ write(iulog,*) ' micro_mg_nicons = ', micro_mg_nicons
+ write(iulog,*) ' micro_mg_ncnst = ', micro_mg_ncnst
+ write(iulog,*) ' micro_mg_ninst = ', micro_mg_ninst
+ end if
+
+contains
+
+ subroutine bad_version_endrun
+ ! Endrun wrapper with a more useful error message.
+ character(len=128) :: errstring
+ write(errstring,*) "Invalid version number specified for MG microphysics: ", &
+ micro_mg_version,".",micro_mg_sub_version
+ call endrun(errstring)
+ end subroutine bad_version_endrun
+
+end subroutine micro_mg_cam_readnl
+
+!================================================================================================
+
+subroutine micro_mg_cam_register
+
+ ! Register microphysics constituents and fields in the physics buffer.
+ !-----------------------------------------------------------------------
+
+ logical :: prog_modal_aero
+ logical :: use_subcol_microp ! If true, then are using subcolumns in microphysics
+
+ call phys_getopts(use_subcol_microp_out = use_subcol_microp, &
+ prog_modal_aero_out = prog_modal_aero)
+
+ ! Register microphysics constituents and save indices.
+
+ call cnst_add(cnst_names(1), mwh2o, cpair, 0._r8, ixcldliq, &
+ longname='Grid box averaged cloud liquid amount', is_convtran1=.true.)
+ call cnst_add(cnst_names(2), mwh2o, cpair, 0._r8, ixcldice, &
+ longname='Grid box averaged cloud ice amount', is_convtran1=.true.)
+
+ call cnst_add(cnst_names(3), mwh2o, cpair, 0._r8, ixnumliq, &
+ longname='Grid box averaged cloud liquid number', is_convtran1=.true.)
+ call cnst_add(cnst_names(4), mwh2o, cpair, 0._r8, ixnumice, &
+ longname='Grid box averaged cloud ice number', is_convtran1=.true.)
+
+ ! Note is_convtran1 is set to .true.
+ if (micro_mg_version > 1) then
+ call cnst_add(cnst_names(5), mwh2o, cpair, 0._r8, ixrain, &
+ longname='Grid box averaged rain amount', is_convtran1=.true.)
+ call cnst_add(cnst_names(6), mwh2o, cpair, 0._r8, ixsnow, &
+ longname='Grid box averaged snow amount', is_convtran1=.true.)
+ call cnst_add(cnst_names(7), mwh2o, cpair, 0._r8, ixnumrain, &
+ longname='Grid box averaged rain number', is_convtran1=.true.)
+ call cnst_add(cnst_names(8), mwh2o, cpair, 0._r8, ixnumsnow, &
+ longname='Grid box averaged snow number', is_convtran1=.true.)
+ end if
+
+ ! Request physics buffer space for fields that persist across timesteps.
+
+ call pbuf_add_field('CLDO','global',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldo_idx)
+
+ ! Physics buffer variables for convective cloud properties.
+
+ call pbuf_add_field('QME', 'physpkg',dtype_r8,(/pcols,pver/), qme_idx)
+ call pbuf_add_field('PRAIN', 'physpkg',dtype_r8,(/pcols,pver/), prain_idx)
+ call pbuf_add_field('NEVAPR', 'physpkg',dtype_r8,(/pcols,pver/), nevapr_idx)
+ call pbuf_add_field('PRER_EVAP', 'global', dtype_r8,(/pcols,pver/), prer_evap_idx)
+
+ call pbuf_add_field('WSEDL', 'physpkg',dtype_r8,(/pcols,pver/), wsedl_idx)
+
+ call pbuf_add_field('REI', 'physpkg',dtype_r8,(/pcols,pver/), rei_idx)
+ call pbuf_add_field('SADICE', 'physpkg',dtype_r8,(/pcols,pver/), sadice_idx)
+ call pbuf_add_field('SADSNOW', 'physpkg',dtype_r8,(/pcols,pver/), sadsnow_idx)
+ call pbuf_add_field('REL', 'physpkg',dtype_r8,(/pcols,pver/), rel_idx)
+
+ ! Mitchell ice effective diameter for radiation
+ call pbuf_add_field('DEI', 'physpkg',dtype_r8,(/pcols,pver/), dei_idx)
+ ! Size distribution shape parameter for radiation
+ call pbuf_add_field('MU', 'physpkg',dtype_r8,(/pcols,pver/), mu_idx)
+ ! Size distribution shape parameter for radiation
+ call pbuf_add_field('LAMBDAC', 'physpkg',dtype_r8,(/pcols,pver/), lambdac_idx)
+
+ ! Stratiform only in cloud ice water path for radiation
+ call pbuf_add_field('ICIWPST', 'physpkg',dtype_r8,(/pcols,pver/), iciwpst_idx)
+ ! Stratiform in cloud liquid water path for radiation
+ call pbuf_add_field('ICLWPST', 'physpkg',dtype_r8,(/pcols,pver/), iclwpst_idx)
+
+ ! Snow effective diameter for radiation
+ call pbuf_add_field('DES', 'physpkg',dtype_r8,(/pcols,pver/), des_idx)
+ ! In cloud snow water path for radiation
+ call pbuf_add_field('ICSWP', 'physpkg',dtype_r8,(/pcols,pver/), icswp_idx)
+ ! Cloud fraction for liquid drops + snow
+ call pbuf_add_field('CLDFSNOW ', 'physpkg',dtype_r8,(/pcols,pver,dyn_time_lvls/), cldfsnow_idx)
+
+ if (prog_modal_aero) then
+ call pbuf_add_field('RATE1_CW2PR_ST','physpkg',dtype_r8,(/pcols,pver/), rate1_cw2pr_st_idx)
+ endif
+
+ call pbuf_add_field('LS_FLXPRC', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxprc_idx)
+ call pbuf_add_field('LS_FLXSNW', 'physpkg',dtype_r8,(/pcols,pverp/), ls_flxsnw_idx)
+
+
+ ! Fields needed as inputs to COSP
+ call pbuf_add_field('LS_MRPRC', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrprc_idx)
+ call pbuf_add_field('LS_MRSNW', 'physpkg',dtype_r8,(/pcols,pver/), ls_mrsnw_idx)
+ call pbuf_add_field('LS_REFFRAIN','physpkg',dtype_r8,(/pcols,pver/), ls_reffrain_idx)
+ call pbuf_add_field('LS_REFFSNOW','physpkg',dtype_r8,(/pcols,pver/), ls_reffsnow_idx)
+ call pbuf_add_field('CV_REFFLIQ', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffliq_idx)
+ call pbuf_add_field('CV_REFFICE', 'physpkg',dtype_r8,(/pcols,pver/), cv_reffice_idx)
+
+ ! CC_* Fields needed by Park macrophysics
+ call pbuf_add_field('CC_T', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_t_idx)
+ call pbuf_add_field('CC_qv', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qv_idx)
+ call pbuf_add_field('CC_ql', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ql_idx)
+ call pbuf_add_field('CC_qi', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qi_idx)
+ call pbuf_add_field('CC_nl', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_nl_idx)
+ call pbuf_add_field('CC_ni', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_ni_idx)
+ call pbuf_add_field('CC_qlst', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cc_qlst_idx)
+
+ ! Fields for UNICON
+ call pbuf_add_field('am_evp_st', 'global', dtype_r8, (/pcols,pver/), am_evp_st_idx)
+ call pbuf_add_field('evprain_st', 'global', dtype_r8, (/pcols,pver/), evprain_st_idx)
+ call pbuf_add_field('evpsnow_st', 'global', dtype_r8, (/pcols,pver/), evpsnow_st_idx)
+
+ ! Register subcolumn pbuf fields
+ if (use_subcol_microp) then
+ ! Global pbuf fields
+ call pbuf_register_subcol('CLDO', 'micro_mg_cam_register', cldo_idx)
+
+ ! CC_* Fields needed by Park macrophysics
+ call pbuf_register_subcol('CC_T', 'micro_mg_cam_register', cc_t_idx)
+ call pbuf_register_subcol('CC_qv', 'micro_mg_cam_register', cc_qv_idx)
+ call pbuf_register_subcol('CC_ql', 'micro_mg_cam_register', cc_ql_idx)
+ call pbuf_register_subcol('CC_qi', 'micro_mg_cam_register', cc_qi_idx)
+ call pbuf_register_subcol('CC_nl', 'micro_mg_cam_register', cc_nl_idx)
+ call pbuf_register_subcol('CC_ni', 'micro_mg_cam_register', cc_ni_idx)
+ call pbuf_register_subcol('CC_qlst', 'micro_mg_cam_register', cc_qlst_idx)
+
+ ! Physpkg pbuf fields
+ ! Physics buffer variables for convective cloud properties.
+
+ call pbuf_register_subcol('QME', 'micro_mg_cam_register', qme_idx)
+ call pbuf_register_subcol('PRAIN', 'micro_mg_cam_register', prain_idx)
+ call pbuf_register_subcol('NEVAPR', 'micro_mg_cam_register', nevapr_idx)
+ call pbuf_register_subcol('PRER_EVAP', 'micro_mg_cam_register', prer_evap_idx)
+
+ call pbuf_register_subcol('WSEDL', 'micro_mg_cam_register', wsedl_idx)
+
+ call pbuf_register_subcol('REI', 'micro_mg_cam_register', rei_idx)
+ call pbuf_register_subcol('SADICE', 'micro_mg_cam_register', sadice_idx)
+ call pbuf_register_subcol('SADSNOW', 'micro_mg_cam_register', sadsnow_idx)
+ call pbuf_register_subcol('REL', 'micro_mg_cam_register', rel_idx)
+
+ ! Mitchell ice effective diameter for radiation
+ call pbuf_register_subcol('DEI', 'micro_mg_cam_register', dei_idx)
+ ! Size distribution shape parameter for radiation
+ call pbuf_register_subcol('MU', 'micro_mg_cam_register', mu_idx)
+ ! Size distribution shape parameter for radiation
+ call pbuf_register_subcol('LAMBDAC', 'micro_mg_cam_register', lambdac_idx)
+
+ ! Stratiform only in cloud ice water path for radiation
+ call pbuf_register_subcol('ICIWPST', 'micro_mg_cam_register', iciwpst_idx)
+ ! Stratiform in cloud liquid water path for radiation
+ call pbuf_register_subcol('ICLWPST', 'micro_mg_cam_register', iclwpst_idx)
+
+ ! Snow effective diameter for radiation
+ call pbuf_register_subcol('DES', 'micro_mg_cam_register', des_idx)
+ ! In cloud snow water path for radiation
+ call pbuf_register_subcol('ICSWP', 'micro_mg_cam_register', icswp_idx)
+ ! Cloud fraction for liquid drops + snow
+ call pbuf_register_subcol('CLDFSNOW ', 'micro_mg_cam_register', cldfsnow_idx)
+
+ if (prog_modal_aero) then
+ call pbuf_register_subcol('RATE1_CW2PR_ST', 'micro_mg_cam_register', rate1_cw2pr_st_idx)
+ end if
+
+ call pbuf_register_subcol('LS_FLXPRC', 'micro_mg_cam_register', ls_flxprc_idx)
+ call pbuf_register_subcol('LS_FLXSNW', 'micro_mg_cam_register', ls_flxsnw_idx)
+
+ ! Fields needed as inputs to COSP
+ call pbuf_register_subcol('LS_MRPRC', 'micro_mg_cam_register', ls_mrprc_idx)
+ call pbuf_register_subcol('LS_MRSNW', 'micro_mg_cam_register', ls_mrsnw_idx)
+ call pbuf_register_subcol('LS_REFFRAIN', 'micro_mg_cam_register', ls_reffrain_idx)
+ call pbuf_register_subcol('LS_REFFSNOW', 'micro_mg_cam_register', ls_reffsnow_idx)
+ call pbuf_register_subcol('CV_REFFLIQ', 'micro_mg_cam_register', cv_reffliq_idx)
+ call pbuf_register_subcol('CV_REFFICE', 'micro_mg_cam_register', cv_reffice_idx)
+ end if
+
+ ! Additional pbuf for CARMA interface
+ if (.not. do_cldice) then
+ call pbuf_add_field('TND_QSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_qsnow_idx)
+ call pbuf_add_field('TND_NSNOW', 'physpkg',dtype_r8,(/pcols,pver/), tnd_nsnow_idx)
+ call pbuf_add_field('RE_ICE', 'physpkg',dtype_r8,(/pcols,pver/), re_ice_idx)
+ end if
+
+ ! Precipitation efficiency fields across timesteps.
+ call pbuf_add_field('ACPRECL', 'global',dtype_r8,(/pcols/), acpr_idx) ! accumulated precip
+ call pbuf_add_field('ACGCME', 'global',dtype_r8,(/pcols/), acgcme_idx) ! accumulated condensation
+ call pbuf_add_field('ACNUM', 'global',dtype_i4,(/pcols/), acnum_idx) ! counter for accumulated # timesteps
+
+ ! SGS variability -- These could be reset by CLUBB so they need to be grid only
+ call pbuf_add_field('RELVAR', 'global',dtype_r8,(/pcols,pver/), relvar_idx)
+ call pbuf_add_field('ACCRE_ENHAN','global',dtype_r8,(/pcols,pver/), accre_enhan_idx)
+
+ ! Diagnostic fields needed for subcol_SILHS, need to be grid-only
+ if (subcol_get_scheme() == 'SILHS') then
+ call pbuf_add_field('QRAIN', 'global',dtype_r8,(/pcols,pver/), qrain_idx)
+ call pbuf_add_field('QSNOW', 'global',dtype_r8,(/pcols,pver/), qsnow_idx)
+ call pbuf_add_field('NRAIN', 'global',dtype_r8,(/pcols,pver/), nrain_idx)
+ call pbuf_add_field('NSNOW', 'global',dtype_r8,(/pcols,pver/), nsnow_idx)
+ end if
+
+end subroutine micro_mg_cam_register
+
+!===============================================================================
+
+function micro_mg_cam_implements_cnst(name)
+
+ ! Return true if specified constituent is implemented by the
+ ! microphysics package
+
+ character(len=*), intent(in) :: name ! constituent name
+ logical :: micro_mg_cam_implements_cnst ! return value
+
+ !-----------------------------------------------------------------------
+
+ micro_mg_cam_implements_cnst = any(name == cnst_names)
+
+end function micro_mg_cam_implements_cnst
+
+!===============================================================================
+
+subroutine micro_mg_cam_init_cnst(name, latvals, lonvals, mask, q)
+
+ ! Initialize the microphysics constituents, if they are
+ ! not read from the initial file.
+
+ character(len=*), intent(in) :: name ! constituent name
+ real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol)
+ real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol)
+ logical, intent(in) :: mask(:) ! Only initialize where .true.
+ real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev
+ !-----------------------------------------------------------------------
+ integer :: k
+
+ if (micro_mg_cam_implements_cnst(name)) then
+ do k = 1, size(q, 2)
+ where(mask)
+ q(:, k) = 0.0_r8
+ end where
+ end do
+ end if
+
+end subroutine micro_mg_cam_init_cnst
+
+!===============================================================================
+
+subroutine micro_mg_cam_init(pbuf2d)
+ use time_manager, only: is_first_step
+ use micro_mg_utils, only: micro_mg_utils_init
+ use micro_mg1_0, only: micro_mg_init1_0 => micro_mg_init
+ use micro_mg2_0, only: micro_mg_init2_0 => micro_mg_init
+
+ !-----------------------------------------------------------------------
+ !
+ ! Initialization for MG microphysics
+ !
+ !-----------------------------------------------------------------------
+
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ integer :: m, mm
+ logical :: history_amwg ! output the variables used by the AMWG diag package
+ logical :: history_budget ! Output tendencies and state variables for CAM4
+ ! temperature, water vapor, cloud ice and cloud
+ ! liquid budgets.
+ logical :: use_subcol_microp
+ logical :: do_clubb_sgs
+ integer :: budget_histfile ! output history file number for budget fields
+ integer :: ierr
+ character(128) :: errstring ! return status (non-blank for error return)
+
+ !-----------------------------------------------------------------------
+
+ call phys_getopts(use_subcol_microp_out=use_subcol_microp, &
+ do_clubb_sgs_out =do_clubb_sgs)
+
+ if (do_clubb_sgs) then
+ allow_sed_supersat = .false.
+ else
+ allow_sed_supersat = .true.
+ endif
+
+ if (masterproc) then
+ write(iulog,"(A,I2,A,I2)") "Initializing MG version ",micro_mg_version,".",micro_mg_sub_version
+ if (.not. do_cldliq) &
+ write(iulog,*) "MG prognostic cloud liquid has been turned off via namelist."
+ if (.not. do_cldice) &
+ write(iulog,*) "MG prognostic cloud ice has been turned off via namelist."
+ write(iulog,*) "Number of microphysics substeps is: ",num_steps
+ end if
+
+ select case (micro_mg_version)
+ case (1)
+ ! Set constituent number for later loops.
+ ncnst = 4
+
+ select case (micro_mg_sub_version)
+ case (0)
+ ! MG 1 does not initialize micro_mg_utils, so have to do it here.
+ call micro_mg_utils_init(r8, rh2o, cpair, tmelt, latvap, latice, &
+ micro_mg_dcs, errstring)
+ call handle_errmsg(errstring, subname="micro_mg_utils_init")
+
+ call micro_mg_init1_0( &
+ r8, gravit, rair, rh2o, cpair, &
+ rhoh2o, tmelt, latvap, latice, &
+ rhmini, micro_mg_dcs, use_hetfrz_classnuc, &
+ micro_mg_precip_frac_method, micro_mg_berg_eff_factor, &
+ micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, &
+ micro_mg_ninst, errstring)
+ end select
+ case (2)
+ ! Set constituent number for later loops.
+ ncnst = 8
+
+ select case (micro_mg_sub_version)
+ case (0)
+ call micro_mg_init2_0( &
+ r8, gravit, rair, rh2o, cpair, &
+ tmelt, latvap, latice, rhmini, &
+ micro_mg_dcs, &
+ microp_uniform, do_cldice, use_hetfrz_classnuc, &
+ micro_mg_precip_frac_method, micro_mg_berg_eff_factor, &
+ allow_sed_supersat, micro_do_sb_physics, &
+ micro_mg_nccons, micro_mg_nicons, micro_mg_ncnst, &
+ micro_mg_ninst, errstring)
+ end select
+ end select
+
+ call handle_errmsg(errstring, subname="micro_mg_init")
+
+ ! Register history variables
+ do m = 1, ncnst
+ call cnst_get_ind(cnst_names(m), mm)
+ if ( any(mm == (/ ixcldliq, ixcldice, ixrain, ixsnow /)) ) then
+ ! mass mixing ratios
+ call addfld(cnst_name(mm), (/ 'lev' /), 'A', 'kg/kg', cnst_longname(mm) )
+ call addfld(sflxnam(mm), horiz_only, 'A', 'kg/m2/s', trim(cnst_name(mm))//' surface flux')
+ else if ( any(mm == (/ ixnumliq, ixnumice, ixnumrain, ixnumsnow /)) ) then
+ ! number concentrations
+ call addfld(cnst_name(mm), (/ 'lev' /), 'A', '1/kg', cnst_longname(mm) )
+ call addfld(sflxnam(mm), horiz_only, 'A', '1/m2/s', trim(cnst_name(mm))//' surface flux')
+ else
+ call endrun( "micro_mg_cam_init: &
+ &Could not call addfld for constituent with unknown units.")
+ endif
+ end do
+
+ call addfld(apcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' after physics' )
+ call addfld(apcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' after physics' )
+ call addfld(bpcnst(ixcldliq), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldliq))//' before physics' )
+ call addfld(bpcnst(ixcldice), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixcldice))//' before physics' )
+
+ if (micro_mg_version > 1) then
+ call addfld(apcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' after physics' )
+ call addfld(apcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' after physics' )
+ call addfld(bpcnst(ixrain), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixrain))//' before physics' )
+ call addfld(bpcnst(ixsnow), (/ 'lev' /), 'A', 'kg/kg', trim(cnst_name(ixsnow))//' before physics' )
+ end if
+
+ call addfld ('CME', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap within the cloud' )
+ call addfld ('PRODPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of conversion of condensate to precip' )
+ call addfld ('EVAPPREC', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling precip' )
+ call addfld ('EVAPSNOW', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling snow' )
+ call addfld ('HPROGCLD', (/ 'lev' /), 'A', 'W/kg' , 'Heating from prognostic clouds' )
+ call addfld ('FICE', (/ 'lev' /), 'A', 'fraction', 'Fractional ice content within cloud' )
+ call addfld ('CLDFSNOW', (/ 'lev' /), 'A', '1', 'Cloud fraction adjusted for snow' )
+ call addfld ('ICWMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus water mixing ratio' )
+ call addfld ('ICIMRST', (/ 'lev' /), 'A', 'kg/kg', 'Prognostic in-stratus ice mixing ratio' )
+
+ ! MG microphysics diagnostics
+ call addfld ('QCSEVAP', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of evaporation of falling cloud water' )
+ call addfld ('QISEVAP', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of sublimation of falling cloud ice' )
+ call addfld ('QVRES', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of residual condensation term' )
+ call addfld ('CMEIOUT', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of deposition/sublimation of cloud ice' )
+ call addfld ('VTRMC', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted cloud water fallspeed' )
+ call addfld ('VTRMI', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted cloud ice fallspeed' )
+ call addfld ('QCSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud water mixing ratio tendency from sedimentation' )
+ call addfld ('QISEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Cloud ice mixing ratio tendency from sedimentation' )
+ call addfld ('PRAO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by rain' )
+ call addfld ('PRCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud water' )
+ call addfld ('MNUCCCO', (/ 'lev' /), 'A', 'kg/kg/s', 'Immersion freezing of cloud water' )
+ call addfld ('MNUCCTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Contact freezing of cloud water' )
+ call addfld ('MNUCCDO', (/ 'lev' /), 'A', 'kg/kg/s', 'Homogeneous and heterogeneous nucleation from vapor' )
+ call addfld ('MNUCCDOhet', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous nucleation from vapor' )
+ call addfld ('MSACWIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water from rime-splintering' )
+ call addfld ('PSACWSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud water by snow' )
+ call addfld ('BERGSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to snow from bergeron' )
+ call addfld ('BERGO', (/ 'lev' /), 'A', 'kg/kg/s', 'Conversion of cloud water to cloud ice from bergeron' )
+ call addfld ('MELTO', (/ 'lev' /), 'A', 'kg/kg/s', 'Melting of cloud ice' )
+ call addfld ('HOMOO', (/ 'lev' /), 'A', 'kg/kg/s', 'Homogeneous freezing of cloud water' )
+ call addfld ('QCRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual condensation term for cloud water' )
+ call addfld ('PRCIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Autoconversion of cloud ice' )
+ call addfld ('PRAIO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of cloud ice by rain' )
+ call addfld ('QIRESO', (/ 'lev' /), 'A', 'kg/kg/s', 'Residual deposition term for cloud ice' )
+ call addfld ('MNUCCRO', (/ 'lev' /), 'A', 'kg/kg/s', 'Heterogeneous freezing of rain to snow' )
+ call addfld ('PRACSO', (/ 'lev' /), 'A', 'kg/kg/s', 'Accretion of rain by snow' )
+ call addfld ('MELTSDT', (/ 'lev' /), 'A', 'W/kg', 'Latent heating rate due to melting of snow' )
+ call addfld ('FRZRDT', (/ 'lev' /), 'A', 'W/kg', 'Latent heating rate due to homogeneous freezing of rain' )
+ if (micro_mg_version > 1) then
+ call addfld ('QRSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Rain mixing ratio tendency from sedimentation' )
+ call addfld ('QSSEDTEN', (/ 'lev' /), 'A', 'kg/kg/s', 'Snow mixing ratio tendency from sedimentation' )
+ end if
+
+!AL MG microphysics diagnostics number tendencies
+ call addfld ('NNUCCCO ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tendency immersion freezing' )
+ call addfld ('NNUCCTO ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tendency contact freezing' )
+ call addfld ('NPSACWSO ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tendency accretion by snow' )
+ call addfld ('NSUBCO ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tendency evaporation of droplet' )
+ call addfld ('NPRAO ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tendency accretion' )
+ call addfld ('NPRC1O ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tendency autoconversion' )
+ call addfld ('NQCSEDTEN',(/ 'lev' /), 'A', '1/kg/s ', 'NC tendency sedimentation' )
+ call addfld ('NQISEDTEN',(/ 'lev' /), 'A', '1/kg/s ', 'NI tendency sedimentation' )
+ call addfld ('NMELTO ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tendency melting' )
+ call addfld ('NIMELTO ',(/ 'lev' /), 'A', '1/kg/s ', 'NI tendency melting' )
+ call addfld ('NHOMOO ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tendency homogeneous freezing' )
+ call addfld ('NIHOMOO ',(/ 'lev' /), 'A', '1/kg/s ', 'NI tendency homogeneous freezing' )
+ call addfld ('NSACWIO ',(/ 'lev' /), 'A', '1/kg/s ', 'NI tendency from HM' )
+ call addfld ('NSUBIO ',(/ 'lev' /), 'A', '1/kg/s ', 'NI tendency evaporation' )
+ call addfld ('NPRCIO ',(/ 'lev' /), 'A', '1/kg/s ', 'NI tendency autoconversion snow' )
+ call addfld ('NPRAIO ',(/ 'lev' /), 'A', '1/kg/s ', 'NI tendency accretion snow' )
+ call addfld ('NNUDEPO ',(/ 'lev' /), 'A', '1/kg/s ', 'NI deposition' )
+ call addfld ('NPCCNO ',(/ 'lev' /), 'A', '1/kg/s ', 'NC activation' )
+ call addfld ('NPCCNO2 ',(/ 'lev' /), 'A', '1/kg/s ', 'NC activation' )
+ call addfld ('NNUCCDO ',(/ 'lev' /), 'A', '1/kg/s ', 'NI nuccleation' )
+ call addfld ('NCTNCONS ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tuning: conservation of nc ' )
+ call addfld ('NCTNNBMN ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tuning: minimum nc' )
+ call addfld ('NCTNSZMN ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tuning: minimum slope parameter' )
+ call addfld ('NCTNSZMX ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tuning: maximum slope parameter' )
+ call addfld ('NCTNNCLD ',(/ 'lev' /), 'A', '1/kg/s ', 'NC tuning: removal of nc for zero cloud water' )
+ call addfld ('NITNCONS ',(/ 'lev' /), 'A', '1/kg/s ', 'NI tuning: conservation of ni ' )
+ call addfld ('NITNSZMN ',(/ 'lev' /), 'A', '1/kg/s ', 'NI tuning: minimum slope parameter' )
+ call addfld ('NITNSZMX ',(/ 'lev' /), 'A', '1/kg/s ', 'NI tuning: maximum slope parameter' )
+ call addfld ('NITNNCLD ',(/ 'lev' /), 'A', '1/kg/s ', 'NI tuning: removal of nI for zero cloud ice' )
+ call addfld ('MNUDEPO ',(/ 'lev' /), 'A', 'kg/kg/s ', 'Mixing ratio deposition' )
+ call addfld ('MPDNLIQ ',(/ 'lev' /), 'A', '1/kg/s ', 'CLDLIQ number tendency - Morrison microphysics' )
+ call addfld ('MPDNICE ',(/ 'lev' /), 'A', '1/kg/s ', 'CLDICE number tendency - Morrison microphysics' )
+ call addfld ('FRZR ',(/ 'lev' /), 'A', 'kg/kg/s ', 'Mass freezing rain to snow' )
+ call addfld ('NFRZR ',(/ 'lev' /), 'A', '1/kg/s ', 'Number freezing rain to snow' )
+ call addfld ('MNUCCRI ',(/ 'lev' /), 'A', 'kg/kg/s ', 'Mass freezing rain to ice' )
+ call addfld ('NNUCCRI ',(/ 'lev' /), 'A', '1/kg/s ', 'Number freezing rain to ice' )
+
+ ! History variables for CAM5 microphysics
+ call addfld ('MPDT', (/ 'lev' /), 'A', 'W/kg', 'Heating tendency - Morrison microphysics' )
+ call addfld ('MPDQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency - Morrison microphysics' )
+ call addfld ('MPDLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDLIQ tendency - Morrison microphysics' )
+ call addfld ('MPDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency - Morrison microphysics' )
+ call addfld ('MPDW2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Vapor tendency - Morrison microphysics' )
+ call addfld ('MPDW2I', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Ice tendency - Morrison microphysics' )
+ call addfld ('MPDW2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Water <--> Precip tendency - Morrison microphysics' )
+ call addfld ('MPDI2V', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Vapor tendency - Morrison microphysics' )
+ call addfld ('MPDI2W', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Water tendency - Morrison microphysics' )
+ call addfld ('MPDI2P', (/ 'lev' /), 'A', 'kg/kg/s', 'Ice <--> Precip tendency - Morrison microphysics' )
+ call addfld ('ICWNC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud water number conc' )
+ call addfld ('ICINC', (/ 'lev' /), 'A', 'm-3', 'Prognostic in-cloud ice number conc' )
+ call addfld ('EFFLIQ_IND', (/ 'lev' /), 'A','Micron', 'Prognostic droplet effective radius (indirect effect)' )
+ call addfld ('CDNUMC', horiz_only, 'A', '1/m2', 'Vertically-integrated droplet concentration' )
+ call addfld ('MPICLWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated &
+ &in-cloud Initial Liquid WP (Before Micro)' )
+ call addfld ('MPICIWPI', horiz_only, 'A', 'kg/m2', 'Vertically-integrated &
+ &in-cloud Initial Ice WP (Before Micro)' )
+
+ ! This is provided as an example on how to write out subcolumn output
+ ! NOTE -- only 'I' should be used for sub-column fields as subc-columns could shift from time-step to time-step
+ if (use_subcol_microp) then
+ call addfld('FICE_SCOL', (/'psubcols','lev '/), 'I', 'fraction', &
+ 'Sub-column fractional ice content within cloud', flag_xyfill=.true., fill_value=1.e30_r8)
+ end if
+
+
+ ! This is only if the coldpoint temperatures are being adjusted.
+ ! NOTE: Some fields related to these and output later are added in tropopause.F90.
+ if (micro_mg_adjust_cpt) then
+ call addfld ('TROPF_TADJ', (/ 'lev' /), 'A', 'K', 'Temperatures after cold point adjustment' )
+ call addfld ('TROPF_RHADJ', (/ 'lev' /), 'A', 'K', 'Relative Hunidity after cold point adjustment' )
+ call addfld ('TROPF_CDT', horiz_only, 'A', 'K', 'Cold point temperature adjustment' )
+ call addfld ('TROPF_CDZ', horiz_only, 'A', 'm', 'Distance of coldpoint from coldest model level' )
+ end if
+
+
+ ! Averaging for cloud particle number and size
+ call addfld ('AWNC', (/ 'lev' /), 'A', 'm-3', 'Average cloud water number conc' )
+ call addfld ('AWNI', (/ 'lev' /), 'A', 'm-3', 'Average cloud ice number conc' )
+ call addfld ('AREL', (/ 'lev' /), 'A', 'Micron', 'Average droplet effective radius' )
+ call addfld ('AREI', (/ 'lev' /), 'A', 'Micron', 'Average ice effective radius' )
+ ! Frequency arrays for above
+ call addfld ('FREQL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of liquid' )
+ call addfld ('FREQI', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of ice' )
+
+ ! Average cloud top particle size and number (liq, ice) and frequency
+ call addfld ('ACTREL', horiz_only, 'A', 'Micron', 'Average Cloud Top droplet effective radius' )
+ call addfld ('ACTREI', horiz_only, 'A', 'Micron', 'Average Cloud Top ice effective radius' )
+ call addfld ('ACTNL', horiz_only, 'A', 'm-3', 'Average Cloud Top droplet number' )
+ call addfld ('ACTNI', horiz_only, 'A', 'm-3', 'Average Cloud Top ice number' )
+
+ call addfld ('FCTL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top liquid' )
+ call addfld ('FCTI', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top ice' )
+ !++IH
+ !For comparing to Bernartz CDNC concentrations
+!akc6 call addfld ('ACTNL_B ', horiz_only, 'A', 'Micron ', 'Average Cloud Top droplet number (Bennartz)' )
+ call addfld ('ACTNL_B ', horiz_only, 'A', 'm-3', 'Average Cloud Top droplet number (Bennartz)' )
+ call addfld ('FCTL_B ', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top liquid (Bennartz)' )
+!ak6+
+ call addfld ('CCN_B ', horiz_only, 'A', 'm-3', 'Average Cloud Top liquid CCN (Bennartz)' )
+!ak6-
+ !--IH
+
+ ! New frequency arrays for mixed phase and supercooled liquid (only and mixed) for (a) Cloud Top and (b) everywhere..
+ call addfld ('FREQM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of mixed phase' )
+ call addfld ('FREQSL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of only supercooled liquid' )
+ call addfld ('FREQSLM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of super cooled liquid with ice' )
+ call addfld ('FCTM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top mixed phase' )
+ call addfld ('FCTSL', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top only supercooled liquid' )
+ call addfld ('FCTSLM', horiz_only, 'A', 'fraction', 'Fractional occurrence of cloud top super cooled liquid with ice' )
+
+ call addfld ('LS_FLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface rain+snow flux' )
+ call addfld ('LS_FLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s', 'ls stratiform gbm interface snow flux' )
+
+ call addfld ('REL', (/ 'lev' /), 'A', 'micron', 'MG REL stratiform cloud effective radius liquid' )
+ call addfld ('REI', (/ 'lev' /), 'A', 'micron', 'MG REI stratiform cloud effective radius ice' )
+ call addfld ('LS_REFFRAIN', (/ 'lev' /), 'A', 'micron', 'ls stratiform rain effective radius' )
+ call addfld ('LS_REFFSNOW', (/ 'lev' /), 'A', 'micron', 'ls stratiform snow effective radius' )
+ call addfld ('CV_REFFLIQ', (/ 'lev' /), 'A', 'micron', 'convective cloud liq effective radius' )
+ call addfld ('CV_REFFICE', (/ 'lev' /), 'A', 'micron', 'convective cloud ice effective radius' )
+ call addfld ('MG_SADICE', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density ice' )
+ call addfld ('MG_SADSNOW', (/ 'lev' /), 'A', 'cm2/cm3', 'MG surface area density snow' )
+
+ ! diagnostic precip
+ call addfld ('QRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean rain mixing ratio' )
+ call addfld ('QSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Diagnostic grid-mean snow mixing ratio' )
+ call addfld ('NRAIN', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean rain number conc' )
+ call addfld ('NSNOW', (/ 'lev' /), 'A', 'm-3', 'Diagnostic grid-mean snow number conc' )
+
+ ! size of precip
+ call addfld ('RERCLD', (/ 'lev' /), 'A', 'm', 'Diagnostic effective radius of Liquid Cloud and Rain' )
+ call addfld ('DSNOW', (/ 'lev' /), 'A', 'm', 'Diagnostic grid-mean snow diameter' )
+
+ ! diagnostic radar reflectivity, cloud-averaged
+ call addfld ('REFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity' )
+ call addfld ('AREFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity' )
+ call addfld ('FREFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity' )
+
+ call addfld ('CSRFL', (/ 'lev' /), 'A', 'DBz', '94 GHz radar reflectivity (CloudSat thresholds)' )
+ call addfld ('ACSRFL', (/ 'lev' /), 'A', 'DBz', 'Average 94 GHz radar reflectivity (CloudSat thresholds)' )
+ call addfld ('FCSRFL', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of radar reflectivity (CloudSat thresholds)' )
+
+ call addfld ('AREFLZ', (/ 'lev' /), 'A', 'mm^6/m^3', 'Average 94 GHz radar reflectivity' )
+
+ ! Aerosol information
+ call addfld ('NCAL', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Liquid' )
+ call addfld ('NCAI', (/ 'lev' /), 'A', '1/m3', 'Number Concentation Activated for Ice' )
+
+ ! Average rain and snow mixing ratio (Q), number (N) and diameter (D), with frequency
+ call addfld ('AQRAIN', (/ 'lev' /), 'A', 'kg/kg', 'Average rain mixing ratio' )
+ call addfld ('AQSNOW', (/ 'lev' /), 'A', 'kg/kg', 'Average snow mixing ratio' )
+ call addfld ('ANRAIN', (/ 'lev' /), 'A', 'm-3', 'Average rain number conc' )
+ call addfld ('ANSNOW', (/ 'lev' /), 'A', 'm-3', 'Average snow number conc' )
+ call addfld ('ADRAIN', (/ 'lev' /), 'A', 'Micron', 'Average rain effective Diameter' )
+ call addfld ('ADSNOW', (/ 'lev' /), 'A', 'Micron', 'Average snow effective Diameter' )
+ call addfld ('FREQR', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of rain' )
+ call addfld ('FREQS', (/ 'lev' /), 'A', 'fraction', 'Fractional occurrence of snow' )
+
+ ! precipitation efficiency & other diagnostic fields
+ call addfld('PE' , horiz_only, 'A', '1', 'Stratiform Precipitation Efficiency (precip/cmeliq)' )
+ call addfld('APRL' , horiz_only, 'A', 'm/s', 'Average Stratiform Precip Rate over efficiency calculation' )
+ call addfld('PEFRAC', horiz_only, 'A', '1', 'Fraction of timesteps precip efficiency reported' )
+ call addfld('VPRCO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of autoconversion rate' )
+ call addfld('VPRAO' , horiz_only, 'A', 'kg/kg/s', 'Vertical average of accretion rate' )
+ call addfld('RACAU' , horiz_only, 'A', 'kg/kg/s', 'Accretion/autoconversion ratio from vertical average' )
+
+ if (micro_mg_version > 1) then
+ call addfld('UMR', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted rain fallspeed' )
+ call addfld('UMS', (/ 'lev' /), 'A', 'm/s', 'Mass-weighted snow fallspeed' )
+ end if
+
+ ! qc limiter (only output in versions 1.5 and later)
+ if (.not. (micro_mg_version == 1 .and. micro_mg_sub_version == 0)) then
+ call addfld('QCRAT', (/ 'lev' /), 'A', 'fraction', 'Qc Limiter: Fraction of qc tendency applied')
+ end if
+
+ ! determine the add_default fields
+ call phys_getopts(history_amwg_out = history_amwg , &
+ history_budget_out = history_budget , &
+ history_budget_histfile_num_out = budget_histfile)
+
+ if (history_amwg) then
+ call add_default ('FICE ', 1, ' ')
+ call add_default ('AQRAIN ', 1, ' ')
+ call add_default ('AQSNOW ', 1, ' ')
+ call add_default ('ANRAIN ', 1, ' ')
+ call add_default ('ANSNOW ', 1, ' ')
+ call add_default ('ADRAIN ', 1, ' ')
+ call add_default ('ADSNOW ', 1, ' ')
+ call add_default ('AREI ', 1, ' ')
+ call add_default ('AREL ', 1, ' ')
+ call add_default ('AWNC ', 1, ' ')
+ call add_default ('AWNI ', 1, ' ')
+ call add_default ('CDNUMC ', 1, ' ')
+ call add_default ('FREQR ', 1, ' ')
+ call add_default ('FREQS ', 1, ' ')
+ call add_default ('FREQL ', 1, ' ')
+ call add_default ('FREQI ', 1, ' ')
+ !++IH (Bennartz CDNC comparison) and extra clouds diags
+ ! made default for NorESM
+ call add_default ('ACTNL ', 1, ' ')
+ call add_default ('ACTREL ', 1, ' ')
+ call add_default ('FCTL ', 1, ' ')
+ call add_default ('ACTNI ', 1, ' ')
+ call add_default ('ACTREI ', 1, ' ')
+ call add_default ('FCTI ', 1, ' ')
+ !These are for comparing to Bennartz
+ call add_default ('FCTL_B ', 1, ' ')
+ call add_default ('ACTNL_B ', 1, ' ')
+ !--IH
+!akc6+
+ call add_default ('CCN_B ', 1, ' ')
+!akc6-
+ do m = 1, ncnst
+ call cnst_get_ind(cnst_names(m), mm)
+ call add_default(cnst_name(mm), 1, ' ')
+ ! call add_default(sflxnam(mm), 1, ' ')
+ end do
+ end if
+
+ if ( history_budget ) then
+ call add_default ('EVAPSNOW ', budget_histfile, ' ')
+ call add_default ('EVAPPREC ', budget_histfile, ' ')
+ call add_default ('QVRES ', budget_histfile, ' ')
+ call add_default ('QISEVAP ', budget_histfile, ' ')
+ call add_default ('QCSEVAP ', budget_histfile, ' ')
+ call add_default ('QISEDTEN ', budget_histfile, ' ')
+ call add_default ('QCSEDTEN ', budget_histfile, ' ')
+ call add_default ('QIRESO ', budget_histfile, ' ')
+ call add_default ('QCRESO ', budget_histfile, ' ')
+ if (micro_mg_version > 1) then
+ call add_default ('QRSEDTEN ', budget_histfile, ' ')
+ call add_default ('QSSEDTEN ', budget_histfile, ' ')
+ end if
+ call add_default ('PSACWSO ', budget_histfile, ' ')
+ call add_default ('PRCO ', budget_histfile, ' ')
+ call add_default ('PRCIO ', budget_histfile, ' ')
+ call add_default ('PRAO ', budget_histfile, ' ')
+ call add_default ('PRAIO ', budget_histfile, ' ')
+ call add_default ('PRACSO ', budget_histfile, ' ')
+ call add_default ('MSACWIO ', budget_histfile, ' ')
+ call add_default ('MPDW2V ', budget_histfile, ' ')
+ call add_default ('MPDW2P ', budget_histfile, ' ')
+ call add_default ('MPDW2I ', budget_histfile, ' ')
+ call add_default ('MPDT ', budget_histfile, ' ')
+ call add_default ('MPDQ ', budget_histfile, ' ')
+ call add_default ('MPDLIQ ', budget_histfile, ' ')
+ call add_default ('MPDICE ', budget_histfile, ' ')
+ call add_default ('MPDI2W ', budget_histfile, ' ')
+ call add_default ('MPDI2V ', budget_histfile, ' ')
+ call add_default ('MPDI2P ', budget_histfile, ' ')
+ call add_default ('MNUCCTO ', budget_histfile, ' ')
+ call add_default ('MNUCCRO ', budget_histfile, ' ')
+ call add_default ('MNUCCCO ', budget_histfile, ' ')
+ call add_default ('MELTSDT ', budget_histfile, ' ')
+ call add_default ('MELTO ', budget_histfile, ' ')
+ call add_default ('HOMOO ', budget_histfile, ' ')
+ call add_default ('FRZRDT ', budget_histfile, ' ')
+ call add_default ('CMEIOUT ', budget_histfile, ' ')
+ call add_default ('BERGSO ', budget_histfile, ' ')
+ call add_default ('BERGO ', budget_histfile, ' ')
+!AL
+ call add_default ('NNUCCCO ', budget_histfile, ' ')
+ call add_default ('NNUCCTO ', budget_histfile, ' ')
+ call add_default ('NPSACWSO ', budget_histfile, ' ')
+ call add_default ('NSUBCO ', budget_histfile, ' ')
+ call add_default ('NPRAO ', budget_histfile, ' ')
+ call add_default ('NPRC1O ', budget_histfile, ' ')
+ call add_default ('NQCSEDTEN', budget_histfile, ' ')
+ call add_default ('NQISEDTEN', budget_histfile, ' ')
+ call add_default ('NMELTO ', budget_histfile, ' ')
+ call add_default ('NIMELTO ', budget_histfile, ' ')
+ call add_default ('NHOMOO ', budget_histfile, ' ')
+ call add_default ('NIHOMOO ', budget_histfile, ' ')
+ call add_default ('NSACWIO ', budget_histfile, ' ')
+ call add_default ('NSUBIO ', budget_histfile, ' ')
+ call add_default ('NPRCIO ', budget_histfile, ' ')
+ call add_default ('NPRAIO ', budget_histfile, ' ')
+ call add_default ('NNUDEPO ', budget_histfile, ' ')
+ call add_default ('MNUDEPO ', budget_histfile, ' ')
+ call add_default ('NPCCNO ', budget_histfile, ' ')
+ call add_default ('NPCCNO2 ', budget_histfile, ' ')
+ call add_default ('NNUCCDO ', budget_histfile, ' ')
+
+ call add_default ('NCTNNCLD ', budget_histfile, ' ')
+ call add_default ('NITNCONS ', budget_histfile, ' ')
+ call add_default ('NITNNCLD ', budget_histfile, ' ')
+ call add_default ('NCTNSZMN ', budget_histfile,' ')
+ call add_default ('NCTNSZMX ', budget_histfile,' ')
+ call add_default ('NITNSZMN ', budget_histfile,' ')
+ call add_default ('NITNSZMX ', budget_histfile,' ')
+ select case (micro_mg_version)
+ case (1)
+ call add_default ('NCTNCONS ', budget_histfile, ' ')
+ call add_default ('NCTNNBMN ', budget_histfile, ' ')
+ case (2)
+ call add_default ('FRZR ', budget_histfile, ' ')
+ call add_default ('NFRZR ', budget_histfile, ' ')
+ call add_default ('MNUCCRI ', budget_histfile, ' ')
+ call add_default ('NNUCCRI ', budget_histfile, ' ')
+ end select
+ call add_default ('MPDNLIQ ', budget_histfile, ' ')
+ call add_default ('MPDNICE ', budget_histfile, ' ')
+!AL
+
+ call add_default(cnst_name(ixcldliq), budget_histfile, ' ')
+ call add_default(cnst_name(ixcldice), budget_histfile, ' ')
+ call add_default(apcnst (ixcldliq), budget_histfile, ' ')
+ call add_default(apcnst (ixcldice), budget_histfile, ' ')
+ call add_default(bpcnst (ixcldliq), budget_histfile, ' ')
+ call add_default(bpcnst (ixcldice), budget_histfile, ' ')
+ if (micro_mg_version > 1) then
+ call add_default(cnst_name(ixrain), budget_histfile, ' ')
+ call add_default(cnst_name(ixsnow), budget_histfile, ' ')
+ call add_default(apcnst (ixrain), budget_histfile, ' ')
+ call add_default(apcnst (ixsnow), budget_histfile, ' ')
+ call add_default(bpcnst (ixrain), budget_histfile, ' ')
+ call add_default(bpcnst (ixsnow), budget_histfile, ' ')
+ end if
+
+ end if
+
+ ! physics buffer indices
+ ast_idx = pbuf_get_index('AST')
+ cld_idx = pbuf_get_index('CLD')
+ concld_idx = pbuf_get_index('CONCLD')
+
+ naai_idx = pbuf_get_index('NAAI')
+ naai_hom_idx = pbuf_get_index('NAAI_HOM')
+ npccn_idx = pbuf_get_index('NPCCN')
+ rndst_idx = pbuf_get_index('RNDST')
+ nacon_idx = pbuf_get_index('NACON')
+
+ prec_str_idx = pbuf_get_index('PREC_STR')
+ snow_str_idx = pbuf_get_index('SNOW_STR')
+ prec_sed_idx = pbuf_get_index('PREC_SED')
+ snow_sed_idx = pbuf_get_index('SNOW_SED')
+ prec_pcw_idx = pbuf_get_index('PREC_PCW')
+ snow_pcw_idx = pbuf_get_index('SNOW_PCW')
+
+ cmeliq_idx = pbuf_get_index('CMELIQ')
+
+ ! These fields may have been added, so don't abort if they have not been
+ qsatfac_idx = pbuf_get_index('QSATFAC', ierr)
+ qrain_idx = pbuf_get_index('QRAIN', ierr)
+ qsnow_idx = pbuf_get_index('QSNOW', ierr)
+ nrain_idx = pbuf_get_index('NRAIN', ierr)
+ nsnow_idx = pbuf_get_index('NSNOW', ierr)
+
+ ! fields for heterogeneous freezing
+ frzimm_idx = pbuf_get_index('FRZIMM', ierr)
+ frzcnt_idx = pbuf_get_index('FRZCNT', ierr)
+ frzdep_idx = pbuf_get_index('FRZDEP', ierr)
+
+ ! Initialize physics buffer grid fields for accumulating precip and condensation
+ if (is_first_step()) then
+ call pbuf_set_field(pbuf2d, cldo_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, cc_qlst_idx,0._r8)
+ call pbuf_set_field(pbuf2d, acpr_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, acgcme_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, acnum_idx, 0)
+ call pbuf_set_field(pbuf2d, relvar_idx, 2._r8)
+ call pbuf_set_field(pbuf2d, accre_enhan_idx, 1._r8)
+ call pbuf_set_field(pbuf2d, am_evp_st_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, evprain_st_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, evpsnow_st_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, prer_evap_idx, 0._r8)
+
+ if (qrain_idx > 0) call pbuf_set_field(pbuf2d, qrain_idx, 0._r8)
+ if (qsnow_idx > 0) call pbuf_set_field(pbuf2d, qsnow_idx, 0._r8)
+ if (nrain_idx > 0) call pbuf_set_field(pbuf2d, nrain_idx, 0._r8)
+ if (nsnow_idx > 0) call pbuf_set_field(pbuf2d, nsnow_idx, 0._r8)
+
+ ! If sub-columns turned on, need to set the sub-column fields as well
+ if (use_subcol_microp) then
+ call pbuf_set_field(pbuf2d, cldo_idx, 0._r8, col_type=col_type_subcol)
+ call pbuf_set_field(pbuf2d, cc_t_idx, 0._r8, col_type=col_type_subcol)
+ call pbuf_set_field(pbuf2d, cc_qv_idx, 0._r8, col_type=col_type_subcol)
+ call pbuf_set_field(pbuf2d, cc_ql_idx, 0._r8, col_type=col_type_subcol)
+ call pbuf_set_field(pbuf2d, cc_qi_idx, 0._r8, col_type=col_type_subcol)
+ call pbuf_set_field(pbuf2d, cc_nl_idx, 0._r8, col_type=col_type_subcol)
+ call pbuf_set_field(pbuf2d, cc_ni_idx, 0._r8, col_type=col_type_subcol)
+ call pbuf_set_field(pbuf2d, cc_qlst_idx,0._r8, col_type=col_type_subcol)
+ end if
+
+ end if
+
+end subroutine micro_mg_cam_init
+
+!===============================================================================
+
+subroutine micro_mg_cam_tend(state, ptend, dtime, pbuf)
+
+ use micro_mg1_0, only: micro_mg_get_cols1_0 => micro_mg_get_cols
+ use micro_mg2_0, only: micro_mg_get_cols2_0 => micro_mg_get_cols
+
+ type(physics_state), intent(in) :: state
+ type(physics_ptend), intent(out) :: ptend
+ real(r8), intent(in) :: dtime
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! Local variables
+ integer :: ncol, nlev, mgncol
+ integer, allocatable :: mgcols(:) ! Columns with microphysics performed
+
+ ! Find the number of levels used in the microphysics.
+ nlev = pver - top_lev + 1
+ ncol = state%ncol
+
+ select case (micro_mg_version)
+ case (1)
+ call micro_mg_get_cols1_0(ncol, nlev, top_lev, state%q(:,:,ixcldliq), &
+ state%q(:,:,ixcldice), mgncol, mgcols)
+ case (2)
+ call micro_mg_get_cols2_0(ncol, nlev, top_lev, state%q(:,:,ixcldliq), &
+ state%q(:,:,ixcldice), state%q(:,:,ixrain), state%q(:,:,ixsnow), &
+ mgncol, mgcols)
+ end select
+
+ call micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nlev)
+
+end subroutine micro_mg_cam_tend
+
+subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nlev)
+
+ use micro_mg_utils, only: size_dist_param_basic, size_dist_param_liq, &
+ mg_liq_props, mg_ice_props, avg_diameter, rhoi, rhosn, rhow, rhows, &
+ qsmall, mincld
+
+ use micro_mg_data, only: MGPacker, MGPostProc, accum_null, accum_mean
+
+ use micro_mg1_0, only: micro_mg_tend1_0 => micro_mg_tend
+ use micro_mg2_0, only: micro_mg_tend2_0 => micro_mg_tend
+
+ use physics_buffer, only: pbuf_col_type_index
+ use subcol, only: subcol_field_avg
+ use tropopause, only: tropopause_find, TROP_ALG_CPP, TROP_ALG_NONE, NOTFOUND
+ use wv_saturation, only: qsat
+
+ type(physics_state), intent(in) :: state
+ type(physics_ptend), intent(out) :: ptend
+ real(r8), intent(in) :: dtime
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ integer, intent(in) :: nlev
+ integer, intent(in) :: mgncol
+ integer, intent(in) :: mgcols(:)
+
+ ! Local variables
+ integer :: lchnk, ncol, psetcols, ngrdcol
+
+ integer :: i, k, itim_old, it
+
+ real(r8), pointer :: naai(:,:) ! ice nucleation number
+ real(r8), pointer :: naai_hom(:,:) ! ice nucleation number (homogeneous)
+ real(r8), pointer :: npccn(:,:) ! liquid activation number tendency
+ real(r8), pointer :: rndst(:,:,:)
+ real(r8), pointer :: nacon(:,:,:)
+ real(r8), pointer :: am_evp_st_grid(:,:) ! Evaporation area of stratiform precipitation. 0<= am_evp_st <=1.
+ real(r8), pointer :: evprain_st_grid(:,:) ! Evaporation rate of stratiform rain [kg/kg/s]
+ real(r8), pointer :: evpsnow_st_grid(:,:) ! Evaporation rate of stratiform snow [kg/kg/s]
+
+ real(r8), pointer :: prec_str(:) ! [Total] Sfc flux of precip from stratiform [ m/s ]
+ real(r8), pointer :: snow_str(:) ! [Total] Sfc flux of snow from stratiform [ m/s ]
+ real(r8), pointer :: prec_sed(:) ! Surface flux of total cloud water from sedimentation
+ real(r8), pointer :: snow_sed(:) ! Surface flux of cloud ice from sedimentation
+ real(r8), pointer :: prec_pcw(:) ! Sfc flux of precip from microphysics [ m/s ]
+ real(r8), pointer :: snow_pcw(:) ! Sfc flux of snow from microphysics [ m/s ]
+
+ real(r8), pointer :: ast(:,:) ! Relative humidity cloud fraction
+ real(r8), pointer :: qsatfac(:,:) ! Subgrid cloud water saturation scaling factor.
+ real(r8), pointer :: alst_mic(:,:)
+ real(r8), pointer :: aist_mic(:,:)
+ real(r8), pointer :: cldo(:,:) ! Old cloud fraction
+ real(r8), pointer :: nevapr(:,:) ! Evaporation of total precipitation (rain + snow)
+ real(r8), pointer :: prer_evap(:,:) ! precipitation evaporation rate
+ real(r8), pointer :: relvar(:,:) ! relative variance of cloud water
+ real(r8), pointer :: accre_enhan(:,:) ! optional accretion enhancement for experimentation
+ real(r8), pointer :: prain(:,:) ! Total precipitation (rain + snow)
+ real(r8), pointer :: dei(:,:) ! Ice effective diameter (meters) (AG: microns?)
+ real(r8), pointer :: mu(:,:) ! Size distribution shape parameter for radiation
+ real(r8), pointer :: lambdac(:,:) ! Size distribution slope parameter for radiation
+ real(r8), pointer :: des(:,:) ! Snow effective diameter (m)
+
+ real(r8) :: rho(state%psetcols,pver)
+ real(r8) :: cldmax(state%psetcols,pver)
+
+ real(r8), target :: rate1cld(state%psetcols,pver) ! array to hold rate1ord_cw2pr_st from microphysics
+
+ real(r8), target :: tlat(state%psetcols,pver)
+ real(r8), target :: qvlat(state%psetcols,pver)
+ real(r8), target :: qcten(state%psetcols,pver)
+ real(r8), target :: qiten(state%psetcols,pver)
+ real(r8), target :: ncten(state%psetcols,pver)
+ real(r8), target :: niten(state%psetcols,pver)
+
+ real(r8), target :: qrten(state%psetcols,pver)
+ real(r8), target :: qsten(state%psetcols,pver)
+ real(r8), target :: nrten(state%psetcols,pver)
+ real(r8), target :: nsten(state%psetcols,pver)
+
+ real(r8), target :: prect(state%psetcols)
+ real(r8), target :: preci(state%psetcols)
+ real(r8), target :: am_evp_st(state%psetcols,pver) ! Area over which precip evaporates
+ real(r8), target :: evapsnow(state%psetcols,pver) ! Local evaporation of snow
+ real(r8), target :: prodsnow(state%psetcols,pver) ! Local production of snow
+ real(r8), target :: cmeice(state%psetcols,pver) ! Rate of cond-evap of ice within the cloud
+ real(r8), target :: qsout(state%psetcols,pver) ! Snow mixing ratio
+ real(r8), target :: cflx(state%psetcols,pverp) ! grid-box avg liq condensate flux (kg m^-2 s^-1)
+ real(r8), target :: iflx(state%psetcols,pverp) ! grid-box avg ice condensate flux (kg m^-2 s^-1)
+ real(r8), target :: rflx(state%psetcols,pverp) ! grid-box average rain flux (kg m^-2 s^-1)
+ real(r8), target :: sflx(state%psetcols,pverp) ! grid-box average snow flux (kg m^-2 s^-1)
+ real(r8), target :: qrout(state%psetcols,pver) ! Rain mixing ratio
+ real(r8), target :: qcsevap(state%psetcols,pver) ! Evaporation of falling cloud water
+ real(r8), target :: qisevap(state%psetcols,pver) ! Sublimation of falling cloud ice
+ real(r8), target :: qvres(state%psetcols,pver) ! Residual condensation term to remove excess saturation
+ real(r8), target :: cmeiout(state%psetcols,pver) ! Deposition/sublimation rate of cloud ice
+ real(r8), target :: vtrmc(state%psetcols,pver) ! Mass-weighted cloud water fallspeed
+ real(r8), target :: vtrmi(state%psetcols,pver) ! Mass-weighted cloud ice fallspeed
+ real(r8), target :: umr(state%psetcols,pver) ! Mass-weighted rain fallspeed
+ real(r8), target :: ums(state%psetcols,pver) ! Mass-weighted snow fallspeed
+ real(r8), target :: qcsedten(state%psetcols,pver) ! Cloud water mixing ratio tendency from sedimentation
+ real(r8), target :: qisedten(state%psetcols,pver) ! Cloud ice mixing ratio tendency from sedimentation
+ real(r8), target :: qrsedten(state%psetcols,pver) ! Rain mixing ratio tendency from sedimentation
+ real(r8), target :: qssedten(state%psetcols,pver) ! Snow mixing ratio tendency from sedimentation
+
+ real(r8), target :: prao(state%psetcols,pver)
+ real(r8), target :: prco(state%psetcols,pver)
+ real(r8), target :: mnuccco(state%psetcols,pver)
+ real(r8), target :: mnuccto(state%psetcols,pver)
+ real(r8), target :: msacwio(state%psetcols,pver)
+ real(r8), target :: psacwso(state%psetcols,pver)
+ real(r8), target :: bergso(state%psetcols,pver)
+ real(r8), target :: bergo(state%psetcols,pver)
+ real(r8), target :: melto(state%psetcols,pver)
+ real(r8), target :: homoo(state%psetcols,pver)
+ real(r8), target :: qcreso(state%psetcols,pver)
+ real(r8), target :: prcio(state%psetcols,pver)
+ real(r8), target :: praio(state%psetcols,pver)
+ real(r8), target :: qireso(state%psetcols,pver)
+ real(r8), target :: mnuccro(state%psetcols,pver)
+ real(r8), target :: pracso (state%psetcols,pver)
+ real(r8), target :: meltsdt(state%psetcols,pver)
+ real(r8), target :: frzrdt (state%psetcols,pver)
+ real(r8), target :: mnuccdo(state%psetcols,pver)
+ real(r8), target :: nrout(state%psetcols,pver)
+ real(r8), target :: nsout(state%psetcols,pver)
+ real(r8), target :: refl(state%psetcols,pver) ! analytic radar reflectivity
+ real(r8), target :: arefl(state%psetcols,pver) ! average reflectivity will zero points outside valid range
+ real(r8), target :: areflz(state%psetcols,pver) ! average reflectivity in z.
+ real(r8), target :: frefl(state%psetcols,pver)
+ real(r8), target :: csrfl(state%psetcols,pver) ! cloudsat reflectivity
+ real(r8), target :: acsrfl(state%psetcols,pver) ! cloudsat average
+ real(r8), target :: fcsrfl(state%psetcols,pver)
+ real(r8), target :: rercld(state%psetcols,pver) ! effective radius calculation for rain + cloud
+ real(r8), target :: ncai(state%psetcols,pver) ! output number conc of ice nuclei available (1/m3)
+ real(r8), target :: ncal(state%psetcols,pver) ! output number conc of CCN (1/m3)
+ real(r8), target :: qrout2(state%psetcols,pver)
+ real(r8), target :: qsout2(state%psetcols,pver)
+ real(r8), target :: nrout2(state%psetcols,pver)
+ real(r8), target :: nsout2(state%psetcols,pver)
+ real(r8), target :: freqs(state%psetcols,pver)
+ real(r8), target :: freqr(state%psetcols,pver)
+ real(r8), target :: nfice(state%psetcols,pver)
+ real(r8), target :: qcrat(state%psetcols,pver) ! qc limiter ratio (1=no limit)
+
+!AL
+ real(r8), target :: nnuccco(state%psetcols,pver) ! immersion freezing
+ real(r8), target :: nnuccto(state%psetcols,pver) ! contact freezing
+ real(r8), target :: npsacwso(state%psetcols,pver) ! accr. snow
+ real(r8), target :: nsubco(state%psetcols,pver) ! evaporation of droplet
+ real(r8), target :: nprao(state%psetcols,pver) ! accretion
+ real(r8), target :: nprc1o(state%psetcols,pver) ! autoconversion
+ real(r8), target :: nqcsedten(state%psetcols,pver) ! nqc sedimentation tendency
+ real(r8), target :: nqisedten(state%psetcols,pver) ! nqc sedimentation tendency
+ real(r8), target :: nmelto(state%psetcols,pver) ! melting of cloud ice
+ real(r8), target :: nhomoo(state%psetcols,pver) ! homogeneos freezign cloud water
+ real(r8), target :: nimelto(state%psetcols,pver) ! melting of cloud ice
+ real(r8), target :: nihomoo(state%psetcols,pver) ! homogeneos freezign cloud water
+ real(r8), target :: nsacwio(state%psetcols,pver) ! numb conc tend due to HM ice multiplication
+ real(r8), target :: nsubio(state%psetcols,pver) ! evaporation of cloud ice number (sublimation?)
+ real(r8), target :: nprcio(state%psetcols,pver) ! numb conc tend due to auto of cloud ice to snow
+ real(r8), target :: npraio(state%psetcols,pver) ! numb conc tend due to accr of cloud ice by snow
+ real(r8), target :: nnudepo(state%psetcols,pver) ! deposition?
+ real(r8), target :: npccno(state%psetcols,pver) ! activation
+ real(r8), target :: nnuccdo(state%psetcols,pver) ! nucleation (ice)
+ real(r8), target :: mnudepo(state%psetcols,pver) ! deposition
+ real(r8), target :: nctncons(state%psetcols,pver) ! correction term
+ real(r8), target :: nctnnbmn(state%psetcols,pver) ! correction if below minimum number
+ real(r8), target :: nctnszmn(state%psetcols,pver) ! gamma adjustment (liquid)
+ real(r8), target :: nctnszmx(state%psetcols,pver) ! gamma adjustment (liquid)
+ real(r8), target :: nctnncld(state%psetcols,pver) ! correction for no cloud
+ real(r8), target :: nitncons(state%psetcols,pver) ! numerical conservation check in sub-time step
+ real(r8), target :: nitnszmn(state%psetcols,pver) ! gamma-adjustment (ice)
+ real(r8), target :: nitnszmx(state%psetcols,pver) ! gamma-adjustment (ice)
+ real(r8), target :: nitnncld(state%psetcols,pver) ! corrrection for no cloud
+ real(r8), target :: frzr(state%psetcols,pver) ! mass freezing rain ==>snow
+ real(r8), target :: nfrzr(state%psetcols,pver) ! number freezing rain ==> snow
+ real(r8), target :: mnuccri(state%psetcols,pver) ! mass freezing rain ==> ice
+ real(r8), target :: nnuccri(state%psetcols,pver) ! number freezing rain ==> ice
+!AL
+ ! Object that packs columns with clouds/precip.
+ type(MGPacker) :: packer
+
+ ! Packed versions of inputs.
+ real(r8) :: packed_t(mgncol,nlev)
+ real(r8) :: packed_q(mgncol,nlev)
+ real(r8) :: packed_qc(mgncol,nlev)
+ real(r8) :: packed_nc(mgncol,nlev)
+ real(r8) :: packed_qi(mgncol,nlev)
+ real(r8) :: packed_ni(mgncol,nlev)
+ real(r8) :: packed_qr(mgncol,nlev)
+ real(r8) :: packed_nr(mgncol,nlev)
+ real(r8) :: packed_qs(mgncol,nlev)
+ real(r8) :: packed_ns(mgncol,nlev)
+
+ real(r8) :: packed_relvar(mgncol,nlev)
+ real(r8) :: packed_accre_enhan(mgncol,nlev)
+
+ real(r8) :: packed_p(mgncol,nlev)
+ real(r8) :: packed_pdel(mgncol,nlev)
+
+ real(r8) :: packed_cldn(mgncol,nlev)
+ real(r8) :: packed_liqcldf(mgncol,nlev)
+ real(r8) :: packed_icecldf(mgncol,nlev)
+ real(r8), allocatable :: packed_qsatfac(:,:)
+
+ real(r8) :: packed_naai(mgncol,nlev)
+ real(r8) :: packed_npccn(mgncol,nlev)
+
+ real(r8), allocatable :: packed_rndst(:,:,:)
+ real(r8), allocatable :: packed_nacon(:,:,:)
+
+ ! Optional outputs.
+ real(r8) :: packed_tnd_qsnow(mgncol,nlev)
+ real(r8) :: packed_tnd_nsnow(mgncol,nlev)
+ real(r8) :: packed_re_ice(mgncol,nlev)
+
+ real(r8) :: packed_frzimm(mgncol,nlev)
+ real(r8) :: packed_frzcnt(mgncol,nlev)
+ real(r8) :: packed_frzdep(mgncol,nlev)
+
+ ! Output field post-processing.
+ type(MGPostProc) :: post_proc
+
+ ! Packed versions of outputs.
+ real(r8), target :: packed_rate1ord_cw2pr_st(mgncol,nlev)
+ real(r8), target :: packed_tlat(mgncol,nlev)
+ real(r8), target :: packed_qvlat(mgncol,nlev)
+ real(r8), target :: packed_qctend(mgncol,nlev)
+ real(r8), target :: packed_qitend(mgncol,nlev)
+ real(r8), target :: packed_nctend(mgncol,nlev)
+ real(r8), target :: packed_nitend(mgncol,nlev)
+
+ real(r8), target :: packed_qrtend(mgncol,nlev)
+ real(r8), target :: packed_qstend(mgncol,nlev)
+ real(r8), target :: packed_nrtend(mgncol,nlev)
+ real(r8), target :: packed_nstend(mgncol,nlev)
+
+ real(r8), target :: packed_prect(mgncol)
+ real(r8), target :: packed_preci(mgncol)
+ real(r8), target :: packed_nevapr(mgncol,nlev)
+ real(r8), target :: packed_am_evp_st(mgncol,nlev)
+ real(r8), target :: packed_evapsnow(mgncol,nlev)
+ real(r8), target :: packed_prain(mgncol,nlev)
+ real(r8), target :: packed_prodsnow(mgncol,nlev)
+ real(r8), target :: packed_cmeout(mgncol,nlev)
+ real(r8), target :: packed_qsout(mgncol,nlev)
+ real(r8), target :: packed_cflx(mgncol,nlev+1)
+ real(r8), target :: packed_iflx(mgncol,nlev+1)
+ real(r8), target :: packed_rflx(mgncol,nlev+1)
+ real(r8), target :: packed_sflx(mgncol,nlev+1)
+ real(r8), target :: packed_qrout(mgncol,nlev)
+ real(r8), target :: packed_qcsevap(mgncol,nlev)
+ real(r8), target :: packed_qisevap(mgncol,nlev)
+ real(r8), target :: packed_qvres(mgncol,nlev)
+ real(r8), target :: packed_cmei(mgncol,nlev)
+ real(r8), target :: packed_vtrmc(mgncol,nlev)
+ real(r8), target :: packed_vtrmi(mgncol,nlev)
+ real(r8), target :: packed_qcsedten(mgncol,nlev)
+ real(r8), target :: packed_qisedten(mgncol,nlev)
+ real(r8), target :: packed_qrsedten(mgncol,nlev)
+ real(r8), target :: packed_qssedten(mgncol,nlev)
+ real(r8), target :: packed_umr(mgncol,nlev)
+ real(r8), target :: packed_ums(mgncol,nlev)
+ real(r8), target :: packed_pra(mgncol,nlev)
+ real(r8), target :: packed_prc(mgncol,nlev)
+ real(r8), target :: packed_mnuccc(mgncol,nlev)
+ real(r8), target :: packed_mnucct(mgncol,nlev)
+ real(r8), target :: packed_msacwi(mgncol,nlev)
+ real(r8), target :: packed_psacws(mgncol,nlev)
+ real(r8), target :: packed_bergs(mgncol,nlev)
+ real(r8), target :: packed_berg(mgncol,nlev)
+ real(r8), target :: packed_melt(mgncol,nlev)
+ real(r8), target :: packed_homo(mgncol,nlev)
+ real(r8), target :: packed_qcres(mgncol,nlev)
+ real(r8), target :: packed_prci(mgncol,nlev)
+ real(r8), target :: packed_prai(mgncol,nlev)
+ real(r8), target :: packed_qires(mgncol,nlev)
+ real(r8), target :: packed_mnuccr(mgncol,nlev)
+ real(r8), target :: packed_pracs(mgncol,nlev)
+ real(r8), target :: packed_meltsdt(mgncol,nlev)
+ real(r8), target :: packed_frzrdt(mgncol,nlev)
+ real(r8), target :: packed_mnuccd(mgncol,nlev)
+ real(r8), target :: packed_nrout(mgncol,nlev)
+ real(r8), target :: packed_nsout(mgncol,nlev)
+ real(r8), target :: packed_refl(mgncol,nlev)
+ real(r8), target :: packed_arefl(mgncol,nlev)
+ real(r8), target :: packed_areflz(mgncol,nlev)
+ real(r8), target :: packed_frefl(mgncol,nlev)
+ real(r8), target :: packed_csrfl(mgncol,nlev)
+ real(r8), target :: packed_acsrfl(mgncol,nlev)
+ real(r8), target :: packed_fcsrfl(mgncol,nlev)
+ real(r8), target :: packed_rercld(mgncol,nlev)
+ real(r8), target :: packed_ncai(mgncol,nlev)
+ real(r8), target :: packed_ncal(mgncol,nlev)
+ real(r8), target :: packed_qrout2(mgncol,nlev)
+ real(r8), target :: packed_qsout2(mgncol,nlev)
+ real(r8), target :: packed_nrout2(mgncol,nlev)
+ real(r8), target :: packed_nsout2(mgncol,nlev)
+ real(r8), target :: packed_freqs(mgncol,nlev)
+ real(r8), target :: packed_freqr(mgncol,nlev)
+ real(r8), target :: packed_nfice(mgncol,nlev)
+ real(r8), target :: packed_prer_evap(mgncol,nlev)
+ real(r8), target :: packed_qcrat(mgncol,nlev)
+
+ real(r8), target :: packed_rel(mgncol,nlev)
+ real(r8), target :: packed_rei(mgncol,nlev)
+ real(r8), target :: packed_sadice(mgncol,nlev)
+ real(r8), target :: packed_sadsnow(mgncol,nlev)
+ real(r8), target :: packed_lambdac(mgncol,nlev)
+ real(r8), target :: packed_mu(mgncol,nlev)
+ real(r8), target :: packed_des(mgncol,nlev)
+ real(r8), target :: packed_dei(mgncol,nlev)
+
+ ! Dummy arrays for cases where we throw away the MG version and
+ ! recalculate sizes on the CAM grid to avoid time/subcolumn averaging
+ ! issues.
+ real(r8) :: rel_fn_dum(mgncol,nlev)
+ real(r8) :: dsout2_dum(mgncol,nlev)
+ real(r8) :: drout_dum(mgncol,nlev)
+ real(r8) :: reff_rain_dum(mgncol,nlev)
+ real(r8) :: reff_snow_dum(mgncol,nlev)
+
+ ! Heterogeneous-only version of mnuccdo.
+ real(r8) :: mnuccdohet(state%psetcols,pver)
+
+!AL
+ real(r8), target :: packed_nnuccco(mgncol,nlev) ! immersion freezing
+ real(r8), target :: packed_nnuccto(mgncol,nlev) ! contact freezing
+ real(r8), target :: packed_npsacwso(mgncol,nlev) ! accr. snow
+ real(r8), target :: packed_nsubco(mgncol,nlev) ! evaporation of droplet
+ real(r8), target :: packed_nprao(mgncol,nlev) ! accretion
+ real(r8), target :: packed_nprc1o(mgncol,nlev) ! autoconversion
+ real(r8), target :: packed_nqcsedten(mgncol,nlev) ! nqc sedimentation tendency
+ real(r8), target :: packed_nqisedten(mgncol,nlev) ! nqc sedimentation tendency
+ real(r8), target :: packed_nmelto(mgncol,nlev) ! melting of cloud ice
+ real(r8), target :: packed_nhomoo(mgncol,nlev) ! homogeneos freezign cloud water
+ real(r8), target :: packed_nimelto(mgncol,nlev) ! melting of cloud ice
+ real(r8), target :: packed_nihomoo(mgncol,nlev) ! homogeneos freezign cloud water
+ real(r8), target :: packed_nsacwio(mgncol,nlev) ! numb conc tend due to HM ice multiplication
+ real(r8), target :: packed_nsubio(mgncol,nlev) ! evaporation of cloud ice number (sublimation?)
+ real(r8), target :: packed_nprcio(mgncol,nlev) ! numb conc tend due to auto of cloud ice to snow
+ real(r8), target :: packed_npraio(mgncol,nlev) ! numb conc tend due to accr of cloud ice by snow
+ real(r8), target :: packed_nnudepo(mgncol,nlev) ! deposition?
+ real(r8), target :: packed_npccno(mgncol,nlev) ! activation
+ real(r8), target :: packed_nnuccdo(mgncol,nlev) ! nucleation (ice)
+ real(r8), target :: packed_mnudepo(mgncol,nlev) ! deposition
+ real(r8), target :: packed_nctncons(mgncol,nlev) ! correction term
+ real(r8), target :: packed_nctnnbmn(mgncol,nlev) ! correction if below minimum number
+ real(r8), target :: packed_nctnszmn(mgncol,nlev) ! gamma adjustment (liquid)
+ real(r8), target :: packed_nctnszmx(mgncol,nlev) ! gamma adjustment (liquid)
+ real(r8), target :: packed_nctnncld(mgncol,nlev) ! correction for no cloud
+ real(r8), target :: packed_nitncons(mgncol,nlev) ! numerical conservation check in sub-time step
+ real(r8), target :: packed_nitnszmn(mgncol,nlev) ! gamma-adjustment (ice)
+ real(r8), target :: packed_nitnszmx(mgncol,nlev) ! gamma-adjustment (ice)
+ real(r8), target :: packed_nitnncld(mgncol,nlev) ! corrrection for no cloud
+ real(r8), target :: packed_frzr(mgncol,nlev) ! mass freezing rain ==> snow
+ real(r8), target :: packed_nfrzr(mgncol,nlev) ! number freezing rain ==> snow
+ real(r8), target :: packed_mnuccri(mgncol,nlev) ! mass freezing rain ==> ice
+ real(r8), target :: packed_nnuccri(mgncol,nlev) ! number freezing rain ==>ice
+!AL
+
+ ! physics buffer fields for COSP simulator
+ real(r8), pointer :: mgflxprc(:,:) ! MG grid-box mean flux_large_scale_cloud_rain+snow at interfaces (kg/m2/s)
+ real(r8), pointer :: mgflxsnw(:,:) ! MG grid-box mean flux_large_scale_cloud_snow at interfaces (kg/m2/s)
+ real(r8), pointer :: mgmrprc(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_rain+snow at interfaces (kg/kg)
+ real(r8), pointer :: mgmrsnw(:,:) ! MG grid-box mean mixingratio_large_scale_cloud_snow at interfaces (kg/kg)
+ real(r8), pointer :: mgreffrain_grid(:,:) ! MG diagnostic rain effective radius (um)
+ real(r8), pointer :: mgreffsnow_grid(:,:) ! MG diagnostic snow effective radius (um)
+ real(r8), pointer :: cvreffliq(:,:) ! convective cloud liquid effective radius (um)
+ real(r8), pointer :: cvreffice(:,:) ! convective cloud ice effective radius (um)
+
+ ! physics buffer fields used with CARMA
+ real(r8), pointer, dimension(:,:) :: tnd_qsnow ! external tendency on snow mass (kg/kg/s)
+ real(r8), pointer, dimension(:,:) :: tnd_nsnow ! external tendency on snow number(#/kg/s)
+ real(r8), pointer, dimension(:,:) :: re_ice ! ice effective radius (m)
+
+ real(r8), pointer :: rate1ord_cw2pr_st(:,:) ! 1st order rate for direct conversion of
+ ! strat. cloud water to precip (1/s) ! rce 2010/05/01
+ real(r8), pointer :: wsedl(:,:) ! Sedimentation velocity of liquid stratus cloud droplet [ m/s ]
+
+
+ real(r8), pointer :: CC_T(:,:) ! Grid-mean microphysical tendency
+ real(r8), pointer :: CC_qv(:,:) ! Grid-mean microphysical tendency
+ real(r8), pointer :: CC_ql(:,:) ! Grid-mean microphysical tendency
+ real(r8), pointer :: CC_qi(:,:) ! Grid-mean microphysical tendency
+ real(r8), pointer :: CC_nl(:,:) ! Grid-mean microphysical tendency
+ real(r8), pointer :: CC_ni(:,:) ! Grid-mean microphysical tendency
+ real(r8), pointer :: CC_qlst(:,:) ! In-liquid stratus microphysical tendency
+
+ ! variables for heterogeneous freezing
+ real(r8), pointer :: frzimm(:,:)
+ real(r8), pointer :: frzcnt(:,:)
+ real(r8), pointer :: frzdep(:,:)
+
+ real(r8), pointer :: qme(:,:)
+
+ ! A local copy of state is used for diagnostic calculations
+ type(physics_state) :: state_loc
+ type(physics_ptend) :: ptend_loc
+
+ real(r8) :: icecldf(state%psetcols,pver) ! Ice cloud fraction
+ real(r8) :: liqcldf(state%psetcols,pver) ! Liquid cloud fraction (combined into cloud)
+
+ real(r8), pointer :: rel(:,:) ! Liquid effective drop radius (microns)
+ real(r8), pointer :: rei(:,:) ! Ice effective drop size (microns)
+ real(r8), pointer :: sadice(:,:) ! Ice surface area density (cm2/cm3)
+ real(r8), pointer :: sadsnow(:,:) ! Snow surface area density (cm2/cm3)
+
+
+ real(r8), pointer :: cmeliq(:,:)
+
+ real(r8), pointer :: cld(:,:) ! Total cloud fraction
+ real(r8), pointer :: concld(:,:) ! Convective cloud fraction
+ real(r8), pointer :: iciwpst(:,:) ! Stratiform in-cloud ice water path for radiation
+ real(r8), pointer :: iclwpst(:,:) ! Stratiform in-cloud liquid water path for radiation
+ real(r8), pointer :: cldfsnow(:,:) ! Cloud fraction for liquid+snow
+ real(r8), pointer :: icswp(:,:) ! In-cloud snow water path
+
+ real(r8) :: icimrst(state%psetcols,pver) ! In stratus ice mixing ratio
+ real(r8) :: icwmrst(state%psetcols,pver) ! In stratus water mixing ratio
+ real(r8) :: icinc(state%psetcols,pver) ! In cloud ice number conc
+ real(r8) :: icwnc(state%psetcols,pver) ! In cloud water number conc
+
+ real(r8) :: iclwpi(state%psetcols) ! Vertically-integrated in-cloud Liquid WP before microphysics
+ real(r8) :: iciwpi(state%psetcols) ! Vertically-integrated in-cloud Ice WP before microphysics
+
+ ! Averaging arrays for effective radius and number....
+ real(r8) :: efiout_grid(pcols,pver)
+ real(r8) :: efcout_grid(pcols,pver)
+ real(r8) :: ncout_grid(pcols,pver)
+ real(r8) :: niout_grid(pcols,pver)
+ real(r8) :: freqi_grid(pcols,pver)
+ real(r8) :: freql_grid(pcols,pver)
+
+! Averaging arrays for supercooled liquid
+ real(r8) :: freqm_grid(pcols,pver)
+ real(r8) :: freqsl_grid(pcols,pver)
+ real(r8) :: freqslm_grid(pcols,pver)
+ real(r8) :: fctm_grid(pcols)
+ real(r8) :: fctsl_grid(pcols)
+ real(r8) :: fctslm_grid(pcols)
+
+ real(r8) :: cdnumc_grid(pcols) ! Vertically-integrated droplet concentration
+ real(r8) :: icimrst_grid_out(pcols,pver) ! In stratus ice mixing ratio
+ real(r8) :: icwmrst_grid_out(pcols,pver) ! In stratus water mixing ratio
+
+ ! Cloud fraction used for precipitation.
+ real(r8) :: cldmax_grid(pcols,pver)
+
+ ! Average cloud top radius & number
+ real(r8) :: ctrel_grid(pcols)
+ real(r8) :: ctrei_grid(pcols)
+ real(r8) :: ctnl_grid(pcols)
+ real(r8) :: ctni_grid(pcols)
+ real(r8) :: fcti_grid(pcols)
+ real(r8) :: fctl_grid(pcols)
+
+ real(r8) :: ftem_grid(pcols,pver)
+ !++IH:
+ real(r8) :: fctl_b(pcols) !frequency of occurrence for Bennartz
+ real(r8) :: ctnl_b(pcols) !cdnc [/m3] for Bennartz
+!akc6+
+ real(r8) :: ccn_b(pcols) !ccm [/m3] defined as for cdnc for Bennartz
+!akc6-
+ !--IH
+
+ ! Variables for precip efficiency calculation
+ real(r8) :: minlwp ! LWP threshold
+
+ real(r8), pointer, dimension(:) :: acprecl_grid ! accumulated precip across timesteps
+ real(r8), pointer, dimension(:) :: acgcme_grid ! accumulated condensation across timesteps
+ integer, pointer, dimension(:) :: acnum_grid ! counter for # timesteps accumulated
+
+ ! Variables for liquid water path and column condensation
+ real(r8) :: tgliqwp_grid(pcols) ! column liquid
+ real(r8) :: tgcmeliq_grid(pcols) ! column condensation rate (units)
+
+ real(r8) :: pe_grid(pcols) ! precip efficiency for output
+ real(r8) :: pefrac_grid(pcols) ! fraction of time precip efficiency is written out
+ real(r8) :: tpr_grid(pcols) ! average accumulated precipitation rate in pe calculation
+
+ ! variables for autoconversion and accretion vertical averages
+ real(r8) :: vprco_grid(pcols) ! vertical average autoconversion
+ real(r8) :: vprao_grid(pcols) ! vertical average accretion
+ real(r8) :: racau_grid(pcols) ! ratio of vertical averages
+ integer :: cnt_grid(pcols) ! counters
+
+ logical :: lq(pcnst)
+
+ real(r8) :: icimrst_grid(pcols,pver) ! stratus ice mixing ratio - on grid
+ real(r8) :: icwmrst_grid(pcols,pver) ! stratus water mixing ratio - on grid
+
+ real(r8), pointer :: lambdac_grid(:,:)
+ real(r8), pointer :: mu_grid(:,:)
+ real(r8), pointer :: rel_grid(:,:)
+ real(r8), pointer :: rei_grid(:,:)
+ real(r8), pointer :: sadice_grid(:,:)
+ real(r8), pointer :: sadsnow_grid(:,:)
+ real(r8), pointer :: dei_grid(:,:)
+ real(r8), pointer :: des_grid(:,:)
+ real(r8), pointer :: iclwpst_grid(:,:)
+
+ real(r8) :: rho_grid(pcols,pver)
+ real(r8) :: liqcldf_grid(pcols,pver)
+ real(r8) :: qsout_grid(pcols,pver)
+ real(r8) :: ncic_grid(pcols,pver)
+ real(r8) :: niic_grid(pcols,pver)
+ real(r8) :: rel_fn_grid(pcols,pver) ! Ice effective drop size at fixed number (indirect effect) (microns) - on grid
+ real(r8) :: qrout_grid(pcols,pver)
+ real(r8) :: drout2_grid(pcols,pver)
+ real(r8) :: dsout2_grid(pcols,pver)
+ real(r8) :: nsout_grid(pcols,pver)
+ real(r8) :: nrout_grid(pcols,pver)
+ real(r8) :: reff_rain_grid(pcols,pver)
+ real(r8) :: reff_snow_grid(pcols,pver)
+ real(r8) :: cld_grid(pcols,pver)
+ real(r8) :: pdel_grid(pcols,pver)
+ real(r8) :: prco_grid(pcols,pver)
+ real(r8) :: prao_grid(pcols,pver)
+ real(r8) :: icecldf_grid(pcols,pver)
+ real(r8) :: icwnc_grid(pcols,pver)
+ real(r8) :: icinc_grid(pcols,pver)
+ real(r8) :: qcreso_grid(pcols,pver)
+ real(r8) :: melto_grid(pcols,pver)
+ real(r8) :: mnuccco_grid(pcols,pver)
+ real(r8) :: mnuccto_grid(pcols,pver)
+ real(r8) :: bergo_grid(pcols,pver)
+ real(r8) :: homoo_grid(pcols,pver)
+ real(r8) :: msacwio_grid(pcols,pver)
+ real(r8) :: psacwso_grid(pcols,pver)
+ real(r8) :: bergso_grid(pcols,pver)
+ real(r8) :: cmeiout_grid(pcols,pver)
+ real(r8) :: qireso_grid(pcols,pver)
+ real(r8) :: prcio_grid(pcols,pver)
+ real(r8) :: praio_grid(pcols,pver)
+
+ real(r8) :: nc_grid(pcols,pver)
+ real(r8) :: ni_grid(pcols,pver)
+ real(r8) :: qr_grid(pcols,pver)
+ real(r8) :: nr_grid(pcols,pver)
+ real(r8) :: qs_grid(pcols,pver)
+ real(r8) :: ns_grid(pcols,pver)
+
+ real(r8) :: cp_rh(pcols,pver)
+ real(r8) :: cp_t(pcols)
+ real(r8) :: cp_z(pcols)
+ real(r8) :: cp_dt(pcols)
+ real(r8) :: cp_dz(pcols)
+ integer :: troplev(pcols)
+ real(r8) :: es
+ real(r8) :: qs
+
+ real(r8), pointer :: cmeliq_grid(:,:)
+
+ real(r8), pointer :: prec_str_grid(:)
+ real(r8), pointer :: snow_str_grid(:)
+ real(r8), pointer :: prec_pcw_grid(:)
+ real(r8), pointer :: snow_pcw_grid(:)
+ real(r8), pointer :: prec_sed_grid(:)
+ real(r8), pointer :: snow_sed_grid(:)
+ real(r8), pointer :: cldo_grid(:,:)
+ real(r8), pointer :: nevapr_grid(:,:)
+ real(r8), pointer :: prain_grid(:,:)
+ real(r8), pointer :: mgflxprc_grid(:,:)
+ real(r8), pointer :: mgflxsnw_grid(:,:)
+ real(r8), pointer :: mgmrprc_grid(:,:)
+ real(r8), pointer :: mgmrsnw_grid(:,:)
+ real(r8), pointer :: cvreffliq_grid(:,:)
+ real(r8), pointer :: cvreffice_grid(:,:)
+ real(r8), pointer :: rate1ord_cw2pr_st_grid(:,:)
+ real(r8), pointer :: wsedl_grid(:,:)
+ real(r8), pointer :: CC_t_grid(:,:)
+ real(r8), pointer :: CC_qv_grid(:,:)
+ real(r8), pointer :: CC_ql_grid(:,:)
+ real(r8), pointer :: CC_qi_grid(:,:)
+ real(r8), pointer :: CC_nl_grid(:,:)
+ real(r8), pointer :: CC_ni_grid(:,:)
+ real(r8), pointer :: CC_qlst_grid(:,:)
+ real(r8), pointer :: qme_grid(:,:)
+ real(r8), pointer :: iciwpst_grid(:,:)
+ real(r8), pointer :: icswp_grid(:,:)
+ real(r8), pointer :: ast_grid(:,:)
+ real(r8), pointer :: cldfsnow_grid(:,:)
+
+ real(r8), pointer :: qrout_grid_ptr(:,:)
+ real(r8), pointer :: qsout_grid_ptr(:,:)
+ real(r8), pointer :: nrout_grid_ptr(:,:)
+ real(r8), pointer :: nsout_grid_ptr(:,:)
+
+
+ logical :: use_subcol_microp
+ integer :: col_type ! Flag to store whether accessing grid or sub-columns in pbuf_get_field
+
+ character(128) :: errstring ! return status (non-blank for error return)
+
+ ! For rrtmg optics. specified distribution.
+ real(r8), parameter :: dcon = 25.e-6_r8 ! Convective size distribution effective radius (meters)
+ real(r8), parameter :: mucon = 5.3_r8 ! Convective size distribution shape parameter
+ real(r8), parameter :: deicon = 50._r8 ! Convective ice effective diameter (meters)
+
+ real(r8), pointer :: pckdptr(:,:)
+
+ !-------------------------------------------------------------------------------
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+ psetcols = state%psetcols
+ ngrdcol = state%ngrdcol
+
+ itim_old = pbuf_old_tim_idx()
+
+ call phys_getopts(use_subcol_microp_out=use_subcol_microp)
+
+ ! Set the col_type flag to grid or subcolumn dependent on the value of use_subcol_microp
+ call pbuf_col_type_index(use_subcol_microp, col_type=col_type)
+
+ !-----------------------
+ ! These physics buffer fields are read only and not set in this parameterization
+ ! If these fields do not have subcolumn data, copy the grid to the subcolumn if subcolumns is turned on
+ ! If subcolumns is not turned on, then these fields will be grid data
+
+ call pbuf_get_field(pbuf, naai_idx, naai, col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, naai_hom_idx, naai_hom, col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, npccn_idx, npccn, col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, rndst_idx, rndst, col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, nacon_idx, nacon, col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, relvar_idx, relvar, col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan, col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, cmeliq_idx, cmeliq, col_type=col_type, copy_if_needed=use_subcol_microp)
+
+ call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), &
+ col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), &
+ col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), &
+ col_type=col_type, copy_if_needed=use_subcol_microp)
+
+ if (.not. do_cldice) then
+ call pbuf_get_field(pbuf, tnd_qsnow_idx, tnd_qsnow, col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, tnd_nsnow_idx, tnd_nsnow, col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, re_ice_idx, re_ice, col_type=col_type, copy_if_needed=use_subcol_microp)
+ end if
+
+ if (use_hetfrz_classnuc) then
+ call pbuf_get_field(pbuf, frzimm_idx, frzimm, col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, frzcnt_idx, frzcnt, col_type=col_type, copy_if_needed=use_subcol_microp)
+ call pbuf_get_field(pbuf, frzdep_idx, frzdep, col_type=col_type, copy_if_needed=use_subcol_microp)
+ end if
+
+ if (qsatfac_idx > 0) call pbuf_get_field(pbuf, qsatfac_idx, qsatfac, col_type=col_type, copy_if_needed=use_subcol_microp)
+
+ !-----------------------
+ ! These physics buffer fields are calculated and set in this parameterization
+ ! If subcolumns is turned on, then these fields will be calculated on a subcolumn grid, otherwise they will be a normal grid
+
+ call pbuf_get_field(pbuf, prec_str_idx, prec_str, col_type=col_type)
+ call pbuf_get_field(pbuf, snow_str_idx, snow_str, col_type=col_type)
+ call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw, col_type=col_type)
+ call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw, col_type=col_type)
+ call pbuf_get_field(pbuf, prec_sed_idx, prec_sed, col_type=col_type)
+ call pbuf_get_field(pbuf, snow_sed_idx, snow_sed, col_type=col_type)
+ call pbuf_get_field(pbuf, nevapr_idx, nevapr, col_type=col_type)
+ call pbuf_get_field(pbuf, prer_evap_idx, prer_evap, col_type=col_type)
+ call pbuf_get_field(pbuf, prain_idx, prain, col_type=col_type)
+ call pbuf_get_field(pbuf, dei_idx, dei, col_type=col_type)
+ call pbuf_get_field(pbuf, mu_idx, mu, col_type=col_type)
+ call pbuf_get_field(pbuf, lambdac_idx, lambdac, col_type=col_type)
+ call pbuf_get_field(pbuf, des_idx, des, col_type=col_type)
+ call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc, col_type=col_type)
+ call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw, col_type=col_type)
+ call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc, col_type=col_type)
+ call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw, col_type=col_type)
+ call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq, col_type=col_type)
+ call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice, col_type=col_type)
+ call pbuf_get_field(pbuf, iciwpst_idx, iciwpst, col_type=col_type)
+ call pbuf_get_field(pbuf, iclwpst_idx, iclwpst, col_type=col_type)
+ call pbuf_get_field(pbuf, icswp_idx, icswp, col_type=col_type)
+ call pbuf_get_field(pbuf, rel_idx, rel, col_type=col_type)
+ call pbuf_get_field(pbuf, rei_idx, rei, col_type=col_type)
+ call pbuf_get_field(pbuf, sadice_idx, sadice, col_type=col_type)
+ call pbuf_get_field(pbuf, sadsnow_idx, sadsnow, col_type=col_type)
+ call pbuf_get_field(pbuf, wsedl_idx, wsedl, col_type=col_type)
+ call pbuf_get_field(pbuf, qme_idx, qme, col_type=col_type)
+
+ call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
+ call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
+ call pbuf_get_field(pbuf, cc_t_idx, CC_t, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
+ call pbuf_get_field(pbuf, cc_qv_idx, CC_qv, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
+ call pbuf_get_field(pbuf, cc_ql_idx, CC_ql, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
+ call pbuf_get_field(pbuf, cc_qi_idx, CC_qi, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
+ call pbuf_get_field(pbuf, cc_nl_idx, CC_nl, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
+ call pbuf_get_field(pbuf, cc_ni_idx, CC_ni, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
+ call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst, start=(/1,1,itim_old/), kount=(/psetcols,pver,1/), col_type=col_type)
+
+ if (rate1_cw2pr_st_idx > 0) then
+ call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st, col_type=col_type)
+ end if
+
+ if (qrain_idx > 0) call pbuf_get_field(pbuf, qrain_idx, qrout_grid_ptr)
+ if (qsnow_idx > 0) call pbuf_get_field(pbuf, qsnow_idx, qsout_grid_ptr)
+ if (nrain_idx > 0) call pbuf_get_field(pbuf, nrain_idx, nrout_grid_ptr)
+ if (nsnow_idx > 0) call pbuf_get_field(pbuf, nsnow_idx, nsout_grid_ptr)
+
+ !-----------------------
+ ! If subcolumns is turned on, all calculated fields which are on subcolumns
+ ! need to be retrieved on the grid as well for storing averaged values
+
+ if (use_subcol_microp) then
+ call pbuf_get_field(pbuf, prec_str_idx, prec_str_grid)
+ call pbuf_get_field(pbuf, snow_str_idx, snow_str_grid)
+ call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw_grid)
+ call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw_grid)
+ call pbuf_get_field(pbuf, prec_sed_idx, prec_sed_grid)
+ call pbuf_get_field(pbuf, snow_sed_idx, snow_sed_grid)
+ call pbuf_get_field(pbuf, nevapr_idx, nevapr_grid)
+ call pbuf_get_field(pbuf, prain_idx, prain_grid)
+ call pbuf_get_field(pbuf, dei_idx, dei_grid)
+ call pbuf_get_field(pbuf, mu_idx, mu_grid)
+ call pbuf_get_field(pbuf, lambdac_idx, lambdac_grid)
+ call pbuf_get_field(pbuf, des_idx, des_grid)
+ call pbuf_get_field(pbuf, ls_flxprc_idx, mgflxprc_grid)
+ call pbuf_get_field(pbuf, ls_flxsnw_idx, mgflxsnw_grid)
+ call pbuf_get_field(pbuf, ls_mrprc_idx, mgmrprc_grid)
+ call pbuf_get_field(pbuf, ls_mrsnw_idx, mgmrsnw_grid)
+ call pbuf_get_field(pbuf, cv_reffliq_idx, cvreffliq_grid)
+ call pbuf_get_field(pbuf, cv_reffice_idx, cvreffice_grid)
+ call pbuf_get_field(pbuf, iciwpst_idx, iciwpst_grid)
+ call pbuf_get_field(pbuf, iclwpst_idx, iclwpst_grid)
+ call pbuf_get_field(pbuf, icswp_idx, icswp_grid)
+ call pbuf_get_field(pbuf, rel_idx, rel_grid)
+ call pbuf_get_field(pbuf, rei_idx, rei_grid)
+ call pbuf_get_field(pbuf, sadice_idx, sadice_grid)
+ call pbuf_get_field(pbuf, sadsnow_idx, sadsnow_grid)
+ call pbuf_get_field(pbuf, wsedl_idx, wsedl_grid)
+ call pbuf_get_field(pbuf, qme_idx, qme_grid)
+
+ call pbuf_get_field(pbuf, cldo_idx, cldo_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, cc_t_idx, CC_t_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, cc_qv_idx, CC_qv_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, cc_ql_idx, CC_ql_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, cc_qi_idx, CC_qi_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, cc_nl_idx, CC_nl_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, cc_ni_idx, CC_ni_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, cc_qlst_idx, CC_qlst_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+
+ if (rate1_cw2pr_st_idx > 0) then
+ call pbuf_get_field(pbuf, rate1_cw2pr_st_idx, rate1ord_cw2pr_st_grid)
+ end if
+
+ end if
+
+ !-----------------------
+ ! These are only on the grid regardless of whether subcolumns are turned on or not
+ call pbuf_get_field(pbuf, ls_reffrain_idx, mgreffrain_grid)
+ call pbuf_get_field(pbuf, ls_reffsnow_idx, mgreffsnow_grid)
+ call pbuf_get_field(pbuf, acpr_idx, acprecl_grid)
+ call pbuf_get_field(pbuf, acgcme_idx, acgcme_grid)
+ call pbuf_get_field(pbuf, acnum_idx, acnum_grid)
+ call pbuf_get_field(pbuf, cmeliq_idx, cmeliq_grid)
+ call pbuf_get_field(pbuf, ast_idx, ast_grid, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+
+ call pbuf_get_field(pbuf, evprain_st_idx, evprain_st_grid)
+ call pbuf_get_field(pbuf, evpsnow_st_idx, evpsnow_st_grid)
+ call pbuf_get_field(pbuf, am_evp_st_idx, am_evp_st_grid)
+
+ !-------------------------------------------------------------------------------------
+ ! Microphysics assumes 'liquid stratus frac = ice stratus frac
+ ! = max( liquid stratus frac, ice stratus frac )'.
+ alst_mic => ast
+ aist_mic => ast
+
+ ! Output initial in-cloud LWP (before microphysics)
+
+ iclwpi = 0._r8
+ iciwpi = 0._r8
+
+ do i = 1, ncol
+ do k = top_lev, pver
+ iclwpi(i) = iclwpi(i) + &
+ min(state%q(i,k,ixcldliq) / max(mincld,ast(i,k)),0.005_r8) &
+ * state%pdel(i,k) / gravit
+ iciwpi(i) = iciwpi(i) + &
+ min(state%q(i,k,ixcldice) / max(mincld,ast(i,k)),0.005_r8) &
+ * state%pdel(i,k) / gravit
+ end do
+ end do
+
+ cldo(:ncol,top_lev:pver)=ast(:ncol,top_lev:pver)
+
+ ! Initialize local state from input.
+ call physics_state_copy(state, state_loc)
+
+ ! Because of the of limited vertical resolution, there can be a signifcant
+ ! warm bias at the cold point tropopause, which can create a wet bias in the
+ ! stratosphere. For the microphysics only, update the cold point temperature, with
+ ! an estimate of the coldest point between the model layers.
+ if (micro_mg_adjust_cpt) then
+ cp_rh(:ncol, :pver) = 0._r8
+ cp_dt(:ncol) = 0._r8
+ cp_dz(:ncol) = 0._r8
+
+ call tropopause_find(state_loc, troplev, primary=TROP_ALG_CPP, backup=TROP_ALG_NONE, &
+ tropZ=cp_z, tropT=cp_t)
+
+ do i = 1, ncol
+
+ ! Update statistics and output results.
+ if (troplev(i) .ne. NOTFOUND) then
+ cp_dt(i) = cp_t(i) - state_loc%t(i,troplev(i))
+ cp_dz(i) = cp_z(i) - state_loc%zm(i,troplev(i))
+
+ ! NOTE: This change in temperature is just for the microphysics
+ ! and should not be added to any tendencies or used to update
+ ! any states
+ state_loc%t(i,troplev(i)) = state_loc%t(i,troplev(i)) + cp_dt(i)
+ end if
+ end do
+
+ ! Output all of the statistics related to the cold point
+ ! tropopause adjustment. Th cold point information itself is
+ ! output in tropopause.F90.
+ call outfld("TROPF_TADJ", state_loc%t, pcols, lchnk)
+ call outfld("TROPF_CDT", cp_dt, pcols, lchnk)
+ call outfld("TROPF_CDZ", cp_dz, pcols, lchnk)
+ end if
+
+ ! Initialize ptend for output.
+ lq = .false.
+ lq(1) = .true.
+ lq(ixcldliq) = .true.
+ lq(ixcldice) = .true.
+ lq(ixnumliq) = .true.
+ lq(ixnumice) = .true.
+ if (micro_mg_version > 1) then
+ lq(ixrain) = .true.
+ lq(ixsnow) = .true.
+ lq(ixnumrain) = .true.
+ lq(ixnumsnow) = .true.
+ end if
+
+ ! the name 'cldwat' triggers special tests on cldliq
+ ! and cldice in physics_update
+ call physics_ptend_init(ptend, psetcols, "cldwat", ls=.true., lq=lq)
+
+ packer = MGPacker(psetcols, pver, mgcols, top_lev)
+ post_proc = MGPostProc(packer)
+
+ pckdptr => packed_rate1ord_cw2pr_st ! workaround an apparent pgi compiler bug
+ call post_proc%add_field(p(rate1cld), pckdptr)
+ call post_proc%add_field(p(tlat) , p(packed_tlat))
+ call post_proc%add_field(p(qvlat), p(packed_qvlat))
+ call post_proc%add_field(p(qcten), p(packed_qctend))
+ call post_proc%add_field(p(qiten), p(packed_qitend))
+ call post_proc%add_field(p(ncten), p(packed_nctend))
+ call post_proc%add_field(p(niten), p(packed_nitend))
+
+ if (micro_mg_version > 1) then
+ call post_proc%add_field(p(qrten), p(packed_qrtend))
+ call post_proc%add_field(p(qsten), p(packed_qstend))
+ call post_proc%add_field(p(nrten), p(packed_nrtend))
+ call post_proc%add_field(p(nsten), p(packed_nstend))
+ call post_proc%add_field(p(umr), p(packed_umr))
+ call post_proc%add_field(p(ums), p(packed_ums))
+ call post_proc%add_field(p(cflx), p(packed_cflx))
+ call post_proc%add_field(p(iflx), p(packed_iflx))
+ end if
+
+ call post_proc%add_field(p(am_evp_st), p(packed_am_evp_st))
+
+ call post_proc%add_field(p(prect), p(packed_prect))
+ call post_proc%add_field(p(preci), p(packed_preci))
+ call post_proc%add_field(p(nevapr), p(packed_nevapr))
+ call post_proc%add_field(p(evapsnow), p(packed_evapsnow))
+ call post_proc%add_field(p(prain), p(packed_prain))
+ call post_proc%add_field(p(prodsnow), p(packed_prodsnow))
+ call post_proc%add_field(p(cmeice), p(packed_cmeout))
+ call post_proc%add_field(p(qsout), p(packed_qsout))
+ call post_proc%add_field(p(rflx), p(packed_rflx))
+ call post_proc%add_field(p(sflx), p(packed_sflx))
+ call post_proc%add_field(p(qrout), p(packed_qrout))
+ call post_proc%add_field(p(qcsevap), p(packed_qcsevap))
+ call post_proc%add_field(p(qisevap), p(packed_qisevap))
+ call post_proc%add_field(p(qvres), p(packed_qvres))
+ call post_proc%add_field(p(cmeiout), p(packed_cmei))
+ call post_proc%add_field(p(vtrmc), p(packed_vtrmc))
+ call post_proc%add_field(p(vtrmi), p(packed_vtrmi))
+ call post_proc%add_field(p(qcsedten), p(packed_qcsedten))
+ call post_proc%add_field(p(qisedten), p(packed_qisedten))
+ if (micro_mg_version > 1) then
+ call post_proc%add_field(p(qrsedten), p(packed_qrsedten))
+ call post_proc%add_field(p(qssedten), p(packed_qssedten))
+ end if
+
+ call post_proc%add_field(p(prao), p(packed_pra))
+ call post_proc%add_field(p(prco), p(packed_prc))
+ call post_proc%add_field(p(mnuccco), p(packed_mnuccc))
+ call post_proc%add_field(p(mnuccto), p(packed_mnucct))
+ call post_proc%add_field(p(msacwio), p(packed_msacwi))
+ call post_proc%add_field(p(psacwso), p(packed_psacws))
+ call post_proc%add_field(p(bergso), p(packed_bergs))
+ call post_proc%add_field(p(bergo), p(packed_berg))
+ call post_proc%add_field(p(melto), p(packed_melt))
+ call post_proc%add_field(p(homoo), p(packed_homo))
+ call post_proc%add_field(p(qcreso), p(packed_qcres))
+ call post_proc%add_field(p(prcio), p(packed_prci))
+ call post_proc%add_field(p(praio), p(packed_prai))
+ call post_proc%add_field(p(qireso), p(packed_qires))
+ call post_proc%add_field(p(mnuccro), p(packed_mnuccr))
+ call post_proc%add_field(p(pracso), p(packed_pracs))
+ call post_proc%add_field(p(meltsdt), p(packed_meltsdt))
+ call post_proc%add_field(p(frzrdt), p(packed_frzrdt))
+ call post_proc%add_field(p(mnuccdo), p(packed_mnuccd))
+ call post_proc%add_field(p(nrout), p(packed_nrout))
+ call post_proc%add_field(p(nsout), p(packed_nsout))
+
+ call post_proc%add_field(p(refl), p(packed_refl), fillvalue=-9999._r8)
+ call post_proc%add_field(p(arefl), p(packed_arefl))
+ call post_proc%add_field(p(areflz), p(packed_areflz))
+ call post_proc%add_field(p(frefl), p(packed_frefl))
+ call post_proc%add_field(p(csrfl), p(packed_csrfl), fillvalue=-9999._r8)
+ call post_proc%add_field(p(acsrfl), p(packed_acsrfl))
+ call post_proc%add_field(p(fcsrfl), p(packed_fcsrfl))
+
+ call post_proc%add_field(p(rercld), p(packed_rercld))
+ call post_proc%add_field(p(ncai), p(packed_ncai))
+ call post_proc%add_field(p(ncal), p(packed_ncal))
+ call post_proc%add_field(p(qrout2), p(packed_qrout2))
+ call post_proc%add_field(p(qsout2), p(packed_qsout2))
+ call post_proc%add_field(p(nrout2), p(packed_nrout2))
+ call post_proc%add_field(p(nsout2), p(packed_nsout2))
+ call post_proc%add_field(p(freqs), p(packed_freqs))
+ call post_proc%add_field(p(freqr), p(packed_freqr))
+ call post_proc%add_field(p(nfice), p(packed_nfice))
+ if (micro_mg_version /= 1) then
+ call post_proc%add_field(p(qcrat), p(packed_qcrat), fillvalue=1._r8)
+ end if
+
+!AL
+ call post_proc%add_field(p(nnuccco), p(packed_nnuccco))
+ call post_proc%add_field(p(nnuccto), p(packed_nnuccto))
+ call post_proc%add_field(p(npsacwso), p(packed_npsacwso))
+ call post_proc%add_field(p(nsubco), p(packed_nsubco))
+ call post_proc%add_field(p(nprao), p(packed_nprao))
+ call post_proc%add_field(p(nprc1o), p(packed_nprc1o))
+ call post_proc%add_field(p(nqcsedten), p(packed_nqcsedten))
+ call post_proc%add_field(p(nqisedten), p(packed_nqisedten))
+ call post_proc%add_field(p(nmelto), p(packed_nmelto))
+ call post_proc%add_field(p(nhomoo), p(packed_nhomoo))
+ call post_proc%add_field(p(nimelto), p(packed_nimelto))
+ call post_proc%add_field(p(nihomoo), p(packed_nihomoo))
+ call post_proc%add_field(p(nsacwio), p(packed_nsacwio))
+ call post_proc%add_field(p(nsubio), p(packed_nsubio))
+ call post_proc%add_field(p(nprcio), p(packed_nprcio))
+ call post_proc%add_field(p(npraio), p(packed_npraio))
+ call post_proc%add_field(p(nnudepo), p(packed_nnudepo))
+ call post_proc%add_field(p(npccno), p(packed_npccno))
+ call post_proc%add_field(p(nnuccdo), p(packed_nnuccdo))
+ call post_proc%add_field(p(mnudepo), p(packed_mnudepo))
+ call post_proc%add_field(p(nctncons), p(packed_nctncons))
+ call post_proc%add_field(p(nctnnbmn), p(packed_nctnnbmn))
+ call post_proc%add_field(p(nctnszmn), p(packed_nctnszmn))
+ call post_proc%add_field(p(nctnszmx), p(packed_nctnszmx))
+ call post_proc%add_field(p(nctnncld), p(packed_nctnncld))
+ call post_proc%add_field(p(nitncons), p(packed_nitncons))
+ call post_proc%add_field(p(nitnszmn), p(packed_nitnszmn))
+ call post_proc%add_field(p(nitnszmx), p(packed_nitnszmx))
+ call post_proc%add_field(p(nitnncld), p(packed_nitnncld))
+ call post_proc%add_field(p(frzr), p(packed_frzr))
+ call post_proc%add_field(p(nfrzr), p(packed_nfrzr))
+ call post_proc%add_field(p(mnuccri), p(packed_mnuccri))
+ call post_proc%add_field(p(nnuccri), p(packed_nnuccri))
+!AL
+
+ ! The following are all variables related to sizes, where it does not
+ ! necessarily make sense to average over time steps. Instead, we keep
+ ! the value from the last substep, which is what "accum_null" does.
+ call post_proc%add_field(p(rel), p(packed_rel), &
+ fillvalue=10._r8, accum_method=accum_null)
+ call post_proc%add_field(p(rei), p(packed_rei), &
+ fillvalue=25._r8, accum_method=accum_null)
+ call post_proc%add_field(p(sadice), p(packed_sadice), &
+ accum_method=accum_null)
+ call post_proc%add_field(p(sadsnow), p(packed_sadsnow), &
+ accum_method=accum_null)
+ call post_proc%add_field(p(lambdac), p(packed_lambdac), &
+ accum_method=accum_null)
+ call post_proc%add_field(p(mu), p(packed_mu), &
+ accum_method=accum_null)
+ call post_proc%add_field(p(des), p(packed_des), &
+ accum_method=accum_null)
+ call post_proc%add_field(p(dei), p(packed_dei), &
+ accum_method=accum_null)
+ call post_proc%add_field(p(prer_evap), p(packed_prer_evap), &
+ accum_method=accum_null)
+
+ ! Pack input variables that are not updated during substeps.
+ packed_relvar = packer%pack(relvar)
+ packed_accre_enhan = packer%pack(accre_enhan)
+
+ packed_p = packer%pack(state_loc%pmid)
+ packed_pdel = packer%pack(state_loc%pdel)
+
+ packed_cldn = packer%pack(ast)
+ packed_liqcldf = packer%pack(alst_mic)
+ packed_icecldf = packer%pack(aist_mic)
+ allocate(packed_qsatfac(mgncol,nlev))
+ if (qsatfac_idx > 0) then
+ packed_qsatfac = packer%pack(qsatfac)
+ else
+ packed_qsatfac = 1._r8
+ endif
+ packed_naai = packer%pack(naai)
+ packed_npccn = packer%pack(npccn)
+
+ allocate(packed_rndst(mgncol,nlev,size(rndst, 3)))
+ packed_rndst = packer%pack(rndst)
+
+ allocate(packed_nacon(mgncol,nlev,size(nacon, 3)))
+ packed_nacon = packer%pack(nacon)
+
+ if (.not. do_cldice) then
+ packed_tnd_qsnow = packer%pack(tnd_qsnow)
+ packed_tnd_nsnow = packer%pack(tnd_nsnow)
+ packed_re_ice = packer%pack(re_ice)
+ end if
+
+ if (use_hetfrz_classnuc) then
+ packed_frzimm = packer%pack(frzimm)
+ packed_frzcnt = packer%pack(frzcnt)
+ packed_frzdep = packer%pack(frzdep)
+ end if
+
+ do it = 1, num_steps
+
+ ! Pack input variables that are updated during substeps.
+ packed_t = packer%pack(state_loc%t)
+ packed_q = packer%pack(state_loc%q(:,:,1))
+ packed_qc = packer%pack(state_loc%q(:,:,ixcldliq))
+ packed_nc = packer%pack(state_loc%q(:,:,ixnumliq))
+ packed_qi = packer%pack(state_loc%q(:,:,ixcldice))
+ packed_ni = packer%pack(state_loc%q(:,:,ixnumice))
+ if (micro_mg_version > 1) then
+ packed_qr = packer%pack(state_loc%q(:,:,ixrain))
+ packed_nr = packer%pack(state_loc%q(:,:,ixnumrain))
+ packed_qs = packer%pack(state_loc%q(:,:,ixsnow))
+ packed_ns = packer%pack(state_loc%q(:,:,ixnumsnow))
+ end if
+
+ select case (micro_mg_version)
+ case (1)
+ select case (micro_mg_sub_version)
+ case (0)
+ call micro_mg_tend1_0( &
+ microp_uniform, mgncol, nlev, mgncol, 1, dtime/num_steps, &
+ packed_t, packed_q, packed_qc, packed_qi, packed_nc, &
+ packed_ni, packed_p, packed_pdel, packed_cldn, packed_liqcldf,&
+ packed_relvar, packed_accre_enhan, &
+ packed_icecldf, packed_rate1ord_cw2pr_st, packed_naai, packed_npccn, &
+ packed_rndst, packed_nacon, packed_tlat, packed_qvlat, packed_qctend, &
+ packed_qitend, packed_nctend, packed_nitend, packed_rel, rel_fn_dum, &
+ packed_rei, packed_prect, packed_preci, packed_nevapr, packed_evapsnow, packed_am_evp_st, &
+ packed_prain, packed_prodsnow, packed_cmeout, packed_dei, packed_mu, &
+ packed_lambdac, packed_qsout, packed_des, packed_rflx, packed_sflx, &
+ packed_qrout, reff_rain_dum, reff_snow_dum, packed_qcsevap, packed_qisevap, &
+ packed_qvres, packed_cmei, packed_vtrmc, packed_vtrmi, packed_qcsedten, &
+ packed_qisedten, packed_pra, packed_prc, packed_mnuccc, packed_mnucct, &
+ packed_msacwi, packed_psacws, packed_bergs, packed_berg, packed_melt, &
+ packed_homo, packed_qcres, packed_prci, packed_prai, packed_qires, &
+ packed_mnuccr, packed_pracs, packed_meltsdt, packed_frzrdt, packed_mnuccd, &
+ packed_nrout, packed_nsout, packed_refl, packed_arefl, packed_areflz, &
+ packed_frefl, packed_csrfl, packed_acsrfl, packed_fcsrfl, packed_rercld, &
+ packed_ncai, packed_ncal, packed_qrout2, packed_qsout2, packed_nrout2, &
+ packed_nsout2, drout_dum, dsout2_dum, packed_freqs,packed_freqr, &
+ packed_nfice, packed_prer_evap, do_cldice, errstring, &
+ packed_tnd_qsnow, packed_tnd_nsnow, packed_re_ice, &
+ packed_frzimm, packed_frzcnt, packed_frzdep, &
+!AL
+ packed_nnuccco, packed_nnuccto, packed_npsacwso, packed_nsubco, packed_nprao, &
+ packed_nprc1o, packed_nqcsedten, packed_nqisedten, packed_nmelto, packed_nhomoo, &
+ packed_nimelto, packed_nihomoo, packed_nsacwio, packed_nsubio, packed_nprcio, &
+ packed_npraio, packed_nnudepo, packed_npccno, packed_nnuccdo, packed_mnudepo, &
+ packed_nctncons, packed_nctnnbmn, packed_nctnszmn, &
+ packed_nctnszmx, packed_nctnncld, packed_nitncons, packed_nitnszmn, &
+ packed_nitnszmx, packed_nitnncld)
+
+
+!AL
+
+ end select
+ case(2)
+ select case (micro_mg_sub_version)
+ case (0)
+
+ call micro_mg_tend2_0( &
+ mgncol, nlev, dtime/num_steps,&
+ packed_t, packed_q, &
+ packed_qc, packed_qi, &
+ packed_nc, packed_ni, &
+ packed_qr, packed_qs, &
+ packed_nr, packed_ns, &
+ packed_relvar, packed_accre_enhan, &
+ packed_p, packed_pdel, &
+ packed_cldn, packed_liqcldf, packed_icecldf, packed_qsatfac, &
+ packed_rate1ord_cw2pr_st, &
+ packed_naai, packed_npccn, &
+ packed_rndst, packed_nacon, &
+ packed_tlat, packed_qvlat, &
+ packed_qctend, packed_qitend, &
+ packed_nctend, packed_nitend, &
+ packed_qrtend, packed_qstend, &
+ packed_nrtend, packed_nstend, &
+ packed_rel, rel_fn_dum, packed_rei, &
+ packed_sadice, packed_sadsnow, &
+ packed_prect, packed_preci, &
+ packed_nevapr, packed_evapsnow, &
+ packed_am_evp_st, &
+ packed_prain, packed_prodsnow, &
+ packed_cmeout, packed_dei, &
+ packed_mu, packed_lambdac, &
+ packed_qsout, packed_des, &
+ packed_cflx, packed_iflx, &
+ packed_rflx, packed_sflx, packed_qrout, &
+ reff_rain_dum, reff_snow_dum, &
+ packed_qcsevap, packed_qisevap, packed_qvres, &
+ packed_cmei, packed_vtrmc, packed_vtrmi, &
+ packed_umr, packed_ums, &
+ packed_qcsedten, packed_qisedten, &
+ packed_qrsedten, packed_qssedten, &
+ packed_pra, packed_prc, &
+ packed_mnuccc, packed_mnucct, packed_msacwi, &
+ packed_psacws, packed_bergs, packed_berg, &
+ packed_melt, packed_homo, &
+ packed_qcres, packed_prci, packed_prai, &
+ packed_qires, packed_mnuccr, packed_pracs, &
+ packed_meltsdt, packed_frzrdt, packed_mnuccd, &
+ packed_nrout, packed_nsout, &
+ packed_refl, packed_arefl, packed_areflz, &
+ packed_frefl, packed_csrfl, packed_acsrfl, &
+ packed_fcsrfl, packed_rercld, &
+ packed_ncai, packed_ncal, &
+ packed_qrout2, packed_qsout2, &
+ packed_nrout2, packed_nsout2, &
+ drout_dum, dsout2_dum, &
+ packed_freqs, packed_freqr, &
+ packed_nfice, packed_qcrat, &
+ errstring, &
+!AL right names?
+ packed_nnuccco, packed_nnuccto, &
+ packed_npsacwso, packed_nsubco, packed_nprao, &
+ packed_nprc1o, packed_nqcsedten, &
+ packed_nqisedten, packed_nmelto, packed_nhomoo, &
+ packed_nimelto, packed_nihomoo, packed_nsacwio, &
+ packed_nsubio, packed_nprcio, &
+ packed_npraio, packed_nnudepo, &
+ packed_npccno, packed_nnuccdo, packed_mnudepo, &
+ packed_frzr,packed_nfrzr, &
+ packed_nnuccri, packed_mnuccri, &
+ packed_nctnszmx,packed_nctnszmn, &
+ packed_nctnncld, packed_nitncons, &
+ packed_nitnszmx, packed_nitnszmn, packed_nitnncld, &
+!AL
+ packed_tnd_qsnow,packed_tnd_nsnow,packed_re_ice,&
+ packed_prer_evap, &
+ packed_frzimm, packed_frzcnt, packed_frzdep )
+ end select
+ end select
+
+ call handle_errmsg(errstring, subname="micro_mg_tend")
+
+ call physics_ptend_init(ptend_loc, psetcols, "micro_mg", &
+ ls=.true., lq=lq)
+
+ ! Set local tendency.
+ ptend_loc%s = packer%unpack(packed_tlat, 0._r8)
+ ptend_loc%q(:,:,1) = packer%unpack(packed_qvlat, 0._r8)
+ ptend_loc%q(:,:,ixcldliq) = packer%unpack(packed_qctend, 0._r8)
+ ptend_loc%q(:,:,ixcldice) = packer%unpack(packed_qitend, 0._r8)
+ ptend_loc%q(:,:,ixnumliq) = packer%unpack(packed_nctend, &
+ -state_loc%q(:,:,ixnumliq)/(dtime/num_steps))
+ if (do_cldice) then
+ ptend_loc%q(:,:,ixnumice) = packer%unpack(packed_nitend, &
+ -state_loc%q(:,:,ixnumice)/(dtime/num_steps))
+ else
+ ! In this case, the tendency should be all 0.
+ if (any(packed_nitend /= 0._r8)) &
+ call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// &
+ " but micro_mg_tend has ice number tendencies.")
+ ptend_loc%q(:,:,ixnumice) = 0._r8
+ end if
+
+ if (micro_mg_version > 1) then
+ ptend_loc%q(:,:,ixrain) = packer%unpack(packed_qrtend, 0._r8)
+ ptend_loc%q(:,:,ixsnow) = packer%unpack(packed_qstend, 0._r8)
+ ptend_loc%q(:,:,ixnumrain) = packer%unpack(packed_nrtend, &
+ -state_loc%q(:,:,ixnumrain)/(dtime/num_steps))
+ ptend_loc%q(:,:,ixnumsnow) = packer%unpack(packed_nstend, &
+ -state_loc%q(:,:,ixnumsnow)/(dtime/num_steps))
+ end if
+
+ ! Sum into overall ptend
+ call physics_ptend_sum(ptend_loc, ptend, ncol)
+
+ ! Update local state
+ call physics_update(state_loc, ptend_loc, dtime/num_steps)
+
+ ! Sum all outputs for averaging.
+ call post_proc%accumulate()
+
+ end do
+
+ ! Divide ptend by substeps.
+ call physics_ptend_scale(ptend, 1._r8/num_steps, ncol)
+
+ ! Use summed outputs to produce averages
+ call post_proc%process_and_unpack()
+
+ call post_proc%finalize()
+
+ ! Check to make sure that the microphysics code is respecting the flags that control
+ ! whether MG should be prognosing cloud ice and cloud liquid or not.
+ if (.not. do_cldice) then
+ if (any(ptend%q(:ncol,top_lev:pver,ixcldice) /= 0.0_r8)) &
+ call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// &
+ " but micro_mg_tend has ice mass tendencies.")
+ if (any(ptend%q(:ncol,top_lev:pver,ixnumice) /= 0.0_r8)) &
+ call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud ice,"// &
+ " but micro_mg_tend has ice number tendencies.")
+ end if
+ if (.not. do_cldliq) then
+ if (any(ptend%q(:ncol,top_lev:pver,ixcldliq) /= 0.0_r8)) &
+ call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// &
+ " but micro_mg_tend has liquid mass tendencies.")
+ if (any(ptend%q(:ncol,top_lev:pver,ixnumliq) /= 0.0_r8)) &
+ call endrun("micro_mg_cam:ERROR - MG microphysics is configured not to prognose cloud liquid,"// &
+ " but micro_mg_tend has liquid number tendencies.")
+ end if
+
+ mnuccdohet = 0._r8
+ do k=top_lev,pver
+ do i=1,ncol
+ if (naai(i,k) > 0._r8) then
+ mnuccdohet(i,k) = mnuccdo(i,k) - (naai_hom(i,k)/naai(i,k))*mnuccdo(i,k)
+ end if
+ end do
+ end do
+
+ mgflxprc(:ncol,top_lev:pverp) = rflx(:ncol,top_lev:pverp) + sflx(:ncol,top_lev:pverp)
+ mgflxsnw(:ncol,top_lev:pverp) = sflx(:ncol,top_lev:pverp)
+
+ !add condensate fluxes for MG2 (ice and snow already added for MG1)
+ if (micro_mg_version >= 2) then
+ mgflxprc(:ncol,top_lev:pverp) = mgflxprc(:ncol,top_lev:pverp)+ iflx(:ncol,top_lev:pverp) + cflx(:ncol,top_lev:pverp)
+ mgflxsnw(:ncol,top_lev:pverp) = mgflxsnw(:ncol,top_lev:pverp) + iflx(:ncol,top_lev:pverp)
+ end if
+
+
+ mgmrprc(:ncol,top_lev:pver) = qrout(:ncol,top_lev:pver) + qsout(:ncol,top_lev:pver)
+ mgmrsnw(:ncol,top_lev:pver) = qsout(:ncol,top_lev:pver)
+
+ !! calculate effective radius of convective liquid and ice using dcon and deicon (not used by code, not useful for COSP)
+ !! hard-coded as average of hard-coded values used for deep/shallow convective detrainment (near line 1502/1505)
+ cvreffliq(:ncol,top_lev:pver) = 9.0_r8
+ cvreffice(:ncol,top_lev:pver) = 37.0_r8
+
+ ! Reassign rate1 if modal aerosols
+ if (rate1_cw2pr_st_idx > 0) then
+ rate1ord_cw2pr_st(:ncol,top_lev:pver) = rate1cld(:ncol,top_lev:pver)
+ end if
+
+ ! Sedimentation velocity for liquid stratus cloud droplet
+ wsedl(:ncol,top_lev:pver) = vtrmc(:ncol,top_lev:pver)
+
+ ! Microphysical tendencies for use in the macrophysics at the next time step
+ CC_T(:ncol,top_lev:pver) = tlat(:ncol,top_lev:pver)/cpair
+ CC_qv(:ncol,top_lev:pver) = qvlat(:ncol,top_lev:pver)
+ CC_ql(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver)
+ CC_qi(:ncol,top_lev:pver) = qiten(:ncol,top_lev:pver)
+ CC_nl(:ncol,top_lev:pver) = ncten(:ncol,top_lev:pver)
+ CC_ni(:ncol,top_lev:pver) = niten(:ncol,top_lev:pver)
+ CC_qlst(:ncol,top_lev:pver) = qcten(:ncol,top_lev:pver)/max(0.01_r8,alst_mic(:ncol,top_lev:pver))
+
+ ! Net micro_mg_cam condensation rate
+ qme(:ncol,:top_lev-1) = 0._r8
+ qme(:ncol,top_lev:pver) = cmeliq(:ncol,top_lev:pver) + cmeiout(:ncol,top_lev:pver)
+
+ ! For precip, accumulate only total precip in prec_pcw and snow_pcw variables.
+ ! Other precip output variables are set to 0
+ ! Do not subscript by ncol here, because in physpkg we divide the whole
+ ! array and need to avoid an FPE due to uninitialized data.
+ prec_pcw = prect
+ snow_pcw = preci
+ prec_sed = 0._r8
+ snow_sed = 0._r8
+ prec_str = prec_pcw + prec_sed
+ snow_str = snow_pcw + snow_sed
+
+ icecldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver)
+ liqcldf(:ncol,top_lev:pver) = ast(:ncol,top_lev:pver)
+
+ ! ------------------------------------------------------------ !
+ ! Compute in cloud ice and liquid mixing ratios !
+ ! Note that 'iclwp, iciwp' are used for radiation computation. !
+ ! ------------------------------------------------------------ !
+
+ icinc = 0._r8
+ icwnc = 0._r8
+ iciwpst = 0._r8
+ iclwpst = 0._r8
+ icswp = 0._r8
+ cldfsnow = 0._r8
+
+ do k = top_lev, pver
+ do i = 1, ncol
+ ! Limits for in-cloud mixing ratios consistent with MG microphysics
+ ! in-cloud mixing ratio maximum limit of 0.005 kg/kg
+ icimrst(i,k) = min( state_loc%q(i,k,ixcldice) / max(mincld,icecldf(i,k)),0.005_r8 )
+ icwmrst(i,k) = min( state_loc%q(i,k,ixcldliq) / max(mincld,liqcldf(i,k)),0.005_r8 )
+ icinc(i,k) = state_loc%q(i,k,ixnumice) / max(mincld,icecldf(i,k)) * &
+ state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k))
+ icwnc(i,k) = state_loc%q(i,k,ixnumliq) / max(mincld,liqcldf(i,k)) * &
+ state_loc%pmid(i,k) / (287.15_r8*state_loc%t(i,k))
+ ! Calculate micro_mg_cam cloud water paths in each layer
+ ! Note: uses stratiform cloud fraction!
+ iciwpst(i,k) = min(state_loc%q(i,k,ixcldice)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit
+ iclwpst(i,k) = min(state_loc%q(i,k,ixcldliq)/max(mincld,ast(i,k)),0.005_r8) * state_loc%pdel(i,k) / gravit
+
+ ! ------------------------------ !
+ ! Adjust cloud fraction for snow !
+ ! ------------------------------ !
+ cldfsnow(i,k) = cld(i,k)
+ ! If cloud and only ice ( no convective cloud or ice ), then set to 0.
+ if( ( cldfsnow(i,k) .gt. 1.e-4_r8 ) .and. &
+ ( concld(i,k) .lt. 1.e-4_r8 ) .and. &
+ ( state_loc%q(i,k,ixcldliq) .lt. 1.e-10_r8 ) ) then
+ cldfsnow(i,k) = 0._r8
+ end if
+ ! If no cloud and snow, then set to 0.25
+ if( ( cldfsnow(i,k) .le. 1.e-4_r8 ) .and. ( qsout(i,k) .gt. 1.e-6_r8 ) ) then
+ cldfsnow(i,k) = 0.25_r8
+ end if
+ ! Calculate in-cloud snow water path
+ icswp(i,k) = qsout(i,k) / max( mincld, cldfsnow(i,k) ) * state_loc%pdel(i,k) / gravit
+ end do
+ end do
+
+ ! Calculate cloud fraction for prognostic precip sizes.
+ if (micro_mg_version > 1) then
+ ! Cloud fraction for purposes of precipitation is maximum cloud
+ ! fraction out of all the layers that the precipitation may be
+ ! falling down from.
+ cldmax(:ncol,:) = max(mincld, ast(:ncol,:))
+ do k = top_lev+1, pver
+ where (state_loc%q(:ncol,k-1,ixrain) >= qsmall .or. &
+ state_loc%q(:ncol,k-1,ixsnow) >= qsmall)
+ cldmax(:ncol,k) = max(cldmax(:ncol,k-1), cldmax(:ncol,k))
+ end where
+ end do
+ end if
+
+ ! ------------------------------------------------------ !
+ ! ------------------------------------------------------ !
+ ! All code from here to the end is on grid columns only !
+ ! ------------------------------------------------------ !
+ ! ------------------------------------------------------ !
+
+ ! Average the fields which are needed later in this paramterization to be on the grid
+ if (use_subcol_microp) then
+ call subcol_field_avg(prec_str, ngrdcol, lchnk, prec_str_grid)
+ call subcol_field_avg(iclwpst, ngrdcol, lchnk, iclwpst_grid)
+ call subcol_field_avg(cvreffliq, ngrdcol, lchnk, cvreffliq_grid)
+ call subcol_field_avg(cvreffice, ngrdcol, lchnk, cvreffice_grid)
+ call subcol_field_avg(mgflxprc, ngrdcol, lchnk, mgflxprc_grid)
+ call subcol_field_avg(mgflxsnw, ngrdcol, lchnk, mgflxsnw_grid)
+ call subcol_field_avg(qme, ngrdcol, lchnk, qme_grid)
+ call subcol_field_avg(nevapr, ngrdcol, lchnk, nevapr_grid)
+ call subcol_field_avg(prain, ngrdcol, lchnk, prain_grid)
+ call subcol_field_avg(evapsnow, ngrdcol, lchnk, evpsnow_st_grid)
+
+ call subcol_field_avg(am_evp_st, ngrdcol, lchnk, am_evp_st_grid)
+
+ ! Average fields which are not in pbuf
+ call subcol_field_avg(qrout, ngrdcol, lchnk, qrout_grid)
+ call subcol_field_avg(qsout, ngrdcol, lchnk, qsout_grid)
+ call subcol_field_avg(nsout, ngrdcol, lchnk, nsout_grid)
+ call subcol_field_avg(nrout, ngrdcol, lchnk, nrout_grid)
+ call subcol_field_avg(cld, ngrdcol, lchnk, cld_grid)
+ call subcol_field_avg(qcreso, ngrdcol, lchnk, qcreso_grid)
+ call subcol_field_avg(melto, ngrdcol, lchnk, melto_grid)
+ call subcol_field_avg(mnuccco, ngrdcol, lchnk, mnuccco_grid)
+ call subcol_field_avg(mnuccto, ngrdcol, lchnk, mnuccto_grid)
+ call subcol_field_avg(bergo, ngrdcol, lchnk, bergo_grid)
+ call subcol_field_avg(homoo, ngrdcol, lchnk, homoo_grid)
+ call subcol_field_avg(msacwio, ngrdcol, lchnk, msacwio_grid)
+ call subcol_field_avg(psacwso, ngrdcol, lchnk, psacwso_grid)
+ call subcol_field_avg(bergso, ngrdcol, lchnk, bergso_grid)
+ call subcol_field_avg(cmeiout, ngrdcol, lchnk, cmeiout_grid)
+ call subcol_field_avg(qireso, ngrdcol, lchnk, qireso_grid)
+ call subcol_field_avg(prcio, ngrdcol, lchnk, prcio_grid)
+ call subcol_field_avg(praio, ngrdcol, lchnk, praio_grid)
+ call subcol_field_avg(icwmrst, ngrdcol, lchnk, icwmrst_grid)
+ call subcol_field_avg(icimrst, ngrdcol, lchnk, icimrst_grid)
+ call subcol_field_avg(liqcldf, ngrdcol, lchnk, liqcldf_grid)
+ call subcol_field_avg(icecldf, ngrdcol, lchnk, icecldf_grid)
+ call subcol_field_avg(icwnc, ngrdcol, lchnk, icwnc_grid)
+ call subcol_field_avg(icinc, ngrdcol, lchnk, icinc_grid)
+ call subcol_field_avg(state_loc%pdel, ngrdcol, lchnk, pdel_grid)
+ call subcol_field_avg(prao, ngrdcol, lchnk, prao_grid)
+ call subcol_field_avg(prco, ngrdcol, lchnk, prco_grid)
+
+ call subcol_field_avg(state_loc%q(:,:,ixnumliq), ngrdcol, lchnk, nc_grid)
+ call subcol_field_avg(state_loc%q(:,:,ixnumice), ngrdcol, lchnk, ni_grid)
+
+ if (micro_mg_version > 1) then
+ call subcol_field_avg(cldmax, ngrdcol, lchnk, cldmax_grid)
+
+ call subcol_field_avg(state_loc%q(:,:,ixrain), ngrdcol, lchnk, qr_grid)
+ call subcol_field_avg(state_loc%q(:,:,ixnumrain), ngrdcol, lchnk, nr_grid)
+ call subcol_field_avg(state_loc%q(:,:,ixsnow), ngrdcol, lchnk, qs_grid)
+ call subcol_field_avg(state_loc%q(:,:,ixnumsnow), ngrdcol, lchnk, ns_grid)
+ end if
+
+ else
+ ! These pbuf fields need to be assigned. There is no corresponding subcol_field_avg
+ ! as they are reset before being used, so it would be a needless calculation
+ lambdac_grid => lambdac
+ mu_grid => mu
+ rel_grid => rel
+ rei_grid => rei
+ sadice_grid => sadice
+ sadsnow_grid => sadsnow
+ dei_grid => dei
+ des_grid => des
+
+ ! fields already on grids, so just assign
+ prec_str_grid => prec_str
+ iclwpst_grid => iclwpst
+ cvreffliq_grid => cvreffliq
+ cvreffice_grid => cvreffice
+ mgflxprc_grid => mgflxprc
+ mgflxsnw_grid => mgflxsnw
+ qme_grid => qme
+ nevapr_grid => nevapr
+ prain_grid => prain
+
+ am_evp_st_grid = am_evp_st
+
+ evpsnow_st_grid = evapsnow
+ qrout_grid = qrout
+ qsout_grid = qsout
+ nsout_grid = nsout
+ nrout_grid = nrout
+ cld_grid = cld
+ qcreso_grid = qcreso
+ melto_grid = melto
+ mnuccco_grid = mnuccco
+ mnuccto_grid = mnuccto
+ bergo_grid = bergo
+ homoo_grid = homoo
+ msacwio_grid = msacwio
+ psacwso_grid = psacwso
+ bergso_grid = bergso
+ cmeiout_grid = cmeiout
+ qireso_grid = qireso
+ prcio_grid = prcio
+ praio_grid = praio
+ icwmrst_grid = icwmrst
+ icimrst_grid = icimrst
+ liqcldf_grid = liqcldf
+ icecldf_grid = icecldf
+ icwnc_grid = icwnc
+ icinc_grid = icinc
+ pdel_grid = state_loc%pdel
+ prao_grid = prao
+ prco_grid = prco
+
+ nc_grid = state_loc%q(:,:,ixnumliq)
+ ni_grid = state_loc%q(:,:,ixnumice)
+
+ if (micro_mg_version > 1) then
+ cldmax_grid = cldmax
+
+ qr_grid = state_loc%q(:,:,ixrain)
+ nr_grid = state_loc%q(:,:,ixnumrain)
+ qs_grid = state_loc%q(:,:,ixsnow)
+ ns_grid = state_loc%q(:,:,ixnumsnow)
+ end if
+
+ end if
+
+ ! If on subcolumns, average the rest of the pbuf fields which were modified on subcolumns but are not used further in
+ ! this parameterization (no need to assign in the non-subcolumn case -- the else step)
+ if (use_subcol_microp) then
+ call subcol_field_avg(snow_str, ngrdcol, lchnk, snow_str_grid)
+ call subcol_field_avg(prec_pcw, ngrdcol, lchnk, prec_pcw_grid)
+ call subcol_field_avg(snow_pcw, ngrdcol, lchnk, snow_pcw_grid)
+ call subcol_field_avg(prec_sed, ngrdcol, lchnk, prec_sed_grid)
+ call subcol_field_avg(snow_sed, ngrdcol, lchnk, snow_sed_grid)
+ call subcol_field_avg(cldo, ngrdcol, lchnk, cldo_grid)
+ call subcol_field_avg(mgmrprc, ngrdcol, lchnk, mgmrprc_grid)
+ call subcol_field_avg(mgmrsnw, ngrdcol, lchnk, mgmrsnw_grid)
+ call subcol_field_avg(wsedl, ngrdcol, lchnk, wsedl_grid)
+ call subcol_field_avg(cc_t, ngrdcol, lchnk, cc_t_grid)
+ call subcol_field_avg(cc_qv, ngrdcol, lchnk, cc_qv_grid)
+ call subcol_field_avg(cc_ql, ngrdcol, lchnk, cc_ql_grid)
+ call subcol_field_avg(cc_qi, ngrdcol, lchnk, cc_qi_grid)
+ call subcol_field_avg(cc_nl, ngrdcol, lchnk, cc_nl_grid)
+ call subcol_field_avg(cc_ni, ngrdcol, lchnk, cc_ni_grid)
+ call subcol_field_avg(cc_qlst, ngrdcol, lchnk, cc_qlst_grid)
+ call subcol_field_avg(iciwpst, ngrdcol, lchnk, iciwpst_grid)
+ call subcol_field_avg(icswp, ngrdcol, lchnk, icswp_grid)
+ call subcol_field_avg(cldfsnow, ngrdcol, lchnk, cldfsnow_grid)
+
+ if (rate1_cw2pr_st_idx > 0) then
+ call subcol_field_avg(rate1ord_cw2pr_st, ngrdcol, lchnk, rate1ord_cw2pr_st_grid)
+ end if
+
+ end if
+
+ ! ------------------------------------- !
+ ! Size distribution calculation !
+ ! ------------------------------------- !
+
+ ! Calculate rho (on subcolumns if turned on) for size distribution
+ ! parameter calculations and average it if needed
+ !
+ ! State instead of state_loc to preserve answers for MG1 (and in any
+ ! case, it is unlikely to make much difference).
+ rho(:ncol,top_lev:) = state%pmid(:ncol,top_lev:) / &
+ (rair*state%t(:ncol,top_lev:))
+ if (use_subcol_microp) then
+ call subcol_field_avg(rho, ngrdcol, lchnk, rho_grid)
+ else
+ rho_grid = rho
+ end if
+
+ ! Effective radius for cloud liquid, fixed number.
+ mu_grid = 0._r8
+ lambdac_grid = 0._r8
+ rel_fn_grid = 10._r8
+
+ ncic_grid = 1.e8_r8
+
+ call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,top_lev:), &
+ ncic_grid(:ngrdcol,top_lev:), rho_grid(:ngrdcol,top_lev:), &
+ mu_grid(:ngrdcol,top_lev:), lambdac_grid(:ngrdcol,top_lev:))
+
+ where (icwmrst_grid(:ngrdcol,top_lev:) > qsmall)
+ rel_fn_grid(:ngrdcol,top_lev:) = &
+ (mu_grid(:ngrdcol,top_lev:) + 3._r8)/ &
+ lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8
+ end where
+
+ ! Effective radius for cloud liquid, and size parameters
+ ! mu_grid and lambdac_grid.
+ mu_grid = 0._r8
+ lambdac_grid = 0._r8
+ rel_grid = 10._r8
+
+ ! Calculate ncic on the grid
+ ncic_grid(:ngrdcol,top_lev:) = nc_grid(:ngrdcol,top_lev:) / &
+ max(mincld,liqcldf_grid(:ngrdcol,top_lev:))
+
+ call size_dist_param_liq(mg_liq_props, icwmrst_grid(:ngrdcol,top_lev:), &
+ ncic_grid(:ngrdcol,top_lev:), rho_grid(:ngrdcol,top_lev:), &
+ mu_grid(:ngrdcol,top_lev:), lambdac_grid(:ngrdcol,top_lev:))
+
+ where (icwmrst_grid(:ngrdcol,top_lev:) >= qsmall)
+ rel_grid(:ngrdcol,top_lev:) = &
+ (mu_grid(:ngrdcol,top_lev:) + 3._r8) / &
+ lambdac_grid(:ngrdcol,top_lev:)/2._r8 * 1.e6_r8
+ elsewhere
+ ! Deal with the fact that size_dist_param_liq sets mu_grid to -100
+ ! wherever there is no cloud.
+ mu_grid(:ngrdcol,top_lev:) = 0._r8
+ end where
+
+ ! Rain/Snow effective diameter.
+ drout2_grid = 0._r8
+ reff_rain_grid = 0._r8
+ des_grid = 0._r8
+ dsout2_grid = 0._r8
+ reff_snow_grid = 0._r8
+
+ if (micro_mg_version > 1) then
+ ! Prognostic precipitation
+
+ where (qr_grid(:ngrdcol,top_lev:) >= 1.e-7_r8)
+ drout2_grid(:ngrdcol,top_lev:) = avg_diameter( &
+ qr_grid(:ngrdcol,top_lev:), &
+ nr_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), &
+ rho_grid(:ngrdcol,top_lev:), rhow)
+
+ reff_rain_grid(:ngrdcol,top_lev:) = drout2_grid(:ngrdcol,top_lev:) * &
+ 1.5_r8 * 1.e6_r8
+ end where
+
+ where (qs_grid(:ngrdcol,top_lev:) >= 1.e-7_r8)
+ dsout2_grid(:ngrdcol,top_lev:) = avg_diameter( &
+ qs_grid(:ngrdcol,top_lev:), &
+ ns_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), &
+ rho_grid(:ngrdcol,top_lev:), rhosn)
+
+ des_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) *&
+ 3._r8 * rhosn/rhows
+
+ reff_snow_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) * &
+ 1.5_r8 * 1.e6_r8
+ end where
+
+ else
+ ! Diagnostic precipitation
+
+ where (qrout_grid(:ngrdcol,top_lev:) >= 1.e-7_r8)
+ drout2_grid(:ngrdcol,top_lev:) = avg_diameter( &
+ qrout_grid(:ngrdcol,top_lev:), &
+ nrout_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), &
+ rho_grid(:ngrdcol,top_lev:), rhow)
+
+ reff_rain_grid(:ngrdcol,top_lev:) = drout2_grid(:ngrdcol,top_lev:) * &
+ 1.5_r8 * 1.e6_r8
+ end where
+
+ where (qsout_grid(:ngrdcol,top_lev:) >= 1.e-7_r8)
+ dsout2_grid(:ngrdcol,top_lev:) = avg_diameter( &
+ qsout_grid(:ngrdcol,top_lev:), &
+ nsout_grid(:ngrdcol,top_lev:) * rho_grid(:ngrdcol,top_lev:), &
+ rho_grid(:ngrdcol,top_lev:), rhosn)
+
+ des_grid(:ngrdcol,top_lev:) = dsout2_grid(:ngrdcol,top_lev:) &
+ * 3._r8 * rhosn/rhows
+
+ reff_snow_grid(:ngrdcol,top_lev:) = &
+ dsout2_grid(:ngrdcol,top_lev:) * 1.5_r8 * 1.e6_r8
+ end where
+
+ end if
+
+ ! Effective radius and diameter for cloud ice.
+ rei_grid = 25._r8
+
+ niic_grid(:ngrdcol,top_lev:) = ni_grid(:ngrdcol,top_lev:) / &
+ max(mincld,icecldf_grid(:ngrdcol,top_lev:))
+
+ call size_dist_param_basic(mg_ice_props, icimrst_grid(:ngrdcol,top_lev:), &
+ niic_grid(:ngrdcol,top_lev:), rei_grid(:ngrdcol,top_lev:))
+
+ where (icimrst_grid(:ngrdcol,top_lev:) >= qsmall)
+ rei_grid(:ngrdcol,top_lev:) = 1.5_r8/rei_grid(:ngrdcol,top_lev:) &
+ * 1.e6_r8
+ elsewhere
+ rei_grid(:ngrdcol,top_lev:) = 25._r8
+ end where
+
+ dei_grid = rei_grid * rhoi/rhows * 2._r8
+
+ ! Limiters for low cloud fraction.
+ do k = top_lev, pver
+ do i = 1, ngrdcol
+ ! Convert snow effective diameter to microns
+ des_grid(i,k) = des_grid(i,k) * 1.e6_r8
+ if ( ast_grid(i,k) < 1.e-4_r8 ) then
+ mu_grid(i,k) = mucon
+ lambdac_grid(i,k) = (mucon + 1._r8)/dcon
+ dei_grid(i,k) = deicon
+ end if
+ end do
+ end do
+
+ mgreffrain_grid(:ngrdcol,top_lev:pver) = reff_rain_grid(:ngrdcol,top_lev:pver)
+ mgreffsnow_grid(:ngrdcol,top_lev:pver) = reff_snow_grid(:ngrdcol,top_lev:pver)
+
+ ! ------------------------------------- !
+ ! Precipitation efficiency Calculation !
+ ! ------------------------------------- !
+
+ !-----------------------------------------------------------------------
+ ! Liquid water path
+
+ ! Compute liquid water paths, and column condensation
+ tgliqwp_grid(:ngrdcol) = 0._r8
+ tgcmeliq_grid(:ngrdcol) = 0._r8
+ do k = top_lev, pver
+ do i = 1, ngrdcol
+ tgliqwp_grid(i) = tgliqwp_grid(i) + iclwpst_grid(i,k)*cld_grid(i,k)
+
+ if (cmeliq_grid(i,k) > 1.e-12_r8) then
+ !convert cmeliq to right units: kgh2o/kgair/s * kgair/m2 / kgh2o/m3 = m/s
+ tgcmeliq_grid(i) = tgcmeliq_grid(i) + cmeliq_grid(i,k) * &
+ (pdel_grid(i,k) / gravit) / rhoh2o
+ end if
+ end do
+ end do
+
+ ! note: 1e-6 kgho2/kgair/s * 1000. pa / (9.81 m/s2) / 1000 kgh2o/m3 = 1e-7 m/s
+ ! this is 1ppmv of h2o in 10hpa
+ ! alternatively: 0.1 mm/day * 1.e-4 m/mm * 1/86400 day/s = 1.e-9
+
+ !-----------------------------------------------------------------------
+ ! precipitation efficiency calculation (accumulate cme and precip)
+
+ minlwp = 0.01_r8 !minimum lwp threshold (kg/m3)
+
+ ! zero out precip efficiency and total averaged precip
+ pe_grid(:ngrdcol) = 0._r8
+ tpr_grid(:ngrdcol) = 0._r8
+ pefrac_grid(:ngrdcol) = 0._r8
+
+ ! accumulate precip and condensation
+ do i = 1, ngrdcol
+
+ acgcme_grid(i) = acgcme_grid(i) + tgcmeliq_grid(i)
+ acprecl_grid(i) = acprecl_grid(i) + prec_str_grid(i)
+ acnum_grid(i) = acnum_grid(i) + 1
+
+ ! if LWP is zero, then 'end of cloud': calculate precip efficiency
+ if (tgliqwp_grid(i) < minlwp) then
+ if (acprecl_grid(i) > 5.e-8_r8) then
+ tpr_grid(i) = max(acprecl_grid(i)/acnum_grid(i), 1.e-15_r8)
+ if (acgcme_grid(i) > 1.e-10_r8) then
+ pe_grid(i) = min(max(acprecl_grid(i)/acgcme_grid(i), 1.e-15_r8), 1.e5_r8)
+ pefrac_grid(i) = 1._r8
+ end if
+ end if
+
+ ! reset counters
+! if (pe_grid(i) /= 0._r8 .and. (pe_grid(i) < 1.e-8_r8 .or. pe_grid(i) > 1.e3_r8)) then
+! write (iulog,*) 'PE_grid:ANOMALY pe_grid, acprecl_grid, acgcme_grid, tpr_grid, acnum_grid ', &
+! pe_grid(i),acprecl_grid(i), acgcme_grid(i), tpr_grid(i), acnum_grid(i)
+! endif
+
+ acprecl_grid(i) = 0._r8
+ acgcme_grid(i) = 0._r8
+ acnum_grid(i) = 0
+ end if ! end LWP zero conditional
+
+ ! if never find any rain....(after 10^3 timesteps...)
+ if (acnum_grid(i) > 1000) then
+ acnum_grid(i) = 0
+ acprecl_grid(i) = 0._r8
+ acgcme_grid(i) = 0._r8
+ end if
+
+ end do
+
+ !-----------------------------------------------------------------------
+ ! vertical average of non-zero accretion, autoconversion and ratio.
+ ! vars: vprco_grid(i),vprao_grid(i),racau_grid(i),cnt_grid
+
+ vprao_grid = 0._r8
+ cnt_grid = 0
+ do k = top_lev, pver
+ vprao_grid(:ngrdcol) = vprao_grid(:ngrdcol) + prao_grid(:ngrdcol,k)
+ where (prao_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1
+ end do
+
+ where (cnt_grid > 0) vprao_grid = vprao_grid/cnt_grid
+
+ vprco_grid = 0._r8
+ cnt_grid = 0
+ do k = top_lev, pver
+ vprco_grid(:ngrdcol) = vprco_grid(:ngrdcol) + prco_grid(:ngrdcol,k)
+ where (prco_grid(:ngrdcol,k) /= 0._r8) cnt_grid(:ngrdcol) = cnt_grid(:ngrdcol) + 1
+ end do
+
+ where (cnt_grid > 0)
+ vprco_grid = vprco_grid/cnt_grid
+ racau_grid = vprao_grid/vprco_grid
+ elsewhere
+ racau_grid = 0._r8
+ end where
+
+ racau_grid = min(racau_grid, 1.e10_r8)
+
+ ! --------------------- !
+ ! History Output Fields !
+ ! --------------------- !
+
+ ! Column droplet concentration
+ cdnumc_grid(:ngrdcol) = sum(nc_grid(:ngrdcol,top_lev:pver) * &
+ pdel_grid(:ngrdcol,top_lev:pver)/gravit, dim=2)
+
+ ! Averaging for new output fields
+ efcout_grid = 0._r8
+ efiout_grid = 0._r8
+ ncout_grid = 0._r8
+ niout_grid = 0._r8
+ freql_grid = 0._r8
+ freqi_grid = 0._r8
+ icwmrst_grid_out = 0._r8
+ icimrst_grid_out = 0._r8
+ freqm_grid = 0._r8
+ freqsl_grid = 0._r8
+ freqslm_grid = 0._r8
+
+ do k = top_lev, pver
+ do i = 1, ngrdcol
+ if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 5.e-5_r8 ) then
+ efcout_grid(i,k) = rel_grid(i,k) * liqcldf_grid(i,k)
+ ncout_grid(i,k) = icwnc_grid(i,k) * liqcldf_grid(i,k)
+ freql_grid(i,k) = liqcldf_grid(i,k)
+ icwmrst_grid_out(i,k) = icwmrst_grid(i,k)
+ end if
+ if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-6_r8 ) then
+ efiout_grid(i,k) = rei_grid(i,k) * icecldf_grid(i,k)
+ niout_grid(i,k) = icinc_grid(i,k) * icecldf_grid(i,k)
+ freqi_grid(i,k) = icecldf_grid(i,k)
+ icimrst_grid_out(i,k) = icimrst_grid(i,k)
+ end if
+
+ ! Supercooled liquid
+ if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 ) then
+ freqm_grid(i,k)=min(liqcldf_grid(i,k),icecldf_grid(i,k))
+ end if
+ if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then
+ freqsl_grid(i,k)=liqcldf_grid(i,k)
+ end if
+ if (freql_grid(i,k) > 0.01_r8 .and. freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then
+ freqslm_grid(i,k)=liqcldf_grid(i,k)
+ end if
+
+ end do
+ end do
+
+ ! Cloud top effective radius and number.
+ fcti_grid = 0._r8
+ fctl_grid = 0._r8
+ ctrel_grid = 0._r8
+ ctrei_grid = 0._r8
+ ctnl_grid = 0._r8
+ ctni_grid = 0._r8
+ fctm_grid = 0._r8
+ fctsl_grid = 0._r8
+ fctslm_grid= 0._r8
+ !++IH for comparign to Bennartz CDNC concentrations
+ fctl_b = 0._r8
+ ctnl_b = 0._r8
+!akc6+
+ ccn_b = 0._r8
+!akc6-
+
+ do i = 1, ngrdcol
+ do k = top_lev, pver
+ if ( liqcldf_grid(i,k) > 0.01_r8 .and. icwmrst_grid(i,k) > 1.e-7_r8 ) then
+ ctrel_grid(i) = rel_grid(i,k) * liqcldf_grid(i,k)
+ ctnl_grid(i) = icwnc_grid(i,k) * liqcldf_grid(i,k)
+ fctl_grid(i) = liqcldf_grid(i,k)
+
+ ! Cloud Top Mixed phase, supercooled liquid only and supercooled liquid mixed
+ if (freqi_grid(i,k) > 0.01_r8) then
+ fctm_grid(i)=min(liqcldf_grid(i,k),icecldf_grid(i,k))
+ end if
+ if (freqi_grid(i,k) < 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then
+ fctsl_grid(i)=liqcldf_grid(i,k)
+ end if
+ if (freqi_grid(i,k) > 0.01_r8 .and. state_loc%t(i,k) < tmelt ) then
+ fctslm_grid(i)=liqcldf_grid(i,k)
+ end if
+
+ exit
+ end if
+
+ if ( icecldf_grid(i,k) > 0.01_r8 .and. icimrst_grid(i,k) > 1.e-7_r8 ) then
+ ctrei_grid(i) = rei_grid(i,k) * icecldf_grid(i,k)
+ ctni_grid(i) = icinc_grid(i,k) * icecldf_grid(i,k)
+ fcti_grid(i) = icecldf_grid(i,k)
+ exit
+ end if
+ end do
+ end do
+
+ ! Evaporation of stratiform precipitation fields for UNICON
+ evprain_st_grid(:ngrdcol,:pver) = nevapr_grid(:ngrdcol,:pver) - evpsnow_st_grid(:ngrdcol,:pver)
+ do k = top_lev, pver
+ do i = 1, ngrdcol
+ evprain_st_grid(i,k) = max(evprain_st_grid(i,k), 0._r8)
+ evpsnow_st_grid(i,k) = max(evpsnow_st_grid(i,k), 0._r8)
+ end do
+ end do
+
+ ! Assign the values to the pbuf pointers if they exist in pbuf
+ if (qrain_idx > 0) qrout_grid_ptr = qrout_grid
+ if (qsnow_idx > 0) qsout_grid_ptr = qsout_grid
+ if (nrain_idx > 0) nrout_grid_ptr = nrout_grid
+ if (nsnow_idx > 0) nsout_grid_ptr = nsout_grid
+
+ !Calculate values for comparing with Bennartz 2017
+ do i = 1, ncol
+ do k = top_lev, pver
+ !Criterions for Bennartz (2017) to use values from a column
+ !1) 268 < T < 300 [K]
+ !2) liquid cloud fraction > 10 %
+ if ( liqcldf(i,k) > 0.1_r8 &
+ .and. state_loc%t(i,k) > 268.0_r8 &
+ .and. state_loc%t(i,k) < 300.0_r8 ) then
+ !Save cloud fraction and in-cloud number conc
+ ctnl_b(i) = icwnc(i,k) * liqcldf(i,k)
+ fctl_b(i) = liqcldf(i,k)
+!akc6+
+ ccn_b(i) = ncal(i,k) * liqcldf(i,k)
+!akc6-
+ exit !==> Go out to i=1,ncol-loop
+ end if
+ !--IH
+ end do
+ end do
+
+ call outfld( 'ACTREL' , ctrel_grid, pcols, lchnk )
+ call outfld( 'ACTREI' , ctrei_grid, pcols, lchnk )
+ call outfld( 'ACTNL' , ctnl_grid, pcols, lchnk )
+ call outfld( 'ACTNI' , ctni_grid, pcols, lchnk )
+ call outfld( 'FCTL' , fctl_grid, pcols, lchnk )
+ call outfld( 'FCTI' , fcti_grid, pcols, lchnk )
+ !++IH
+ call outfld( 'FCTL_B' , fctl_b, pcols, lchnk )
+ call outfld( 'ACTNL_B' , ctnl_b, pcols, lchnk )
+!akc6+
+ call outfld( 'CCN_B' , ccn_b, pcols, lchnk )
+!akc6-
+ !--IH
+
+ ! --------------------------------------------- !
+ ! General outfield calls for microphysics !
+ ! --------------------------------------------- !
+
+ ! Output a handle of variables which are calculated on the fly
+ ftem_grid = 0._r8
+
+ ftem_grid(:ngrdcol,top_lev:pver) = qcreso_grid(:ngrdcol,top_lev:pver)
+ call outfld( 'MPDW2V', ftem_grid, pcols, lchnk)
+
+ ftem_grid(:ngrdcol,top_lev:pver) = melto_grid(:ngrdcol,top_lev:pver) - mnuccco_grid(:ngrdcol,top_lev:pver)&
+ - mnuccto_grid(:ngrdcol,top_lev:pver) - bergo_grid(:ngrdcol,top_lev:pver) - homoo_grid(:ngrdcol,top_lev:pver)&
+ - msacwio_grid(:ngrdcol,top_lev:pver)
+ call outfld( 'MPDW2I', ftem_grid, pcols, lchnk)
+
+ ftem_grid(:ngrdcol,top_lev:pver) = -prao_grid(:ngrdcol,top_lev:pver) - prco_grid(:ngrdcol,top_lev:pver)&
+ - psacwso_grid(:ngrdcol,top_lev:pver) - bergso_grid(:ngrdcol,top_lev:pver)
+ call outfld( 'MPDW2P', ftem_grid, pcols, lchnk)
+
+ ftem_grid(:ngrdcol,top_lev:pver) = cmeiout_grid(:ngrdcol,top_lev:pver) + qireso_grid(:ngrdcol,top_lev:pver)
+ call outfld( 'MPDI2V', ftem_grid, pcols, lchnk)
+
+ ftem_grid(:ngrdcol,top_lev:pver) = -melto_grid(:ngrdcol,top_lev:pver) + mnuccco_grid(:ngrdcol,top_lev:pver) &
+ + mnuccto_grid(:ngrdcol,top_lev:pver) + bergo_grid(:ngrdcol,top_lev:pver) + homoo_grid(:ngrdcol,top_lev:pver)&
+ + msacwio_grid(:ngrdcol,top_lev:pver)
+ call outfld( 'MPDI2W', ftem_grid, pcols, lchnk)
+
+ ftem_grid(:ngrdcol,top_lev:pver) = -prcio_grid(:ngrdcol,top_lev:pver) - praio_grid(:ngrdcol,top_lev:pver)
+ call outfld( 'MPDI2P', ftem_grid, pcols, lchnk)
+
+ ! Output fields which have not been averaged already, averaging if use_subcol_microp is true
+ call outfld('MPICLWPI', iclwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('MPICIWPI', iciwpi, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('REFL', refl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('AREFL', arefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('AREFLZ', areflz, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('FREFL', frefl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('CSRFL', csrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('ACSRFL', acsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('FCSRFL', fcsrfl, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('RERCLD', rercld, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('NCAL', ncal, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('NCAI', ncai, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('AQRAIN', qrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('AQSNOW', qsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('ANRAIN', nrout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('ANSNOW', nsout2, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('FREQR', freqr, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('FREQS', freqs, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('MPDT', tlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('MPDQ', qvlat, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('MPDLIQ', qcten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('MPDICE', qiten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('EVAPSNOW', evapsnow, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('QCSEVAP', qcsevap, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('QISEVAP', qisevap, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('QVRES', qvres, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('VTRMC', vtrmc, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('VTRMI', vtrmi, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('QCSEDTEN', qcsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('QISEDTEN', qisedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ if (micro_mg_version > 1) then
+ call outfld('QRSEDTEN', qrsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('QSSEDTEN', qssedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ end if
+ call outfld('MNUCCDO', mnuccdo, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('MNUCCDOhet', mnuccdohet, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('MNUCCRO', mnuccro, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('PRACSO', pracso , psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('MELTSDT', meltsdt, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('FRZRDT', frzrdt , psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('FICE', nfice, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('CLDFSNOW', cldfsnow, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+
+!AL
+ call outfld ('NNUCCCO ', nnuccco, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NNUCCTO ', nnuccto, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NPSACWSO ', npsacwso, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NSUBCO ', nsubco, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NPRAO ', nprao, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NPRC1O ', nprc1o, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NQCSEDTEN', nqcsedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NQISEDTEN', nqisedten, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NMELTO ', nmelto, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NIMELTO ', nimelto, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NHOMOO ', nhomoo, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NIHOMOO ', nihomoo, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NSACWIO ', nsacwio, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NSUBIO ', nsubio, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NPRCIO ', nprcio, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NPRAIO ', npraio, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NNUDEPO ', nnudepo, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NPCCNO ', npccno, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NPCCNO2 ', npccn, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NNUCCDO ', nnuccdo, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('MNUDEPO ', mnudepo, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NCTNCONS ', nctncons, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NCTNNBMN ', nctnnbmn, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NCTNSZMN ', nctnszmn, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NCTNSZMX ', nctnszmx, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NCTNNCLD ', nctnncld, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NITNCONS ', nitncons, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NITNSZMN ', nitnszmn, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NITNSZMX ', nitnszmx, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NITNNCLD ', nitnncld, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ if (micro_mg_version > 1) then
+ call outfld ('FRZR ', frzr, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NFRZR ', nfrzr, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('MNUCCRI', mnuccri, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld ('NNUCCRI', nnuccri, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ end if
+
+ call outfld( 'MPDNLIQ ', ncten, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+ call outfld( 'MPDNICE ', niten, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
+!AL
+
+
+ if (micro_mg_version > 1) then
+ call outfld('UMR', umr, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ call outfld('UMS', ums, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ end if
+
+ if (.not. (micro_mg_version == 1 .and. micro_mg_sub_version == 0)) then
+ call outfld('QCRAT', qcrat, psetcols, lchnk, avg_subcol_field=use_subcol_microp)
+ end if
+
+ ! Example subcolumn outfld call
+ if (use_subcol_microp) then
+ call outfld('FICE_SCOL', nfice, psubcols*pcols, lchnk)
+ end if
+
+ ! Output fields which are already on the grid
+ call outfld('QRAIN', qrout_grid, pcols, lchnk)
+ call outfld('QSNOW', qsout_grid, pcols, lchnk)
+ call outfld('NRAIN', nrout_grid, pcols, lchnk)
+ call outfld('NSNOW', nsout_grid, pcols, lchnk)
+ call outfld('CV_REFFLIQ', cvreffliq_grid, pcols, lchnk)
+ call outfld('CV_REFFICE', cvreffice_grid, pcols, lchnk)
+ call outfld('LS_FLXPRC', mgflxprc_grid, pcols, lchnk)
+ call outfld('LS_FLXSNW', mgflxsnw_grid, pcols, lchnk)
+ call outfld('CME', qme_grid, pcols, lchnk)
+ call outfld('PRODPREC', prain_grid, pcols, lchnk)
+ call outfld('EVAPPREC', nevapr_grid, pcols, lchnk)
+ call outfld('QCRESO', qcreso_grid, pcols, lchnk)
+ call outfld('LS_REFFRAIN', mgreffrain_grid, pcols, lchnk)
+ call outfld('LS_REFFSNOW', mgreffsnow_grid, pcols, lchnk)
+ call outfld('DSNOW', des_grid, pcols, lchnk)
+ call outfld('ADRAIN', drout2_grid, pcols, lchnk)
+ call outfld('ADSNOW', dsout2_grid, pcols, lchnk)
+ call outfld('PE', pe_grid, pcols, lchnk)
+ call outfld('PEFRAC', pefrac_grid, pcols, lchnk)
+ call outfld('APRL', tpr_grid, pcols, lchnk)
+ call outfld('VPRAO', vprao_grid, pcols, lchnk)
+ call outfld('VPRCO', vprco_grid, pcols, lchnk)
+ call outfld('RACAU', racau_grid, pcols, lchnk)
+ call outfld('AREL', efcout_grid, pcols, lchnk)
+ call outfld('AREI', efiout_grid, pcols, lchnk)
+ call outfld('AWNC' , ncout_grid, pcols, lchnk)
+ call outfld('AWNI' , niout_grid, pcols, lchnk)
+ call outfld('FREQL', freql_grid, pcols, lchnk)
+ call outfld('FREQI', freqi_grid, pcols, lchnk)
+ call outfld('ACTREL', ctrel_grid, pcols, lchnk)
+ call outfld('ACTREI', ctrei_grid, pcols, lchnk)
+ call outfld('ACTNL', ctnl_grid, pcols, lchnk)
+ call outfld('ACTNI', ctni_grid, pcols, lchnk)
+ call outfld('FCTL', fctl_grid, pcols, lchnk)
+ call outfld('FCTI', fcti_grid, pcols, lchnk)
+ call outfld('ICINC', icinc_grid, pcols, lchnk)
+ call outfld('ICWNC', icwnc_grid, pcols, lchnk)
+ call outfld('EFFLIQ_IND', rel_fn_grid, pcols, lchnk)
+ call outfld('CDNUMC', cdnumc_grid, pcols, lchnk)
+ call outfld('REL', rel_grid, pcols, lchnk)
+ call outfld('REI', rei_grid, pcols, lchnk)
+ call outfld('MG_SADICE', sadice_grid, pcols, lchnk)
+ call outfld('MG_SADSNOW', sadsnow_grid, pcols, lchnk)
+ call outfld('ICIMRST', icimrst_grid_out, pcols, lchnk)
+ call outfld('ICWMRST', icwmrst_grid_out, pcols, lchnk)
+ call outfld('CMEIOUT', cmeiout_grid, pcols, lchnk)
+ call outfld('PRAO', prao_grid, pcols, lchnk)
+ call outfld('PRCO', prco_grid, pcols, lchnk)
+ call outfld('MNUCCCO', mnuccco_grid, pcols, lchnk)
+ call outfld('MNUCCTO', mnuccto_grid, pcols, lchnk)
+ call outfld('MSACWIO', msacwio_grid, pcols, lchnk)
+ call outfld('PSACWSO', psacwso_grid, pcols, lchnk)
+ call outfld('BERGSO', bergso_grid, pcols, lchnk)
+ call outfld('BERGO', bergo_grid, pcols, lchnk)
+ call outfld('MELTO', melto_grid, pcols, lchnk)
+ call outfld('HOMOO', homoo_grid, pcols, lchnk)
+ call outfld('PRCIO', prcio_grid, pcols, lchnk)
+ call outfld('PRAIO', praio_grid, pcols, lchnk)
+ call outfld('QIRESO', qireso_grid, pcols, lchnk)
+ call outfld('FREQM', freqm_grid, pcols, lchnk)
+ call outfld('FREQSL', freqsl_grid, pcols, lchnk)
+ call outfld('FREQSLM', freqslm_grid, pcols, lchnk)
+ call outfld('FCTM', fctm_grid, pcols, lchnk)
+ call outfld('FCTSL', fctsl_grid, pcols, lchnk)
+ call outfld('FCTSLM', fctslm_grid, pcols, lchnk)
+
+ if (micro_mg_adjust_cpt) then
+ cp_rh(:ncol, :pver) = 0._r8
+
+ do i = 1, ncol
+
+ ! Calculate the RH including any T change that we make.
+ do k = top_lev, pver
+ call qsat(state_loc%t(i,k), state_loc%pmid(i,k), es, qs)
+ cp_rh(i,k) = state_loc%q(i, k, 1) / qs * 100._r8
+ end do
+ end do
+
+ call outfld("TROPF_RHADJ", cp_rh, pcols, lchnk)
+ end if
+
+ ! ptend_loc is deallocated in physics_update above
+ call physics_state_dealloc(state_loc)
+
+end subroutine micro_mg_cam_tend_pack
+
+function p1(tin) result(pout)
+ real(r8), target, intent(in) :: tin(:)
+ real(r8), pointer :: pout(:)
+ pout => tin
+end function p1
+
+function p2(tin) result(pout)
+ real(r8), target, intent(in) :: tin(:,:)
+ real(r8), pointer :: pout(:,:)
+ pout => tin
+end function p2
+
+end module micro_mg_cam
diff --git a/src/NorESM/phys_control.F90 b/src/NorESM/phys_control.F90
new file mode 100644
index 0000000000..06efcdde10
--- /dev/null
+++ b/src/NorESM/phys_control.F90
@@ -0,0 +1,411 @@
+module phys_control
+!-----------------------------------------------------------------------
+! Purpose:
+!
+! Provides a control interface to CAM physics packages
+!
+! Revision history:
+! 2006-05-01 D. B. Coleman, Creation of module
+! 2009-02-13 Eaton Replace *_{default,set}opts methods with module namelist.
+! Add vars to indicate physics version and chemistry type.
+!-----------------------------------------------------------------------
+
+use spmd_utils, only: masterproc
+use cam_logfile, only: iulog
+use cam_abortutils, only: endrun
+use shr_kind_mod, only: r8 => shr_kind_r8
+
+implicit none
+private
+save
+
+public :: &
+ phys_ctl_readnl, &! read namelist from file
+ phys_getopts, &! generic query method
+ phys_setopts, &! generic set method
+ phys_deepconv_pbl, &! return true if deep convection is allowed in the PBL
+ phys_do_flux_avg, &! return true to average surface fluxes
+ cam_physpkg_is, &! query for the name of the physics package
+ cam_chempkg_is, &! query for the name of the chemistry package
+ waccmx_is
+
+! Private module data
+
+character(len=16), parameter :: unset_str = 'UNSET'
+integer, parameter :: unset_int = huge(1)
+
+! Namelist variables:
+character(len=16) :: cam_physpkg = unset_str ! CAM physics package
+character(len=32) :: cam_chempkg = unset_str ! CAM chemistry package
+character(len=16) :: waccmx_opt = unset_str ! WACCMX run option [ionosphere | neutral | off
+character(len=16) :: deep_scheme = unset_str ! deep convection package
+character(len=16) :: shallow_scheme = unset_str ! shallow convection package
+character(len=16) :: eddy_scheme = unset_str ! vertical diffusion package
+character(len=16) :: microp_scheme = unset_str ! microphysics package
+character(len=16) :: macrop_scheme = unset_str ! macrophysics package
+character(len=16) :: radiation_scheme = unset_str ! radiation package
+integer :: srf_flux_avg = unset_int ! 1 => smooth surface fluxes, 0 otherwise
+
+logical :: use_subcol_microp = .false. ! if .true. then use sub-columns in microphysics
+
+logical :: atm_dep_flux = .true. ! true => deposition fluxes will be provided
+ ! to the coupler
+logical :: history_amwg = .true. ! output the variables used by the AMWG diag package
+logical :: history_vdiag = .false. ! output the variables used by the AMWG variability diag package
+logical :: history_aerosol = .false. ! output the MAM aerosol variables and tendencies
+logical :: history_aero_optics = .false. ! output the aerosol
+logical :: history_eddy = .false. ! output the eddy variables
+logical :: history_budget = .false. ! output tendencies and state variables for CAM4
+ ! temperature, water vapor, cloud ice and cloud
+ ! liquid budgets.
+logical :: convproc_do_aer = .false. ! switch for new convective scavenging treatment for modal aerosols
+
+integer :: history_budget_histfile_num = 1 ! output history file number for budget fields
+logical :: history_waccm = .false. ! output variables of interest for WACCM runs
+logical :: history_waccmx = .false. ! output variables of interest for WACCM-X runs
+logical :: history_chemistry = .true. ! output default chemistry-related variables
+logical :: history_carma = .false. ! output default CARMA-related variables
+logical :: history_clubb = .true. ! output default CLUBB-related variables
+logical :: history_dust = .false.
+logical :: history_cesm_forcing = .false.
+logical :: history_scwaccm_forcing = .false.
+logical :: history_chemspecies_srf = .false.
+
+logical :: do_clubb_sgs
+! Check validity of physics_state objects in physics_update.
+logical :: state_debug_checks = .false.
+
+! Macro/micro-physics co-substeps
+integer :: cld_macmic_num_steps = 1
+
+logical :: offline_driver = .false. ! true => offline driver is being used
+
+
+logical, public, protected :: use_simple_phys = .false. ! true => simple physics configuration
+
+logical :: use_spcam ! true => use super parameterized CAM
+
+logical :: prog_modal_aero ! determines whether prognostic modal aerosols are present in the run.
+
+! Option to use heterogeneous freezing
+logical, public, protected :: use_hetfrz_classnuc = .false.
+
+! Which gravity wave sources are used?
+logical, public, protected :: use_gw_oro = .true. ! Orography.
+logical, public, protected :: use_gw_front = .false. ! Frontogenesis.
+logical, public, protected :: use_gw_front_igw = .false. ! Frontogenesis to inertial spectrum.
+logical, public, protected :: use_gw_convect_dp = .false. ! Deep convection.
+logical, public, protected :: use_gw_convect_sh = .false. ! Shallow convection.
+
+! FV dycore angular momentum correction
+logical, public, protected :: fv_am_correction = .false.
+
+!tht: energy adjustment in dry mass adjustment
+logical, public, protected :: dme_energy_adjust = .false.
+
+!=======================================================================
+contains
+!=======================================================================
+
+subroutine phys_ctl_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use spmd_utils, only: mpi_character, mpi_integer, mpi_logical, masterprocid, mpicom
+ use cam_control_mod, only: cam_ctrl_set_physics_type
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'phys_ctl_readnl'
+
+ namelist /phys_ctl_nl/ cam_physpkg, use_simple_phys, cam_chempkg, waccmx_opt, &
+ deep_scheme, shallow_scheme, &
+ eddy_scheme, microp_scheme, macrop_scheme, radiation_scheme, srf_flux_avg, &
+ use_subcol_microp, atm_dep_flux, history_amwg, history_vdiag, history_aerosol, history_aero_optics, &
+ history_eddy, history_budget, history_budget_histfile_num, history_waccm, &
+ history_waccmx, history_chemistry, history_carma, history_clubb, history_dust, &
+ history_cesm_forcing, history_scwaccm_forcing, history_chemspecies_srf, &
+ do_clubb_sgs, state_debug_checks, use_hetfrz_classnuc, use_gw_oro, use_gw_front, &
+ use_gw_front_igw, use_gw_convect_dp, use_gw_convect_sh, cld_macmic_num_steps, &
+ offline_driver, convproc_do_aer, dme_energy_adjust !+tht
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'phys_ctl_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, phys_ctl_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+ end if
+
+ ! Broadcast namelist variables
+ call mpi_bcast(deep_scheme, len(deep_scheme), mpi_character, masterprocid, mpicom, ierr)
+ call mpi_bcast(cam_physpkg, len(cam_physpkg), mpi_character, masterprocid, mpicom, ierr)
+ call mpi_bcast(use_simple_phys, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(cam_chempkg, len(cam_chempkg), mpi_character, masterprocid, mpicom, ierr)
+ call mpi_bcast(waccmx_opt, len(waccmx_opt), mpi_character, masterprocid, mpicom, ierr)
+ call mpi_bcast(shallow_scheme, len(shallow_scheme), mpi_character, masterprocid, mpicom, ierr)
+ call mpi_bcast(eddy_scheme, len(eddy_scheme), mpi_character, masterprocid, mpicom, ierr)
+ call mpi_bcast(microp_scheme, len(microp_scheme), mpi_character, masterprocid, mpicom, ierr)
+ call mpi_bcast(radiation_scheme, len(radiation_scheme), mpi_character, masterprocid, mpicom, ierr)
+ call mpi_bcast(macrop_scheme, len(macrop_scheme), mpi_character, masterprocid, mpicom, ierr)
+ call mpi_bcast(srf_flux_avg, 1, mpi_integer, masterprocid, mpicom, ierr)
+ call mpi_bcast(use_subcol_microp, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(atm_dep_flux, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_amwg, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_vdiag, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_eddy, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_aerosol, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_aero_optics, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_budget, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_budget_histfile_num, 1, mpi_integer, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_waccm, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_waccmx, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_chemistry, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_carma, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_clubb, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_dust, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_cesm_forcing, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_chemspecies_srf, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_scwaccm_forcing, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(do_clubb_sgs, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(state_debug_checks, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(use_hetfrz_classnuc, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(use_gw_oro, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(use_gw_front, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(use_gw_front_igw, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(use_gw_convect_dp, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(use_gw_convect_sh, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(cld_macmic_num_steps, 1, mpi_integer, masterprocid, mpicom, ierr)
+ call mpi_bcast(offline_driver, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(convproc_do_aer, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(dme_energy_adjust, 1, mpi_logical, masterprocid, mpicom, ierr) !+tht
+
+ use_spcam = ( cam_physpkg_is('spcam_sam1mom') &
+ .or. cam_physpkg_is('spcam_m2005'))
+
+ call cam_ctrl_set_physics_type(cam_physpkg)
+
+ ! Error checking:
+
+ ! Check compatibility of eddy & shallow schemes
+ if (( shallow_scheme .eq. 'UW' ) .and. ( eddy_scheme .ne. 'diag_TKE' )) then
+ write(iulog,*)'Do you really want to run UW shallow scheme without diagnostic TKE eddy scheme? Quiting'
+ call endrun('shallow convection and eddy scheme may be incompatible')
+ endif
+
+ if (( shallow_scheme .eq. 'Hack' ) .and. ( ( eddy_scheme .ne. 'HB' ) .and. ( eddy_scheme .ne. 'HBR' ))) then
+ write(iulog,*)'Do you really want to run Hack shallow scheme with a non-standard eddy scheme? Quiting.'
+ call endrun('shallow convection and eddy scheme may be incompatible')
+ endif
+
+ ! Check compatibility of PBL and Microphysics schemes
+ if (( eddy_scheme .eq. 'diag_TKE' ) .and. ( microp_scheme .eq. 'RK' )) then
+ write(iulog,*)'UW PBL is not compatible with RK microphysics. Quiting'
+ call endrun('PBL and Microphysics schemes incompatible')
+ endif
+
+ ! Add a check to make sure CLUBB and MG are used together
+ if ( do_clubb_sgs .and. ( microp_scheme .ne. 'MG') .and. .not. use_spcam) then
+ write(iulog,*)'CLUBB is only compatible with MG microphysics. Quiting'
+ call endrun('CLUBB and microphysics schemes incompatible')
+ endif
+
+ ! Check that eddy_scheme, macrop_scheme, shallow_scheme are all set to CLUBB_SGS if do_clubb_sgs is true
+ if (do_clubb_sgs .and. .not. use_spcam) then
+ if (eddy_scheme .ne. 'CLUBB_SGS' .or. macrop_scheme .ne. 'CLUBB_SGS' .or. shallow_scheme .ne. 'CLUBB_SGS') then
+ write(iulog,*)'eddy_scheme, macrop_scheme and shallow_scheme must all be CLUBB_SGS. Quiting'
+ call endrun('CLUBB and eddy, macrop or shallow schemes incompatible')
+ endif
+ endif
+
+ ! Macro/micro co-substepping support.
+ if (cld_macmic_num_steps > 1) then
+ if (microp_scheme /= "MG" .or. (macrop_scheme /= "park" .and. macrop_scheme /= "CLUBB_SGS")) then
+ call endrun ("Setting cld_macmic_num_steps > 1 is only &
+ &supported with Park or CLUBB macrophysics and MG microphysics.")
+ end if
+ end if
+
+ ! prog_modal_aero determines whether prognostic modal aerosols are present in the run.
+ prog_modal_aero = index(cam_chempkg,'_mam')>0
+#ifdef OSLO_AERO
+ prog_modal_aero = .FALSE.
+#endif
+end subroutine phys_ctl_readnl
+
+!===============================================================================
+
+logical function cam_physpkg_is(name)
+
+ ! query for the name of the physics package
+
+ character(len=*) :: name
+
+ cam_physpkg_is = (trim(name) == trim(cam_physpkg))
+end function cam_physpkg_is
+
+!===============================================================================
+
+logical function cam_chempkg_is(name)
+
+ ! query for the name of the chemics package
+
+ character(len=*) :: name
+
+ cam_chempkg_is = (trim(name) == trim(cam_chempkg))
+end function cam_chempkg_is
+
+!===============================================================================
+
+logical function waccmx_is(name)
+
+ ! query for the name of the waccmx run option
+
+ character(len=*) :: name
+
+ waccmx_is = (trim(name) == trim(waccmx_opt))
+end function waccmx_is
+
+!===============================================================================
+
+subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, microp_scheme_out, &
+ radiation_scheme_out, use_subcol_microp_out, atm_dep_flux_out, &
+ history_amwg_out, history_vdiag_out, history_aerosol_out, history_aero_optics_out, history_eddy_out, &
+ history_budget_out, history_budget_histfile_num_out, &
+ history_waccm_out, history_waccmx_out, history_chemistry_out, &
+ history_carma_out, history_clubb_out, history_dust_out, &
+ history_cesm_forcing_out, history_scwaccm_forcing_out, history_chemspecies_srf_out, &
+ cam_chempkg_out, prog_modal_aero_out, macrop_scheme_out, &
+ do_clubb_sgs_out, use_spcam_out, state_debug_checks_out, cld_macmic_num_steps_out, &
+ offline_driver_out, convproc_do_aer_out, dme_energy_adjust_out) !+tht
+!-----------------------------------------------------------------------
+! Purpose: Return runtime settings
+! deep_scheme_out : deep convection scheme
+! shallow_scheme_out: shallow convection scheme
+! eddy_scheme_out : vertical diffusion scheme
+! microp_scheme_out : microphysics scheme
+! radiation_scheme_out : radiation_scheme
+! SPCAM_microp_scheme_out : SPCAM microphysics scheme
+!-----------------------------------------------------------------------
+
+ character(len=16), intent(out), optional :: deep_scheme_out
+ character(len=16), intent(out), optional :: shallow_scheme_out
+ character(len=16), intent(out), optional :: eddy_scheme_out
+ character(len=16), intent(out), optional :: microp_scheme_out
+ character(len=16), intent(out), optional :: radiation_scheme_out
+ character(len=16), intent(out), optional :: macrop_scheme_out
+ logical, intent(out), optional :: use_subcol_microp_out
+ logical, intent(out), optional :: use_spcam_out
+ logical, intent(out), optional :: atm_dep_flux_out
+ logical, intent(out), optional :: history_amwg_out
+ logical, intent(out), optional :: history_vdiag_out
+ logical, intent(out), optional :: history_eddy_out
+ logical, intent(out), optional :: history_aerosol_out
+ logical, intent(out), optional :: history_aero_optics_out
+ logical, intent(out), optional :: history_budget_out
+ integer, intent(out), optional :: history_budget_histfile_num_out
+ logical, intent(out), optional :: history_waccm_out
+ logical, intent(out), optional :: history_waccmx_out
+ logical, intent(out), optional :: history_chemistry_out
+ logical, intent(out), optional :: history_carma_out
+ logical, intent(out), optional :: history_clubb_out
+ logical, intent(out), optional :: history_dust_out
+ logical, intent(out), optional :: history_cesm_forcing_out
+ logical, intent(out), optional :: history_chemspecies_srf_out
+ logical, intent(out), optional :: history_scwaccm_forcing_out
+ logical, intent(out), optional :: do_clubb_sgs_out
+ character(len=32), intent(out), optional :: cam_chempkg_out
+ logical, intent(out), optional :: prog_modal_aero_out
+ logical, intent(out), optional :: state_debug_checks_out
+ integer, intent(out), optional :: cld_macmic_num_steps_out
+ logical, intent(out), optional :: offline_driver_out
+ logical, intent(out), optional :: convproc_do_aer_out
+ logical, intent(out), optional :: dme_energy_adjust_out !+tht
+
+ if ( present(deep_scheme_out ) ) deep_scheme_out = deep_scheme
+ if ( present(shallow_scheme_out ) ) shallow_scheme_out = shallow_scheme
+ if ( present(eddy_scheme_out ) ) eddy_scheme_out = eddy_scheme
+ if ( present(microp_scheme_out ) ) microp_scheme_out = microp_scheme
+ if ( present(radiation_scheme_out ) ) radiation_scheme_out = radiation_scheme
+ if ( present(use_subcol_microp_out ) ) use_subcol_microp_out = use_subcol_microp
+ if ( present(use_spcam_out ) ) use_spcam_out = use_spcam
+
+ if ( present(macrop_scheme_out ) ) macrop_scheme_out = macrop_scheme
+ if ( present(atm_dep_flux_out ) ) atm_dep_flux_out = atm_dep_flux
+ if ( present(history_aerosol_out ) ) history_aerosol_out = history_aerosol
+ if ( present(history_aero_optics_out ) ) history_aero_optics_out = history_aero_optics
+ if ( present(history_budget_out ) ) history_budget_out = history_budget
+ if ( present(history_amwg_out ) ) history_amwg_out = history_amwg
+ if ( present(history_vdiag_out ) ) history_vdiag_out = history_vdiag
+ if ( present(history_eddy_out ) ) history_eddy_out = history_eddy
+ if ( present(history_budget_histfile_num_out ) ) history_budget_histfile_num_out = history_budget_histfile_num
+ if ( present(history_waccm_out ) ) history_waccm_out = history_waccm
+ if ( present(history_waccmx_out ) ) history_waccmx_out = history_waccmx
+ if ( present(history_chemistry_out ) ) history_chemistry_out = history_chemistry
+ if ( present(history_cesm_forcing_out) ) history_cesm_forcing_out = history_cesm_forcing
+ if ( present(history_chemspecies_srf_out) ) history_chemspecies_srf_out = history_chemspecies_srf
+ if ( present(history_scwaccm_forcing_out) ) history_scwaccm_forcing_out = history_scwaccm_forcing
+ if ( present(history_carma_out ) ) history_carma_out = history_carma
+ if ( present(history_clubb_out ) ) history_clubb_out = history_clubb
+ if ( present(history_dust_out ) ) history_dust_out = history_dust
+ if ( present(do_clubb_sgs_out ) ) do_clubb_sgs_out = do_clubb_sgs
+ if ( present(cam_chempkg_out ) ) cam_chempkg_out = cam_chempkg
+ if ( present(prog_modal_aero_out ) ) prog_modal_aero_out = prog_modal_aero
+ if ( present(state_debug_checks_out ) ) state_debug_checks_out = state_debug_checks
+ if ( present(cld_macmic_num_steps_out) ) cld_macmic_num_steps_out = cld_macmic_num_steps
+ if ( present(offline_driver_out ) ) offline_driver_out = offline_driver
+ if ( present(convproc_do_aer_out ) ) convproc_do_aer_out = convproc_do_aer
+ if ( present(dme_energy_adjust_out ) ) dme_energy_adjust_out = dme_energy_adjust !+tht
+
+end subroutine phys_getopts
+
+!===============================================================================
+
+subroutine phys_setopts(fv_am_correction_in)
+
+ logical, intent(in), optional :: fv_am_correction_in
+
+ if ( present(fv_am_correction_in) ) fv_am_correction = fv_am_correction_in
+
+end subroutine phys_setopts
+
+!===============================================================================
+
+function phys_deepconv_pbl()
+
+ logical phys_deepconv_pbl
+
+ ! Don't allow deep convection in PBL if running UW PBL scheme
+ if ( (eddy_scheme .eq. 'diag_TKE' ) .or. (shallow_scheme .eq. 'UW' ) ) then
+ phys_deepconv_pbl = .true.
+ else
+ phys_deepconv_pbl = .false.
+ endif
+
+ return
+
+end function phys_deepconv_pbl
+
+!===============================================================================
+
+function phys_do_flux_avg()
+
+ logical :: phys_do_flux_avg
+ !----------------------------------------------------------------------
+
+ phys_do_flux_avg = .false.
+ if (srf_flux_avg == 1) phys_do_flux_avg = .true.
+
+end function phys_do_flux_avg
+
+!===============================================================================
+end module phys_control
diff --git a/src/NorESM/physpkg.F90 b/src/NorESM/physpkg.F90
new file mode 100644
index 0000000000..7bc17bdba5
--- /dev/null
+++ b/src/NorESM/physpkg.F90
@@ -0,0 +1,2629 @@
+module physpkg
+ !-----------------------------------------------------------------------
+ ! Purpose:
+ !
+ ! Provides the interface to CAM physics package
+ !
+ ! Revision history:
+ ! Aug 2005, E. B. Kluzek, Creation of module from physpkg subroutine
+ ! 2005-10-17 B. Eaton Add contents of inti.F90 to phys_init(). Add
+ ! initialization of grid info in phys_state.
+ ! Nov 2010 A. Gettelman Put micro/macro physics into separate routines
+ !-----------------------------------------------------------------------
+
+#ifdef OSLO_AERO
+#include
+#endif
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use spmd_utils, only: masterproc
+ use physconst, only: latvap, latice, rh2o
+ use physics_types, only: physics_state, physics_tend, physics_state_set_grid, &
+ physics_ptend, physics_tend_init, physics_update, &
+ physics_type_alloc, physics_ptend_dealloc,&
+ physics_state_alloc, physics_state_dealloc, physics_tend_alloc, physics_tend_dealloc
+ use phys_grid, only: get_ncols_p
+ use phys_gmean, only: gmean_mass
+ use ppgrid, only: begchunk, endchunk, pcols, pver, pverp, psubcols
+ use constituents, only: pcnst, cnst_name, cnst_get_ind
+ use camsrfexch, only: cam_out_t, cam_in_t
+
+ use cam_control_mod, only: ideal_phys, adiabatic
+ use phys_control, only: phys_do_flux_avg, phys_getopts, waccmx_is
+ use scamMod, only: single_column, scm_crm_mode
+ use flux_avg, only: flux_avg_init
+ use perf_mod
+ use cam_logfile, only: iulog
+ use camsrfexch, only: cam_export
+
+ use modal_aero_calcsize, only: modal_aero_calcsize_init, modal_aero_calcsize_diag, modal_aero_calcsize_reg
+ use modal_aero_wateruptake, only: modal_aero_wateruptake_init, modal_aero_wateruptake_dr, modal_aero_wateruptake_reg
+
+ implicit none
+ private
+ save
+
+ ! Public methods
+ public phys_register ! was initindx - register physics methods
+ public phys_init ! Public initialization method
+ public phys_run1 ! First phase of the public run method
+ public phys_run2 ! Second phase of the public run method
+ public phys_final ! Public finalization method
+
+ ! Private module data
+
+ ! Physics package options
+ character(len=16) :: shallow_scheme
+ character(len=16) :: macrop_scheme
+ character(len=16) :: microp_scheme
+ integer :: cld_macmic_num_steps ! Number of macro/micro substeps
+ logical :: do_clubb_sgs
+ logical :: use_subcol_microp ! if true, use subcolumns in microphysics
+ logical :: state_debug_checks ! Debug physics_state.
+ logical :: clim_modal_aero ! climate controled by prognostic or prescribed modal aerosols
+ logical :: prog_modal_aero ! Prognostic modal aerosols present
+
+ ! Physics buffer index
+ integer :: teout_idx = 0
+
+ integer :: landm_idx = 0
+ integer :: sgh_idx = 0
+ integer :: sgh30_idx = 0
+
+ integer :: qini_idx = 0
+ integer :: cldliqini_idx = 0
+ integer :: cldiceini_idx = 0
+!AL
+ integer :: cldncini_idx = 0
+ integer :: cldniini_idx = 0
+!AK
+ integer :: prec_str_idx = 0
+ integer :: snow_str_idx = 0
+ integer :: prec_sed_idx = 0
+ integer :: snow_sed_idx = 0
+ integer :: prec_pcw_idx = 0
+ integer :: snow_pcw_idx = 0
+ integer :: prec_dp_idx = 0
+ integer :: snow_dp_idx = 0
+ integer :: prec_sh_idx = 0
+ integer :: snow_sh_idx = 0
+ integer :: dlfzm_idx = 0 ! detrained convective cloud water mixing ratio.
+
+!=======================================================================
+contains
+!=======================================================================
+
+ subroutine phys_register
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose: Register constituents and physics buffer fields.
+ !
+ ! Author: CSM Contact: M. Vertenstein, Aug. 1997
+ ! B.A. Boville, Oct 2001
+ ! A. Gettelman, Nov 2010 - put micro/macro physics into separate routines
+ !
+ !-----------------------------------------------------------------------
+ use cam_abortutils, only: endrun
+ use physics_buffer, only: pbuf_init_time
+ use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_register_subcol
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use spmd_utils, only: masterproc
+ use constituents, only: pcnst, cnst_add, cnst_chk_dim, cnst_name
+
+ use cam_control_mod, only: moist_physics
+ use chemistry, only: chem_register
+ use cloud_fraction, only: cldfrc_register
+ use rk_stratiform, only: rk_stratiform_register
+ use microp_driver, only: microp_driver_register
+ use microp_aero, only: microp_aero_register
+ use macrop_driver, only: macrop_driver_register
+ use clubb_intr, only: clubb_register_cam
+ use conv_water, only: conv_water_register
+ use physconst, only: mwdry, cpair, mwh2o, cpwv
+ use tracers, only: tracers_register
+ use check_energy, only: check_energy_register
+ use carma_intr, only: carma_register
+ use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_register
+ use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_register
+ use ghg_data, only: ghg_data_register
+ use vertical_diffusion, only: vd_register
+ use convect_deep, only: convect_deep_register
+ use convect_shallow, only: convect_shallow_register
+ use radiation, only: radiation_register
+ use co2_cycle, only: co2_register
+ use flux_avg, only: flux_avg_register
+ use iondrag, only: iondrag_register
+ use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_reg
+ use string_utils, only: to_lower
+ use prescribed_ozone, only: prescribed_ozone_register
+ use prescribed_volcaero,only: prescribed_volcaero_register
+ use prescribed_strataero,only: prescribed_strataero_register
+ use prescribed_aero, only: prescribed_aero_register
+ use prescribed_ghg, only: prescribed_ghg_register
+ use sslt_rebin, only: sslt_rebin_register
+ use aoa_tracers, only: aoa_tracers_register
+ use aircraft_emit, only: aircraft_emit_register
+ use cam_diagnostics, only: diag_register
+ use cloud_diagnostics, only: cloud_diagnostics_register
+ use cospsimulator_intr, only: cospsimulator_intr_register
+ use rad_constituents, only: rad_cnst_get_info ! Added to query if it is a modal aero sim or not
+ use subcol, only: subcol_register
+ use subcol_utils, only: is_subcol_on
+ use dyn_comp, only: dyn_register
+ use spcam_drivers, only: spcam_register
+ use offline_driver, only: offline_driver_reg
+
+ !---------------------------Local variables-----------------------------
+ !
+ integer :: m ! loop index
+ integer :: mm ! constituent index
+ integer :: nmodes
+ !-----------------------------------------------------------------------
+
+ ! Get physics options
+ call phys_getopts(shallow_scheme_out = shallow_scheme, &
+ macrop_scheme_out = macrop_scheme, &
+ microp_scheme_out = microp_scheme, &
+ cld_macmic_num_steps_out = cld_macmic_num_steps, &
+ do_clubb_sgs_out = do_clubb_sgs, &
+ use_subcol_microp_out = use_subcol_microp, &
+ state_debug_checks_out = state_debug_checks)
+
+ ! Initialize dyn_time_lvls
+ call pbuf_init_time()
+
+ ! Register the subcol scheme
+ call subcol_register()
+
+ ! Register water vapor.
+ ! ***** N.B. ***** This must be the first call to cnst_add so that
+ ! water vapor is constituent 1.
+ if (moist_physics) then
+ call cnst_add('Q', mwh2o, cpwv, 1.E-12_r8, mm, &
+ longname='Specific humidity', readiv=.true., is_convtran1=.true.)
+ else
+ call cnst_add('Q', mwh2o, cpwv, 0.0_r8, mm, &
+ longname='Specific humidity', readiv=.false., is_convtran1=.true.)
+ end if
+
+ ! Topography file fields.
+ call pbuf_add_field('LANDM', 'global', dtype_r8, (/pcols/), landm_idx)
+ call pbuf_add_field('SGH', 'global', dtype_r8, (/pcols/), sgh_idx)
+ call pbuf_add_field('SGH30', 'global', dtype_r8, (/pcols/), sgh30_idx)
+
+ ! Fields for physics package diagnostics
+ call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx)
+ call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx)
+ call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx)
+!AL
+ call pbuf_add_field('CLDNCINI', 'physpkg', dtype_r8, (/pcols,pver/), cldncini_idx)
+ call pbuf_add_field('CLDNIINI', 'physpkg', dtype_r8, (/pcols,pver/), cldniini_idx)
+!AL
+ ! check energy package
+ call check_energy_register
+
+ ! If using a simple physics option (e.g., held_suarez, adiabatic),
+ ! the normal CAM physics parameterizations are not called.
+ if (moist_physics) then
+
+ ! register fluxes for saving across time
+ if (phys_do_flux_avg()) call flux_avg_register()
+
+ call cldfrc_register()
+
+ ! cloud water
+ if( microp_scheme == 'RK' ) then
+ call rk_stratiform_register()
+ elseif( microp_scheme == 'MG' ) then
+ if (.not. do_clubb_sgs) call macrop_driver_register()
+ call microp_aero_register()
+ call microp_driver_register()
+ end if
+
+ ! Register CLUBB_SGS here
+ if (do_clubb_sgs) call clubb_register_cam()
+
+
+ call pbuf_add_field('PREC_STR', 'physpkg',dtype_r8,(/pcols/),prec_str_idx)
+ call pbuf_add_field('SNOW_STR', 'physpkg',dtype_r8,(/pcols/),snow_str_idx)
+ call pbuf_add_field('PREC_PCW', 'physpkg',dtype_r8,(/pcols/),prec_pcw_idx)
+ call pbuf_add_field('SNOW_PCW', 'physpkg',dtype_r8,(/pcols/),snow_pcw_idx)
+ call pbuf_add_field('PREC_SED', 'physpkg',dtype_r8,(/pcols/),prec_sed_idx)
+ call pbuf_add_field('SNOW_SED', 'physpkg',dtype_r8,(/pcols/),snow_sed_idx)
+ if (is_subcol_on()) then
+ call pbuf_register_subcol('PREC_STR', 'phys_register', prec_str_idx)
+ call pbuf_register_subcol('SNOW_STR', 'phys_register', snow_str_idx)
+ call pbuf_register_subcol('PREC_PCW', 'phys_register', prec_pcw_idx)
+ call pbuf_register_subcol('SNOW_PCW', 'phys_register', snow_pcw_idx)
+ call pbuf_register_subcol('PREC_SED', 'phys_register', prec_sed_idx)
+ call pbuf_register_subcol('SNOW_SED', 'phys_register', snow_sed_idx)
+ end if
+
+ ! Who should add FRACIS?
+ ! -- It does not seem that aero_intr should add it since FRACIS is used in convection
+ ! even if there are no prognostic aerosols ... so do it here for now
+ call pbuf_add_field('FRACIS','physpkg',dtype_r8,(/pcols,pver,pcnst/),m)
+
+ call conv_water_register()
+
+ ! Determine whether its a 'modal' aerosol simulation or not
+ call rad_cnst_get_info(0, nmodes=nmodes)
+ clim_modal_aero = (nmodes > 0)
+
+ if (clim_modal_aero) then
+ call modal_aero_calcsize_reg()
+ call modal_aero_wateruptake_reg()
+ endif
+
+ ! register chemical constituents including aerosols ...
+ call chem_register()
+
+ ! co2 constituents
+ call co2_register()
+
+ ! register data model ozone with pbuf
+ if (cam3_ozone_data_on) then
+ call cam3_ozone_data_register()
+ end if
+ call prescribed_volcaero_register()
+ call prescribed_strataero_register()
+ call prescribed_ozone_register()
+ call prescribed_aero_register()
+ call prescribed_ghg_register()
+ call sslt_rebin_register
+
+ ! CAM3 prescribed aerosols
+ if (cam3_aero_data_on) then
+ call cam3_aero_data_register()
+ end if
+
+ ! register various data model gasses with pbuf
+ call ghg_data_register()
+
+ ! carma microphysics
+ !
+ call carma_register()
+
+ ! Register iondrag variables with pbuf
+ call iondrag_register()
+
+ ! Register ionosphere variables with pbuf if mode set to ionosphere
+ if( waccmx_is('ionosphere') ) then
+ call waccmx_phys_ion_elec_temp_reg()
+ endif
+
+ call aircraft_emit_register()
+
+ ! deep convection
+ call convect_deep_register
+
+ ! shallow convection
+ call convect_shallow_register
+
+
+ call spcam_register
+
+ ! radiation
+ call radiation_register
+ call cloud_diagnostics_register
+
+ ! COSP
+ call cospsimulator_intr_register
+
+ ! vertical diffusion
+ call vd_register()
+ else
+ ! held_suarez/adiabatic physics option should be in simple_physics
+ call endrun('phys_register: moist_physics configuration error')
+ end if
+
+ ! Register diagnostics PBUF
+ call diag_register()
+
+ ! Register age of air tracers
+ call aoa_tracers_register()
+
+ ! Register test tracers
+ call tracers_register()
+
+ call dyn_register()
+
+ ! All tracers registered, check that the dimensions are correct
+ call cnst_chk_dim()
+
+ ! ***NOTE*** No registering constituents after the call to cnst_chk_dim.
+
+ call offline_driver_reg()
+
+ end subroutine phys_register
+
+
+
+ !=======================================================================
+
+ subroutine phys_inidat( cam_out, pbuf2d )
+ use cam_abortutils, only: endrun
+
+ use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc, pbuf_set_field, dyn_time_lvls
+
+
+ use cam_initfiles, only: initial_file_get_id, topo_file_get_id
+ use cam_grid_support, only: cam_grid_check, cam_grid_id
+ use cam_grid_support, only: cam_grid_get_dim_names
+ use pio, only: file_desc_t
+ use ncdio_atm, only: infld
+ use dycore, only: dycore_is
+ use polar_avg, only: polar_average
+ use short_lived_species, only: initialize_short_lived_species
+ use cam_control_mod, only: aqua_planet
+ use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_inidat
+
+ type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk)
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+ integer :: lchnk, m, n, i, k, ncol
+ type(file_desc_t), pointer :: fh_ini, fh_topo
+ character(len=8) :: fieldname
+ real(r8), pointer :: tptr(:,:), tptr_2(:,:), tptr3d(:,:,:), tptr3d_2(:,:,:)
+ real(r8), pointer :: qpert(:,:)
+
+ character(len=11) :: subname='phys_inidat' ! subroutine name
+ integer :: tpert_idx, qpert_idx, pblh_idx
+
+ logical :: found=.false., found2=.false.
+ integer :: ierr
+ character(len=8) :: dim1name, dim2name
+ integer :: ixcldice, ixcldliq
+ integer :: grid_id ! grid ID for data mapping
+
+ nullify(tptr,tptr_2,tptr3d,tptr3d_2)
+
+ fh_ini => initial_file_get_id()
+ fh_topo => topo_file_get_id()
+
+ ! dynamics variables are handled in dyn_init - here we read variables needed for physics
+ ! but not dynamics
+
+ grid_id = cam_grid_id('physgrid')
+ if (.not. cam_grid_check(grid_id)) then
+ call endrun(trim(subname)//': Internal error, no "physgrid" grid')
+ end if
+ call cam_grid_get_dim_names(grid_id, dim1name, dim2name)
+
+ allocate(tptr(1:pcols,begchunk:endchunk))
+
+ if (associated(fh_topo) .and. .not. aqua_planet) then
+ call infld('SGH', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr, found, gridname='physgrid')
+ if(.not. found) call endrun('ERROR: SGH not found on topo file')
+
+ call pbuf_set_field(pbuf2d, sgh_idx, tptr)
+
+ allocate(tptr_2(1:pcols,begchunk:endchunk))
+ call infld('SGH30', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr_2, found, gridname='physgrid')
+ if(found) then
+ call pbuf_set_field(pbuf2d, sgh30_idx, tptr_2)
+ else
+ if (masterproc) write(iulog,*) 'Warning: Error reading SGH30 from topo file.'
+ if (masterproc) write(iulog,*) 'The field SGH30 will be filled using data from SGH.'
+ call pbuf_set_field(pbuf2d, sgh30_idx, tptr)
+ end if
+
+ deallocate(tptr_2)
+
+ call infld('LANDM_COSLAT', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr, found, gridname='physgrid')
+
+ if(.not.found) call endrun(' ERROR: LANDM_COSLAT not found on topo dataset.')
+
+ call pbuf_set_field(pbuf2d, landm_idx, tptr)
+
+ else
+ call pbuf_set_field(pbuf2d, sgh_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, sgh30_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, landm_idx, 0._r8)
+ end if
+
+ call infld('PBLH', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr(:,:), found, gridname='physgrid')
+ if(.not. found) then
+ tptr(:,:) = 0._r8
+ if (masterproc) write(iulog,*) 'PBLH initialized to 0.'
+ end if
+ pblh_idx = pbuf_get_index('pblh')
+
+ call pbuf_set_field(pbuf2d, pblh_idx, tptr)
+
+ call infld('TPERT', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr(:,:), found, gridname='physgrid')
+ if(.not. found) then
+ tptr(:,:) = 0._r8
+ if (masterproc) write(iulog,*) 'TPERT initialized to 0.'
+ end if
+ tpert_idx = pbuf_get_index( 'tpert')
+ call pbuf_set_field(pbuf2d, tpert_idx, tptr)
+
+ fieldname='QPERT'
+ qpert_idx = pbuf_get_index( 'qpert',ierr)
+ if (qpert_idx > 0) then
+ call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr, found, gridname='physgrid')
+ if(.not. found) then
+ tptr=0_r8
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
+ end if
+
+ allocate(tptr3d_2(pcols,pcnst,begchunk:endchunk))
+ tptr3d_2 = 0_r8
+ tptr3d_2(:,1,:) = tptr(:,:)
+
+ call pbuf_set_field(pbuf2d, qpert_idx, tptr3d_2)
+ deallocate(tptr3d_2)
+ end if
+
+ fieldname='CUSH'
+ m = pbuf_get_index('cush', ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr, found, gridname='physgrid')
+ if(.not.found) then
+ if(masterproc) write(iulog,*) trim(fieldname), ' initialized to 1000.'
+ tptr=1000._r8
+ end if
+ do n=1,dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr, start=(/1,n/), kount=(/pcols,1/))
+ end do
+ deallocate(tptr)
+ end if
+
+ !
+ ! 3-D fields
+ !
+
+ allocate(tptr3d(pcols,pver,begchunk:endchunk))
+
+ fieldname='CLOUD'
+ m = pbuf_get_index('CLD')
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(found) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
+ end if
+
+ fieldname='QCWAT'
+ m = pbuf_get_index(fieldname,ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(.not. found) then
+ call infld('Q',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if (found) then
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized with Q'
+ if(dycore_is('LR')) call polar_average(pver, tptr3d)
+ else
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to huge()'
+ tptr3d = huge(1.0_r8)
+ end if
+ end if
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ end if
+
+ fieldname = 'ICCWAT'
+ m = pbuf_get_index(fieldname, ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(found) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ else
+ call cnst_get_ind('CLDICE', ixcldice)
+ call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(found) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ end if
+ if (masterproc) then
+ if (found) then
+ write(iulog,*) trim(fieldname), ' initialized with CLDICE'
+ else
+ write(iulog,*) trim(fieldname), ' initialized to 0.0'
+ end if
+ end if
+ end if
+ end if
+
+ fieldname = 'LCWAT'
+ m = pbuf_get_index(fieldname,ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(found) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ else
+ allocate(tptr3d_2(pcols,pver,begchunk:endchunk))
+ call cnst_get_ind('CLDICE', ixcldice)
+ call cnst_get_ind('CLDLIQ', ixcldliq)
+ call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ call infld('CLDLIQ',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d_2, found2, gridname='physgrid')
+ if(found .and. found2) then
+ do lchnk = begchunk, endchunk
+ ncol = get_ncols_p(lchnk)
+ tptr3d(:ncol,:,lchnk)=tptr3d(:ncol,:,lchnk)+tptr3d_2(:ncol,:,lchnk)
+ end do
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE + CLDLIQ'
+ else if (found) then ! Data already loaded in tptr3d
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE only'
+ else if (found2) then
+ tptr3d(:,:,:)=tptr3d_2(:,:,:)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDLIQ only'
+ end if
+
+ if (found .or. found2) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ if(dycore_is('LR')) call polar_average(pver, tptr3d)
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.0'
+ end if
+ deallocate(tptr3d_2)
+ end if
+ end if
+
+ deallocate(tptr3d)
+ allocate(tptr3d(pcols,pver,begchunk:endchunk))
+
+ fieldname = 'TCWAT'
+ m = pbuf_get_index(fieldname,ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(.not.found) then
+ call infld('T', fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if (found) then
+ if(dycore_is('LR')) call polar_average(pver, tptr3d)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized with T'
+ else
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to huge()'
+ tptr3d = huge(1._r8)
+ end if
+ end if
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ end if
+
+ deallocate(tptr3d)
+ allocate(tptr3d(pcols,pverp,begchunk:endchunk))
+
+ fieldname = 'TKE'
+ m = pbuf_get_index( 'tke')
+ call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if (found) then
+ call pbuf_set_field(pbuf2d, m, tptr3d)
+ else
+ call pbuf_set_field(pbuf2d, m, 0.01_r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.01'
+ end if
+
+
+ fieldname = 'KVM'
+ m = pbuf_get_index('kvm')
+ call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if (found) then
+ call pbuf_set_field(pbuf2d, m, tptr3d)
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
+ end if
+
+
+ fieldname = 'KVH'
+ m = pbuf_get_index('kvh')
+ call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if (found) then
+ call pbuf_set_field(pbuf2d, m, tptr3d)
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
+ end if
+
+ deallocate(tptr3d)
+ allocate(tptr3d(pcols,pver,begchunk:endchunk))
+
+ fieldname = 'CONCLD'
+ m = pbuf_get_index('CONCLD',ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(found) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
+ end if
+
+ deallocate (tptr3d)
+ end if
+
+ call initialize_short_lived_species(fh_ini, pbuf2d)
+
+ !---------------------------------------------------------------------------------
+ ! If needed, get ion and electron temperature fields from initial condition file
+ !---------------------------------------------------------------------------------
+
+ call waccmx_phys_ion_elec_temp_inidat(fh_ini,pbuf2d)
+
+ end subroutine phys_inidat
+
+
+ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_out )
+
+ !-----------------------------------------------------------------------
+ !
+ ! Initialization of physics package.
+ !
+ !-----------------------------------------------------------------------
+
+ use physics_buffer, only: physics_buffer_desc, pbuf_initialize, pbuf_get_index
+ use physconst, only: rair, cpair, gravit, stebol, tmelt, &
+ latvap, latice, rh2o, rhoh2o, pstd, zvir, &
+ karman, rhodair, physconst_init
+ use ref_pres, only: pref_edge, pref_mid
+
+ use carma_intr, only: carma_init
+ use cam_control_mod, only: initial_run
+ use check_energy, only: check_energy_init
+ use chemistry, only: chem_init
+ use prescribed_ozone, only: prescribed_ozone_init
+ use prescribed_ghg, only: prescribed_ghg_init
+ use prescribed_aero, only: prescribed_aero_init
+ use aerodep_flx, only: aerodep_flx_init
+ use aircraft_emit, only: aircraft_emit_init
+ use prescribed_volcaero,only: prescribed_volcaero_init
+ use prescribed_strataero,only: prescribed_strataero_init
+ use cloud_fraction, only: cldfrc_init
+ use cldfrc2m, only: cldfrc2m_init
+ use co2_cycle, only: co2_init, co2_transport
+ use convect_deep, only: convect_deep_init
+ use convect_shallow, only: convect_shallow_init
+ use cam_diagnostics, only: diag_init
+ use gw_drag, only: gw_init
+ use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_init
+ use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_init
+ use radheat, only: radheat_init
+ use radiation, only: radiation_init
+ use cloud_diagnostics, only: cloud_diagnostics_init
+ use rk_stratiform, only: rk_stratiform_init
+ use wv_saturation, only: wv_sat_init
+ use microp_driver, only: microp_driver_init
+ use microp_aero, only: microp_aero_init
+ use macrop_driver, only: macrop_driver_init
+ use conv_water, only: conv_water_init
+ use spcam_drivers, only: spcam_init
+ use tracers, only: tracers_init
+ use aoa_tracers, only: aoa_tracers_init
+ use rayleigh_friction, only: rayleigh_friction_init
+ use pbl_utils, only: pbl_utils_init
+ use vertical_diffusion, only: vertical_diffusion_init
+ use phys_debug_util, only: phys_debug_init
+ use phys_debug, only: phys_debug_state_init
+ use rad_constituents, only: rad_cnst_init
+ use aer_rad_props, only: aer_rad_props_init
+ use subcol, only: subcol_init
+ use qbo, only: qbo_init
+ use qneg_module, only: qneg_init
+ use iondrag, only: iondrag_init, do_waccm_ions
+#if ( defined OFFLINE_DYN )
+ use metdata, only: metdata_phys_init
+#endif
+ use epp_ionization, only: epp_ionization_init, epp_ionization_active
+ use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_init ! Initialization of ionosphere module (WACCM-X)
+ use waccmx_phys_intr, only: waccmx_phys_mspd_init ! Initialization of major species diffusion module (WACCM-X)
+ use clubb_intr, only: clubb_ini_cam
+ use sslt_rebin, only: sslt_rebin_init
+ use tropopause, only: tropopause_init
+ use solar_data, only: solar_data_init
+ use dadadj_cam, only: dadadj_init
+ use cam_abortutils, only: endrun
+ use nudging, only: Nudge_Model, nudging_init
+
+ ! Input/output arguments
+ type(physics_state), pointer :: phys_state(:)
+ type(physics_tend ), pointer :: phys_tend(:)
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ type(cam_out_t),intent(inout) :: cam_out(begchunk:endchunk)
+
+ ! local variables
+ integer :: lchnk
+ integer :: ierr
+
+ !-----------------------------------------------------------------------
+
+ call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols)
+
+ do lchnk = begchunk, endchunk
+ call physics_state_set_grid(lchnk, phys_state(lchnk))
+ end do
+
+ !-------------------------------------------------------------------------------------------
+ ! Initialize any variables in physconst which are not temporally and/or spatially constant
+ !-------------------------------------------------------------------------------------------
+ call physconst_init()
+
+ ! Initialize debugging a physics column
+ call phys_debug_init()
+
+ call pbuf_initialize(pbuf2d)
+
+ ! Initialize subcol scheme
+ call subcol_init(pbuf2d)
+
+ ! diag_init makes addfld calls for dynamics fields that are output from
+ ! the physics decomposition
+ call diag_init(pbuf2d)
+
+ call check_energy_init()
+
+ call tracers_init()
+
+ ! age of air tracers
+ call aoa_tracers_init()
+
+ teout_idx = pbuf_get_index( 'TEOUT')
+
+ ! adiabatic or ideal physics should be only used if in simple_physics
+ if (adiabatic .or. ideal_phys) then
+ if (adiabatic) then
+ call endrun('phys_init: adiabatic configuration error')
+ else
+ call endrun('phys_init: ideal_phys configuration error')
+ end if
+ end if
+
+ if (initial_run) then
+ call phys_inidat(cam_out, pbuf2d)
+ end if
+
+ ! wv_saturation is relatively independent of everything else and
+ ! low level, so init it early. Must at least do this before radiation.
+ call wv_sat_init
+
+ ! CAM3 prescribed aerosols
+ if (cam3_aero_data_on) call cam3_aero_data_init(phys_state)
+
+ ! Initialize rad constituents and their properties
+ call rad_cnst_init()
+ call aer_rad_props_init()
+
+ ! initialize carma
+ call carma_init()
+
+ ! solar irradiance data modules
+ call solar_data_init()
+
+ ! Prognostic chemistry.
+ call chem_init(phys_state,pbuf2d)
+
+ ! Prescribed tracers
+ call prescribed_ozone_init()
+ call prescribed_ghg_init()
+ call prescribed_aero_init()
+ call aerodep_flx_init()
+ call aircraft_emit_init()
+ call prescribed_volcaero_init()
+ call prescribed_strataero_init()
+
+ ! co2 cycle
+ if (co2_transport()) then
+ call co2_init()
+ end if
+
+ ! CAM3 prescribed ozone
+ if (cam3_ozone_data_on) call cam3_ozone_data_init(phys_state)
+
+ call gw_init()
+
+ call rayleigh_friction_init()
+
+ call pbl_utils_init(gravit, karman, cpair, rair, zvir)
+ call vertical_diffusion_init(pbuf2d)
+
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ call waccmx_phys_mspd_init ()
+ ! Initialization of ionosphere module if mode set to ionosphere
+ if( waccmx_is('ionosphere') ) then
+ call waccmx_phys_ion_elec_temp_init(pbuf2d)
+ endif
+ endif
+
+ call radiation_init(pbuf2d)
+
+ call cloud_diagnostics_init()
+
+ call radheat_init(pref_mid)
+
+ call convect_shallow_init(pref_edge, pbuf2d)
+
+ call cldfrc_init()
+ call cldfrc2m_init()
+
+ call convect_deep_init(pref_edge)
+
+ if( microp_scheme == 'RK' ) then
+ call rk_stratiform_init()
+ elseif( microp_scheme == 'MG' ) then
+ if (.not. do_clubb_sgs) call macrop_driver_init(pbuf2d)
+ call microp_aero_init()
+ call microp_driver_init(pbuf2d)
+ call conv_water_init
+ elseif( microp_scheme == 'SPCAM_m2005') then
+ call conv_water_init
+ end if
+
+
+ ! initiate CLUBB within CAM
+ if (do_clubb_sgs) call clubb_ini_cam(pbuf2d)
+
+ call spcam_init(pbuf2d)
+
+ call qbo_init
+
+ call iondrag_init(pref_mid)
+ ! Geomagnetic module -- after iondrag_init
+ if (epp_ionization_active) then
+ call epp_ionization_init()
+ endif
+
+#if ( defined OFFLINE_DYN )
+ call metdata_phys_init()
+#endif
+ call sslt_rebin_init()
+ call tropopause_init()
+ call dadadj_init()
+
+ prec_dp_idx = pbuf_get_index('PREC_DP')
+ snow_dp_idx = pbuf_get_index('SNOW_DP')
+ prec_sh_idx = pbuf_get_index('PREC_SH')
+ snow_sh_idx = pbuf_get_index('SNOW_SH')
+
+ dlfzm_idx = pbuf_get_index('DLFZM', ierr)
+
+ call phys_getopts(prog_modal_aero_out=prog_modal_aero)
+
+ ! Initialize Nudging Parameters
+ !--------------------------------
+ if(Nudge_Model) call nudging_init
+
+ if (clim_modal_aero) then
+
+ ! If climate calculations are affected by prescribed modal aerosols, the
+ ! the initialization routine for the dry mode radius calculation is called
+ ! here. For prognostic MAM the initialization is called from
+ ! modal_aero_initialize
+ if (.not. prog_modal_aero) then
+ call modal_aero_calcsize_init(pbuf2d)
+ endif
+
+ call modal_aero_wateruptake_init(pbuf2d)
+
+ end if
+
+ ! Initialize qneg3 and qneg4
+ call qneg_init()
+
+ end subroutine phys_init
+
+ !
+ !-----------------------------------------------------------------------
+ !
+
+ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out)
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! First part of atmospheric physics package before updating of surface models
+ !
+ !-----------------------------------------------------------------------
+ use time_manager, only: get_nstep
+ use cam_diagnostics,only: diag_allocate, diag_physvar_ic
+ use check_energy, only: check_energy_gmean
+ use phys_control, only: phys_getopts
+ use spcam_drivers, only: tphysbc_spcam
+ use spmd_utils, only: mpicom
+ use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate
+#if (defined BFB_CAM_SCAM_IOP )
+ use cam_history, only: outfld
+#endif
+ use cam_abortutils, only: endrun
+#if ( defined OFFLINE_DYN )
+ use metdata, only: get_met_srf1
+#endif
+ !
+ ! Input arguments
+ !
+ real(r8), intent(in) :: ztodt ! physics time step unless nstep=0
+ !
+ ! Input/Output arguments
+ !
+ type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state
+ type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend
+
+ type(physics_buffer_desc), pointer, dimension(:,:) :: pbuf2d
+ type(cam_in_t), dimension(begchunk:endchunk) :: cam_in
+ type(cam_out_t), dimension(begchunk:endchunk) :: cam_out
+ !-----------------------------------------------------------------------
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+ integer :: c ! indices
+ integer :: ncol ! number of columns
+ integer :: nstep ! current timestep number
+ logical :: use_spcam
+ type(physics_buffer_desc), pointer :: phys_buffer_chunk(:)
+
+ call t_startf ('physpkg_st1')
+ nstep = get_nstep()
+
+#if ( defined OFFLINE_DYN )
+ !
+ ! if offline mode set SNOWH and TS for micro-phys
+ !
+ call get_met_srf1( cam_in )
+#endif
+
+ ! The following initialization depends on the import state (cam_in)
+ ! being initialized. This isn't true when cam_init is called, so need
+ ! to postpone this initialization to here.
+ if (nstep == 0 .and. phys_do_flux_avg()) call flux_avg_init(cam_in, pbuf2d)
+
+ ! Compute total energy of input state and previous output state
+ call t_startf ('chk_en_gmean')
+ call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep)
+ call t_stopf ('chk_en_gmean')
+
+ call t_stopf ('physpkg_st1')
+
+ call t_startf ('physpkg_st1')
+
+ call pbuf_allocate(pbuf2d, 'physpkg')
+ call diag_allocate()
+
+ !-----------------------------------------------------------------------
+ ! Advance time information
+ !-----------------------------------------------------------------------
+
+ call phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d)
+
+ call t_stopf ('physpkg_st1')
+
+#ifdef TRACER_CHECK
+ call gmean_mass ('before tphysbc DRY', phys_state)
+#endif
+
+
+ !-----------------------------------------------------------------------
+ ! Tendency physics before flux coupler invocation
+ !-----------------------------------------------------------------------
+ !
+
+#if (defined BFB_CAM_SCAM_IOP )
+ do c=begchunk, endchunk
+ call outfld('Tg',cam_in(c)%ts,pcols ,c )
+ end do
+#endif
+
+ call t_barrierf('sync_bc_physics', mpicom)
+ call t_startf ('bc_physics')
+ call t_adj_detailf(+1)
+
+ call phys_getopts( use_spcam_out = use_spcam)
+
+!$OMP PARALLEL DO PRIVATE (C, phys_buffer_chunk)
+ do c=begchunk, endchunk
+ !
+ ! Output physics terms to IC file
+ !
+ phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c)
+
+ call t_startf ('diag_physvar_ic')
+ call diag_physvar_ic ( c, phys_buffer_chunk, cam_out(c), cam_in(c) )
+ call t_stopf ('diag_physvar_ic')
+
+ if (use_spcam) then
+ call tphysbc_spcam (ztodt, phys_state(c), &
+ phys_tend(c), phys_buffer_chunk, &
+ cam_out(c), cam_in(c) )
+ else
+ call tphysbc (ztodt, phys_state(c), &
+ phys_tend(c), phys_buffer_chunk, &
+ cam_out(c), cam_in(c) )
+ end if
+
+ end do
+
+ call t_adj_detailf(-1)
+ call t_stopf ('bc_physics')
+
+ ! Don't call the rest in CRM mode
+ if(single_column.and.scm_crm_mode) return
+
+#ifdef TRACER_CHECK
+ call gmean_mass ('between DRY', phys_state)
+#endif
+
+ end subroutine phys_run1
+
+ !
+ !-----------------------------------------------------------------------
+ !
+
+ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, &
+ cam_in )
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! Second part of atmospheric physics package after updating of surface models
+ !
+ !-----------------------------------------------------------------------
+ use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_deallocate, pbuf_update_tim_idx
+ use mo_lightning, only: lightning_no_prod
+ use cam_diagnostics, only: diag_deallocate, diag_surf
+ use physconst, only: stebol, latvap
+ use carma_intr, only: carma_accumulate_stats
+ use spmd_utils, only: mpicom
+#if ( defined OFFLINE_DYN )
+ use metdata, only: get_met_srf2
+#endif
+ !
+ ! Input arguments
+ !
+ real(r8), intent(in) :: ztodt ! physics time step unless nstep=0
+ !
+ ! Input/Output arguments
+ !
+ type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state
+ type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend
+ type(physics_buffer_desc),pointer, dimension(:,:) :: pbuf2d
+
+ type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out
+ type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in
+ !
+ !-----------------------------------------------------------------------
+ !---------------------------Local workspace-----------------------------
+ !
+ integer :: c ! chunk index
+ integer :: ncol ! number of columns
+ type(physics_buffer_desc),pointer, dimension(:) :: phys_buffer_chunk
+ !
+ ! If exit condition just return
+ !
+
+ if(single_column.and.scm_crm_mode) return
+
+ !-----------------------------------------------------------------------
+ ! Tendency physics after coupler
+ ! Not necessary at terminal timestep.
+ !-----------------------------------------------------------------------
+ !
+#if ( defined OFFLINE_DYN )
+ !
+ ! if offline mode set SHFLX QFLX TAUX TAUY for vert diffusion
+ !
+ call get_met_srf2( cam_in )
+#endif
+ ! Set lightning production of NO
+ call t_startf ('lightning_no_prod')
+ call lightning_no_prod( phys_state, pbuf2d, cam_in )
+ call t_stopf ('lightning_no_prod')
+
+ call t_barrierf('sync_ac_physics', mpicom)
+ call t_startf ('ac_physics')
+ call t_adj_detailf(+1)
+
+!$OMP PARALLEL DO PRIVATE (C, NCOL, phys_buffer_chunk)
+
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+ phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c)
+ !
+ ! surface diagnostics for history files
+ !
+ call t_startf('diag_surf')
+ call diag_surf(cam_in(c), cam_out(c), phys_state(c), phys_buffer_chunk)
+ call t_stopf('diag_surf')
+
+ call tphysac(ztodt, cam_in(c), &
+ cam_out(c), &
+ phys_state(c), phys_tend(c), phys_buffer_chunk)
+ end do ! Chunk loop
+
+ call t_adj_detailf(-1)
+ call t_stopf('ac_physics')
+
+#ifdef TRACER_CHECK
+ call gmean_mass ('after tphysac FV:WET)', phys_state)
+#endif
+
+ call t_startf ('carma_accumulate_stats')
+ call carma_accumulate_stats()
+ call t_stopf ('carma_accumulate_stats')
+
+ call t_startf ('physpkg_st2')
+ call pbuf_deallocate(pbuf2d, 'physpkg')
+
+ call pbuf_update_tim_idx()
+ call diag_deallocate()
+ call t_stopf ('physpkg_st2')
+
+ end subroutine phys_run2
+
+ !
+ !-----------------------------------------------------------------------
+ !
+
+ subroutine phys_final( phys_state, phys_tend, pbuf2d )
+ use physics_buffer, only : physics_buffer_desc, pbuf_deallocate
+ use chemistry, only : chem_final
+ use carma_intr, only : carma_final
+ use wv_saturation, only : wv_sat_final
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! Finalization of physics package
+ !
+ !-----------------------------------------------------------------------
+ ! Input/output arguments
+ type(physics_state), pointer :: phys_state(:)
+ type(physics_tend ), pointer :: phys_tend(:)
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ if(associated(pbuf2d)) then
+ call pbuf_deallocate(pbuf2d,'global')
+ deallocate(pbuf2d)
+ end if
+ deallocate(phys_state)
+ deallocate(phys_tend)
+ call chem_final
+ call carma_final
+ call wv_sat_final
+
+ end subroutine phys_final
+
+
+ subroutine tphysac (ztodt, cam_in, &
+ cam_out, state, tend, pbuf)
+ !-----------------------------------------------------------------------
+ !
+ ! Tendency physics after coupling to land, sea, and ice models.
+ !
+ ! Computes the following:
+ !
+ ! o Aerosol Emission at Surface
+ ! o Source-Sink for Advected Tracers
+ ! o Symmetric Turbulence Scheme - Vertical Diffusion
+ ! o Rayleigh Friction
+ ! o Dry Deposition of Aerosol
+ ! o Enforce Charge Neutrality ( Only for WACCM )
+ ! o Gravity Wave Drag
+ ! o QBO Relaxation ( Only for WACCM )
+ ! o Ion Drag ( Only for WACCM )
+ ! o Scale Dry Mass Energy
+ !-----------------------------------------------------------------------
+ use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use chemistry, only: chem_is_active, chem_timestep_tend, chem_emissions
+ use cam_diagnostics, only: diag_phys_tend_writeout
+ use gw_drag, only: gw_tend
+ use vertical_diffusion, only: vertical_diffusion_tend
+ use rayleigh_friction, only: rayleigh_friction_tend
+ use constituents, only: cnst_get_ind
+ use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, &
+ physics_dme_adjust, set_dry_to_wet, physics_state_check
+ use waccmx_phys_intr, only: waccmx_phys_mspd_tend ! WACCM-X major diffusion
+ use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X
+ use aoa_tracers, only: aoa_tracers_timestep_tend
+ use physconst, only: rhoh2o, latvap,latice
+ use aero_model, only: aero_model_drydep
+ use carma_intr, only: carma_emission_tend, carma_timestep_tend
+ use carma_flags_mod, only: carma_do_aerosol, carma_do_emission
+ use check_energy, only: check_energy_chng, calc_te_and_aam_budgets
+ use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng
+ use time_manager, only: get_nstep
+ use cam_abortutils, only: endrun
+ use dycore, only: dycore_is
+ use cam_control_mod, only: aqua_planet
+ use mo_gas_phase_chemdr,only: map2chm
+ use clybry_fam, only: clybry_fam_set
+ use charge_neutrality, only: charge_balance
+ use qbo, only: qbo_relax
+ use iondrag, only: iondrag_calc, do_waccm_ions
+ use perf_mod
+ use flux_avg, only: flux_avg_run
+ use unicon_cam, only: unicon_cam_org_diags
+ use cam_history, only: hist_fld_active
+ use qneg_module, only: qneg4
+ use co2_cycle, only: co2_cycle_set_ptend
+ use nudging, only: Nudge_Model,Nudge_ON,nudging_timestep_tend
+
+ !
+ ! Arguments
+ !
+ real(r8), intent(in) :: ztodt ! Two times model timestep (2 delta-t)
+
+ type(cam_in_t), intent(inout) :: cam_in
+ type(cam_out_t), intent(inout) :: cam_out
+ type(physics_state), intent(inout) :: state
+ type(physics_tend ), intent(inout) :: tend
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+
+ type(check_tracers_data):: tracerint ! tracer mass integrals and cummulative boundary fluxes
+
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+ type(physics_ptend) :: ptend ! indivdual parameterization tendencies
+
+ integer :: nstep ! current timestep number
+ real(r8) :: zero(pcols) ! array of zeros
+
+ integer :: lchnk ! chunk identifier
+ integer :: ncol ! number of atmospheric columns
+ integer i,k,m ! Longitude, level indices
+ integer :: yr, mon, day, tod ! components of a date
+ integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water.
+!AL
+ integer :: ixnumice, ixnumliq
+!AL
+ logical :: labort ! abort flag
+
+ real(r8) tvm(pcols,pver) ! virtual temperature
+ real(r8) prect(pcols) ! total precipitation
+ real(r8) surfric(pcols) ! surface friction velocity
+ real(r8) obklen(pcols) ! Obukhov length
+ real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry
+ real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng.
+ real(r8) :: tmp_q (pcols,pver) ! tmp space
+ real(r8) :: tmp_cldliq(pcols,pver) ! tmp space
+ real(r8) :: tmp_cldice(pcols,pver) ! tmp space
+ real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space
+ real(r8) :: tmp_pdel (pcols,pver) ! tmp space
+ real(r8) :: tmp_t (pcols,pver) !+tht tmp space
+ real(r8) :: tmp_ps (pcols) ! tmp space
+
+ ! physics buffer fields for total energy and mass adjustment
+ integer itim_old, ifld
+
+ real(r8), pointer, dimension(:,:) :: cld
+ real(r8), pointer, dimension(:,:) :: qini
+ real(r8), pointer, dimension(:,:) :: cldliqini
+ real(r8), pointer, dimension(:,:) :: cldiceini
+ real(r8), pointer, dimension(:,:) :: dtcore
+ real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction
+!AL
+ real(r8), pointer, dimension(:,:) :: cldncini
+ real(r8), pointer, dimension(:,:) :: cldniini
+ real(r8) :: tmp_cldnc(pcols,pver) ! tmp space
+ real(r8) :: tmp_cldni(pcols,pver) ! tmp space
+!AL
+
+ !tht: variables for dme_energy_adjust
+ real(r8):: eflx(pcols), dsema(pcols)
+ logical, parameter:: ohf_adjust =.true. ! condensates have surface specific enthalpy
+
+ !-----------------------------------------------------------------------
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ nstep = get_nstep()
+
+ ! Adjust the surface fluxes to reduce instabilities in near sfc layer
+ if (phys_do_flux_avg()) then
+ call flux_avg_run(state, cam_in, pbuf, nstep, ztodt)
+ endif
+
+ ! Validate the physics state.
+ if (state_debug_checks) &
+ call physics_state_check(state, name="before tphysac")
+
+ call t_startf('tphysac_init')
+ ! Associate pointers with physics buffer fields
+ itim_old = pbuf_old_tim_idx()
+
+
+ ifld = pbuf_get_index('DTCORE')
+ call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+ call pbuf_get_field(pbuf, qini_idx, qini)
+ call pbuf_get_field(pbuf, cldliqini_idx, cldliqini)
+ call pbuf_get_field(pbuf, cldiceini_idx, cldiceini)
+!AL
+ call pbuf_get_field(pbuf, cldncini_idx, cldncini)
+ call pbuf_get_field(pbuf, cldniini_idx, cldniini)
+!AL
+
+ ifld = pbuf_get_index('CLD')
+ call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/))
+
+ ifld = pbuf_get_index('AST')
+ call pbuf_get_field(pbuf, ifld, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+ !
+ ! accumulate fluxes into net flux array for spectral dycores
+ ! jrm Include latent heat of fusion for snow
+ !
+ do i=1,ncol
+ tend%flx_net(i) = tend%flx_net(i) + cam_in%shf(i) + (cam_out%precc(i) &
+ + cam_out%precl(i))*latvap*rhoh2o &
+ + (cam_out%precsc(i) + cam_out%precsl(i))*latice*rhoh2o
+ end do
+
+ ! emissions of aerosols and gas-phase chemistry constituents at surface
+ call chem_emissions( state, cam_in )
+
+ if (carma_do_emission) then
+ ! carma emissions
+ call carma_emission_tend (state, ptend, cam_in, ztodt)
+ call physics_update(state, ptend, ztodt, tend)
+ end if
+
+ ! get nstep and zero array for energy checker
+ zero = 0._r8
+ nstep = get_nstep()
+ call check_tracers_init(state, tracerint)
+
+ ! Check if latent heat flux exceeds the total moisture content of the
+ ! lowest model layer, thereby creating negative moisture.
+
+ call qneg4('TPHYSAC', lchnk, ncol, ztodt , &
+ state%q(1,pver,1), state%rpdel(1,pver), &
+ cam_in%shf, cam_in%lhf, cam_in%cflx)
+
+ call t_stopf('tphysac_init')
+ !===================================================
+ ! Source/sink terms for advected tracers.
+ !===================================================
+ call t_startf('adv_tracer_src_snk')
+ ! Test tracers
+
+ call aoa_tracers_timestep_tend(state, ptend, cam_in%cflx, cam_in%landfrac, ztodt)
+ call physics_update(state, ptend, ztodt, tend)
+ call check_tracers_chng(state, tracerint, "aoa_tracers_timestep_tend", nstep, ztodt, &
+ cam_in%cflx)
+
+ call co2_cycle_set_ptend(state, pbuf, ptend)
+ call physics_update(state, ptend, ztodt, tend)
+
+ !===================================================
+ ! Chemistry and MAM calculation
+ ! MAM core aerosol conversion process is performed in the below 'chem_timestep_tend'.
+ ! In addition, surface flux of aerosol species other than 'dust' and 'sea salt', and
+ ! elevated emission of aerosol species are treated in 'chem_timestep_tend' before
+ ! Gas chemistry and MAM core aerosol conversion.
+ ! Note that surface flux is not added into the atmosphere, but elevated emission is
+ ! added into the atmosphere as tendency.
+ !===================================================
+ if (chem_is_active()) then
+ call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, &
+ pbuf, fh2o=fh2o)
+
+ call physics_update(state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "chem", nstep, ztodt, fh2o, zero, zero, zero)
+ call check_tracers_chng(state, tracerint, "chem_timestep_tend", nstep, ztodt, &
+ cam_in%cflx)
+ end if
+ call t_stopf('adv_tracer_src_snk')
+
+ !===================================================
+ ! Vertical diffusion/pbl calculation
+ ! Call vertical diffusion code (pbl, free atmosphere and molecular)
+ !===================================================
+
+ call t_startf('vertical_diffusion_tend')
+ call vertical_diffusion_tend (ztodt ,state , cam_in, &
+ surfric ,obklen ,ptend ,ast ,pbuf )
+
+ !------------------------------------------
+ ! Call major diffusion for extended model
+ !------------------------------------------
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ call waccmx_phys_mspd_tend (ztodt ,state ,ptend)
+ endif
+
+ call physics_update(state, ptend, ztodt, tend)
+
+ call t_stopf ('vertical_diffusion_tend')
+
+ !===================================================
+ ! Rayleigh friction calculation
+ !===================================================
+ call t_startf('rayleigh_friction')
+ call rayleigh_friction_tend( ztodt, state, ptend)
+ call physics_update(state, ptend, ztodt, tend)
+ call t_stopf('rayleigh_friction')
+
+ if (do_clubb_sgs) then
+ call check_energy_chng(state, tend, "vdiff", nstep, ztodt, zero, zero, zero, zero)
+ else
+ call check_energy_chng(state, tend, "vdiff", nstep, ztodt, cam_in%cflx(:,1), zero, &
+ zero, cam_in%shf)
+ endif
+
+ call check_tracers_chng(state, tracerint, "vdiff", nstep, ztodt, cam_in%cflx)
+
+ ! aerosol dry deposition processes
+ call t_startf('aero_drydep')
+ call aero_model_drydep( state, pbuf, obklen, surfric, cam_in, ztodt, cam_out, ptend )
+ call physics_update(state, ptend, ztodt, tend)
+ call t_stopf('aero_drydep')
+
+ ! CARMA microphysics
+ !
+ ! NOTE: This does both the timestep_tend for CARMA aerosols as well as doing the dry
+ ! deposition for CARMA aerosols. It needs to follow vertical_diffusion_tend, so that
+ ! obklen and surfric have been calculated. It needs to follow aero_model_drydep, so
+ ! that cam_out%xxxdryxxx fields have already been set for CAM aerosols and cam_out
+ ! can be added to for CARMA aerosols.
+ if (carma_do_aerosol) then
+ call t_startf('carma_timestep_tend')
+ call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric)
+ call physics_update(state, ptend, ztodt, tend)
+
+ call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero)
+ call t_stopf('carma_timestep_tend')
+ end if
+
+
+ !---------------------------------------------------------------------------------
+ ! ... enforce charge neutrality
+ !---------------------------------------------------------------------------------
+ call charge_balance(state, pbuf)
+
+ !===================================================
+ ! Gravity wave drag
+ !===================================================
+ call t_startf('gw_tend')
+
+ call gw_tend(state, pbuf, ztodt, ptend, cam_in, flx_heat)
+
+ call physics_update(state, ptend, ztodt, tend)
+ ! Check energy integrals
+ call check_energy_chng(state, tend, "gwdrag", nstep, ztodt, zero, &
+ zero, zero, flx_heat)
+ call t_stopf('gw_tend')
+
+ ! QBO relaxation
+ call qbo_relax(state, pbuf, ptend)
+ call physics_update(state, ptend, ztodt, tend)
+ ! Check energy integrals
+ call check_energy_chng(state, tend, "qborelax", nstep, ztodt, zero, zero, zero, zero)
+
+ ! Ion drag calculation
+ call t_startf ( 'iondrag' )
+
+ if ( do_waccm_ions ) then
+ call iondrag_calc( lchnk, ncol, state, ptend, pbuf, ztodt )
+ else
+ call iondrag_calc( lchnk, ncol, state, ptend)
+ endif
+ !----------------------------------------------------------------------------
+ ! Call ionosphere routines for extended model if mode is set to ionosphere
+ !----------------------------------------------------------------------------
+ if( waccmx_is('ionosphere') ) then
+ call waccmx_phys_ion_elec_temp_tend(state, ptend, pbuf, ztodt)
+ endif
+
+ call physics_update(state, ptend, ztodt, tend)
+ call calc_te_and_aam_budgets(state, 'pAP')
+
+ !---------------------------------------------------------------------------------
+ ! Enforce charge neutrality after O+ change from ionos_tend
+ !---------------------------------------------------------------------------------
+ if( waccmx_is('ionosphere') ) then
+ call charge_balance(state, pbuf)
+ endif
+
+ ! Check energy integrals
+ call check_energy_chng(state, tend, "iondrag", nstep, ztodt, zero, zero, zero, zero)
+
+ call t_stopf ( 'iondrag' )
+
+ ! Update Nudging values, if needed
+ !----------------------------------
+ if((Nudge_Model).and.(Nudge_ON)) then
+ call nudging_timestep_tend(state,ptend)
+ call physics_update(state,ptend,ztodt,tend)
+ call check_energy_chng(state, tend, "nudging", nstep, ztodt, zero, zero, zero, zero)
+ endif
+
+ !-------------- Energy budget checks vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
+
+ ! Save total energy for global fixer in next timestep (FV and SE dycores)
+ call pbuf_set_field(pbuf, teout_idx, state%te_cur, (/1,itim_old/),(/pcols,1/))
+
+ if (shallow_scheme .eq. 'UNICON') then
+
+ ! ------------------------------------------------------------------------
+ ! Insert the organization-related heterogeneities computed inside the
+ ! UNICON into the tracer arrays here before performing advection.
+ ! This is necessary to prevent any modifications of organization-related
+ ! heterogeneities by non convection-advection process, such as
+ ! dry and wet deposition of aerosols, MAM, etc.
+ ! Again, note that only UNICON and advection schemes are allowed to
+ ! changes to organization at this stage, although we can include the
+ ! effects of other physical processes in future.
+ ! ------------------------------------------------------------------------
+
+ call unicon_cam_org_diags(state, pbuf)
+
+ end if
+ !
+ ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust
+ ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004.
+ if ( dycore_is('LR')) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist
+
+ ! Scale dry mass and energy (does nothing if dycore is EUL or SLD)
+ call cnst_get_ind('CLDLIQ', ixcldliq)
+ call cnst_get_ind('CLDICE', ixcldice)
+ tmp_t (:ncol,:pver) = state%t(:ncol,:pver) !+tht
+ tmp_q (:ncol,:pver) = state%q(:ncol,:pver,1)
+ tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq)
+ tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice)
+!AL
+ call cnst_get_ind('NUMLIQ', ixnumliq)
+ call cnst_get_ind('NUMICE', ixnumice)
+ tmp_cldnc(:ncol,:pver) = state%q(:ncol,:pver,ixnumliq)
+ tmp_cldni(:ncol,:pver) = state%q(:ncol,:pver,ixnumice)
+!AL
+ ! For 'SE', physics_dme_adjust is called for energy diagnostic purposes only. So, save off tracers
+ if (dycore_is('SE').and.hist_fld_active('SE_pAM').or.hist_fld_active('KE_pAM').or.hist_fld_active('WV_pAM').or.&
+ hist_fld_active('WL_pAM').or.hist_fld_active('WI_pAM')) then
+ tmp_trac(:ncol,:pver,:pcnst) = state%q(:ncol,:pver,:pcnst)
+ tmp_pdel(:ncol,:pver) = state%pdel(:ncol,:pver)
+ tmp_ps(:ncol) = state%ps(:ncol)
+ !
+ ! pint, lnpint,rpdel are altered by dme_adjust but not used for tendencies in dynamics of SE
+ ! we do not reset them to pre-dme_adjust values
+ !
+ if (dycore_is('SE')) call set_dry_to_wet(state)
+ call physics_dme_adjust(state, tend, qini, ztodt)
+ call calc_te_and_aam_budgets(state, 'pAM')
+ ! Restore pre-"physics_dme_adjust" tracers
+ state%q(:ncol,:pver,:pcnst) = tmp_trac(:ncol,:pver,:pcnst)
+ state%pdel(:ncol,:pver) = tmp_pdel(:ncol,:pver)
+ state%ps(:ncol) = tmp_ps(:ncol)
+ end if
+
+!+tht
+ !if (dycore_is('LR')) call physics_dme_adjust(state, tend, qini, ztodt)
+ if (dycore_is('LR')) &
+ call physics_dme_adjust(state, tend, qini, ztodt, eflx, dsema, &
+ ohf_adjust, cam_in%ocnfrac, cam_in%sst, cam_in%ts)
+!-tht
+
+!!! REMOVE THIS CALL, SINCE ONLY Q IS BEING ADJUSTED. WON'T BALANCE ENERGY. TE IS SAVED BEFORE THIS
+!!! call check_energy_chng(state, tend, "drymass", nstep, ztodt, zero, zero, zero, zero)
+
+ ! store T in buffer for use in computing dynamics T-tendency in next timestep
+ do k = 1,pver
+ dtcore(:ncol,k) = state%t(:ncol,k)
+ end do
+
+ !-------------- Energy budget checks ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+ if (aqua_planet) then
+ labort = .false.
+ do i=1,ncol
+ if (cam_in%ocnfrac(i) /= 1._r8) labort = .true.
+ end do
+ if (labort) then
+ call endrun ('TPHYSAC error: grid contains non-ocean point')
+ endif
+ endif
+
+!AL+tht
+ !call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, &
+ ! qini, cldliqini, cldiceini)
+ call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_t, tmp_cldliq, tmp_cldice, &
+ tmp_cldnc,tmp_cldni,qini, cldliqini, cldiceini, cldncini, cldniini, eflx, dsema )
+!AL-tht
+
+ call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf )
+
+ end subroutine tphysac
+
+ subroutine tphysbc (ztodt, state, &
+ tend, pbuf, &
+ cam_out, cam_in )
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! Evaluate and apply physical processes that are calculated BEFORE
+ ! coupling to land, sea, and ice models.
+ !
+ ! Processes currently included are:
+ !
+ ! o Resetting Negative Tracers to Positive
+ ! o Global Mean Total Energy Fixer
+ ! o Dry Adjustment
+ ! o Asymmetric Turbulence Scheme : Deep Convection & Shallow Convection
+ ! o Stratiform Macro-Microphysics
+ ! o Wet Scavenging of Aerosol
+ ! o Radiation
+ !
+ ! Method:
+ !
+ ! Each parameterization should be implemented with this sequence of calls:
+ ! 1) Call physics interface
+ ! 2) Check energy
+ ! 3) Call physics_update
+ ! See Interface to Column Physics and Chemistry Packages
+ ! http://www.ccsm.ucar.edu/models/atm-cam/docs/phys-interface/index.html
+ !
+ !-----------------------------------------------------------------------
+
+ use physics_buffer, only: physics_buffer_desc, pbuf_get_field
+ use physics_buffer, only: pbuf_get_index, pbuf_old_tim_idx
+ use physics_buffer, only: col_type_subcol, dyn_time_lvls
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ use dadadj_cam, only: dadadj_tend
+ use rk_stratiform, only: rk_stratiform_tend
+ use microp_driver, only: microp_driver_tend
+ use microp_aero, only: microp_aero_run
+ use macrop_driver, only: macrop_driver_tend
+ use physics_types, only: physics_state, physics_tend, physics_ptend, &
+ physics_update, physics_ptend_init, physics_ptend_sum, &
+ physics_state_check, physics_ptend_scale
+ use cam_diagnostics, only: diag_conv_tend_ini, diag_phys_writeout, diag_conv, diag_export, diag_state_b4_phys_write
+ use cam_history, only: outfld
+ use physconst, only: cpair, latvap
+ use constituents, only: pcnst, qmin, cnst_get_ind
+ use convect_deep, only: convect_deep_tend, convect_deep_tend_2, deep_scheme_does_scav_trans
+ use time_manager, only: is_first_step, get_nstep
+ use convect_shallow, only: convect_shallow_tend
+ use check_energy, only: check_energy_chng, check_energy_fix, check_energy_timestep_init
+ use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng
+ use check_energy, only: calc_te_and_aam_budgets
+ use dycore, only: dycore_is
+ use aero_model, only: aero_model_wetdep
+ use carma_intr, only: carma_wetdep_tend, carma_timestep_tend
+ use carma_flags_mod, only: carma_do_detrain, carma_do_cldice, carma_do_cldliq, carma_do_wetdep
+ use radiation, only: radiation_tend
+ use cloud_diagnostics, only: cloud_diagnostics_calc
+ use perf_mod
+ use mo_gas_phase_chemdr,only: map2chm
+ use clybry_fam, only: clybry_fam_adj
+ use clubb_intr, only: clubb_tend_cam
+ use sslt_rebin, only: sslt_rebin_adv
+ use tropopause, only: tropopause_output
+ use cam_abortutils, only: endrun
+ use subcol, only: subcol_gen, subcol_ptend_avg
+ use subcol_utils, only: subcol_ptend_copy, is_subcol_on
+ use qneg_module, only: qneg3
+
+#ifdef OSLO_AERO
+ use commondefinitions
+ use aerosoldef !, only: nmodes
+#endif
+
+ implicit none
+
+ real(r8), intent(in) :: ztodt ! 2 delta t (model time increment)
+
+ type(physics_state), intent(inout) :: state
+ type(physics_tend ), intent(inout) :: tend
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ type(cam_out_t), intent(inout) :: cam_out
+ type(cam_in_t), intent(in) :: cam_in
+
+
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+
+ type(physics_ptend) :: ptend ! indivdual parameterization tendencies
+ type(physics_state) :: state_sc ! state for sub-columns
+ type(physics_ptend) :: ptend_sc ! ptend for sub-columns
+ type(physics_ptend) :: ptend_aero ! ptend for microp_aero
+ type(physics_ptend) :: ptend_aero_sc ! ptend for microp_aero on sub-columns
+ type(physics_tend) :: tend_sc ! tend for sub-columns
+
+ integer :: nstep ! current timestep number
+
+ real(r8) :: net_flx(pcols)
+
+ real(r8) :: zdu(pcols,pver) ! detraining mass flux from deep convection
+ real(r8) :: cmfmc(pcols,pverp) ! Convective mass flux--m sub c
+
+ real(r8) cmfcme(pcols,pver) ! cmf condensation - evaporation
+
+ real(r8) dlf(pcols,pver) ! Detraining cld H20 from shallow + deep convections
+ real(r8) dlf2(pcols,pver) ! Detraining cld H20 from shallow convections
+ real(r8) pflx(pcols,pverp) ! Conv rain flux thru out btm of lev
+
+ integer lchnk ! chunk identifier
+ integer ncol ! number of atmospheric columns
+
+ integer :: i,k,m ! Longitude, level, constituent indices
+ integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water.
+!AL
+ integer :: ixcldni, ixcldnc ! constituent indices for cloud liquid and ice water.
+!AL
+ ! for macro/micro co-substepping
+ integer :: macmic_it ! iteration variables
+ real(r8) :: cld_macmic_ztodt ! modified timestep
+#ifdef OSLO_AERO
+ integer kcomp ! mode number (1-14)
+#endif
+
+ ! physics buffer fields to compute tendencies for stratiform package
+ integer itim_old, ifld
+ real(r8), pointer, dimension(:,:) :: cld ! cloud fraction
+
+
+ ! physics buffer fields for total energy and mass adjustment
+ real(r8), pointer, dimension(: ) :: teout
+ real(r8), pointer, dimension(:,:) :: qini
+ real(r8), pointer, dimension(:,:) :: cldliqini
+ real(r8), pointer, dimension(:,:) :: cldiceini
+ real(r8), pointer, dimension(:,:) :: dtcore
+!AL
+ real(r8), pointer, dimension(:,:) :: cldncini
+ real(r8), pointer, dimension(:,:) :: cldniini
+!AL
+ real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble
+
+ real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio.
+
+ ! convective precipitation variables
+ real(r8),pointer :: prec_dp(:) ! total precipitation from ZM convection
+ real(r8),pointer :: snow_dp(:) ! snow from ZM convection
+ real(r8),pointer :: prec_sh(:) ! total precipitation from Hack convection
+ real(r8),pointer :: snow_sh(:) ! snow from Hack convection
+
+ ! carma precipitation variables
+ real(r8) :: prec_sed_carma(pcols) ! total precip from cloud sedimentation (CARMA)
+ real(r8) :: snow_sed_carma(pcols) ! snow from cloud ice sedimentation (CARMA)
+
+ ! stratiform precipitation variables
+ real(r8),pointer :: prec_str(:) ! sfc flux of precip from stratiform (m/s)
+ real(r8),pointer :: snow_str(:) ! sfc flux of snow from stratiform (m/s)
+ real(r8),pointer :: prec_str_sc(:) ! sfc flux of precip from stratiform (m/s) -- for subcolumns
+ real(r8),pointer :: snow_str_sc(:) ! sfc flux of snow from stratiform (m/s) -- for subcolumns
+ real(r8),pointer :: prec_pcw(:) ! total precip from prognostic cloud scheme
+ real(r8),pointer :: snow_pcw(:) ! snow from prognostic cloud scheme
+ real(r8),pointer :: prec_sed(:) ! total precip from cloud sedimentation
+ real(r8),pointer :: snow_sed(:) ! snow from cloud ice sedimentation
+
+ ! Local copies for substepping
+ real(r8) :: prec_pcw_macmic(pcols)
+ real(r8) :: snow_pcw_macmic(pcols)
+ real(r8) :: prec_sed_macmic(pcols)
+ real(r8) :: snow_sed_macmic(pcols)
+
+ ! energy checking variables
+ real(r8) :: zero(pcols) ! array of zeros
+ real(r8) :: zero_sc(pcols*psubcols) ! array of zeros
+ real(r8) :: rliq(pcols) ! vertical integral of liquid not yet in q(ixcldliq)
+ real(r8) :: rice(pcols) ! vertical integral of ice not yet in q(ixcldice)
+ real(r8) :: rliq2(pcols) ! vertical integral of liquid from shallow scheme
+ real(r8) :: det_s (pcols) ! vertical integral of detrained static energy from ice
+ real(r8) :: det_ice(pcols) ! vertical integral of detrained ice
+ real(r8) :: flx_cnd(pcols)
+ real(r8) :: flx_heat(pcols)
+ type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes
+ real(r8) :: zero_tracers(pcols,pcnst)
+
+ logical :: lq(pcnst)
+
+#ifdef AEROCOM
+ real(r8) :: logsig3d(pcols,pver,nmodes) ! Log (log10) of standard deviation for lognormal modes, method 2.
+ real(r8) :: rnew3d(pcols,pver,nmodes) ! New modal radius from look-up tables, method 2.
+ real(r8) :: logsig1(pcols,pver) ! Log (log10) of standard deviation for lognormal mode 1, method 2.
+ real(r8) :: rnew1(pcols,pver) ! New modal radius, mode 1, from look-up tables, method 2.
+ real(r8) :: logsig2(pcols,pver) ! Log (log10) of standard deviation for lognormal mode 2, method 2.
+ real(r8) :: rnew2(pcols,pver) ! New modal radius, mode 2, from look-up tables, method 2.
+ real(r8) :: logsig4(pcols,pver) ! Log (log10) of standard deviation for lognormal mode 4, method 2.
+ real(r8) :: rnew4(pcols,pver) ! New modal radius, mode 4, from look-up tables, method 2.
+ real(r8) :: logsig5(pcols,pver) ! Log (log10) of standard deviation for lognormal mode 5, method 2.
+ real(r8) :: rnew5(pcols,pver) ! New modal radius, mode 5, from look-up tables, method 2.
+ real(r8) :: logsig6(pcols,pver) ! Log (log10) of standard deviation for lognormal mode 6, method 2.
+ real(r8) :: rnew6(pcols,pver) ! New modal radius, mode 6, from look-up tables, method 2.
+ real(r8) :: logsig7(pcols,pver) ! Log (log10) of standard deviation for lognormal mode 7, method 2.
+ real(r8) :: rnew7(pcols,pver) ! New modal radius, mode 7, from look-up tables, method 2.
+ real(r8) :: logsig8(pcols,pver) ! Log (log10) of standard deviation for lognormal mode 8, method 2.
+ real(r8) :: rnew8(pcols,pver) ! New modal radius, mode 8, from look-up tables, method 2.
+ real(r8) :: logsig9(pcols,pver) ! Log (log10) of standard deviation for lognormal mode 9, method 2.
+ real(r8) :: rnew9(pcols,pver) ! New modal radius, mode 9, from look-up tables, method 2.
+ real(r8) :: logsig10(pcols,pver)! Log (log10) of standard deviation for lognormal modes 10, method 2.
+ real(r8) :: rnew10(pcols,pver) ! New modal radius, mode 10, from look-up tables, method 2.
+ real(r8) :: logsig11(pcols,pver)! Log (log10) of standard deviation for lognormal modes 11, method 2.
+ real(r8) :: rnew11(pcols,pver) ! New modal radius, mode 11, from look-up tables, method 2.
+ real(r8) :: logsig13(pcols,pver)! Log (log10) of standard deviation for lognormal modes 13, method 2.
+ real(r8) :: rnew13(pcols,pver) ! New modal radius, mode 13, from look-up tables, method 2.
+ real(r8) :: logsig14(pcols,pver)! Log (log10) of standard deviation for lognormal modes 14, method 2.
+ real(r8) :: rnew14(pcols,pver) ! New modal radius, mode 14, from look-up tables, method 2.
+ real(r8) :: rnewdry1(pcols,pver) ! New dry modal radius, mode 1, from look-up tables, method 2.
+ real(r8) :: rnewdry2(pcols,pver) ! New dry modal radius, mode 2, from look-up tables, method 2.
+ real(r8) :: rnewdry4(pcols,pver) ! New dry modal radius, mode 4, from look-up tables, method 2.
+ real(r8) :: rnewdry5(pcols,pver) ! New dry modal radius, mode 5, from look-up tables, method 2.
+ real(r8) :: rnewdry6(pcols,pver) ! New dry modal radius, mode 6, from look-up tables, method 2.
+ real(r8) :: rnewdry7(pcols,pver) ! New dry modal radius, mode 7, from look-up tables, method 2.
+ real(r8) :: rnewdry8(pcols,pver) ! New dry modal radius, mode 8, from look-up tables, method 2.
+ real(r8) :: rnewdry9(pcols,pver) ! New dry modal radius, mode 9, from look-up tables, method 2.
+ real(r8) :: rnewdry10(pcols,pver) ! New dry modal radius, mode 10, from look-up tables, method 2.
+ real(r8) :: rnewdry11(pcols,pver) ! New dry modal radius, mode 11, from look-up tables, method 2.
+ real(r8) :: rnewdry13(pcols,pver) ! New dry modal radius, mode 13, from look-up tables, method 2.
+ real(r8) :: rnewdry14(pcols,pver) ! New dry modal radius, mode 14, from look-up tables, method 2.
+ real(r8) :: relhum(pcols,pver) ! Ambient relative humidity (fraction)
+ real(r8) :: v3so4(pcols,pver,nmodes) ! Modal mass fraction of Sulfate
+ real(r8) :: v3insol(pcols,pver,nmodes)! Modal mass fraction of BC and dust
+ real(r8) :: v3oc(pcols,pver,nmodes) ! Modal mass fraction of OC (POM)
+ real(r8) :: v3ss(pcols,pver,nmodes) ! Modal mass fraction of sea-salt
+ real(r8) :: frh(pcols,pver,nmodes) ! Modal humidity growth factor
+#endif ! aerocom
+ !-----------------------------------------------------------------------
+
+ call t_startf('bc_init')
+
+ zero = 0._r8
+ zero_tracers(:,:) = 0._r8
+ zero_sc(:) = 0._r8
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ nstep = get_nstep()
+
+ ! Associate pointers with physics buffer fields
+ itim_old = pbuf_old_tim_idx()
+ ifld = pbuf_get_index('CLD')
+ call pbuf_get_field(pbuf, ifld, cld, (/1,1,itim_old/),(/pcols,pver,1/))
+
+ call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/))
+
+ call pbuf_get_field(pbuf, qini_idx, qini)
+ call pbuf_get_field(pbuf, cldliqini_idx, cldliqini)
+ call pbuf_get_field(pbuf, cldiceini_idx, cldiceini)
+!AL
+ call pbuf_get_field(pbuf, cldncini_idx, cldncini)
+ call pbuf_get_field(pbuf, cldniini_idx, cldniini)
+!AL
+
+ ifld = pbuf_get_index('DTCORE')
+ call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+ ifld = pbuf_get_index('FRACIS')
+ call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) )
+ fracis (:ncol,:,1:pcnst) = 1._r8
+
+ ! Set physics tendencies to 0
+ tend %dTdt(:ncol,:pver) = 0._r8
+ tend %dudt(:ncol,:pver) = 0._r8
+ tend %dvdt(:ncol,:pver) = 0._r8
+
+ ! Verify state coming from the dynamics
+ if (state_debug_checks) &
+ call physics_state_check(state, name="before tphysbc (dycore?)")
+
+ call clybry_fam_adj( ncol, lchnk, map2chm, state%q, pbuf )
+
+ ! Since clybry_fam_adj operates directly on the tracers, and has no
+ ! physics_update call, re-run qneg3.
+
+ call qneg3('TPHYSBCc',lchnk ,ncol ,pcols ,pver , &
+ 1, pcnst, qmin ,state%q )
+
+ ! Validate output of clybry_fam_adj.
+ if (state_debug_checks) &
+ call physics_state_check(state, name="clybry_fam_adj")
+
+ !
+ ! Dump out "before physics" state
+ !
+ call diag_state_b4_phys_write (state)
+
+ ! compute mass integrals of input tracers state
+ call check_tracers_init(state, tracerint)
+
+ call t_stopf('bc_init')
+
+ !===================================================
+ ! Global mean total energy fixer
+ !===================================================
+ call t_startf('energy_fixer')
+
+ call calc_te_and_aam_budgets(state, 'pBF')
+ if (dycore_is('LR') .or. dycore_is('SE')) then
+ call check_energy_fix(state, ptend, nstep, flx_heat)
+ call physics_update(state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat)
+ call outfld( 'EFIX', flx_heat , pcols, lchnk )
+ end if
+ call calc_te_and_aam_budgets(state, 'pBP')
+ ! Save state for convective tendency calculations.
+ call diag_conv_tend_ini(state, pbuf)
+
+ call cnst_get_ind('CLDLIQ', ixcldliq)
+ call cnst_get_ind('CLDICE', ixcldice)
+ qini (:ncol,:pver) = state%q(:ncol,:pver, 1)
+ cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq)
+ cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice)
+!AL
+ call cnst_get_ind('NUMLIQ', ixcldnc)
+ call cnst_get_ind('NUMICE', ixcldni)
+ cldncini(:ncol,:pver) = state%q(:ncol,:pver,ixcldnc)
+ cldniini(:ncol,:pver) = state%q(:ncol,:pver,ixcldni)
+!AL
+
+ call outfld('TEOUT', teout , pcols, lchnk )
+ call outfld('TEINP', state%te_ini, pcols, lchnk )
+ call outfld('TEFIX', state%te_cur, pcols, lchnk )
+
+ ! T tendency due to dynamics
+ if( nstep > dyn_time_lvls-1 ) then
+ dtcore(:ncol,:pver) = (state%t(:ncol,:pver) - dtcore(:ncol,:pver))/ztodt
+ call outfld( 'DTCORE', dtcore, pcols, lchnk )
+ end if
+
+ call t_stopf('energy_fixer')
+ !
+ !===================================================
+ ! Dry adjustment
+ !===================================================
+ call t_startf('dry_adjustment')
+
+ call dadadj_tend(ztodt, state, ptend)
+
+ call physics_update(state, ptend, ztodt, tend)
+
+ call t_stopf('dry_adjustment')
+
+ !===================================================
+ ! Moist convection
+ !===================================================
+ call t_startf('moist_convection')
+
+ call t_startf ('convect_deep_tend')
+
+ call convect_deep_tend( &
+ cmfmc, cmfcme, &
+ pflx, zdu, &
+ rliq, rice, &
+ ztodt, &
+ state, ptend, cam_in%landfrac, pbuf)
+
+ call physics_update(state, ptend, ztodt, tend)
+
+ call t_stopf('convect_deep_tend')
+
+ call pbuf_get_field(pbuf, prec_dp_idx, prec_dp )
+ call pbuf_get_field(pbuf, snow_dp_idx, snow_dp )
+ call pbuf_get_field(pbuf, prec_sh_idx, prec_sh )
+ call pbuf_get_field(pbuf, snow_sh_idx, snow_sh )
+ call pbuf_get_field(pbuf, prec_str_idx, prec_str )
+ call pbuf_get_field(pbuf, snow_str_idx, snow_str )
+ call pbuf_get_field(pbuf, prec_sed_idx, prec_sed )
+ call pbuf_get_field(pbuf, snow_sed_idx, snow_sed )
+ call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw )
+ call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw )
+
+ if (use_subcol_microp) then
+ call pbuf_get_field(pbuf, prec_str_idx, prec_str_sc, col_type=col_type_subcol)
+ call pbuf_get_field(pbuf, snow_str_idx, snow_str_sc, col_type=col_type_subcol)
+ end if
+
+ ! Check energy integrals, including "reserved liquid"
+ flx_cnd(:ncol) = prec_dp(:ncol) + rliq(:ncol)
+ snow_dp(:ncol) = snow_dp(:ncol) + rice(:ncol)
+ call check_energy_chng(state, tend, "convect_deep", nstep, ztodt, zero, flx_cnd, snow_dp, zero)
+ snow_dp(:ncol) = snow_dp(:ncol) - rice(:ncol)
+
+ !
+ ! Call Hack (1994) convection scheme to deal with shallow/mid-level convection
+ !
+ call t_startf ('convect_shallow_tend')
+
+ if (dlfzm_idx > 0) then
+ call pbuf_get_field(pbuf, dlfzm_idx, dlfzm)
+ dlf(:ncol,:) = dlfzm(:ncol,:)
+ else
+ dlf(:,:) = 0._r8
+ end if
+
+ call convect_shallow_tend (ztodt , cmfmc, &
+ dlf , dlf2 , rliq , rliq2, &
+ state , ptend , pbuf, cam_in)
+ call t_stopf ('convect_shallow_tend')
+
+ call physics_update(state, ptend, ztodt, tend)
+
+ flx_cnd(:ncol) = prec_sh(:ncol) + rliq2(:ncol)
+ call check_energy_chng(state, tend, "convect_shallow", nstep, ztodt, zero, flx_cnd, snow_sh, zero)
+
+ call check_tracers_chng(state, tracerint, "convect_shallow", nstep, ztodt, zero_tracers)
+
+ call t_stopf('moist_convection')
+
+ ! Rebin the 4-bin version of sea salt into bins for coarse and accumulation
+ ! modes that correspond to the available optics data. This is only necessary
+ ! for CAM-RT. But it's done here so that the microphysics code which is called
+ ! from the stratiform interface has access to the same aerosols as the radiation
+ ! code.
+ call sslt_rebin_adv(pbuf, state)
+
+#ifdef DIRIND
+! do i=1,ncol
+! precc (i) = prec_zmc(i) + prec_cmf(i)
+! if(precc(i).lt.0.) precc(i)=0.
+! end do
+#ifdef AEROCOM
+ do kcomp=1,14
+ do k=1,pver
+ do i=1,ncol
+ rnew3d(i,k,kcomp) =0.0_r8
+ logsig3d(i,k,kcomp)=0.0_r8
+ enddo
+ enddo
+ enddo
+#endif ! aerocom
+#endif ! dirind
+
+
+ !===================================================
+ ! Calculate tendencies from CARMA bin microphysics.
+ !===================================================
+ !
+ ! If CARMA is doing detrainment, then on output, rliq no longer represents water reserved
+ ! for detrainment, but instead represents potential snow fall. The mass and number of the
+ ! snow are stored in the physics buffer and will be incorporated by the MG microphysics.
+ !
+ ! Currently CARMA cloud microphysics is only supported with the MG microphysics.
+ call t_startf('carma_timestep_tend')
+
+ if (carma_do_cldice .or. carma_do_cldliq) then
+ call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, dlf=dlf, rliq=rliq, &
+ prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed_carma, snow_sed=snow_sed_carma)
+ call physics_update(state, ptend, ztodt, tend)
+
+ ! Before the detrainment, the reserved condensate is all liquid, but if CARMA is doing
+ ! detrainment, then the reserved condensate is snow.
+ if (carma_do_detrain) then
+ call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str+rliq, snow_str+rliq, zero)
+ else
+ call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str, snow_str, zero)
+ end if
+ end if
+
+ call t_stopf('carma_timestep_tend')
+
+ if( microp_scheme == 'RK' ) then
+
+ !===================================================
+ ! Calculate stratiform tendency (sedimentation, detrain, cloud fraction and microphysics )
+ !===================================================
+ call t_startf('rk_stratiform_tend')
+
+ call rk_stratiform_tend(state, ptend, pbuf, ztodt, &
+ cam_in%icefrac, cam_in%landfrac, cam_in%ocnfrac, &
+ cam_in%snowhland, & ! sediment
+ dlf, dlf2, & ! detrain
+ rliq , & ! check energy after detrain
+ cmfmc, &
+ cam_in%ts, cam_in%sst, zdu)
+
+ call physics_update(state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "cldwat_tend", nstep, ztodt, zero, prec_str, snow_str, zero)
+
+ call t_stopf('rk_stratiform_tend')
+
+ elseif( microp_scheme == 'MG' ) then
+ ! Start co-substepping of macrophysics and microphysics
+ cld_macmic_ztodt = ztodt/cld_macmic_num_steps
+
+ ! Clear precip fields that should accumulate.
+ prec_sed_macmic = 0._r8
+ snow_sed_macmic = 0._r8
+ prec_pcw_macmic = 0._r8
+ snow_pcw_macmic = 0._r8
+
+ do macmic_it = 1, cld_macmic_num_steps
+
+ !===================================================
+ ! Calculate macrophysical tendency (sedimentation, detrain, cloud fraction)
+ !===================================================
+
+ call t_startf('macrop_tend')
+
+ ! don't call Park macrophysics if CLUBB is called
+ if (macrop_scheme .ne. 'CLUBB_SGS') then
+
+ call macrop_driver_tend( &
+ state, ptend, cld_macmic_ztodt, &
+ cam_in%landfrac, cam_in%ocnfrac, cam_in%snowhland, & ! sediment
+ dlf, dlf2, & ! detrain
+ cmfmc, &
+ cam_in%ts, cam_in%sst, zdu, &
+ pbuf, det_s, det_ice)
+
+ ! Since we "added" the reserved liquid back in this routine, we need
+ ! to account for it in the energy checker
+ flx_cnd(:ncol) = -1._r8*rliq(:ncol)
+ flx_heat(:ncol) = det_s(:ncol)
+
+ ! Unfortunately, physics_update does not know what time period
+ ! "tend" is supposed to cover, and therefore can't update it
+ ! with substeps correctly. For now, work around this by scaling
+ ! ptend down by the number of substeps, then applying it for
+ ! the full time (ztodt).
+ call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol)
+ call physics_update(state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "macrop_tend", nstep, ztodt, &
+ zero, flx_cnd(:ncol)/cld_macmic_num_steps, &
+ det_ice(:ncol)/cld_macmic_num_steps, &
+ flx_heat(:ncol)/cld_macmic_num_steps)
+
+ else ! Calculate CLUBB macrophysics
+
+ ! =====================================================
+ ! CLUBB call (PBL, shallow convection, macrophysics)
+ ! =====================================================
+
+ call clubb_tend_cam(state, ptend, pbuf, cld_macmic_ztodt,&
+ cmfmc, cam_in, macmic_it, cld_macmic_num_steps, &
+ dlf, det_s, det_ice)
+
+ ! Since we "added" the reserved liquid back in this routine, we need
+ ! to account for it in the energy checker
+ flx_cnd(:ncol) = -1._r8*rliq(:ncol)
+ flx_heat(:ncol) = cam_in%shf(:ncol) + det_s(:ncol)
+
+ ! Unfortunately, physics_update does not know what time period
+ ! "tend" is supposed to cover, and therefore can't update it
+ ! with substeps correctly. For now, work around this by scaling
+ ! ptend down by the number of substeps, then applying it for
+ ! the full time (ztodt).
+ call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol)
+
+ ! Update physics tendencies and copy state to state_eq, because that is
+ ! input for microphysics
+ call physics_update(state, ptend, ztodt, tend)
+
+ ! Use actual qflux (not lhf/latvap) for consistency with surface fluxes and revised code
+ call check_energy_chng(state, tend, "clubb_tend", nstep, ztodt, &
+ cam_in%cflx(:ncol,1)/cld_macmic_num_steps, &
+ flx_cnd(:ncol)/cld_macmic_num_steps, &
+ det_ice(:ncol)/cld_macmic_num_steps, &
+ flx_heat(:ncol)/cld_macmic_num_steps)
+
+ endif
+
+ call t_stopf('macrop_tend')
+
+ !===================================================
+ ! Calculate cloud microphysics
+ !===================================================
+
+ if (is_subcol_on()) then
+ ! Allocate sub-column structures.
+ call physics_state_alloc(state_sc, lchnk, psubcols*pcols)
+ call physics_tend_alloc(tend_sc, psubcols*pcols)
+
+ ! Generate sub-columns using the requested scheme
+ call subcol_gen(state, tend, state_sc, tend_sc, pbuf)
+
+ !Initialize check energy for subcolumns
+ call check_energy_timestep_init(state_sc, tend_sc, pbuf, col_type_subcol)
+ end if
+
+ call t_startf('microp_aero_run')
+ call microp_aero_run(state, ptend_aero, cld_macmic_ztodt, pbuf)
+ call t_stopf('microp_aero_run')
+
+ call t_startf('microp_tend')
+
+ if (use_subcol_microp) then
+ call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, pbuf)
+
+ ! Average the sub-column ptend for use in gridded update - will not contain ptend_aero
+ call subcol_ptend_avg(ptend_sc, state_sc%ngrdcol, lchnk, ptend)
+
+ ! Copy ptend_aero field to one dimensioned by sub-columns before summing with ptend
+ call subcol_ptend_copy(ptend_aero, state_sc, ptend_aero_sc)
+ call physics_ptend_sum(ptend_aero_sc, ptend_sc, state_sc%ncol)
+ call physics_ptend_dealloc(ptend_aero_sc)
+
+ ! Have to scale and apply for full timestep to get tend right
+ ! (see above note for macrophysics).
+ call physics_ptend_scale(ptend_sc, 1._r8/cld_macmic_num_steps, ncol)
+
+ call physics_update (state_sc, ptend_sc, ztodt, tend_sc)
+ call check_energy_chng(state_sc, tend_sc, "microp_tend_subcol", &
+ nstep, ztodt, zero_sc, &
+ prec_str_sc(:state_sc%ncol)/cld_macmic_num_steps, &
+ snow_str_sc(:state_sc%ncol)/cld_macmic_num_steps, zero_sc)
+
+ call physics_state_dealloc(state_sc)
+ call physics_tend_dealloc(tend_sc)
+ call physics_ptend_dealloc(ptend_sc)
+ else
+ call microp_driver_tend(state, ptend, cld_macmic_ztodt, pbuf)
+ end if
+ ! combine aero and micro tendencies for the grid
+ call physics_ptend_sum(ptend_aero, ptend, ncol)
+ call physics_ptend_dealloc(ptend_aero)
+
+ ! Have to scale and apply for full timestep to get tend right
+ ! (see above note for macrophysics).
+ call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol)
+
+ call physics_update (state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "microp_tend", nstep, ztodt, &
+ zero, prec_str(:ncol)/cld_macmic_num_steps, &
+ snow_str(:ncol)/cld_macmic_num_steps, zero)
+
+ call t_stopf('microp_tend')
+ prec_sed_macmic(:ncol) = prec_sed_macmic(:ncol) + prec_sed(:ncol)
+ snow_sed_macmic(:ncol) = snow_sed_macmic(:ncol) + snow_sed(:ncol)
+ prec_pcw_macmic(:ncol) = prec_pcw_macmic(:ncol) + prec_pcw(:ncol)
+ snow_pcw_macmic(:ncol) = snow_pcw_macmic(:ncol) + snow_pcw(:ncol)
+
+ end do ! end substepping over macrophysics/microphysics
+
+ prec_sed(:ncol) = prec_sed_macmic(:ncol)/cld_macmic_num_steps
+ snow_sed(:ncol) = snow_sed_macmic(:ncol)/cld_macmic_num_steps
+ prec_pcw(:ncol) = prec_pcw_macmic(:ncol)/cld_macmic_num_steps
+ snow_pcw(:ncol) = snow_pcw_macmic(:ncol)/cld_macmic_num_steps
+ prec_str(:ncol) = prec_pcw(:ncol) + prec_sed(:ncol)
+ snow_str(:ncol) = snow_pcw(:ncol) + snow_sed(:ncol)
+
+ endif
+
+ ! Add the precipitation from CARMA to the precipitation from stratiform.
+ if (carma_do_cldice .or. carma_do_cldliq) then
+ prec_sed(:ncol) = prec_sed(:ncol) + prec_sed_carma(:ncol)
+ snow_sed(:ncol) = snow_sed(:ncol) + snow_sed_carma(:ncol)
+ end if
+
+ if ( .not. deep_scheme_does_scav_trans() ) then
+
+ ! -------------------------------------------------------------------------------
+ ! 1. Wet Scavenging of Aerosols by Convective and Stratiform Precipitation.
+ ! 2. Convective Transport of Non-Water Aerosol Species.
+ !
+ ! . Aerosol wet chemistry determines scavenging fractions, and transformations
+ ! . Then do convective transport of all trace species except qv,ql,qi.
+ ! . We needed to do the scavenging first to determine the interstitial fraction.
+ ! . When UNICON is used as unified convection, we should still perform
+ ! wet scavenging but not 'convect_deep_tend2'.
+ ! -------------------------------------------------------------------------------
+
+ call t_startf('bc_aerosols')
+ if (clim_modal_aero .and. .not. prog_modal_aero) then
+ call modal_aero_calcsize_diag(state, pbuf)
+ call modal_aero_wateruptake_dr(state, pbuf)
+ endif
+ call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf)
+ call physics_update(state, ptend, ztodt, tend)
+
+#ifdef DIRIND
+#ifdef AEROCOM
+! Estimating hygroscopic growth by use of linear interpolation w.r.t. mass
+! fractions of each internally mixed component for each mode (kcomp).
+!
+ call intfrh(lchnk, ncol, v3so4, v3insol, v3oc, v3ss, relhum, frh)
+!
+ do k=1,pver
+ do i=1,ncol
+ rnewdry1(i,k) = rnew3d(i,k,1)
+ rnewdry2(i,k) = rnew3d(i,k,2)
+ rnewdry4(i,k) = rnew3d(i,k,4)
+ rnewdry5(i,k) = rnew3d(i,k,5)
+ rnewdry6(i,k) = rnew3d(i,k,6)
+ rnewdry7(i,k) = rnew3d(i,k,7)
+ rnewdry8(i,k) = rnew3d(i,k,8)
+ rnewdry9(i,k) = rnew3d(i,k,9)
+ rnewdry10(i,k) = rnew3d(i,k,10)
+ rnewdry11(i,k) = rnew3d(i,k,11)
+ rnewdry13(i,k) = rnew3d(i,k,13)
+ rnewdry14(i,k) = rnew3d(i,k,14)
+ rnew1(i,k) = rnew3d(i,k,1)*frh(i,k,1)
+ rnew2(i,k) = rnew3d(i,k,2)*frh(i,k,2)
+ rnew4(i,k) = rnew3d(i,k,4)*frh(i,k,4)
+ rnew5(i,k) = rnew3d(i,k,5)*frh(i,k,5)
+ rnew6(i,k) = rnew3d(i,k,6)*frh(i,k,6)
+ rnew7(i,k) = rnew3d(i,k,7)*frh(i,k,7)
+ rnew8(i,k) = rnew3d(i,k,8)*frh(i,k,8)
+ rnew9(i,k) = rnew3d(i,k,9)*frh(i,k,9)
+ rnew10(i,k) = rnew3d(i,k,10)*frh(i,k,10)
+ rnew11(i,k) = rnew3d(i,k,11)*frh(i,k,11)
+ rnew13(i,k) = rnew3d(i,k,13)*frh(i,k,13)
+ rnew14(i,k) = rnew3d(i,k,14)*frh(i,k,14)
+ logsig1(i,k) = logsig3d(i,k,1)
+ logsig2(i,k) = logsig3d(i,k,2)
+ logsig4(i,k) = logsig3d(i,k,4)
+ logsig5(i,k) = logsig3d(i,k,5)
+ logsig6(i,k) = logsig3d(i,k,6)
+ logsig7(i,k) = logsig3d(i,k,7)
+ logsig8(i,k) = logsig3d(i,k,8)
+ logsig9(i,k) = logsig3d(i,k,9)
+ logsig10(i,k)= logsig3d(i,k,10)
+ logsig11(i,k)= logsig3d(i,k,11)
+ logsig13(i,k)= logsig3d(i,k,13)
+ logsig14(i,k)= logsig3d(i,k,14)
+!test-output++
+! logsig1(i,k) = frh(i,k,1)
+! logsig2(i,k) = frh(i,k,2)
+! logsig4(i,k) = frh(i,k,4)
+! logsig5(i,k) = frh(i,k,5)
+! logsig6(i,k) = frh(i,k,6)
+! logsig7(i,k) = frh(i,k,7)
+! logsig8(i,k) = frh(i,k,8)
+! logsig9(i,k) = frh(i,k,9)
+! logsig10(i,k) = frh(i,k,10)
+!test-output--
+ end do
+ end do
+! kommenterer ut disse foreløpig:
+! call outfld('RNEWD1 ',rnewdry1,pcols,lchnk)
+! call outfld('RNEWD2 ',rnewdry2,pcols,lchnk)
+! call outfld('RNEWD4 ',rnewdry4,pcols,lchnk)
+! call outfld('RNEWD5 ',rnewdry5,pcols,lchnk)
+! call outfld('RNEWD6 ',rnewdry6,pcols,lchnk)
+! call outfld('RNEWD7 ',rnewdry7,pcols,lchnk)
+! call outfld('RNEWD8 ',rnewdry8,pcols,lchnk)
+! call outfld('RNEWD9 ',rnewdry9,pcols,lchnk)
+! call outfld('RNEWD10 ',rnewdry10,pcols,lchnk)
+!! call outfld('RNEWD11 ',rnewdry11,pcols,lchnk) ! always = 0.0118
+!! call outfld('RNEWD13 ',rnewdry13,pcols,lchnk) ! always = 0.04
+!! call outfld('RNEWD14 ',rnewdry14,pcols,lchnk) ! always = 0.04
+! call outfld('RNEW1 ',rnew1,pcols,lchnk)
+! call outfld('RNEW2 ',rnew2,pcols,lchnk)
+! call outfld('RNEW4 ',rnew4,pcols,lchnk)
+! call outfld('RNEW5 ',rnew5,pcols,lchnk)
+! call outfld('RNEW6 ',rnew6,pcols,lchnk)
+! call outfld('RNEW7 ',rnew7,pcols,lchnk)
+! call outfld('RNEW8 ',rnew8,pcols,lchnk)
+! call outfld('RNEW9 ',rnew9,pcols,lchnk)
+! call outfld('RNEW10 ',rnew10,pcols,lchnk)
+! call outfld('RNEW11 ',rnew11,pcols,lchnk)
+! call outfld('RNEW13 ',rnew13,pcols,lchnk)
+! call outfld('RNEW14 ',rnew14,pcols,lchnk)
+! call outfld('LOGSIG1 ',logsig1,pcols,lchnk)
+! call outfld('LOGSIG2 ',logsig2,pcols,lchnk)
+! call outfld('LOGSIG4 ',logsig4,pcols,lchnk)
+! call outfld('LOGSIG5 ',logsig5,pcols,lchnk)
+! call outfld('LOGSIG6 ',logsig6,pcols,lchnk)
+! call outfld('LOGSIG7 ',logsig7,pcols,lchnk)
+! call outfld('LOGSIG8 ',logsig8,pcols,lchnk)
+! call outfld('LOGSIG9 ',logsig9,pcols,lchnk)
+! call outfld('LOGSIG10',logsig10,pcols,lchnk)
+!! call outfld('LOGSIG11',logsig11,pcols,lchnk) ! always = 0.2553
+!! call outfld('LOGSIG13',logsig13,pcols,lchnk) ! always = 0.2553
+!! call outfld('LOGSIG14',logsig14,pcols,lchnk) ! always = 0.2553
+#endif ! aerocom
+#endif ! dirind
+
+ if (carma_do_wetdep) then
+ ! CARMA wet deposition
+ !
+ ! NOTE: It needs to follow aero_model_wetdep, so that cam_out%xxxwetxxx
+ ! fields have already been set for CAM aerosols and cam_out can be added
+ ! to for CARMA aerosols.
+ call t_startf ('carma_wetdep_tend')
+ call carma_wetdep_tend(state, ptend, ztodt, pbuf, dlf, cam_out)
+ call physics_update(state, ptend, ztodt, tend)
+ call t_stopf ('carma_wetdep_tend')
+ end if
+
+ call t_startf ('convect_deep_tend2')
+ call convect_deep_tend_2( state, ptend, ztodt, pbuf )
+ call physics_update(state, ptend, ztodt, tend)
+ call t_stopf ('convect_deep_tend2')
+
+ ! check tracer integrals
+ call check_tracers_chng(state, tracerint, "cmfmca", nstep, ztodt, zero_tracers)
+
+ call t_stopf('bc_aerosols')
+
+ endif
+
+ !===================================================
+ ! Moist physical parameteriztions complete:
+ ! send dynamical variables, and derived variables to history file
+ !===================================================
+
+ call t_startf('bc_history_write')
+ call diag_phys_writeout(state, pbuf)
+ call diag_conv(state, ztodt, pbuf)
+
+ call t_stopf('bc_history_write')
+
+ !===================================================
+ ! Write cloud diagnostics on history file
+ !===================================================
+
+ call t_startf('bc_cld_diag_history_write')
+
+ call cloud_diagnostics_calc(state, pbuf)
+
+ call t_stopf('bc_cld_diag_history_write')
+
+ !===================================================
+ ! Radiation computations
+ !===================================================
+ call t_startf('radiation')
+
+
+ call radiation_tend( &
+ state, ptend, pbuf, cam_out, cam_in, net_flx)
+
+ ! Set net flux used by spectral dycores
+ do i=1,ncol
+ tend%flx_net(i) = net_flx(i)
+ end do
+ call physics_update(state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "radheat", nstep, ztodt, zero, zero, zero, net_flx)
+
+ call t_stopf('radiation')
+
+ ! Diagnose the location of the tropopause and its location to the history file(s).
+ call t_startf('tropopause')
+ call tropopause_output(state)
+ call t_stopf('tropopause')
+
+ ! Save atmospheric fields to force surface models
+ call t_startf('cam_export')
+ call cam_export (state,cam_out,pbuf)
+ call t_stopf('cam_export')
+
+ ! Write export state to history file
+ call t_startf('diag_export')
+ call diag_export(cam_out)
+ call t_stopf('diag_export')
+
+ end subroutine tphysbc
+
+subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d)
+!-----------------------------------------------------------------------------------
+!
+! Purpose: The place for parameterizations to call per timestep initializations.
+! Generally this is used to update time interpolated fields from boundary
+! datasets.
+!
+!-----------------------------------------------------------------------------------
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use chemistry, only: chem_timestep_init
+ use chem_surfvals, only: chem_surfvals_set
+ use physics_types, only: physics_state
+ use physics_buffer, only: physics_buffer_desc
+ use carma_intr, only: carma_timestep_init
+ use ghg_data, only: ghg_data_timestep_init
+ use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_timestep_init
+ use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_timestep_init
+ use aoa_tracers, only: aoa_tracers_timestep_init
+ use vertical_diffusion, only: vertical_diffusion_ts_init
+ use radheat, only: radheat_timestep_init
+ use solar_data, only: solar_data_advance
+ use qbo, only: qbo_timestep_init
+ use iondrag, only: do_waccm_ions, iondrag_timestep_init
+ use perf_mod
+
+ use prescribed_ozone, only: prescribed_ozone_adv
+ use prescribed_ghg, only: prescribed_ghg_adv
+ use prescribed_aero, only: prescribed_aero_adv
+ use aerodep_flx, only: aerodep_flx_adv
+ use aircraft_emit, only: aircraft_emit_adv
+ use prescribed_volcaero, only: prescribed_volcaero_adv
+ use prescribed_strataero,only: prescribed_strataero_adv
+ use mo_apex, only: mo_apex_init
+ use epp_ionization, only: epp_ionization_active
+ use iop_forcing, only: scam_use_iop_srf
+ use nudging, only: Nudge_Model, nudging_timestep_init
+#ifdef OSLO_AERO
+ use oslo_ocean_intr, only: oslo_ocean_time
+#endif
+
+ implicit none
+
+ type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state
+ type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in
+ type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out
+
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ !-----------------------------------------------------------------------------
+
+ if (single_column) call scam_use_iop_srf(cam_in)
+
+ ! update geomagnetic coordinates
+ if (epp_ionization_active .or. do_waccm_ions) then
+ call mo_apex_init(phys_state)
+ endif
+
+ ! Chemistry surface values
+ call chem_surfvals_set()
+
+ ! Solar irradiance
+ call solar_data_advance()
+
+ ! Time interpolate for chemistry.
+ call chem_timestep_init(phys_state, pbuf2d)
+
+ ! Prescribed tracers
+ call prescribed_ozone_adv(phys_state, pbuf2d)
+ call prescribed_ghg_adv(phys_state, pbuf2d)
+ call prescribed_aero_adv(phys_state, pbuf2d)
+ call aircraft_emit_adv(phys_state, pbuf2d)
+ call prescribed_volcaero_adv(phys_state, pbuf2d)
+ call prescribed_strataero_adv(phys_state, pbuf2d)
+#ifdef OSLO_AERO
+ call oslo_ocean_time(phys_state, pbuf2d)
+#endif
+
+ ! prescribed aerosol deposition fluxes
+ call aerodep_flx_adv(phys_state, pbuf2d, cam_out)
+
+ ! CAM3 prescribed aerosol masses
+ if (cam3_aero_data_on) call cam3_aero_data_timestep_init(pbuf2d, phys_state)
+
+ ! CAM3 prescribed ozone data
+ if (cam3_ozone_data_on) call cam3_ozone_data_timestep_init(pbuf2d, phys_state)
+
+ ! Time interpolate data models of gasses in pbuf2d
+ call ghg_data_timestep_init(pbuf2d, phys_state)
+
+ ! Upper atmosphere radiative processes
+ call radheat_timestep_init(phys_state, pbuf2d)
+
+ ! Time interpolate for vertical diffusion upper boundary condition
+ call vertical_diffusion_ts_init(pbuf2d, phys_state)
+
+ !----------------------------------------------------------------------
+ ! update QBO data for this time step
+ !----------------------------------------------------------------------
+ call qbo_timestep_init
+
+ call iondrag_timestep_init()
+
+ call carma_timestep_init()
+
+ ! age of air tracers
+ call aoa_tracers_timestep_init(phys_state)
+
+ ! Update Nudging values, if needed
+ !----------------------------------
+ if(Nudge_Model) call nudging_timestep_init(phys_state)
+
+end subroutine phys_timestep_init
+
+end module physpkg
diff --git a/src/NorESM/zm_conv.F90 b/src/NorESM/zm_conv.F90
new file mode 100755
index 0000000000..7b52311a86
--- /dev/null
+++ b/src/NorESM/zm_conv.F90
@@ -0,0 +1,5403 @@
+module zm_conv
+
+!---------------------------------------------------------------------------------
+! Purpose:
+!
+! Interface from Zhang-McFarlane convection scheme, includes evaporation of convective
+! precip from the ZM scheme
+!
+! Apr 2006: RBN: Code added to perform a dilute ascent for closure of the CM mass flux
+! based on an entraining plume a la Raymond and Blythe (1992)
+!
+! Author: Byron Boville, from code in tphysbc
+!
+!---------------------------------------------------------------------------------
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use spmd_utils, only: masterproc
+ use ppgrid, only: pcols, pver, pverp
+ use cloud_fraction, only: cldfrc_fice
+ use physconst, only: cpair, epsilo, gravit, latice, latvap, tmelt, rair, &
+ cpwv, cpliq, rh2o, cpvir, zvir
+ use cam_abortutils, only: endrun
+ use cam_logfile, only: iulog
+ use zm_microphysics, only: zm_mphy, zm_aero_t, zm_conv_t
+
+ implicit none
+
+ save
+ private ! Make default type private to the module
+!
+! PUBLIC: interfaces
+!
+ public zm_convi ! ZM schemea
+ public zm_convr ! ZM schemea
+ public zm_conv_evap ! evaporation of precip from ZM schemea
+ public convtran ! convective transport
+ public momtran ! convective momentum transport
+
+!
+! Private data
+!
+ real(r8) rl ! wg latent heat of vaporization.
+ real(r8) cpres ! specific heat at constant pressure in j/kg-degk.
+ real(r8) :: ke ! Tunable evaporation efficiency set from namelist input zmconv_ke
+ real(r8) :: ke_lnd
+ real(r8) :: c0_lnd ! set from namelist input zmconv_c0_lnd
+ real(r8) :: c0_ocn ! set from namelist input zmconv_c0_ocn
+ integer :: num_cin ! set from namelist input zmconv_num_cin
+ ! The number of negative buoyancy regions that are allowed
+ ! before the convection top and CAPE calculations are completed.
+ logical :: zm_org
+ real(r8) tau ! convective time scale
+ real(r8),parameter :: c1 = 6.112_r8
+ real(r8),parameter :: c2 = 17.67_r8
+ real(r8),parameter :: c3 = 243.5_r8
+ real(r8) :: tfreez
+ real(r8) :: eps1
+ real(r8) :: momcu
+ real(r8) :: momcd
+
+ logical :: zmconv_microp
+
+ logical :: no_deep_pbl ! default = .false.
+ ! no_deep_pbl = .true. eliminates deep convection entirely within PBL
+
+
+!moved from moistconvection.F90
+ real(r8) :: rgrav ! reciprocal of grav
+ real(r8) :: rgas ! gas constant for dry air
+ real(r8) :: grav ! = gravit
+ real(r8) :: cp ! = cpres = cpair
+
+ integer limcnv ! top interface level limit for convection
+
+ logical, parameter:: second_call=.true. & !+tht iterate parcel-plume calculation...
+ ,retrigger =.true. & !+tht ...and also iterate trigger condition
+ ,use_cin =.true. & !+tht use CIN
+ ,tht_tweaks =.true. !+tht enthalpy mixing, dmpdz into buoyan_dilute, others
+
+ real(r8),parameter :: &
+! standard parameters:
+ capelmt = 70._r8 & ! threshold value for cape for deep convection.
+ ,capelmt_lnd= 70._r8 & ! ...and over land
+ ,tiedke_add = 0.5_r8 & !"Tiedke parameter" = launching buoyancy of plume ens.
+ ,tiedke_lnd = 1.0_r8 & ! ...and over land
+ ,cape_tau = 3.6e3_r8& !+tht CAPE closure time-scale [s]
+ ,entrmn = 2e-4_r8 & !+tht maximum convective entrainment rate
+ ,alfadet = 0.1_r8 & !+tht convective detrainment/entrainment ratio
+ ,tentrm = 1e-3_r8 & !+tht (initial) entrainment rate for test parcel
+ ,tentr_lnd = 1e-3_r8 & !+tht entrainment rate over land (ignored if tht_tweaks)
+ ,plclmin = 6.e2_r8 & !+tht don't convect if LCL above this level (pno cin; ignored if use_cin=F)
+
+!tht moist thermo, additional parameter (must be evaluated in runtime)
+ !real(r8), parameter :: dcol=(cpliq-cpwv)/latvap
+ real(r8) dcol
+!-tht
+
+contains
+
+
+subroutine zm_convi(limcnv_in, zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_ke_lnd, &
+ zmconv_momcu, zmconv_momcd, zmconv_num_cin, zmconv_org, &
+ zmconv_microp_in, no_deep_pbl_in)
+
+ integer, intent(in) :: limcnv_in ! top interface level limit for convection
+ integer, intent(in) :: zmconv_num_cin ! Number negative buoyancy regions that are allowed
+ ! before the convection top and CAPE calculations are completed.
+ real(r8),intent(in) :: zmconv_c0_lnd
+ real(r8),intent(in) :: zmconv_c0_ocn
+ real(r8),intent(in) :: zmconv_ke
+ real(r8),intent(in) :: zmconv_ke_lnd
+ real(r8),intent(in) :: zmconv_momcu
+ real(r8),intent(in) :: zmconv_momcd
+ logical :: zmconv_org
+ logical, intent(in) :: zmconv_microp_in
+ logical, intent(in), optional :: no_deep_pbl_in ! no_deep_pbl = .true. eliminates ZM convection entirely within PBL
+
+
+ ! Initialization of ZM constants
+ limcnv = limcnv_in
+ tfreez = tmelt
+ eps1 = epsilo
+ rl = latvap
+ cpres = cpair
+ rgrav = 1.0_r8/gravit
+ rgas = rair
+ grav = gravit
+ cp = cpres
+!+tht moist thermo
+ dcol=(cpliq-cpwv)/latvap
+!-tht
+
+ c0_lnd = zmconv_c0_lnd
+ c0_ocn = zmconv_c0_ocn
+ num_cin = zmconv_num_cin
+ ke = zmconv_ke
+ ke_lnd = zmconv_ke_lnd
+ zm_org = zmconv_org
+ momcu = zmconv_momcu
+ momcd = zmconv_momcd
+
+ zmconv_microp = zmconv_microp_in
+
+ if ( present(no_deep_pbl_in) ) then
+ no_deep_pbl = no_deep_pbl_in
+ else
+ no_deep_pbl = .false.
+ endif
+
+ tau = cape_tau
+
+ if ( masterproc ) then
+ write(iulog,*)'**** ZM: DILUTE Buoyancy Calculation ****'
+!+tht give a honest and transparent list of ALL parameters
+ write(iulog,*) 'ZM formulation parameters:'
+ write(iulog,*) ' Don''t allow convection entirely within PBL : no_deep_pbl',no_deep_pbl
+ write(iulog,*) ' USE ORG tracer to reduce entrainment in CAPE : zmconv_org ',zm_org
+ write(iulog,*) ' (tht) Iterate CAPE calculation using diagnosed entrnm: second_call',second_call
+ write(iulog,*) ' (tht) Retrigger ZM convection usinf diagnosed entrnm : retrigger ',retrigger
+ write(iulog,*) ' (tht) Apply CIN threshold condition to allow convect.: use_cin ',use_cin
+ write(iulog,*) ' (tht) Conservatively mix plume enthalpy not entropy : tht_tweaks ',tht_tweaks
+ if (.not.tht_tweaks .and. (second_call.or.retrigger)) &
+ call endrun('**** ZM_CONVI : tht_tweaks must be T in order to use second_call or retrigger ****')
+ write(iulog,*) 'ZM tuning parameters:'
+ write(iulog,*) ' Maximum number of CINs in CAPE : num_cin', num_cin
+ !+tht check required here to ensure code integrity!
+ if (num_cin.gt.5) call endrun('**** ZM_CONVI : NUM_CIN must not exceeed 5 ****')
+ write(iulog,*) ' Conv. autoconversion rate on land: c0_lnd ',c0_lnd
+ write(iulog,*) ' Conv. autoconversion rate on ocn.: c0_ocn ',c0_ocn
+ if (zm_org) then
+ write(iulog,*) ' Evaporation efficiency over land : ke_lnd ',ke_lnd
+ write(iulog,*) ' Evaporation efficiency over ocn. : ke ',ke
+ else
+ write(iulog,*) ' Evaporation efficiency : ke ',ke
+ endif
+ write(iulog,*) 'ZM parameters "hard-wired" in the code:'
+ write(iulog,*) ' CAPE threshold parameter : capelmt ',capelmt
+ write(iulog,*) ' CAPE closure time-scale : cape_tau ',tau
+ write(iulog,*) ' Minimum pressure of LCL allowed : plclmin ',plclmin
+ write(iulog,*) ' Entrainment rate in initial test plume for CAPE: tentrm ',tentrm
+ if (zm_org .and. .not.tht_tweaks) &
+ write(iulog,*) ' Entrainment rate on land in CAPE test plume : tentr_lnd ',tentr_lnd
+ write(iulog,*) ' "Tiedke param."=launch buoyancy of plume ens. : tiedke_add ',tiedke_add
+ write(iulog,*) ' Maximum entrainment rate in convective ensemble: entrmn ',entrmn
+ write(iulog,*) ' Detrainment/entrainment ratio in convect. ens. : afladet ',alfadet
+ if (use_cin) &
+ write(iulog,*) ' (tht) Maximum allowed CIN as a fraction of CAPE : cin_threshd',cin_threshd
+ write(iulog,*)'**** ZM: DILUTE Buoyancy Calculation ****'
+!-tht
+ endif
+
+end subroutine zm_convi
+
+
+
+subroutine zm_convr(lchnk ,ncol , &
+ t ,qh ,prec ,jctop ,jcbot , &
+ pblh ,zm ,geos ,zi ,qtnd , &
+ heat ,pap ,paph ,dpp , &
+! delt ,mcon ,cme ,cape , &
+ delt ,mcon ,cme ,cape ,eurt , & !+tht: eurt=entrainment rate
+ tpert ,dlf ,pflx ,zdu ,rprd , &
+ mu ,md ,du ,eu ,ed , &
+! dp ,dsubcld ,jt ,maxg ,ideep , &
+ dp ,dsubcld ,jt ,maxg ,ideep , lengath , &
+ ql ,rliq ,landfrac, &
+ org ,orgt ,org2d , &
+ dif ,dnlf ,dnif ,conv , &
+ aero , rice)
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Main driver for zhang-mcfarlane convection scheme
+!
+! Method:
+! performs deep convective adjustment based on mass-flux closure
+! algorithm.
+!
+! Author:guang jun zhang, m.lazare, n.mcfarlane. CAM Contact: P. Rasch
+!
+! This is contributed code not fully standardized by the CAM core group.
+! All variables have been typed, where most are identified in comments
+! The current procedure will be reimplemented in a subsequent version
+! of the CAM where it will include a more straightforward formulation
+! and will make use of the standard CAM nomenclature
+!
+!-----------------------------------------------------------------------
+ use phys_control, only: cam_physpkg_is
+
+!
+! ************************ index of variables **********************
+!
+! wg * alpha array of vertical differencing used (=1. for upstream).
+! w * cape convective available potential energy.
+! wg * capeg gathered convective available potential energy.
+! c * capelmt threshold value for cape for deep convection.
+! ic * cpres specific heat at constant pressure in j/kg-degk.
+! i * dpp
+! ic * delt length of model time-step in seconds.
+! wg * dp layer thickness in mbs (between upper/lower interface).
+! wg * dqdt mixing ratio tendency at gathered points.
+! wg * dsdt dry static energy ("temp") tendency at gathered points.
+! wg * dudt u-wind tendency at gathered points.
+! wg * dvdt v-wind tendency at gathered points.
+! wg * dsubcld layer thickness in mbs between lcl and maxi.
+! ic * grav acceleration due to gravity in m/sec2.
+! wg * du detrainment in updraft. specified in mid-layer
+! wg * ed entrainment in downdraft.
+! wg * eu entrainment in updraft.
+! wg * hmn moist static energy.
+! wg * hsat saturated moist static energy.
+! w * ideep holds position of gathered points vs longitude index.
+! ic * pver number of model levels.
+! wg * j0 detrainment initiation level index.
+! wg * jd downdraft initiation level index.
+! ic * jlatpr gaussian latitude index for printing grids (if needed).
+! wg * jt top level index of deep cumulus convection.
+! w * lcl base level index of deep cumulus convection.
+! wg * lclg gathered values of lcl.
+! w * lel index of highest theoretical convective plume.
+! wg * lelg gathered values of lel.
+! w * lon index of onset level for deep convection.
+! w * maxi index of level with largest moist static energy.
+! wg * maxg gathered values of maxi.
+! wg * mb cloud base mass flux.
+! wg * mc net upward (scaled by mb) cloud mass flux.
+! wg * md downward cloud mass flux (positive up).
+! wg * mu upward cloud mass flux (positive up). specified
+! at interface
+! ic * msg number of missing moisture levels at the top of model.
+! w * p grid slice of ambient mid-layer pressure in mbs.
+! i * pblt row of pbl top indices.
+! w * pcpdh scaled surface pressure.
+! w * pf grid slice of ambient interface pressure in mbs.
+! wg * pg grid slice of gathered values of p.
+! w * q grid slice of mixing ratio.
+! wg * qd grid slice of mixing ratio in downdraft.
+! wg * qg grid slice of gathered values of q.
+! i/o * qh grid slice of specific humidity.
+! w * qh0 grid slice of initial specific humidity.
+! wg * qhat grid slice of upper interface mixing ratio.
+! wg * ql grid slice of cloud liquid water.
+! wg * qs grid slice of saturation mixing ratio.
+! w * qstp grid slice of parcel temp. saturation mixing ratio.
+! wg * qstpg grid slice of gathered values of qstp.
+! wg * qu grid slice of mixing ratio in updraft.
+! ic * rgas dry air gas constant.
+! wg * rl latent heat of vaporization.
+! w * s grid slice of scaled dry static energy (t+gz/cp).
+! wg * sd grid slice of dry static energy in downdraft.
+! wg * sg grid slice of gathered values of s.
+! wg * shat grid slice of upper interface dry static energy.
+! wg * su grid slice of dry static energy in updraft.
+! i/o * t
+! o * jctop row of top-of-deep-convection indices passed out.
+! O * jcbot row of base of cloud indices passed out.
+! wg * tg grid slice of gathered values of t.
+! w * tl row of parcel temperature at lcl.
+! wg * tlg grid slice of gathered values of tl.
+! w * tp grid slice of parcel temperatures.
+! wg * tpg grid slice of gathered values of tp.
+! i/o * u grid slice of u-wind (real).
+! wg * ug grid slice of gathered values of u.
+! i/o * utg grid slice of u-wind tendency (real).
+! i/o * v grid slice of v-wind (real).
+! w * va work array re-used by called subroutines.
+! wg * vg grid slice of gathered values of v.
+! i/o * vtg grid slice of v-wind tendency (real).
+! i * w grid slice of diagnosed large-scale vertical velocity.
+! w * z grid slice of ambient mid-layer height in metres.
+! w * zf grid slice of ambient interface height in metres.
+! wg * zfg grid slice of gathered values of zf.
+! wg * zg grid slice of gathered values of z.
+!
+!-----------------------------------------------------------------------
+!
+! multi-level i/o fields:
+! i => input arrays.
+! i/o => input/output arrays.
+! w => work arrays.
+! wg => work arrays operating only on gathered points.
+! ic => input data constants.
+! c => data constants pertaining to subroutine itself.
+!
+! input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+
+ real(r8), intent(in) :: t(pcols,pver) ! grid slice of temperature at mid-layer.
+ real(r8), intent(in) :: qh(pcols,pver) ! grid slice of specific humidity.
+ real(r8), intent(in) :: pap(pcols,pver)
+ real(r8), intent(in) :: paph(pcols,pver+1)
+ real(r8), intent(in) :: dpp(pcols,pver) ! local sigma half-level thickness (i.e. dshj).
+ real(r8), intent(in) :: zm(pcols,pver)
+ real(r8), intent(in) :: geos(pcols)
+ real(r8), intent(in) :: zi(pcols,pver+1)
+ real(r8), intent(in) :: pblh(pcols)
+ real(r8), intent(in) :: tpert(pcols)
+ real(r8), intent(in) :: landfrac(pcols) ! RBN Landfrac
+
+ type(zm_conv_t), intent(inout) :: conv
+ type(zm_aero_t), intent(inout) :: aero ! aerosol object. intent(inout) because the
+ ! gathered arrays are set here
+ ! before passing object
+ ! to microphysics
+! output arguments
+!
+ real(r8), intent(out) :: qtnd(pcols,pver) ! specific humidity tendency (kg/kg/s)
+ real(r8), intent(out) :: heat(pcols,pver) ! heating rate (dry static energy tendency, W/kg)
+ real(r8), intent(out) :: mcon(pcols,pverp)
+ real(r8), intent(out) :: dlf(pcols,pver) ! scattrd version of the detraining cld h2o tend
+ real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level
+ real(r8), intent(out) :: cme(pcols,pver)
+ real(r8), intent(out) :: cape(pcols) ! w convective available potential energy.
+ real(r8), intent(out) :: zdu(pcols,pver)
+ real(r8), intent(out) :: rprd(pcols,pver) ! rain production rate
+ real(r8), intent(out) :: dif(pcols,pver) ! detrained convective cloud ice mixing ratio.
+ real(r8), intent(out) :: dnlf(pcols,pver) ! detrained convective cloud water num concen.
+ real(r8), intent(out) :: dnif(pcols,pver) ! detrained convective cloud ice num concen.
+
+! move these vars from local storage to output so that convective
+! transports can be done in outside of conv_cam.
+ real(r8), intent(out) :: mu(pcols,pver)
+ real(r8), intent(out) :: eu(pcols,pver)
+ real(r8), intent(out) :: eurt(pcols,pver) !+tht: entrainment rate (full z-dependence)
+ !real(r8), intent(out) :: eurt(pcols) !+tht: entrainment rate (avg or max)
+ real(r8), intent(out) :: du(pcols,pver)
+ real(r8), intent(out) :: md(pcols,pver)
+ real(r8), intent(out) :: ed(pcols,pver)
+ real(r8), intent(out) :: dp(pcols,pver) ! wg layer thickness in mbs (between upper/lower interface).
+ real(r8), intent(out) :: dsubcld(pcols) ! wg layer thickness in mbs between lcl and maxi.
+ real(r8), intent(out) :: jctop(pcols) ! o row of top-of-deep-convection indices passed out.
+ real(r8), intent(out) :: jcbot(pcols) ! o row of base of cloud indices passed out.
+ real(r8), intent(out) :: prec(pcols)
+ real(r8), intent(out) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals
+ real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldce) for energy integrals
+
+ integer, intent(out) :: ideep(pcols) ! column indices of gathered points
+ integer, intent(out) :: lengath
+
+ real(r8) cin (pcols) !+tht CIN
+
+ type(zm_conv_t) :: loc_conv
+
+ real(r8), pointer :: org(:,:) ! Only used if zm_org is true
+ real(r8), pointer :: orgt(:,:) ! Only used if zm_org is true
+ real(r8), pointer :: org2d(:,:) ! Only used if zm_org is true
+
+ real(r8) zs(pcols)
+ real(r8) dlg(pcols,pver) ! gathrd version of the detraining cld h2o tend
+ real(r8) pflxg(pcols,pverp) ! gather precip flux at each level
+ real(r8) cug(pcols,pver) ! gathered condensation rate
+
+ real(r8) evpg(pcols,pver) ! gathered evap rate of rain in downdraft
+ real(r8) orgavg(pcols)
+ real(r8) dptot(pcols)
+ real(r8) mumax(pcols)
+ integer jt(pcols) ! wg top level index of deep cumulus convection.
+ integer maxg(pcols) ! wg gathered values of maxi.
+! integer lengath
+! diagnostic field used by chem/wetdep codes
+ real(r8) ql(pcols,pver) ! wg grid slice of cloud liquid water.
+!
+ real(r8) pblt(pcols) ! i row of pbl top indices.
+
+
+
+
+!
+!-----------------------------------------------------------------------
+!
+! general work fields (local variables):
+!
+ real(r8) q(pcols,pver) ! w grid slice of mixing ratio.
+ real(r8) p(pcols,pver) ! w grid slice of ambient mid-layer pressure in mbs.
+ real(r8) z(pcols,pver) ! w grid slice of ambient mid-layer height in metres.
+ real(r8) s(pcols,pver) ! w grid slice of scaled dry static energy (t+gz/cp).
+ real(r8) tp(pcols,pver) ! w grid slice of parcel temperatures.
+ real(r8) zf(pcols,pver+1) ! w grid slice of ambient interface height in metres.
+ real(r8) pf(pcols,pver+1) ! w grid slice of ambient interface pressure in mbs.
+ real(r8) qstp(pcols,pver) ! w grid slice of parcel temp. saturation mixing ratio.
+
+ real(r8) tl(pcols) ! w row of parcel temperature at lcl.
+
+ integer lcl(pcols) ! w base level index of deep cumulus convection.
+ integer lel(pcols) ! w index of highest theoretical convective plume.
+ integer lon(pcols) ! w index of onset level for deep convection.
+ integer maxi(pcols) ! w index of level with largest moist static energy.
+
+ real(r8) precip
+!
+! gathered work fields:
+!
+ real(r8) qg(pcols,pver) ! wg grid slice of gathered values of q.
+ real(r8) tg(pcols,pver) ! w grid slice of temperature at interface.
+ real(r8) pg(pcols,pver) ! wg grid slice of gathered values of p.
+ real(r8) zg(pcols,pver) ! wg grid slice of gathered values of z.
+ real(r8) sg(pcols,pver) ! wg grid slice of gathered values of s.
+ real(r8) tpg(pcols,pver) ! wg grid slice of gathered values of tp.
+ real(r8) zfg(pcols,pver+1) ! wg grid slice of gathered values of zf.
+ real(r8) qstpg(pcols,pver) ! wg grid slice of gathered values of qstp.
+ real(r8) ug(pcols,pver) ! wg grid slice of gathered values of u.
+ real(r8) vg(pcols,pver) ! wg grid slice of gathered values of v.
+ real(r8) cmeg(pcols,pver)
+
+ real(r8) rprdg(pcols,pver) ! wg gathered rain production rate
+ real(r8) capeg(pcols) ! wg gathered convective available potential energy.
+ real(r8) tlg(pcols) ! wg grid slice of gathered values of tl.
+ real(r8) landfracg(pcols) ! wg grid slice of landfrac
+
+ integer lclg(pcols) ! wg gathered values of lcl.
+ integer lelg(pcols)
+
+ integer indxd(pcols) !+tht work array
+!
+! work fields arising from gathered calculations.
+!
+ real(r8) dqdt(pcols,pver) ! wg mixing ratio tendency at gathered points.
+ real(r8) dsdt(pcols,pver) ! wg dry static energy ("temp") tendency at gathered points.
+! real(r8) alpha(pcols,pver) ! array of vertical differencing used (=1. for upstream).
+ real(r8) sd(pcols,pver) ! wg grid slice of dry static energy in downdraft.
+ real(r8) qd(pcols,pver) ! wg grid slice of mixing ratio in downdraft.
+ real(r8) mc(pcols,pver) ! wg net upward (scaled by mb) cloud mass flux.
+ real(r8) qhat(pcols,pver) ! wg grid slice of upper interface mixing ratio.
+ real(r8) qu(pcols,pver) ! wg grid slice of mixing ratio in updraft.
+ real(r8) su(pcols,pver) ! wg grid slice of dry static energy in updraft.
+ real(r8) qs(pcols,pver) ! wg grid slice of saturation mixing ratio.
+ real(r8) shat(pcols,pver) ! wg grid slice of upper interface dry static energy.
+ real(r8) hmn(pcols,pver) ! wg moist static energy.
+ real(r8) hsat(pcols,pver) ! wg saturated moist static energy.
+ real(r8) qlg(pcols,pver)
+ real(r8) dudt(pcols,pver) ! wg u-wind tendency at gathered points.
+ real(r8) dvdt(pcols,pver) ! wg v-wind tendency at gathered points.
+! real(r8) ud(pcols,pver)
+! real(r8) vd(pcols,pver)
+
+ !real(r8) dmpdz(pcols) !+tht Parcel fractional mass entrainment rate (/m)
+ real(r8) dmpdz(pcols,pver) !+tht Parcel fractional mass entrainment rate (/m)
+
+ real(r8) qldeg(pcols,pver) ! cloud liquid water mixing ratio for detrainment (kg/kg)
+ real(r8) mb(pcols) ! wg cloud base mass flux.
+
+ integer jlcl(pcols)
+ integer j0(pcols) ! wg detrainment initiation level index.
+ integer jd(pcols) ! wg downdraft initiation level index.
+
+ real(r8) delt ! length of model time-step in seconds.
+
+ integer i
+ integer ii
+ integer k, kk, l, m
+
+ integer msg ! ic number of missing moisture levels at the top of model.
+ real(r8) qdifr
+ real(r8) sdifr
+
+ real(r8) hk, dmmx(pcols), dmsm(pcols), orgc(pcols) !+tht for diagnostic entrainment
+
+ real(r8), parameter :: dcon = 25.e-6_r8
+ real(r8), parameter :: mucon = 5.3_r8
+ real(r8) negadq
+ logical doliq
+
+
+!
+!--------------------------Data statements------------------------------
+
+ dmpdz=-tentrm !+tht initialise value for entrainment rate
+
+!
+! Set internal variable "msg" (convection limit) to "limcnv-1"
+!
+ msg = limcnv - 1
+!
+! initialize necessary arrays.
+! zero out variables not used in cam
+!
+
+ if (zm_org) then
+ orgt(:,:) = 0._r8
+ end if
+
+ qtnd(:,:) = 0._r8
+ heat(:,:) = 0._r8
+ mcon(:,:) = 0._r8
+ rliq(:ncol) = 0._r8
+ rice(:ncol) = 0._r8
+
+ if (zmconv_microp) then
+ allocate( &
+ loc_conv%frz(pcols,pver), &
+ loc_conv%sprd(pcols,pver), &
+ loc_conv%wu(pcols,pver), &
+ loc_conv%qi(pcols,pver), &
+ loc_conv%qliq(pcols,pver), &
+ loc_conv%qice(pcols,pver), &
+ loc_conv%qrain(pcols,pver), &
+ loc_conv%qsnow(pcols,pver), &
+ loc_conv%di(pcols,pver), &
+ loc_conv%dnl(pcols,pver), &
+ loc_conv%dni(pcols,pver), &
+ loc_conv%qnl(pcols,pver), &
+ loc_conv%qni(pcols,pver), &
+ loc_conv%qnr(pcols,pver), &
+ loc_conv%qns(pcols,pver), &
+ loc_conv%qide(pcols,pver), &
+ loc_conv%qncde(pcols,pver), &
+ loc_conv%qnide(pcols,pver), &
+ loc_conv%autolm(pcols,pver), &
+ loc_conv%accrlm(pcols,pver), &
+ loc_conv%bergnm(pcols,pver), &
+ loc_conv%fhtimm(pcols,pver), &
+ loc_conv%fhtctm(pcols,pver), &
+ loc_conv%fhmlm(pcols,pver), &
+ loc_conv%hmpim(pcols,pver), &
+ loc_conv%accslm(pcols,pver), &
+ loc_conv%dlfm(pcols,pver), &
+ loc_conv%cmel(pcols,pver), &
+ loc_conv%autoln(pcols,pver), &
+ loc_conv%accrln(pcols,pver), &
+ loc_conv%bergnn(pcols,pver), &
+ loc_conv%fhtimn(pcols,pver), &
+ loc_conv%fhtctn(pcols,pver), &
+ loc_conv%fhmln(pcols,pver), &
+ loc_conv%accsln(pcols,pver), &
+ loc_conv%activn(pcols,pver), &
+ loc_conv%dlfn(pcols,pver), &
+ loc_conv%autoim(pcols,pver), &
+ loc_conv%accsim(pcols,pver), &
+ loc_conv%difm(pcols,pver), &
+ loc_conv%cmei(pcols,pver), &
+ loc_conv%nuclin(pcols,pver), &
+ loc_conv%autoin(pcols,pver), &
+ loc_conv%accsin(pcols,pver), &
+ loc_conv%hmpin(pcols,pver), &
+ loc_conv%difn(pcols,pver), &
+ loc_conv%trspcm(pcols,pver), &
+ loc_conv%trspcn(pcols,pver), &
+ loc_conv%trspim(pcols,pver), &
+ loc_conv%trspin(pcols,pver), &
+ loc_conv%lambdadpcu(pcols,pver), &
+ loc_conv%mudpcu(pcols,pver), &
+ loc_conv%dcape(pcols) )
+ end if
+
+!
+! initialize convective tendencies
+!
+ prec(:ncol) = 0._r8
+ !eurt(:ncol) = 0._r8 !+tht (avg or max)
+ do k = 1,pver
+ do i = 1,ncol
+ dqdt(i,k) = 0._r8
+ dsdt(i,k) = 0._r8
+ dudt(i,k) = 0._r8
+ dvdt(i,k) = 0._r8
+ pflx(i,k) = 0._r8
+ pflxg(i,k) = 0._r8
+ cme(i,k) = 0._r8
+ rprd(i,k) = 0._r8
+ zdu(i,k) = 0._r8
+ ql(i,k) = 0._r8
+ qlg(i,k) = 0._r8
+ dlf(i,k) = 0._r8
+ dlg(i,k) = 0._r8
+ qldeg(i,k) = 0._r8
+ eurt(i,k) = 0._r8 !+tht entr.rate (full)
+
+ dif(i,k) = 0._r8
+ dnlf(i,k) = 0._r8
+ dnif(i,k) = 0._r8
+
+ end do
+ end do
+
+ if (zmconv_microp) then
+ do k = 1,pver
+ do i = 1,ncol
+ loc_conv%qliq(i,k) = 0._r8
+ loc_conv%qice(i,k) = 0._r8
+ loc_conv%di(i,k) = 0._r8
+ loc_conv%qrain(i,k)= 0._r8
+ loc_conv%qsnow(i,k)= 0._r8
+ loc_conv%dnl(i,k) = 0._r8
+ loc_conv%dni(i,k) = 0._r8
+ loc_conv%wu(i,k) = 0._r8
+ loc_conv%qnl(i,k) = 0._r8
+ loc_conv%qni(i,k) = 0._r8
+ loc_conv%qnr(i,k) = 0._r8
+ loc_conv%qns(i,k) = 0._r8
+ loc_conv%frz(i,k) = 0._r8
+ loc_conv%sprd(i,k) = 0._r8
+ loc_conv%qide(i,k) = 0._r8
+ loc_conv%qncde(i,k) = 0._r8
+ loc_conv%qnide(i,k) = 0._r8
+
+ loc_conv%autolm(i,k) = 0._r8
+ loc_conv%accrlm(i,k) = 0._r8
+ loc_conv%bergnm(i,k) = 0._r8
+ loc_conv%fhtimm(i,k) = 0._r8
+ loc_conv%fhtctm(i,k) = 0._r8
+ loc_conv%fhmlm (i,k) = 0._r8
+ loc_conv%hmpim (i,k) = 0._r8
+ loc_conv%accslm(i,k) = 0._r8
+ loc_conv%dlfm (i,k) = 0._r8
+
+ loc_conv%autoln(i,k) = 0._r8
+ loc_conv%accrln(i,k) = 0._r8
+ loc_conv%bergnn(i,k) = 0._r8
+ loc_conv%fhtimn(i,k) = 0._r8
+ loc_conv%fhtctn(i,k) = 0._r8
+ loc_conv%fhmln (i,k) = 0._r8
+ loc_conv%accsln(i,k) = 0._r8
+ loc_conv%activn(i,k) = 0._r8
+ loc_conv%dlfn (i,k) = 0._r8
+ loc_conv%cmel (i,k) = 0._r8
+
+ loc_conv%autoim(i,k) = 0._r8
+ loc_conv%accsim(i,k) = 0._r8
+ loc_conv%difm (i,k) = 0._r8
+ loc_conv%cmei (i,k) = 0._r8
+
+ loc_conv%nuclin(i,k) = 0._r8
+ loc_conv%autoin(i,k) = 0._r8
+ loc_conv%accsin(i,k) = 0._r8
+ loc_conv%hmpin (i,k) = 0._r8
+ loc_conv%difn (i,k) = 0._r8
+
+ loc_conv%trspcm(i,k) = 0._r8
+ loc_conv%trspcn(i,k) = 0._r8
+ loc_conv%trspim(i,k) = 0._r8
+ loc_conv%trspin(i,k) = 0._r8
+
+ conv%qi(i,k) = 0._r8
+ conv%frz(i,k) = 0._r8
+ conv%sprd(i,k) = 0._r8
+ conv%qi(i,k) = 0._r8
+ conv%qliq(i,k) = 0._r8
+ conv%qice(i,k) = 0._r8
+ conv%qnl(i,k) = 0._r8
+ conv%qni(i,k) = 0._r8
+ conv%qnr(i,k) = 0._r8
+ conv%qns(i,k) = 0._r8
+ conv%qrain(i,k) = 0._r8
+ conv%qsnow(i,k) = 0._r8
+ conv%wu(i,k) = 0._r8
+
+ conv%autolm(i,k) = 0._r8
+ conv%accrlm(i,k) = 0._r8
+ conv%bergnm(i,k) = 0._r8
+ conv%fhtimm(i,k) = 0._r8
+ conv%fhtctm(i,k) = 0._r8
+ conv%fhmlm (i,k) = 0._r8
+ conv%hmpim (i,k) = 0._r8
+ conv%accslm(i,k) = 0._r8
+ conv%dlfm (i,k) = 0._r8
+
+ conv%autoln(i,k) = 0._r8
+ conv%accrln(i,k) = 0._r8
+ conv%bergnn(i,k) = 0._r8
+ conv%fhtimn(i,k) = 0._r8
+ conv%fhtctn(i,k) = 0._r8
+ conv%fhmln (i,k) = 0._r8
+ conv%accsln(i,k) = 0._r8
+ conv%activn(i,k) = 0._r8
+ conv%dlfn (i,k) = 0._r8
+ conv%cmel (i,k) = 0._r8
+
+ conv%autoim(i,k) = 0._r8
+ conv%accsim(i,k) = 0._r8
+ conv%difm (i,k) = 0._r8
+ conv%cmei (i,k) = 0._r8
+
+ conv%nuclin(i,k) = 0._r8
+ conv%autoin(i,k) = 0._r8
+ conv%accsin(i,k) = 0._r8
+ conv%hmpin (i,k) = 0._r8
+ conv%difn (i,k) = 0._r8
+
+ conv%trspcm(i,k) = 0._r8
+ conv%trspcn(i,k) = 0._r8
+ conv%trspim(i,k) = 0._r8
+ conv%trspin(i,k) = 0._r8
+
+ end do
+ end do
+
+ conv%lambdadpcu = (mucon + 1._r8)/dcon
+ conv%mudpcu = mucon
+ loc_conv%lambdadpcu = conv%lambdadpcu
+ loc_conv%mudpcu = conv%mudpcu
+
+ end if
+
+ do i = 1,ncol
+ pflx(i,pverp) = 0
+ pflxg(i,pverp) = 0
+ end do
+!
+ do i = 1,ncol
+ pblt(i) = pver
+ dsubcld(i) = 0._r8
+
+
+ jctop(i) = pver
+ jcbot(i) = 1
+
+ end do
+
+ if (zmconv_microp) then
+ do i = 1,ncol
+ conv%dcape(i) = 0._r8
+ loc_conv%dcape(i) = 0._r8
+ end do
+ end if
+
+ if (zm_org) then
+! compute vertical average here
+ orgavg(:) = 0._r8
+ dptot(:) = 0._r8
+
+ do k = 1, pver
+ do i = 1,ncol
+ if (org(i,k) .gt. 0) then
+ orgavg(i) = orgavg(i)+dpp(i,k)*org(i,k)
+ dptot(i) = dptot(i)+dpp(i,k)
+ endif
+ enddo
+ enddo
+
+ do i = 1,ncol
+ if (dptot(i) .gt. 0) then
+ orgavg(i) = orgavg(i)/dptot(i)
+ endif
+ enddo
+
+ do k = 1, pver
+ do i = 1, ncol
+ org2d(i,k) = orgavg(i)
+ enddo
+ enddo
+
+ endif
+
+!
+! calculate local pressure (mbs) and height (m) for both interface
+! and mid-layer locations.
+!
+ do i = 1,ncol
+ zs(i) = geos(i)*rgrav
+ pf(i,pver+1) = paph(i,pver+1)*0.01_r8
+ zf(i,pver+1) = zi(i,pver+1) + zs(i)
+ end do
+ do k = 1,pver
+ do i = 1,ncol
+ p(i,k) = pap(i,k)*0.01_r8
+ pf(i,k) = paph(i,k)*0.01_r8
+ z(i,k) = zm(i,k) + zs(i)
+ zf(i,k) = zi(i,k) + zs(i)
+ end do
+ end do
+!
+ do k = pver - 1,msg + 1,-1
+ do i = 1,ncol
+ if (abs(z(i,k)-zs(i)-pblh(i)) < (zf(i,k)-zf(i,k+1))*0.5_r8) pblt(i) = k
+ end do
+ end do
+!
+! store incoming specific humidity field for subsequent calculation
+! of precipitation (through change in storage).
+! define dry static energy (normalized by cp).
+!
+ do k = 1,pver
+ do i = 1,ncol
+ q(i,k) = qh(i,k)
+!+tht moist thermo
+ !s(i,k) = t(i,k) + (grav/cpres)*z(i,k)
+ s(i,k) = t(i,k) + (grav/((1._r8+zvir*q(i,k))*cpres))*z(i,k)
+!-tht
+ tp(i,k)=0.0_r8
+ shat(i,k) = s(i,k)
+ qhat(i,k) = q(i,k)
+ end do
+ end do
+
+ do i = 1,ncol
+ capeg(i) = 0._r8
+ lclg(i) = 1
+ lelg(i) = pver
+ maxg(i) = 1
+ tlg(i) = 400._r8
+ dsubcld(i) = 0._r8
+ end do
+
+ if( cam_physpkg_is('cam3')) then
+
+ ! For cam3 physics package, call non-dilute
+
+ call buoyan(lchnk ,ncol , &
+ q ,t ,p ,z ,pf , &
+ tp ,qstp ,tl ,rl ,cape , &
+ pblt ,lcl ,lel ,lon ,maxi , &
+ rgas ,grav ,cpres ,msg , &
+ tpert )
+ else
+
+ ! Evaluate Tparcel, qs(Tparcel), buoyancy and CAPE,
+ ! lcl, lel, parcel launch level at index maxi()=hmax
+
+ call buoyan_dilute(lchnk ,ncol , &
+ q ,t ,p ,z ,pf , &
+! tp ,qstp ,tl ,rl ,cape , &
+ tp ,qstp ,tl ,rl ,cape , cin , & !+tht CIN
+ pblt ,lcl ,lel ,lon ,maxi , &
+ rgas ,grav ,cpres ,msg , &
+! tpert , org2d , landfrac)
+ !tpert , org2d , landfrac , dmpdz) !+tht DMPDZ
+ tpert , org , landfrac , dmpdz) !+tht DMPDZ 3D
+ end if
+
+!
+! determine whether grid points will undergo some deep convection
+! (ideep=1) or not (ideep=0), based on values of cape,lcl,lel
+! (require cape.gt. 0 and lel capelmt) then
+ if (.not.use_cin .or. cin(i).lt.cape(i)*cin_threshd) then !+tht: don't convect if CIN comparable to CAPE
+ lengath = lengath + 1
+ ideep(lengath) = i
+ indxd(lengath) = i !+tht sub-index
+ endif
+ end if
+ end do
+
+ if (lengath.eq.0) return
+
+! do ii=1,lengath
+! i=indxd(ii)
+! ideep(ii)=i !+tht keeping ideep and indxd distinguished for possible different use of CIN
+! end do
+!
+! obtain gathered arrays necessary for ensuing calculations.
+!
+ do k = 1,pver
+ do i = 1,lengath
+ dp(i,k) = 0.01_r8*dpp(ideep(i),k)
+ qg(i,k) = q(ideep(i),k)
+ tg(i,k) = t(ideep(i),k)
+ pg(i,k) = p(ideep(i),k)
+ zg(i,k) = z(ideep(i),k)
+ sg(i,k) = s(ideep(i),k)
+ tpg(i,k) = tp(ideep(i),k)
+ zfg(i,k) = zf(ideep(i),k)
+ qstpg(i,k) = qstp(ideep(i),k)
+ ug(i,k) = 0._r8
+ vg(i,k) = 0._r8
+ end do
+ end do
+
+ if (zmconv_microp) then
+
+ if (aero%scheme == 'modal') then
+
+ do m = 1, aero%nmodes
+
+ do k = 1,pver
+ do i = 1,lengath
+ aero%numg_a(i,k,m) = aero%num_a(m)%val(ideep(i),k)
+ aero%dgnumg(i,k,m) = aero%dgnum(m)%val(ideep(i),k)
+ end do
+ end do
+
+ do l = 1, aero%nspec(m)
+ do k = 1,pver
+ do i = 1,lengath
+ aero%mmrg_a(i,k,l,m) = aero%mmr_a(l,m)%val(ideep(i),k)
+ end do
+ end do
+ end do
+
+ end do
+
+ else if (aero%scheme == 'bulk') then
+
+ do m = 1, aero%nbulk
+ do k = 1,pver
+ do i = 1,lengath
+ aero%mmrg_bulk(i,k,m) = aero%mmr_bulk(m)%val(ideep(i),k)
+ end do
+ end do
+ end do
+
+ end if
+
+ end if
+
+!
+ do i = 1,lengath
+ zfg(i,pver+1) = zf(ideep(i),pver+1)
+ end do
+ do i = 1,lengath
+ capeg(i) = cape(ideep(i))
+ lclg(i) = lcl(ideep(i))
+ lelg(i) = lel(ideep(i))
+ maxg(i) = maxi(ideep(i))
+ tlg(i) = tl(ideep(i))
+ landfracg(i) = landfrac(ideep(i))
+ end do
+!
+! calculate sub-cloud layer pressure "thickness" for use in
+! closure and tendency routines.
+!
+ do k = msg + 1,pver
+ do i = 1,lengath
+ if (k >= maxg(i)) then
+ dsubcld(i) = dsubcld(i) + dp(i,k)
+ end if
+ end do
+ end do
+!
+! define array of factors (alpha) which defines interfacial
+! values, as well as interfacial values for (q,s) used in
+! subsequent routines.
+!
+ do k = msg + 2,pver
+ do i = 1,lengath
+! alpha(i,k) = 0.5
+ sdifr = 0._r8
+ qdifr = 0._r8
+ if (sg(i,k) > 0._r8 .or. sg(i,k-1) > 0._r8) &
+ sdifr = abs((sg(i,k)-sg(i,k-1))/max(sg(i,k-1),sg(i,k)))
+ if (qg(i,k) > 0._r8 .or. qg(i,k-1) > 0._r8) &
+ qdifr = abs((qg(i,k)-qg(i,k-1))/max(qg(i,k-1),qg(i,k)))
+ if (sdifr > 1.E-6_r8) then
+ shat(i,k) = log(sg(i,k-1)/sg(i,k))*sg(i,k-1)*sg(i,k)/(sg(i,k-1)-sg(i,k))
+ else
+ shat(i,k) = 0.5_r8* (sg(i,k)+sg(i,k-1))
+ end if
+ if (qdifr > 1.E-6_r8) then
+ qhat(i,k) = log(qg(i,k-1)/qg(i,k))*qg(i,k-1)*qg(i,k)/(qg(i,k-1)-qg(i,k))
+ else
+ qhat(i,k) = 0.5_r8* (qg(i,k)+qg(i,k-1))
+ end if
+ end do
+ end do
+!
+! obtain cloud properties.
+!
+
+ call cldprp(lchnk , &
+ qg ,tg ,ug ,vg ,pg , &
+ zg ,sg ,mu ,eu ,du , &
+ md ,ed ,sd ,qd ,mc , &
+ qu ,su ,zfg ,qs ,hmn , &
+ hsat ,shat ,qlg , &
+ cmeg ,maxg ,lelg ,jt ,jlcl , &
+ maxg ,j0 ,jd ,rl ,lengath , &
+ rgas ,grav ,cpres ,msg , &
+ pflxg ,evpg ,cug ,rprdg ,limcnv ,landfracg , &
+ qldeg ,aero ,loc_conv,qhat )
+
+!===================================================================================
+!!++tht second call to buoyan_dilute for new CAPE using entrainment rate from CLDPRP
+ if (second_call) then
+ do i = 1,lengath
+ hk=0._r8
+
+ !dmpdz(ideep(i)) = 1._r8 ! large value 2D
+ dmpdz(ideep(i),:) = 1._r8 ! large value 3D
+
+!+tht 17.04.16 use org as parameter to mix max and avg EU(k)
+ dmmx(i)=0._r8
+ dmsm(i)=0._r8 ! 2D
+ !orgc(i)=min(max(org2d(ideep(i),1),0._r8),1._r8) ! use vertical-avg org
+ orgc(i)=1._r8 ! don't use ORG 10/5/2016
+ do k = pver,msg+1,-1
+ !orgc(i)=min(max(org(ideep (i),k),0._r8),1._r8) ! use full 3D org
+ if (eu(i,k).gt.0_r8) then
+ dmmx(i) = -max(-dmmx(i),eu(i,k))
+ !dmsm(i) = dmsm(i)-eu(i,k)*tg(i,k)*dp(i,k)/pg(i,k) ! 2D
+ !hk=hk+tg(i,k)*dp(i,k)/pg(i,k) ! 2D
+ dmsm(i) = dmsm(i)-eu(i,k) ! 2D
+ hk=hk+1._r8 ! 2D
+ !dmpdz(ideep(i),k) = -eu(i,k) *orgc(i) + dmmx(i) *(1._r8-orgc(i)) ! 3D
+ endif
+ enddo
+ if (hk.gt.0) then
+ dmsm(i) = dmsm(i)/hk ! 2D
+ dmpdz(ideep(i),:) = dmsm(i) *orgc(i) + dmmx(i) *(1._r8-orgc(i)) ! 2D
+ !dmpdz(ideep(i) ) = dmsm(i) *orgc(i) + dmmx(i) *(1._r8-orgc(i)) ! 2D
+ endif
+!-tht 17.04.16
+ enddo
+
+ call buoyan_dilute(lchnk ,ncol , &
+ q ,t ,p ,z ,pf , &
+! tp ,qstp ,tl ,rl ,cape , &
+ tp ,qstp ,tl ,rl ,cape , cin , &
+ pblt ,lcl ,lel ,lon ,maxi , &
+ rgas ,grav ,cpres ,msg , &
+! tpert , org2d , landfrac ) !+tht
+ !tpert , org2d , landfrac , dmpdz) !+tht DMPDZ, ORG 2D
+ tpert , org , landfrac , dmpdz) !+tht DMPDZ, ORG 3D
+
+ !-------------------------------------------------------------------------------
+ !+tht: retrigger?
+ if (retrigger) then
+ lengath = 0
+ ideep(:)= 0
+ indxd(:)= 0
+ do i=1,ncol
+ if (cape(i) > capelmt) then
+ if (.not.use_cin .or. cin(i).lt.cape(i)*cin_threshd) then !+tht: don't convect if CIN comparable to CAPE
+ lengath = lengath + 1
+ indxd(lengath) = i !+tht sub-index
+ endif
+ end if
+ end do
+ if (lengath.eq.0) return
+ do ii=1,lengath
+ i=indxd(ii)
+ ideep(ii)=i !+tht keeping ideep and indxd distinguished for possible different use of CIN
+ end do
+ !----
+ ! shorten all gathered arrays to new triggered subset
+ do k = 1,pver
+ do i = 1,lengath
+ dp(i,k) = 0.01_r8*dpp(ideep(i),k)
+ qg(i,k) = q(ideep(i),k)
+ tg(i,k) = t(ideep(i),k)
+ pg(i,k) = p(ideep(i),k)
+ zg(i,k) = z(ideep(i),k)
+ sg(i,k) = s(ideep(i),k)
+ tpg(i,k) = tp(ideep(i),k)
+ zfg(i,k) = zf(ideep(i),k)
+ qstpg(i,k) = qstp(ideep(i),k)
+ ug(i,k) = 0._r8
+ vg(i,k) = 0._r8
+ end do
+ end do
+ if (zmconv_microp) then
+ if (aero%scheme == 'modal') then
+ do m = 1, aero%nmodes
+ do k = 1,pver
+ do i = 1,lengath
+ aero%numg_a(i,k,m) = aero%num_a(m)%val(ideep(i),k)
+ aero%dgnumg(i,k,m) = aero%dgnum(m)%val(ideep(i),k)
+ end do
+ end do
+ do l = 1, aero%nspec(m)
+ do k = 1,pver
+ do i = 1,lengath
+ aero%mmrg_a(i,k,l,m) = aero%mmr_a(l,m)%val(ideep(i),k)
+ end do
+ end do
+ end do
+ end do
+ else if (aero%scheme == 'bulk') then
+ do m = 1, aero%nbulk
+ do k = 1,pver
+ do i = 1,lengath
+ aero%mmrg_bulk(i,k,m) = aero%mmr_bulk(m)%val(ideep(i),k)
+ end do
+ end do
+ end do
+ end if
+ end if
+ do i = 1,lengath
+ zfg(i,pver+1) = zf(ideep(i),pver+1)
+ end do
+ do i = 1,lengath
+ capeg(i) = cape(ideep(i))
+ lclg(i) = lcl(ideep(i))
+ lelg(i) = lel(ideep(i))
+ maxg(i) = maxi(ideep(i))
+ tlg(i) = tl(ideep(i))
+ landfracg(i) = landfrac(ideep(i))
+ dsubcld(i) = 0._r8
+ end do
+ do k = msg + 1,pver
+ do i = 1,lengath
+ if (k >= maxg(i)) then
+ dsubcld(i) = dsubcld(i) + dp(i,k)
+ end if
+ end do
+ end do
+ do k = msg + 2,pver
+ do i = 1,lengath
+! alpha(i,k) = 0.5
+ sdifr = 0._r8
+ qdifr = 0._r8
+ if (sg(i,k) > 0._r8 .or. sg(i,k-1) > 0._r8) &
+ sdifr = abs((sg(i,k)-sg(i,k-1))/max(sg(i,k-1),sg(i,k)))
+ if (qg(i,k) > 0._r8 .or. qg(i,k-1) > 0._r8) &
+ qdifr = abs((qg(i,k)-qg(i,k-1))/max(qg(i,k-1),qg(i,k)))
+ if (sdifr > 1.E-6_r8) then
+ shat(i,k) = log(sg(i,k-1)/sg(i,k))*sg(i,k-1)*sg(i,k)/(sg(i,k-1)-sg(i,k))
+ else
+ shat(i,k) = 0.5_r8* (sg(i,k)+sg(i,k-1))
+ end if
+ if (qdifr > 1.E-6_r8) then
+ qhat(i,k) = log(qg(i,k-1)/qg(i,k))*qg(i,k-1)*qg(i,k)/(qg(i,k-1)-qg(i,k))
+ else
+ qhat(i,k) = 0.5_r8* (qg(i,k)+qg(i,k-1))
+ end if
+ end do
+ end do
+ ! tesbus dereggirt wen ot syarra derethag lla netrosh
+ !----
+ else ! end retrigger=T
+ do k = 1,pver
+ do i = 1,lengath
+ tpg(i,k) = tp(ideep(i),k)
+ zfg(i,k) = zf(ideep(i),k)
+ qstpg(i,k) = qstp(ideep(i),k)
+ end do
+ end do
+ do i = 1,lengath
+ capeg(i) = cape(ideep(i))
+ lclg(i) = lcl(ideep(i))
+ lelg(i) = lel(ideep(i))
+ maxg(i) = maxi(ideep(i))
+ tlg(i) = tl(ideep(i))
+ end do
+ endif ! end retrigger=F
+ !-------------------------------------------------------------------------------
+
+ call cldprp(lchnk , &
+ qg ,tg ,ug ,vg ,pg , &
+ zg ,sg ,mu ,eu ,du , &
+ md ,ed ,sd ,qd ,mc , &
+ qu ,su ,zfg ,qs ,hmn , &
+ hsat ,shat ,qlg , &
+ cmeg ,maxg ,lelg ,jt ,jlcl , &
+ maxg ,j0 ,jd ,rl ,lengath , &
+ rgas ,grav ,cpres ,msg , &
+ pflxg ,evpg ,cug ,rprdg ,limcnv ,landfracg , &
+ qldeg ,aero ,loc_conv,qhat )
+ !else ! end second_call=T
+ endif ! end second_call=F
+
+ !do i = 1,lengath
+ !eurt (ideep(i)) =-dmpdz(ideep(i)) !+tht entr.rate 2D
+ !enddo
+ do k = msg + 1,pver
+ do i = 1,lengath
+ eurt (ideep(i),k)=-dmpdz(ideep(i),k) !+tht entr.rate 3D
+ enddo
+ enddo
+
+!!--tht
+!===================================================================================
+
+ if (zmconv_microp) then
+ do i = 1,lengath
+ capeg(i) = capeg(i)+ loc_conv%dcape(i)
+ end do
+ end if
+
+!
+! convert detrainment from units of "1/m" to "1/mb".
+!
+
+ do k = msg + 1,pver
+ do i = 1,lengath
+ du (i,k) = du (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k)
+ eu (i,k) = eu (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k)
+ ed (i,k) = ed (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k)
+ cug (i,k) = cug (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k)
+ cmeg (i,k) = cmeg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k)
+ rprdg(i,k) = rprdg(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k)
+ evpg (i,k) = evpg (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k)
+ end do
+ end do
+
+ if (zmconv_microp) then
+ do k = msg + 1,pver
+ do i = 1,lengath
+ loc_conv%sprd(i,k) = loc_conv%sprd(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k)
+ loc_conv%frz (i,k) = loc_conv%frz (i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k)
+ end do
+ end do
+ end if
+
+ call closure(lchnk , &
+ qg ,tg ,pg ,zg ,sg , &
+ tpg ,qs ,qu ,su ,mc , &
+ du ,mu ,md ,qd ,sd , &
+ qhat ,shat ,dp ,qstpg ,zfg , &
+ qlg ,dsubcld ,mb ,capeg ,tlg , &
+ lclg ,lelg ,jt ,maxg ,1 , &
+ lengath ,rgas ,grav ,cpres ,rl , &
+ msg ,capelmt )
+!
+! limit cloud base mass flux to theoretical upper bound.
+!
+ do i=1,lengath
+ mumax(i) = 0
+ end do
+ do k=msg + 2,pver
+ do i=1,lengath
+ mumax(i) = max(mumax(i), mu(i,k)/dp(i,k))
+ end do
+ end do
+
+ do i=1,lengath
+ if (mumax(i) > 0._r8) then
+ mb(i) = min(mb(i),0.5_r8/(delt*mumax(i)))
+ else
+ mb(i) = 0._r8
+ endif
+ end do
+ ! If no_deep_pbl = .true., don't allow convection entirely
+ ! within PBL (suggestion of Bjorn Stevens, 8-2000)
+
+ if (no_deep_pbl) then
+ do i=1,lengath
+ if (zm(ideep(i),jt(i)) < pblh(ideep(i))) mb(i) = 0
+ end do
+ end if
+
+ if (zmconv_microp) then
+ do k=msg+1,pver
+ do i=1,lengath
+ loc_conv%sprd(i,k) = loc_conv%sprd(i,k)*mb(i)
+ loc_conv%frz (i,k) = loc_conv%frz (i,k)*mb(i)
+ end do
+ end do
+ end if
+
+ do k=msg+1,pver
+ do i=1,lengath
+ mu (i,k) = mu (i,k)*mb(i)
+ md (i,k) = md (i,k)*mb(i)
+ mc (i,k) = mc (i,k)*mb(i)
+ du (i,k) = du (i,k)*mb(i)
+ eu (i,k) = eu (i,k)*mb(i)
+ ed (i,k) = ed (i,k)*mb(i)
+ cmeg (i,k) = cmeg (i,k)*mb(i)
+ rprdg(i,k) = rprdg(i,k)*mb(i)
+ cug (i,k) = cug (i,k)*mb(i)
+ evpg (i,k) = evpg (i,k)*mb(i)
+ pflxg(i,k+1)= pflxg(i,k+1)*mb(i)*100._r8/grav
+
+
+ if ( zmconv_microp .and. mb(i).eq.0._r8) then
+ qlg (i,k) = 0._r8
+ loc_conv%qliq (i,k) = 0._r8
+ loc_conv%qice (i,k) = 0._r8
+ loc_conv%qrain(i,k) = 0._r8
+ loc_conv%qsnow(i,k) = 0._r8
+ loc_conv%wu(i,k) = 0._r8
+ loc_conv%qnl (i,k) = 0._r8
+ loc_conv%qni (i,k) = 0._r8
+ loc_conv%qnr (i,k) = 0._r8
+ loc_conv%qns (i,k) = 0._r8
+
+ loc_conv%autolm(i,k) = 0._r8
+ loc_conv%accrlm(i,k) = 0._r8
+ loc_conv%bergnm(i,k) = 0._r8
+ loc_conv%fhtimm(i,k) = 0._r8
+ loc_conv%fhtctm(i,k) = 0._r8
+ loc_conv%fhmlm (i,k) = 0._r8
+ loc_conv%hmpim (i,k) = 0._r8
+ loc_conv%accslm(i,k) = 0._r8
+ loc_conv%dlfm (i,k) = 0._r8
+
+ loc_conv%autoln(i,k) = 0._r8
+ loc_conv%accrln(i,k) = 0._r8
+ loc_conv%bergnn(i,k) = 0._r8
+ loc_conv%fhtimn(i,k) = 0._r8
+ loc_conv%fhtctn(i,k) = 0._r8
+ loc_conv%fhmln (i,k) = 0._r8
+ loc_conv%accsln(i,k) = 0._r8
+ loc_conv%activn(i,k) = 0._r8
+ loc_conv%dlfn (i,k) = 0._r8
+ loc_conv%cmel (i,k) = 0._r8
+
+ loc_conv%autoim(i,k) = 0._r8
+ loc_conv%accsim(i,k) = 0._r8
+ loc_conv%difm (i,k) = 0._r8
+ loc_conv%cmei (i,k) = 0._r8
+
+ loc_conv%nuclin(i,k) = 0._r8
+ loc_conv%autoin(i,k) = 0._r8
+ loc_conv%accsin(i,k) = 0._r8
+ loc_conv%hmpin (i,k) = 0._r8
+ loc_conv%difn (i,k) = 0._r8
+
+ loc_conv%trspcm(i,k) = 0._r8
+ loc_conv%trspcn(i,k) = 0._r8
+ loc_conv%trspim(i,k) = 0._r8
+ loc_conv%trspin(i,k) = 0._r8
+ end if
+ end do
+ end do
+!
+! compute temperature and moisture changes due to convection.
+!
+ call q1q2_pjr(lchnk , &
+ dqdt ,dsdt ,qg ,qs ,qu , &
+ su ,du ,qhat ,shat ,dp , &
+ mu ,md ,sd ,qd ,qldeg , &
+ dsubcld ,jt ,maxg ,1 ,lengath , &
+ cpres ,rl ,msg , &
+ dlg ,evpg ,cug , &
+ loc_conv )
+!
+! gather back temperature and mixing ratio.
+!
+
+ if (zmconv_microp) then
+ do k = msg + 1,pver
+ do i = 1,lengath
+ if (dqdt(i,k)*2._r8*delt+qg(i,k)<0._r8) then
+ negadq = (dqdt(i,k)+0.5_r8*qg(i,k)/delt)/0.9999_r8
+ dqdt(i,k) = dqdt(i,k)-negadq
+
+ do kk=k,jt(i),-1
+ if (negadq<0._r8) then
+ if (rprdg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then
+ dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres
+ if (rprdg(i,kk)>loc_conv%sprd(i,kk)) then
+ if(rprdg(i,kk)-loc_conv%sprd(i,kk)<-negadq*dp(i,k)/dp(i,kk)) then
+ dsdt(i,k) = dsdt(i,k) + (negadq+ (rprdg(i,kk)-loc_conv%sprd(i,kk))*dp(i,kk)/dp(i,k))*latice/cpres
+ loc_conv%sprd(i,kk) = negadq*dp(i,k)/dp(i,kk)+rprdg(i,kk)
+ end if
+ else
+ loc_conv%sprd(i,kk) = loc_conv%sprd(i,kk)+negadq*dp(i,k)/dp(i,kk)
+ dsdt(i,k) = dsdt(i,k) + negadq*latice/cpres
+ end if
+ rprdg(i,kk) = rprdg(i,kk)+negadq*dp(i,k)/dp(i,kk)
+ negadq = 0._r8
+ else
+ negadq = rprdg(i,kk)*dp(i,kk)/dp(i,k)+negadq
+ dsdt(i,k) = dsdt(i,k) - rprdg(i,kk)*rl/cpres*dp(i,kk)/dp(i,k)
+ if (rprdg(i,kk)>loc_conv%sprd(i,kk)) then
+ dsdt(i,k) = dsdt(i,k) - loc_conv%sprd(i,kk)*latice/cpres*dp(i,kk)/dp(i,k)
+ loc_conv%sprd(i,kk) = 0._r8
+ else
+ dsdt(i,k) = dsdt(i,k) -rprdg(i,kk)*latice/cpres*dp(i,kk)/dp(i,k)
+ loc_conv%sprd(i,kk)= loc_conv%sprd(i,kk)- rprdg(i,kk)
+ end if
+ rprdg(i,kk) = 0._r8
+ end if
+
+ if (dlg(i,kk)>loc_conv%di(i,kk)) then
+ doliq= .true.
+ else
+ doliq= .false.
+ end if
+
+ if (negadq<0._r8) then
+ if (doliq) then
+ if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then
+ dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres
+ loc_conv%dnl(i,kk) = loc_conv%dnl(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk))
+ dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk)
+ negadq = 0._r8
+ else
+ negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k)
+ dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*rl/cpres
+ dlg(i,kk) = 0._r8
+ loc_conv%dnl(i,kk) = 0._r8
+ end if
+ else
+ if (loc_conv%di(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then
+ dsdt(i,k) = dsdt(i,k) + negadq*(rl+latice)/cpres
+ loc_conv%dni(i,kk) = loc_conv%dni(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/loc_conv%di(i,kk))
+ loc_conv%di(i,kk) = loc_conv%di(i,kk)+negadq*dp(i,k)/dp(i,kk)
+ negadq = 0._r8
+ else
+ negadq = negadq + loc_conv%di(i,kk)*dp(i,kk)/dp(i,k)
+ dsdt(i,k) = dsdt(i,k) - loc_conv%di(i,kk)*dp(i,kk)/dp(i,k)*(rl+latice)/cpres
+ loc_conv%di(i,kk) = 0._r8
+ loc_conv%dni(i,kk) = 0._r8
+ end if
+ doliq= .false.
+ end if
+ end if
+ if (negadq<0._r8 .and. doliq ) then
+ if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then
+ dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres
+ loc_conv%dnl(i,kk) = loc_conv%dnl(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dlg(i,kk))
+ dlg(i,kk) = dlg(i,kk)+negadq*dp(i,k)/dp(i,kk)
+ negadq = 0._r8
+ else
+ negadq = negadq + dlg(i,kk)*dp(i,kk)/dp(i,k)
+ dsdt(i,k) = dsdt(i,k) - dlg(i,kk)*dp(i,kk)/dp(i,k)*rl/cpres
+ dlg(i,kk) = 0._r8
+ loc_conv%dnl(i,kk) = 0._r8
+ end if
+ end if
+
+ end if
+ end do
+
+ if (negadq<0._r8) then
+ dqdt(i,k) = dqdt(i,k) + negadq
+ end if
+
+ end if
+ end do
+ end do
+ end if
+
+ do k = msg + 1,pver
+ do i = 1,lengath
+!
+! q is updated to compute net precip.
+!
+ q(ideep(i),k) = qh(ideep(i),k) + 2._r8*delt*dqdt(i,k)
+ qtnd(ideep(i),k) = dqdt (i,k)
+ cme (ideep(i),k) = cmeg (i,k)
+ rprd(ideep(i),k) = rprdg(i,k)
+ zdu (ideep(i),k) = du (i,k)
+ mcon(ideep(i),k) = mc (i,k)
+ heat(ideep(i),k) = dsdt (i,k)*cpres
+ dlf (ideep(i),k) = dlg (i,k)
+ pflx(ideep(i),k) = pflxg(i,k)
+ ql (ideep(i),k) = qlg (i,k)
+ end do
+ end do
+
+ if (zmconv_microp) then
+ do k = msg + 1,pver
+ do i = 1,lengath
+ dif (ideep(i),k) = loc_conv%di (i,k)
+ dnlf(ideep(i),k) = loc_conv%dnl (i,k)
+ dnif(ideep(i),k) = loc_conv%dni (i,k)
+
+ conv%qi (ideep(i),k) = loc_conv%qice(i,k)
+ conv%frz(ideep(i),k) = loc_conv%frz(i,k)*latice/cpres
+ conv%sprd(ideep(i),k) = loc_conv%sprd(i,k)
+ conv%wu (ideep(i),k) = loc_conv%wu (i,k)
+ conv%qliq(ideep(i),k) = loc_conv%qliq (i,k)
+ conv%qice(ideep(i),k) = loc_conv%qice (i,k)
+ conv%qrain(ideep(i),k) = loc_conv%qrain (i,k)
+ conv%qsnow(ideep(i),k) = loc_conv%qsnow (i,k)
+ conv%qnl(ideep(i),k) = loc_conv%qnl(i,k)
+ conv%qni(ideep(i),k) = loc_conv%qni(i,k)
+ conv%qnr(ideep(i),k) = loc_conv%qnr(i,k)
+ conv%qns(ideep(i),k) = loc_conv%qns(i,k)
+
+ conv%autolm(ideep(i),k) = loc_conv%autolm(i,k)
+ conv%accrlm(ideep(i),k) = loc_conv%accrlm(i,k)
+ conv%bergnm(ideep(i),k) = loc_conv%bergnm(i,k)
+ conv%fhtimm(ideep(i),k) = loc_conv%fhtimm(i,k)
+ conv%fhtctm(ideep(i),k) = loc_conv%fhtctm(i,k)
+ conv%fhmlm (ideep(i),k) = loc_conv%fhmlm (i,k)
+ conv%hmpim (ideep(i),k) = loc_conv%hmpim (i,k)
+ conv%accslm(ideep(i),k) = loc_conv%accslm(i,k)
+ conv%dlfm (ideep(i),k) = loc_conv%dlfm (i,k)
+
+ conv%autoln(ideep(i),k) = loc_conv%autoln(i,k)
+ conv%accrln(ideep(i),k) = loc_conv%accrln(i,k)
+ conv%bergnn(ideep(i),k) = loc_conv%bergnn(i,k)
+ conv%fhtimn(ideep(i),k) = loc_conv%fhtimn(i,k)
+ conv%fhtctn(ideep(i),k) = loc_conv%fhtctn(i,k)
+ conv%fhmln (ideep(i),k) = loc_conv%fhmln (i,k)
+ conv%accsln(ideep(i),k) = loc_conv%accsln(i,k)
+ conv%activn(ideep(i),k) = loc_conv%activn(i,k)
+ conv%dlfn (ideep(i),k) = loc_conv%dlfn (i,k)
+ conv%cmel (ideep(i),k) = loc_conv%cmel (i,k)
+
+ conv%autoim(ideep(i),k) = loc_conv%autoim(i,k)
+ conv%accsim(ideep(i),k) = loc_conv%accsim(i,k)
+ conv%difm (ideep(i),k) = loc_conv%difm (i,k)
+ conv%cmei (ideep(i),k) = loc_conv%cmei (i,k)
+
+ conv%nuclin(ideep(i),k) = loc_conv%nuclin(i,k)
+ conv%autoin(ideep(i),k) = loc_conv%autoin(i,k)
+ conv%accsin(ideep(i),k) = loc_conv%accsin(i,k)
+ conv%hmpin (ideep(i),k) = loc_conv%hmpin (i,k)
+ conv%difn (ideep(i),k) = loc_conv%difn (i,k)
+
+ conv%trspcm(ideep(i),k) = loc_conv%trspcm(i,k)
+ conv%trspcn(ideep(i),k) = loc_conv%trspcn(i,k)
+ conv%trspim(ideep(i),k) = loc_conv%trspim(i,k)
+ conv%trspin(ideep(i),k) = loc_conv%trspin(i,k)
+ conv%lambdadpcu(ideep(i),k) = loc_conv%lambdadpcu(i,k)
+ conv%mudpcu(ideep(i),k) = loc_conv%mudpcu(i,k)
+
+ end do
+ end do
+
+ do k = msg + 1,pver
+ do i = 1,ncol
+
+ !convert it from units of "kg/kg" to "g/m3"
+
+ if(k.lt.pver) then
+ conv%qice (i,k) = 0.5_r8*(conv%qice(i,k)+conv%qice(i,k+1))
+ conv%qliq (i,k) = 0.5_r8*(conv%qliq(i,k)+conv%qliq(i,k+1))
+ conv%qrain (i,k) = 0.5_r8*(conv%qrain(i,k)+conv%qrain(i,k+1))
+ conv%qsnow (i,k) = 0.5_r8*(conv%qsnow(i,k)+conv%qsnow(i,k+1))
+ conv%qni (i,k) = 0.5_r8*(conv%qni(i,k)+conv%qni(i,k+1))
+ conv%qnl (i,k) = 0.5_r8*(conv%qnl(i,k)+conv%qnl(i,k+1))
+ conv%qnr (i,k) = 0.5_r8*(conv%qnr(i,k)+conv%qnr(i,k+1))
+ conv%qns (i,k) = 0.5_r8*(conv%qns(i,k)+conv%qns(i,k+1))
+ conv%wu(i,k) = 0.5_r8*(conv%wu(i,k)+conv%wu(i,k+1))
+ end if
+
+ if (t(i,k).gt. 273.15_r8 .and. t(i,k-1).le.273.15_r8) then
+ conv%qice (i,k-1) = conv%qice (i,k-1) + conv%qice (i,k)
+ conv%qice (i,k) = 0._r8
+ conv%qni (i,k-1) = conv%qni (i,k-1) + conv%qni (i,k)
+ conv%qni (i,k) = 0._r8
+ conv%qsnow (i,k-1) = conv%qsnow (i,k-1) + conv%qsnow (i,k)
+ conv%qsnow (i,k) = 0._r8
+ conv%qns (i,k-1) = conv%qns (i,k-1) + conv%qns (i,k)
+ conv%qns (i,k) = 0._r8
+ end if
+
+ conv%qice (i,k) = conv%qice(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8
+ conv%qliq (i,k) = conv%qliq(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8
+ conv%qrain (i,k) = conv%qrain(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8
+ conv%qsnow (i,k) = conv%qsnow(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8
+ conv%qni (i,k) = conv%qni(i,k) * pap(i,k)/t(i,k)/rgas
+ conv%qnl (i,k) = conv%qnl(i,k) * pap(i,k)/t(i,k)/rgas
+ conv%qnr (i,k) = conv%qnr(i,k) * pap(i,k)/t(i,k)/rgas
+ conv%qns (i,k) = conv%qns(i,k) * pap(i,k)/t(i,k)/rgas
+ end do
+ end do
+ end if
+
+!
+ do i = 1,lengath
+ jctop(ideep(i)) = jt(i)
+ jcbot(ideep(i)) = maxg(i)
+ pflx(ideep(i),pverp) = pflxg(i,pverp)
+ end do
+
+ if (zmconv_microp) then
+ do i = 1,lengath
+ conv%dcape(ideep(i)) = loc_conv%dcape(i)
+ end do
+ end if
+
+! Compute precip by integrating change in water vapor minus detrained cloud water
+ do k = pver,msg + 1,-1
+ do i = 1,ncol
+ prec(i) = prec(i) - dpp(i,k)* (q(i,k)-qh(i,k)) - dpp(i,k)*(dlf(i,k)+dif(i,k))*2._r8*delt
+ end do
+ end do
+
+! obtain final precipitation rate in m/s.
+ do i = 1,ncol
+ prec(i) = rgrav*max(prec(i),0._r8)/ (2._r8*delt)/1000._r8
+ end do
+
+! Compute reserved liquid (not yet in cldliq) for energy integrals.
+! Treat rliq as flux out bottom, to be added back later.
+ do k = 1, pver
+ do i = 1, ncol
+ rliq(i) = rliq(i) + (dlf(i,k)+dif(i,k))*dpp(i,k)/gravit
+ rice(i) = rice(i) + dif(i,k)*dpp(i,k)/gravit
+ end do
+ end do
+ rliq(:ncol) = rliq(:ncol) /1000._r8
+ rice(:ncol) = rice(:ncol) /1000._r8
+
+ if (zmconv_microp) then
+ deallocate( &
+ loc_conv%frz, &
+ loc_conv%sprd, &
+ loc_conv%wu, &
+ loc_conv%qi, &
+ loc_conv%qliq, &
+ loc_conv%qice, &
+ loc_conv%qrain, &
+ loc_conv%qsnow, &
+ loc_conv%di, &
+ loc_conv%dnl, &
+ loc_conv%dni, &
+ loc_conv%qnl, &
+ loc_conv%qni, &
+ loc_conv%qnr, &
+ loc_conv%qns, &
+ loc_conv%qide, &
+ loc_conv%qncde, &
+ loc_conv%qnide, &
+ loc_conv%autolm, &
+ loc_conv%accrlm, &
+ loc_conv%bergnm, &
+ loc_conv%fhtimm, &
+ loc_conv%fhtctm, &
+ loc_conv%fhmlm, &
+ loc_conv%hmpim, &
+ loc_conv%accslm, &
+ loc_conv%dlfm, &
+ loc_conv%cmel, &
+ loc_conv%autoln, &
+ loc_conv%accrln, &
+ loc_conv%bergnn, &
+ loc_conv%fhtimn, &
+ loc_conv%fhtctn, &
+ loc_conv%fhmln, &
+ loc_conv%accsln, &
+ loc_conv%activn, &
+ loc_conv%dlfn, &
+ loc_conv%autoim, &
+ loc_conv%accsim, &
+ loc_conv%difm, &
+ loc_conv%cmei, &
+ loc_conv%nuclin, &
+ loc_conv%autoin, &
+ loc_conv%accsin, &
+ loc_conv%hmpin, &
+ loc_conv%difn, &
+ loc_conv%trspcm, &
+ loc_conv%trspcn, &
+ loc_conv%trspim, &
+ loc_conv%trspin, &
+ loc_conv%lambdadpcu, &
+ loc_conv%mudpcu, &
+ loc_conv%dcape )
+ end if
+
+ return
+end subroutine zm_convr
+
+!===============================================================================
+subroutine zm_conv_evap(ncol,lchnk, &
+ t,pmid,pdel,q, &
+ landfrac, &
+ tend_s, tend_s_snwprd, tend_s_snwevmlt, tend_q, &
+ prdprec, cldfrc, deltat, &
+ prec, snow, ntprprd, ntsnprd, flxprec, flxsnow, prdsnow)
+
+
+!-----------------------------------------------------------------------
+! Compute tendencies due to evaporation of rain from ZM scheme
+!--
+! Compute the total precipitation and snow fluxes at the surface.
+! Add in the latent heat of fusion for snow formation and melt, since it not dealt with
+! in the Zhang-MacFarlane parameterization.
+! Evaporate some of the precip directly into the environment using a Sundqvist type algorithm
+!-----------------------------------------------------------------------
+
+ use wv_saturation, only: qsat
+ use phys_grid, only: get_rlat_all_p
+
+!------------------------------Arguments--------------------------------
+ integer,intent(in) :: ncol, lchnk ! number of columns and chunk index
+ real(r8),intent(in), dimension(pcols,pver) :: t ! temperature (K)
+ real(r8),intent(in), dimension(pcols,pver) :: pmid ! midpoint pressure (Pa)
+ real(r8),intent(in), dimension(pcols,pver) :: pdel ! layer thickness (Pa)
+ real(r8),intent(in), dimension(pcols,pver) :: q ! water vapor (kg/kg)
+ real(r8),intent(in), dimension(pcols) :: landfrac
+ real(r8),intent(inout), dimension(pcols,pver) :: tend_s ! heating rate (J/kg/s)
+ real(r8),intent(inout), dimension(pcols,pver) :: tend_q ! water vapor tendency (kg/kg/s)
+ real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwprd ! Heating rate of snow production
+ real(r8),intent(out ), dimension(pcols,pver) :: tend_s_snwevmlt ! Heating rate of evap/melting of snow
+
+
+
+ real(r8), intent(in ) :: prdprec(pcols,pver)! precipitation production (kg/ks/s)
+ real(r8), intent(in ) :: cldfrc(pcols,pver) ! cloud fraction
+ real(r8), intent(in ) :: deltat ! time step
+
+ real(r8), intent(inout) :: prec(pcols) ! Convective-scale preciptn rate
+ real(r8), intent(out) :: snow(pcols) ! Convective-scale snowfall rate
+
+ real(r8), optional, intent(in), allocatable :: prdsnow(:,:) ! snow production (kg/ks/s)
+
+!
+!---------------------------Local storage-------------------------------
+
+ real(r8) :: es (pcols,pver) ! Saturation vapor pressure
+ real(r8) :: fice (pcols,pver) ! ice fraction in precip production
+ real(r8) :: fsnow_conv(pcols,pver) ! snow fraction in precip production
+ real(r8) :: qs (pcols,pver) ! saturation specific humidity
+ real(r8),intent(out) :: flxprec(pcols,pverp) ! Convective-scale flux of precip at interfaces (kg/m2/s)
+ real(r8),intent(out) :: flxsnow(pcols,pverp) ! Convective-scale flux of snow at interfaces (kg/m2/s)
+ real(r8),intent(out) :: ntprprd(pcols,pver) ! net precip production in layer
+ real(r8),intent(out) :: ntsnprd(pcols,pver) ! net snow production in layer
+ real(r8) :: work1 ! temp variable (pjr)
+ real(r8) :: work2 ! temp variable (pjr)
+
+ real(r8) :: evpvint(pcols) ! vertical integral of evaporation
+ real(r8) :: evpprec(pcols) ! evaporation of precipitation (kg/kg/s)
+ real(r8) :: evpsnow(pcols) ! evaporation of snowfall (kg/kg/s)
+ real(r8) :: snowmlt(pcols) ! snow melt tendency in layer
+ real(r8) :: flxsntm(pcols) ! flux of snow into layer, after melting
+
+ real(r8) :: kemask
+ real(r8) :: evplimit ! temp variable for evaporation limits
+ real(r8) :: rlat(pcols)
+ real(r8) :: dum
+ real(r8) :: omsm
+
+ integer :: i,k ! longitude,level indices
+ logical :: old_snow
+
+
+!-----------------------------------------------------------------------
+
+ ! If prdsnow is passed in and allocated, then use it in the calculation, otherwise
+ ! use the old snow calculation
+ old_snow=.true.
+ if (present(prdsnow)) then
+ if (allocated(prdsnow)) then
+ old_snow=.false.
+ end if
+ end if
+
+! convert input precip to kg/m2/s
+ prec(:ncol) = prec(:ncol)*1000._r8
+
+! determine saturation vapor pressure
+ call qsat(t(1:ncol, 1:pver), pmid(1:ncol, 1:pver), &
+ es(1:ncol, 1:pver), qs(1:ncol, 1:pver))
+
+! determine ice fraction in rain production (use cloud water parameterization fraction at present)
+ call cldfrc_fice(ncol, t, fice, fsnow_conv)
+
+! zero the flux integrals on the top boundary
+ flxprec(:ncol,1) = 0._r8
+ flxsnow(:ncol,1) = 0._r8
+ evpvint(:ncol) = 0._r8
+ omsm=0.9999_r8
+
+ do k = 1, pver
+ do i = 1, ncol
+
+! Melt snow falling into layer, if necessary.
+ if( old_snow ) then
+ if (t(i,k) > tmelt) then
+ flxsntm(i) = 0._r8
+ snowmlt(i) = flxsnow(i,k) * gravit/ pdel(i,k)
+ else
+ flxsntm(i) = flxsnow(i,k)
+ snowmlt(i) = 0._r8
+ end if
+ else
+ ! make sure melting snow doesn't reduce temperature below threshold
+ if (t(i,k) > tmelt) then
+ dum = -latice/cpres*flxsnow(i,k)*gravit/pdel(i,k)*deltat
+ if (t(i,k) + dum .le. tmelt) then
+ dum = (t(i,k)-tmelt)*cpres/latice/deltat
+ dum = dum/(flxsnow(i,k)*gravit/pdel(i,k))
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+ dum = dum*omsm
+ flxsntm(i) = flxsnow(i,k)*(1.0_r8-dum)
+ snowmlt(i) = dum*flxsnow(i,k)*gravit/ pdel(i,k)
+ else
+ flxsntm(i) = flxsnow(i,k)
+ snowmlt(i) = 0._r8
+ end if
+ end if
+
+! relative humidity depression must be > 0 for evaporation
+!+tht: Q is a mixing ration, QS a specific humidity. Change one of the two before taking ratio.
+ if (tht_tweaks) then
+ !+tht assume parametrisation for EVPPREC is correct with spec. hum.
+ evplimit = max(1._r8 - q(i,k)/(1._r8+q(i,k))/qs(i,k), 0._r8) !+tht
+ else
+ evplimit = max(1._r8 - q(i,k)/qs(i,k), 0._r8) ! orig
+ endif
+!-tht
+
+ if (zm_org) then
+ kemask = ke * (1._r8 - landfrac(i)) + ke_lnd * landfrac(i)
+ else
+ kemask = ke
+ endif
+
+! total evaporation depends on flux in the top of the layer
+! flux prec is the net production above layer minus evaporation into environmet
+ evpprec(i) = kemask * (1._r8 - cldfrc(i,k)) * evplimit * sqrt(flxprec(i,k))
+!**********************************************************
+!! evpprec(i) = 0. ! turn off evaporation for now
+!**********************************************************
+
+! Don't let evaporation supersaturate layer (approx). Layer may already be saturated.
+! Currently does not include heating/cooling change to qs
+ if (tht_tweaks) then
+ !+tht assume parametrisation for EVPPREC is correct with spec. hum.
+ !evplimit = max(0._r8, (qs(i,k)-q(i,k)/(1._r8+q(i,k))) / deltat) !+tht
+ else
+ evplimit = max(0._r8, (qs(i,k)-q(i,k)) / deltat) ! orig
+ endif
+! Don't evaporate more than is falling into the layer - do not evaporate rain formed
+! in this layer but if precip production is negative, remove from the available precip
+! Negative precip production occurs because of evaporation in downdrafts.
+!!$ evplimit = flxprec(i,k) * gravit / pdel(i,k) + min(prdprec(i,k), 0.)
+ evplimit = min(evplimit, flxprec(i,k) * gravit / pdel(i,k))
+
+! Total evaporation cannot exceed input precipitation
+ evplimit = min(evplimit, (prec(i) - evpvint(i)) * gravit / pdel(i,k))
+
+ evpprec(i) = min(evplimit, evpprec(i))
+ if( .not.old_snow ) then
+ evpprec(i) = max(0._r8, evpprec(i))
+ evpprec(i) = evpprec(i)*omsm
+ end if
+
+
+! evaporation of snow depends on snow fraction of total precipitation in the top after melting
+ if (flxprec(i,k) > 0._r8) then
+! evpsnow(i) = evpprec(i) * flxsntm(i) / flxprec(i,k)
+! prevent roundoff problems
+ work1 = min(max(0._r8,flxsntm(i)/flxprec(i,k)),1._r8)
+ evpsnow(i) = evpprec(i) * work1
+ else
+ evpsnow(i) = 0._r8
+ end if
+
+! vertically integrated evaporation
+ evpvint(i) = evpvint(i) + evpprec(i) * pdel(i,k)/gravit
+
+! net precip production is production - evaporation
+ ntprprd(i,k) = prdprec(i,k) - evpprec(i)
+! net snow production is precip production * ice fraction - evaporation - melting
+!pjrworks ntsnprd(i,k) = prdprec(i,k)*fice(i,k) - evpsnow(i) - snowmlt(i)
+!pjrwrks2 ntsnprd(i,k) = prdprec(i,k)*fsnow_conv(i,k) - evpsnow(i) - snowmlt(i)
+! the small amount added to flxprec in the work1 expression has been increased from
+! 1e-36 to 8.64e-11 (1e-5 mm/day). This causes the temperature based partitioning
+! scheme to be used for small flxprec amounts. This is to address error growth problems.
+
+ if( old_snow ) then
+#ifdef PERGRO
+ work1 = min(max(0._r8,flxsnow(i,k)/(flxprec(i,k)+8.64e-11_r8)),1._r8)
+#else
+ if (flxprec(i,k).gt.0._r8) then
+ work1 = min(max(0._r8,flxsnow(i,k)/flxprec(i,k)),1._r8)
+ else
+ work1 = 0._r8
+ endif
+#endif
+ work2 = max(fsnow_conv(i,k), work1)
+ if (snowmlt(i).gt.0._r8) work2 = 0._r8
+! work2 = fsnow_conv(i,k)
+ ntsnprd(i,k) = prdprec(i,k)*work2 - evpsnow(i) - snowmlt(i)
+ tend_s_snwprd (i,k) = prdprec(i,k)*work2*latice
+ tend_s_snwevmlt(i,k) = - ( evpsnow(i) + snowmlt(i) )*latice
+ else
+ ntsnprd(i,k) = prdsnow(i,k) - min(flxsnow(i,k)*gravit/pdel(i,k), evpsnow(i)+snowmlt(i))
+ tend_s_snwprd (i,k) = prdsnow(i,k)*latice
+ tend_s_snwevmlt(i,k) = -min(flxsnow(i,k)*gravit/pdel(i,k), evpsnow(i)+snowmlt(i) )*latice
+ end if
+
+! precipitation fluxes
+ flxprec(i,k+1) = flxprec(i,k) + ntprprd(i,k) * pdel(i,k)/gravit
+ flxsnow(i,k+1) = flxsnow(i,k) + ntsnprd(i,k) * pdel(i,k)/gravit
+
+! protect against rounding error
+ flxprec(i,k+1) = max(flxprec(i,k+1), 0._r8)
+ flxsnow(i,k+1) = max(flxsnow(i,k+1), 0._r8)
+! more protection (pjr)
+! flxsnow(i,k+1) = min(flxsnow(i,k+1), flxprec(i,k+1))
+
+! heating (cooling) and moistening due to evaporation
+! - latent heat of vaporization for precip production has already been accounted for
+! - snow is contained in prec
+ if( old_snow ) then
+ tend_s(i,k) =-evpprec(i)*latvap + ntsnprd(i,k)*latice
+ else
+ tend_s(i,k) =-evpprec(i)*latvap + tend_s_snwevmlt(i,k)
+ end if
+ tend_q(i,k) = evpprec(i)
+ end do
+ end do
+
+! set output precipitation rates (m/s)
+ prec(:ncol) = flxprec(:ncol,pver+1) / 1000._r8
+ snow(:ncol) = flxsnow(:ncol,pver+1) / 1000._r8
+
+!**********************************************************
+!!$ tend_s(:ncol,:) = 0. ! turn heating off
+!**********************************************************
+
+end subroutine zm_conv_evap
+
+
+
+subroutine convtran(lchnk , &
+ doconvtran,q ,ncnst ,mu ,md , &
+ du ,eu ,ed ,dp ,dsubcld , &
+ jt ,mx ,ideep ,il1g ,il2g , &
+ nstep ,fracis ,dqdt ,dpdry ,dt)
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Convective transport of trace species
+!
+! Mixing ratios may be with respect to either dry or moist air
+!
+! Method:
+!
+!
+!
+! Author: P. Rasch
+!
+!-----------------------------------------------------------------------
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use constituents, only: cnst_get_type_byind
+ use ppgrid
+
+ implicit none
+!-----------------------------------------------------------------------
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncnst ! number of tracers to transport
+ logical, intent(in) :: doconvtran(ncnst) ! flag for doing convective transport
+ real(r8), intent(in) :: q(pcols,pver,ncnst) ! Tracer array including moisture
+ real(r8), intent(in) :: mu(pcols,pver) ! Mass flux up
+ real(r8), intent(in) :: md(pcols,pver) ! Mass flux down
+ real(r8), intent(in) :: du(pcols,pver) ! Mass detraining from updraft
+ real(r8), intent(in) :: eu(pcols,pver) ! Mass entraining from updraft
+ real(r8), intent(in) :: ed(pcols,pver) ! Mass entraining from downdraft
+ real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces
+ real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc
+ real(r8), intent(in) :: fracis(pcols,pver,ncnst) ! fraction of tracer that is insoluble
+
+ integer, intent(in) :: jt(pcols) ! Index of cloud top for each column
+ integer, intent(in) :: mx(pcols) ! Index of cloud top for each column
+ integer, intent(in) :: ideep(pcols) ! Gathering array
+ integer, intent(in) :: il1g ! Gathered min lon indices over which to operate
+ integer, intent(in) :: il2g ! Gathered max lon indices over which to operate
+ integer, intent(in) :: nstep ! Time step index
+
+ real(r8), intent(in) :: dpdry(pcols,pver) ! Delta pressure between interfaces
+
+ real(r8), intent(in) :: dt ! 2 delta t (model time increment)
+
+! input/output
+
+ real(r8), intent(out) :: dqdt(pcols,pver,ncnst) ! Tracer tendency array
+
+!--------------------------Local Variables------------------------------
+
+ integer i ! Work index
+ integer k ! Work index
+ integer kbm ! Highest altitude index of cloud base
+ integer kk ! Work index
+ integer kkp1 ! Work index
+ integer km1 ! Work index
+ integer kp1 ! Work index
+ integer ktm ! Highest altitude index of cloud top
+ integer m ! Work index
+
+ real(r8) cabv ! Mix ratio of constituent above
+ real(r8) cbel ! Mix ratio of constituent below
+ real(r8) cdifr ! Normalized diff between cabv and cbel
+ real(r8) chat(pcols,pver) ! Mix ratio in env at interfaces
+ real(r8) cond(pcols,pver) ! Mix ratio in downdraft at interfaces
+ real(r8) const(pcols,pver) ! Gathered tracer array
+ real(r8) fisg(pcols,pver) ! gathered insoluble fraction of tracer
+ real(r8) conu(pcols,pver) ! Mix ratio in updraft at interfaces
+ real(r8) dcondt(pcols,pver) ! Gathered tend array
+ real(r8) small ! A small number
+ real(r8) mbsth ! Threshold for mass fluxes
+ real(r8) mupdudp ! A work variable
+ real(r8) minc ! A work variable
+ real(r8) maxc ! A work variable
+ real(r8) fluxin ! A work variable
+ real(r8) fluxout ! A work variable
+ real(r8) netflux ! A work variable
+
+ real(r8) dutmp(pcols,pver) ! Mass detraining from updraft
+ real(r8) eutmp(pcols,pver) ! Mass entraining from updraft
+ real(r8) edtmp(pcols,pver) ! Mass entraining from downdraft
+ real(r8) dptmp(pcols,pver) ! Delta pressure between interfaces
+ real(r8) total(pcols)
+ real(r8) negadt,qtmp
+
+!-----------------------------------------------------------------------
+!
+ small = 1.e-36_r8
+! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s)
+ mbsth = 1.e-15_r8
+
+! Find the highest level top and bottom levels of convection
+ ktm = pver
+ kbm = pver
+ do i = il1g, il2g
+ ktm = min(ktm,jt(i))
+ kbm = min(kbm,mx(i))
+ end do
+
+! Loop ever each constituent
+ do m = 2, ncnst
+ if (doconvtran(m)) then
+
+ if (cnst_get_type_byind(m).eq.'dry') then
+ do k = 1,pver
+ do i =il1g,il2g
+ dptmp(i,k) = dpdry(i,k)
+ dutmp(i,k) = du(i,k)*dp(i,k)/dpdry(i,k)
+ eutmp(i,k) = eu(i,k)*dp(i,k)/dpdry(i,k)
+ edtmp(i,k) = ed(i,k)*dp(i,k)/dpdry(i,k)
+ end do
+ end do
+ else
+ do k = 1,pver
+ do i =il1g,il2g
+ dptmp(i,k) = dp(i,k)
+ dutmp(i,k) = du(i,k)
+ eutmp(i,k) = eu(i,k)
+ edtmp(i,k) = ed(i,k)
+ end do
+ end do
+ endif
+! dptmp = dp
+
+! Gather up the constituent and set tend to zero
+ do k = 1,pver
+ do i =il1g,il2g
+ const(i,k) = q(ideep(i),k,m)
+ fisg(i,k) = fracis(ideep(i),k,m)
+ end do
+ end do
+
+! From now on work only with gathered data
+
+! Interpolate environment tracer values to interfaces
+ do k = 1,pver
+ km1 = max(1,k-1)
+ do i = il1g, il2g
+ minc = min(const(i,km1),const(i,k))
+ maxc = max(const(i,km1),const(i,k))
+ if (minc < 0) then
+ cdifr = 0._r8
+ else
+ cdifr = abs(const(i,k)-const(i,km1))/max(maxc,small)
+ endif
+
+! If the two layers differ significantly use a geometric averaging
+! procedure
+ if (cdifr > 1.E-6_r8) then
+ cabv = max(const(i,km1),maxc*1.e-12_r8)
+ cbel = max(const(i,k),maxc*1.e-12_r8)
+ chat(i,k) = log(cabv/cbel)/(cabv-cbel)*cabv*cbel
+
+ else ! Small diff, so just arithmetic mean
+ chat(i,k) = 0.5_r8* (const(i,k)+const(i,km1))
+ end if
+
+! Provisional up and down draft values
+ conu(i,k) = chat(i,k)
+ cond(i,k) = chat(i,k)
+
+! provisional tends
+ dcondt(i,k) = 0._r8
+
+ end do
+ end do
+
+! Do levels adjacent to top and bottom
+ k = 2
+ km1 = 1
+ kk = pver
+ do i = il1g,il2g
+ mupdudp = mu(i,kk) + dutmp(i,kk)*dptmp(i,kk)
+ if (mupdudp > mbsth) then
+ conu(i,kk) = (+eutmp(i,kk)*fisg(i,kk)*const(i,kk)*dptmp(i,kk))/mupdudp
+ endif
+ if (md(i,k) < -mbsth) then
+ cond(i,k) = (-edtmp(i,km1)*fisg(i,km1)*const(i,km1)*dptmp(i,km1))/md(i,k)
+ endif
+ end do
+
+! Updraft from bottom to top
+ do kk = pver-1,1,-1
+ kkp1 = min(pver,kk+1)
+ do i = il1g,il2g
+ mupdudp = mu(i,kk) + dutmp(i,kk)*dptmp(i,kk)
+ if (mupdudp > mbsth) then
+ conu(i,kk) = ( mu(i,kkp1)*conu(i,kkp1)+eutmp(i,kk)*fisg(i,kk)* &
+ const(i,kk)*dptmp(i,kk) )/mupdudp
+ endif
+ end do
+ end do
+
+! Downdraft from top to bottom
+ do k = 3,pver
+ km1 = max(1,k-1)
+ do i = il1g,il2g
+ if (md(i,k) < -mbsth) then
+ cond(i,k) = ( md(i,km1)*cond(i,km1)-edtmp(i,km1)*fisg(i,km1)*const(i,km1) &
+ *dptmp(i,km1) )/md(i,k)
+ endif
+ end do
+ end do
+
+
+ do k = ktm,pver
+ km1 = max(1,k-1)
+ kp1 = min(pver,k+1)
+ do i = il1g,il2g
+
+! version 1 hard to check for roundoff errors
+! dcondt(i,k) =
+! $ +(+mu(i,kp1)* (conu(i,kp1)-chat(i,kp1))
+! $ -mu(i,k)* (conu(i,k)-chat(i,k))
+! $ +md(i,kp1)* (cond(i,kp1)-chat(i,kp1))
+! $ -md(i,k)* (cond(i,k)-chat(i,k))
+! $ )/dp(i,k)
+
+! version 2 hard to limit fluxes
+! fluxin = mu(i,kp1)*conu(i,kp1) + mu(i,k)*chat(i,k)
+! $ -(md(i,k) *cond(i,k) + md(i,kp1)*chat(i,kp1))
+! fluxout = mu(i,k)*conu(i,k) + mu(i,kp1)*chat(i,kp1)
+! $ -(md(i,kp1)*cond(i,kp1) + md(i,k)*chat(i,k))
+
+! version 3 limit fluxes outside convection to mass in appropriate layer
+! these limiters are probably only safe for positive definite quantitities
+! it assumes that mu and md already satify a courant number limit of 1
+ fluxin = mu(i,kp1)*conu(i,kp1)+ mu(i,k)*min(chat(i,k),const(i,km1)) &
+ -(md(i,k) *cond(i,k) + md(i,kp1)*min(chat(i,kp1),const(i,kp1)))
+ fluxout = mu(i,k)*conu(i,k) + mu(i,kp1)*min(chat(i,kp1),const(i,k)) &
+ -(md(i,kp1)*cond(i,kp1) + md(i,k)*min(chat(i,k),const(i,k)))
+
+ netflux = fluxin - fluxout
+ if (abs(netflux) < max(fluxin,fluxout)*1.e-12_r8) then
+ netflux = 0._r8
+ endif
+ dcondt(i,k) = netflux/dptmp(i,k)
+ end do
+ end do
+! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!
+ do k = kbm,pver
+ km1 = max(1,k-1)
+ do i = il1g,il2g
+ if (k == mx(i)) then
+
+! version 1
+! dcondt(i,k) = (1./dsubcld(i))*
+! $ (-mu(i,k)*(conu(i,k)-chat(i,k))
+! $ -md(i,k)*(cond(i,k)-chat(i,k))
+! $ )
+
+! version 2
+! fluxin = mu(i,k)*chat(i,k) - md(i,k)*cond(i,k)
+! fluxout = mu(i,k)*conu(i,k) - md(i,k)*chat(i,k)
+! version 3
+ fluxin = mu(i,k)*min(chat(i,k),const(i,km1)) - md(i,k)*cond(i,k)
+ fluxout = mu(i,k)*conu(i,k) - md(i,k)*min(chat(i,k),const(i,k))
+
+ netflux = fluxin - fluxout
+ if (abs(netflux) < max(fluxin,fluxout)*1.e-12_r8) then
+ netflux = 0._r8
+ endif
+! dcondt(i,k) = netflux/dsubcld(i)
+ dcondt(i,k) = netflux/dptmp(i,k)
+ else if (k > mx(i)) then
+! dcondt(i,k) = dcondt(i,k-1)
+ dcondt(i,k) = 0._r8
+ end if
+ end do
+ end do
+
+ if (zmconv_microp) then
+ do i = il1g,il2g
+ do k = jt(i),mx(i)
+ if (dcondt(i,k)*dt+const(i,k)<0._r8) then
+ negadt = dcondt(i,k)+const(i,k)/dt
+ dcondt(i,k) = -const(i,k)/dt
+ do kk= k+1, mx(i)
+ if (negadt<0._r8 .and. dcondt(i,kk)*dt+const(i,kk)>0._r8 ) then
+ qtmp = dcondt(i,kk)+negadt*dptmp(i,k)/dptmp(i,kk)
+ if (qtmp*dt+const(i,kk)>0._r8) then
+ dcondt(i,kk)= qtmp
+ negadt=0._r8
+ else
+ negadt= negadt+(const(i,kk)/dt+dcondt(i,kk))*dptmp(i,kk)/dptmp(i,k)
+ dcondt(i,kk)= -const(i,kk)/dt
+ end if
+
+ end if
+ end do
+ do kk= k-1, jt(i), -1
+ if (negadt<0._r8 .and. dcondt(i,kk)*dt+const(i,kk)>0._r8 ) then
+ qtmp = dcondt(i,kk)+negadt*dptmp(i,k)/dptmp(i,kk)
+ if (qtmp*dt+const(i,kk)>0._r8) then
+ dcondt(i,kk)= qtmp
+ negadt=0._r8
+ else
+ negadt= negadt+(const(i,kk)/dt+dcondt(i,kk))*dptmp(i,kk)/dptmp(i,k)
+ dcondt(i,kk)= -const(i,kk)/dt
+ end if
+ end if
+ end do
+
+ if (negadt<0._r8) then
+ dcondt(i,k) = dcondt(i,k) + negadt
+ end if
+ end if
+ end do
+ end do
+ end if
+
+
+! Initialize to zero everywhere, then scatter tendency back to full array
+ dqdt(:,:,m) = 0._r8
+ do k = 1,pver
+ kp1 = min(pver,k+1)
+ do i = il1g,il2g
+ dqdt(ideep(i),k,m) = dcondt(i,k)
+ end do
+ end do
+
+ end if ! for doconvtran
+
+ end do
+
+ return
+end subroutine convtran
+
+!=========================================================================================
+
+subroutine momtran(lchnk, ncol, &
+ domomtran,q ,ncnst ,mu ,md , &
+ du ,eu ,ed ,dp ,dsubcld , &
+ jt ,mx ,ideep ,il1g ,il2g , &
+ nstep ,dqdt ,pguall ,pgdall, icwu, icwd, dt, seten )
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Convective transport of momentum
+!
+! Mixing ratios may be with respect to either dry or moist air
+!
+! Method:
+! Based on the convtran subroutine by P. Rasch
+!
+!
+! Author: J. Richter and P. Rasch
+!
+!-----------------------------------------------------------------------
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use constituents, only: cnst_get_type_byind
+ use ppgrid
+
+ implicit none
+!-----------------------------------------------------------------------
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ integer, intent(in) :: ncnst ! number of tracers to transport
+ logical, intent(in) :: domomtran(ncnst) ! flag for doing convective transport
+ real(r8), intent(in) :: q(pcols,pver,ncnst) ! Wind array
+ real(r8), intent(in) :: mu(pcols,pver) ! Mass flux up
+ real(r8), intent(in) :: md(pcols,pver) ! Mass flux down
+ real(r8), intent(in) :: du(pcols,pver) ! Mass detraining from updraft
+ real(r8), intent(in) :: eu(pcols,pver) ! Mass entraining from updraft
+ real(r8), intent(in) :: ed(pcols,pver) ! Mass entraining from downdraft
+ real(r8), intent(in) :: dp(pcols,pver) ! Delta pressure between interfaces
+ real(r8), intent(in) :: dsubcld(pcols) ! Delta pressure from cloud base to sfc
+ real(r8), intent(in) :: dt ! time step in seconds : 2*delta_t
+
+ integer, intent(in) :: jt(pcols) ! Index of cloud top for each column
+ integer, intent(in) :: mx(pcols) ! Index of cloud top for each column
+ integer, intent(in) :: ideep(pcols) ! Gathering array
+ integer, intent(in) :: il1g ! Gathered min lon indices over which to operate
+ integer, intent(in) :: il2g ! Gathered max lon indices over which to operate
+ integer, intent(in) :: nstep ! Time step index
+
+
+
+! input/output
+
+ real(r8), intent(out) :: dqdt(pcols,pver,ncnst) ! Tracer tendency array
+
+!--------------------------Local Variables------------------------------
+
+ integer i ! Work index
+ integer k ! Work index
+ integer kbm ! Highest altitude index of cloud base
+ integer kk ! Work index
+ integer kkp1 ! Work index
+ integer kkm1 ! Work index
+ integer km1 ! Work index
+ integer kp1 ! Work index
+ integer ktm ! Highest altitude index of cloud top
+ integer m ! Work index
+ integer ii ! Work index
+
+ real(r8) cabv ! Mix ratio of constituent above
+ real(r8) cbel ! Mix ratio of constituent below
+ real(r8) cdifr ! Normalized diff between cabv and cbel
+ real(r8) chat(pcols,pver) ! Mix ratio in env at interfaces
+ real(r8) cond(pcols,pver) ! Mix ratio in downdraft at interfaces
+ real(r8) const(pcols,pver) ! Gathered wind array
+ real(r8) conu(pcols,pver) ! Mix ratio in updraft at interfaces
+ real(r8) dcondt(pcols,pver) ! Gathered tend array
+ real(r8) mbsth ! Threshold for mass fluxes
+ real(r8) mupdudp ! A work variable
+ real(r8) minc ! A work variable
+ real(r8) maxc ! A work variable
+ real(r8) fluxin ! A work variable
+ real(r8) fluxout ! A work variable
+ real(r8) netflux ! A work variable
+
+ real(r8) sum ! sum
+ real(r8) sum2 ! sum2
+
+ real(r8) mududp(pcols,pver) ! working variable
+ real(r8) mddudp(pcols,pver) ! working variable
+
+ real(r8) pgu(pcols,pver) ! Pressure gradient term for updraft
+ real(r8) pgd(pcols,pver) ! Pressure gradient term for downdraft
+
+ real(r8),intent(out) :: pguall(pcols,pver,ncnst) ! Apparent force from updraft PG
+ real(r8),intent(out) :: pgdall(pcols,pver,ncnst) ! Apparent force from downdraft PG
+
+ real(r8),intent(out) :: icwu(pcols,pver,ncnst) ! In-cloud winds in updraft
+ real(r8),intent(out) :: icwd(pcols,pver,ncnst) ! In-cloud winds in downdraft
+
+ real(r8),intent(out) :: seten(pcols,pver) ! Dry static energy tendency
+ real(r8) gseten(pcols,pver) ! Gathered dry static energy tendency
+
+ real(r8) mflux(pcols,pverp,ncnst) ! Gathered momentum flux
+
+ real(r8) wind0(pcols,pver,ncnst) ! gathered wind before time step
+ real(r8) windf(pcols,pver,ncnst) ! gathered wind after time step
+ real(r8) fkeb, fket, ketend_cons, ketend, utop, ubot, vtop, vbot, gset2
+
+
+!-----------------------------------------------------------------------
+!
+
+! Initialize outgoing fields
+ pguall(:,:,:) = 0.0_r8
+ pgdall(:,:,:) = 0.0_r8
+! Initialize in-cloud winds to environmental wind
+ icwu(:ncol,:,:) = q(:ncol,:,:)
+ icwd(:ncol,:,:) = q(:ncol,:,:)
+
+! Initialize momentum flux and final winds
+ mflux(:,:,:) = 0.0_r8
+ wind0(:,:,:) = 0.0_r8
+ windf(:,:,:) = 0.0_r8
+
+! Initialize dry static energy
+
+ seten(:,:) = 0.0_r8
+ gseten(:,:) = 0.0_r8
+
+! mbsth is the threshold below which we treat the mass fluxes as zero (in mb/s)
+ mbsth = 1.e-15_r8
+
+! Find the highest level top and bottom levels of convection
+ ktm = pver
+ kbm = pver
+ do i = il1g, il2g
+ ktm = min(ktm,jt(i))
+ kbm = min(kbm,mx(i))
+ end do
+
+! Loop ever each wind component
+ do m = 1, ncnst !start at m = 1 to transport momentum
+ if (domomtran(m)) then
+
+! Gather up the winds and set tend to zero
+ do k = 1,pver
+ do i =il1g,il2g
+ const(i,k) = q(ideep(i),k,m)
+ wind0(i,k,m) = const(i,k)
+ end do
+ end do
+
+
+! From now on work only with gathered data
+
+! Interpolate winds to interfaces
+
+ do k = 1,pver
+ km1 = max(1,k-1)
+ do i = il1g, il2g
+
+ ! use arithmetic mean
+ chat(i,k) = 0.5_r8* (const(i,k)+const(i,km1))
+
+! Provisional up and down draft values
+ conu(i,k) = chat(i,k)
+ cond(i,k) = chat(i,k)
+
+! provisional tends
+ dcondt(i,k) = 0._r8
+
+ end do
+ end do
+
+
+!
+! Pressure Perturbation Term
+!
+
+ !Top boundary: assume mu is zero
+
+ k=1
+ pgu(:il2g,k) = 0.0_r8
+ pgd(:il2g,k) = 0.0_r8
+
+ do k=2,pver-1
+ km1 = max(1,k-1)
+ kp1 = min(pver,k+1)
+ do i = il1g,il2g
+
+ !interior points
+
+ mududp(i,k) = ( mu(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) &
+ + mu(i,kp1) * (const(i,kp1) - const(i,k))/dp(i,k))
+
+ pgu(i,k) = - momcu * 0.5_r8 * mududp(i,k)
+
+
+ mddudp(i,k) = ( md(i,k) * (const(i,k)- const(i,km1))/dp(i,km1) &
+ + md(i,kp1) * (const(i,kp1) - const(i,k))/dp(i,k))
+
+ pgd(i,k) = - momcd * 0.5_r8 * mddudp(i,k)
+
+
+ end do
+ end do
+
+ ! bottom boundary
+ k = pver
+ km1 = max(1,k-1)
+ do i=il1g,il2g
+
+ mududp(i,k) = mu(i,k) * (const(i,k)- const(i,km1))/dp(i,km1)
+ pgu(i,k) = - momcu * mududp(i,k)
+
+ mddudp(i,k) = md(i,k) * (const(i,k)- const(i,km1))/dp(i,km1)
+
+ pgd(i,k) = - momcd * mddudp(i,k)
+
+ end do
+
+
+!
+! In-cloud velocity calculations
+!
+
+! Do levels adjacent to top and bottom
+ k = 2
+ km1 = 1
+ kk = pver
+ kkm1 = max(1,kk-1)
+ do i = il1g,il2g
+ mupdudp = mu(i,kk) + du(i,kk)*dp(i,kk)
+ if (mupdudp > mbsth) then
+
+ conu(i,kk) = (+eu(i,kk)*const(i,kk)*dp(i,kk)+pgu(i,kk)*dp(i,kk))/mupdudp
+ endif
+ if (md(i,k) < -mbsth) then
+ cond(i,k) = (-ed(i,km1)*const(i,km1)*dp(i,km1))-pgd(i,km1)*dp(i,km1)/md(i,k)
+ endif
+
+
+ end do
+
+
+
+! Updraft from bottom to top
+ do kk = pver-1,1,-1
+ kkm1 = max(1,kk-1)
+ kkp1 = min(pver,kk+1)
+ do i = il1g,il2g
+ mupdudp = mu(i,kk) + du(i,kk)*dp(i,kk)
+ if (mupdudp > mbsth) then
+
+ conu(i,kk) = ( mu(i,kkp1)*conu(i,kkp1)+eu(i,kk)* &
+ const(i,kk)*dp(i,kk)+pgu(i,kk)*dp(i,kk))/mupdudp
+ endif
+ end do
+
+ end do
+
+
+! Downdraft from top to bottom
+ do k = 3,pver
+ km1 = max(1,k-1)
+ do i = il1g,il2g
+ if (md(i,k) < -mbsth) then
+
+ cond(i,k) = ( md(i,km1)*cond(i,km1)-ed(i,km1)*const(i,km1) &
+ *dp(i,km1)-pgd(i,km1)*dp(i,km1) )/md(i,k)
+
+ endif
+ end do
+ end do
+
+
+ sum = 0._r8
+ sum2 = 0._r8
+
+
+ do k = ktm,pver
+ km1 = max(1,k-1)
+ kp1 = min(pver,k+1)
+ do i = il1g,il2g
+ ii = ideep(i)
+
+! version 1 hard to check for roundoff errors
+ dcondt(i,k) = &
+ +(mu(i,kp1)* (conu(i,kp1)-chat(i,kp1)) &
+ -mu(i,k)* (conu(i,k)-chat(i,k)) &
+ +md(i,kp1)* (cond(i,kp1)-chat(i,kp1)) &
+ -md(i,k)* (cond(i,k)-chat(i,k)) &
+ )/dp(i,k)
+
+ end do
+ end do
+
+ ! dcont for bottom layer
+ !
+ do k = kbm,pver
+ km1 = max(1,k-1)
+ do i = il1g,il2g
+ if (k == mx(i)) then
+
+ ! version 1
+ dcondt(i,k) = (1._r8/dp(i,k))* &
+ (-mu(i,k)*(conu(i,k)-chat(i,k)) &
+ -md(i,k)*(cond(i,k)-chat(i,k)) &
+ )
+ end if
+ end do
+ end do
+
+! Initialize to zero everywhere, then scatter tendency back to full array
+ dqdt(:,:,m) = 0._r8
+
+ do k = 1,pver
+ do i = il1g,il2g
+ ii = ideep(i)
+ dqdt(ii,k,m) = dcondt(i,k)
+ ! Output apparent force on the mean flow from pressure gradient
+ pguall(ii,k,m) = -pgu(i,k)
+ pgdall(ii,k,m) = -pgd(i,k)
+ icwu(ii,k,m) = conu(i,k)
+ icwd(ii,k,m) = cond(i,k)
+ end do
+ end do
+
+ ! Calculate momentum flux in units of mb*m/s2
+
+ do k = ktm,pver
+ do i = il1g,il2g
+ ii = ideep(i)
+ mflux(i,k,m) = &
+ -mu(i,k)* (conu(i,k)-chat(i,k)) &
+ -md(i,k)* (cond(i,k)-chat(i,k))
+ end do
+ end do
+
+
+ ! Calculate winds at the end of the time step
+
+ do k = ktm,pver
+ do i = il1g,il2g
+ ii = ideep(i)
+ km1 = max(1,k-1)
+ kp1 = k+1
+ windf(i,k,m) = const(i,k) - (mflux(i,kp1,m) - mflux(i,k,m)) * dt /dp(i,k)
+
+ end do
+ end do
+
+ end if ! for domomtran
+ end do
+
+ ! Need to add an energy fix to account for the dissipation of kinetic energy
+ ! Formulation follows from Boville and Bretherton (2003)
+ ! formulation by PJR
+
+ do k = ktm,pver
+ km1 = max(1,k-1)
+ kp1 = min(pver,k+1)
+ do i = il1g,il2g
+
+ ii = ideep(i)
+
+ ! calculate the KE fluxes at top and bot of layer
+ ! based on a discrete approximation to b&b eq(35) F_KE = u*F_u + v*F_v at interface
+ utop = (wind0(i,k,1)+wind0(i,km1,1))/2._r8
+ vtop = (wind0(i,k,2)+wind0(i,km1,2))/2._r8
+ ubot = (wind0(i,kp1,1)+wind0(i,k,1))/2._r8
+ vbot = (wind0(i,kp1,2)+wind0(i,k,2))/2._r8
+ fket = utop*mflux(i,k,1) + vtop*mflux(i,k,2) ! top of layer
+ fkeb = ubot*mflux(i,k+1,1) + vbot*mflux(i,k+1,2) ! bot of layer
+
+ ! divergence of these fluxes should give a conservative redistribution of KE
+ ketend_cons = (fket-fkeb)/dp(i,k)
+
+ ! tendency in kinetic energy resulting from the momentum transport
+ ketend = ((windf(i,k,1)**2 + windf(i,k,2)**2) - (wind0(i,k,1)**2 + wind0(i,k,2)**2))*0.5_r8/dt
+
+ ! the difference should be the dissipation
+ gset2 = ketend_cons - ketend
+ gseten(i,k) = gset2
+
+ end do
+
+ end do
+
+ ! Scatter dry static energy to full array
+ do k = 1,pver
+ do i = il1g,il2g
+ ii = ideep(i)
+ seten(ii,k) = gseten(i,k)
+
+ end do
+ end do
+
+ return
+end subroutine momtran
+
+!=========================================================================================
+
+subroutine buoyan(lchnk ,ncol , &
+ q ,t ,p ,z ,pf , &
+ tp ,qstp ,tl ,rl ,cape , &
+ pblt ,lcl ,lel ,lon ,mx , &
+ rd ,grav ,cp ,msg , &
+ tpert )
+!-----------------------------------------------------------------------
+!
+! Purpose:
+!
+!
+! Method:
+!
+!
+!
+! Author:
+! This is contributed code not fully standardized by the CCM core group.
+! The documentation has been enhanced to the degree that we are able.
+! Reviewed: P. Rasch, April 1996
+!
+!-----------------------------------------------------------------------
+ implicit none
+!-----------------------------------------------------------------------
+!
+! input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+
+ real(r8), intent(in) :: q(pcols,pver) ! spec. humidity
+ real(r8), intent(in) :: t(pcols,pver) ! temperature
+ real(r8), intent(in) :: p(pcols,pver) ! pressure
+ real(r8), intent(in) :: z(pcols,pver) ! height
+ real(r8), intent(in) :: pf(pcols,pver+1) ! pressure at interfaces
+ real(r8), intent(in) :: pblt(pcols) ! index of pbl depth
+ real(r8), intent(in) :: tpert(pcols) ! perturbation temperature by pbl processes
+
+!
+! output arguments
+!
+ real(r8), intent(out) :: tp(pcols,pver) ! parcel temperature
+ real(r8), intent(out) :: qstp(pcols,pver) ! saturation mixing ratio of parcel
+ real(r8), intent(out) :: tl(pcols) ! parcel temperature at lcl
+ real(r8), intent(out) :: cape(pcols) ! convective aval. pot. energy.
+ integer lcl(pcols) !
+ integer lel(pcols) !
+ integer lon(pcols) ! level of onset of deep convection
+ integer mx(pcols) ! level of max moist static energy
+!
+!--------------------------Local Variables------------------------------
+!
+ real(r8) capeten(pcols,num_cin) ! provisional value of cape
+ real(r8) tv(pcols,pver) !
+ real(r8) tpv(pcols,pver) !
+ real(r8) buoy(pcols,pver)
+
+ real(r8) a1(pcols)
+ real(r8) a2(pcols)
+ real(r8) estp(pcols)
+ real(r8) pl(pcols)
+ real(r8) plexp(pcols)
+ real(r8) hmax(pcols)
+ real(r8) hmn(pcols)
+ real(r8) y(pcols)
+
+ logical plge600(pcols)
+ integer knt(pcols)
+ integer lelten(pcols,num_cin)
+
+ real(r8) cp
+ real(r8) e
+ real(r8) grav
+
+ integer i
+ integer k
+ integer msg
+ integer n
+
+ real(r8) rd
+ real(r8) rl
+#ifdef PERGRO
+ real(r8) rhd
+#endif
+!
+!-----------------------------------------------------------------------
+!
+ do n = 1,num_cin
+ do i = 1,ncol
+ lelten(i,n) = pver
+ capeten(i,n) = 0._r8
+ end do
+ end do
+!
+ do i = 1,ncol
+ lon(i) = pver
+ knt(i) = 0
+ lel(i) = pver
+ mx(i) = lon(i)
+ cape(i) = 0._r8
+ hmax(i) = 0._r8
+ end do
+
+ tp(:ncol,:) = t(:ncol,:)
+ qstp(:ncol,:) = q(:ncol,:)
+
+!!! RBN - Initialize tv and buoy for output.
+!!! tv=tv : tpv=tpv : qstp=q : buoy=0.
+ tv(:ncol,:) = t(:ncol,:) *(1._r8+1.608_r8*q(:ncol,:))/ (1._r8+q(:ncol,:))
+ tpv(:ncol,:) = tv(:ncol,:)
+ buoy(:ncol,:) = 0._r8
+
+!
+! set "launching" level(mx) to be at maximum moist static energy.
+! search for this level stops at planetary boundary layer top.
+!
+#ifdef PERGRO
+ do k = pver,msg + 1,-1
+ do i = 1,ncol
+ hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k)
+!
+! Reset max moist static energy level when relative difference exceeds 1.e-4
+!
+ rhd = (hmn(i) - hmax(i))/(hmn(i) + hmax(i))
+ if (k >= nint(pblt(i)) .and. k <= lon(i) .and. rhd > -1.e-4_r8) then
+ hmax(i) = hmn(i)
+ mx(i) = k
+ end if
+ end do
+ end do
+#else
+ do k = pver,msg + 1,-1
+ do i = 1,ncol
+ hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k)
+ if (k >= nint(pblt(i)) .and. k <= lon(i) .and. hmn(i) > hmax(i)) then
+ hmax(i) = hmn(i)
+ mx(i) = k
+ end if
+ end do
+ end do
+#endif
+!
+ do i = 1,ncol
+ lcl(i) = mx(i)
+ e = p(i,mx(i))*q(i,mx(i))/ (eps1+q(i,mx(i)))
+ tl(i) = 2840._r8/ (3.5_r8*log(t(i,mx(i)))-log(e)-4.805_r8) + 55._r8
+ if (tl(i) < t(i,mx(i))) then
+ plexp(i) = (1._r8/ (0.2854_r8* (1._r8-0.28_r8*q(i,mx(i)))))
+ pl(i) = p(i,mx(i))* (tl(i)/t(i,mx(i)))**plexp(i)
+ else
+ tl(i) = t(i,mx(i))
+ pl(i) = p(i,mx(i))
+ end if
+ end do
+
+!
+! calculate lifting condensation level (lcl).
+!
+ do k = pver,msg + 2,-1
+ do i = 1,ncol
+ if (k <= mx(i) .and. (p(i,k) > pl(i) .and. p(i,k-1) <= pl(i))) then
+ lcl(i) = k - 1
+ end if
+ end do
+ end do
+!
+! if lcl is above the nominal level of non-divergence (600 mbs),
+! no deep convection is permitted (ensuing calculations
+! skipped and cape retains initialized value of zero).
+!
+ do i = 1,ncol
+ plge600(i) = pl(i).ge.plclmin
+ end do
+!
+! initialize parcel properties in sub-cloud layer below lcl.
+!
+ do k = pver,msg + 1,-1
+ do i=1,ncol
+ if (k > lcl(i) .and. k <= mx(i) .and. plge600(i)) then
+ tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k))
+ qstp(i,k) = q(i,mx(i))
+ tp(i,k) = t(i,mx(i))* (p(i,k)/p(i,mx(i)))**(0.2854_r8* (1._r8-0.28_r8*q(i,mx(i))))
+!
+! buoyancy is increased by 0.5 k as in tiedtke
+!
+!-jjh tpv (i,k)=tp(i,k)*(1.+1.608*q(i,mx(i)))/
+!-jjh 1 (1.+q(i,mx(i)))
+ tpv(i,k) = (tp(i,k)+tpert(i))*(1._r8+1.608_r8*q(i,mx(i)))/ (1._r8+q(i,mx(i)))
+ buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add
+ end if
+ end do
+ end do
+
+!
+! define parcel properties at lcl (i.e. level immediately above pl).
+!
+ do k = pver,msg + 1,-1
+ do i=1,ncol
+ if (k == lcl(i) .and. plge600(i)) then
+ tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k))
+ qstp(i,k) = q(i,mx(i))
+ tp(i,k) = tl(i)* (p(i,k)/pl(i))**(0.2854_r8* (1._r8-0.28_r8*qstp(i,k)))
+! estp(i) =exp(21.656_r8 - 5418._r8/tp(i,k))
+! use of different formulas for es has about 1 g/kg difference
+! in qs at t= 300k, and 0.02 g/kg at t=263k, with the formula
+! above giving larger qs.
+ call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k))
+ a1(i) = cp / rl + qstp(i,k) * (1._r8+ qstp(i,k) / eps1) * rl * eps1 / &
+ (rd * tp(i,k) ** 2)
+ a2(i) = .5_r8* (qstp(i,k)* (1._r8+2._r8/eps1*qstp(i,k))* &
+ (1._r8+qstp(i,k)/eps1)*eps1**2*rl*rl/ &
+ (rd**2*tp(i,k)**4)-qstp(i,k)* &
+ (1._r8+qstp(i,k)/eps1)*2._r8*eps1*rl/ &
+ (rd*tp(i,k)**3))
+ a1(i) = 1._r8/a1(i)
+ a2(i) = -a2(i)*a1(i)**3
+ y(i) = q(i,mx(i)) - qstp(i,k)
+ tp(i,k) = tp(i,k) + a1(i)*y(i) + a2(i)*y(i)**2
+ call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k))
+!
+! buoyancy is increased by 0.5 k in cape calculation.
+! dec. 9, 1994
+!-jjh tpv(i,k) =tp(i,k)*(1.+1.608*qstp(i,k))/(1.+q(i,mx(i)))
+!
+ tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+q(i,mx(i)))
+ buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add
+ end if
+ end do
+ end do
+!
+! main buoyancy calculation.
+!
+ do k = pver - 1,msg + 1,-1
+ do i=1,ncol
+ if (k < lcl(i) .and. plge600(i)) then
+ tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k))
+ qstp(i,k) = qstp(i,k+1)
+ tp(i,k) = tp(i,k+1)* (p(i,k)/p(i,k+1))**(0.2854_r8* (1._r8-0.28_r8*qstp(i,k)))
+ call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k))
+ a1(i) = cp/rl + qstp(i,k)* (1._r8+qstp(i,k)/eps1)*rl*eps1/ (rd*tp(i,k)**2)
+ a2(i) = .5_r8* (qstp(i,k)* (1._r8+2._r8/eps1*qstp(i,k))* &
+ (1._r8+qstp(i,k)/eps1)*eps1**2*rl*rl/ &
+ (rd**2*tp(i,k)**4)-qstp(i,k)* &
+ (1._r8+qstp(i,k)/eps1)*2._r8*eps1*rl/ &
+ (rd*tp(i,k)**3))
+ a1(i) = 1._r8/a1(i)
+ a2(i) = -a2(i)*a1(i)**3
+ y(i) = qstp(i,k+1) - qstp(i,k)
+ tp(i,k) = tp(i,k) + a1(i)*y(i) + a2(i)*y(i)**2
+ call qsat_hPa(tp(i,k), p(i,k), estp(i), qstp(i,k))
+!-jjh tpv(i,k) =tp(i,k)*(1.+1.608*qstp(i,k))/
+!jt (1.+q(i,mx(i)))
+ tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k))/(1._r8+q(i,mx(i)))
+ buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add
+ end if
+ end do
+ end do
+
+!
+ do k = msg + 2,pver
+ do i = 1,ncol
+ if (k < lcl(i) .and. plge600(i)) then
+ if (buoy(i,k+1) > 0._r8 .and. buoy(i,k) <= 0._r8) then
+ knt(i) = min(5,knt(i) + 1)
+ lelten(i,knt(i)) = k
+ end if
+ end if
+ end do
+ end do
+!
+! calculate convective available potential energy (cape).
+!
+ do n = 1,5
+ do k = msg + 1,pver
+ do i = 1,ncol
+ if (plge600(i) .and. k <= mx(i) .and. k > lelten(i,n)) then
+ capeten(i,n) = capeten(i,n) + rd*buoy(i,k)*log(pf(i,k+1)/pf(i,k))
+ end if
+ end do
+ end do
+ end do
+!
+! find maximum cape from all possible tentative capes from
+! one sounding,
+! and use it as the final cape, april 26, 1995
+!
+ do n = 1,5
+ do i = 1,ncol
+ if (capeten(i,n) > cape(i)) then
+ cape(i) = capeten(i,n)
+ lel(i) = lelten(i,n)
+ end if
+ end do
+ end do
+!
+! put lower bound on cape for diagnostic purposes.
+!
+ do i = 1,ncol
+ cape(i) = max(cape(i), 0._r8)
+ end do
+!
+ return
+end subroutine buoyan
+
+subroutine cldprp(lchnk , &
+ q ,t ,u ,v ,p , &
+ z ,s ,mu ,eu ,du , &
+ md ,ed ,sd ,qd ,mc , &
+ qu ,su ,zf ,qst ,hmn , &
+ hsat ,shat ,ql , &
+ cmeg ,jb ,lel ,jt ,jlcl , &
+ mx ,j0 ,jd ,rl ,il2g , &
+ rd ,grav ,cp ,msg , &
+ pflx ,evp ,cu ,rprd ,limcnv ,landfrac, &
+ qcde ,aero ,loc_conv,qhat )
+
+!-----------------------------------------------------------------------
+!
+! Purpose:
+!
+!
+! Method:
+! may 09/91 - guang jun zhang, m.lazare, n.mcfarlane.
+! original version cldprop.
+!
+! Author: See above, modified by P. Rasch
+! This is contributed code not fully standardized by the CCM core group.
+!
+! this code is very much rougher than virtually anything else in the CCM
+! there are debug statements left strewn about and code segments disabled
+! these are to facilitate future development. We expect to release a
+! cleaner code in a future release
+!
+! the documentation has been enhanced to the degree that we are able
+!
+!-----------------------------------------------------------------------
+
+ implicit none
+
+!------------------------------------------------------------------------------
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+
+ real(r8), intent(in) :: q(pcols,pver) ! spec. humidity of env
+ real(r8), intent(in) :: t(pcols,pver) ! temp of env
+ real(r8), intent(in) :: p(pcols,pver) ! pressure of env
+ real(r8), intent(in) :: z(pcols,pver) ! height of env
+ real(r8), intent(in) :: s(pcols,pver) ! normalized dry static energy of env
+ real(r8), intent(in) :: zf(pcols,pverp) ! height of interfaces
+ real(r8), intent(in) :: u(pcols,pver) ! zonal velocity of env
+ real(r8), intent(in) :: v(pcols,pver) ! merid. velocity of env
+
+ real(r8), intent(in) :: landfrac(pcols) ! RBN Landfrac
+
+ integer, intent(in) :: jb(pcols) ! updraft base level
+ integer, intent(in) :: lel(pcols) ! updraft launch level
+ integer, intent(out) :: jt(pcols) ! updraft plume top
+ integer, intent(out) :: jlcl(pcols) ! updraft lifting cond level
+ integer, intent(in) :: mx(pcols) ! updraft base level (same is jb)
+ integer, intent(out) :: j0(pcols) ! level where updraft begins detraining
+ integer, intent(out) :: jd(pcols) ! level of downdraft
+ integer, intent(in) :: limcnv ! convection limiting level
+ integer, intent(in) :: il2g !CORE GROUP REMOVE
+ integer, intent(in) :: msg ! missing moisture vals (always 0)
+ real(r8), intent(in) :: rl ! latent heat of vap
+ real(r8), intent(in) :: shat(pcols,pver) ! interface values of dry stat energy
+ real(r8), intent(in) :: qhat(pcols,pver) ! wg grid slice of upper interface mixing ratio.
+ type(zm_aero_t), intent(in) :: aero ! aerosol object
+
+!
+! output
+!
+ real(r8), intent(out) :: rprd(pcols,pver) ! rate of production of precip at that layer
+ real(r8), intent(out) :: du(pcols,pver) ! detrainement rate of updraft
+ real(r8), intent(out) :: ed(pcols,pver) ! entrainment rate of downdraft
+ real(r8), intent(out) :: eu(pcols,pver) ! entrainment rate of updraft
+ real(r8), intent(out) :: hmn(pcols,pver) ! moist stat energy of env
+ real(r8), intent(out) :: hsat(pcols,pver) ! sat moist stat energy of env
+ real(r8), intent(out) :: mc(pcols,pver) ! net mass flux
+ real(r8), intent(out) :: md(pcols,pver) ! downdraft mass flux
+ real(r8), intent(out) :: mu(pcols,pver) ! updraft mass flux
+ real(r8), intent(out) :: pflx(pcols,pverp) ! precipitation flux thru layer
+ real(r8), intent(out) :: qd(pcols,pver) ! spec humidity of downdraft
+ real(r8), intent(out) :: ql(pcols,pver) ! liq water of updraft
+ real(r8), intent(out) :: qst(pcols,pver) ! saturation mixing ratio of env.
+ real(r8), intent(out) :: qu(pcols,pver) ! spec hum of updraft
+ real(r8), intent(out) :: sd(pcols,pver) ! normalized dry stat energy of downdraft
+ real(r8), intent(out) :: su(pcols,pver) ! normalized dry stat energy of updraft
+ real(r8), intent(out) :: qcde(pcols,pver) ! cloud water mixing ratio for detrainment (kg/kg)
+
+ type(zm_conv_t) :: loc_conv
+
+ real(r8) rd ! gas constant for dry air
+ real(r8) grav ! gravity
+ real(r8) cp ! heat capacity of dry air
+
+!
+! Local workspace
+!
+ real(r8) gamma(pcols,pver)
+ real(r8) dz(pcols,pver)
+ real(r8) iprm(pcols,pver)
+ real(r8) hu(pcols,pver)
+ real(r8) hd(pcols,pver)
+ real(r8) eps(pcols,pver)
+ real(r8) f(pcols,pver)
+ real(r8) k1(pcols,pver)
+ real(r8) i2(pcols,pver)
+ real(r8) ihat(pcols,pver)
+ real(r8) i3(pcols,pver)
+ real(r8) idag(pcols,pver)
+ real(r8) i4(pcols,pver)
+ real(r8) qsthat(pcols,pver)
+ real(r8) hsthat(pcols,pver)
+ real(r8) gamhat(pcols,pver)
+ real(r8) cu(pcols,pver)
+ real(r8) evp(pcols,pver)
+ real(r8) cmeg(pcols,pver)
+ real(r8) qds(pcols,pver)
+! RBN For c0mask
+ real(r8) c0mask(pcols)
+!tht For tiedke_msk
+ real(r8) tiedke_msk(pcols)
+
+!tht moist thermo vars
+ real(r8), dimension(pcols,pver) :: mcp,mrd,mrl,tu,td
+!-tht
+
+ real(r8) hmin(pcols)
+ real(r8) expdif(pcols)
+ real(r8) expnum(pcols)
+ real(r8) ftemp(pcols)
+ real(r8) eps0(pcols)
+ real(r8) rmue(pcols)
+ real(r8) zuef(pcols)
+ real(r8) zdef(pcols)
+ real(r8) epsm(pcols)
+ real(r8) ratmjb(pcols)
+ real(r8) est(pcols)
+ real(r8) totpcp(pcols)
+ real(r8) totevp(pcols)
+ real(r8) alfa(pcols)
+ real(r8) ql1
+ !real(r8) tu
+ real(r8) estu
+ real(r8) qstu
+
+ real(r8) small
+ real(r8) mdt
+
+ real(r8) fice(pcols,pver) ! ice fraction in precip production
+ real(r8) tug(pcols,pver)
+
+ real(r8) tvuo(pcols,pver) ! updraft virtual T w/o freezing heating
+ real(r8) tvu(pcols,pver) ! updraft virtual T with freezing heating
+ real(r8) totfrz(pcols)
+ real(r8) frz (pcols,pver) ! rate of freezing
+ integer jto(pcols) ! updraft plume old top
+ integer tmplel(pcols)
+
+ integer iter, itnum
+ integer m
+
+ integer khighest
+ integer klowest
+ integer kount
+ integer i,k
+
+ logical doit(pcols)
+ logical done(pcols)
+!
+!------------------------------------------------------------------------------
+!
+ if (zmconv_microp) then
+ loc_conv%autolm(:il2g,:) = 0._r8
+ loc_conv%accrlm(:il2g,:) = 0._r8
+ loc_conv%bergnm(:il2g,:) = 0._r8
+ loc_conv%fhtimm(:il2g,:) = 0._r8
+ loc_conv%fhtctm(:il2g,:) = 0._r8
+ loc_conv%fhmlm (:il2g,:) = 0._r8
+ loc_conv%hmpim (:il2g,:) = 0._r8
+ loc_conv%accslm(:il2g,:) = 0._r8
+ loc_conv%dlfm (:il2g,:) = 0._r8
+
+ loc_conv%autoln(:il2g,:) = 0._r8
+ loc_conv%accrln(:il2g,:) = 0._r8
+ loc_conv%bergnn(:il2g,:) = 0._r8
+ loc_conv%fhtimn(:il2g,:) = 0._r8
+ loc_conv%fhtctn(:il2g,:) = 0._r8
+ loc_conv%fhmln (:il2g,:) = 0._r8
+ loc_conv%accsln(:il2g,:) = 0._r8
+ loc_conv%activn(:il2g,:) = 0._r8
+ loc_conv%dlfn (:il2g,:) = 0._r8
+
+ loc_conv%autoim(:il2g,:) = 0._r8
+ loc_conv%accsim(:il2g,:) = 0._r8
+ loc_conv%difm (:il2g,:) = 0._r8
+
+ loc_conv%nuclin(:il2g,:) = 0._r8
+ loc_conv%autoin(:il2g,:) = 0._r8
+ loc_conv%accsin(:il2g,:) = 0._r8
+ loc_conv%hmpin (:il2g,:) = 0._r8
+ loc_conv%difn (:il2g,:) = 0._r8
+
+ loc_conv%trspcm(:il2g,:) = 0._r8
+ loc_conv%trspcn(:il2g,:) = 0._r8
+ loc_conv%trspim(:il2g,:) = 0._r8
+ loc_conv%trspin(:il2g,:) = 0._r8
+
+ loc_conv%dcape (:il2g) = 0._r8
+
+ end if
+
+ do i = 1,il2g
+ ftemp(i) = 0._r8
+ expnum(i) = 0._r8
+ expdif(i) = 0._r8
+ c0mask(i) = c0_ocn * (1._r8-landfrac(i)) + c0_lnd * landfrac(i)
+ tiedke_msk(i)=tiedke_add* (1._r8-landfrac(i)) + tiedke_lnd* landfrac(i)
+ end do
+!
+!jr Change from msg+1 to 1 to prevent blowup
+!
+ do k = 1,pver
+ do i = 1,il2g
+ dz(i,k) = zf(i,k) - zf(i,k+1)
+ end do
+ end do
+
+!
+! initialize many output and work variables to zero
+!
+ pflx(:il2g,1) = 0
+
+ do k = 1,pver
+ do i = 1,il2g
+ k1(i,k) = 0._r8
+ i2(i,k) = 0._r8
+ i3(i,k) = 0._r8
+ i4(i,k) = 0._r8
+ mu(i,k) = 0._r8
+ f(i,k) = 0._r8
+ eps(i,k) = 0._r8
+ eu(i,k) = 0._r8
+ du(i,k) = 0._r8
+ ql(i,k) = 0._r8
+ cu(i,k) = 0._r8
+ evp(i,k) = 0._r8
+ cmeg(i,k) = 0._r8
+ qds(i,k) = q(i,k)
+ md(i,k) = 0._r8
+ ed(i,k) = 0._r8
+ sd(i,k) = s(i,k)
+ qd(i,k) = q(i,k)
+ mc(i,k) = 0._r8
+ qu(i,k) = q(i,k)
+ su(i,k) = s(i,k)
+ call qsat_hPa(t(i,k), p(i,k), est(i), qst(i,k))
+
+ if ( p(i,k)-est(i) <= 0._r8 ) then
+ qst(i,k) = 1.0_r8
+ end if
+!tht moist thermo
+ mrd(i,k) = (1._r8+zvir*q(i,k))*rd
+ mcp(i,k) = (1._r8+cpvir*q(i,k))*cp
+ mrl(i,k) = (1._r8-dcol*(t(i,k)-tmelt))*rl
+! gamma(i,k) = qst(i,k)*(1._r8 + qst(i,k)/eps1)*eps1*rl/(rd*t(i,k)**2)*rl/cp
+!!tht: mixing ratios; note that q dependence of Cp and T dependence of L are ignored
+! hmn(i,k) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k)
+! hsat(i,k) = cp*t(i,k) + grav*z(i,k) + rl*qst(i,k)
+ gamma(i,k) = qst(i,k)*(1._r8 + qst(i,k)/eps1)*eps1*mrl(i,k)/(mrd(i,k)*t(i,k)**2)*mrl(i,k)/mcp(i,k)
+ hmn(i,k) = mcp(i,k)*t(i,k) + grav*z(i,k) + mrl(i,k)*q(i,k)
+ hsat(i,k) = mcp(i,k)*t(i,k) + grav*z(i,k) + mrl(i,k)*qst(i,k)
+!-tht
+ hu(i,k) = hmn(i,k)
+ hd(i,k) = hmn(i,k)
+ rprd(i,k) = 0._r8
+
+ fice(i,k) = 0._r8
+ tug(i,k) = 0._r8
+ qcde(i,k) = 0._r8
+!+tht moist thermo
+ !tvuo(i,k) = (shat(i,k) - grav/cp*zf(i,k))*(1._r8 + 0.608_r8*qhat(i,k))
+ tvuo(i,k) = (shat(i,k) - grav/mcp(i,k)*zf(i,k))*(1._r8+zvir*qhat(i,k))
+!-tht
+ tvu(i,k) = tvuo(i,k)
+ frz(i,k) = 0._r8
+
+ end do
+ end do
+ if (zmconv_microp) then
+ do k = 1,pver
+ do i = 1,il2g
+ loc_conv%sprd(i,k) = 0._r8
+ loc_conv%wu(i,k) = 0._r8
+ loc_conv%cmel(i,k) = 0._r8
+ loc_conv%cmei(i,k) = 0._r8
+ loc_conv%qliq(i,k) = 0._r8
+ loc_conv%qice(i,k) = 0._r8
+ loc_conv%qnl(i,k) = 0._r8
+ loc_conv%qni(i,k) = 0._r8
+ loc_conv%qide(i,k) = 0._r8
+ loc_conv%qncde(i,k) = 0._r8
+ loc_conv%qnide(i,k) = 0._r8
+ loc_conv%qnr(i,k) = 0._r8
+ loc_conv%qns(i,k) = 0._r8
+ loc_conv%qrain(i,k)= 0._r8
+ loc_conv%qsnow(i,k)= 0._r8
+ loc_conv%frz(i,k) = 0._r8
+ end do
+ end do
+ end if
+!
+!jr Set to zero things which make this routine blow up
+!
+ do k=1,msg
+ do i=1,il2g
+ rprd(i,k) = 0._r8
+ end do
+ end do
+!
+! interpolate the layer values of qst, hsat and gamma to
+! layer interfaces
+!
+ do k = 1, msg+1
+ do i = 1,il2g
+ hsthat(i,k) = hsat(i,k)
+ qsthat(i,k) = qst(i,k)
+ gamhat(i,k) = gamma(i,k)
+ end do
+ end do
+ do i = 1,il2g
+ totpcp(i) = 0._r8
+ totevp(i) = 0._r8
+ end do
+ do k = msg + 2,pver
+ do i = 1,il2g
+ if (abs(qst(i,k-1)-qst(i,k)) > 1.E-6_r8) then
+ qsthat(i,k) = log(qst(i,k-1)/qst(i,k))*qst(i,k-1)*qst(i,k)/ (qst(i,k-1)-qst(i,k))
+ else
+ qsthat(i,k) = qst(i,k)
+ end if
+!+tht moist thermo
+ !hsthat(i,k) = cp*shat(i,k) + rl*qsthat(i,k)
+ hsthat(i,k) =mcp(i,k)*shat(i,k) +mrl(i,k)*qsthat(i,k)
+!-tht
+ if (abs(gamma(i,k-1)-gamma(i,k)) > 1.E-6_r8) then
+ gamhat(i,k) = log(gamma(i,k-1)/gamma(i,k))*gamma(i,k-1)*gamma(i,k)/ &
+ (gamma(i,k-1)-gamma(i,k))
+ else
+ gamhat(i,k) = gamma(i,k)
+ end if
+ end do
+ end do
+!
+! initialize cloud top to highest plume top.
+!jr changed hard-wired 4 to limcnv+1 (not to exceed pver)
+!
+ jt(:) = pver
+ do i = 1,il2g
+ jt(i) = max(lel(i),limcnv+1)
+ jt(i) = min(jt(i),pver)
+ jd(i) = pver
+ jlcl(i) = lel(i)
+ hmin(i) = 1.E6_r8
+ end do
+!
+! find the level of minimum hsat, where detrainment starts
+!
+
+ do k = msg + 1,pver
+ do i = 1,il2g
+ if (hsat(i,k) <= hmin(i) .and. k >= jt(i) .and. k <= jb(i)) then
+ hmin(i) = hsat(i,k)
+ j0(i) = k
+ end if
+ end do
+ end do
+ do i = 1,il2g
+ j0(i) = min(j0(i),jb(i)-2)
+ j0(i) = max(j0(i),jt(i)+2)
+!
+! Fix from Guang Zhang to address out of bounds array reference
+!
+ j0(i) = min(j0(i),pver)
+ end do
+!
+! Initialize certain arrays inside cloud
+!
+ do k = msg + 1,pver
+ do i = 1,il2g
+ if (k >= jt(i) .and. k <= jb(i)) then
+!+tht moist thermo - uniform perturbation either in h or in s
+ hu(i,k) = hmn(i,mx(i)) + cp*tiedke_msk(i)
+ !su(i,k) = s(i,mx(i)) + tiedke_msk(i)
+ su(i,k) = s(i,mx(i)) + tiedke_msk(i)/(1._r8+cpvir*qu(i,k))
+!-tht
+ end if
+ end do
+ end do
+!
+! *********************************************************
+! compute taylor series for approximate eps(z) below
+! *********************************************************
+!
+ do k = pver - 1,msg + 1,-1
+ do i = 1,il2g
+ if (k < jb(i) .and. k >= jt(i)) then
+ k1(i,k) = k1(i,k+1) + (hmn(i,mx(i))-hmn(i,k))*dz(i,k)
+ ihat(i,k) = 0.5_r8* (k1(i,k+1)+k1(i,k))
+ i2(i,k) = i2(i,k+1) + ihat(i,k)*dz(i,k)
+ idag(i,k) = 0.5_r8* (i2(i,k+1)+i2(i,k))
+ i3(i,k) = i3(i,k+1) + idag(i,k)*dz(i,k)
+ iprm(i,k) = 0.5_r8* (i3(i,k+1)+i3(i,k))
+ i4(i,k) = i4(i,k+1) + iprm(i,k)*dz(i,k)
+ end if
+ end do
+ end do
+!
+! re-initialize hmin array for ensuing calculation.
+!
+ do i = 1,il2g
+ hmin(i) = 1.E6_r8
+ end do
+ do k = msg + 1,pver
+ do i = 1,il2g
+ if (k >= j0(i) .and. k <= jb(i) .and. hmn(i,k) <= hmin(i)) then
+ hmin(i) = hmn(i,k)
+ expdif(i) = hmn(i,mx(i)) - hmin(i)
+ end if
+ end do
+ end do
+!
+! *********************************************************
+! compute approximate eps(z) using above taylor series
+! *********************************************************
+!
+ do k = msg + 2,pver
+ do i = 1,il2g
+ expnum(i) = 0._r8
+ ftemp(i) = 0._r8
+ if (k < jt(i) .or. k >= jb(i)) then
+ k1(i,k) = 0._r8
+ expnum(i) = 0._r8
+ else
+ expnum(i) = hmn(i,mx(i)) - (hsat(i,k-1)*(zf(i,k)-z(i,k)) + &
+ hsat(i,k)* (z(i,k-1)-zf(i,k)))/(z(i,k-1)-z(i,k))
+ end if
+ if ((expdif(i) > 100._r8 .and. expnum(i) > 0._r8) .and. &
+ k1(i,k) > expnum(i)*dz(i,k)) then
+ ftemp(i) = expnum(i)/k1(i,k)
+ f(i,k) = ftemp(i) + i2(i,k)/k1(i,k)*ftemp(i)**2 + &
+ (2._r8*i2(i,k)**2-k1(i,k)*i3(i,k))/k1(i,k)**2* &
+ ftemp(i)**3 + (-5._r8*k1(i,k)*i2(i,k)*i3(i,k)+ &
+ 5._r8*i2(i,k)**3+k1(i,k)**2*i4(i,k))/ &
+ k1(i,k)**3*ftemp(i)**4
+ f(i,k) = max(f(i,k),0._r8)
+!-->> maximum entr. rate (lambda_0 in paper) here set = 2e-4 !! (tht) <<--
+ !f(i,k) = min(f(i,k),0.0002_r8)
+ f(i,k) = min(f(i,k),entrmn)
+ end if
+ end do
+ end do
+ do i = 1,il2g
+ if (j0(i) < jb(i)) then
+ if (f(i,j0(i)) < 1.E-6_r8 .and. f(i,j0(i)+1) > f(i,j0(i))) j0(i) = j0(i) + 1
+ end if
+ end do
+ do k = msg + 2,pver
+ do i = 1,il2g
+ if (k >= jt(i) .and. k <= j0(i)) then
+ f(i,k) = max(f(i,k),f(i,k-1))
+ end if
+ end do
+ end do
+ do i = 1,il2g
+ eps0(i) = f(i,j0(i))
+ eps(i,jb(i)) = eps0(i)
+ end do
+!
+! This is set to match the Rasch and Kristjansson paper
+!
+ do k = pver,msg + 1,-1
+ do i = 1,il2g
+ if (k >= j0(i) .and. k <= jb(i)) then
+ eps(i,k) = f(i,j0(i))
+ end if
+ end do
+ end do
+ do k = pver,msg + 1,-1
+ do i = 1,il2g
+ if (k < j0(i) .and. k >= jt(i)) eps(i,k) = f(i,k)
+ end do
+ end do
+
+ if (zmconv_microp) then
+ itnum = 2
+ else
+ itnum = 1
+ end if
+
+ do iter=1, itnum
+
+ if (zmconv_microp) then
+ do k = pver,msg + 1,-1
+ do i = 1,il2g
+ cu(i,k) = 0._r8
+ loc_conv%qliq(i,k) = 0._r8
+ loc_conv%qice(i,k) = 0._r8
+ ql(i,k) = 0._r8
+ loc_conv%frz(i,k) = 0._r8
+ end do
+ end do
+ do i = 1,il2g
+ totpcp(i) = 0._r8
+ hu(i,jb(i)) = hmn(i,jb(i)) + cp*tiedke_msk(i)
+ end do
+
+ end if
+
+!
+! specify the updraft mass flux mu, entrainment eu, detrainment du
+! and moist static energy hu.
+! here and below mu, eu,du, md and ed are all normalized by mb
+!
+ do i = 1,il2g
+ if (eps0(i) > 0._r8) then
+ mu(i,jb(i)) = 1._r8
+ eu(i,jb(i)) = mu(i,jb(i))/dz(i,jb(i))
+ end if
+ if (zmconv_microp) then
+ tmplel(i) = lel(i)
+ else
+ tmplel(i) = jt(i)
+ end if
+ end do
+ do k = pver,msg + 1,-1
+ do i = 1,il2g
+ if (eps0(i) > 0._r8 .and. (k >= tmplel(i) .and. k < jb(i))) then
+ zuef(i) = zf(i,k) - zf(i,jb(i))
+ rmue(i) = (1._r8/eps0(i))* (exp(eps(i,k+1)*zuef(i))-1._r8)/zuef(i)
+ mu(i,k) = (1._r8/eps0(i))* (exp(eps(i,k )*zuef(i))-1._r8)/zuef(i)
+ eu(i,k) = (rmue(i)-mu(i,k+1))/dz(i,k)
+ du(i,k) = (rmue(i)-mu(i,k))/dz(i,k)
+ end if
+ end do
+ end do
+
+ khighest = pverp
+ klowest = 1
+ do i=1,il2g
+ khighest = min(khighest,lel(i))
+ klowest = max(klowest,jb(i))
+ end do
+ do k = klowest-1,khighest,-1
+ do i = 1,il2g
+ if (k <= jb(i)-1 .and. k >= lel(i) .and. eps0(i) > 0._r8) then
+ if (mu(i,k) < 0.02_r8) then
+ hu(i,k) = hmn(i,k)
+ mu(i,k) = 0._r8
+ eu(i,k) = 0._r8
+ du(i,k) = mu(i,k+1)/dz(i,k)
+ else
+ if (zmconv_microp) then
+ hu(i,k) = (mu(i,k+1)*hu(i,k+1) + dz(i,k)*(eu(i,k)*hmn(i,k) + &
+ latice*frz(i,k)))/(mu(i,k)+ dz(i,k)*du(i,k))
+ else
+ hu(i,k) = mu(i,k+1)/mu(i,k)*hu(i,k+1) + &
+ dz(i,k)/mu(i,k)* (eu(i,k)*hmn(i,k)- du(i,k)*hsat(i,k))
+ end if
+ end if
+ end if
+ end do
+ end do
+!
+! reset cloud top index beginning from two layers above the
+! cloud base (i.e. if cloud is only one layer thick, top is not reset
+!
+ do i=1,il2g
+ doit(i) = .true.
+ totfrz(i)= 0._r8
+ do k = pver,msg + 1,-1
+ totfrz(i)= totfrz(i)+ frz(i,k)*dz(i,k)
+ end do
+ end do
+ do k=klowest-2,khighest-1,-1
+ do i=1,il2g
+ if (doit(i) .and. k <= jb(i)-2 .and. k >= lel(i)-1) then
+ if (hu(i,k) <= hsthat(i,k) .and. hu(i,k+1) > hsthat(i,k+1) &
+ .and. mu(i,k) >= 0.02_r8) then
+ if (hu(i,k)-hsthat(i,k) < -2000._r8) then
+ jt(i) = k + 1
+ doit(i) = .false.
+ else
+ jt(i) = k
+ doit(i) = .false.
+ end if
+ else if ( (hu(i,k) > hu(i,jb(i)) .and. totfrz(i)<=0._r8) .or. mu(i,k) < 0.02_r8) then
+ jt(i) = k + 1
+ doit(i) = .false.
+ end if
+ end if
+ end do
+ end do
+
+ if (iter == 1) jto(:) = jt(:)
+
+ do k = pver,msg + 1,-1
+ do i = 1,il2g
+ if (k >= lel(i) .and. k <= jt(i) .and. eps0(i) > 0._r8) then
+ mu(i,k) = 0._r8
+ eu(i,k) = 0._r8
+ du(i,k) = 0._r8
+ hu(i,k) = hmn(i,k)
+ end if
+ if (k == jt(i) .and. eps0(i) > 0._r8) then
+ du(i,k) = mu(i,k+1)/dz(i,k)
+ eu(i,k) = 0._r8
+ mu(i,k) = 0._r8
+ end if
+ end do
+ end do
+
+! initialise tu (moist thermo)
+ do k = pver,msg + 2,-1
+ do i = 1,il2g
+ tu(i,k) = (hu(i,k)-grav*zf(i,k)-(1._r8+dcol*tmelt)*rl*qu(i,k)) &
+ /(cp*( 1._r8 + (cpvir-dcol*(rl/cp))*qu(i,k) ))
+ end do
+ end do
+
+ do i = 1,il2g
+ done(i) = .false.
+ end do
+ kount = 0
+ do k = pver,msg + 2,-1
+ do i = 1,il2g
+ if (k == jb(i) .and. eps0(i) > 0._r8) then
+ qu(i,k) = q(i,mx(i))
+!+tht moist thermo
+ !su(i,k) = (hu(i,k)-rl*qu(i,k))/cp
+ tu(i,k) = (hu(i,k)-grav*zf(i,k)-(1._r8+dcol*tmelt)*rl*qu(i,k)) &
+ /(cp*( 1._r8 + (cpvir-dcol*(rl/cp))*qu(i,k) ))
+ su(i,k) = (hu(i,k)-(1._r8-dcol*(tu(i,k)-tmelt))*rl*qu(i,k)) &
+ /((1._r8+cpvir*qu(i,k))*cp)
+!-tht
+ end if
+ if (( .not. done(i) .and. k > jt(i) .and. k < jb(i)) .and. eps0(i) > 0._r8) then
+ su(i,k) = mu(i,k+1)/mu(i,k)*su(i,k+1) + &
+ dz(i,k)/mu(i,k)* (eu(i,k)-du(i,k))*s(i,k)
+ qu(i,k) = mu(i,k+1)/mu(i,k)*qu(i,k+1) + dz(i,k)/mu(i,k)* (eu(i,k)*q(i,k)- &
+ du(i,k)*qst(i,k))
+!+tht moist thermo
+ !tu = su(i,k) - grav/cp*zf(i,k)
+ !call qsat_hPa(tu, (p(i,k)+p(i,k-1))/2._r8, estu, qstu)
+ tu(i,k) = su(i,k) - grav/((1._r8+0.85*qu(i,k))*cp)*zf(i,k)
+ call qsat_hPa(tu(i,k), (p(i,k)+p(i,k-1))/2._r8, estu, qstu)
+!-tht
+ if (qu(i,k) >= qstu) then
+ jlcl(i) = k
+ kount = kount + 1
+ done(i) = .true.
+ end if
+ end if
+ end do
+ if (kount >= il2g) goto 690
+ end do
+690 continue
+ do k = msg + 2,pver
+ do i = 1,il2g
+ if ((k > jt(i) .and. k <= jlcl(i)) .and. eps0(i) > 0._r8) then
+!+tht moist thermo
+ !su(i,k) = shat(i,k) + (hu(i,k)-hsthat(i,k))/(cp* (1._r8+gamhat(i,k)))
+ !qu(i,k) = qsthat(i,k) + gamhat(i,k)*(hu(i,k)-hsthat(i,k))/ &
+ ! (rl* (1._r8+gamhat(i,k)))
+ qu(i,k) = qsthat(i,k) + gamhat(i,k)*(hu(i,k)-hsthat(i,k))/ &
+ ((1._r8-dcol*(tu(i,k)-tmelt))*rl* (1._r8+gamhat(i,k)))
+ su(i,k) = shat(i,k) + (hu(i,k)-hsthat(i,k))/((1._r8+cpvir*qu(i,k))*cp* (1._r8+gamhat(i,k)))
+ tu(i,k) = su(i,k) - grav/((1._r8+cpvir*qu(i,k))*cp)*zf(i,k)
+!-tht
+ end if
+ end do
+ end do
+
+! compute condensation in updraft
+ if (zmconv_microp) then
+ tmplel(:il2g) = jlcl(:il2g)+1
+ else
+ tmplel(:il2g) = jb(:il2g)
+ end if
+
+ do k = pver,msg + 2,-1
+ do i = 1,il2g
+ if (k >= jt(i) .and. k < tmplel(i) .and. eps0(i) > 0._r8) then
+ if (zmconv_microp) then
+ cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ &
+ dz(i,k)- eu(i,k)*s(i,k)+du(i,k)*su(i,k))/(rl/cp) &
+!+tht moist thermo
+ *((1._r8+cpvir*qu(i,k))/(1._r8-dcol*(tu(i,k)-tmelt))) &
+!-tht
+ - latice*frz(i,k)/rl
+ else
+
+ cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ &
+!+tht moist thermo
+ !dz(i,k)- (eu(i,k)-du(i,k))*s(i,k))/(rl/cp)
+ dz(i,k)- (eu(i,k)-du(i,k))*s(i,k))/(rl/cp) &
+ *((1._r8+cpvir*qu(i,k))/(1._r8-dcol*(tu(i,k)-tmelt)))
+!-tht
+ end if
+ if (k == jt(i)) cu(i,k) = 0._r8
+ cu(i,k) = max(0._r8,cu(i,k))
+ end if
+ end do
+ end do
+
+
+ if (zmconv_microp) then
+
+ tug(:il2g,:) = t(:il2g,:)
+ fice(:,:) = 0._r8
+
+ do k = pver, msg+2, -1
+ do i = 1, il2g
+!+tht moist thermo
+ !tug(i,k) = su(i,k) - grav/cp*zf(i,k)
+ tug(i,k) = su(i,k) - grav/cp*zf(i,k)/(1._r8+cpvir*qu(i,k))
+!-tht
+ end do
+ end do
+
+ do k = 1, pver-1
+ do i = 1, il2g
+
+ if (tug(i,k+1) > 273.15_r8) then
+ ! If warmer than tmax then water phase
+ fice(i,k) = 0._r8
+
+ else if (tug(i,k+1) < 233.15_r8) then
+ ! If colder than tmin then ice phase
+ fice(i,k) = 1._r8
+
+ else
+ ! Otherwise mixed phase, with ice fraction decreasing linearly
+ ! from tmin to tmax
+ fice(i,k) =(273.15_r8 - tug(i,k+1)) / 40._r8
+ end if
+ end do
+ end do
+
+ do k = 1, pver
+ do i = 1,il2g
+ loc_conv%cmei(i,k) = cu(i,k)* fice(i,k)
+ loc_conv%cmel(i,k) = cu(i,k) * (1._r8-fice(i,k))
+ end do
+ end do
+
+ call zm_mphy(su, qu, mu, du, eu, loc_conv%cmel, loc_conv%cmei, zf, p, t, q, &
+ eps0, jb, jt, jlcl, msg, il2g, grav, cp, rd, aero, gamhat, &
+ loc_conv%qliq, loc_conv%qice, loc_conv%qnl, loc_conv%qni, qcde, loc_conv%qide, &
+ loc_conv%qncde, loc_conv%qnide, rprd, loc_conv%sprd, frz, &
+ loc_conv%wu, loc_conv%qrain, loc_conv%qsnow, loc_conv%qnr, loc_conv%qns, &
+ loc_conv%autolm, loc_conv%accrlm, loc_conv%bergnm, loc_conv%fhtimm, loc_conv%fhtctm, &
+ loc_conv%fhmlm, loc_conv%hmpim, loc_conv%accslm, loc_conv%dlfm, loc_conv%autoln, &
+ loc_conv%accrln, loc_conv%bergnn, loc_conv%fhtimn, loc_conv%fhtctn, &
+ loc_conv%fhmln, loc_conv%accsln, loc_conv%activn, loc_conv%dlfn, loc_conv%autoim, &
+ loc_conv%accsim, loc_conv%difm, loc_conv%nuclin, loc_conv%autoin, &
+ loc_conv%accsin, loc_conv%hmpin, loc_conv%difn, loc_conv%trspcm, loc_conv%trspcn, &
+ loc_conv%trspim, loc_conv%trspin, loc_conv%lambdadpcu, loc_conv%mudpcu )
+
+
+ do k = pver,msg + 2,-1
+ do i = 1,il2g
+ ql(i,k) = loc_conv%qliq(i,k)+ loc_conv%qice(i,k)
+ loc_conv%frz(i,k) = frz(i,k)
+ end do
+ end do
+
+ do i = 1,il2g
+ if (iter == 2 .and. jt(i)> jto(i)) then
+ do k = jt(i), jto(i), -1
+ loc_conv%frz(i,k) = 0.0_r8
+ cu(i,k)=0.0_r8
+ end do
+ end if
+ end do
+
+
+ do k = pver,msg + 2,-1
+ do i = 1,il2g
+ if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then
+ totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*(qcde(i,k+1)+loc_conv%qide(i,k+1) ))
+ end if
+ end do
+ end do
+
+ do k = msg + 2,pver
+ do i = 1,il2g
+ if ((k > jt(i) .and. k <= jlcl(i)) .and. eps0(i) > 0._r8) then
+ if (iter == 1) tvuo(i,k)= (su(i,k) - grav/cp*zf(i,k))*(1._r8+0.608_r8*qu(i,k))
+ if (iter == 2 .and. k > max(jt(i),jto(i)) ) then
+!+tht moist thermo
+ !tvu(i,k) = (su(i,k) - grav/cp*zf(i,k))*(1._r8 +0.608_r8*qu(i,k))
+ tvu(i,k) = (su(i,k) - grav/(cp*(1._r8+cpvir*qu(i,k)))*zf(i,k))*(1._r8 +0.608_r8*qu(i,k))
+!-tht
+ loc_conv%dcape(i) = loc_conv%dcape(i)+ rd*(tvu(i,k)-tvuo(i,k))*log(p(i,k)/p(i,k-1))
+ end if
+ end if
+ end do
+ end do
+
+ else ! no convective microphysics
+
+! compute condensed liquid, rain production rate
+! accumulate total precipitation (condensation - detrainment of liquid)
+! Note ql1 = ql(k) + rprd(k)*dz(k)/mu(k)
+! The differencing is somewhat strange (e.g. du(i,k)*ql(i,k+1)) but is
+! consistently applied.
+! mu, ql are interface quantities
+! cu, du, eu, rprd are midpoint quantites
+
+ do k = pver,msg + 2,-1
+ do i = 1,il2g
+ rprd(i,k) = 0._r8
+ if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8 .and. mu(i,k) >= 0.0_r8) then
+ if (mu(i,k) > 0._r8) then
+ ql1 = 1._r8/mu(i,k)* (mu(i,k+1)*ql(i,k+1)- &
+ dz(i,k)*du(i,k)*ql(i,k+1)+dz(i,k)*cu(i,k))
+ ql(i,k) = ql1/ (1._r8+dz(i,k)*c0mask(i))
+ else
+ ql(i,k) = 0._r8
+ end if
+ totpcp(i) = totpcp(i) + dz(i,k)*(cu(i,k)-du(i,k)*ql(i,k+1))
+ rprd(i,k) = c0mask(i)*mu(i,k)*ql(i,k)
+ qcde(i,k) = ql(i,k)
+
+ if (zmconv_microp) then
+ loc_conv%qide(i,k) = 0._r8
+ loc_conv%qncde(i,k) = 0._r8
+ loc_conv%qnide(i,k) = 0._r8
+ loc_conv%sprd(i,k) = 0._r8
+ end if
+
+ end if
+ end do
+ end do
+!
+ end if ! zmconv_microp
+
+ end do !iter
+!
+! specify downdraft properties (no downdrafts if jd.ge.jb).
+! scale down downward mass flux profile so that net flux
+! (up-down) at cloud base in not negative.
+!
+ do i = 1,il2g
+!
+! in normal downdraft strength run alfa=0.2. In test4 alfa=0.1
+!+tht: detrainment proportionality factor (alpha in paper) hard-wired to 0.1 here
+ !alfa(i) = 0.1_r8
+ alfa(i) = alfadet
+!-tht
+ jt(i) = min(jt(i),jb(i)-1)
+ jd(i) = max(j0(i),jt(i)+1)
+ jd(i) = min(jd(i),jb(i))
+ hd(i,jd(i)) = hmn(i,jd(i)-1)
+ if (jd(i) < jb(i) .and. eps0(i) > 0._r8) then
+ epsm(i) = eps0(i)
+ md(i,jd(i)) = -alfa(i)*epsm(i)/eps0(i)
+ end if
+ end do
+ do k = msg + 1,pver
+ do i = 1,il2g
+ if ((k > jd(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8) then
+ zdef(i) = zf(i,jd(i)) - zf(i,k)
+!tht: why the factor 2 here?
+ md(i,k) = -alfa(i)/ (2._r8*eps0(i))*(exp(2._r8*epsm(i)*zdef(i))-1._r8)/zdef(i)
+ end if
+ end do
+ end do
+
+ do k = msg + 1,pver
+ do i = 1,il2g
+ if ((k >= jt(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8 .and. jd(i) < jb(i)) then
+ ratmjb(i) = min(abs(mu(i,jb(i))/md(i,jb(i))),1._r8)
+ md(i,k) = md(i,k)*ratmjb(i)
+ end if
+ end do
+ end do
+
+ small = 1.e-20_r8
+ do k = msg + 1,pver
+ do i = 1,il2g
+ if ((k >= jt(i) .and. k <= pver) .and. eps0(i) > 0._r8) then
+ ed(i,k-1) = (md(i,k-1)-md(i,k))/dz(i,k-1)
+ mdt = min(md(i,k),-small)
+ hd(i,k) = (md(i,k-1)*hd(i,k-1) - dz(i,k-1)*ed(i,k-1)*hmn(i,k-1))/mdt
+ end if
+ end do
+ end do
+!
+! calculate updraft and downdraft properties.
+!
+ do k = msg + 2,pver
+ do i = 1,il2g
+ if ((k >= jd(i) .and. k <= jb(i)) .and. eps0(i) > 0._r8 .and. jd(i) < jb(i)) then
+ qds(i,k) = qsthat(i,k) + gamhat(i,k)*(hd(i,k)-hsthat(i,k))/ &
+ (rl*(1._r8 + gamhat(i,k)))
+!+tht moist thermo
+ td(i,k) = (hd(i,k)-grav*zf(i,k)-(1._r8+dcol*tmelt)*rl*qds(i,k)) &
+ /(cp*( 1._r8 + (cpvir-dcol*(rl/cp))*qds(i,k) ))
+ qds(i,k) = qsthat(i,k) + gamhat(i,k)*(hd(i,k)-hsthat(i,k))/ &
+ ((1._r8-dcol*(td(i,k)-tmelt))*rl*(1._r8 + gamhat(i,k)))
+!-tht
+ end if
+ end do
+ end do
+
+ do i = 1,il2g
+ qd(i,jd(i)) = qds(i,jd(i))
+!+tht moist thermo
+ !sd(i,jd(i)) = (hd(i,jd(i)) - rl*qd(i,jd(i)))/cp
+ k=jd(i) ! BUG FIX 2019 05 24
+ sd(i,jd(i)) = (hd(i,jd(i)) - (1._r8-dcol*(td(i,k)-tmelt))*rl*qd(i,jd(i)))/((1._r8+cpvir*qd(i,k))*cp)
+ td(i,k) = sd(i,k) - grav/((1._r8+cpvir*qd(i,k))*cp)*zf(i,k)
+!-tht
+ end do
+!
+ do k = msg + 2,pver
+ do i = 1,il2g
+ if (k >= jd(i) .and. k < jb(i) .and. eps0(i) > 0._r8) then
+ qd(i,k+1) = qds(i,k+1)
+ evp(i,k) = -ed(i,k)*q(i,k) + (md(i,k)*qd(i,k)-md(i,k+1)*qd(i,k+1))/dz(i,k)
+ evp(i,k) = max(evp(i,k),0._r8)
+ mdt = min(md(i,k+1),-small)
+ if (zmconv_microp) then
+ evp(i,k) = min(evp(i,k),rprd(i,k))
+ end if
+!+tht moist thermo
+ !sd(i,k+1) = ((rl/cp*evp(i,k)-ed(i,k)*s(i,k))*dz(i,k) + md(i,k)*sd(i,k))/mdt
+ sd(i,k+1) = (((1._r8-dcol*(td(i,k)-tmelt))*rl/((1._r8+cpvir*qd(i,k))*cp)*evp(i,k) &
+ -ed(i,k)*s(i,k))*dz(i,k) + md(i,k)*sd(i,k))/mdt
+!-tht
+ totevp(i) = totevp(i) - dz(i,k)*ed(i,k)*q(i,k)
+ end if
+ end do
+ end do
+ do i = 1,il2g
+!*guang totevp(i) = totevp(i) + md(i,jd(i))*q(i,jd(i)-1) -
+ totevp(i) = totevp(i) + md(i,jd(i))*qd(i,jd(i)) - md(i,jb(i))*qd(i,jb(i))
+ end do
+!!$ if (.true.) then
+ if (.false.) then
+ do i = 1,il2g
+ k = jb(i)
+ if (eps0(i) > 0._r8) then
+ evp(i,k) = -ed(i,k)*q(i,k) + (md(i,k)*qd(i,k))/dz(i,k)
+ evp(i,k) = max(evp(i,k),0._r8)
+ totevp(i) = totevp(i) - dz(i,k)*ed(i,k)*q(i,k)
+ end if
+ end do
+ endif
+
+ do i = 1,il2g
+ totpcp(i) = max(totpcp(i),0._r8)
+ totevp(i) = max(totevp(i),0._r8)
+ end do
+!
+ do k = msg + 2,pver
+ do i = 1,il2g
+ if (totevp(i) > 0._r8 .and. totpcp(i) > 0._r8) then
+ md(i,k) = md (i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i)))
+ ed(i,k) = ed (i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i)))
+ evp(i,k) = evp(i,k)*min(1._r8, totpcp(i)/(totevp(i)+totpcp(i)))
+ else
+ md(i,k) = 0._r8
+ ed(i,k) = 0._r8
+ evp(i,k) = 0._r8
+ end if
+! cmeg is the cloud water condensed - rain water evaporated
+! rprd is the cloud water converted to rain - (rain evaporated)
+ cmeg(i,k) = cu(i,k) - evp(i,k)
+ rprd(i,k) = rprd(i,k)-evp(i,k)
+ end do
+ end do
+
+! compute the net precipitation flux across interfaces
+ pflx(:il2g,1) = 0._r8
+ do k = 2,pverp
+ do i = 1,il2g
+ pflx(i,k) = pflx(i,k-1) + rprd(i,k-1)*dz(i,k-1)
+ end do
+ end do
+!
+ do k = msg + 1,pver
+ do i = 1,il2g
+ mc(i,k) = mu(i,k) + md(i,k)
+ end do
+ end do
+!
+ return
+end subroutine cldprp
+
+subroutine closure(lchnk , &
+ q ,t ,p ,z ,s , &
+ tp ,qs ,qu ,su ,mc , &
+ du ,mu ,md ,qd ,sd , &
+ qhat ,shat ,dp ,qstp ,zf , &
+ ql ,dsubcld ,mb ,cape ,tl , &
+ lcl ,lel ,jt ,mx ,il1g , &
+ il2g ,rd ,grav ,cp ,rl , &
+ msg ,capelmt )
+!-----------------------------------------------------------------------
+!
+! Purpose:
+!
+!
+! Method:
+!
+!
+!
+! Author: G. Zhang and collaborators. CCM contact:P. Rasch
+! This is contributed code not fully standardized by the CCM core group.
+!
+! this code is very much rougher than virtually anything else in the CCM
+! We expect to release cleaner code in a future release
+!
+! the documentation has been enhanced to the degree that we are able
+!
+!-----------------------------------------------------------------------
+
+!
+!-----------------------------Arguments---------------------------------
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+
+ real(r8), intent(inout) :: q(pcols,pver) ! spec humidity
+ real(r8), intent(inout) :: t(pcols,pver) ! temperature
+ real(r8), intent(inout) :: p(pcols,pver) ! pressure (mb)
+ real(r8), intent(inout) :: mb(pcols) ! cloud base mass flux
+ real(r8), intent(in) :: z(pcols,pver) ! height (m)
+ real(r8), intent(in) :: s(pcols,pver) ! normalized dry static energy
+ real(r8), intent(in) :: tp(pcols,pver) ! parcel temp
+ real(r8), intent(in) :: qs(pcols,pver) ! sat spec humidity
+ real(r8), intent(in) :: qu(pcols,pver) ! updraft spec. humidity
+ real(r8), intent(in) :: su(pcols,pver) ! normalized dry stat energy of updraft
+ real(r8), intent(in) :: mc(pcols,pver) ! net convective mass flux
+ real(r8), intent(in) :: du(pcols,pver) ! detrainment from updraft
+ real(r8), intent(in) :: mu(pcols,pver) ! mass flux of updraft
+ real(r8), intent(in) :: md(pcols,pver) ! mass flux of downdraft
+ real(r8), intent(in) :: qd(pcols,pver) ! spec. humidity of downdraft
+ real(r8), intent(in) :: sd(pcols,pver) ! dry static energy of downdraft
+ real(r8), intent(in) :: qhat(pcols,pver) ! environment spec humidity at interfaces
+ real(r8), intent(in) :: shat(pcols,pver) ! env. normalized dry static energy at intrfcs
+ real(r8), intent(in) :: dp(pcols,pver) ! pressure thickness of layers
+ real(r8), intent(in) :: qstp(pcols,pver) ! spec humidity of parcel
+ real(r8), intent(in) :: zf(pcols,pver+1) ! height of interface levels
+ real(r8), intent(in) :: ql(pcols,pver) ! liquid water mixing ratio
+
+ real(r8), intent(in) :: cape(pcols) ! available pot. energy of column
+ real(r8), intent(in) :: tl(pcols)
+ real(r8), intent(in) :: dsubcld(pcols) ! thickness of subcloud layer
+
+ integer, intent(in) :: lcl(pcols) ! index of lcl
+ integer, intent(in) :: lel(pcols) ! index of launch leve
+ integer, intent(in) :: jt(pcols) ! top of updraft
+ integer, intent(in) :: mx(pcols) ! base of updraft
+!
+!--------------------------Local variables------------------------------
+!
+ real(r8) dtpdt(pcols,pver)
+ real(r8) dqsdtp(pcols,pver)
+ real(r8) dtmdt(pcols,pver)
+ real(r8) dqmdt(pcols,pver)
+ real(r8) dboydt(pcols,pver)
+ real(r8) thetavp(pcols,pver)
+ real(r8) thetavm(pcols,pver)
+
+ real(r8) dtbdt(pcols),dqbdt(pcols),dtldt(pcols)
+ real(r8) beta
+ real(r8) capelmt
+ real(r8) cp
+ real(r8) dadt(pcols)
+ real(r8) debdt
+ real(r8) dltaa
+ real(r8) eb
+ real(r8) grav
+
+ integer i
+ integer il1g
+ integer il2g
+ integer k, kmin, kmax
+ integer msg
+
+ real(r8) rd
+ real(r8) rl
+!+tht moist thermo
+ real(r8) rltp
+!-tht moist thermo
+
+! change of subcloud layer properties due to convection is
+! related to cumulus updrafts and downdrafts.
+! mc(z)=f(z)*mb, mub=betau*mb, mdb=betad*mb are used
+! to define betau, betad and f(z).
+! note that this implies all time derivatives are in effect
+! time derivatives per unit cloud-base mass flux, i.e. they
+! have units of 1/mb instead of 1/sec.
+!
+ do i = il1g,il2g
+ mb(i) = 0._r8
+ eb = p(i,mx(i))*q(i,mx(i))/ (eps1+q(i,mx(i)))
+ dtbdt(i) = (1._r8/dsubcld(i))* (mu(i,mx(i))*(shat(i,mx(i))-su(i,mx(i)))+ &
+ md(i,mx(i))* (shat(i,mx(i))-sd(i,mx(i))))
+ dqbdt(i) = (1._r8/dsubcld(i))* (mu(i,mx(i))*(qhat(i,mx(i))-qu(i,mx(i)))+ &
+ md(i,mx(i))* (qhat(i,mx(i))-qd(i,mx(i))))
+ debdt = eps1*p(i,mx(i))/ (eps1+q(i,mx(i)))**2*dqbdt(i)
+ dtldt(i) = -2840._r8* (3.5_r8/t(i,mx(i))*dtbdt(i)-debdt/eb)/ &
+ (3.5_r8*log(t(i,mx(i)))-log(eb)-4.805_r8)**2
+ end do
+!
+! dtmdt and dqmdt are cumulus heating and drying.
+!
+ do k = msg + 1,pver
+ do i = il1g,il2g
+ dtmdt(i,k) = 0._r8
+ dqmdt(i,k) = 0._r8
+ end do
+ end do
+!
+ do k = msg + 1,pver - 1
+ do i = il1g,il2g
+ if (k == jt(i)) then
+!+tht moist thermo -- changes in this most parts of routine do not seem essential
+ !dtmdt(i,k) = (1._r8/dp(i,k))*(mu(i,k+1)* (su(i,k+1)-shat(i,k+1)- &
+ ! rl/cp*ql(i,k+1))+md(i,k+1)* (sd(i,k+1)-shat(i,k+1)))
+ !dqmdt(i,k) = (1._r8/dp(i,k))*(mu(i,k+1)* (qu(i,k+1)- &
+ ! qhat(i,k+1)+ql(i,k+1))+md(i,k+1)*(qd(i,k+1)-qhat(i,k+1)))
+ dqmdt(i,k) = (1._r8/dp(i,k))*(mu(i,k+1)*(qu(i,k+1)-qhat(i,k+1) +ql(i,k+1)) &
+ +md(i,k+1)*(qd(i,k+1)-qhat(i,k+1) ))
+ dtmdt(i,k) = (1._r8/dp(i,k))*(mu(i,k+1)*(su(i,k+1)-shat(i,k+1)-rl/cp*ql(i,k+1)) &
+ +md(i,k+1)*(sd(i,k+1)-shat(i,k+1) ))
+!-tht
+ end if
+ end do
+ end do
+!
+ beta = 0._r8
+ do k = msg + 1,pver - 1
+ do i = il1g,il2g
+ if (k > jt(i) .and. k < mx(i)) then
+ dtmdt(i,k) = (mc(i,k)*(shat(i,k)-s(i,k)) - mc(i,k+1)*(shat(i,k+1)-s(i,k)))/dp(i,k) &
+ - rl/cp*du(i,k)*(beta*ql(i,k)+ (1-beta)*ql(i,k+1))
+! dqmdt(i,k)=(mc(i,k)*(qhat(i,k)-q(i,k))
+! 1 +mc(i,k+1)*(q(i,k)-qhat(i,k+1)))/dp(i,k)
+! 2 +du(i,k)*(qs(i,k)-q(i,k))
+! 3 +du(i,k)*(beta*ql(i,k)+(1-beta)*ql(i,k+1))
+
+ dqmdt(i,k) = (mu(i,k+1)*(qu(i,k+1)-qhat(i,k+1)+cp/rl*(su(i,k+1)-s(i,k))) &
+ -mu(i,k )*(qu(i,k )-qhat(i,k )+cp/rl*(su(i,k )-s(i,k))) &
+ +md(i,k+1)*(qd(i,k+1)-qhat(i,k+1)+cp/rl*(sd(i,k+1)-s(i,k))) &
+ -md(i,k )*(qd(i,k )-qhat(i,k )+cp/rl*(sd(i,k )-s(i,k))))/dp(i,k) + &
+ du(i,k)* (beta*ql(i,k)+(1-beta)*ql(i,k+1))
+ end if
+ end do
+ end do
+!
+ do k = msg + 1,pver
+ do i = il1g,il2g
+ if (k >= lel(i) .and. k <= lcl(i)) then
+ thetavp(i,k) = tp(i,k)* (1000._r8/p(i,k))**(rd/cp) *(1._r8+1.608_r8*qstp(i,k)-q(i,mx(i)))
+ thetavm(i,k) = t (i,k)* (1000._r8/p(i,k))**(rd/cp) *(1._r8+0.608_r8*q(i,k) )
+!!+tht moist thermo ...but probably important for parcel heating
+ dqsdtp(i,k) = qstp(i,k)* (1._r8+qstp(i,k)/eps1)*eps1*rl/(rd*tp(i,k)**2)
+ !rltp=rl*(1.-dcol*(tp(i,k)-tmelt))
+ !dqsdtp(i,k) = qstp(i,k)* (1._r8+qstp(i,k)/eps1)*eps1*rltp/(rd*tp(i,k)**2)
+!
+! dtpdt is the parcel temperature change due to change of
+! subcloud layer properties during convection.
+!
+ dtpdt(i,k) = tp(i,k)/ (1._r8 + rl/cp*(dqsdtp(i,k)-qstp(i,k)/tp(i,k))) &
+ *(dtbdt(i)/t(i,mx(i)) + rl/cp*(dqbdt(i)/tl(i)-q(i,mx(i))/tl(i)**2*dtldt(i)))
+ !rltp=rltp/(cp*(1.+cpvir*qstp(i,k)))
+ !dtpdt(i,k) = tp(i,k)/ (1._r8 + rltp*(dqsdtp(i,k)-qstp(i,k)/tp(i,k))) &
+ ! *(dtbdt(i)/t(i,mx(i)) + rltp*(dqbdt(i)/tl(i)-q(i,mx(i))/tl(i)**2*dtldt(i)))
+!!-tht
+!
+! dboydt is the integrand of cape change.
+!
+ dboydt(i,k) = ((dtpdt(i,k)/tp(i,k) &
+ +1._r8 /(1._r8+1.608_r8*qstp(i,k)-q(i,mx(i))) &
+ *(1.608_r8*dqsdtp(i,k)*dtpdt(i,k)-dqbdt(i))) &
+ -(dtmdt(i,k)/t (i,k) &
+ +0.608_r8/(1._r8+0.608_r8*q(i,k) ) &
+ *dqmdt(i,k)) &
+ )*grav*thetavp(i,k)/thetavm(i,k)
+ end if
+ end do
+ end do
+!
+ do k = msg + 1,pver
+ do i = il1g,il2g
+ if (k > lcl(i) .and. k < mx(i)) then
+ thetavp(i,k) = tp(i,k)* (1000._r8/p(i,k))**(rd/cp) *(1._r8+0.608_r8*q(i,mx(i)))
+ thetavm(i,k) = t (i,k)* (1000._r8/p(i,k))**(rd/cp) *(1._r8+0.608_r8*q(i,k ))
+!
+! dboydt is the integrand of cape change.
+!
+ dboydt(i,k) = (dtbdt(i )/t(i,mx(i)) &
+ +0.608_r8/(1._r8+0.608_r8*q(i,mx(i)))*dqbdt(i ) &
+ -dtmdt(i,k)/t(i,k ) &
+ -0.608_r8/(1._r8+0.608_r8*q(i,k ))*dqmdt(i,k) &
+ )*grav*thetavp(i,k)/thetavm(i,k)
+ end if
+ end do
+ end do
+
+!
+! buoyant energy change is set to 2/3*excess cape per 3 hours
+!
+ dadt(il1g:il2g) = 0._r8
+ kmin = minval(lel(il1g:il2g))
+ kmax = maxval(mx(il1g:il2g)) - 1
+ do k = kmin, kmax
+ do i = il1g,il2g
+ if ( k >= lel(i) .and. k <= mx(i) - 1) then
+ dadt(i) = dadt(i) + dboydt(i,k)* (zf(i,k)-zf(i,k+1))
+ endif
+ end do
+ end do
+ do i = il1g,il2g
+ dltaa = -1._r8* (cape(i)-capelmt)
+ if (dadt(i) /= 0._r8) mb(i) = max(dltaa/tau/dadt(i),0._r8)
+ end do
+!
+ return
+end subroutine closure
+
+subroutine q1q2_pjr(lchnk , &
+ dqdt ,dsdt ,q ,qs ,qu , &
+ su ,du ,qhat ,shat ,dp , &
+ mu ,md ,sd ,qd ,ql , &
+ dsubcld ,jt ,mx ,il1g ,il2g , &
+ cp ,rl ,msg , &
+ dl ,evp ,cu , &
+ loc_conv)
+
+
+ implicit none
+
+!-----------------------------------------------------------------------
+!
+! Purpose:
+!
+!
+! Method:
+!
+!
+!
+! Author: phil rasch dec 19 1995
+!
+!-----------------------------------------------------------------------
+
+
+ real(r8), intent(in) :: cp
+
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: il1g
+ integer, intent(in) :: il2g
+ integer, intent(in) :: msg
+
+ real(r8), intent(in) :: q(pcols,pver)
+ real(r8), intent(in) :: qs(pcols,pver)
+ real(r8), intent(in) :: qu(pcols,pver)
+ real(r8), intent(in) :: su(pcols,pver)
+ real(r8), intent(in) :: du(pcols,pver)
+ real(r8), intent(in) :: qhat(pcols,pver)
+ real(r8), intent(in) :: shat(pcols,pver)
+ real(r8), intent(in) :: dp(pcols,pver)
+ real(r8), intent(in) :: mu(pcols,pver)
+ real(r8), intent(in) :: md(pcols,pver)
+ real(r8), intent(in) :: sd(pcols,pver)
+ real(r8), intent(in) :: qd(pcols,pver)
+ real(r8), intent(in) :: ql(pcols,pver)
+ real(r8), intent(in) :: evp(pcols,pver)
+ real(r8), intent(in) :: cu(pcols,pver)
+ real(r8), intent(in) :: dsubcld(pcols)
+
+ real(r8),intent(out) :: dqdt(pcols,pver),dsdt(pcols,pver)
+ real(r8),intent(out) :: dl(pcols,pver)
+
+ type(zm_conv_t) :: loc_conv
+
+ integer kbm
+ integer ktm
+ integer jt(pcols)
+ integer mx(pcols)
+!
+! work fields:
+!
+ integer i
+ integer k
+
+ real(r8) emc
+ real(r8) rl
+!-------------------------------------------------------------------
+ do k = msg + 1,pver
+ do i = il1g,il2g
+ dsdt(i,k) = 0._r8
+ dqdt(i,k) = 0._r8
+ dl(i,k) = 0._r8
+ end do
+ end do
+
+ if (zmconv_microp) then
+ do k = msg + 1,pver
+ do i = il1g,il2g
+ loc_conv%di(i,k) = 0._r8
+ loc_conv%dnl(i,k) = 0._r8
+ loc_conv%dni(i,k) = 0._r8
+ end do
+ end do
+ end if
+!
+! find the highest level top and bottom levels of convection
+!
+ ktm = pver
+ kbm = pver
+ do i = il1g, il2g
+ ktm = min(ktm,jt(i))
+ kbm = min(kbm,mx(i))
+ end do
+
+ !do k =ktm,pver-1
+ ! do i=il1g,il2g
+ ! tu(i,k)=su(i,k)-grav*zf(i,k)/(cp*(1._r8+cpvir*qu(i,k)))
+ ! td(i,k)=sd(i,k)-grav*zf(i,k)/(cp*(1._r8+cpvir*qd(i,k)))
+ ! enddo
+ !enddo
+
+ do k = ktm,pver-1
+ do i = il1g,il2g
+ emc = -cu (i,k) & ! condensation in updraft
+ +evp(i,k) ! evaporating rain in downdraft
+
+ !rlcu0=(1.-dcol*(tu(i,k )-tmelt))/(1._r8+cpvir*qu(i,k ))
+ !rlcu1=(1.-dcol*(tu(i,k+1)-tmelt))/(1._r8+cpvir*qu(i,k+1))
+ !rlcd0=(1.-dcol*(td(i,k )-tmelt))/(1._r8+cpvir*qd(i,k ))
+ !rlcd1=(1.-dcol*(td(i,k+1)-tmelt))/(1._r8+cpvir*qd(i,k+1))
+
+ dsdt(i,k) = -rl/cp*emc &
+ + ( mu(i,k+1)* (su(i,k+1)-shat(i,k+1)) &
+ -mu(i,k )* (su(i,k )-shat(i,k )) &
+ +md(i,k+1)* (sd(i,k+1)-shat(i,k+1)) &
+ -md(i,k )* (sd(i,k )-shat(i,k )) &
+ )/dp(i,k)
+
+ if (zmconv_microp) dsdt(i,k) = dsdt(i,k) + latice/cp*loc_conv%frz(i,k)
+
+ dqdt(i,k) = emc + &
+ ( mu(i,k+1)* (qu(i,k+1)-qhat(i,k+1)) &
+ -mu(i,k )* (qu(i,k )-qhat(i,k )) &
+ +md(i,k+1)* (qd(i,k+1)-qhat(i,k+1)) &
+ -md(i,k )* (qd(i,k )-qhat(i,k )) &
+ )/dp(i,k)
+
+ dl(i,k) = du(i,k)*ql(i,k+1)
+
+ if (zmconv_microp) then
+ loc_conv%di(i,k) = du(i,k)*loc_conv%qide(i,k+1)
+ loc_conv%dnl(i,k) = du(i,k)*loc_conv%qncde(i,k+1)
+ loc_conv%dni(i,k) = du(i,k)*loc_conv%qnide(i,k+1)
+ end if
+
+ end do
+ end do
+
+!
+ do k = kbm,pver
+ do i = il1g,il2g
+ if (k == mx(i)) then
+ dsdt(i,k) = (1._r8/dsubcld(i))* &
+ (-mu(i,k)* (su(i,k)-shat(i,k)) &
+ -md(i,k)* (sd(i,k)-shat(i,k)) &
+ )
+ dqdt(i,k) = (1._r8/dsubcld(i))* &
+ (-mu(i,k)*(qu(i,k)-qhat(i,k)) &
+ -md(i,k)*(qd(i,k)-qhat(i,k)) &
+ )
+ else if (k > mx(i)) then
+ dsdt(i,k) = dsdt(i,k-1)
+ dqdt(i,k) = dqdt(i,k-1)
+ end if
+ end do
+ end do
+!
+ return
+end subroutine q1q2_pjr
+
+!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+subroutine buoyan_dilute(lchnk ,ncol , &
+ q ,t ,p ,z ,pf , &
+! tp ,qstp ,tl ,rl ,cape , &
+ tp ,qstp ,tl ,rl ,cape , cin , & !+tht cin
+ pblt ,lcl ,lel ,lon ,mx , &
+ rd ,grav ,cp ,msg , &
+! tpert , org , landfrac)
+ tpert , org , landfrac , dmpdz) !+tht dmpdz
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Calculates CAPE the lifting condensation level and the convective top
+! where buoyancy is first -ve.
+!
+! Method: Calculates the parcel temperature based on a simple constant
+! entraining plume model. CAPE is integrated from buoyancy.
+! 09/09/04 - Simplest approach using an assumed entrainment rate for
+! testing (dmpdp).
+! 08/04/05 - Swap to convert dmpdz to dmpdp
+!
+! SCAM Logical Switches - DILUTE:RBN - Now Disabled
+! ---------------------
+! switch(1) = .T. - Uses the dilute parcel calculation to obtain tendencies.
+! switch(2) = .T. - Includes entropy/q changes due to condensate loss and freezing.
+! switch(3) = .T. - Adds the PBL Tpert for the parcel temperature at all levels.
+!
+! References:
+! Raymond and Blythe (1992) JAS
+!
+! Author:
+! Richard Neale - September 2004
+!
+!-----------------------------------------------------------------------
+ implicit none
+!-----------------------------------------------------------------------
+!
+! input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+
+ real(r8), intent(in) :: q(pcols,pver) ! spec. humidity
+ real(r8), intent(in) :: t(pcols,pver) ! temperature
+ real(r8), intent(in) :: p(pcols,pver) ! pressure
+ real(r8), intent(in) :: z(pcols,pver) ! height
+ real(r8), intent(in) :: pf(pcols,pver+1) ! pressure at interfaces
+ real(r8), intent(in) :: pblt(pcols) ! index of pbl depth
+ real(r8), intent(in) :: tpert(pcols) ! perturbation temperature by pbl processes
+
+!+tht
+ !real(r8), intent(in), dimension(pcols) :: dmpdz ! Parcel fractional mass entrainment rate (/m) 2D
+ real(r8), intent(in), dimension(pcols,pver) :: dmpdz ! Parcel fractional mass entrainment rate (/m) 3D
+ !real(r8), dimension(pcols,pver) :: dmpdz ! Parcel fractional mass entrainment rate (/m) 3D
+!-tht
+
+!
+! output arguments
+!
+ real(r8), intent(out) :: tp(pcols,pver) ! parcel temperature
+ real(r8), intent(out) :: qstp(pcols,pver) ! saturation mixing ratio of parcel (only above lcl, just q below).
+ real(r8), intent(out) :: tl(pcols) ! parcel temperature at lcl
+ real(r8), intent(out) :: cape(pcols) ! convective aval. pot. energy.
+
+ real(r8), intent(out) :: cin (pcols) !+tht: CIN
+
+ integer lcl(pcols) !
+ integer lel(pcols) !
+ integer lon(pcols) ! level of onset of deep convection
+ integer mx(pcols) ! level of max moist static energy
+
+ real(r8), pointer :: org(:,:) ! organization parameter
+ real(r8), intent(in) :: landfrac(pcols)
+!
+!--------------------------Local Variables------------------------------
+!
+ real(r8) capeten(pcols,5) ! provisional value of cape
+ real(r8) cinten (pcols,5) !+tht provisional value of CIN
+ real(r8) tv(pcols,pver) !
+ real(r8) tpv(pcols,pver) !
+ real(r8) buoy(pcols,pver)
+
+ real(r8) a1(pcols)
+ real(r8) a2(pcols)
+ real(r8) estp(pcols)
+ real(r8) pl(pcols)
+ real(r8) plexp(pcols)
+ real(r8) hmax(pcols)
+ real(r8) hmn(pcols)
+ real(r8) y(pcols)
+
+ logical plge600(pcols)
+ integer knt(pcols)
+ integer lelten(pcols,5)
+
+ real(r8) cp
+ real(r8) e
+ real(r8) grav
+
+ integer i
+ integer k
+ integer msg
+ integer n
+
+ real(r8) rd
+ real(r8) rl
+#ifdef PERGRO
+ real(r8) rhd
+#endif
+!
+!-----------------------------------------------------------------------
+!
+ do n = 1,5
+ do i = 1,ncol
+ lelten(i,n) = pver
+ capeten(i,n) = 0._r8
+ cinten (i,n) = 0._r8
+ end do
+ end do
+!
+ do i = 1,ncol
+!+tht: variable LON initialised here (to PVER).
+! This hard-wires lowest level where conv. initiation is permitted
+ !lon(i) = pver
+! try something different, e.g. limit PBL ovverride:
+ lon(i) = min(pver,nint(pblt(i))+2)
+!-tht
+ knt(i) = 0
+ lel(i) = pver
+ mx(i) = lon(i)
+ cape(i) = 0._r8
+ hmax(i) = 0._r8
+ end do
+
+ tp(:ncol,:) = t(:ncol,:)
+ qstp(:ncol,:) = q(:ncol,:)
+
+!!! RBN - Initialize tv and buoy for output.
+!!! tv=tv : tpv=tpv : qstp=q : buoy=0.
+ if (tht_tweaks) then
+!+tht use system constants
+ tv (:ncol,:) = t(:ncol,:) *(1._r8+q(:ncol,:)/eps1)/ (1._r8+q(:ncol,:)) !+tht
+ else
+ tv (:ncol,:) = t(:ncol,:) *(1._r8+1.608_r8*q(:ncol,:))/ (1._r8+q(:ncol,:))
+ endif
+!-tht
+ tpv (:ncol,:) = tv(:ncol,:)
+ buoy(:ncol,:) = 0._r8
+
+!
+! set "launching" level(mx) to be at maximum moist static energy.
+! search for this level stops at planetary boundary layer top.
+!
+#ifdef PERGRO
+ do k = pver,msg + 1,-1
+ do i = 1,ncol
+!+tht: use correct total mse -- moist thermo
+ !hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k)
+ hmn(i) =(cp+q(i,k)*cpliq)*t(i,k)/(1._r8+q(i,k)) + (1._r8+q(i,k)/eps1)/(1._r8+q(i,k))*grav*z(i,k) &
+ +(rl-(cpliq-cpwv)*(t(i,k)-tfreez))*q(i,k)
+!-tht
+
+!
+! Reset max moist static energy level when relative difference exceeds 1.e-4
+!
+ rhd = (hmn(i) - hmax(i))/(hmn(i) + hmax(i))
+ if (k >= nint(pblt(i)) .and. k <= lon(i) .and. rhd > -1.e-4_r8) then
+ hmax(i) = hmn(i)
+ mx(i) = k
+ end if
+ end do
+ end do
+#else
+ do k = pver,msg + 1,-1
+ do i = 1,ncol
+!+tht: use total mse -- moist thermo
+ !hmn(i) = cp*t(i,k) + grav*z(i,k) + rl*q(i,k)
+ hmn(i) =(cp+q(i,k)*cpliq)*t(i,k)/(1._r8+q(i,k)) + (1._r8+q(i,k)/eps1)/(1._r8+q(i,k))*grav*z(i,k) &
+ +(rl-(cpliq-cpwv)*(t(i,k)-tfreez))*q(i,k)
+!-tht
+ if (k >= nint(pblt(i)) .and. k <= lon(i) .and. hmn(i) > hmax(i)) then
+ hmax(i) = hmn(i)
+ mx(i) = k
+ end if
+ end do
+ end do
+#endif
+
+! LCL dilute calculation - initialize to mx(i)
+! Determine lcl in parcel_dilute and get pl,tl after parcel_dilute
+! Original code actually sets LCL as level above wher condensate forms.
+! Therefore in parcel_dilute lcl(i) will be at first level where qsmix < qtmix.
+
+ do i = 1,ncol ! Initialise LCL variables.
+ lcl(i) = mx(i)
+ tl(i) = t(i,mx(i))
+ pl(i) = p(i,mx(i))
+ end do
+
+!
+! main buoyancy calculation.
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!! DILUTE PLUME CALCULATION USING ENTRAINING PLUME !!!
+!!! RBN 9/9/04 !!!
+
+!+tht: add geop.height in argument to allow enthalpy mixing
+! call parcel_dilute(lchnk, ncol, msg, mx, p, t, q, &
+ call parcel_dilute(lchnk, ncol, msg, mx, p, z, t, q, &
+ tpert, tp, tpv, qstp, pl, tl, lcl, &
+! org, landfrac)
+ org, landfrac, dmpdz)
+!-tht
+
+
+! If lcl is above the nominal level of non-divergence (600 mbs),
+! no deep convection is permitted (ensuing calculations
+! skipped and cape retains initialized value of zero).
+!
+ do i = 1,ncol
+ plge600(i) = pl(i).ge.plclmin ! Just change to always allow buoy calculation.
+ end do
+
+!
+! Main buoyancy calculation.
+!
+ do k = pver,msg + 1,-1
+ do i=1,ncol
+ if (k <= mx(i) .and. plge600(i)) then ! Define buoy from launch level to cloud top.
+ if (tht_tweaks) then
+ tv(i,k) = t(i,k)* (1._r8+q(i,k)/eps1)/ (1._r8+q(i,k)) !+tht
+ else
+ tv(i,k) = t(i,k)* (1._r8+1.608_r8*q(i,k))/ (1._r8+q(i,k)) !orig
+ endif
+! +0.5K or not? (arbitrary at this point - introduce in parcel_dilute instead? tht)
+ buoy(i,k) = tpv(i,k) - tv(i,k) + tiedke_add ! +0.5K or not?
+ else
+ qstp(i,k) = q(i,k)
+ tp(i,k) = t(i,k)
+ tpv(i,k) = tv(i,k)
+ endif
+ end do
+ end do
+
+
+
+!-------------------------------------------------------------------------------
+! beginning from one below top (first level p>40hPa, msg) check for at most
+! num_cin levels of neutral buoyancy (LELten) and compute CAPEten between LCL
+! and those (tht)
+ do k = msg + 2,pver
+ do i = 1,ncol
+ if (k < lcl(i) .and. plge600(i)) then
+ if (buoy(i,k+1) > 0._r8 .and. buoy(i,k) <= 0._r8) then
+ knt(i) = min(num_cin,knt(i) + 1)
+ lelten(i,knt(i)) = k
+ end if
+ end if
+ end do
+ end do
+
+! calculate convective available potential energy (cape).
+ do n = 1,num_cin
+ do k = msg + 1,pver
+ do i = 1,ncol
+ if (plge600(i) .and. k <= mx(i) .and. k > lelten(i,n)) then
+ capeten(i,n) = capeten(i,n) + rd*buoy(i,k)*log(pf(i,k+1)/pf(i,k))
+!+tht also compute total CIN
+ cinten (i,n) = cinten (i,n) - rd*min(buoy(i,k),0._r8)*log(pf(i,k+1)/pf(i,k))
+!-tht
+ end if
+ end do
+ end do
+ end do
+!
+! find maximum cape from all possible tentative capes from
+! one sounding,
+! and use it as the final cape, april 26, 1995
+!
+ do n = 1,num_cin
+ do i = 1,ncol
+ if (capeten(i,n) > cape(i)) then
+ cape(i) = capeten(i,n)
+ cin (i) = cinten (i,n) !+tht CIN
+ lel(i) = lelten(i,n)
+ end if
+ end do
+ end do
+!
+! put lower bound on cape for diagnostic purposes.
+!
+ do i = 1,ncol
+ cape(i) = max(cape(i), 0._r8)
+ end do
+!
+ return
+end subroutine buoyan_dilute
+
+
+!+tht
+!subroutine parcel_dilute (lchnk, ncol, msg, klaunch, p, t, q, &
+ subroutine parcel_dilute (lchnk, ncol, msg, klaunch, p, z, t, q, &
+ tpert, tp, tpv, qstp, pl, tl, lcl, &
+! org, landfrac)
+ org, landfrac, dmpdz)
+!-tht
+
+! Routine to determine
+! 1. Tp - Parcel temperature
+! 2. qstp - Saturated mixing ratio at the parcel temperature.
+
+!--------------------
+implicit none
+!--------------------
+
+integer, intent(in) :: lchnk
+integer, intent(in) :: ncol
+integer, intent(in) :: msg
+
+integer, intent(in), dimension(pcols) :: klaunch(pcols)
+
+real(r8), intent(in), dimension(pcols,pver) :: p
+!+tht
+real(r8), intent(in), dimension(pcols,pver) :: z
+!-tht
+real(r8), intent(in), dimension(pcols,pver) :: t
+real(r8), intent(in), dimension(pcols,pver) :: q
+real(r8), intent(in), dimension(pcols) :: tpert ! PBL temperature perturbation.
+
+real(r8), intent(inout), dimension(pcols,pver) :: tp ! Parcel temp.
+real(r8), intent(inout), dimension(pcols,pver) :: qstp ! Parcel water vapour (sat value above lcl).
+real(r8), intent(inout), dimension(pcols) :: tl ! Actual temp of LCL.
+real(r8), intent(inout), dimension(pcols) :: pl ! Actual pressure of LCL.
+
+integer, intent(inout), dimension(pcols) :: lcl ! Lifting condesation level (first model level with saturation).
+
+real(r8), intent(out), dimension(pcols,pver) :: tpv ! Define tpv within this routine.
+
+real(r8), pointer, dimension(:,:) :: org
+real(r8), intent(in), dimension(pcols) :: landfrac
+
+!+tht
+!real(r8), dimension(pcols) :: dmpdz ! Parcel fractional mass entrainment rate (/m) 2D
+ real(r8), dimension(pcols,pver) :: dmpdz ! Parcel fractional mass entrainment rate (/m) 3D
+!-tht
+
+!--------------------
+
+! Have to be careful as s is also dry static energy.
+!+tht
+! in the mods below, s is used both as enthalpy (moist s.e.) and entropy
+!-tht
+
+! If we are to retain the fact that CAM loops over grid-points in the internal
+! loop then we need to dimension sp,atp,mp,xsh2o with ncol.
+
+
+real(r8) tmix(pcols,pver) ! Tempertaure of the entraining parcel.
+real(r8) qtmix(pcols,pver) ! Total water of the entraining parcel.
+real(r8) qsmix(pcols,pver) ! Saturated mixing ratio at the tmix.
+real(r8) smix(pcols,pver) ! Entropy of the entraining parcel.
+real(r8) xsh2o(pcols,pver) ! Precipitate lost from parcel.
+real(r8) ds_xsh2o(pcols,pver) ! Entropy change due to loss of condensate.
+real(r8) ds_freeze(pcols,pver) ! Entropy change sue to freezing of precip.
+real(r8) dmpdz2d(pcols,pver) ! variable detrainment rate
+
+!+tht
+real(r8) zl(pcols) ! lcl
+!-tht
+
+real(r8) mp(pcols) ! Parcel mass flux.
+real(r8) qtp(pcols) ! Parcel total water.
+real(r8) sp(pcols) ! Parcel entropy.
+
+real(r8) sp0(pcols) ! Parcel launch entropy.
+real(r8) qtp0(pcols) ! Parcel launch total water.
+real(r8) mp0(pcols) ! Parcel launch relative mass flux.
+
+real(r8) lwmax ! Maximum condesate that can be held in cloud before rainout.
+real(r8) dmpdp ! Parcel fractional mass entrainment rate (/mb).
+!real(r8) dmpdpc ! In cloud parcel mass entrainment rate (/mb).
+!real(r8) dmpdz ! Parcel fractional mass entrainment rate (/m)
+real(r8) dpdz,dzdp ! Hydrstatic relation and inverse of.
+real(r8) senv ! Environmental entropy at each grid point.
+real(r8) qtenv ! Environmental total water " " ".
+real(r8) penv ! Environmental total pressure " " ".
+!+tht
+real(r8) zenv
+!-tht
+real(r8) tenv ! Environmental total temperature " " ".
+real(r8) new_s ! Hold value for entropy after condensation/freezing adjustments.
+real(r8) new_q ! Hold value for total water after condensation/freezing adjustments.
+real(r8) dp ! Layer thickness (center to center)
+real(r8) tfguess ! First guess for entropy inversion - crucial for efficiency!
+real(r8) tscool ! Super cooled temperature offset (in degC) (eg -35).
+
+real(r8) qxsk, qxskp1 ! LCL excess water (k, k+1)
+real(r8) dsdp, dqtdp, dqxsdp ! LCL s, qt, p gradients (k, k+1)
+real(r8) slcl,qtlcl,qslcl ! LCL s, qt, qs values.
+real(r8) org2rkm, org2Tpert
+real(r8) dmpdz_lnd, dmpdz_mask
+
+integer rcall ! Number of ientropy call for errors recording
+integer nit_lheat ! Number of iterations for condensation/freezing loop.
+integer i,k,ii ! Loop counters.
+
+real(r8) est
+
+!======================================================================
+! SUMMARY
+!
+! 9/9/04 - Assumes parcel is initiated from level of maxh (klaunch)
+! and entrains at each level with a specified entrainment rate.
+!
+! 15/9/04 - Calculates lcl(i) based on k where qsmix is first < qtmix.
+!
+!======================================================================
+!
+! Set some values that may be changed frequently.
+!
+
+if (zm_org) then
+ org2rkm = 10._r8
+ org2Tpert = 0._r8
+endif
+
+nit_lheat = 2 ! iterations for ds,dq changes from condensation freezing.
+
+!+tht should not be necessary but for bit-reproducibility it turns out it is
+ if (.not.tht_tweaks) then
+ dmpdz =-tentrm ! Entrainment rate. (-ve for /m)
+ dmpdz_lnd=-tentr_lnd ! idem, on land
+ endif
+!-tht
+
+!dmpdpc = 3.e-2_r8 ! In cloud entrainment rate (/mb).
+
+ lwmax = 1.e-3_r8 ! Need to put formula in for this.
+ tscool = 0.0_r8 ! Temp at which water loading freezes in the cloud.
+!+tht
+!lwmax = 1.e10_r8 ! tht: don't precipitate
+!tscool =-10._r8 ! tht: allow even just mild supercooling?!
+!-tht
+
+qtmix=0._r8
+smix=0._r8
+
+qtenv = 0._r8
+senv = 0._r8
+tenv = 0._r8
+penv = 0._r8
+!+tht
+zenv = 0._r8
+!-tht
+
+qtp0 = 0._r8
+sp0 = 0._r8
+mp0 = 0._r8
+
+qtp = 0._r8
+sp = 0._r8
+mp = 0._r8
+
+new_q = 0._r8
+new_s = 0._r8
+
+zl(:)=0._r8
+
+! **** Begin loops ****
+
+do k = pver, msg+1, -1
+ do i=1,ncol
+
+! Initialize parcel values at launch level.
+
+ if (k == klaunch(i)) then
+ qtp0(i) = q(i,k) ! Parcel launch total water (assuming subsaturated) - OK????.
+
+!+tht: formulate dilution on enthalpy not on entropy
+ if (tht_tweaks) then
+ sp0(i) = enthalpy(t(i,k),p(i,k),qtp0(i),z(i,k)) ! Parcel launch enthalpy.
+ else
+ sp0(i) = entropy (t(i,k),p(i,k),qtp0(i)) ! Parcel launch entropy.
+ endif
+!-tht
+ mp0(i) = 1._r8 ! Parcel launch relative mass (=1 for dmpdp=0 i.e. undilute).
+ smix(i,k) = sp0(i)
+ qtmix(i,k) = qtp0(i)
+!+tht: since the function to invert for T is *identical* with sp0(i)=entropy(t), unless there is
+! a coding error (likely, given the mess) the result must be t(i,k) (verified 21/2/2014)
+ if (tht_tweaks) then
+ tmix(i,k) = t(i,k)
+ call qsat_hPa(tmix(i,k),p(i,k), est, qsmix(i,k))
+ else
+ tfguess = t(i,k)
+ rcall = 1
+ call ientropy (rcall,i,lchnk,smix(i,k),p(i,k),qtmix(i,k),tmix(i,k),qsmix(i,k),tfguess)
+ endif
+!-tht
+ end if
+
+! Entraining levels
+
+ if (k < klaunch(i)) then
+
+! Set environmental values for this level.
+
+ dp = (p(i,k)-p(i,k+1)) ! In -ve mb as p decreasing with height - difference between center of layers.
+ qtenv = 0.5_r8*(q(i,k)+q(i,k+1)) ! Total water of environment.
+ tenv = 0.5_r8*(t(i,k)+t(i,k+1))
+ penv = 0.5_r8*(p(i,k)+p(i,k+1))
+!+tht
+ zenv = 0.5_r8*(z(i,k)+z(i,k+1))
+!-tht
+
+!+tht: base plume dilution on enthalpy not on entropy
+ if (tht_tweaks) then
+ senv = enthalpy(tenv,penv,qtenv,zenv) ! Enthalpy of environment.
+ else
+ senv = entropy (tenv,penv,qtenv) ! Entropy of environment.
+ endif
+!-tht
+
+! Determine fractional entrainment rate /pa given value /m.
+
+ dpdz = -(penv*grav)/(rgas*tenv) ! in mb/m since p in mb.
+ dzdp = 1._r8/dpdz ! in m/mb
+ if (zm_org) then
+!+tht
+! NB: land fudge makes no sense to me - make dmpdz_lnd=dmpdz (as per default code, hard-wired to 1e-3)
+ !dmpdz_mask=dmpdz
+ !dmpdz_mask=dmpdz(i)
+ dmpdz_mask=dmpdz(i,k)
+ if (tht_tweaks) dmpdz_lnd=dmpdz_mask
+ dmpdz_mask = landfrac(i) * dmpdz_lnd + (1._r8 - landfrac(i)) * dmpdz_mask
+ dmpdp = (dmpdz_mask/(1._r8+org(i,k)*org2rkm))*dzdp ! /mb Fractional entrainment
+ else
+ !dmpdp = dmpdz*dzdp
+ !dmpdp = dmpdz(i)*dzdp ! /mb Fractional entrainment 2D
+ dmpdp = dmpdz(i,k)*dzdp ! /mb Fractional entrainment 3D
+!-tht
+ endif
+
+! Sum entrainment to current level
+! entrains q,s out of intervening dp layers, in which linear variation is assumed
+! so really it entrains the mean of the 2 stored values.
+
+ sp(i) = sp(i) - dmpdp*dp*senv
+ qtp(i) = qtp(i) - dmpdp*dp*qtenv
+ mp(i) = mp(i) - dmpdp*dp
+
+! Entrain s and qt to next level.
+
+ smix(i,k) = (sp0(i) + sp(i)) / (mp0(i) + mp(i))
+ qtmix(i,k) = (qtp0(i) + qtp(i)) / (mp0(i) + mp(i))
+
+! Invert entropy from s and q to determine T and saturation-capped q of mixture.
+! t(i,k) used as a first guess so that it converges faster.
+
+ tfguess = tmix(i,k+1)
+ rcall = 2
+!+tht
+ if (tht_tweaks) then
+ call ienthalpy(rcall,i,lchnk,smix(i,k),p(i,k),z(i,k),qtmix(i,k),tmix(i,k),qsmix(i,k),tfguess)
+ else
+ call ientropy (rcall,i,lchnk,smix(i,k),p(i,k),qtmix(i,k),tmix(i,k),qsmix(i,k),tfguess)
+ endif
+!-tht
+
+!
+! Determine if this is lcl of this column if qsmix <= qtmix.
+! FIRST LEVEL where this happens on ascending.
+ if (qsmix(i,k) <= qtmix(i,k) .and. qsmix(i,k+1) > qtmix(i,k+1)) then
+ lcl(i) = k
+ qxsk = qtmix(i,k) - qsmix(i,k)
+ qxskp1 = qtmix(i,k+1) - qsmix(i,k+1)
+ dqxsdp = (qxsk - qxskp1)/dp
+ pl(i) = p(i,k+1) - qxskp1/dqxsdp ! pressure level of actual lcl.
+!+tht
+ zl(i) = z(i,k+1) - qxskp1/dqxsdp *dzdp
+!-tht
+ dsdp = (smix(i,k) - smix(i,k+1))/dp
+ dqtdp = (qtmix(i,k) - qtmix(i,k+1))/dp
+ slcl = smix(i,k+1) + dsdp* (pl(i)-p(i,k+1))
+ qtlcl = qtmix(i,k+1) + dqtdp*(pl(i)-p(i,k+1))
+
+ tfguess = tmix(i,k)
+ rcall = 3
+!+tht
+ if (tht_tweaks) then
+ call ienthalpy(rcall,i,lchnk,slcl,pl(i),zl(i),qtlcl,tl(i),qslcl,tfguess)
+ else
+ call ientropy (rcall,i,lchnk,slcl,pl(i),qtlcl,tl(i),qslcl,tfguess)
+ endif
+!-tht
+
+! write(iulog,*)' '
+! write(iulog,*)' p',p(i,k+1),pl(i),p(i,lcl(i))
+! write(iulog,*)' t',tmix(i,k+1),tl(i),tmix(i,lcl(i))
+! write(iulog,*)' s',smix(i,k+1),slcl,smix(i,lcl(i))
+! write(iulog,*)'qt',qtmix(i,k+1),qtlcl,qtmix(i,lcl(i))
+! write(iulog,*)'qs',qsmix(i,k+1),qslcl,qsmix(i,lcl(i))
+
+ endif
+!
+ end if ! k < klaunch
+
+
+ end do ! Levels loop
+end do ! Columns loop
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!END ENTRAINMENT LOOP!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!! Could stop now and test with this as it will provide some estimate of buoyancy
+!! without the effects of freezing/condensation taken into account for tmix.
+
+!! So we now have a profile of entropy and total water of the entraining parcel
+!! Varying with height from the launch level klaunch parcel=environment. To the
+!! top allowed level for the existence of convection.
+
+!! Now we have to adjust these values such that the water held in vaopor is < or
+!! = to qsmix. Therefore, we assume that the cloud holds a certain amount of
+!! condensate (lwmax) and the rest is rained out (xsh2o). This, obviously
+!! provides latent heating to the mixed parcel and so this has to be added back
+!! to it. But does this also increase qsmix as well? Also freezing processes
+
+
+xsh2o = 0._r8
+ds_xsh2o = 0._r8
+ds_freeze = 0._r8
+
+!!!!!!!!!!!!!!!!!!!!!!!!!PRECIPITATION/FREEZING LOOP!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Iterate solution twice for accuracy
+
+
+
+do k = pver, msg+1, -1
+ do i=1,ncol
+
+! Initialize variables at k=klaunch
+
+ if (k == klaunch(i)) then
+
+! Set parcel values at launch level assume no liquid water.
+
+ tp(i,k) = tmix(i,k)
+ qstp(i,k) = q(i,k)
+ if (zm_org) then
+ if (tht_tweaks) then
+ tpv(i,k) = (tp(i,k) + (org2Tpert*org(i,k)+tpert(i))) * (1._r8+qstp(i,k)/eps1) / (1._r8+qstp(i,k)) !+tht
+ else
+ tpv(i,k) = (tp(i,k) + (org2Tpert*org(i,k)+tpert(i))) * (1._r8+1.608_r8*qstp(i,k)) / (1._r8+qstp(i,k))
+ endif
+ else
+ if (tht_tweaks) then
+ tpv(i,k) = (tp(i,k) + tpert(i)) * (1._r8+qstp(i,k)/eps1) / (1._r8+qstp(i,k)) !+tht OK with mx ratio
+ else
+ tpv(i,k) = (tp(i,k) + tpert(i)) * (1._r8+1.608_r8*qstp(i,k)) / (1._r8+qstp(i,k))
+ endif
+ endif
+
+ end if
+
+ if (k < klaunch(i)) then
+
+ if (tht_tweaks) then
+ smix(i,k)=entropy(tmix(i,k),p(i,k),qtmix(i,k)) !+tht make sure to use entropy here
+ endif
+
+!----
+! Initiate loop if switch(2) = .T. - RBN:DILUTE - TAKEN OUT BUT COULD BE RETURNED LATER.
+! Iterate nit_lheat times for s,qt changes.
+ do ii=0,nit_lheat-1
+
+! Rain (xsh2o) is excess condensate, bar LWMAX (Accumulated loss from qtmix).
+ xsh2o(i,k) = max (0._r8, qtmix(i,k) - qsmix(i,k) - lwmax)
+
+! Contribution to ds from precip loss of condensate (Accumulated change from smix).(-ve)
+ ds_xsh2o(i,k) = ds_xsh2o(i,k+1) - cpliq * log (tmix(i,k)/tfreez) * max(0._r8,(xsh2o(i,k)-xsh2o(i,k+1)))
+!
+! Entropy of freezing: latice times amount of water involved divided by T.
+!
+ if (tmix(i,k) <= tfreez+tscool .and. ds_freeze(i,k+1) == 0._r8) then ! One off freezing of condensate.
+ ds_freeze(i,k) = (latice/tmix(i,k)) * max(0._r8,qtmix(i,k)-qsmix(i,k)-xsh2o(i,k)) ! Gain of LH
+ end if
+
+ if (tmix(i,k) <= tfreez+tscool .and. ds_freeze(i,k+1) /= 0._r8) then ! Continual freezing of additional condensate.
+ ds_freeze(i,k) = ds_freeze(i,k+1)+(latice/tmix(i,k)) * max(0._r8,(qsmix(i,k+1)-qsmix(i,k)))
+ end if
+
+! Adjust entropy and accordingly to sum of ds (be careful of signs).
+ new_s = smix(i,k) + ds_xsh2o(i,k) + ds_freeze(i,k)
+
+! Adjust liquid water and accordingly to xsh2o.
+ new_q = qtmix(i,k) - xsh2o(i,k)
+
+! Invert entropy to get updated Tmix and qsmix of parcel.
+
+ tfguess = tmix(i,k)
+ rcall =4
+ call ientropy (rcall,i,lchnk,new_s, p(i,k), new_q, tmix(i,k), qsmix(i,k), tfguess)
+
+ end do ! Iteration loop for freezing processes.
+
+! tp - Parcel temp is temp of mixture.
+! tpv - Parcel v. temp should be density temp with new_q total water.
+
+ tp(i,k) = tmix(i,k)
+
+! tpv = tprho in the presence of condensate (i.e. when new_q > qsmix)
+ if (new_q > qsmix(i,k)) then ! Super-saturated so condensate present - reduces buoyancy.
+ qstp(i,k) = qsmix(i,k)
+ else ! Just saturated/sub-saturated - no condensate virtual effects.
+ qstp(i,k) = new_q
+ end if
+
+ if (zm_org) then
+ if (tht_tweaks) then
+ tpv(i,k) = (tp(i,k)+(org2Tpert*org(i,k)+tpert(i)))* (1._r8+qstp(i,k)/eps1) / (1._r8+ new_q) !+tht
+ else
+ tpv(i,k) = (tp(i,k)+(org2Tpert*org(i,k)+tpert(i)))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+ new_q)
+ endif
+ else
+ if (tht_tweaks) then
+ tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+qstp(i,k)/eps1) / (1._r8+ new_q) !+tht
+ else
+ tpv(i,k) = (tp(i,k)+tpert(i))* (1._r8+1.608_r8*qstp(i,k)) / (1._r8+ new_q)
+ endif
+ endif
+
+ end if ! k < klaunch
+
+ end do ! Loop for columns
+
+end do ! Loop for vertical levels.
+
+
+return
+end subroutine parcel_dilute
+
+!-----------------------------------------------------------------------------------------
+real(r8) function entropy(TK,p,qtot)
+!-----------------------------------------------------------------------------------------
+!
+! TK(K),p(mb),qtot(kg/kg)
+! from Raymond and Blyth 1992
+!
+ real(r8), intent(in) :: p,qtot,TK
+ real(r8) :: qv,qst,e,est,L
+ real(r8), parameter :: pref = 1000._r8
+
+L = rl - (cpliq - cpwv)*(TK-tfreez) ! T IN CENTIGRADE
+
+call qsat_hPa(TK, p, est, qst)
+
+qv = min(qtot,qst) ! Partition qtot into vapor part only.
+e = qv*p / (eps1 +qv)
+
+entropy = (cpres + qtot*cpliq)*log( TK/tfreez) - rgas*log( (p-e)/pref ) + &
+ L*qv/TK - qv*rh2o*log(qv/qst)
+
+end FUNCTION entropy
+
+!
+!-----------------------------------------------------------------------------------------
+SUBROUTINE ientropy (rcall,icol,lchnk,s,p,qt,T,qst,Tfg)
+!-----------------------------------------------------------------------------------------
+!
+! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg).
+! Inverts entropy, pressure and total water qt
+! for T and saturated vapor mixing ratio
+!
+
+ use phys_grid, only: get_rlon_p, get_rlat_p
+
+ integer, intent(in) :: icol, lchnk, rcall
+ real(r8), intent(in) :: s, p, Tfg, qt
+ real(r8), intent(out) :: qst, T
+ real(r8) :: est, this_lat,this_lon
+ real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol
+ integer :: i
+
+ logical :: converged
+
+ ! Max number of iteration loops.
+ integer, parameter :: LOOPMAX = 100
+ real(r8), parameter :: EPS = 3.e-8_r8
+
+ converged = .false.
+
+ ! Invert the entropy equation -- use Brent's method
+ ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973.
+
+ T = Tfg ! Better first guess based on Tprofile from conv.
+
+ a = Tfg-10 !low bracket
+ b = Tfg+10 !high bracket
+
+ fa = entropy(a, p, qt) - s
+ fb = entropy(b, p, qt) - s
+
+ c=b
+ fc=fb
+ tol=0.001_r8
+
+ converge: do i=0, LOOPMAX
+ if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. &
+ (fb < 0.0_r8 .and. fc < 0.0_r8)) then
+ c=a
+ fc=fa
+ d=b-a
+ ebr=d
+ end if
+ if (abs(fc) < abs(fb)) then
+ a=b
+ b=c
+ c=a
+ fa=fb
+ fb=fc
+ fc=fa
+ end if
+
+ tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol
+ xm=0.5_r8*(c-b)
+ converged = (abs(xm) <= tol1 .or. fb == 0.0_r8)
+ if (converged) exit converge
+
+ if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then
+ sbr=fb/fa
+ if (a == c) then
+ pbr=2.0_r8*xm*sbr
+ qbr=1.0_r8-sbr
+ else
+ qbr=fa/fc
+ rbr=fb/fc
+ pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8))
+ qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8)
+ end if
+ if (pbr > 0.0_r8) qbr=-qbr
+ pbr=abs(pbr)
+ if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then
+ ebr=d
+ d=pbr/qbr
+ else
+ d=xm
+ ebr=d
+ end if
+ else
+ d=xm
+ ebr=d
+ end if
+ a=b
+ fa=fb
+ b=b+merge(d,sign(tol1,xm), abs(d) > tol1 )
+
+ fb = entropy(b, p, qt) - s
+
+ end do converge
+
+ T = b
+ call qsat_hPa(T, p, est, qst)
+
+ if (.not. converged) then
+ this_lat = get_rlat_p(lchnk, icol)*57.296_r8
+ this_lon = get_rlon_p(lchnk, icol)*57.296_r8
+ write(iulog,*) '*** ZM_CONV: IENTROPY: Failed and about to exit, info follows ****'
+ write(iulog,100) 'ZM_CONV: IENTROPY. Details: call#,lchnk,icol= ',rcall,lchnk,icol, &
+ ' lat: ',this_lat,' lon: ',this_lon, &
+ ' P(mb)= ', p, ' Tfg(K)= ', Tfg, ' qt(g/kg) = ', 1000._r8*qt, &
+ ' qst(g/kg) = ', 1000._r8*qst,', s(J/kg) = ',s
+ call endrun('**** ZM_CONV IENTROPY: Tmix did not converge ****')
+ end if
+
+100 format (A,I1,I4,I4,7(A,F6.2))
+
+end SUBROUTINE ientropy
+
+! Wrapper for qsat_water that does translation between Pa and hPa
+! qsat_water uses Pa internally, so get it right, need to pass in Pa.
+! Afterward, set es back to hPa.
+elemental subroutine qsat_hPa(t, p, es, qm)
+ use wv_saturation, only: qsat_water
+
+ ! Inputs
+ real(r8), intent(in) :: t ! Temperature (K)
+ real(r8), intent(in) :: p ! Pressure (hPa)
+ ! Outputs
+ real(r8), intent(out) :: es ! Saturation vapor pressure (hPa)
+ real(r8), intent(out) :: qm ! Saturation mass mixing ratio
+ ! (vapor mass over dry mass, kg/kg)
+
+ call qsat_water(t, p*100._r8, es, qm)
+
+ es = es*0.01_r8
+
+end subroutine qsat_hPa
+
+!-----------------------------------------------------------------------------------------
+real(r8) function enthalpy(TK,p,qtot,z)
+!-----------------------------------------------------------------------------------------
+!
+! TK(K),p(mb),qtot(kg/kg)
+!
+ real(r8), intent(in) :: p,qtot,TK,z
+ real(r8) :: qv,qst,e,est,L
+
+L = rl - (cpliq - cpwv)*(TK-tfreez)
+
+call qsat_hPa(TK, p, est, qst)
+qv = min(qtot,qst) ! Partition qtot into vapor part only.
+
+!enthalpy = (cpres + qtot*cpliq)*(TK-tfreez) + L*qv + (1._r8+qtot)*grav*z
+ enthalpy = (cpres + qtot*cpliq)* TK + L*qv + (1._r8+qtot)*grav*z
+
+return
+end FUNCTION enthalpy
+
+!-----------------------------------------------------------------------------------------
+ SUBROUTINE ienthalpy (rcall,icol,lchnk,s,p,z,qt,T,qst,Tfg) !identical with iENTROPY, only function calls swapped
+!-----------------------------------------------------------------------------------------
+!
+! p(mb), Tfg/T(K), qt/qv(kg/kg), s(J/kg).
+! Inverts entropy, pressure and total water qt
+! for T and saturated vapor mixing ratio
+!
+
+ use phys_grid, only: get_rlon_p, get_rlat_p
+
+ integer, intent(in) :: icol, lchnk, rcall
+ real(r8), intent(in) :: s, p, z, Tfg, qt
+ real(r8), intent(out) :: qst, T
+ real(r8) :: est, this_lat,this_lon
+ real(r8) :: a,b,c,d,ebr,fa,fb,fc,pbr,qbr,rbr,sbr,tol1,xm,tol
+ integer :: i
+
+ logical :: converged
+
+ ! Max number of iteration loops.
+ integer, parameter :: LOOPMAX = 100
+ real(r8), parameter :: EPS = 3.e-8_r8
+
+ converged = .false.
+
+ ! Invert the entropy equation -- use Brent's method
+ ! Brent, R. P. Ch. 3-4 in Algorithms for Minimization Without Derivatives. Englewood Cliffs, NJ: Prentice-Hall, 1973.
+
+ T = Tfg ! Better first guess based on Tprofile from conv.
+
+ a = Tfg-10 !low bracket
+ b = Tfg+10 !high bracket
+
+ fa = enthalpy(a, p, qt,z) - s
+ fb = enthalpy(b, p, qt,z) - s
+
+ c=b
+ fc=fb
+ tol=0.001_r8
+
+ converge: do i=0, LOOPMAX
+ if ((fb > 0.0_r8 .and. fc > 0.0_r8) .or. &
+ (fb < 0.0_r8 .and. fc < 0.0_r8)) then
+ c=a
+ fc=fa
+ d=b-a
+ ebr=d
+ end if
+ if (abs(fc) < abs(fb)) then
+ a=b
+ b=c
+ c=a
+ fa=fb
+ fb=fc
+ fc=fa
+ end if
+
+ tol1=2.0_r8*EPS*abs(b)+0.5_r8*tol
+ xm=0.5_r8*(c-b)
+ converged = (abs(xm) <= tol1 .or. fb == 0.0_r8)
+ if (converged) exit converge
+
+ if (abs(ebr) >= tol1 .and. abs(fa) > abs(fb)) then
+ sbr=fb/fa
+ if (a == c) then
+ pbr=2.0_r8*xm*sbr
+ qbr=1.0_r8-sbr
+ else
+ qbr=fa/fc
+ rbr=fb/fc
+ pbr=sbr*(2.0_r8*xm*qbr*(qbr-rbr)-(b-a)*(rbr-1.0_r8))
+ qbr=(qbr-1.0_r8)*(rbr-1.0_r8)*(sbr-1.0_r8)
+ end if
+ if (pbr > 0.0_r8) qbr=-qbr
+ pbr=abs(pbr)
+ if (2.0_r8*pbr < min(3.0_r8*xm*qbr-abs(tol1*qbr),abs(ebr*qbr))) then
+ ebr=d
+ d=pbr/qbr
+ else
+ d=xm
+ ebr=d
+ end if
+ else
+ d=xm
+ ebr=d
+ end if
+ a=b
+ fa=fb
+ b=b+merge(d,sign(tol1,xm), abs(d) > tol1 )
+
+ fb = enthalpy(b, p, qt,z) - s
+
+ end do converge
+
+ T = b
+ call qsat_hPa(T, p, est, qst)
+
+ if (.not. converged) then
+ this_lat = get_rlat_p(lchnk, icol)*57.296_r8
+ this_lon = get_rlon_p(lchnk, icol)*57.296_r8
+ write(iulog,*) '*** ZM_CONV: IENTHALPY: Failed and about to exit, info follows ****'
+ write(iulog,100) 'ZM_CONV: IENTHALPY. Details: call#,lchnk,icol= ',rcall,lchnk,icol, &
+ ' lat: ',this_lat,' lon: ',this_lon, &
+ ' P(mb)= ', p, ' Tfg(K)= ', Tfg, ' qt(g/kg) = ', 1000._r8*qt, &
+ ' qst(g/kg) = ', 1000._r8*qst,', s(J/kg) = ',s
+ call endrun('**** ZM_CONV IENTHALPY: Tmix did not converge ****')
+ end if
+
+100 format (A,I1,I4,I4,7(A,F6.2))
+
+ end SUBROUTINE ienthalpy
+
+end module zm_conv
diff --git a/src/NorESM/zm_conv_intr.F90 b/src/NorESM/zm_conv_intr.F90
new file mode 100644
index 0000000000..f070cf8a7b
--- /dev/null
+++ b/src/NorESM/zm_conv_intr.F90
@@ -0,0 +1,1395 @@
+module zm_conv_intr
+!---------------------------------------------------------------------------------
+! Purpose:
+!
+! CAM interface to the Zhang-McFarlane deep convection scheme
+!
+! Author: D.B. Coleman
+! January 2010 modified by J. Kay to add COSP simulator fields to physics buffer
+!---------------------------------------------------------------------------------
+ use shr_kind_mod, only: r8=>shr_kind_r8
+ use physconst, only: cpair
+ use ppgrid, only: pver, pcols, pverp, begchunk, endchunk
+ use zm_conv, only: zm_conv_evap, zm_convr, convtran, momtran
+ use zm_microphysics, only: zm_aero_t, zm_conv_t
+ use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num, rad_cnst_get_aer_mmr, &
+ rad_cnst_get_aer_props, rad_cnst_get_mode_props !, &
+ use ndrop_bam, only: ndrop_bam_init
+ use cam_abortutils, only: endrun
+ use physconst, only: pi
+ use spmd_utils, only: masterproc
+ use perf_mod
+ use cam_logfile, only: iulog
+ use constituents, only: cnst_add
+
+ implicit none
+ private
+ save
+
+ ! Public methods
+
+ public ::&
+ zm_conv_register, &! register fields in physics buffer
+ zm_conv_readnl, &! read namelist
+ zm_conv_init, &! initialize donner_deep module
+ zm_conv_tend, &! return tendencies
+ zm_conv_tend_2 ! return tendencies
+
+ public :: zmconv_microp
+
+ integer ::& ! indices for fields in the physics buffer
+ zm_mu_idx, &
+ zm_eu_idx, &
+ zm_du_idx, &
+ zm_md_idx, &
+ zm_ed_idx, &
+ zm_dp_idx, &
+ zm_dsubcld_idx, &
+ zm_jt_idx, &
+ zm_maxg_idx, &
+ zm_ideep_idx, &
+ dp_flxprc_idx, &
+ dp_flxsnw_idx, &
+ dp_cldliq_idx, &
+ ixorg, &
+ dp_cldice_idx, &
+ dlfzm_idx, & ! detrained convective cloud water mixing ratio.
+ difzm_idx, & ! detrained convective cloud ice mixing ratio.
+ dnlfzm_idx, & ! detrained convective cloud water num concen.
+ dnifzm_idx, & ! detrained convective cloud ice num concen.
+ prec_dp_idx, &
+ snow_dp_idx
+
+ real(r8), parameter :: unset_r8 = huge(1.0_r8)
+ real(r8) :: zmconv_c0_lnd = unset_r8
+ real(r8) :: zmconv_c0_ocn = unset_r8
+ real(r8) :: zmconv_ke = unset_r8
+ real(r8) :: zmconv_ke_lnd = unset_r8
+ real(r8) :: zmconv_momcu = unset_r8
+ real(r8) :: zmconv_momcd = unset_r8
+ integer :: zmconv_num_cin ! Number of negative buoyancy regions that are allowed
+ ! before the convection top and CAPE calculations are completed.
+ logical :: zmconv_org ! Parameterization for sub-grid scale convective organization for the ZM deep
+ ! convective scheme based on Mapes and Neale (2011)
+ logical :: zmconv_microp = .false. ! switch for microphysics
+
+
+! indices for fields in the physics buffer
+ integer :: cld_idx = 0
+ integer :: icwmrdp_idx = 0
+ integer :: rprddp_idx = 0
+ integer :: fracis_idx = 0
+ integer :: nevapr_dpcu_idx = 0
+ integer :: dgnum_idx = 0
+
+ integer :: nmodes
+ integer :: nbulk
+
+ type(zm_aero_t), allocatable :: aero(:) ! object contains information about the aerosols
+
+!=========================================================================================
+contains
+!=========================================================================================
+
+subroutine zm_conv_register
+
+!----------------------------------------
+! Purpose: register fields with the physics buffer
+!----------------------------------------
+
+ use physics_buffer, only : pbuf_add_field, dtype_r8, dtype_i4
+
+ implicit none
+
+ integer idx
+
+ call pbuf_add_field('ZM_MU', 'physpkg', dtype_r8, (/pcols,pver/), zm_mu_idx)
+ call pbuf_add_field('ZM_EU', 'physpkg', dtype_r8, (/pcols,pver/), zm_eu_idx)
+ call pbuf_add_field('ZM_DU', 'physpkg', dtype_r8, (/pcols,pver/), zm_du_idx)
+ call pbuf_add_field('ZM_MD', 'physpkg', dtype_r8, (/pcols,pver/), zm_md_idx)
+ call pbuf_add_field('ZM_ED', 'physpkg', dtype_r8, (/pcols,pver/), zm_ed_idx)
+
+ ! wg layer thickness in mbs (between upper/lower interface).
+ call pbuf_add_field('ZM_DP', 'physpkg', dtype_r8, (/pcols,pver/), zm_dp_idx)
+
+ ! wg layer thickness in mbs between lcl and maxi.
+ call pbuf_add_field('ZM_DSUBCLD', 'physpkg', dtype_r8, (/pcols/), zm_dsubcld_idx)
+
+ ! wg top level index of deep cumulus convection.
+ call pbuf_add_field('ZM_JT', 'physpkg', dtype_i4, (/pcols/), zm_jt_idx)
+
+ ! wg gathered values of maxi.
+ call pbuf_add_field('ZM_MAXG', 'physpkg', dtype_i4, (/pcols/), zm_maxg_idx)
+
+ ! map gathered points to chunk index
+ call pbuf_add_field('ZM_IDEEP', 'physpkg', dtype_i4, (/pcols/), zm_ideep_idx)
+
+! Flux of precipitation from deep convection (kg/m2/s)
+ call pbuf_add_field('DP_FLXPRC','global',dtype_r8,(/pcols,pverp/),dp_flxprc_idx)
+
+! Flux of snow from deep convection (kg/m2/s)
+ call pbuf_add_field('DP_FLXSNW','global',dtype_r8,(/pcols,pverp/),dp_flxsnw_idx)
+
+! deep gbm cloud liquid water (kg/kg)
+ call pbuf_add_field('DP_CLDLIQ','global',dtype_r8,(/pcols,pver/), dp_cldliq_idx)
+
+! deep gbm cloud liquid water (kg/kg)
+ call pbuf_add_field('DP_CLDICE','global',dtype_r8,(/pcols,pver/), dp_cldice_idx)
+
+ call pbuf_add_field('ICWMRDP', 'physpkg',dtype_r8,(/pcols,pver/),icwmrdp_idx)
+ call pbuf_add_field('RPRDDP', 'physpkg',dtype_r8,(/pcols,pver/),rprddp_idx)
+ call pbuf_add_field('NEVAPR_DPCU','physpkg',dtype_r8,(/pcols,pver/),nevapr_dpcu_idx)
+ call pbuf_add_field('PREC_DP', 'physpkg',dtype_r8,(/pcols/), prec_dp_idx)
+ call pbuf_add_field('SNOW_DP', 'physpkg',dtype_r8,(/pcols/), snow_dp_idx)
+
+ ! detrained convective cloud water mixing ratio.
+ call pbuf_add_field('DLFZM', 'physpkg', dtype_r8, (/pcols,pver/), dlfzm_idx)
+ ! detrained convective cloud ice mixing ratio.
+ call pbuf_add_field('DIFZM', 'physpkg', dtype_r8, (/pcols,pver/), difzm_idx)
+
+ if (zmconv_microp) then
+ ! Only add the number conc fields if the microphysics is active.
+
+ ! detrained convective cloud water num concen.
+ call pbuf_add_field('DNLFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnlfzm_idx)
+ ! detrained convective cloud ice num concen.
+ call pbuf_add_field('DNIFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnifzm_idx)
+ end if
+
+ if (zmconv_org) then
+ call cnst_add('ZM_ORG',0._r8,0._r8,0._r8,ixorg,longname='organization parameter')
+ endif
+
+end subroutine zm_conv_register
+
+!=========================================================================================
+
+subroutine zm_conv_readnl(nlfile)
+
+ use spmd_utils, only: mpicom, masterproc, masterprocid, mpi_real8, mpi_integer, mpi_logical
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'zm_conv_readnl'
+
+ namelist /zmconv_nl/ zmconv_c0_lnd, zmconv_c0_ocn, zmconv_num_cin, &
+ zmconv_ke, zmconv_ke_lnd, zmconv_org, &
+ zmconv_momcu, zmconv_momcd, zmconv_microp
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'zmconv_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, zmconv_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+
+ end if
+
+ ! Broadcast namelist variables
+ call mpi_bcast(zmconv_num_cin, 1, mpi_integer, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_num_cin")
+ call mpi_bcast(zmconv_c0_lnd, 1, mpi_real8, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_c0_lnd")
+ call mpi_bcast(zmconv_c0_ocn, 1, mpi_real8, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_c0_ocn")
+ call mpi_bcast(zmconv_ke, 1, mpi_real8, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_ke")
+ call mpi_bcast(zmconv_ke_lnd, 1, mpi_real8, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_ke_lnd")
+ call mpi_bcast(zmconv_momcu, 1, mpi_real8, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_momcu")
+ call mpi_bcast(zmconv_momcd, 1, mpi_real8, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_momcd")
+ call mpi_bcast(zmconv_org, 1, mpi_logical, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_org")
+ call mpi_bcast(zmconv_microp, 1, mpi_logical, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun("zm_conv_readnl: FATAL: mpi_bcast: zmconv_microp")
+
+end subroutine zm_conv_readnl
+
+!=========================================================================================
+
+subroutine zm_conv_init(pref_edge)
+
+!----------------------------------------
+! Purpose: declare output fields, initialize variables needed by convection
+!----------------------------------------
+
+ use cam_history, only: addfld, add_default, horiz_only
+ use ppgrid, only: pcols, pver
+ use zm_conv, only: zm_convi
+ use pmgrid, only: plev,plevp
+ use spmd_utils, only: masterproc
+ use phys_control, only: phys_deepconv_pbl, phys_getopts, cam_physpkg_is
+ use physics_buffer, only: pbuf_get_index
+
+ implicit none
+
+ real(r8),intent(in) :: pref_edge(plevp) ! reference pressures at interfaces
+
+
+ logical :: no_deep_pbl ! if true, no deep convection in PBL
+ integer limcnv ! top interface level limit for convection
+ integer k, istat
+ logical :: history_budget ! output tendencies and state variables for CAM4
+ ! temperature, water vapor, cloud ice and cloud
+ ! liquid budgets.
+ integer :: history_budget_histfile_num ! output history file number for budget fields
+
+! Allocate the basic aero structure outside the zmconv_microp logical
+! This allows the aero structure to be passed
+! Note that all of the arrays inside this structure are conditionally allocated
+
+ allocate(aero(begchunk:endchunk))
+
+!
+! Register fields with the output buffer
+!
+
+ if (zmconv_org) then
+ call addfld ('ZM_ORG ', (/ 'lev' /), 'A', '- ','Organization parameter')
+ call addfld ('ZM_ORG2D ', (/ 'lev' /), 'A', '- ','Organization parameter 2D')
+ endif
+ call addfld ('PRECZ', horiz_only, 'A', 'm/s','total precipitation from ZM convection')
+ call addfld ('ZMDT', (/ 'lev' /), 'A', 'K/s','T tendency - Zhang-McFarlane moist convection')
+ call addfld ('ZMDQ', (/ 'lev' /), 'A', 'kg/kg/s','Q tendency - Zhang-McFarlane moist convection')
+ call addfld ('ZMDICE', (/ 'lev' /), 'A', 'kg/kg/s','Cloud ice tendency - Zhang-McFarlane convection')
+ call addfld ('ZMDLIQ', (/ 'lev' /), 'A', 'kg/kg/s','Cloud liq tendency - Zhang-McFarlane convection')
+ call addfld ('EVAPTZM', (/ 'lev' /), 'A', 'K/s','T tendency - Evaporation/snow prod from Zhang convection')
+ call addfld ('FZSNTZM', (/ 'lev' /), 'A', 'K/s','T tendency - Rain to snow conversion from Zhang convection')
+ call addfld ('EVSNTZM', (/ 'lev' /), 'A', 'K/s','T tendency - Snow to rain prod from Zhang convection')
+ call addfld ('EVAPQZM', (/ 'lev' /), 'A', 'kg/kg/s','Q tendency - Evaporation from Zhang-McFarlane moist convection')
+
+ call addfld ('ZMFLXPRC', (/ 'ilev' /), 'A', 'kg/m2/s','Flux of precipitation from ZM convection' )
+ call addfld ('ZMFLXSNW', (/ 'ilev' /), 'A', 'kg/m2/s','Flux of snow from ZM convection' )
+ call addfld ('ZMNTPRPD', (/ 'lev' /) , 'A', 'kg/kg/s','Net precipitation production from ZM convection')
+ call addfld ('ZMNTSNPD', (/ 'lev' /) , 'A', 'kg/kg/s','Net snow production from ZM convection' )
+ call addfld ('ZMEIHEAT', (/ 'lev' /) , 'A', 'W/kg' ,'Heating by ice and evaporation in ZM convection')
+
+ call addfld ('CMFMCDZM', (/ 'ilev' /), 'A', 'kg/m2/s','Convection mass flux from ZM deep ')
+ call addfld ('PRECCDZM', horiz_only, 'A', 'm/s','Convective precipitation rate from ZM deep')
+
+ call addfld ('PCONVB', horiz_only , 'A', 'Pa' ,'convection base pressure')
+ call addfld ('PCONVT', horiz_only , 'A', 'Pa' ,'convection top pressure')
+
+ call addfld ('CAPE', horiz_only, 'A', 'J/kg', 'Convectively available potential energy')
+ call addfld ('FREQZM', horiz_only , 'A', 'fraction', 'Fractional occurance of ZM convection')
+
+ call addfld ('ZMMTT', (/ 'lev' /), 'A', 'K/s', 'T tendency - ZM convective momentum transport')
+ call addfld ('ZMMTU', (/ 'lev' /), 'A', 'm/s2', 'U tendency - ZM convective momentum transport')
+ call addfld ('ZMMTV', (/ 'lev' /), 'A', 'm/s2', 'V tendency - ZM convective momentum transport')
+
+ call addfld ('ZMMU', (/ 'lev' /), 'A', 'kg/m2/s', 'ZM convection updraft mass flux')
+ call addfld ('ZMMD', (/ 'lev' /), 'A', 'kg/m2/s', 'ZM convection downdraft mass flux')
+
+ call addfld ('ZMUPGU', (/ 'lev' /), 'A', 'm/s2', 'zonal force from ZM updraft pressure gradient term')
+ call addfld ('ZMUPGD', (/ 'lev' /), 'A', 'm/s2', 'zonal force from ZM downdraft pressure gradient term')
+ call addfld ('ZMVPGU', (/ 'lev' /), 'A', 'm/s2', 'meridional force from ZM updraft pressure gradient term')
+ call addfld ('ZMVPGD', (/ 'lev' /), 'A', 'm/s2', 'merdional force from ZM downdraft pressure gradient term')
+
+ call addfld ('ZMICUU', (/ 'lev' /), 'A', 'm/s', 'ZM in-cloud U updrafts')
+ call addfld ('ZMICUD', (/ 'lev' /), 'A', 'm/s', 'ZM in-cloud U downdrafts')
+ call addfld ('ZMICVU', (/ 'lev' /), 'A', 'm/s', 'ZM in-cloud V updrafts')
+ call addfld ('ZMICVD', (/ 'lev' /), 'A', 'm/s', 'ZM in-cloud V downdrafts')
+
+ call addfld ('DIFZM' ,(/ 'lev' /), 'A','kg/kg/s ','Detrained ice water from ZM convection')
+ call addfld ('DLFZM' ,(/ 'lev' /), 'A','kg/kg/s ','Detrained liquid water from ZM convection')
+
+!+tht
+ !call addfld ('EURT', horiz_only, 'A', '1/m', 'ZM plume ensemble entrainment rate') ! 2D
+ call addfld ('EURT', (/ 'lev' /), 'A', '1/m', 'ZM plume ensemble entrainment rate') ! 3D
+!-tht
+
+ call phys_getopts( history_budget_out = history_budget, &
+ history_budget_histfile_num_out = history_budget_histfile_num)
+
+ if (zmconv_org) then
+ call add_default('ZM_ORG', 1, ' ')
+ call add_default('ZM_ORG2D', 1, ' ')
+ endif
+ if ( history_budget ) then
+ call add_default('EVAPTZM ', history_budget_histfile_num, ' ')
+ call add_default('EVAPQZM ', history_budget_histfile_num, ' ')
+ call add_default('ZMDT ', history_budget_histfile_num, ' ')
+ call add_default('ZMDQ ', history_budget_histfile_num, ' ')
+ call add_default('ZMDLIQ ', history_budget_histfile_num, ' ')
+ call add_default('ZMDICE ', history_budget_histfile_num, ' ')
+ call add_default('ZMMTT ', history_budget_histfile_num, ' ')
+ end if
+
+ if (zmconv_microp) then
+ call add_default ('DIFZM', 1, ' ')
+ call add_default ('DLFZM', 1, ' ')
+ end if
+!
+! Limit deep convection to regions below 40 mb
+! Note this calculation is repeated in the shallow convection interface
+!
+ limcnv = 0 ! null value to check against below
+ if (pref_edge(1) >= 4.e3_r8) then
+ limcnv = 1
+ else
+ do k=1,plev
+ if (pref_edge(k) < 4.e3_r8 .and. pref_edge(k+1) >= 4.e3_r8) then
+ limcnv = k
+ exit
+ end if
+ end do
+ if ( limcnv == 0 ) limcnv = plevp
+ end if
+
+ if (masterproc) then
+ write(iulog,*)'ZM_CONV_INIT: Deep convection will be capped at intfc ',limcnv, &
+ ' which is ',pref_edge(limcnv),' pascals'
+ end if
+
+ no_deep_pbl = phys_deepconv_pbl()
+ call zm_convi(limcnv,zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_ke_lnd, &
+ zmconv_momcu, zmconv_momcd, zmconv_num_cin, zmconv_org, &
+ zmconv_microp, no_deep_pbl_in = no_deep_pbl)
+
+ cld_idx = pbuf_get_index('CLD')
+ fracis_idx = pbuf_get_index('FRACIS')
+
+ if (zmconv_microp) call zm_conv_micro_init()
+
+end subroutine zm_conv_init
+!=========================================================================================
+!subroutine zm_conv_tend(state, ptend, tdt)
+
+subroutine zm_conv_tend(pblh ,mcon ,cme , &
+ tpert ,pflx ,zdu , &
+ rliq ,rice ,ztodt , &
+ jctop ,jcbot , &
+ state ,ptend_all ,landfrac, pbuf)
+
+
+ use cam_history, only: outfld
+ use physics_types, only: physics_state, physics_ptend
+ use physics_types, only: physics_ptend_init, physics_update
+ use physics_types, only: physics_state_copy, physics_state_dealloc
+ use physics_types, only: physics_ptend_sum, physics_ptend_dealloc
+
+ use phys_grid, only: get_lat_p, get_lon_p
+ use time_manager, only: get_nstep, is_first_step
+ use physics_buffer, only : pbuf_get_field, physics_buffer_desc, pbuf_old_tim_idx
+ use constituents, only: pcnst, cnst_get_ind, cnst_is_convtran1
+ use check_energy, only: check_energy_chng
+ use physconst, only: gravit
+ use phys_control, only: cam_physpkg_is
+
+ ! Arguments
+
+ type(physics_state), intent(in),target :: state ! Physics state variables
+ type(physics_ptend), intent(out) :: ptend_all ! individual parameterization tendencies
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ real(r8), intent(in) :: ztodt ! 2 delta t (model time increment)
+ real(r8), intent(in) :: pblh(pcols) ! Planetary boundary layer height
+ real(r8), intent(in) :: tpert(pcols) ! Thermal temperature excess
+ real(r8), intent(in) :: landfrac(pcols) ! RBN - Landfrac
+
+ real(r8), intent(out) :: mcon(pcols,pverp) ! Convective mass flux--m sub c
+ real(r8), intent(out) :: pflx(pcols,pverp) ! scattered precip flux at each level
+ real(r8), intent(out) :: cme(pcols,pver) ! cmf condensation - evaporation
+ real(r8), intent(out) :: zdu(pcols,pver) ! detraining mass flux
+
+ real(r8), intent(out) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals
+ real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldice) for energy integrals
+
+
+ ! Local variables
+
+ type(zm_conv_t) :: conv
+
+ integer :: i,k,l,m
+ integer :: ilon ! global longitude index of a column
+ integer :: ilat ! global latitude index of a column
+ integer :: nstep
+ integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water.
+ integer :: lchnk ! chunk identifier
+ integer :: ncol ! number of atmospheric columns
+ integer :: itim_old ! for physics buffer fields
+
+ real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables
+ real(r8) :: ntprprd(pcols,pver) ! evap outfld: net precip production in layer
+ real(r8) :: ntsnprd(pcols,pver) ! evap outfld: net snow production in layer
+ real(r8) :: tend_s_snwprd (pcols,pver) ! Heating rate of snow production
+ real(r8) :: tend_s_snwevmlt(pcols,pver) ! Heating rate of evap/melting of snow
+ real(r8) :: fake_dpdry(pcols,pver) ! used in convtran call
+
+ ! physics types
+ type(physics_state) :: state1 ! locally modify for evaporation to use, not returned
+ type(physics_ptend),target :: ptend_loc ! package tendencies
+
+ ! physics buffer fields
+ real(r8), pointer, dimension(:) :: prec ! total precipitation
+ real(r8), pointer, dimension(:) :: snow ! snow from ZM convection
+ real(r8), pointer, dimension(:,:) :: cld
+ real(r8), pointer, dimension(:,:) :: ql ! wg grid slice of cloud liquid water.
+ real(r8), pointer, dimension(:,:) :: rprd ! rain production rate
+ real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble
+ real(r8), pointer, dimension(:,:) :: evapcdp ! Evaporation of deep convective precipitation
+ real(r8), pointer, dimension(:,:) :: flxprec ! Convective-scale flux of precip at interfaces (kg/m2/s)
+ real(r8), pointer, dimension(:,:) :: flxsnow ! Convective-scale flux of snow at interfaces (kg/m2/s)
+ real(r8), pointer, dimension(:,:) :: dp_cldliq
+ real(r8), pointer, dimension(:,:) :: dp_cldice
+ real(r8), pointer :: dlf(:,:) ! detrained convective cloud water mixing ratio.
+ real(r8), pointer :: dif(:,:) ! detrained convective cloud ice mixing ratio.
+ real(r8), pointer :: dnlf(:,:) ! detrained convective cloud water num concen.
+ real(r8), pointer :: dnif(:,:) ! detrained convective cloud ice num concen.
+ real(r8), pointer :: lambdadpcu(:,:) ! slope of cloud liquid size distr
+ real(r8), pointer :: mudpcu(:,:) ! width parameter of droplet size distr
+
+ real(r8), pointer :: mu(:,:) ! (pcols,pver)
+ real(r8), pointer :: eu(:,:) ! (pcols,pver)
+ real(r8), pointer :: du(:,:) ! (pcols,pver)
+ real(r8), pointer :: md(:,:) ! (pcols,pver)
+ real(r8), pointer :: ed(:,:) ! (pcols,pver)
+ real(r8), pointer :: dp(:,:) ! (pcols,pver)
+ real(r8), pointer :: dsubcld(:) ! (pcols)
+ integer, pointer :: jt(:) ! (pcols)
+ integer, pointer :: maxg(:) ! (pcols)
+ integer, pointer :: ideep(:) ! (pcols)
+ integer :: lengath
+
+ real(r8) :: jctop(pcols) ! o row of top-of-deep-convection indices passed out.
+ real(r8) :: jcbot(pcols) ! o row of base of cloud indices passed out.
+
+ real(r8) :: pcont(pcols), pconb(pcols), freqzm(pcols)
+
+!+tht
+ !real(r8) :: eurt(pcols) !+tht: entr.rate 2D
+ real(r8) :: eurt(pcols,pver) !+tht: entr.rate 3D
+!-tht
+
+ ! history output fields
+ real(r8) :: cape(pcols) ! w convective available potential energy.
+ real(r8) :: mu_out(pcols,pver)
+ real(r8) :: md_out(pcols,pver)
+
+ ! used in momentum transport calculation
+ real(r8) :: winds(pcols, pver, 2)
+ real(r8) :: wind_tends(pcols, pver, 2)
+ real(r8) :: pguall(pcols, pver, 2)
+ real(r8) :: pgdall(pcols, pver, 2)
+ real(r8) :: icwu(pcols,pver, 2)
+ real(r8) :: icwd(pcols,pver, 2)
+ real(r8) :: seten(pcols, pver)
+ logical :: l_windt(2)
+ real(r8) :: tfinal1, tfinal2
+ integer :: ii
+
+ real(r8),pointer :: zm_org2d(:,:)
+ real(r8),pointer :: orgt(:,:), org(:,:)
+
+ logical :: lq(pcnst)
+
+ !----------------------------------------------------------------------
+
+ ! initialize
+ lchnk = state%lchnk
+ ncol = state%ncol
+ nstep = get_nstep()
+
+ if (zmconv_microp) then
+ allocate( &
+ conv%qi(pcols,pver), &
+ conv%qliq(pcols,pver), &
+ conv%qice(pcols,pver), &
+ conv%wu(pcols,pver), &
+ conv%sprd(pcols,pver), &
+ conv%qrain(pcols,pver), &
+ conv%qsnow(pcols,pver), &
+ conv%qnl(pcols,pver), &
+ conv%qni(pcols,pver), &
+ conv%qnr(pcols,pver), &
+ conv%qns(pcols,pver), &
+ conv%frz(pcols,pver), &
+ conv%autolm(pcols,pver), &
+ conv%accrlm(pcols,pver), &
+ conv%bergnm(pcols,pver), &
+ conv%fhtimm(pcols,pver), &
+ conv%fhtctm(pcols,pver), &
+ conv%fhmlm (pcols,pver), &
+ conv%hmpim (pcols,pver), &
+ conv%accslm(pcols,pver), &
+ conv%dlfm (pcols,pver), &
+ conv%autoln(pcols,pver), &
+ conv%accrln(pcols,pver), &
+ conv%bergnn(pcols,pver), &
+ conv%fhtimn(pcols,pver), &
+ conv%fhtctn(pcols,pver), &
+ conv%fhmln (pcols,pver), &
+ conv%accsln(pcols,pver), &
+ conv%activn(pcols,pver), &
+ conv%dlfn (pcols,pver), &
+ conv%autoim(pcols,pver), &
+ conv%accsim(pcols,pver), &
+ conv%difm (pcols,pver), &
+ conv%nuclin(pcols,pver), &
+ conv%autoin(pcols,pver), &
+ conv%accsin(pcols,pver), &
+ conv%hmpin (pcols,pver), &
+ conv%difn (pcols,pver), &
+ conv%cmel (pcols,pver), &
+ conv%cmei (pcols,pver), &
+ conv%trspcm(pcols,pver), &
+ conv%trspcn(pcols,pver), &
+ conv%trspim(pcols,pver), &
+ conv%trspin(pcols,pver), &
+ conv%lambdadpcu(pcols,pver), &
+ conv%mudpcu(pcols,pver), &
+ conv%dcape(pcols) )
+ end if
+
+ ftem = 0._r8
+ mu_out(:,:) = 0._r8
+ md_out(:,:) = 0._r8
+ wind_tends(:ncol,:pver,:) = 0.0_r8
+
+ call physics_state_copy(state,state1) ! copy state to local state1.
+
+ lq(:) = .FALSE.
+ lq(1) = .TRUE.
+ if (zmconv_org) then
+ lq(ixorg) = .TRUE.
+ endif
+ call physics_ptend_init(ptend_loc, state%psetcols, 'zm_convr', ls=.true., lq=lq)! initialize local ptend type
+
+!
+! Associate pointers with physics buffer fields
+!
+ itim_old = pbuf_old_tim_idx()
+ call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+ call pbuf_get_field(pbuf, icwmrdp_idx, ql )
+ call pbuf_get_field(pbuf, rprddp_idx, rprd )
+ call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) )
+ call pbuf_get_field(pbuf, nevapr_dpcu_idx, evapcdp )
+ call pbuf_get_field(pbuf, prec_dp_idx, prec )
+ call pbuf_get_field(pbuf, snow_dp_idx, snow )
+
+ call pbuf_get_field(pbuf, zm_mu_idx, mu)
+ call pbuf_get_field(pbuf, zm_eu_idx, eu)
+ call pbuf_get_field(pbuf, zm_du_idx, du)
+ call pbuf_get_field(pbuf, zm_md_idx, md)
+ call pbuf_get_field(pbuf, zm_ed_idx, ed)
+ call pbuf_get_field(pbuf, zm_dp_idx, dp)
+ call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld)
+ call pbuf_get_field(pbuf, zm_jt_idx, jt)
+ call pbuf_get_field(pbuf, zm_maxg_idx, maxg)
+ call pbuf_get_field(pbuf, zm_ideep_idx, ideep)
+
+ call pbuf_get_field(pbuf, dlfzm_idx, dlf)
+ call pbuf_get_field(pbuf, difzm_idx, dif)
+
+ if (zmconv_microp) then
+ call pbuf_get_field(pbuf, dnlfzm_idx, dnlf)
+ call pbuf_get_field(pbuf, dnifzm_idx, dnif)
+ else
+ allocate(dnlf(pcols,pver), dnif(pcols,pver))
+ end if
+
+ if (zmconv_microp) then
+
+ if (nmodes > 0) then
+
+ ! Associate pointers with the modes and species that affect the climate
+ ! (list 0)
+
+ do m = 1, nmodes
+ call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, aero(lchnk)%num_a(m)%val)
+ call pbuf_get_field(pbuf, dgnum_idx, aero(lchnk)%dgnum(m)%val, start=(/1,1,m/), kount=(/pcols,pver,1/))
+
+ do l = 1, aero(lchnk)%nspec(m)
+ call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, aero(lchnk)%mmr_a(l,m)%val)
+ end do
+ end do
+
+ else if (nbulk > 0) then
+
+ ! Associate pointers with the bulk aerosols that affect the climate
+ ! (list 0)
+
+ do m = 1, nbulk
+ call rad_cnst_get_aer_mmr(0, m, state, pbuf, aero(lchnk)%mmr_bulk(m)%val)
+ end do
+
+ end if
+ end if
+
+!
+! Begin with Zhang-McFarlane (1996) convection parameterization
+!
+ call t_startf ('zm_convr')
+
+ if (zmconv_org) then
+ allocate(zm_org2d(pcols,pver))
+ org => state%q(:,:,ixorg)
+ orgt => ptend_loc%q(:,:,ixorg)
+ endif
+
+ call zm_convr( lchnk ,ncol , &
+ state%t ,state%q(:,:,1), prec ,jctop ,jcbot , &
+ pblh ,state%zm ,state%phis ,state%zi ,ptend_loc%q(:,:,1) , &
+ ptend_loc%s , state%pmid ,state%pint ,state%pdel , &
+! .5_r8*ztodt ,mcon ,cme , cape, &
+ .5_r8*ztodt ,mcon ,cme , cape, eurt,& !+tht eurt
+ tpert ,dlf ,pflx ,zdu ,rprd , &
+ mu, md, du, eu, ed, &
+! dp, dsubcld, jt, maxg, ideep, &
+ dp, dsubcld, jt, maxg, ideep, lengath, &
+ ql, rliq, landfrac, &
+ org, orgt, zm_org2d, &
+ dif, dnlf, dnif, conv, &
+ aero(lchnk), rice)
+
+! lengath = count(ideep > 0)
+
+ call outfld('CAPE', cape, pcols, lchnk) ! RBN - CAPE output
+
+ !call outfld('EURT', eurt, pcols, lchnk) !+tht: entr.rate 2D
+ call outfld('EURT', eurt(1,1), pcols, lchnk) !+tht: entr.rate 3D
+
+!
+! Output fractional occurance of ZM convection
+!
+ freqzm(:) = 0._r8
+ do i = 1,lengath
+ freqzm(ideep(i)) = 1.0_r8
+ end do
+ call outfld('FREQZM ',freqzm ,pcols ,lchnk )
+!
+! Convert mass flux from reported mb/s to kg/m^2/s
+!
+ mcon(:ncol,:pver) = mcon(:ncol,:pver) * 100._r8/gravit
+
+ call outfld('CMFMCDZM', mcon, pcols, lchnk)
+
+ ! Store upward and downward mass fluxes in un-gathered arrays
+ ! + convert from mb/s to kg/m^2/s
+ do i=1,lengath
+ do k=1,pver
+ ii = ideep(i)
+ mu_out(ii,k) = mu(i,k) * 100._r8/gravit
+ md_out(ii,k) = md(i,k) * 100._r8/gravit
+ end do
+ end do
+
+ call outfld('ZMMU', mu_out, pcols, lchnk)
+ call outfld('ZMMD', md_out, pcols, lchnk)
+
+ ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair
+ call outfld('ZMDT ',ftem ,pcols ,lchnk )
+ call outfld('ZMDQ ',ptend_loc%q(1,1,1) ,pcols ,lchnk )
+ call t_stopf ('zm_convr')
+
+ call outfld('DIFZM' ,dif ,pcols, lchnk)
+ call outfld('DLFZM' ,dlf ,pcols, lchnk)
+
+ if (zmconv_microp) call zm_conv_micro_outfld(conv, dnif, dnlf, lchnk, ncol)
+
+ pcont(:ncol) = state%ps(:ncol)
+ pconb(:ncol) = state%ps(:ncol)
+ do i = 1,lengath
+ if (maxg(i).gt.jt(i)) then
+ pcont(ideep(i)) = state%pmid(ideep(i),jt(i)) ! gathered array (or jctop ungathered)
+ pconb(ideep(i)) = state%pmid(ideep(i),maxg(i))! gathered array
+ endif
+ ! write(iulog,*) ' pcont, pconb ', pcont(i), pconb(i), cnt(i), cnb(i)
+ end do
+ call outfld('PCONVT ',pcont ,pcols ,lchnk )
+ call outfld('PCONVB ',pconb ,pcols ,lchnk )
+
+ call physics_ptend_init(ptend_all, state%psetcols, 'zm_conv_tend')
+
+ ! add tendency from this process to tendencies from other processes
+ call physics_ptend_sum(ptend_loc,ptend_all, ncol)
+
+ ! update physics state type state1 with ptend_loc
+ call physics_update(state1, ptend_loc, ztodt)
+
+ ! initialize ptend for next process
+ lq(:) = .FALSE.
+ lq(1) = .TRUE.
+ if (zmconv_org) then
+ lq(ixorg) = .TRUE.
+ endif
+ call physics_ptend_init(ptend_loc, state1%psetcols, 'zm_conv_evap', ls=.true., lq=lq)
+
+ call t_startf ('zm_conv_evap')
+!
+! Determine the phase of the precipitation produced and add latent heat of fusion
+! Evaporate some of the precip directly into the environment (Sundqvist)
+! Allow this to use the updated state1 and the fresh ptend_loc type
+! heating and specific humidity tendencies produced
+!
+
+ call pbuf_get_field(pbuf, dp_flxprc_idx, flxprec )
+ call pbuf_get_field(pbuf, dp_flxsnw_idx, flxsnow )
+ call pbuf_get_field(pbuf, dp_cldliq_idx, dp_cldliq )
+ call pbuf_get_field(pbuf, dp_cldice_idx, dp_cldice )
+ dp_cldliq(:ncol,:) = 0._r8
+ dp_cldice(:ncol,:) = 0._r8
+
+ call zm_conv_evap(state1%ncol,state1%lchnk, &
+ state1%t,state1%pmid,state1%pdel,state1%q(:pcols,:pver,1), &
+ landfrac, &
+ ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, ptend_loc%q(:pcols,:pver,1), &
+ rprd, cld, ztodt, &
+ prec, snow, ntprprd, ntsnprd , flxprec, flxsnow, conv%sprd)
+
+ evapcdp(:ncol,:pver) = ptend_loc%q(:ncol,:pver,1)
+
+ if (zmconv_org) then
+ ptend_loc%q(:ncol,:pver,ixorg) = min(1._r8,max(0._r8,(50._r8*1000._r8*1000._r8*abs(evapcdp(:ncol,:pver))) &
+ -(state%q(:ncol,:pver,ixorg)/10800._r8)))
+ ptend_loc%q(:ncol,:pver,ixorg) = (ptend_loc%q(:ncol,:pver,ixorg) - state%q(:ncol,:pver,ixorg))/ztodt
+ endif
+
+!
+! Write out variables from zm_conv_evap
+!
+ ftem(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair
+ call outfld('EVAPTZM ',ftem ,pcols ,lchnk )
+ ftem(:ncol,:pver) = tend_s_snwprd (:ncol,:pver)/cpair
+ call outfld('FZSNTZM ',ftem ,pcols ,lchnk )
+ ftem(:ncol,:pver) = tend_s_snwevmlt(:ncol,:pver)/cpair
+ call outfld('EVSNTZM ',ftem ,pcols ,lchnk )
+ call outfld('EVAPQZM ',ptend_loc%q(1,1,1) ,pcols ,lchnk )
+ call outfld('ZMFLXPRC', flxprec, pcols, lchnk)
+ call outfld('ZMFLXSNW', flxsnow, pcols, lchnk)
+ call outfld('ZMNTPRPD', ntprprd, pcols, lchnk)
+ call outfld('ZMNTSNPD', ntsnprd, pcols, lchnk)
+ call outfld('ZMEIHEAT', ptend_loc%s, pcols, lchnk)
+ call outfld('CMFMCDZM ',mcon , pcols ,lchnk )
+ call outfld('PRECCDZM ',prec, pcols ,lchnk )
+
+
+ call t_stopf ('zm_conv_evap')
+
+ call outfld('PRECZ ', prec , pcols, lchnk)
+
+ ! add tendency from this process to tend from other processes here
+ call physics_ptend_sum(ptend_loc,ptend_all, ncol)
+
+ ! update physics state type state1 with ptend_loc
+ call physics_update(state1, ptend_loc, ztodt)
+
+
+ ! Momentum Transport (non-cam3 physics)
+
+ if ( .not. cam_physpkg_is('cam3')) then
+
+ call physics_ptend_init(ptend_loc, state1%psetcols, 'momtran', ls=.true., lu=.true., lv=.true.)
+
+ winds(:ncol,:pver,1) = state1%u(:ncol,:pver)
+ winds(:ncol,:pver,2) = state1%v(:ncol,:pver)
+
+ l_windt(1) = .true.
+ l_windt(2) = .true.
+
+ call t_startf ('momtran')
+ call momtran (lchnk, ncol, &
+ l_windt,winds, 2, mu, md, &
+ du, eu, ed, dp, dsubcld, &
+ jt, maxg, ideep, 1, lengath, &
+ nstep, wind_tends, pguall, pgdall, icwu, icwd, ztodt, seten )
+ call t_stopf ('momtran')
+
+ ptend_loc%u(:ncol,:pver) = wind_tends(:ncol,:pver,1)
+ ptend_loc%v(:ncol,:pver) = wind_tends(:ncol,:pver,2)
+ ptend_loc%s(:ncol,:pver) = seten(:ncol,:pver)
+
+ call physics_ptend_sum(ptend_loc,ptend_all, ncol)
+
+ ! update physics state type state1 with ptend_loc
+ call physics_update(state1, ptend_loc, ztodt)
+
+ ftem(:ncol,:pver) = seten(:ncol,:pver)/cpair
+ if (zmconv_org) then
+ call outfld('ZM_ORG', state%q(:,:,ixorg), pcols, lchnk)
+ call outfld('ZM_ORG2D', zm_org2d, pcols, lchnk)
+ endif
+ call outfld('ZMMTT', ftem , pcols, lchnk)
+ call outfld('ZMMTU', wind_tends(1,1,1), pcols, lchnk)
+ call outfld('ZMMTV', wind_tends(1,1,2), pcols, lchnk)
+
+ ! Output apparent force from pressure gradient
+ call outfld('ZMUPGU', pguall(1,1,1), pcols, lchnk)
+ call outfld('ZMUPGD', pgdall(1,1,1), pcols, lchnk)
+ call outfld('ZMVPGU', pguall(1,1,2), pcols, lchnk)
+ call outfld('ZMVPGD', pgdall(1,1,2), pcols, lchnk)
+
+ ! Output in-cloud winds
+ call outfld('ZMICUU', icwu(1,1,1), pcols, lchnk)
+ call outfld('ZMICUD', icwd(1,1,1), pcols, lchnk)
+ call outfld('ZMICVU', icwu(1,1,2), pcols, lchnk)
+ call outfld('ZMICVD', icwd(1,1,2), pcols, lchnk)
+
+ end if
+
+ ! Transport cloud water and ice only
+ call cnst_get_ind('CLDLIQ', ixcldliq)
+ call cnst_get_ind('CLDICE', ixcldice)
+
+ lq(:) = .FALSE.
+ lq(2:) = cnst_is_convtran1(2:)
+ call physics_ptend_init(ptend_loc, state1%psetcols, 'convtran1', lq=lq)
+
+
+ ! dpdry is not used in this call to convtran since the cloud liquid and ice mixing
+ ! ratios are moist
+ fake_dpdry(:,:) = 0._r8
+
+ call t_startf ('convtran1')
+ call convtran (lchnk, &
+ ptend_loc%lq,state1%q, pcnst, mu, md, &
+ du, eu, ed, dp, dsubcld, &
+ jt,maxg, ideep, 1, lengath, &
+ nstep, fracis, ptend_loc%q, fake_dpdry, ztodt)
+ call t_stopf ('convtran1')
+
+ call outfld('ZMDICE ',ptend_loc%q(1,1,ixcldice) ,pcols ,lchnk )
+ call outfld('ZMDLIQ ',ptend_loc%q(1,1,ixcldliq) ,pcols ,lchnk )
+
+ ! add tendency from this process to tend from other processes here
+ call physics_ptend_sum(ptend_loc,ptend_all, ncol)
+
+ call physics_state_dealloc(state1)
+ call physics_ptend_dealloc(ptend_loc)
+
+ if (zmconv_org) then
+ deallocate(zm_org2d)
+ end if
+
+ if (zmconv_microp) then
+ deallocate( &
+ conv%qi, &
+ conv%qliq, &
+ conv%qice, &
+ conv%wu, &
+ conv%sprd, &
+ conv%qrain, &
+ conv%qsnow, &
+ conv%qnl, &
+ conv%qni, &
+ conv%qnr, &
+ conv%qns, &
+ conv%frz, &
+ conv%autolm, &
+ conv%accrlm, &
+ conv%bergnm, &
+ conv%fhtimm, &
+ conv%fhtctm, &
+ conv%fhmlm , &
+ conv%hmpim , &
+ conv%accslm, &
+ conv%dlfm , &
+ conv%autoln, &
+ conv%accrln, &
+ conv%bergnn, &
+ conv%fhtimn, &
+ conv%fhtctn, &
+ conv%fhmln , &
+ conv%accsln, &
+ conv%activn, &
+ conv%dlfn , &
+ conv%autoim, &
+ conv%accsim, &
+ conv%difm , &
+ conv%nuclin, &
+ conv%autoin, &
+ conv%accsin, &
+ conv%hmpin , &
+ conv%difn , &
+ conv%cmel , &
+ conv%cmei , &
+ conv%trspcm, &
+ conv%trspcn, &
+ conv%trspim, &
+ conv%trspin, &
+ conv%lambdadpcu, &
+ conv%mudpcu, &
+ conv%dcape )
+
+ else
+
+ deallocate(dnlf, dnif)
+
+ end if
+
+end subroutine zm_conv_tend
+!=========================================================================================
+
+
+subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf)
+
+ use physics_types, only: physics_state, physics_ptend, physics_ptend_init
+ use time_manager, only: get_nstep
+ use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc
+ use constituents, only: pcnst, cnst_is_convtran2
+
+! Arguments
+ type(physics_state), intent(in ) :: state ! Physics state variables
+ type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ real(r8), intent(in) :: ztodt ! 2 delta t (model time increment)
+
+! Local variables
+ integer :: i, lchnk, istat
+ integer :: lengath ! number of columns with deep convection
+ integer :: nstep
+
+ real(r8), dimension(pcols,pver) :: dpdry
+
+ ! physics buffer fields
+ real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble
+ real(r8), pointer :: mu(:,:) ! (pcols,pver)
+ real(r8), pointer :: eu(:,:) ! (pcols,pver)
+ real(r8), pointer :: du(:,:) ! (pcols,pver)
+ real(r8), pointer :: md(:,:) ! (pcols,pver)
+ real(r8), pointer :: ed(:,:) ! (pcols,pver)
+ real(r8), pointer :: dp(:,:) ! (pcols,pver)
+ real(r8), pointer :: dsubcld(:) ! (pcols)
+ integer, pointer :: jt(:) ! (pcols)
+ integer, pointer :: maxg(:) ! (pcols)
+ integer, pointer :: ideep(:) ! (pcols)
+ !-----------------------------------------------------------------------------------
+
+
+ call physics_ptend_init(ptend, state%psetcols, 'convtran2', lq=cnst_is_convtran2 )
+
+ call pbuf_get_field(pbuf, fracis_idx, fracis)
+ call pbuf_get_field(pbuf, zm_mu_idx, mu)
+ call pbuf_get_field(pbuf, zm_eu_idx, eu)
+ call pbuf_get_field(pbuf, zm_du_idx, du)
+ call pbuf_get_field(pbuf, zm_md_idx, md)
+ call pbuf_get_field(pbuf, zm_ed_idx, ed)
+ call pbuf_get_field(pbuf, zm_dp_idx, dp)
+ call pbuf_get_field(pbuf, zm_dsubcld_idx, dsubcld)
+ call pbuf_get_field(pbuf, zm_jt_idx, jt)
+ call pbuf_get_field(pbuf, zm_maxg_idx, maxg)
+ call pbuf_get_field(pbuf, zm_ideep_idx, ideep)
+
+ lengath = count(ideep > 0)
+
+ lchnk = state%lchnk
+ nstep = get_nstep()
+
+ if (any(ptend%lq(:))) then
+ ! initialize dpdry for call to convtran
+ ! it is used for tracers of dry mixing ratio type
+ dpdry = 0._r8
+ do i = 1, lengath
+ dpdry(i,:) = state%pdeldry(ideep(i),:)/100._r8
+ end do
+
+ call t_startf ('convtran2')
+ call convtran (lchnk, &
+ ptend%lq,state%q, pcnst, mu, md, &
+ du, eu, ed, dp, dsubcld, &
+ jt, maxg, ideep, 1, lengath, &
+ nstep, fracis, ptend%q, dpdry, ztodt)
+ call t_stopf ('convtran2')
+ end if
+
+end subroutine zm_conv_tend_2
+
+!=========================================================================================
+
+subroutine zm_conv_micro_init()
+
+ use cam_history, only: addfld, add_default, horiz_only
+ use ppgrid, only: pcols, pver
+ use pmgrid, only: plev,plevp
+ use phys_control, only: cam_physpkg_is
+ use physics_buffer, only: pbuf_get_index
+ use zm_microphysics, only: zm_mphyi
+
+ implicit none
+
+ integer :: i
+
+ !
+ ! Register fields with the output buffer
+ !
+ call addfld ('ICIMRDP', (/ 'lev' /), 'A','kg/kg', 'Deep Convection in-cloud ice mixing ratio ')
+ call addfld ('CLDLIQZM',(/ 'lev' /), 'A','g/m3' ,'Cloud liquid water - ZM convection')
+ call addfld ('CLDICEZM',(/ 'lev' /), 'A','g/m3' ,'Cloud ice water - ZM convection')
+ call addfld ('CLIQSNUM',(/ 'lev' /), 'A','1' ,'Cloud liquid water sample number - ZM convection')
+ call addfld ('CICESNUM',(/ 'lev' /), 'A','1' ,'Cloud ice water sample number - ZM convection')
+ call addfld ('QRAINZM' ,(/ 'lev' /), 'A','g/m3' ,'rain water - ZM convection')
+ call addfld ('QSNOWZM' ,(/ 'lev' /), 'A','g/m3' ,'snow - ZM convection')
+ call addfld ('CRAINNUM',(/ 'lev' /), 'A','1' ,'Cloud rain water sample number - ZM convection')
+ call addfld ('CSNOWNUM',(/ 'lev' /), 'A','1' ,'Cloud snow sample number - ZM convection')
+
+ call addfld ('DNIFZM' ,(/ 'lev' /), 'A','1/kg/s ' ,'Detrained ice water num concen from ZM convection')
+ call addfld ('DNLFZM' ,(/ 'lev' /), 'A','1/kg/s ' ,'Detrained liquid water num concen from ZM convection')
+ call addfld ('WUZM' ,(/ 'lev' /), 'A','m/s' ,'vertical velocity - ZM convection')
+ call addfld ('WUZMSNUM',(/ 'lev' /), 'A','1' ,'vertical velocity sample number - ZM convection')
+
+ call addfld ('QNLZM',(/ 'lev' /), 'A','1/m3' ,'Cloud liquid water number concen - ZM convection')
+ call addfld ('QNIZM',(/ 'lev' /), 'A','1/m3' ,'Cloud ice number concen - ZM convection')
+ call addfld ('QNRZM',(/ 'lev' /), 'A','1/m3' ,'Cloud rain water number concen - ZM convection')
+ call addfld ('QNSZM',(/ 'lev' /), 'A','1/m3' ,'Cloud snow number concen - ZM convection')
+
+ call addfld ('FRZZM',(/ 'lev' /), 'A','1/s' ,'mass tendency due to freezing - ZM convection')
+
+ call addfld ('AUTOL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to autoconversion of droplets to rain')
+ call addfld ('ACCRL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of droplets by rain')
+ call addfld ('BERGN_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to Bergeron process')
+ call addfld ('FHTIM_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to immersion freezing')
+ call addfld ('FHTCT_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to contact freezing')
+ call addfld ('FHML_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to homogeneous freezing of droplet')
+ call addfld ('HMPI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to HM process')
+ call addfld ('ACCSL_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of droplet by snow')
+ call addfld ('DLF_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to detrainment of droplet')
+ call addfld ('COND_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to condensation')
+
+ call addfld ('AUTOL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to autoconversion of droplets to rain')
+ call addfld ('ACCRL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of droplets by rain')
+ call addfld ('BERGN_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to Bergeron process')
+ call addfld ('FHTIM_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to immersion freezing')
+ call addfld ('FHTCT_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to contact freezing')
+ call addfld ('FHML_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to homogeneous freezing of droplet')
+ call addfld ('ACCSL_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of droplet by snow')
+ call addfld ('ACTIV_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to droplets activation')
+ call addfld ('DLF_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to detrainment of droplet')
+
+ call addfld ('AUTOI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to autoconversion of ice to snow')
+ call addfld ('ACCSI_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to accretion of ice by snow')
+ call addfld ('DIF_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to detrainment of cloud ice')
+ call addfld ('DEPOS_M' ,(/ 'lev' /), 'A','kg/kg/m' ,'mass tendency due to deposition')
+
+ call addfld ('NUCLI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to ice nucleation')
+ call addfld ('AUTOI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to autoconversion of ice to snow')
+ call addfld ('ACCSI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to accretion of ice by snow')
+ call addfld ('HMPI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to HM process')
+ call addfld ('DIF_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency due to detrainment of cloud ice')
+
+ call addfld ('TRSPC_M' ,(/ 'lev' /), 'A','kg/kg/m','mass tendency of droplets due to convective transport')
+ call addfld ('TRSPC_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency of droplets due to convective transport')
+ call addfld ('TRSPI_M' ,(/ 'lev' /), 'A','kg/kg/m','mass tendency of ice crystal due to convective transport')
+ call addfld ('TRSPI_N' ,(/ 'lev' /), 'A','1/kg/m' ,'num tendency of ice crystal due to convective transport')
+
+
+ call add_default ('CLDLIQZM', 1, ' ')
+ call add_default ('CLDICEZM', 1, ' ')
+ call add_default ('CLIQSNUM', 1, ' ')
+ call add_default ('CICESNUM', 1, ' ')
+ call add_default ('DNIFZM', 1, ' ')
+ call add_default ('DNLFZM', 1, ' ')
+ call add_default ('WUZM', 1, ' ')
+ call add_default ('QRAINZM', 1, ' ')
+ call add_default ('QSNOWZM', 1, ' ')
+ call add_default ('CRAINNUM', 1, ' ')
+ call add_default ('CSNOWNUM', 1, ' ')
+ call add_default ('QNLZM', 1, ' ')
+ call add_default ('QNIZM', 1, ' ')
+ call add_default ('QNRZM', 1, ' ')
+ call add_default ('QNSZM', 1, ' ')
+ call add_default ('FRZZM', 1, ' ')
+
+ ! Initialization for the microphysics
+
+ call zm_mphyi()
+
+ ! Initialize the aerosol object with data from the modes/species
+ ! affecting climate,
+ ! i.e., the list index is hardcoded to 0.
+
+ call rad_cnst_get_info(0, nmodes=nmodes, naero=nbulk)
+
+
+ do i = begchunk, endchunk
+ call zm_aero_init(nmodes, nbulk, aero(i))
+ end do
+
+ if (nmodes > 0) then
+
+ dgnum_idx = pbuf_get_index('DGNUM')
+
+ else if (nbulk > 0 .and. cam_physpkg_is('cam4')) then
+
+ ! This call is needed to allow running the ZM microphysics with the
+ ! cam4 physics package.
+ call ndrop_bam_init()
+
+ end if
+
+ end subroutine zm_conv_micro_init
+
+
+ subroutine zm_aero_init(nmodes, nbulk, aero)
+
+ use pmgrid, only: plev,plevp
+
+ ! Initialize the zm_aero_t object for modal aerosols
+
+ integer, intent(in) :: nmodes
+ integer, intent(in) :: nbulk
+ type(zm_aero_t), intent(out) :: aero
+
+ integer :: iaer, l, m
+ integer :: nspecmx ! max number of species in a mode
+
+ character(len=20), allocatable :: aername(:)
+ character(len=32) :: str32
+ character(len=*), parameter :: routine = 'zm_conv_init'
+
+ real(r8) :: sigmag, dgnumlo, dgnumhi
+ real(r8) :: alnsg
+ !----------------------------------------------------------------------------------
+
+ aero%nmodes = nmodes
+ aero%nbulk = nbulk
+
+ if (nmodes > 0) then
+
+ ! Initialize the modal aerosol information
+
+ aero%scheme = 'modal'
+
+ ! Get number of species in each mode, and find max.
+ allocate(aero%nspec(aero%nmodes))
+ nspecmx = 0
+ do m = 1, aero%nmodes
+
+ call rad_cnst_get_info(0, m, nspec=aero%nspec(m), mode_type=str32)
+
+ nspecmx = max(nspecmx, aero%nspec(m))
+
+ ! save mode index for specified mode types
+ select case (trim(str32))
+ case ('accum')
+ aero%mode_accum_idx = m
+ case ('aitken')
+ aero%mode_aitken_idx = m
+ case ('coarse')
+ aero%mode_coarse_idx = m
+ end select
+
+ end do
+
+ ! Check that required mode types were found
+ if (aero%mode_accum_idx == -1 .or. aero%mode_aitken_idx == -1 .or. aero%mode_coarse_idx == -1) then
+ write(iulog,*) routine//': ERROR required mode type not found - mode idx:', &
+ aero%mode_accum_idx, aero%mode_aitken_idx, aero%mode_coarse_idx
+ call endrun(routine//': ERROR required mode type not found')
+ end if
+
+ ! find indices for the dust and seasalt species in the coarse mode
+ do l = 1, aero%nspec(aero%mode_coarse_idx)
+ call rad_cnst_get_info(0, aero%mode_coarse_idx, l, spec_type=str32)
+ select case (trim(str32))
+ case ('dust')
+ aero%coarse_dust_idx = l
+ case ('seasalt')
+ aero%coarse_nacl_idx = l
+ end select
+ end do
+ ! Check that required modal specie types were found
+ if (aero%coarse_dust_idx == -1 .or. aero%coarse_nacl_idx == -1) then
+ write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', &
+ aero%coarse_dust_idx, aero%coarse_nacl_idx
+ call endrun(routine//': ERROR required mode-species type not found')
+ end if
+
+ allocate( &
+ aero%num_a(nmodes), &
+ aero%mmr_a(nspecmx,nmodes), &
+ aero%numg_a(pcols,pver,nmodes), &
+ aero%mmrg_a(pcols,pver,nspecmx,nmodes), &
+ aero%voltonumblo(nmodes), &
+ aero%voltonumbhi(nmodes), &
+ aero%specdens(nspecmx,nmodes), &
+ aero%spechygro(nspecmx,nmodes), &
+ aero%dgnum(nmodes), &
+ aero%dgnumg(pcols,pver,nmodes) )
+
+
+ do m = 1, nmodes
+
+ ! Properties of modes
+ call rad_cnst_get_mode_props(0, m, &
+ sigmag=sigmag, dgnumlo=dgnumlo, dgnumhi=dgnumhi)
+
+ alnsg = log(sigmag)
+ aero%voltonumblo(m) = 1._r8 / ( (pi/6._r8)*(dgnumlo**3._r8)*exp(4.5_r8*alnsg**2._r8) )
+ aero%voltonumbhi(m) = 1._r8 / ( (pi/6._r8)*(dgnumhi**3._r8)*exp(4.5_r8*alnsg**2._r8) )
+
+ ! save sigmag of aitken mode
+ if (m == aero%mode_aitken_idx) aero%sigmag_aitken = sigmag
+
+ ! Properties of modal species
+ do l = 1, aero%nspec(m)
+ call rad_cnst_get_aer_props(0, m, l, density_aer=aero%specdens(l,m), &
+ hygro_aer=aero%spechygro(l,m))
+ end do
+ end do
+
+ else if (nbulk > 0) then
+
+ aero%scheme = 'bulk'
+
+ ! Props needed for BAM number concentration calcs.
+ allocate( &
+ aername(nbulk), &
+ aero%num_to_mass_aer(nbulk), &
+ aero%mmr_bulk(nbulk), &
+ aero%mmrg_bulk(pcols,plev,nbulk) )
+
+ do iaer = 1, aero%nbulk
+ call rad_cnst_get_aer_props(0, iaer, &
+ aername = aername(iaer), &
+ num_to_mass_aer = aero%num_to_mass_aer(iaer) )
+
+ ! Look for sulfate aerosol in this list (Bulk aerosol only)
+ if (trim(aername(iaer)) == 'SULFATE') aero%idxsul = iaer
+ if (trim(aername(iaer)) == 'DUST1') aero%idxdst1 = iaer
+ if (trim(aername(iaer)) == 'DUST2') aero%idxdst2 = iaer
+ if (trim(aername(iaer)) == 'DUST3') aero%idxdst3 = iaer
+ if (trim(aername(iaer)) == 'DUST4') aero%idxdst4 = iaer
+ if (trim(aername(iaer)) == 'BCPHI') aero%idxbcphi = iaer
+ end do
+
+ end if
+
+ end subroutine zm_aero_init
+
+ subroutine zm_conv_micro_outfld(conv, dnif, dnlf, lchnk, ncol)
+
+ use cam_history, only: outfld
+
+ type(zm_conv_t),intent(in) :: conv
+ real(r8), intent(in) :: dnlf(:,:) ! detrained convective cloud water num concen.
+ real(r8), intent(in) :: dnif(:,:) ! detrained convective cloud ice num concen.
+ integer, intent(in) :: lchnk
+ integer, intent(in) :: ncol
+
+ integer :: i,k
+
+ real(r8) :: cice_snum(pcols,pver) ! convective cloud ice sample number.
+ real(r8) :: cliq_snum(pcols,pver) ! convective cloud liquid sample number.
+ real(r8) :: crain_snum(pcols,pver) ! convective rain water sample number.
+ real(r8) :: csnow_snum(pcols,pver) ! convective snow sample number.
+ real(r8) :: wu_snum(pcols,pver) ! vertical velocity sample number
+
+ real(r8) :: qni_snum(pcols,pver) ! convective cloud ice number sample number.
+ real(r8) :: qnl_snum(pcols,pver) ! convective cloud liquid number sample number.
+
+ do k = 1,pver
+ do i = 1,ncol
+ if (conv%qice(i,k) .gt. 0.0_r8) then
+ cice_snum(i,k) = 1.0_r8
+ else
+ cice_snum(i,k) = 0.0_r8
+ end if
+ if (conv%qliq(i,k) .gt. 0.0_r8) then
+ cliq_snum(i,k) = 1.0_r8
+ else
+ cliq_snum(i,k) = 0.0_r8
+ end if
+ if (conv%qsnow(i,k) .gt. 0.0_r8) then
+ csnow_snum(i,k) = 1.0_r8
+ else
+ csnow_snum(i,k) = 0.0_r8
+ end if
+ if (conv%qrain(i,k) .gt. 0.0_r8) then
+ crain_snum(i,k) = 1.0_r8
+ else
+ crain_snum(i,k) = 0.0_r8
+ end if
+
+ if (conv%qnl(i,k) .gt. 0.0_r8) then
+ qnl_snum(i,k) = 1.0_r8
+ else
+ qnl_snum(i,k) = 0.0_r8
+ end if
+ if (conv%qni(i,k) .gt. 0.0_r8) then
+ qni_snum(i,k) = 1.0_r8
+ else
+ qni_snum(i,k) = 0.0_r8
+ end if
+ if (conv%wu(i,k) .gt. 0.0_r8) then
+ wu_snum(i,k) = 1.0_r8
+ else
+ wu_snum(i,k) = 0.0_r8
+ end if
+
+ end do
+ end do
+
+ call outfld('ICIMRDP ',conv%qi ,pcols, lchnk )
+ call outfld('CLDLIQZM',conv%qliq ,pcols, lchnk)
+ call outfld('CLDICEZM',conv%qice ,pcols, lchnk)
+ call outfld('CLIQSNUM',cliq_snum ,pcols, lchnk)
+ call outfld('CICESNUM',cice_snum ,pcols, lchnk)
+ call outfld('QRAINZM' ,conv%qrain ,pcols, lchnk)
+ call outfld('QSNOWZM' ,conv%qsnow ,pcols, lchnk)
+ call outfld('CRAINNUM',crain_snum ,pcols, lchnk)
+ call outfld('CSNOWNUM',csnow_snum ,pcols, lchnk)
+
+ call outfld('WUZM' ,conv%wu ,pcols, lchnk)
+ call outfld('WUZMSNUM',wu_snum ,pcols, lchnk)
+ call outfld('QNLZM' ,conv%qnl ,pcols, lchnk)
+ call outfld('QNIZM' ,conv%qni ,pcols, lchnk)
+ call outfld('QNRZM' ,conv%qnr ,pcols, lchnk)
+ call outfld('QNSZM' ,conv%qns ,pcols, lchnk)
+ call outfld('FRZZM' ,conv%frz ,pcols, lchnk)
+
+ call outfld('AUTOL_M' ,conv%autolm ,pcols, lchnk)
+ call outfld('ACCRL_M' ,conv%accrlm ,pcols, lchnk)
+ call outfld('BERGN_M' ,conv%bergnm ,pcols, lchnk)
+ call outfld('FHTIM_M' ,conv%fhtimm ,pcols, lchnk)
+ call outfld('FHTCT_M' ,conv%fhtctm ,pcols, lchnk)
+ call outfld('FHML_M' ,conv%fhmlm ,pcols, lchnk)
+ call outfld('HMPI_M' ,conv%hmpim ,pcols, lchnk)
+ call outfld('ACCSL_M' ,conv%accslm ,pcols, lchnk)
+ call outfld('DLF_M' ,conv%dlfm ,pcols, lchnk)
+
+ call outfld('AUTOL_N' ,conv%autoln ,pcols, lchnk)
+ call outfld('ACCRL_N' ,conv%accrln ,pcols, lchnk)
+ call outfld('BERGN_N' ,conv%bergnn ,pcols, lchnk)
+ call outfld('FHTIM_N' ,conv%fhtimn ,pcols, lchnk)
+ call outfld('FHTCT_N' ,conv%fhtctn ,pcols, lchnk)
+ call outfld('FHML_N' ,conv%fhmln ,pcols, lchnk)
+ call outfld('ACCSL_N' ,conv%accsln ,pcols, lchnk)
+ call outfld('ACTIV_N' ,conv%activn ,pcols, lchnk)
+ call outfld('DLF_N' ,conv%dlfn ,pcols, lchnk)
+ call outfld('AUTOI_M' ,conv%autoim ,pcols, lchnk)
+ call outfld('ACCSI_M' ,conv%accsim ,pcols, lchnk)
+ call outfld('DIF_M' ,conv%difm ,pcols, lchnk)
+ call outfld('NUCLI_N' ,conv%nuclin ,pcols, lchnk)
+ call outfld('AUTOI_N' ,conv%autoin ,pcols, lchnk)
+ call outfld('ACCSI_N' ,conv%accsin ,pcols, lchnk)
+ call outfld('HMPI_N' ,conv%hmpin ,pcols, lchnk)
+ call outfld('DIF_N' ,conv%difn ,pcols, lchnk)
+ call outfld('COND_M' ,conv%cmel ,pcols, lchnk)
+ call outfld('DEPOS_M' ,conv%cmei ,pcols, lchnk)
+
+ call outfld('TRSPC_M' ,conv%trspcm ,pcols, lchnk)
+ call outfld('TRSPC_N' ,conv%trspcn ,pcols, lchnk)
+ call outfld('TRSPI_M' ,conv%trspim ,pcols, lchnk)
+ call outfld('TRSPI_N' ,conv%trspin ,pcols, lchnk)
+ call outfld('DNIFZM' ,dnif ,pcols, lchnk)
+ call outfld('DNLFZM' ,dnlf ,pcols, lchnk)
+
+ end subroutine zm_conv_micro_outfld
+
+end module zm_conv_intr
diff --git a/src/chemistry/mozart/chemistry.F90 b/src/chemistry/mozart/chemistry.F90
index dc7db5eadd..2abdb3b88a 100644
--- a/src/chemistry/mozart/chemistry.F90
+++ b/src/chemistry/mozart/chemistry.F90
@@ -863,7 +863,7 @@ subroutine chem_init(phys_state, pbuf2d)
! Add chemical tendency of water vapor to water budget output
if ( history_budget ) then
- call add_default ('CT_H2O' , history_budget_histfile_num, ' ')
+ call add_default ('CT_H2O_GHG' , history_budget_histfile_num, ' ')
endif
!-----------------------------------------------------------------------
diff --git a/src/chemistry/mozart/mo_fstrat.F90 b/src/chemistry/mozart/mo_fstrat.F90
index 6e627c685f..75a0b5cbd3 100644
--- a/src/chemistry/mozart/mo_fstrat.F90
+++ b/src/chemistry/mozart/mo_fstrat.F90
@@ -456,7 +456,6 @@ subroutine set_fstrat_vals( vmr, pmid, pint, ltrop, calday, ncol,lchnk )
real(r8) :: pint_vals(2)
real(r8), allocatable :: table_ox(:)
logical :: found_trop
- integer :: lat
if (.not. any(has_fstrat(:))) return
@@ -556,7 +555,7 @@ subroutine set_fstrat_vals( vmr, pmid, pint, ltrop, calday, ncol,lchnk )
+ dels*(mr_ub(i,m,next,2:ub_nlevs-1,lchnk) &
- mr_ub(i,m,last,2:ub_nlevs-1,lchnk))
#ifdef UB_DEBUG
- write(iulog,*) 'set_fstrat_vals: table_ox @ lat = ',lat
+ write(iulog,*) 'set_fstrat_vals: table_ox @ i = ',i
write(iulog,'(1p5g15.7)') table_ox(:)
write(iulog,*) ' '
#endif
@@ -572,7 +571,7 @@ subroutine set_fstrat_vals( vmr, pmid, pint, ltrop, calday, ncol,lchnk )
#endif
call rebin( ub_nlevs-2, km, ub_plevse, pint(i,:km+1), table_ox, vmr(i,:km,map(m)) )
#ifdef UB_DEBUG
- write(iulog,*) 'set_fstrat_vals: ub o3 @ lat = ',lat
+ write(iulog,*) 'set_fstrat_vals: ub o3 @ i = ',i
write(iulog,'(1p5g15.7)') vmr(i,:km,map(m))
#endif
end do
@@ -631,7 +630,7 @@ subroutine set_fstrat_vals( vmr, pmid, pint, ltrop, calday, ncol,lchnk )
end do
#ifdef DEBUG
if( levrelax /= ltrop(i) ) then
- write(iulog,*) 'warning -- raised ubc: ',lat,i, &
+ write(iulog,*) 'warning -- raised ubc: ',i, &
ltrop(i)-1,nint(pmid(i,ltrop(i)-1)/100._r8),'mb -->', &
levrelax,nint(pmid(i,levrelax)/100._r8),'mb'
end if
@@ -815,7 +814,6 @@ subroutine set_fstrat_h2o( h2o, pmid, ltrop, calday, ncol, lchnk )
real(r8) :: delp(ncol,zlower)
real(r8) :: pint_vals(2)
logical :: found_trop
- integer :: lat
h2o_overwrite : if( h2o_ndx > 0 .and. table_h2o_ndx > 0 ) then
!--------------------------------------------------------
@@ -913,7 +911,7 @@ subroutine set_fstrat_h2o( h2o, pmid, ltrop, calday, ncol, lchnk )
end do
#ifdef DEBUG
if( levrelax /= ltrop(i) ) then
- write(iulog,*) 'warning -- raised ubc: ',lat,i, &
+ write(iulog,*) 'warning -- raised ubc: ',i, &
ltrop(i)-1,nint(pmid(i,ltrop(i)-1)/100._r8),'mb -->', &
levrelax,nint(pmid(i,levrelax)/100._r8),'mb'
end if
diff --git a/src/chemistry/mozart/mo_gas_phase_chemdr.F90 b/src/chemistry/mozart/mo_gas_phase_chemdr.F90
index afcb13da0e..71a380f16b 100644
--- a/src/chemistry/mozart/mo_gas_phase_chemdr.F90
+++ b/src/chemistry/mozart/mo_gas_phase_chemdr.F90
@@ -506,7 +506,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, &
! ... Calculate cosine of zenith angle
! then cast back to angle (radians)
!-----------------------------------------------------------------------
- call zenith( calday, rlats, rlons, zen_angle, ncol )
+ call zenith( calday, rlats, rlons, zen_angle, ncol , delt) !+tht delt
zen_angle(:) = acos( zen_angle(:) )
sza(:) = zen_angle(:) * rad2deg
diff --git a/src/chemistry/mozart/mo_photo.F90 b/src/chemistry/mozart/mo_photo.F90
index a953c2db74..d02570d5b0 100644
--- a/src/chemistry/mozart/mo_photo.F90
+++ b/src/chemistry/mozart/mo_photo.F90
@@ -567,11 +567,17 @@ subroutine photo_inti( xs_coef_file, xs_short_file, xs_long_file, rsf_file, &
end do
end if
#ifdef DEBUG
- write(iulog,*) '-----------------------------------'
- write(iulog,*) 'photo_inti: diagnostics'
- write(iulog,*) 'ki, delp = ',ki,delp
- write(iulog,*) 'pinterp,levs(ki-1:ki) = ',pinterp,levs(ki-1:ki)
- write(iulog,*) '-----------------------------------'
+ if (masterproc) then
+ write(iulog,*) '-----------------------------------'
+ write(iulog,*) 'photo_inti: diagnostics'
+ write(iulog,*) 'ki, delp = ',ki,delp
+ if (ki>1) then
+ write(iulog,*) 'pinterp,levs(ki-1:ki) = ',pinterp,levs(ki-1:ki)
+ else
+ write(iulog,*) 'pinterp,levs(ki) = ',pinterp,levs(ki)
+ end if
+ write(iulog,*) '-----------------------------------'
+ endif
#endif
end if
end if has_abs_columns
@@ -1080,8 +1086,10 @@ subroutine xactive_photo( photos, vmr, temper, cwat, cldfr, &
ncdate = yr*10000 + mon*100 + day
ut = real(tod)/3600._r8
#ifdef DEBUG
- write(iulog,*) 'photo: nj = ',nlng
- write(iulog,*) 'photo: esfact = ',esfact
+ if (masterproc) then
+ write(iulog,*) 'photo: nj = ',nlng
+ write(iulog,*) 'photo: esfact = ',esfact
+ endif
#endif
col_loop : do i = 1,ncol
daylight : &
@@ -1700,10 +1708,12 @@ subroutine photo_timestep_init( calday )
dels = (calday - days(m)) / (days(m+1) - days(m))
end if
#ifdef DEBUG
- write(iulog,*) '-----------------------------------'
- write(iulog,*) 'photo_timestep_init: diagnostics'
- write(iulog,*) 'calday, last, next, dels = ',calday,last,next,dels
- write(iulog,*) '-----------------------------------'
+ if (masterproc) then
+ write(iulog,*) '-----------------------------------'
+ write(iulog,*) 'photo_timestep_init: diagnostics'
+ write(iulog,*) 'calday, last, next, dels = ',calday,last,next,dels
+ write(iulog,*) '-----------------------------------'
+ endif
#endif
end if
diff --git a/src/chemistry/mozart/mo_waccm_hrates.F90 b/src/chemistry/mozart/mo_waccm_hrates.F90
index 5e7b8a8405..50358e2c00 100644
--- a/src/chemistry/mozart/mo_waccm_hrates.F90
+++ b/src/chemistry/mozart/mo_waccm_hrates.F90
@@ -116,7 +116,7 @@ subroutine waccm_hrates(ncol, state, asdir, bot_mlt_lev, qrs_tot, pbuf )
use set_cp, only : calc_cp
use cam_history, only : outfld
use shr_orb_mod, only : shr_orb_decl
- use time_manager, only : get_curr_calday
+ use time_manager, only : get_curr_calday, get_step_size !+tht step_size
use cam_control_mod, only : lambm0, eccen, mvelpp, obliqr
use mo_constants, only : r2d
use short_lived_species,only: get_short_lived_species
@@ -195,6 +195,9 @@ subroutine waccm_hrates(ncol, state, asdir, bot_mlt_lev, qrs_tot, pbuf )
real(r8) :: delta ! solar declination (radians)
logical :: do_diag
+ integer :: dtime !+tht time step
+ real(r8) :: dtavg !+tht time step
+
real(r8), pointer :: ele_temp_fld(:,:) ! electron temperature pointer
real(r8), pointer :: ion_temp_fld(:,:) ! ion temperature pointer
@@ -239,7 +242,12 @@ subroutine waccm_hrates(ncol, state, asdir, bot_mlt_lev, qrs_tot, pbuf )
! ... calculate cosine of zenith angle then cast back to angle
!-----------------------------------------------------------------------
calday = get_curr_calday()
- call zenith( calday, rlats, rlons, zen_angle, ncol )
+!+tht
+ !call zenith( calday, rlats, rlons, zen_angle, ncol )
+ dtime=get_step_size()
+ dtavg=dtime
+ call zenith( calday, rlats, rlons, zen_angle, ncol ,dtavg)
+!-tht
zen_angle(:) = acos( zen_angle(:) )
!-----------------------------------------------------------------------
diff --git a/src/chemistry/oslo_aero/aero_model.F90 b/src/chemistry/oslo_aero/aero_model.F90
new file mode 100644
index 0000000000..7bdcff9fcb
--- /dev/null
+++ b/src/chemistry/oslo_aero/aero_model.F90
@@ -0,0 +1,1123 @@
+!===============================================================================
+! Modal Aerosol Model
+!===============================================================================
+module aero_model
+
+#include
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use constituents, only: pcnst, cnst_name, cnst_get_ind
+ use ppgrid, only: pcols, pver, pverp
+ use phys_control, only: phys_getopts, cam_physpkg_is
+ use cam_abortutils, only: endrun
+ use cam_logfile, only: iulog
+ use perf_mod, only: t_startf, t_stopf
+ use camsrfexch, only: cam_in_t, cam_out_t
+ use aerodep_flx, only: aerodep_flx_prescribed
+ use physics_types, only: physics_state, physics_ptend, physics_ptend_init
+ use physics_buffer, only: physics_buffer_desc
+ use physics_buffer, only: pbuf_get_field, pbuf_get_index, pbuf_set_field
+ use physconst, only: gravit, rair, rhoh2o
+ use spmd_utils, only: masterproc
+ use infnan, only: nan, assignment(=)
+
+ use cam_history, only: outfld, fieldname_len
+ use chem_mods, only: gas_pcnst, adv_mass
+ use mo_tracname, only: solsym
+ use aerosoldef, only: chemistryIndex, physicsIndex &
+ , getCloudTracerIndexDirect &
+ , getCloudTracerName
+ use condtend, only: N_COND_VAP, COND_VAP_ORG_SV, COND_VAP_ORG_LV, COND_VAP_H2SO4 &
+ , condtend_sub
+ use koagsub, only: coagtend, clcoag
+ use sox_cldaero_mod, only: sox_cldaero_init
+ !use modal_aero_data,only: cnst_name_cw, lptr_so4_cw_amode
+ !use modal_aero_data,only: ntot_amode, modename_amode, nspec_max
+
+ use ref_pres, only: top_lev => clim_modal_aero_top_lev
+
+ !use modal_aero_wateruptake, only: modal_strat_sulfate
+ use mo_setsox, only: setsox
+ use mo_mass_xforms, only: vmr2mmr, mmr2vmr, mmr2vmri
+
+ implicit none
+ private
+
+ public :: aero_model_readnl
+ public :: aero_model_register
+ public :: aero_model_init
+ public :: aero_model_gasaerexch ! create, grow, change, and shrink aerosols.
+ public :: aero_model_drydep ! aerosol dry deposition and sediment
+ public :: aero_model_wetdep ! aerosol wet removal
+ public :: aero_model_emissions ! aerosol emissions
+ public :: aero_model_surfarea ! tropopspheric aerosol wet surface area for chemistry
+ public :: aero_model_strat_surfarea ! stratospheric aerosol wet surface area for chemistry
+
+ ! Misc private data
+
+ ! number of modes
+ integer :: nmodes
+ integer :: pblh_idx = 0
+ integer :: dgnum_idx = 0
+ integer :: dgnumwet_idx = 0
+ integer :: rate1_cw2pr_st_idx = 0
+
+ integer :: wetdens_ap_idx = 0
+ integer :: qaerwat_idx = 0
+
+ integer :: fracis_idx = 0
+ integer :: prain_idx = 0
+ integer :: rprddp_idx = 0
+ integer :: rprdsh_idx = 0
+ integer :: nevapr_shcu_idx = 0
+ integer :: nevapr_dpcu_idx = 0
+
+ integer :: sulfeq_idx = -1
+
+ ! variables for table lookup of aerosol impaction/interception scavenging rates
+ integer, parameter :: nimptblgrow_mind=-7, nimptblgrow_maxd=12
+ real(r8) :: dlndg_nimptblgrow
+ real(r8),allocatable :: scavimptblnum(:,:)
+ real(r8),allocatable :: scavimptblvol(:,:)
+
+ ! for surf_area_dens
+ integer,allocatable :: num_idx(:)
+ integer,allocatable :: index_tot_mass(:,:)
+ integer,allocatable :: index_chm_mass(:,:)
+
+ integer :: ndx_h2so4, ndx_soa_lv, ndx_soa_sv
+
+ ! Namelist variables
+ character(len=16) :: wetdep_list(pcnst) = ' '
+ character(len=16) :: drydep_list(pcnst) = ' '
+ real(r8) :: sol_facti_cloud_borne = 1._r8
+ real(r8) :: sol_factb_interstitial = 0.1_r8
+ real(r8) :: sol_factic_interstitial = 0.4_r8
+ real(r8) :: seasalt_emis_scale
+
+ integer :: ndrydep = 0
+ integer,allocatable :: drydep_indices(:)
+ integer :: nwetdep = 0
+ integer,allocatable :: wetdep_indices(:)
+ logical :: drydep_lq(pcnst)
+ logical :: wetdep_lq(pcnst)
+
+
+ logical :: convproc_do_aer
+
+contains
+
+ !=============================================================================
+ ! reads aerosol namelist options
+ !=============================================================================
+ subroutine aero_model_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use mpishorthand
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'aero_model_readnl'
+
+ ! Namelist variables
+ character(len=16) :: aer_wetdep_list(pcnst) = ' '
+ character(len=16) :: aer_drydep_list(pcnst) = ' '
+
+ namelist /aerosol_nl/ aer_wetdep_list, aer_drydep_list, sol_facti_cloud_borne, &
+ sol_factb_interstitial, sol_factic_interstitial
+
+ !-----------------------------------------------------------------------------
+
+ ! Read namelist
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'aerosol_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, aerosol_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+ end if
+
+#ifdef SPMD
+ ! Broadcast namelist variables
+ call mpibcast(aer_wetdep_list, len(aer_wetdep_list(1))*pcnst, mpichar, 0, mpicom)
+ call mpibcast(aer_drydep_list, len(aer_drydep_list(1))*pcnst, mpichar, 0, mpicom)
+ call mpibcast(sol_facti_cloud_borne, 1, mpir8, 0, mpicom)
+ call mpibcast(sol_factb_interstitial, 1, mpir8, 0, mpicom)
+ call mpibcast(sol_factic_interstitial, 1, mpir8, 0, mpicom)
+ call mpibcast(seasalt_emis_scale, 1, mpir8, 0, mpicom)
+#endif
+
+ wetdep_list = aer_wetdep_list
+ drydep_list = aer_drydep_list
+
+ end subroutine aero_model_readnl
+
+ !=============================================================================
+ !=============================================================================
+ subroutine aero_model_register()
+ use aerosoldef, only: aero_register
+ use condtend, only: registerCondensation
+
+ call aero_register()
+ call registerCondensation()
+
+ end subroutine aero_model_register
+
+ !=============================================================================
+ !=============================================================================
+ subroutine aero_model_init( pbuf2d )
+
+ !use mo_chem_utls, only: get_inv_ndx
+ use cam_history, only: addfld, add_default, horiz_only
+ use mo_chem_utls, only: get_rxt_ndx, get_spc_ndx
+ !use modal_aero_data, only: cnst_name_cw
+ !use modal_aero_data, only: modal_aero_data_init
+ !use rad_constituents,only: rad_cnst_get_info
+ use dust_model, only: dust_init, dust_active
+ use seasalt_model, only: seasalt_init, seasalt_active
+ use drydep_mod, only: inidrydep
+ use wetdep, only: wetdep_init
+
+ use condtend, only: initializeCondensation
+ use oslo_ocean_intr, only: oslo_ocean_init
+ use oslo_aerosols_intr, only: oslo_aero_initialize
+
+ use opttab, only : initopt
+ use opttab_lw, only: initopt_lw
+
+ use modal_aero_deposition , only: modal_aero_deposition_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
+ !use modal_aero_gasaerexch, only: modal_aero_gasaerexch_init
+ !use modal_aero_newnuc, only: modal_aero_newnuc_init
+ !use modal_aero_rename, only: modal_aero_rename_init
+ !use modal_aero_convproc, only: ma_convproc_init
+
+ ! args
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ ! local vars
+ character(len=*), parameter :: subrname = 'aero_model_init'
+ integer :: m, n, id
+ character(len=20) :: dummy
+
+ logical :: history_aerosol ! Output MAM or SECT aerosol tendencies
+
+ integer :: l
+ character(len=6) :: test_name
+ character(len=64) :: errmes
+
+ character(len=2) :: unit_basename ! Units 'kg' or '1'
+ integer :: errcode
+ character(len=fieldname_len) :: field_name
+
+ character(len=32) :: spec_name
+ character(len=32) :: spec_type
+ character(len=32) :: mode_type
+ integer :: nspec
+
+ call phys_getopts(history_aerosol_out = history_aerosol, &
+ convproc_do_aer_out = convproc_do_aer)
+
+#ifdef OSLO_AERO
+ call constants
+ call initopt
+ call initlogn
+ call initopt_lw
+#ifdef AEROCOM
+ call initaeropt
+ call initdryp
+#endif ! aerocom
+#endif
+
+ call initializeCondensation()
+ call oslo_ocean_init()
+
+ call oslo_aero_initialize(pbuf2d)
+
+ call dust_init()
+ call seasalt_init() !seasalt_emis_scale)
+ call wetdep_init()
+ call modal_aero_deposition_init()
+
+
+ nwetdep = 0
+ ndrydep = 0
+
+
+ call inidrydep(rair, gravit)
+ dummy = 'RAM1'
+ call addfld (dummy,horiz_only, 'A','frac','RAM1')
+ if ( history_aerosol ) then
+ call add_default (dummy, 1, ' ')
+ endif
+ dummy = 'airFV'
+ call addfld (dummy,horiz_only, 'A','frac','FV')
+ if ( history_aerosol ) then
+ call add_default (dummy, 1, ' ')
+ endif
+
+ !Get height of boundary layer for boundary layer nucleation
+ pblh_idx = pbuf_get_index('pblh')
+
+ call cnst_get_ind ( "H2SO4", ndx_h2so4, abort=.true. )
+ ndx_h2so4 = chemistryIndex(ndx_h2so4)
+ call cnst_get_ind ( "SOA_LV", ndx_soa_lv,abort=.true.)
+ ndx_soa_lv = chemistryIndex(ndx_soa_lv)
+ call cnst_get_ind ( "SOA_SV", ndx_soa_sv, abort=.true.)
+ ndx_soa_sv = chemistryIndex(ndx_soa_sv)
+
+ do m = 1,gas_pcnst
+
+
+ unit_basename = 'kg' ! Units 'kg' or '1'
+
+ call addfld( 'GS_'//trim(solsym(m)),horiz_only, 'A', unit_basename//'/m2/s ', &
+ trim(solsym(m))//' gas chemistry/wet removal (for gas species)')
+ call addfld( 'AQ_'//trim(solsym(m)),horiz_only, 'A', unit_basename//'/m2/s ', &
+ trim(solsym(m))//' aqueous chemistry (for gas species)')
+ if(physicsIndex(m).le.pcnst) then
+ if (getCloudTracerIndexDirect(physicsIndex(m)) .gt. 0)then
+ call addfld( 'AQ_'//getCloudTracerName(physicsIndex(m)),horiz_only, 'A', unit_basename//'/m2/s ', &
+ trim(solsym(m))//' aqueous chemistry (for cloud species)')
+ end if
+ end if
+
+ if ( history_aerosol ) then
+ call add_default( 'GS_'//trim(solsym(m)), 1, ' ')
+ call add_default( 'AQ_'//trim(solsym(m)), 1, ' ')
+ if(physicsIndex(m).le.pcnst) then
+ if(getCloudTracerIndexDirect(physicsIndex(m)).gt.0)then
+ call add_default( 'AQ_'//getCloudTracerName(physicsIndex(m)),1,' ')
+ end if
+ end if
+ endif
+ enddo
+
+ call addfld ('NUCLRATE',(/'lev'/), 'A','#/cm3/s','Nucleation rate')
+ call addfld ('FORMRATE',(/'lev'/), 'A','#/cm3/s','Formation rate of 12nm particles')
+ call addfld ('COAGNUCL',(/'lev'/), 'A', '/s','Coagulation sink for nucleating particles')
+ call addfld ('GRH2SO4',(/'lev'/), 'A', 'nm/hour','Growth rate H2SO4')
+ call addfld ('GRSOA',(/'lev'/),'A','nm/hour','Growth rate SOA')
+ call addfld ('GR',(/'lev'/), 'A', 'nm/hour','Growth rate, H2SO4+SOA')
+ call addfld ('NUCLSOA',(/'lev'/),'A','kg/kg','SOA nucleate')
+ call addfld ('ORGNUCL',(/'lev'/),'A','kg/kg','Organic gas available for nucleation')
+
+ if(history_aerosol)then
+ call add_default ('NUCLRATE', 1, ' ')
+ call add_default ('FORMRATE', 1, ' ')
+ call add_default ('COAGNUCL', 1, ' ')
+ call add_default ('GRH2SO4', 1, ' ')
+ call add_default ('GRSOA', 1, ' ')
+ call add_default ('GR', 1, ' ')
+ call add_default ('NUCLSOA', 1, ' ')
+ call add_default ('ORGNUCL', 1, ' ')
+ end if
+
+ call addfld( 'XPH_LWC', (/ 'lev' /), 'A','kg/kg', 'pH value multiplied by lwc')
+ call addfld ('AQSO4_H2O2', horiz_only, 'A','kg/m2/s', 'SO4 aqueous phase chemistry due to H2O2')
+ call addfld ('AQSO4_O3', horiz_only, 'A','kg/m2/s', 'SO4 aqueous phase chemistry due to O3')
+
+ if ( history_aerosol ) then
+ call add_default ('XPH_LWC', 1, ' ')
+ call add_default ('AQSO4_H2O2', 1, ' ')
+ call add_default ('AQSO4_O3', 1, ' ')
+ endif
+
+
+
+end subroutine aero_model_init
+
+ !=============================================================================
+ !=============================================================================
+ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ptend )
+
+ use calcaersize
+ use oslo_aerosols_intr, only: oslo_aero_dry_intr
+ use aerosoldef , only : numberOfProcessModeTracers
+ use commondefinitions, only: oslo_nmodes=>nmodes
+
+ ! args
+ type(physics_state), intent(in) :: state ! Physics state variables
+ real(r8), intent(in) :: obklen(:)
+ real(r8), intent(in) :: ustar(:) ! sfc fric vel
+ type(cam_in_t), target, intent(in) :: cam_in ! import state
+ real(r8), intent(in) :: dt ! time step
+ type(cam_out_t), intent(inout) :: cam_out ! export state
+ type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! local vars
+ integer :: ncol
+ real(r8), dimension(pcols, pver, 0:oslo_nmodes) :: oslo_dgnumwet
+ real(r8), dimension(pcols, pver, 0:oslo_nmodes) :: oslo_wetdens
+ real(r8), dimension(pcols, pver, numberOfProcessModeTracers) :: oslo_dgnumwet_processmodes
+ real(r8), dimension(pcols, pver, numberOfProcessModeTracers) :: oslo_wetdens_processmodes
+
+ ncol = state%ncol
+
+ call calcaersize_sub( ncol, &
+ state%t, state%q(1,1,1), state%pmid, state%pdel &
+ ,oslo_dgnumwet , oslo_wetdens &
+ ,oslo_dgnumwet_processmodes, oslo_wetdens_processmodes &
+ )
+
+ call oslo_aero_dry_intr(state, pbuf, obklen, ustar, cam_in, dt, cam_out,ptend &
+ , oslo_dgnumwet, oslo_wetdens &
+ , oslo_dgnumwet_processmodes, oslo_wetdens_processmodes, &
+ cam_in%cflx ) !++alfgr
+
+ return
+ endsubroutine aero_model_drydep
+
+ !=============================================================================
+ !=============================================================================
+ subroutine aero_model_wetdep( state, dt, dlf, cam_out, ptend, pbuf)
+
+ use oslo_aerosols_intr, only: oslo_aero_wet_intr
+
+ type(physics_state), intent(in) :: state ! Physics state variables
+ real(r8), intent(in) :: dt ! time step
+ real(r8), intent(in) :: dlf(:,:) ! shallow+deep convective detrainment [kg/kg/s]
+ type(cam_out_t), intent(inout) :: cam_out ! export state
+ type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ call oslo_aero_wet_intr( state, dt, dlf, cam_out, ptend, pbuf)
+
+ endsubroutine aero_model_wetdep
+
+ !-------------------------------------------------------------------------
+ ! provides wet tropospheric aerosol surface area info for modal aerosols
+ ! called from mo_usrrxt
+ !-------------------------------------------------------------------------
+ subroutine aero_model_surfarea( &
+ mmr, radmean, relhum, pmid, temp, strato_sad, sulfate, rho, ltrop, &
+ dlat, het1_ndx, pbuf, ncol, sfc, dm_aer, sad_trop, reff_trop )
+
+ use commondefinitions, only: nmodes_oslo => nmodes
+ use const , only: numberToSurface
+ use aerosoldef , only: lifeCycleNumberMedianRadius
+ use oslo_utils , only: calculateNumberConcentration
+
+ ! dummy args
+ real(r8), intent(in) :: pmid(:,:)
+ real(r8), intent(in) :: temp(:,:)
+ real(r8), intent(in) :: mmr(:,:,:)
+ real(r8), intent(in) :: radmean ! mean radii in cm
+ real(r8), intent(in) :: strato_sad(:,:)
+ integer, intent(in) :: ncol
+ integer, intent(in) :: ltrop(:)
+ real(r8), intent(in) :: dlat(:) ! degrees latitude
+ integer, intent(in) :: het1_ndx
+ real(r8), intent(in) :: relhum(:,:)
+ real(r8), intent(in) :: rho(:,:) ! total atm density (/cm^3)
+ real(r8), intent(in) :: sulfate(:,:)
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ real(r8), intent(inout) :: sfc(:,:,:)
+ real(r8), intent(inout) :: dm_aer(:,:,:)
+ real(r8), intent(inout) :: sad_trop(:,:)
+ real(r8), intent(out) :: reff_trop(:,:)
+
+ ! local vars
+ !HAVE TO GET RID OF THIS MODE 0!! MESSES UP EVERYTHING!!
+ real(r8) :: numberConcentration(pcols,pver,0:nmodes_oslo)
+ real(r8), target :: sad_mode(pcols,pver, nmodes_oslo)
+ real(r8) :: rho_air(pcols,pver)
+ integer :: l,m
+ integer :: i,k
+
+ !Get air density
+ do k=1,pver
+ do i=1,ncol
+ rho_air(i,k) = pmid(i,k)/(temp(i,k)*287.04_r8)
+ end do
+ end do
+ !
+ !Get number concentrations
+ call calculateNumberConcentration(ncol, mmr, rho_air, numberConcentration)
+
+ !Convert to area using lifecycle-radius
+ sad_mode = 0._r8
+ sad_trop = 0._r8
+ do m=1,nmodes_oslo
+ do k=1,pver
+ sad_mode(:ncol,k,m) = numberConcentration(:ncol,k,m)*numberToSurface(m)*1.e-2_r8 !m2/m3 ==> cm2/cm3
+ sad_trop(:ncol,k) = sad_trop(:ncol,k) + sad_mode(:ncol,k,m)
+ end do
+ end do
+
+ do m=1,nmodes_oslo
+ do k=1,pver
+ sfc(:ncol,k,m) = sad_mode(:ncol,k,m) ! aitken_idx:aitken_idx)
+ dm_aer(:ncol,k,m) = 2.0_r8*lifeCycleNumberMedianRadius(m)
+ end do
+ end do
+
+ !++ need to implement reff_trop here
+ reff_trop(:,:)=1.0e-6_r8
+ !--
+
+
+ end subroutine aero_model_surfarea
+
+ !-------------------------------------------------------------------------
+ ! provides WET stratospheric aerosol surface area info for modal aerosols
+ ! if modal_strat_sulfate = TRUE -- called from mo_gas_phase_chemdr
+ !-------------------------------------------------------------------------
+ subroutine aero_model_strat_surfarea( ncol, mmr, pmid, temp, ltrop, pbuf, strato_sad, reff_strat )
+
+ ! dummy args
+ integer, intent(in) :: ncol
+ real(r8), intent(in) :: mmr(:,:,:)
+ real(r8), intent(in) :: pmid(:,:)
+ real(r8), intent(in) :: temp(:,:)
+ integer, intent(in) :: ltrop(:) ! tropopause level indices
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ real(r8), intent(out) :: strato_sad(:,:)
+ real(r8), intent(out) :: reff_strat(:,:)
+
+ ! local vars
+ real(r8), pointer, dimension(:,:,:) :: dgnumwet
+ integer :: beglev(ncol)
+ integer :: endlev(ncol)
+
+ reff_strat = 0.1e-6_r8
+ strato_sad = 0._r8
+ !do nothing
+ return
+
+ end subroutine aero_model_strat_surfarea
+
+ !=============================================================================
+ !=============================================================================
+ subroutine aero_model_gasaerexch( loffset, ncol, lchnk, troplev, delt, 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 condtend, only : condtend_sub
+ use aerosoldef, only: getCloudTracerName
+ !-----------------------------------------------------------------------
+ ! ... dummy arguments
+ !-----------------------------------------------------------------------
+ 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) :: troplev(pcols)
+ real(r8), intent(in) :: delt ! time step size (sec)
+ real(r8), intent(in) :: reaction_rates(:,:,:) ! reaction rates
+ real(r8), intent(in) :: tfld(:,:) ! temperature (K)
+ real(r8), intent(in) :: pmid(:,:) ! pressure at model levels (Pa)
+ real(r8), intent(in) :: pdel(:,:) ! pressure thickness of levels (Pa)
+ real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu )
+ real(r8), intent(in) :: relhum(:,:) ! relative humidity
+ real(r8), intent(in) :: airdens(:,:) ! total atms density (molec/cm**3)
+ real(r8), intent(in) :: invariants(:,:,:)
+ real(r8), intent(inout) :: del_h2so4_gasprod(:,:) ![molec/molec/sec]
+ real(r8), intent(in) :: zm(:,:)
+ real(r8), intent(in) :: qh2o(:,:)
+ real(r8), intent(in) :: cwat(:,:) ! cloud liquid water content (kg/kg)
+ real(r8), intent(in) :: cldfr(:,:)
+ real(r8), intent(in) :: cldnum(:,:) ! droplet number concentration (#/kg)
+ real(r8), intent(in) :: vmr0(:,:,:) ! initial mixing ratios (before gas-phase chem changes)
+ real(r8), intent(inout) :: vmr(:,:,:) ! mixing ratios ( vmr )
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! local vars
+
+ integer :: n, m
+ integer :: i,k,l
+ integer :: nstep
+
+ integer, parameter :: nmodes_aq_chem = 1
+
+ real(r8), dimension(ncol) :: wrk
+ character(len=32) :: name
+ real(r8) :: dvmrcwdt(ncol,pver,gas_pcnst)
+ real(r8) :: dvmrdt(ncol,pver,gas_pcnst)
+ real(r8) :: vmrcw(ncol,pver,gas_pcnst) ! cloud-borne aerosol (vmr)
+
+ real(r8) :: del_h2so4_aeruptk(ncol,pver)
+ real(r8) :: del_h2so4_aqchem(ncol,pver)
+ real(r8) :: mmr_cond_vap_start_of_timestep(pcols,pver,N_COND_VAP)
+ real(r8) :: mmr_cond_vap_gasprod(pcols,pver,N_COND_VAP)
+ real(r8) :: del_soa_lv_gasprod(ncol,pver)
+ real(r8) :: del_soa_sv_gasprod(ncol,pver)
+ real(r8) :: dvmrdt_sv1(ncol,pver,gas_pcnst)
+ real(r8) :: dvmrcwdt_sv1(ncol,pver,gas_pcnst)
+ real(r8) :: mmr_tend_ncols(ncol, pver, gas_pcnst)
+ real(r8) :: mmr_tend_pcols(pcols, pver, gas_pcnst)
+
+ integer :: cond_vap_idx
+ real(r8) :: aqso4(ncol,nmodes_aq_chem) ! aqueous phase chemistry
+ real(r8) :: aqh2so4(ncol,nmodes_aq_chem) ! aqueous phase chemistry
+ real(r8) :: aqso4_h2o2(ncol) ! SO4 aqueous phase chemistry due to H2O2
+ real(r8) :: aqso4_o3(ncol) ! SO4 aqueous phase chemistry due to O3
+ real(r8) :: xphlwc(ncol,pver) ! pH value multiplied by lwc
+ real(r8) :: delt_inverse ! 1 / timestep
+
+ real(r8), pointer :: pblh(:)
+
+ logical :: is_spcam_m2005
+
+ nstep = get_nstep()
+
+
+ is_spcam_m2005 = cam_physpkg_is('spcam_m2005')
+
+ delt_inverse = 1.0_r8 / delt
+
+ !Get height of boundary layer (needed for boundary layer nucleation)
+ call pbuf_get_field(pbuf, pblh_idx, pblh)
+
+ ! calculate tendency due to gas phase chemistry and processes
+ dvmrdt(:ncol,:,:) = (vmr(:ncol,:,:) - vmr0(:ncol,:,:)) / delt
+ 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
+ end do
+ name = 'GS_'//trim(solsym(m))
+ call outfld( name, wrk(:ncol), ncol, lchnk )
+ enddo
+
+! Get mass mixing ratios at start of time step
+ call vmr2mmr( vmr0, mmr_tend_ncols, mbar, ncol )
+ mmr_cond_vap_start_of_timestep(:ncol,:,COND_VAP_H2SO4) = mmr_tend_ncols(1:ncol,:,ndx_h2so4)
+ mmr_cond_vap_start_of_timestep(:ncol,:,COND_VAP_ORG_LV) = mmr_tend_ncols(1:ncol,:,ndx_soa_lv)
+ mmr_cond_vap_start_of_timestep(:ncol,:,COND_VAP_ORG_SV) = mmr_tend_ncols(1:ncol,:,ndx_soa_sv)
+!
+! Aerosol processes ...
+!
+ call qqcw2vmr( lchnk, vmrcw, mbar, ncol, loffset, pbuf )
+
+ ! save h2so4 change by gas phase chem (for later new particle nucleation)
+ if (ndx_h2so4 > 0) then
+ del_h2so4_gasprod(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) - vmr0(1:ncol,:,ndx_h2so4)
+ endif
+
+ del_soa_lv_gasprod(1:ncol,:) = vmr(1:ncol,:,ndx_soa_lv) - vmr0(1:ncol,:,ndx_soa_lv)
+ del_soa_sv_gasprod(1:ncol,:) = vmr(1:ncol,:,ndx_soa_sv) - vmr0(1:ncol,:,ndx_soa_sv)
+
+ if (.not. is_spcam_m2005) then ! regular CAM
+ dvmrdt(:ncol,:,:) = vmr(:ncol,:,:)
+ dvmrcwdt(:ncol,:,:) = vmrcw(:ncol,:,:)
+
+ !Save intermediate concentrations
+ dvmrdt_sv1 = vmr
+ dvmrcwdt_sv1 = vmrcw
+
+ ! aqueous chemistry ...
+
+ call setsox( &
+ ncol, &
+ lchnk, &
+ loffset, &
+ delt, &
+ pmid, &
+ pdel, &
+ tfld, &
+ mbar, &
+ cwat, &
+ cldfr, &
+ cldnum, &
+ airdens, &
+ invariants, &
+ vmrcw, &
+ vmr, &
+ xphlwc, &
+ aqso4, &
+ aqh2so4, &
+ aqso4_h2o2, &
+ aqso4_o3 &
+ )
+
+ call outfld( 'AQSO4_H2O2', aqso4_h2o2(:ncol), ncol, lchnk)
+ call outfld( 'AQSO4_O3', aqso4_o3(:ncol), ncol, lchnk)
+ call outfld( 'XPH_LWC', xphlwc(:ncol,:), ncol, lchnk )
+
+
+ ! vmr tendency from aqchem and soa routines
+ dvmrdt_sv1 = (vmr - dvmrdt_sv1)/delt
+ dvmrcwdt_sv1 = (vmrcw - dvmrcwdt_sv1)/delt
+
+ if(ndx_h2so4 .gt. 0)then
+ del_h2so4_aqchem(:ncol,:) = dvmrdt_sv1(:ncol,:,ndx_h2so4)*delt !"production rate" of H2SO4
+ else
+ del_h2so4_aqchem(:ncol,:) = 0.0_r8
+ end if
+
+ do m = 1,gas_pcnst
+ wrk(:ncol) = 0._r8
+ do k = 1,pver
+ wrk(:ncol) = wrk(:ncol) + dvmrdt_sv1(:ncol,k,m)*adv_mass(m)/mbar(:ncol,k)*pdel(:ncol,k)/gravit
+ end do
+ name = 'AQ_'//trim(solsym(m))
+ call outfld( name, wrk(:ncol), ncol, lchnk )
+
+ !In oslo aero also write out the tendencies for the
+ !cloud borne aerosols...
+ n = physicsIndex(m)
+ if (n.le.pcnst) then
+ if(getCloudTracerIndexDirect(n) .gt. 0)then
+ name = 'AQ_'//trim(getCloudTracerName(n))
+ wrk(:ncol)=0.0_r8
+ do k=1,pver
+ wrk(:ncol) = wrk(:ncol) + dvmrcwdt_sv1(:ncol,k,m)*adv_mass(m)/mbar(:ncol,k)*pdel(:ncol,k)/gravit
+ end do
+ call outfld( name, wrk(:ncol), ncol, lchnk )
+ end if
+ end if
+ enddo
+
+ else if (is_spcam_m2005) then ! SPCAM ECPP
+! when ECPP is used, aqueous chemistry is done in ECPP,
+! and not updated here.
+! Minghuai Wang, 2010-02 (Minghuai.Wang@pnl.gov)
+!
+ dvmrdt = 0.0_r8
+ dvmrcwdt = 0.0_r8
+ endif
+
+ !condensation
+ call vmr2mmr( vmr, mmr_tend_ncols, mbar, ncol )
+ do k = 1,pver
+ mmr_cond_vap_gasprod(:ncol,k,COND_VAP_H2SO4) = adv_mass(ndx_h2so4) * (del_h2so4_gasprod(:ncol,k)+del_h2so4_aqchem(:ncol,k)) / mbar(:ncol,k)/delt
+ mmr_cond_vap_gasprod(:ncol,k,COND_VAP_ORG_LV) = adv_mass(ndx_soa_lv) * del_soa_lv_gasprod(:ncol,k) / mbar(:ncol,k)/delt !cka
+ mmr_cond_vap_gasprod(:ncol,k,COND_VAP_ORG_SV) = adv_mass(ndx_soa_sv) * del_soa_sv_gasprod(:ncol,k) / mbar(:ncol,k)/delt !cka
+ end do
+
+ !This should not happen since there are only
+ !production terms for these gases!!
+ do cond_vap_idx=1,N_COND_VAP
+ where(mmr_cond_vap_gasprod(:ncol,:,cond_vap_idx).lt. 0.0_r8)
+ mmr_cond_vap_gasprod(:ncol,:,cond_vap_idx) = 0.0_r8
+ end where
+ end do
+ mmr_tend_ncols(:ncol,:,ndx_h2so4) = mmr_cond_vap_start_of_timestep(:ncol,:,COND_VAP_H2SO4)
+ mmr_tend_ncols(:ncol,:,ndx_soa_lv) = mmr_cond_vap_start_of_timestep(:ncol,:,COND_VAP_ORG_LV)
+ mmr_tend_ncols(:ncol,:,ndx_soa_sv) = mmr_cond_vap_start_of_timestep(:ncol,:,COND_VAP_ORG_SV)
+
+ !Rest of microphysics have pcols dimension
+ mmr_tend_pcols(:ncol,:,:) = mmr_tend_ncols(:ncol,:,:)
+ !Note use of "zm" here. In CAM5.3-implementation "zi" was used..
+ !zm is passed through the generic interface, and it should not change much
+ !to check if "zm" is below boundary layer height instead of zi
+ call condtend_sub( lchnk, mmr_tend_pcols, mmr_cond_vap_gasprod,tfld, pmid, &
+ pdel, delt, ncol, pblh, zm, qh2o) !cka
+
+
+ !coagulation
+ ! OS 280415 Concentratiions in cloud water is in vmr space and as a
+ ! temporary variable (vmrcw) Coagulation between aerosol and cloud
+ ! droplets moved to after vmrcw is moved into qqcw (in mmr spac)
+
+ call coagtend( mmr_tend_pcols, pmid, pdel, tfld, delt_inverse, ncol, lchnk)
+
+ !Convert cloud water to mmr again ==> values in buffer
+ call vmr2qqcw( lchnk, vmrcw, mbar, ncol, loffset, pbuf )
+
+ !Call cloud coagulation routines (all in mass mixing ratios)
+ call clcoag( mmr_tend_pcols, pmid, pdel, tfld, cldnum ,cldfr, delt_inverse, ncol, lchnk,loffset,pbuf)
+
+ !Make sure mmr==> vmr is done correctly
+ mmr_tend_ncols(:ncol,:,:) = mmr_tend_pcols(:ncol,:,:)
+
+ !Go back to volume mixing ratio for chemistry
+ call mmr2vmr( mmr_tend_ncols, vmr, mbar, ncol )
+
+ return
+
+ end subroutine aero_model_gasaerexch
+
+ !=============================================================================
+ !=============================================================================
+ subroutine aero_model_emissions( state, cam_in )
+ use seasalt_model, only: oslo_salt_emis_intr, seasalt_active, OMOceanSource
+ use dust_model, only: oslo_dust_emis_intr, dust_active
+ use oslo_ocean_intr, only: oslo_dms_emis_intr
+ use aerosoldef, only: l_om_ni
+ use physics_types, only: physics_state
+
+ ! Arguments:
+
+ type(physics_state), intent(in) :: state ! Physics state variables
+ type(cam_in_t), intent(inout) :: cam_in ! import state
+
+ ! local vars
+
+ integer :: lchnk, ncol
+ real(r8) :: sflx(pcols) ! accumulate over all bins for output
+ real (r8), parameter :: z0=0.0001_r8 ! m roughness length over oceans--from ocean model
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ if (dust_active) then
+
+ call oslo_dust_emis_intr( state, cam_in)
+
+ ! some dust emis diagnostics ...
+ endif
+
+ if (seasalt_active) then
+
+ call oslo_salt_emis_intr(state, cam_in)
+
+ endif
+
+ !Add whatever OM ocean source was calculated in the seasalt module
+ cam_in%cflx(:ncol,l_om_ni) = cam_in%cflx(:ncol,l_om_ni) + OMOceanSource(:ncol)
+
+ !Pick up correct DMS emissions (replace values from file if requested)
+ call oslo_dms_emis_intr(state, cam_in)
+
+ end subroutine aero_model_emissions
+
+ !===============================================================================
+ ! private methods
+
+
+ !=============================================================================
+ !=============================================================================
+ subroutine surf_area_dens( ncol, mmr, pmid, temp, diam, beglev, endlev, sad, sfc )
+ use mo_constants, only : pi
+
+ ! dummy args
+ integer, intent(in) :: ncol
+ real(r8), intent(in) :: mmr(:,:,:)
+ real(r8), intent(in) :: pmid(:,:)
+ real(r8), intent(in) :: temp(:,:)
+ real(r8), intent(in) :: diam(:,:,:)
+ integer, intent(in) :: beglev(:)
+ integer, intent(in) :: endlev(:)
+ real(r8), intent(out) :: sad(:,:)
+ real(r8),optional, intent(out) :: sfc(:,:,:)
+
+ ! local vars
+
+ !
+ ! Compute surface aero for each mode.
+ ! Total over all modes as the surface area for chemical reactions.
+ !
+
+ !oslo: do nothing for now
+ return
+
+ end subroutine surf_area_dens
+
+ !===============================================================================
+ !===============================================================================
+ subroutine modal_aero_bcscavcoef_init
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! Computes lookup table for aerosol impaction/interception scavenging rates
+ !
+ ! Authors: R. Easter
+ !
+ !-----------------------------------------------------------------------
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use modal_aero_data
+ use cam_abortutils, only: endrun
+
+ implicit none
+
+ ! oslo : do nothing for now
+ return
+ end subroutine modal_aero_bcscavcoef_init
+
+ !===============================================================================
+ !===============================================================================
+ subroutine modal_aero_depvel_part( ncol, t, pmid, ram1, fv, vlc_dry, vlc_trb, vlc_grv, &
+ radius_part, density_part, sig_part, moment, lchnk )
+
+! calculates surface deposition velocity of particles
+! L. Zhang, S. Gong, J. Padro, and L. Barrie
+! A size-seggregated particle dry deposition scheme for an atmospheric aerosol module
+! Atmospheric Environment, 35, 549-560, 2001.
+!
+! Authors: X. Liu
+
+ !
+ ! !USES
+ !
+ use physconst, only: pi,boltz, gravit, rair
+ use mo_drydep, only: n_land_type, fraction_landuse
+
+ ! !ARGUMENTS:
+ !
+ implicit none
+ !
+ real(r8), intent(in) :: t(pcols,pver) !atm temperature (K)
+ real(r8), intent(in) :: pmid(pcols,pver) !atm pressure (Pa)
+ real(r8), intent(in) :: fv(pcols) !friction velocity (m/s)
+ real(r8), intent(in) :: ram1(pcols) !aerodynamical resistance (s/m)
+ real(r8), intent(in) :: radius_part(pcols,pver) ! mean (volume/number) particle radius (m)
+ real(r8), intent(in) :: density_part(pcols,pver) ! density of particle material (kg/m3)
+ real(r8), intent(in) :: sig_part(pcols,pver) ! geometric standard deviation of particles
+ integer, intent(in) :: moment ! moment of size distribution (0 for number, 2 for surface area, 3 for volume)
+ integer, intent(in) :: ncol
+ integer, intent(in) :: lchnk
+
+ real(r8), intent(out) :: vlc_trb(pcols) !Turbulent deposn velocity (m/s)
+ real(r8), intent(out) :: vlc_grv(pcols,pver) !grav deposn velocity (m/s)
+ real(r8), intent(out) :: vlc_dry(pcols,pver) !dry deposn velocity (m/s)
+ !------------------------------------------------------------------------
+
+ !------------------------------------------------------------------------
+ ! Local Variables
+ integer :: m,i,k,ix !indices
+ real(r8) :: rho !atm density (kg/m**3)
+ real(r8) :: vsc_dyn_atm(pcols,pver) ![kg m-1 s-1] Dynamic viscosity of air
+ real(r8) :: vsc_knm_atm(pcols,pver) ![m2 s-1] Kinematic viscosity of atmosphere
+ real(r8) :: shm_nbr ![frc] Schmidt number
+ real(r8) :: stk_nbr ![frc] Stokes number
+ real(r8) :: mfp_atm(pcols,pver) ![m] Mean free path of air
+ real(r8) :: dff_aer ![m2 s-1] Brownian diffusivity of particle
+ real(r8) :: slp_crc(pcols,pver) ![frc] Slip correction factor
+ real(r8) :: rss_trb ![s m-1] Resistance to turbulent deposition
+ real(r8) :: rss_lmn ![s m-1] Quasi-laminar layer resistance
+ real(r8) :: brownian ! collection efficiency for Browning diffusion
+ real(r8) :: impaction ! collection efficiency for impaction
+ real(r8) :: interception ! collection efficiency for interception
+ real(r8) :: stickfrac ! fraction of particles sticking to surface
+ real(r8) :: radius_moment(pcols,pver) ! median radius (m) for moment
+ real(r8) :: lnsig ! ln(sig_part)
+ real(r8) :: dispersion ! accounts for influence of size dist dispersion on bulk settling velocity
+ ! assuming radius_part is number mode radius * exp(1.5 ln(sigma))
+
+ integer :: lt
+ real(r8) :: lnd_frc
+ real(r8) :: wrk1, wrk2, wrk3
+
+ ! constants
+ real(r8) gamma(11) ! exponent of schmidt number
+! data gamma/0.54d+00, 0.56d+00, 0.57d+00, 0.54d+00, 0.54d+00, &
+! 0.56d+00, 0.54d+00, 0.54d+00, 0.54d+00, 0.56d+00, &
+! 0.50d+00/
+ data gamma/0.56e+00_r8, 0.54e+00_r8, 0.54e+00_r8, 0.56e+00_r8, 0.56e+00_r8, &
+ 0.56e+00_r8, 0.50e+00_r8, 0.54e+00_r8, 0.54e+00_r8, 0.54e+00_r8, &
+ 0.54e+00_r8/
+ save gamma
+
+ real(r8) alpha(11) ! parameter for impaction
+! data alpha/50.00d+00, 0.95d+00, 0.80d+00, 1.20d+00, 1.30d+00, &
+! 0.80d+00, 50.00d+00, 50.00d+00, 2.00d+00, 1.50d+00, &
+! 100.00d+00/
+ data alpha/1.50e+00_r8, 1.20e+00_r8, 1.20e+00_r8, 0.80e+00_r8, 1.00e+00_r8, &
+ 0.80e+00_r8, 100.00e+00_r8, 50.00e+00_r8, 2.00e+00_r8, 1.20e+00_r8, &
+ 50.00e+00_r8/
+ save alpha
+
+ real(r8) radius_collector(11) ! radius (m) of surface collectors
+! data radius_collector/-1.00d+00, 5.10d-03, 3.50d-03, 3.20d-03, 10.00d-03, &
+! 5.00d-03, -1.00d+00, -1.00d+00, 10.00d-03, 10.00d-03, &
+! -1.00d+00/
+ data radius_collector/10.00e-03_r8, 3.50e-03_r8, 3.50e-03_r8, 5.10e-03_r8, 2.00e-03_r8, &
+ 5.00e-03_r8, -1.00e+00_r8, -1.00e+00_r8, 10.00e-03_r8, 3.50e-03_r8, &
+ -1.00e+00_r8/
+ save radius_collector
+
+ integer :: iwet(11) ! flag for wet surface = 1, otherwise = -1
+! data iwet/1, -1, -1, -1, -1, &
+! -1, -1, -1, 1, -1, &
+! 1/
+ data iwet/-1, -1, -1, -1, -1, &
+ -1, 1, -1, 1, -1, &
+ -1/
+ save iwet
+
+
+ !------------------------------------------------------------------------
+ do k=1,pver
+ do i=1,ncol
+
+ lnsig = log(sig_part(i,k))
+! use a maximum radius of 50 microns when calculating deposition velocity
+ radius_moment(i,k) = min(50.0e-6_r8,radius_part(i,k))* &
+ exp((float(moment)-1.5_r8)*lnsig*lnsig)
+ dispersion = exp(2._r8*lnsig*lnsig)
+
+ rho=pmid(i,k)/rair/t(i,k)
+
+ ! Quasi-laminar layer resistance: call rss_lmn_get
+ ! Size-independent thermokinetic properties
+ vsc_dyn_atm(i,k) = 1.72e-5_r8 * ((t(i,k)/273.0_r8)**1.5_r8) * 393.0_r8 / &
+ (t(i,k)+120.0_r8) ![kg m-1 s-1] RoY94 p. 102
+ mfp_atm(i,k) = 2.0_r8 * vsc_dyn_atm(i,k) / & ![m] SeP97 p. 455
+ (pmid(i,k)*sqrt(8.0_r8/(pi*rair*t(i,k))))
+ vsc_knm_atm(i,k) = vsc_dyn_atm(i,k) / rho ![m2 s-1] Kinematic viscosity of air
+
+ slp_crc(i,k) = 1.0_r8 + mfp_atm(i,k) * &
+ (1.257_r8+0.4_r8*exp(-1.1_r8*radius_moment(i,k)/(mfp_atm(i,k)))) / &
+ radius_moment(i,k) ![frc] Slip correction factor SeP97 p. 464
+ vlc_grv(i,k) = (4.0_r8/18.0_r8) * radius_moment(i,k)*radius_moment(i,k)*density_part(i,k)* &
+ gravit*slp_crc(i,k) / vsc_dyn_atm(i,k) ![m s-1] Stokes' settling velocity SeP97 p. 466
+ vlc_grv(i,k) = vlc_grv(i,k) * dispersion
+
+ vlc_dry(i,k)=vlc_grv(i,k)
+ enddo
+ enddo
+ k=pver ! only look at bottom level for next part
+ do i=1,ncol
+ dff_aer = boltz * t(i,k) * slp_crc(i,k) / & ![m2 s-1]
+ (6.0_r8*pi*vsc_dyn_atm(i,k)*radius_moment(i,k)) !SeP97 p.474
+ shm_nbr = vsc_knm_atm(i,k) / dff_aer ![frc] SeP97 p.972
+
+ wrk2 = 0._r8
+ wrk3 = 0._r8
+ do lt = 1,n_land_type
+ lnd_frc = fraction_landuse(i,lt,lchnk)
+ if ( lnd_frc /= 0._r8 ) then
+ brownian = shm_nbr**(-gamma(lt))
+ if (radius_collector(lt) > 0.0_r8) then
+! vegetated surface
+ stk_nbr = vlc_grv(i,k) * fv(i) / (gravit*radius_collector(lt))
+ interception = 2.0_r8*(radius_moment(i,k)/radius_collector(lt))**2.0_r8
+ else
+! non-vegetated surface
+ stk_nbr = vlc_grv(i,k) * fv(i) * fv(i) / (gravit*vsc_knm_atm(i,k)) ![frc] SeP97 p.965
+ interception = 0.0_r8
+ endif
+ impaction = (stk_nbr/(alpha(lt)+stk_nbr))**2.0_r8
+
+ if (iwet(lt) > 0) then
+ stickfrac = 1.0_r8
+ else
+ stickfrac = exp(-sqrt(stk_nbr))
+ if (stickfrac < 1.0e-10_r8) stickfrac = 1.0e-10_r8
+ endif
+ rss_lmn = 1.0_r8 / (3.0_r8 * fv(i) * stickfrac * (brownian+interception+impaction))
+ rss_trb = ram1(i) + rss_lmn + ram1(i)*rss_lmn*vlc_grv(i,k)
+
+ wrk1 = 1.0_r8 / rss_trb
+ wrk2 = wrk2 + lnd_frc*( wrk1 )
+ wrk3 = wrk3 + lnd_frc*( wrk1 + vlc_grv(i,k) )
+ endif
+ enddo ! n_land_type
+ vlc_trb(i) = wrk2
+ vlc_dry(i,k) = wrk3
+ enddo !ncol
+
+ return
+ end subroutine modal_aero_depvel_part
+
+ !===============================================================================
+ subroutine modal_aero_bcscavcoef_get( m, ncol, isprx, dgn_awet, scavcoefnum, scavcoefvol )
+
+ use modal_aero_data
+ !-----------------------------------------------------------------------
+ implicit none
+
+ integer,intent(in) :: m, ncol
+ logical,intent(in):: isprx(pcols,pver)
+ real(r8), intent(in) :: dgn_awet(pcols,pver,ntot_amode)
+ real(r8), intent(out) :: scavcoefnum(pcols,pver), scavcoefvol(pcols,pver)
+
+ integer i, k, jgrow
+
+ return
+ end subroutine modal_aero_bcscavcoef_get
+
+ !=============================================================================
+ !=============================================================================
+ subroutine qqcw2vmr(lchnk, vmr, mbar, ncol, im, pbuf)
+ use modal_aero_data, only : qqcw_get_field
+ use physics_buffer, only : physics_buffer_desc
+ !-----------------------------------------------------------------
+ ! ... Xfrom from mass to volume mixing ratio
+ !-----------------------------------------------------------------
+
+ use chem_mods, only : adv_mass, gas_pcnst
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! ... Dummy args
+ !-----------------------------------------------------------------
+ integer, intent(in) :: lchnk, ncol, im
+ real(r8), intent(in) :: mbar(ncol,pver)
+ real(r8), intent(inout) :: vmr(ncol,pver,gas_pcnst)
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ !-----------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------
+ integer :: k, m
+ real(r8), pointer :: fldcw(:,:)
+
+ do m=1,gas_pcnst
+ if( adv_mass(m) /= 0._r8 ) then
+ fldcw => qqcw_get_field(pbuf, m+im,lchnk,errorhandle=.true.)
+ if(associated(fldcw)) then
+ do k=1,pver
+ vmr(:ncol,k,m) = mbar(:ncol,k) * fldcw(:ncol,k) / adv_mass(m)
+ end do
+ else
+ vmr(:,:,m) = 0.0_r8
+ end if
+ end if
+ end do
+ end subroutine qqcw2vmr
+
+
+ !=============================================================================
+ !=============================================================================
+ subroutine vmr2qqcw( lchnk, vmr, mbar, ncol, im, pbuf )
+ !-----------------------------------------------------------------
+ ! ... Xfrom from volume to mass mixing ratio
+ !-----------------------------------------------------------------
+
+ use m_spc_id
+ use chem_mods, only : adv_mass, gas_pcnst
+ use modal_aero_data, only : qqcw_get_field
+ use physics_buffer, only : physics_buffer_desc
+
+ implicit none
+
+ !-----------------------------------------------------------------
+ ! ... Dummy args
+ !-----------------------------------------------------------------
+ integer, intent(in) :: lchnk, ncol, im
+ real(r8), intent(in) :: mbar(ncol,pver)
+ real(r8), intent(in) :: vmr(ncol,pver,gas_pcnst)
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ !-----------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------
+ integer :: k, m
+ real(r8), pointer :: fldcw(:,:)
+ !-----------------------------------------------------------------
+ ! ... The non-group species
+ !-----------------------------------------------------------------
+ do m = 1,gas_pcnst
+ fldcw => qqcw_get_field(pbuf, m+im,lchnk,errorhandle=.true.)
+ if( adv_mass(m) /= 0._r8 .and. associated(fldcw)) then
+ do k = 1,pver
+ fldcw(:ncol,k) = adv_mass(m) * vmr(:ncol,k,m) / mbar(:ncol,k)
+ end do
+ end if
+ end do
+
+ end subroutine vmr2qqcw
+
+end module aero_model
diff --git a/src/chemistry/oslo_aero/aeronucl.F90 b/src/chemistry/oslo_aero/aeronucl.F90
new file mode 100644
index 0000000000..74e0156957
--- /dev/null
+++ b/src/chemistry/oslo_aero/aeronucl.F90
@@ -0,0 +1,374 @@
+subroutine aeronucl(lchnk, ncol, t, pmid, h2ommr, h2so4pc, oxidorg, coagnuc, nuclso4, nuclorg, zm, pblht)
+
+! Subroutine to calculate nucleation (formation) rates of new particles
+! At the moment, the final nucleation rate consists of
+! (1) Binary sulphuric acid-water nucleation in whole atmosphere (Vehkamaki et al., 2002, JGR)
+! JGR, vol 107, No D22, http://onlinelibrary.wiley.com/doi/10.1029/2002JD002184/abstract
+! (2) Boundary-layer nucleation
+! Paasonen et al (2010), ACP, vol 10, pp 11223: http://www.atmos-chem-phys.net/10/11223/2010/acp-10-11223-2010.html
+! (3) First version published ACP (Risto Makkonen)
+! ACP, vol 14, no 10, pp 5127 http://www.atmos-chem-phys.net/14/5127/2014/acp-14-5127-2014.html
+! Modified Spring 2015, cka
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use wv_saturation, only: qsat_water
+ use physconst, only: avogad, rair
+ use ppgrid, only: pcols, pver, pverp
+ use aerosoldef, only : MODE_IDX_SO4SOA_AIT, rhopart, l_so4_a1, l_soa_lv, l_so4_na, l_soa_na
+ use commondefinitions, only: originalNumberMedianRadius
+ use cam_history, only: outfld
+ use phys_control, only: phys_getopts
+ use chem_mods, only: adv_mass
+ use m_spc_id, only : id_H2SO4, id_soa_lv
+ use const, only : volumeToNumber
+
+ implicit none
+
+ !-- Arguments
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric column
+ real(r8), intent(in) :: pmid(pcols,pver) ! layer pressure (Pa)
+ real(r8), intent(in) :: h2ommr(pcols,pver) ! layer specific humidity
+ real(r8), intent(in) :: t(pcols,pver) ! Temperature (K)
+ real(r8), intent(in) :: h2so4pc(pcols,pver) ! Sulphuric acid concentration (kg kg-1)
+ real(r8), intent(in) :: oxidorg(pcols,pver) ! Organic vapour concentration (kg kg-1)
+ real(r8), intent(in) :: coagnuc(pcols,pver) ! Coagulation sink for nucleating particles [1/s]
+ real(r8), intent(out) :: nuclorg(pcols,pver) ! Nucleated mass (ORG)
+ real(r8), intent(out) :: nuclso4(pcols,pver) ! Nucleated mass (H2SO4)
+ real(r8), intent(in) :: zm(pcols,pver) ! Height at layer midpoints (m)
+ real(r8), intent(in) :: pblht(pcols) ! Planetary boundary layer height (m)
+
+ !-- Local variables
+
+ real(r8), parameter :: pi=3.141592654_r8
+ !cka+
+ real(r8), parameter :: gasconst_R=8.314472_r8 ! universal gas constant [J mol-1 K-1]
+ real(r8), parameter :: h2so4_dens=1841._r8 ! h2so4 density [kg m-3]
+ real(r8), parameter :: org_dens=2000._r8 ! density of organics [kg m-3], based on RM assumptions
+ !cka -
+
+ integer :: i,k
+ real(r8) :: qs(pcols,pver) ! Saturation specific humidity
+ real(r8) :: relhum(pcols,pver) ! Relative humidity
+ real(r8) :: h2so4(pcols,pver) ! Sulphuric acid concentration [#/cm3]
+ real(r8) :: nuclvolume(pcols,pver) ! [m3/m3/s] Nucleated mass (SO4+ORG)
+ real(r8) :: rhoair(pcols,pver) ! density of air [kg/m3] !cka
+ real(r8) :: pblht_lim(pcols) ! Planetary boundary layer height (m) (500mzm(i,k) .AND. pbl_nucleation>0) then
+
+ if(pbl_nucleation .EQ. 1) then
+
+ !-- Paasonen et al. (2010), eqn 10, Table 4
+ nuclrate_pbl(i,k)=(1.7E-6_r8)*h2so4(i,k)
+
+ else if(pbl_nucleation .EQ. 2) then
+
+ !-- Paasonen et al. (2010)
+ !values from Table 3 in Paasonen et al (2010), modified version of eqn 14
+ nuclrate_pbl(i,k)=(6.1E-7_r8)*h2so4(i,k)+(0.39E-7_r8)*orgforgrowth(i,k)
+
+ end if
+
+ nuclrate_pbl(i,k)=MAX(MIN(nuclrate_pbl(i,k),1.E10_r8),0._r8)
+
+ else !Not using PBL-nucleation
+ nuclrate_pbl(i,k)=0._r8
+ end if
+ !Size [nm] of particles in PBL
+ nuclsize_pbl(i,k)=2._r8
+
+ end do !horizontal points
+ end do !levels
+
+ !-- Calculate total nucleated mass
+ do k=1,pver
+ do i=1,ncol
+
+ ! Molecular speed and growth rate: H2SO4. Eq. 21 in Kerminen and Kulmala 2002
+ vmolh2so4=SQRT(8._r8*gasconst_R*t(i,k)/(pi*molmass_h2so4*1.E-3_r8))
+ grh2so4(i,k)=(3.E-9_r8/h2so4_dens)*(vmolh2so4*molmass_h2so4*h2so4(i,k))
+ grh2so4(i,k)=MAX(MIN(grh2so4(i,k),10000._r8),1.E-10_r8)
+
+ ! Molecular speed and growth rate: ORG. Eq. 21 in Kerminen and Kulmala 2002
+ vmolorg=SQRT(8._r8*gasconst_R*t(i,k)/(pi*molmass_soa*1.E-3_r8))
+ grorg(i,k)=(3.E-9_r8/org_dens)*(vmolorg*molmass_soa*orgforgrowth(i,k))
+ grorg(i,k)=MAX(MIN(grorg(i,k),10000._r8),1.E-10_r8)
+
+ ! Combined growth rate (cka)
+ gr(i,k)=grh2so4(i,k)+grorg(i,k)
+
+ !-- Lehtinen 2007 parameterization for apparent formation rate
+ ! diameters in nm, growth rate in nm h-1, coagulation in s-1
+
+ call appformrate(nuclsize_bin(i,k), d_form*1.E9_r8, nuclrate_bin(i,k), formrate_bin(i,k), coagnuc(i,k), gr(i,k))
+ call appformrate(nuclsize_pbl(i,k), d_form*1.E9_r8, nuclrate_pbl(i,k), formrate_pbl(i,k), coagnuc(i,k), gr(i,k))
+
+ formrate_bin(i,k)=MAX(MIN(formrate_bin(i,k),1.E3_r8),0._r8)
+ formrate_pbl(i,k)=MAX(MIN(formrate_pbl(i,k),1.E3_r8),0._r8)
+
+ ! Number of mol nucleated per g air per second.
+ nuclvolume(i,k) = (formrate_bin(i,k) + formrate_pbl(i,k)) & ![particles/cm3]
+ *1.0e6_r8 & !==> [particles / m3 /]
+ /volumeToNumber(MODE_IDX_SO4SOA_AIT) & !==> [m3_{aer} / m3_{air} / sec]
+ / rhoair(i,k) !==> m3_{aer} / kg_{air} /sec
+
+ !Estimate how much is organic based on growth-rate
+ if(gr(i,k)>1.E-10_r8) then
+ frach2so4=grh2so4(i,k)/gr(i,k)
+ else
+ frach2so4=1._r8
+ end if
+
+ ! Nucleated so4 and soa mass mixing ratio per second [kg kg-1 s-1]
+ ! used density of particle phase, not of condensing gas
+ nuclso4(i,k)=rhopart(l_so4_na)*nuclvolume(i,k)*frach2so4
+ nuclorg(i,k)=rhopart(l_soa_na)*nuclvolume(i,k)*(1.0_r8-frach2so4)
+
+ end do
+ end do
+
+ !-- Diagnostic output
+ call outfld('NUCLRATE', nuclrate_bin+nuclrate_pbl, pcols ,lchnk)
+ call outfld('FORMRATE', formrate_bin+formrate_pbl, pcols ,lchnk)
+ call outfld('COAGNUCL', coagnuc, pcols ,lchnk)
+ call outfld('GRH2SO4', grh2so4, pcols ,lchnk)
+ call outfld('GRSOA', grorg, pcols ,lchnk)
+ call outfld('GR', gr, pcols ,lchnk)
+
+ return
+end
+
diff --git a/src/chemistry/oslo_aero/aerosoldef.F90 b/src/chemistry/oslo_aero/aerosoldef.F90
new file mode 100644
index 0000000000..46e855ad7e
--- /dev/null
+++ b/src/chemistry/oslo_aero/aerosoldef.F90
@@ -0,0 +1,709 @@
+module aerosoldef
+
+!---------------------------------------------------------------------------------
+! Module to set up register aerosols indexes, number of gas and particle
+! species and their scavenging rates. Tables for humidity growth
+!---------------------------------------------------------------------------------
+! Modified Spring 2015 by cka to include a version of RM's treatment of soa. (Makkonen et al. 2012)
+! Modified Summer 2015 by ak to include a new treatment of sea-salt (Salter et al. 2015)
+
+ use commondefinitions
+ use modal_aero_data, only: qqcw_set_ptr
+ use mo_tracname, only : solsym
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use constituents, only: pcnst, cnst_name,cnst_get_ind
+ use cam_abortutils, only: endrun
+
+ implicit none
+ save
+ private ! Make default type private to the module
+
+ integer, public, parameter :: max_tracers_per_mode = 7
+ real(r8), public,dimension (pcnst) ::rhopart
+ real(r8), public,dimension (pcnst) ::sgpart
+ real(r8), public,dimension (pcnst) ::osmoticCoefficient
+ real(r8), public,dimension (pcnst) ::numberOfIons
+ real(r8), public,dimension (pcnst) ::solubleMassFraction
+ integer, public,dimension (pcnst) ::aerosolType
+ real(r8), public, dimension(nbmodes) :: numberFractionAvailableAqChem
+ real(r8), public,dimension (pcnst) :: invrhopart
+
+
+ real(r8), public, parameter :: smallConcentration = 1.e-100_r8 !duplicate, sync with smallNumber in Const
+!
+! Public interfaces
+!
+ public aero_register ! register consituents
+ public is_process_mode ! Check is an aerosol specie is a process mode
+ public isAerosol ! Check is specie is aerosol (i.e. gases get .FALSE. here)
+ public getTracerIndex
+ public getNumberOfTracersInMode
+ public getNumberOfBackgroundTracersInMode
+ public getCloudTracerIndex
+ public getCloudTracerIndexDirect
+ public getCloudTracerName
+ public chemistryIndex
+ public physicsIndex
+ public getDryDensity
+ public getConstituentFraction
+ public isTracerInMode
+ public fillAerosolTracerList
+ public getNumberOfAerosolTracers
+ public fillInverseAerosolTracerList
+
+!cka: Add SOA particles to mode 1 and 11
+ integer, parameter, public :: MODE_IDX_BC_EXT_AC = 0 !Externally mixed BC accumulation mode
+ integer, parameter, public :: MODE_IDX_SO4SOA_AIT = 1 !SO4 and SOA in aitken mode, Created from 11 by growth (condensation) of SO4
+!cka integer, parameter, public :: MODE_IDX_SO4_AIT = 1 !Pure SO4 in aitken mode, Created from 11 by growth (condensation) of SO4
+ integer, parameter, public :: MODE_IDX_BC_AIT = 2 !Created from 12 by growth (condensation) SO4
+ integer, parameter, public :: MODE_IDX_NOT_USED = 3 !Not used
+ integer, parameter, public :: MODE_IDX_OMBC_INTMIX_COAT_AIT = 4 !Created from 14 by growth (condensation) of SO4 and from cloud processing/wet-phas
+ integer, parameter, public :: MODE_IDX_SO4_AC = 5 !Accumulation mode SO4 (mode will have other comps added)
+ integer, parameter, public :: MODE_IDX_DST_A2 = 6 !Accumulation mode dust (mode will have other comps added)
+ integer, parameter, public :: MODE_IDX_DST_A3 = 7 !Coarse mode dust (mode will have other comps added)
+ integer, parameter, public :: MODE_IDX_SS_A1 = 8 !Fine mode sea-salt (mode will have other comps added)
+ integer, parameter, public :: MODE_IDX_SS_A2 = 9 !Accumulation mode sea-salt (mode will have other comps added)
+ integer, parameter, public :: MODE_IDX_SS_A3 = 10 !Coarse mode sea-salt (mode will have other comps added)
+ integer, parameter, public :: MODE_IDX_SO4SOA_NUC = 11 !SO4 and SOA nucleation mode
+!cka integer, parameter, public :: MODE_IDX_SO4_NUC = 11 !SO4 nucleation mode
+ integer, parameter, public :: MODE_IDX_BC_NUC = 12 !BC nucleation mode
+ integer, parameter, public :: MODE_IDX_LUMPED_ORGANICS = 13 !not used in lifecycle, but some extra mass goes here when max. allowed LUT conc. are too small
+ integer, parameter, public :: MODE_IDX_OMBC_INTMIX_AIT = 14 !mix quickly formed in fire-plumes
+
+ integer, parameter, public :: numberOfExternallyMixedModes = 4 !Modes 0;11-14 (13 is not used in lifecycle)
+ integer, parameter, public :: numberOfInternallyMIxedMOdes = 9 !Modes 1-10 (3 is not used in lifecycle)
+
+ integer, parameter, public :: numberOfProcessModeTracers = 6
+ integer, public, dimension(numberOfProcessModeTracers) :: tracerInProcessMode
+ integer, public, dimension(pcnst) :: processModeMap
+
+ !These tables describe how the tracers behave chemically
+ integer, dimension(numberOfExternallyMixedModes), public :: externallyMixedMode = (/MODE_IDX_BC_EXT_AC,MODE_IDX_SO4SOA_NUC, MODE_IDX_BC_NUC, MODE_IDX_OMBC_INTMIX_AIT /)
+ integer, dimension(numberOfInternallyMixedMOdes), public :: internallyMixedMode = (/MODE_IDX_SO4SOA_AIT, MODE_IDX_BC_AIT, MODE_IDX_OMBC_INTMIX_COAT_AIT &
+ ,MODE_IDX_SO4_AC, MODE_IDX_DST_A2, MODE_IDX_DST_A3, MODE_IDX_SS_A1 &
+ ,MODE_IDX_SS_A2, MODE_IDX_SS_A3 /)
+
+!cka: add l_soa_n, l_soa_na (particles) l_soa_a1 (condensate) and l_soa_lv, l_soa_sv (SOA precursors)
+! following are species indices for individual camuio species
+ integer,public :: &
+ l_so4_na, l_so4_a1, l_so4_a2, l_so4_ac, &
+ l_bc_n, l_bc_ax, l_bc_ni, l_bc_a, l_bc_ai,l_bc_ac, &
+ l_om_ni, l_om_ai ,l_om_ac, &
+ l_so4_pr, &
+ l_dst_a2, l_dst_a3, &
+ l_ss_a1, l_ss_a2, l_ss_a3, l_h2so4, &
+ l_soa_na, l_soa_a1, l_soa_lv, l_soa_sv
+
+! some code here has been moved to commondefinitions...
+
+ integer :: n_aerosol_tracers !number of aerosol tracers
+
+ integer :: imozart
+
+ !Number of transported tracers in each mode
+ integer, parameter, dimension(0:nmodes) :: n_tracers_in_mode = (/ 1, 4, 3, 0, 5, 7, 7, 7, 7, 7, 7, 0, 1, 0, 2 /) !cka: added organic condensate to mode 1,2,4-10
+ integer, parameter, dimension(0:nmodes) :: n_background_tracers_in_mode = (/ 1,2,1,0,2,1,1,1,1,1,1,0,1,0,2 /) !cka: added soa to mode 1 and 11
+
+ integer, dimension(0:nmodes, max_tracers_per_mode) :: tracer_in_mode
+
+
+ !Radius used for the modes in the lifeCycle MAY ASSUME SOME GROWTH ALREADY HAPPENED
+ real(r8), parameter, public, dimension(0:nmodes) :: lifeCycleNumberMedianRadius = &
+!BCsizes 1.e-6_r8*(/ 0.1_r8, 0.02_r8, 0.0118_r8, 0.04_r8, 0.04_r8, 0.075_r8, &
+ 1.e-6_r8*(/ 0.0626_r8, 0.025_r8, 0.025_r8, 0.04_r8, 0.06_r8, 0.075_r8, &
+ 0.22_r8, 0.63_r8, 0.0475_r8, 0.30_r8, 0.75_r8, & ! Salter et al. (2015)
+!BCsizes 0.0118_r8, 0.0118_r8, 0.04_r8, 0.04_r8 /)
+ 0.0118_r8, 0.024_r8, 0.04_r8, 0.04_r8 /)
+
+ !Sigma based on original lifecycle code (taken from "sigmak" used previously in lifecycle code)
+ real(r8), parameter, public, dimension(0:nmodes) :: lifeCycleSigma = (/1.6_r8, 1.8_r8, 1.8_r8, 1.8_r8, 1.8_r8 & !0-4
+ ,1.59_r8, 1.59_r8, 2.0_r8 & !5,6,7 (SO4+dust)
+ ,2.1_r8, 1.72_r8, 1.6_r8 & !8-10 (SS) ! Salter et al. (2015)
+ ,1.8_r8, 1.8_r8, 1.8_r8, 1.8_r8 & !11-14
+ /)
+
+ !Below cloud scavenging coefficients for modes which have an actual size
+ real(r8), parameter, public, dimension(0:nmodes) :: belowCloudScavengingCoefficient= &
+ (/ 0.01_r8 , 0.02_r8 , 0.02_r8 , 0.0_r8 , 0.02_r8, 0.01_r8, & !(0-5)
+ 0.02_r8 , 0.2_r8 , 0.02_r8 , 0.02_r8, 0.5_r8, & !6-10 (DUST+SS)
+ 0.04_r8 , 0.08_r8 , 0.0_r8 , 0.02_r8 /) ! SO4_n, bc_n, N/A og bc/oc
+
+ !Treatment of process-modes!
+ !The tracers indices can not be set here since they are not known on compile time
+ !tracerInProcessMode = (/l_so4_a1, l_so4_a2, l_so4_ac, l_om_ac, l_bc_ac, l_soa_a1 /)
+
+ !The process modes need an "efficient size" (Why does A1 have a different size than the others??)
+ real(r8), parameter, public, dimension(numberOfProcessModeTracers) :: processModeNumberMedianRadius = &
+ (/ 0.04e-6_r8, 0.1e-6_r8, 0.1e-6_r8, 0.1e-6_r8, 0.1e-6_r8, 0.04e-6_r8 /)
+
+ !The process modes need an "efficient sigma"
+ real(r8), parameter, public, dimension(numberOfProcessModeTracers) :: processModeSigma = &
+ (/ 1.8_r8, 1.59_r8, 1.59_r8, 1.59_r8, 1.59_r8, 1.8_r8 /)
+
+
+ real(r8), parameter, public, dimension(numberOfProcessModeTracers) :: belowCloudScavengingCoefficientProcessModes = &
+ (/0.02_r8, 0.01_r8, 0.02_r8, 0.02_r8, 0.02_r8, 0.02_r8 /)
+
+ !Growth of aerosols, duplicated in opttab!! AK: NB oppdaterte tall i opttab, rh der er ikke helt lik rhtab...
+ real(r8), public,dimension (10) :: rhtab
+ real(r8), public,dimension (10,pcnst):: rdivr0(10,pcnst)
+
+ data rhtab/ 0.0_r8, 0.37_r8, 0.47_r8, 0.65_r8, 0.75_r8, 0.80_r8, 0.85_r8, 0.90_r8, 0.95_r8, 0.98_r8 /
+
+ integer, dimension(pcnst) :: cloudTracerIndex
+ character(len=20) :: cloudTracerName(pcnst)
+contains
+
+
+ !For a tracer in an aerosol mode, check if this is
+ !actually a real tracer or a process mode
+ function is_process_mode(l_index_in, isChemistry) result(answer)
+ implicit none
+ integer, intent(in) :: l_index_in
+ logical, intent(in) :: isChemistry !true if called from chemistry
+ integer :: l_index_phys
+ logical :: answer
+
+ l_index_phys = l_index_in
+ if(isChemistry .eqv. .true.)then
+ l_index_phys = l_index_phys + iMozart - 1
+ endif
+
+ !answer becomes true if tracer is a "process mode"
+ answer = .FALSE.
+ if(l_index_phys .eq. l_so4_a1 &
+ .OR. l_index_phys .eq. l_so4_a2 &
+ .OR. l_index_phys .eq. l_so4_ac &
+ .OR. l_index_phys .eq. l_bc_ac &
+ .OR. l_index_phys .eq. l_om_ac &
+ .OR. l_index_phys .eq. l_soa_a1 ) then
+ answer = .TRUE.
+ endif
+
+ return
+ end function is_process_mode
+
+!===============================================================================
+ subroutine aero_register
+!-----------------------------------------------------------------------
+!
+! Register aerosol modes and indices, should be changed to read in values
+! instead of hard-coding it.
+!
+!-----------------------------------------------------------------------
+
+ use mpishorthand
+ use physics_buffer, only: pbuf_add_field, dtype_r8
+ use ppgrid, only: pcols, pver, pverp
+
+
+ implicit none
+ integer :: idx_dum, l,m,mm
+ logical isAlreadyCounted(pcnst)
+
+! register the species
+
+ call cnst_get_ind('SO4_NA',l_so4_na, abort=.true.) !Aitken mode sulfate (growth from so4_n)
+ call cnst_get_ind('SO4_A1',l_so4_a1, abort=.true.) !sulfate condensate (gas phase production)
+ call cnst_get_ind('SO4_A2',l_so4_a2, abort=.true.) !sulfate produced in aq. chemistry
+ call cnst_get_ind('SO4_AC',l_so4_ac, abort=.true.) !sulfate from coagulation processes
+ call cnst_get_ind('SO4_PR',l_so4_pr, abort=.true.) !sulfate emitted as primary
+
+ call cnst_get_ind('BC_N',l_bc_n, abort=.true.) !emissions (mainly industry) lost through coagulation
+ call cnst_get_ind('BC_AX',l_bc_ax, abort=.true.) !externally mixed (fluffy and impossible to activate)
+ call cnst_get_ind('BC_NI',l_bc_ni, abort=.true.) !mixed with oc (mainly biomass), externally mixed otherwise (before condensation etc)
+ call cnst_get_ind('BC_A',l_bc_a, abort=.true.) !formed when bc_n grows by condensation
+ call cnst_get_ind('BC_AI',l_bc_ai, abort=.true.) !formed when bc_ni grows by condensation
+ call cnst_get_ind('BC_AC',l_bc_ac, abort=.true.) !bc from coagulation processes
+
+ call cnst_get_ind('OM_NI',l_om_ni, abort=.true.) !om (mainly from biomass), emitted
+ call cnst_get_ind('OM_AI',l_om_ai, abort=.true.) !om formed when condensation growth of om_ni
+ call cnst_get_ind('OM_AC',l_om_ac, abort=.true.) !om from coagulation processes
+
+ call cnst_get_ind('DST_A2',l_dst_a2, abort=.true.) !Dust accumulation mode
+ call cnst_get_ind('DST_A3',l_dst_a3, abort=.true.) !Dust coarse mode
+
+ call cnst_get_ind('SS_A1',l_ss_a1, abort=.true.) !Sea salt fine mode
+ call cnst_get_ind('SS_A2',l_ss_a2, abort=.true.) !Sea salt accumulation mode
+ call cnst_get_ind('SS_A3',l_ss_a3, abort=.true.) !Sea salt coarse mode
+
+!cka: register SOA species
+ call cnst_get_ind('SOA_NA',l_soa_na, abort=.true.) !Aitken mode SOA with SO4 and SOA condensate
+ call cnst_get_ind('SOA_A1',l_soa_a1, abort=.true.) !SOA condensate
+ call cnst_get_ind('SOA_LV',l_soa_lv, abort=.true.) !Gas phase low volatile SOA
+ call cnst_get_ind('SOA_SV',l_soa_sv, abort=.true.) !Gas phase semi volatile SOA
+
+ !gas phase h2so4
+ call cnst_get_ind('H2SO4', l_h2so4, abort=.true.)
+
+ !Register the tracers in modes
+ call registerTracersInMode()
+
+ !Set the aerosol types
+ aerosolType(:)=-99
+ aerosolType(l_so4_na)=AEROSOL_TYPE_SULFATE
+ aerosolType(l_so4_a1)=AEROSOL_TYPE_SULFATE
+ aerosolType(l_so4_a2)=AEROSOL_TYPE_SULFATE
+ aerosolType(l_so4_ac)=AEROSOL_TYPE_SULFATE
+ aerosolType(l_so4_pr)=AEROSOL_TYPE_SULFATE
+ aerosolType(l_bc_n)=AEROSOL_TYPE_BC
+ aerosolType(l_bc_ax)=AEROSOL_TYPE_BC
+ aerosolType(l_bc_ni)=AEROSOL_TYPE_BC
+ aerosolType(l_bc_a) =AEROSOL_TYPE_BC
+ aerosolType(l_bc_ai)=AEROSOL_TYPE_BC
+ aerosolType(l_bc_ac)=AEROSOL_TYPE_BC
+ aerosolType(l_om_ni)=AEROSOL_TYPE_OM
+ aerosolType(l_om_ai)=AEROSOL_TYPE_OM
+ aerosolType(l_om_ac)=AEROSOL_TYPE_OM
+ aerosolType(l_dst_a2)=AEROSOL_TYPE_DUST
+ aerosolType(l_dst_a3)=AEROSOL_TYPE_DUST
+ aerosolType(l_ss_a1)=AEROSOL_TYPE_SALT
+ aerosolType(l_ss_a2)=AEROSOL_TYPE_SALT
+ aerosolType(l_ss_a3)=AEROSOL_TYPE_SALT
+ aerosolType(l_soa_na)=AEROSOL_TYPE_OM
+ aerosolType(l_soa_a1)=AEROSOL_TYPE_OM
+
+ rhopart(:)= 1000.0_r8
+ !assign values based on aerosol type
+ do m=0,nmodes
+ do l=1,n_tracers_in_mode(m)
+ mm= getTracerIndex(m,l,.false.)
+ osmoticCoefficient(mm) = aerosol_type_osmotic_coefficient(aerosolType(mm))
+ rhopart(mm) = aerosol_type_density(aerosolType(mm))
+ solubleMassFraction(mm) = aerosol_type_soluble_mass_fraction(aerosolType(mm))
+ numberOfIons(mm) = aerosol_type_number_of_ions(aerosolType(mm))
+ end do
+ end do
+ !SPECIAL CASES OF AEROSOL PROPERTIES:
+ !Density of bc_ax is rewritten later (calculated from fractal dimension)
+ !so4_a2 is different since it is ammonium sulfate and not sulf. acid.
+ rhopart(l_so4_a2) = 1769.0_r8
+
+ !These are not really particles, but set densities for the condenseable vapours
+ !used by condtend
+ rhopart(l_h2so4)= 1841.0_r8
+ rhopart(l_soa_lv) = aerosol_type_density(AEROSOL_TYPE_OM)
+ rhopart(l_soa_sv) = aerosol_type_density(AEROSOL_TYPE_OM)
+! Inverse calculated to avoid unneeded divisions in loop
+ invrhopart(:)=1._r8/rhopart(:)
+ !Set process mode sizes
+ tracerInProcessMode = (/l_so4_a1, l_so4_a2, l_so4_ac, l_om_ac, l_bc_ac, l_soa_a1 /)
+ processModeMap(:)=-99 !Force error if using unset values
+ do l =1,pcnst
+ do m=1,numberOfProcessModeTracers
+ if(tracerInProcessMode(m) .eq. l)then
+ processModeMap(l)=m
+ end if
+ end do
+ end do
+
+ !Find out first mozart tracers (fxm: short lived species might mess up this!)
+ call cnst_get_ind(trim(solsym(1)), imozart, abort=.true.)
+
+ !Add the cloud-tracers
+ isAlreadyCounted(:) = .false.
+ cloudTracerIndex(:) = -1
+ do m=1,nmodes
+ do l=1,n_tracers_in_mode(m)
+ mm= getTracerIndex(m,l,.false.)
+ if(.not. isAlreadyCounted(mm))then
+ cloudTracerName(mm) = trim(cnst_name(mm))//"_OCW"
+ !print*, "CTN ", trim(cloudTracerName(mm))
+ call pbuf_add_field(trim(cloudTracerName(mm)), 'global', dtype_r8, (/pcols,pver/), idx_dum)
+ call qqcw_set_ptr(mm,idx_dum)
+ cloudTracerIndex(mm) = idx_dum
+ isAlreadyCounted(mm) = .true.
+ endif
+ end do
+ end do
+
+
+ !Find out how many aerosol-tracers we carry
+ isAlreadyCounted(:) = .FALSE.
+ n_aerosol_tracers=0
+ do m=1,nmodes
+ do l=1,n_tracers_in_mode(m)
+ mm=getTracerIndex(m,l,.false.)
+ if(.not. isAlreadyCounted(mm))then
+ n_aerosol_tracers = n_aerosol_tracers + 1
+ isAlreadyCounted(mm)=.true.
+ endif
+ end do
+ end do
+
+ !Tabulated rh-growth for all species
+ call inittabrh
+
+
+ return
+ end subroutine aero_register
+
+ function getNumberOfAerosolTracers()RESULT(numberOfTracers)
+ implicit none
+ integer :: numberOfTracers
+ numberOfTracers = n_aerosol_tracers
+ end function getNumberOfAerosolTracers
+
+ function chemistryIndex(phys_index) RESULT (chemistryIndexOut)
+ implicit none
+ integer, intent(in) :: phys_index
+ integer :: chemistryIndexOut
+
+ chemistryIndexOut = phys_index - imozart + 1
+ end function chemistryIndex
+
+ function physicsIndex(chem_index) RESULT(physIndexOut)
+ implicit none
+ integer, intent(in) :: chem_index
+ integer :: physIndexOut
+
+ physIndexOut = chem_index + imozart - 1
+ end function physicsIndex
+
+ function isAerosol(phys_index) RESULT(answer)
+ integer, intent(in) :: phys_index
+ logical answer
+ answer=.FALSE.
+ if(aerosolType(phys_index) .gt. 0)then
+ answer = .TRUE.
+ endif
+ return
+ end function isAerosol
+!=============================================================================
+
+ function getNumberOfTracersInMode(modeIndex) RESULT(numberOfSpecies)
+ implicit none
+ integer, intent(in) :: modeIndex
+ integer numberOfSpecies
+ numberOfSpecies = n_tracers_in_mode(modeIndex)
+ end function getNumberOfTracersInMode
+
+ function getNumberOfBackgroundTracersInMode(modeIndex) RESULT (numberOfBackgroundSpecies)
+ implicit none
+ integer, intent(in) :: modeIndex
+ integer numberOfBackgroundSpecies
+ numberOfBackgroundSpecies = n_background_tracers_in_mode(modeIndex)
+ end function getNumberOfBackgroundTracersInMode
+
+ !purpose: Ask for an index in mode
+ !The index is the index in the q-array
+ !Some tracers may exist in several modes (is that a problem??)
+ function getTracerIndex(modeIndex, componentIndex, isChemistry) RESULT(tracerIndex)
+ implicit none
+ integer, intent(in) :: modeIndex
+ integer, intent(in) :: componentIndex
+ logical, intent(in) :: isChemistry
+ integer tracerIndex
+
+ if(isChemistry)then
+ !This is tracer index in physics array
+ tracerIndex = tracer_in_mode(modeIndex,componentIndex)-imozart+1
+ else
+ tracerIndex = tracer_in_mode(modeIndex,componentIndex)
+ endif
+
+ end function getTracerIndex
+
+ !Obtain an index in the physics-buffer for a component in the lifecycle scheme
+ function getCloudTracerIndex(modeIndex, componentIndex) RESULT(cloud_tracer_index)
+ implicit none
+ integer, intent(in) :: modeIndex
+ integer, intent(in) :: componentIndex
+ integer :: tracerIndex
+ integer cloud_tracer_index
+
+ if(componentIndex == 0)then
+ !Special key for number concentration of a mode
+ print*,"error no such species"
+ stop
+ else if (componentIndex > 0)then
+ !Lifecycle specie in a mode
+ tracerIndex = getTracerIndex(modeIndex,componentIndex,.false.)
+ cloud_tracer_index = cloudTracerIndex(tracerIndex) !ak: Index in phys-buffer
+ else
+ !error, negative component index
+ call endrun("negative componentindex in getCloudTracerIndex")
+ endif
+ end function getCloudTracerIndex
+
+ !returns index in pbuf for the corresponding cloud tracer with physics index "tracerIndex"
+ !returns "-1" if the tracer does not have any corresponding cloud tracer
+ function getCloudTracerIndexDirect(tracerIndex) RESULT(cloudTracerIndexOut)
+ implicit none
+ integer, intent(in) :: tracerIndex
+ integer :: cloudTracerIndexOut
+
+ cloudTracerIndexOut = cloudTracerIndex(tracerIndex)
+
+ end function getCloudTracerIndexDirect
+
+ function getDryDensity(m,l) RESULT(density)
+ implicit none
+ integer, intent(in) :: m !mode index
+ integer, intent(in) :: l !tracer index
+ real(r8) :: density
+ density = rhopart(tracer_in_mode(m,l))
+ end function
+
+
+ function getCloudTracerName(tracerIndex) RESULT(cloudTracerNameOut)
+ implicit none
+ integer, intent(in) :: tracerIndex
+ character(len=20) :: cloudTracerNameOut
+ cloudTracerNameOut = trim(cloudTracerName(tracerIndex))
+ return
+ end function getCloudTracerName
+
+ subroutine fillAerosolTracerList(aerosolTracerList)
+ implicit none
+ integer, dimension (:), intent(out) :: aerosolTracerList
+ logical, dimension(pcnst) :: alreadyFound
+
+ integer :: m,l,mm,nTracer
+
+ alreadyFound(:) = .FALSE.
+
+ nTracer = 0
+ do m=1,nmodes
+ do l=1,n_tracers_in_mode(m)
+ mm=getTracerIndex(m,l,.FALSE.)
+ if(.NOT.alreadyFound(mm))then
+ nTracer = nTracer + 1
+ alreadyFound(mm) = .TRUE.
+ aerosolTracerList(nTracer) = mm
+ end if
+ end do
+ end do
+ end subroutine fillAerosolTracerList
+
+ subroutine fillInverseAerosolTracerList(aerosolTracerList, inverseAerosolTracerList, n_aerosol_tracers)
+ implicit none
+ integer, dimension(:), intent(in) :: aerosolTracerList
+ integer, intent(in) :: n_aerosol_tracers
+ integer, dimension(pcnst), intent(out) :: inverseAerosolTracerList
+ integer :: i
+
+ inverseAerosolTracerList(:) = -99
+ do i=1,n_aerosol_tracers
+ inverseAerosolTracerList(aerosolTracerList(i)) = i
+ end do
+
+ end subroutine
+
+ !Register tracer index in modes
+ subroutine registerTracersInMode()
+
+ implicit none
+
+ tracer_in_mode(:,:) = -1 !undefined
+ !externally mixed bc
+ tracer_in_mode(MODE_IDX_BC_EXT_AC, 1:n_tracers_in_mode(MODE_IDX_BC_EXT_AC)) = (/l_bc_ax/)
+!cka !sulphate + sulfate condensate
+!cka tracer_in_mode(MODE_IDX_SO4_AIT, 1:n_tracers_in_mode(MODE_IDX_SO4_AIT) ) = (/l_so4_na, l_so4_a1/)
+ !sulphate + soa, sulfate condensate.
+ tracer_in_mode(MODE_IDX_SO4SOA_AIT, 1:n_tracers_in_mode(MODE_IDX_SO4SOA_AIT) ) = (/l_so4_na, l_soa_na, l_so4_a1, l_soa_a1/)
+ !bc + sulfate condensate
+ tracer_in_mode(MODE_IDX_BC_AIT,1:n_tracers_in_mode(MODE_IDX_BC_AIT)) = (/l_bc_a, l_so4_a1, l_soa_a1/)
+ !index not used
+ !tracer_in_mode(MODE_IDX_NOT_USED, 1:n_tracers_in_mode(MODE_IDX_NOT_USED)) = (/-1/)
+ !om / bc internally mixed with sulfate condensate and aquous phase sulfate
+ tracer_in_mode(MODE_IDX_OMBC_INTMIX_COAT_AIT, 1:n_tracers_in_mode(MODE_IDX_OMBC_INTMIX_COAT_AIT))= (/l_bc_ai, l_om_ai, l_so4_a1, l_so4_a2, l_soa_a1 /)
+ !accumulation mode sulfate with coagulate, condensate and aquous phase sulfate
+ tracer_in_mode(MODE_IDX_SO4_AC, 1:n_tracers_in_mode(MODE_IDX_SO4_AC)) = (/l_so4_pr, l_bc_ac, l_om_ac, l_so4_a1, l_so4_ac, l_so4_a2, l_soa_a1 /)
+ !ac-mode dust with sulfate coagulate, condensate sulfate and wet-phase sulfate
+ tracer_in_mode(MODE_IDX_DST_A2, 1:n_tracers_in_mode(MODE_IDX_DST_A2)) = (/l_dst_a2, l_bc_ac, l_om_ac, l_so4_a1, l_so4_ac, l_so4_a2, l_soa_a1 /)
+ !coarse mode dust with sulfate coagulate, condensate sulfate and wet-phase sulfate
+ tracer_in_mode(MODE_IDX_DST_A3, 1:n_tracers_in_mode(MODE_IDX_DST_A3)) = (/l_dst_a3, l_bc_ac, l_om_ac, l_so4_a1, l_so4_ac, l_so4_a2, l_soa_a1 /)
+ !at-mode ss with sulfate coagulate, condensate sulfate and wet-phase sulfate
+ tracer_in_mode(MODE_IDX_SS_A1, 1:n_tracers_in_mode(MODE_IDX_SS_A1)) = (/l_ss_a1, l_bc_ac, l_om_ac, l_so4_a1, l_so4_ac, l_so4_a2, l_soa_a1 /)
+ !ac mode ss with sulfate coagulate, condensate sulfate and wet-phase sulfate
+ tracer_in_mode(MODE_IDX_SS_A2, 1:n_tracers_in_mode(MODE_IDX_SS_A2)) = (/l_ss_a2, l_bc_ac, l_om_ac, l_so4_a1, l_so4_ac, l_so4_a2, l_soa_a1 /)
+ !coarse mode ss sulfate coagulate, condensate sulfate and wet-phase sulfate
+ tracer_in_mode(MODE_IDX_SS_A3, 1:n_tracers_in_mode(MODE_IDX_SS_A3)) = (/l_ss_a3, l_bc_ac, l_om_ac, l_so4_a1, l_so4_ac, l_so4_a2, l_soa_a1 /)
+ !sulfate + soa nucleation mode (mode no longer used)
+ !tracer_in_mode(MODE_IDX_SO4SOA_NUC, 1:n_tracers_in_mode(MODE_IDX_SO4SOA_NUC)) = (/ -1 /)
+ !bc in nucleation mode
+ tracer_in_mode(MODE_IDX_BC_NUC, 1:n_tracers_in_mode(MODE_IDX_BC_NUC)) = (/l_bc_n/)
+ !lumped organics
+ !tracer_in_mode(MODE_IDX_LUMPED_ORGANICS, 1:n_tracers_in_mode(MODE_IDX_LUMPED_ORGANICS)) = (/-1/)
+ !intermal mixture bc/oc coated
+ tracer_in_mode(MODE_IDX_OMBC_INTMIX_AIT, 1:n_tracers_in_mode(MODE_IDX_OMBC_INTMIX_AIT)) = (/l_bc_ni, l_om_ni/)
+
+ end subroutine registerTracersInMode
+ !
+
+ function isTracerInMode(modeIndex, constituentIndex)RESULT(answer)
+ implicit none
+ integer, intent(in) :: modeIndex
+ integer, intent(in) :: constituentIndex
+ integer :: i
+ logical :: answer
+ answer = .FALSE.
+ do i=1,n_tracers_in_mode(modeIndex)
+ if(tracer_in_mode(modeIndex,i) == constituentIndex)then
+ answer = .TRUE.
+ endif
+ enddo
+ return
+ end function isTracerInMode
+ !
+
+ function getConstituentFraction(CProcessModes, f_c, f_bc, f_aq, f_so4_cond,f_soa &
+ ,Cam, f_acm, f_bcm, f_aqm, f_so4_condm,f_soam, constituentIndex,debugPrint ) RESULT(fraction) ! mass fraction
+ implicit none
+ real(r8), intent(in) :: CProcessModes
+ real(r8), intent(in) :: f_c
+ real(r8), intent(in) :: f_bc
+ real(r8), intent(in) :: f_aq
+ real(r8), intent(in) :: f_so4_cond
+ real(r8), intent(in) :: f_soa
+ real(r8), intent(in) :: cam
+ real(r8), intent(in) :: f_aqm
+ real(r8), intent(in) :: f_bcm
+ real(r8), intent(in) :: f_acm
+ real(r8), intent(in) :: f_so4_condm
+ real(r8), intent(in) :: f_soam
+ integer, intent(in) :: constituentIndex
+ logical, optional, intent(in) :: debugPrint
+ logical :: doPrint = .false.
+ real(r8) :: fraction
+
+ if(present(debugPrint))then
+ if(debugPrint .eqv. .true.)then
+ doPrint=.true.
+ endif
+ endif
+
+
+ fraction = 1.0_r8 ! fraction = 1 for all tracers, except special cases (process modes) below
+
+ !This fraction is the mass of a certain tracer in a specific size-mode divided by the total
+ !mass of the same tracer for (i.e. summed up over) all size-modes. This total mass is what
+ !is transported in the model, in the life cycle scheme. The word size-mode is here used for a mode in the
+ !aerosol size-distribution, which is assumed to be log-normal prior to growth.
+ if((l_so4_a1 .eq. constituentIndex))then !so4 condensation
+ fraction= (cam &
+ *(1.0_r8-f_acm) & !sulfate fraction
+ *(1.0_r8-f_aqm) & !fraction not from aq phase
+ *(f_so4_condm) & !fraction being condensate
+ ) &
+ / &
+ (CProcessModes*(1.0_r8-f_c)*(1.0_r8-f_aq)*f_so4_cond+smallConcentration) !total so4 condensate
+
+ if(doPrint .eqv. .true.)then
+ print*, " "
+ print*, "conc ==>", CProcessmodes, cam
+ print*, "modefrc ==>", f_acm, f_aqm, f_so4_condm
+ print*, "totfrc ==>", f_c, f_aq, f_so4_cond
+ print*, "fraction ==>", cam/(CProcessModes+smallConcentration)*100.0, fraction*100 , "%"
+ endif
+
+ else if(l_so4_ac .eq. constituentIndex)then !so4 coagulation
+ fraction = (cam &
+ * (1.0_r8 - f_acm) & !sulfate fraction
+ * (1.0_r8 - f_aqm) & !fraction not from aq phase
+ * (1.0_r8 - f_so4_condm) & !fraction not being condensate
+ ) &
+ / &
+ (CProcessModes*(1.0_r8-f_c)*(1.0_r8-f_aq)*(1.0_r8-f_so4_cond) & !total non-aq sulf
+ +smallConcentration)
+
+ else if(l_so4_a2 .eq. constituentIndex) then !so4 wet phase
+ fraction = (cam &
+ *(1.0_r8-f_acm) & !sulfate fraction
+ *f_aqm) & !aq phase fraction of sulfate
+ / &
+ (CProcessModes*(1.0_r8-f_c)*(f_aq)+smallConcentration)
+
+ else if(l_bc_ac .eq. constituentIndex)then !bc coagulated
+ fraction = (cam &
+ *f_acm & ! carbonaceous fraction
+ *f_bcm) & ! bc fraction of carbonaceous
+ / &
+ (CProcessModes*f_c*f_bc+smallConcentration)
+
+ else if(l_om_ac .eq. constituentIndex ) then !oc coagulated
+ fraction = (cam &
+ *f_acm & ! carbonaceous fraction
+ *(1.0_r8-f_bcm) & ! oc fraction of carbonaceous
+ *(1.0_r8-f_soam))& ! oc fraction which is soa
+ / &
+ (CProcessModes*f_c*(1.0_r8-f_bc)*(1.0_r8-f_soa)+smallConcentration)
+
+ else if (l_soa_a1 .eq. constituentIndex) then !SOA condensate
+ fraction = cam &
+ *f_acm & !carbonaceous fraction
+ *(1.0_r8 -f_bcm) & !om fraction
+ *(f_soam) & !fraction of OM is SOA
+ / &
+ (CProcessModes * f_c* (1.0_r8 -f_bc)*f_soa + smallConcentration)
+ end if
+
+ !if(fraction .gt. 1.2_r8)then
+ ! if(cam .gt. 1.e-8 *CprocessModes)then
+ ! print*, "warning, fraction > 1.2 in getConstituentFraction", constituentIndex, fraction
+ ! print*, " ==> ", CprocessModes, cam ,f_c, f_bc, f_aq,f_so4_cond
+ ! print*, " ==> ", f_acm, f_bcm, f_aq, f_so4_condm
+ ! print*, " ==> ", cam/CprocessModes
+ ! !stop
+ ! endif
+ ! fraction = 1.0_r8
+ if (fraction .gt. 1.0_r8)then
+ fraction = 1.0_r8
+ endif
+
+ return
+ end function getConstituentFraction
+
+!**********************************************
+
+
+ subroutine inittabrh
+
+ ! Tables for hygroscopic growth
+
+ integer :: i
+
+
+ real(r8) :: rr0ss(10),rr0so4(10),rr0bcoc(10)
+
+ data rr0ss / 1.00_r8, 1.00_r8, 1.02_r8, 1.57_r8, 1.88_r8, 1.97_r8, 2.12_r8, 2.35_r8, 2.88_r8, 3.62_r8 /
+ data rr0so4 / 1.00_r8, 1.34_r8, 1.39_r8, 1.52_r8, 1.62_r8, 1.69_r8, 1.78_r8, 1.92_r8, 2.22_r8, 2.79_r8 /
+ data rr0bcoc / 1.00_r8, 1.02_r8, 1.03_r8, 1.12_r8, 1.17_r8, 1.20_r8, 1.25_r8, 1.31_r8, 1.46_r8, 1.71_r8 /
+
+ rdivr0(:,:)=1._r8
+
+ do i=1,10
+ rdivr0(i,l_so4_na)=rr0so4(i)
+ rdivr0(i,l_so4_a1)=rr0so4(i)
+ rdivr0(i,l_so4_a2)=rr0so4(i)
+ rdivr0(i,l_so4_ac)=rr0so4(i)
+ rdivr0(i,l_so4_pr)=rr0so4(i)
+
+ rdivr0(i,l_bc_a)=rr0bcoc(i)
+
+! rdivr0(i,l_bc_n)=rr0bcoc(i)
+ rdivr0(i,l_bc_ni)=rr0bcoc(i)
+ rdivr0(i,l_bc_ai)=rr0bcoc(i)
+ rdivr0(i,l_bc_ac)=rr0bcoc(i)
+
+! rdivr0(i,l_om_n)=rr0bcoc(i)
+ rdivr0(i,l_om_ni)=rr0bcoc(i)
+ rdivr0(i,l_om_ai)=rr0bcoc(i)
+ rdivr0(i,l_om_ac)=rr0bcoc(i)
+
+ rdivr0(i,l_ss_a1)=rr0ss(i)
+ rdivr0(i,l_ss_a2)=rr0ss(i)
+ rdivr0(i,l_ss_a3)=rr0ss(i)
+
+!cka: Add hygroscopic properties for soa. Assume identical to bcoc properties.
+ rdivr0(i,l_soa_na)=rr0bcoc(i)
+! rdivr0(i,l_soa_a1)=rr0bcoc(i)
+
+ end do
+ return
+ end subroutine inittabrh
+
+end module aerosoldef
+
+
diff --git a/src/chemistry/oslo_aero/appformrate.F90 b/src/chemistry/oslo_aero/appformrate.F90
new file mode 100644
index 0000000000..53ef08c64d
--- /dev/null
+++ b/src/chemistry/oslo_aero/appformrate.F90
@@ -0,0 +1,58 @@
+subroutine appformrate(d1, dx, j1, jx, CoagS_dx, gr)
+ !-- appformrate calculates the formation rate jx of dx sized particles from the nucleation rate j1 (d1 sized particles)
+ !-- Formation rate is parameterized according to Lehtinen et al. (2007), JAS 38:988-994
+ !-- Parameterization takes into account the loss of particles due to coagulation
+ !-- Growth by self-coagulation is not accounted for
+ !-- Typically, 1% of 1 nm nuclei make it to 12 nm
+ !-- Written by Risto Makkonen
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ implicit none
+
+ !-- Arguments
+
+ real(r8), intent(in) :: d1 ! Size of nucleation-sized particles (nm)
+ real(r8), intent(in) :: dx ! Size of calculated apparent formation rate (nm)
+ real(r8), intent(in) :: j1 ! Nucleation rate of d1 sized particles (# cm-3 s-1)
+ real(r8), intent(out) :: jx ! Formation rate of dx sized particles (# cm-3 s-1)
+ real(r8), intent(in) :: CoagS_dx ! Coagulation term for nucleating particles (s-1)
+ real(r8), intent(in) :: gr ! Particle growth rate (nm h-1)
+
+ !-- Local variables
+
+ real(r8) :: m
+ real(r8) :: gamma
+ real(r8) :: CoagS_d1 ! Coagulation term for nucleating particles, calculated from CoagS_dx
+
+ ! In Hyytiala, typically 80% of the nuclei are scavenged onto larger background particles while they grow from 1 to 3 nm
+
+ !-- (Eq. 6) Exponent m, depends on background distribution
+ ! m=log(CoagS_dx/CoagS_d1)/log(dx/d1)
+ ! Or, if we dont want to calculate CoagS_d1, lets assume a typical value for m (-1.5 -- -1.9) and calculate CoagS_d1 from Eq.5
+ m=-1.6_r8
+ CoagS_d1=CoagS_dx*(d1/dx)**m
+ CoagS_d1=MAX(MIN(CoagS_d1,1.E2_r8),1.E-10_r8)
+
+ gamma=(1._r8/(m+1._r8))*((dx/d1)**(m+1._r8)-1._r8)
+ gamma=MAX(MIN(gamma,1.E2_r8),1.E-10_r8)
+
+ !gr=MAX(MIN(gr,1.E3_r8),1.E-5_r8)
+
+ !-- (Eq. 7) CoagS_d1 is multiplied with 3600 to get units h-1
+ !WRITE(*,*) 'gammaym:',gamma,exp(-gamma*d1*CoagS_d1*3600/gr)
+ jx=j1*exp(-gamma*d1*CoagS_d1*3600._r8/gr)
+
+ return
+
+end
+
+ ! First estimate: 99% of particles are lost during growth from 1 nm to 12 nm
+
+ ! Koagtendista:
+ ! Siis lasketaan siella koagulaatio SO4_N -moodille.
+ ! Condtend lasketaan ennen coagtendia, eli naita ei ole saatavilla!! Voisiko vaihtaa jarjestysta
+ ! Nama on constants.F90:ssa
+ ! rhob(0) = rhopart(l_bc_ax) ! mostly not in use (rhorbc in stead)
+ ! rk(1) = effsize(l_so4_n)*1.e6_r8
+ ! Pitaisko siis koagsubissa laskea oma Kp12s4 nukleaatiokoon hiukkasille, vai olettaako samaksi kuin 10nm, vai onko joku kaava
diff --git a/src/chemistry/oslo_aero/calcaersize.F90 b/src/chemistry/oslo_aero/calcaersize.F90
new file mode 100644
index 0000000000..cbc65878c6
--- /dev/null
+++ b/src/chemistry/oslo_aero/calcaersize.F90
@@ -0,0 +1,179 @@
+module calcaersize
+
+contains
+
+! � Seland Calculates mean volume size and hygroscopic growth for use in
+! dry deposition
+ subroutine calcaersize_sub( ncol, &
+ t, h2ommr, pmid, pdel,wetnumberMedianDiameter,wetrho &
+ , wetNumberMedianDiameter_processmode, wetrho_processmode)
+
+
+ use constituents, only : pcnst
+ use shr_kind_mod,only: r8 => shr_kind_r8
+ use ppgrid
+ use wv_saturation, only: qsat_water
+ use commondefinitions, only: nmodes
+ use aerosoldef
+ use physconst, only: rhoh2o
+
+ implicit none
+
+ integer, intent(in) :: ncol ! number of columns
+ real(r8), intent(in) :: t(pcols,pver) ! layer temperatures (K)
+ real(r8), intent(in) :: h2ommr(pcols,pver) ! layer specific humidity
+ real(r8), intent(in) :: pmid(pcols,pver) ! layer pressure (Pa)
+ real(r8), intent(in) :: pdel(pcols,pver) ! layer pressure thickness (Pa)
+
+ real(r8), intent(out):: wetNumberMedianDiameter(pcols,pver,0:nmodes)
+ real(r8), intent(out):: wetrho(pcols,pver,0:nmodes) ! wet aerosol density
+ real(r8), intent(out) :: wetNumberMedianDiameter_processmode(pcols,pver,numberOfProcessModeTracers)
+ real(r8), intent(out) :: wetrho_processmode(pcols,pver,numberOfProcessModeTracers)
+
+! local variables
+ real(r8) :: relhum(pcols,pver) ! Relative humidity
+ integer :: i,k,m,irelh,mm, tracerCounter
+ integer ::l ! species index
+ real(r8) :: xrh(pcols,pver)
+ real(r8) :: qs(pcols,pver) ! saturation specific humidity
+ real(r8) :: rmeanvol ! Mean radius with respect to volume
+ integer :: irh1(pcols,pver),irh2(pcols,pver)
+ integer :: t_irh1,t_irh2
+ real(r8) :: t_rh1,t_rh2,t_xrh,rr1,rr2
+ real(r8) :: volumeFractionAerosol !with respect to total (aerosol + water)
+ real(r8) :: tmp1, tmp2
+ real(r8) :: wetrad_tmp(max_tracers_per_mode)
+ real(r8) :: dry_rhopart_tmp(max_tracers_per_mode)
+ real(r8) :: mixed_dry_rho
+
+
+ !Get the tabulated rh in all grid cells
+ do k=1,pver
+ do i=1,ncol
+ call qsat_water(t(i,k),pmid(i,k), tmp1, qs(i,k), tmp2)
+ xrh(i,k) = h2ommr(i,k)/qs(i,k)
+!cak
+! if(xrh(i,k).lt.0.0_r8.or.xrh(i,k).gt.1.0_r8) then
+! write(*,*) 'i,k,rh calcaer=',i,k,xrh(i,k)
+! endif
+!cak
+ xrh(i,k) = max(xrh(i,k),0.0_r8)
+ xrh(i,k) = min(xrh(i,k),1.0_r8)
+ relhum(i,k)=xrh(i,k)
+ xrh(i,k)=min(xrh(i,k),rhtab(10))
+ end do
+ end do
+
+ !Find the relh-index in all grid-points
+ do irelh=1,SIZE(rhtab) - 1
+ do k=1,pver
+ do i=1,ncol
+ if(xrh(i,k).ge.rhtab(irelh).and. &
+ xrh(i,k).le.rhtab(irelh+1)) then
+ irh1(i,k)=irelh !lower index
+ irh2(i,k)=irelh+1 !higher index
+ end if
+ end do
+ end do
+ end do
+
+ do k=1,pver
+ do i=1,ncol
+
+ !Get the indexes out as floating point single numbers
+ t_irh1 = irh1(i,k)
+ t_irh2 = irh2(i,k)
+ t_rh1 = rhtab(t_irh1)
+ t_rh2 = rhtab(t_irh2)
+ t_xrh = xrh(i,k)
+
+ do m = 0, nmodes
+ !Do some weighting to mass mean property
+ !weighting by 1.5 is number median ==> volumetric mean
+ !http://dust.ess.uci.edu/facts/psd/psd.pdf
+ rmeanvol = lifeCycleNumberMedianRadius(m)*DEXP(1.5_r8*(log(lifeCycleSigma(m)))**2)
+ wetNumberMedianDiameter(i,k,m ) = 0.1e-6_r8 !Initialize to something..
+ mixed_dry_rho = 1.e3_r8
+
+ tracerCounter = 0
+ do l = 1,getNumberOfBackgroundTracersInMode(m)
+
+ tracerCounter = tracerCounter + 1
+
+ !which tracer is this?
+ mm = getTracerIndex(m,l,.false.)
+
+ !radius of lower rh-bin for this tracer
+ rr1=rdivr0(t_irh1,mm)
+
+ !radius of upper rh-bin for this tracer
+ rr2=rdivr0(t_irh2,mm)
+
+ !linear interpolate dry ==> wet radius for this tracer
+ wetrad_tmp(tracerCounter) = (((t_rh2-t_xrh)*rr1+(t_xrh-t_rh1)*rr2)/ &
+ (t_rh2-t_rh1))*rmeanvol
+
+ !mixed density of dry particle
+ dry_rhopart_tmp(tracerCounter) = getDryDensity(m,l)
+
+ end do
+
+ !Find the average growth of this mode
+ !(still not taking into account how much we have!!)
+ if(TracerCounter .gt. 0)then
+
+ !Convert to diameter and take average (note: This is MASS median diameter)
+ wetNumberMedianDiameter(i,k,m) = 2.0_r8 * SUM(wetrad_tmp(1:tracerCounter))/dble(tracerCounter)
+
+ !Take average density
+ mixed_dry_rho = SUM(dry_rhopart_tmp(1:tracerCounter))/dble(tracerCounter)
+
+ !At this point the radius is in "mass mean" space
+ volumeFractionAerosol = MIN(1.0_r8, ( 2.0_r8*rmeanVol / wetNumberMedianDiameter(i,k,m) )**3)
+
+ !wet density
+ wetrho(i,k,m) = mixed_dry_rho * volumeFractionAerosol &
+ + (1._r8-volumeFractionAerosol)*rhoh2o
+
+ !convert back to number median diameter (wet)
+ wetNumberMedianDiameter(i,k,m) = wetNumberMedianDiameter(i,k,m)*DEXP(-1.5_r8*(log(lifeCycleSigma(m)))**2)
+ endif
+
+
+ end do !modes
+
+ !Same thing for the process modes
+ do l=1,numberOfProcessModeTracers
+
+ mm = tracerInProcessMode(l) !process mode tracer (physics space)
+
+ !weighting by 1.5 is number median ==> volumetric mean
+ !http://dust.ess.uci.edu/facts/psd/psd.pdf
+ rmeanvol = processModeNumberMedianRadius(l)*DEXP(1.5_r8*(log(processModeSigma(l)))**2)
+
+ !radius of lower rh-bin for this tracer
+ rr1=rdivr0(t_irh1,mm)
+
+ !radius of upper rh-bin for this tracer
+ rr2=rdivr0(t_irh2,mm)
+
+ !Note this is MASS median diameter
+ wetNumberMedianDiameter_processmode(i,k,l) = (((t_rh2-t_xrh)*rr1+(t_xrh-t_rh1)*rr2)/ &
+ (t_rh2-t_rh1))*rmeanvol*2.0_r8
+
+ volumeFractionAerosol = MIN(1.0, (2.0_r8*rmeanVol/wetnumberMedianDiameter_processmode(i,k,l))**3)
+
+ wetrho_processmode(i,k,l) = volumeFractionAerosol*rhopart(mm) &
+ + (1.0_r8 - volumeFractionAerosol)*rhoh2o
+
+ !convert back to number median diameter (wet)
+ wetNumberMedianDiameter_processMode(i,k,l) = wetNumberMedianDiameter_processMode(i,k,l)*DEXP(-1.5_r8*(log(processModeSigma(l)))**2)
+ end do !process modes
+ end do !horizontal points
+ end do !layers
+
+ return
+ end subroutine calcaersize_sub
+end module
+
+
diff --git a/src/chemistry/oslo_aero/commondefinitions.F90 b/src/chemistry/oslo_aero/commondefinitions.F90
new file mode 100644
index 0000000000..aaccd85641
--- /dev/null
+++ b/src/chemistry/oslo_aero/commondefinitions.F90
@@ -0,0 +1,79 @@
+
+module commondefinitions
+
+!---------------------------------------------------------------------------------
+! Module for aerosol hygroscopicities and dry size parameters which are common
+! in AeroTab and CAM5-Oslo. Note: This file is not yet linked with AeroTab, so
+! make sure that the look-up tables made with AeroTab (optics and the dry size
+! parameters for modified size distributions) are based on the same version of
+! commondefinitions.F90.
+!---------------------------------------------------------------------------------
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ implicit none
+
+
+ !Define some aerosol types and their properties..
+ integer, parameter, public :: N_AEROSOL_TYPES = 5
+ integer, parameter, public :: AEROSOL_TYPE_SULFATE = 1
+ integer, parameter, public :: AEROSOL_TYPE_BC = 2
+ integer, parameter, public :: AEROSOL_TYPE_OM = 3
+ integer, parameter, public :: AEROSOL_TYPE_DUST = 4
+ integer, parameter, public :: AEROSOL_TYPE_SALT = 5
+
+ !NUMBERS BELOW ARE ESSENTIAL TO CALCULATE HYGROSCOPICITY AND THEREFORE INDIRECT EFFECT!
+ !These numbers define the "hygroscopicity parameter" Numbers are selected so that they give reasonable hygroscipity
+ !note that changing numbers individually changes the hygroscopicity!
+ !Hygroscopicity is defined in Abdul-Razzak and S. Ghan: (B in their eqn 4)
+ !A parameterization of aerosol activation 2. Multiple aerosol types, JGR, vol 105, noD5, pp 6837
+ !http://onlinelibrary.wiley.com/doi/10.1029/1999JD901161/abstract
+ !
+ !Further note that changing any of these numbers without changing aerotab will lead to
+ !inconsistencies in the simulation since Aerotab tabulates hygroscopical growth!
+ !
+ !Main reference for numbers chosen: Ghan et al MIRAGE paper (JRG, vol 106, D6, pp 5295), 2001
+ !References:
+ !SULFATE : Using same numbers as MIRAGE paper (ammonium sulfate)
+ !BC : Does not really matter as long as soluble mass fraction is small
+ ! However, numbers below reproduces values from MIRAGE paper
+ ! New mass density (October 2016) is based on Bond and Bergstrom (2007): Light Absorption
+ ! by Carbonaceous Particles: An Investigative Review, Aerosol Science and Technology, 40:27œôòó67.
+ !OM : Soluble mass fraction tuned to give B of MIRAGE Paper
+ !DUST : The numbers give B of ~ 0.07 (high end of Kohler, Kreidenweis et al, GRL, vol 36, 2009.
+ ! (10% as soluble mass fraction seems reasonable)
+ ! (see also Osada et al, Atmospheric Research, vol 124, 2013, pp 101
+ !SEA SALT: Soluble mass fraction tuned to give consistent values for (r/r0) at 99% when using the parametrization in
+ ! Koepke, Hess, Schult and Shettle: Max-Plack-Institut fur Meteorolgie, report No. 243 "GLOBAL AEROSOL DATA SET"
+ ! These values give "B" of 1.20 instead of 1.16 in MIRAGE paper.
+
+ character(len=8),public, dimension(N_AEROSOL_TYPES) :: aerosol_type_name = &
+ (/"SULFATE ", "BC ","OM ", "DUST ", "SALT " /)
+ real(r8), public, dimension(N_AEROSOL_TYPES) :: aerosol_type_density = &
+ (/1769.0_r8, 1800.0_r8, 1500.0_r8, 2600.0_r8, 2200.0_r8 /) !kg/m3
+ real(r8), public, dimension(N_AEROSOL_TYPES) :: aerosol_type_molecular_weight = &
+ (/132.0_r8, 12.0_r8, 168.2_r8, 135.0_r8, 58.44_r8 /) !kg/kmol
+ real(r8), public, dimension(N_AEROSOL_TYPES) :: aerosol_type_osmotic_coefficient = &
+ (/0.7_r8, 1.111_r8, 1.0_r8, 1.0_r8, 1.0_r8 /) ![-]
+ real(r8), public, dimension(N_AEROSOL_TYPES) :: aerosol_type_soluble_mass_fraction = &
+ (/1.0_r8, 1.67e-7_r8, 0.8725_r8, 0.1_r8, 0.885_r8 /) ![-]
+ real(r8), public, dimension(N_AEROSOL_TYPES) :: aerosol_type_number_of_ions = &
+ (/3.0_r8, 1.0_r8, 1.0_r8, 2.0_r8, 2.0_r8 /) ![-]
+
+! Define lognormal size parameters for each size mode (dry, at point of emission/production)
+ integer, public, parameter :: nmodes = 14
+ integer, public, parameter :: nbmodes = 10
+ !Number median radius of background emissions THESE DO NOT ASSUME IMPLICIT GROWTH!!
+ real(r8), parameter, public, dimension(0:nmodes) :: originalNumberMedianRadius = &
+ 1.e-6_r8* (/ 0.0626_r8, & !0
+ 0.0118_r8, 0.024_r8, 0.04_r8, 0.04_r8, 0.075_r8, & !1-5
+ 0.22_r8, 0.63_r8, 0.0475_r8, 0.30_r8, 0.75_r8, & !6-10 ! SS: Salter et al. (2015)
+ 0.0118_r8, 0.024_r8, 0.04_r8, 0.04_r8 /) !11-14
+
+ !sigma of background aerosols )
+ real(r8), parameter, public, dimension(0:nmodes) :: originalSigma = &
+ (/1.6_r8, & !0
+ 1.8_r8, 1.8_r8, 1.8_r8, 1.8_r8, 1.59_r8, & !1-5
+ 1.59_r8, 2.0_r8, 2.1_r8, 1.72_r8, 1.60_r8, & !6-10 ! SS: Salter et al. (2015)
+ 1.8_r8, 1.8_r8, 1.8_r8, 1.8_r8 /) !11-14
+
+end module
diff --git a/src/chemistry/oslo_aero/condtend.F90 b/src/chemistry/oslo_aero/condtend.F90
new file mode 100644
index 0000000000..1b8cc27ed1
--- /dev/null
+++ b/src/chemistry/oslo_aero/condtend.F90
@@ -0,0 +1,640 @@
+module condtend
+
+ use phys_control, only: phys_getopts
+ use chem_mods, only: gas_pcnst
+ use mo_tracname, only: solsym
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use ppgrid
+ use const
+ use cam_history, only: outfld
+ use aerosoldef
+ use physconst, only: rair, gravit, pi
+ use commondefinitions
+ use chem_mods, only: adv_mass !molecular weights from mozart
+!soa
+
+ save
+
+ integer, parameter :: N_COND_VAP = 3
+ integer, parameter :: COND_VAP_H2SO4 = 1
+ integer, parameter :: COND_VAP_ORG_LV = 2
+ integer, parameter :: COND_VAP_ORG_SV = 3
+
+ real(r8), public, dimension(0:nmodes,N_COND_VAP) :: normalizedCondensationSink ![m3/#/s] condensation sink per particle in mode i
+
+ integer, private, dimension(gas_pcnst) :: lifeCycleReceiver ! [-] array of transformation of life cycle tracers
+ real(r8), private, dimension(0:nmodes,N_COND_VAP) :: stickingCoefficient ! [-] stickingCoefficient for H2SO4 on a mode
+ integer, private, dimension(N_COND_VAP) :: cond_vap_map
+
+! Assumed number of monolayers
+ real(r8), parameter, private :: n_so4_monolayers_age = 3.0_r8
+
+ real(r8), parameter, public :: &
+ dr_so4_monolayers_age = n_so4_monolayers_age * 4.76e-10_r8
+! thickness of the so4 monolayers (m)
+! for so4(+nh4), use bi-sulfate mw and 1.77 g/cm3 as in MAM
+
+
+contains
+
+ subroutine registerCondensation()
+
+ implicit none
+
+
+ integer :: iDonor
+ integer :: l_donor
+ integer :: tracerIndex
+ integer :: mode_index_donor
+
+ !These are the lifecycle-species which receive mass when
+ !the externally mixed modes receive condensate,
+ !e.g. the receiver of l_so4_n mass is the tracer l_so4_na
+ lifeCycleReceiver(:) = -99
+ lifeCycleReceiver(chemistryIndex(l_bc_n)) = chemistryIndex(l_bc_a) !create bc int mix from bc in mode 12
+ lifeCycleReceiver(chemistryIndex(l_bc_ni)) = chemistryIndex(l_bc_ai) !create bc int mix from bc in mode 14
+ lifeCycleReceiver(chemistryIndex(l_om_ni)) = chemistryIndex(l_om_ai)
+ !!create om int mix from om in mode 14
+ lifeCycleReceiver(chemistryIndex(l_bc_ax)) = chemistryIndex(l_bc_ai)
+ !!create bc int mix from bc in mode 0. Note Mass is conserved but not number
+
+ !Sticking coeffcients for H2SO4 condensation
+ !See table 1 in Kirkevag et al (2013)
+ !http://www.geosci-model-dev.net/6/207/2013/gmd-6-207-2013.html
+ !Note: In NorESM1, sticking coefficients of the externally mixed modes were
+ !used for the internally mixed modes in modallapp. In condtend the internally
+ !mixed modes had sticking coefficient = 1.0
+ !This might be correct, but is too confusing, so here just
+ !assign based on background aerosol and table 1 in Kirkevag et al
+ stickingCoefficient(:,:) = 1.0_r8
+ stickingCoefficient(MODE_IDX_BC_EXT_AC,:) = 0.3_r8
+ stickingCoefficient(MODE_IDX_BC_AIT,:) = 0.3_r8
+ stickingCoefficient(MODE_IDX_OMBC_INTMIX_COAT_AIT,:) = 0.5_r8
+ stickingCoefficient(MODE_IDX_DST_A2,:) = 0.3_r8
+ stickingCoefficient(MODE_IDX_DST_A3,:) = 0.3_r8
+ stickingCoefficient(MODE_IDX_BC_NUC,:) = 0.3_r8
+ stickingCoefficient(MODE_IDX_OMBC_INTMIX_AIT,:) = 0.5_r8
+
+
+ end subroutine registerCondensation
+
+!===============================================================================
+
+ subroutine initializeCondensation()
+
+ !condensation coefficients:
+ !Theory: Poling et al, "The properties of gases and liquids"
+ !5th edition, eqn 11-4-4
+
+ use cam_history, only: addfld, add_default, fieldname_len, horiz_only
+ implicit none
+
+ real(r8), parameter :: aunit = 1.6606e-27_r8 ![kg] Atomic mass unit
+ real(r8), parameter :: boltz = 1.3806e-23_r8 ![J/K/molec]
+ real(r8), parameter :: t0 = 273.15_r8 ![K] standard temperature
+ real(r8), parameter :: p0 = 101325.0_r8 ! [Pa] Standard pressure
+ real(r8), parameter :: radair = 1.73e-10_r8 ![m] Typical air molecule collision radius
+ real(r8), parameter :: Mair = 28.97_r8 ![amu/molec] Molecular weight for dry air
+ !Diffusion volumes for simple molecules [Poling et al], table 11-1
+ real(r8), dimension(N_COND_VAP), parameter :: vad = (/51.96_r8, 208.18_r8, 208.18_r8/) ![cm3/mol]
+ real(r8), parameter :: vadAir = 19.7_r8 ![cm3/mol]
+ real(r8), parameter :: aThird = 1.0_r8/3.0_r8
+ real(r8), parameter :: cm2Tom2 = 1.e-4_r8 !convert from cm2 ==> m2
+
+ real(r8), dimension(0:100,0:nmodes,N_COND_VAP) :: DiffusionCoefficient ! [m2/s] Diffusion coefficient
+ character(len=fieldname_len+3) :: fieldname_donor
+ character(len=fieldname_len+3) :: fieldname_receiver
+ character(128) :: long_name
+ character(8) :: unit
+
+ integer :: nsiz !counter for aerotab sizes
+ integer :: iChem !counter for chemical species
+ integer :: mode_index_donor !index for mode
+ integer :: iMode !Counter for mode
+ integer :: tracerIndex !counter for chem. spec
+
+ logical :: history_aerosol
+ logical :: isAlreadyOnList(gas_pcnst)
+ integer :: cond_vap_idx
+
+ real(r8), dimension(N_COND_VAP) :: mfv ![m] mean free path
+ real(r8), dimension(N_COND_VAP) :: diff ![m2/s] diffusion coefficient for cond. vap
+ real(r8) :: molecularWeight !amu/molec molecular weight
+ real(r8) :: Mdual ![molec/amu] 1/M_1 + 1/M_2
+ real(r8) :: rho ![kg/m3] density of component in question
+ real(r8) :: radmol ![m] radius molecule
+ real(r8), dimension(N_COND_VAP) :: th !thermal velocity
+
+ !Couple the condenseable vapours to chemical species for properties and indexes
+ cond_vap_map(COND_VAP_H2SO4) = chemistryIndex(l_h2so4)
+ cond_vap_map(COND_VAP_ORG_LV) = chemistryIndex(l_soa_lv)
+ cond_vap_map(COND_VAP_ORG_SV) = chemistryIndex(l_soa_sv)
+
+ do cond_vap_idx = 1, N_COND_VAP
+
+ rho = rhopart(physicsIndex(cond_vap_map(cond_vap_idx))) !pick up densities from aerosoldef
+
+ molecularWeight=adv_mass(cond_vap_map(cond_vap_idx)) !pick up molecular weights from mozart
+
+ !https://en.wikipedia.org/wiki/Thermal_velocity
+ th(cond_vap_idx) = sqrt(8.0_r8*boltz*t0/(pi*molecularweight*aunit)) ! thermal velocity for H2SO4 in air (m/s)
+
+ !Radius of molecul (straight forward assuming spherical)
+ radmol=(3.0_r8*molecularWeight*aunit/(4.0_r8*pi*rho))**aThird ! molecule radius
+
+ Mdual=2.0_r8/(1.0_r8/Mair+1.0_r8/molecularWeight) !factor of [1/m_1 + 1_m2]
+
+ !calculating microphysical parameters from equations in Ch. 8 of Seinfeld & Pandis (1998):
+ mfv(cond_vap_idx)=1.0_r8/(pi*sqrt(1.0_r8+MolecularWeight/Mair)*(radair+radmol)**2*p0/(boltz*t0)) ! mean free path for molec in air (m)
+
+ !Solve eqn 11-4.4 in Poling et al
+ !(A bit hard to follow units here, but result in the book is in cm2/s)..
+ !so scale by "cm2Tom2" to get m2/sec
+ diff(cond_vap_idx) = cm2Tom2 &
+ *0.00143_r8*t0**1.75_r8 &
+ /((p0/1.0e5_r8)*sqrt(Mdual) &
+ *(((Vad(cond_vap_idx))**aThird+(Vadair)**aThird)**2))
+
+ !Values used in noresm1:
+ !real(r8), parameter :: diff = 9.5e-6 !m2/s diffusion coefficient (H2SO4)
+ !real(r8), parameter :: th = 243.0_r8 !m/s thermal velocity (H2SO4)
+ !real(r8), parameter :: mfv = 1.65e-8 !m mean free path (H2SO4)
+
+ !Check values obtained here (H2SO4 / SOA)
+ !write(*,*) 'mfv = ', mfv(cond_vap_idx) !2.800830854409093E-008 / 1.633546464678737E-008
+ !write(*,*) ' diff = ', diff(cond_vap_idx) !-> 9.360361706957621E-006 / !-> 4.185923463242946E-006
+ !write(*,*) ' th = ', th !-> 242.818542922924 / 185.421069430852
+ end do
+
+ do cond_vap_idx = 1, N_COND_VAP
+ do imode = 0, nmodes !all modes receive condensation
+ do nsiz = 1, nBinsTab !aerotab sizes
+ !Correct for non-continuum effects, formula is from
+ !Chuang and Penner, Tellus, 1995, sticking coeffient from
+ !Vignati et al, JGR, 2004
+ !fxm: make "diff ==> diff (cond_vap_idx)
+ DiffusionCoefficient(nsiz,imode,cond_vap_idx) = diff(cond_vap_idx) & !original diffusion coefficient
+ /( &
+ rBinMidPoint(nsiz)/(rBinMidPoint(nsiz)+mfv(cond_vap_idx)) & !non-continuum correction factor
+ +4.0_r8*diff(cond_vap_idx)/(stickingCoefficient(imode,cond_vap_idx)*th(cond_vap_idx)*rBinMidPoint(nsiz)) &
+ )
+ enddo
+ end do !receiver modes
+ end do
+
+ normalizedCondensationSink(:,:) = 0.0_r8
+ !Find sink per particle in mode "imode"
+ !Eqn 13 in Kulmala et al, Tellus 53B, 2001, pp 479
+ !http://onlinelibrary.wiley.com/doi/10.1034/j.1600-0889.2001.530411.x/abstract
+ do cond_vap_idx =1, N_COND_VAP
+ do imode = 0, nmodes
+ do nsiz = 1, nBinsTab
+ normalizedCondensationSink(imode,cond_vap_idx) = &
+ normalizedCondensationSink(imode,cond_vap_idx) &
+ + 4.0_r8*pi &
+ * DiffusionCoefficient(nsiz,imode,cond_vap_idx) & ![m2/s] diffusion coefficient
+ * rBinMidPoint(nsiz) & ![m] look up table radius
+ * normnk(imode,nsiz) ![frc]
+ end do
+ end do
+ end do
+
+ !Initialize output
+ call phys_getopts(history_aerosol_out = history_aerosol)
+
+ isAlreadyOnList(:) = .FALSE.
+ do iChem = 1,gas_pcnst
+ !Does this tracer have a receiver? If yes: It participate in condensation tendencies
+ if(lifeCycleReceiver(iChem) .gt. 0)then
+ unit = "kg/m2/s"
+ fieldname_donor = trim(solsym(iChem))//"condTend"
+ fieldname_receiver = trim(solsym(lifeCycleReceiver(iChem)))//"condTend"
+ if(.not. isAlreadyOnList(lifeCycleReceiver(iChem)))then
+ call addfld( fieldname_receiver, horiz_only, "A", unit, "condensation tendency" )
+ isAlreadyOnList(lifeCycleReceiver(iChem))=.TRUE.
+ end if
+ call addfld( fieldname_donor, horiz_only, "A", unit, "condensation tendency" )
+ if(history_aerosol)then
+ call add_default( fieldname_receiver, 1, ' ' )
+ call add_default( fieldname_donor , 1, ' ')
+ end if
+ end if
+ end do
+ !Need to add so4_a1, soa_na, so4_na, soa_a1 also (which are not parts of the donor-receiver stuff)
+ fieldname_receiver = trim(solsym(chemistryIndex(l_so4_a1)))//"condTend"
+ call addfld( fieldname_receiver, horiz_only, 'A', unit, "condensation tendency")
+ if(history_aerosol)then
+ call add_default( fieldname_receiver, 1, ' ' )
+ end if
+ fieldname_receiver = trim(solsym(chemistryIndex(l_soa_a1)))//"condTend"
+ call addfld( fieldname_receiver, horiz_only, "A", unit, "condensation tendency" )
+ if(history_aerosol)then
+ call add_default( fieldname_receiver, 1, ' ' )
+ end if
+ fieldname_receiver = trim(solsym(chemistryIndex(l_so4_na)))//"condTend"
+ call addfld( fieldname_receiver, horiz_only, 'A', unit , "condensation tendency" )
+ if(history_aerosol)then
+ call add_default( fieldname_receiver, 1, ' ' )
+ end if
+ fieldname_receiver = trim(solsym(chemistryIndex(l_soa_na)))//"condTend"
+ call addfld( fieldname_receiver, horiz_only, 'A', unit, "condensation tendency" )
+ if(history_aerosol)then
+ call add_default( fieldname_receiver, 1, ' ' )
+ end if
+
+
+
+ end subroutine initializeCondensation
+
+
+
+ subroutine condtend_sub(lchnk, q, cond_vap_gasprod, temperature, &
+ pmid, pdel, dt, ncol, pblh,zm,qh20)
+
+! Calculate the sulphate nucleation rate, and condensation rate of
+! aerosols used for parameterising the transfer of externally mixed
+! aitken mode particles into an internal mixture.
+! Note the parameterisation for conversion of externally mixed particles
+! used the h2so4 lifetime onto the particles, and not a given
+! increase in particle radius. Will be improved in future versions of the model
+! Added input for h2so4 and soa nucleation: soa_lv_gasprod, soa_sv_gasprod, pblh,zm,qh20 (cka)
+
+ use cam_history, only: outfld,fieldname_len
+!nuctst3+ use koagsub, only: normalizedCoagulationSink,receiverMode,numberOfCoagulationReceivers ! h2so4 and soa nucleation(cka)
+! use koagsub, only: normCoagSinkMode1,normalizedCoagulationSink,receiverMode,numberOfCoagulationReceivers ! h2so4 and soa nucleation(cka)
+!nuctst3-
+!ak+
+ use koagsub, only: normalizedCoagulationSink,receiverMode,numberOfCoagulationReceivers, &
+ numberOfAddCoagReceivers,addReceiverMode,normCoagSinkAdd
+!ak-
+ use constituents, only: pcnst ! h2so4 and soa nucleation (cka)
+
+ implicit none
+
+ ! arguments
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of columns
+ real(r8), intent(in) :: temperature(pcols,pver) ! Temperature (K)
+ real(r8), intent(in) :: pmid(pcols,pver) ! [Pa] pressure at mid point
+ real(r8), intent(in) :: pdel(pcols,pver) ! [Pa] difference in grid cell
+ real(r8), intent(inout) :: q(pcols,pver,gas_pcnst) ! TMR [kg/kg] including moisture
+ real(r8), intent(in) :: cond_vap_gasprod(pcols,pver,N_COND_VAP) ! TMR [kg/kg/sec]] production rate of H2SO4 (gas prod - aq phase uptake)
+ real(r8), intent(in) :: dt ! Time step
+ ! Needed for soa nucleation treatment
+ real(r8), intent(in) :: pblh(pcols) ! pbl height (m)
+ real(r8), intent(in) :: zm(pcols,pverp) ! midlayer geopotential height above the surface (m) (pver+1)
+ real(r8), intent(in) :: qh20(pcols,pver) ! specific humidity (kg/kg)
+
+ ! local
+ character(len=fieldname_len+3) :: fieldname
+ integer :: i,k,nsiz
+ integer :: mode_index_donor ![idx] index of mode donating mass
+ integer :: mode_index_receiver ![idx] index of mode receiving mass
+ integer :: tracerIndex
+ integer :: l_donor
+ integer :: l_receiver
+ integer :: iDonor ![idx] counter for externally mixed modes
+ real(r8) :: condensationSink(0:nmodes, N_COND_VAP)![1/s] loss rate per mode (mixture)
+ real(r8) :: condensationSinkFraction(pcols,pver,numberOfExternallyMixedModes,N_COND_VAP) ![frc]
+ real(r8) :: sumCondensationSink(pcols,pver, N_COND_VAP) ![1/s] sum of condensation sink
+ real(r8) :: totalLoss(pcols,pver,gas_pcnst) ![kg/kg] tracer lost
+ real(r8) :: numberConcentration(0:nmodes) ![#/m3] number concentration
+ real(r8) :: numberConcentrationExtMix(pcols,pver,numberOfExternallyMixedModes)
+ real(r8), dimension(pcols, gas_pcnst) :: coltend
+ real(r8), dimension(pcols) :: tracer_coltend
+
+ real(r8) :: intermediateConcentration(pcols,pver,N_COND_VAP)
+ real(r8) :: rhoAir(pcols,pver) ![kg/m3] density of air
+! Volume of added material from condensate; surface area of core particle;
+ real(r8) :: volume_shell, area_core,vol_monolayer
+ real (r8) :: frac_transfer ! Fraction of hydrophobic material converted to an internally mixed mode
+ logical :: history_aerosol
+ character(128) :: long_name ![-] needed for diagnostics
+
+!cka:+
+ ! needed for h2so4 and soa nucleation treatment
+ integer :: modeIndexReceiverCoag !Index of modes receiving coagulate
+ integer :: iCoagReceiver !counter for species receiving coagulate
+ real(r8) :: coagulationSink(pcols,pver) ![1/s] coaglation loss for SO4_n and soa_n
+!nuctst3+
+! real(r8) :: normCSmode1(pcols,pver) !normalized coagulation from self coagulation (simplified)
+!nuctst3-
+ real(r8), parameter :: lvocfrac=0.5 !Fraction of organic oxidation products with low enough
+ !volatility to enter nucleation mode particles (1-24 nm)
+ real(r8) :: soa_lv_forNucleation(pcols,pver) ![kg/kg] soa gas available for nucleation
+ real(r8) :: gasLost(pcols,pver,N_COND_VAP) ![kg/kg] budget terms on H2SO4 (gas)
+ real(r8) :: fracNucl(pcols,pver,N_COND_VAP) ! [frc] fraction of gas nucleated
+ real(r8) :: firstOrderLossRateNucl(pcols,pver,N_COND_VAP) ![1/s] first order loss rate due to nucleation
+ real(r8) :: nuclso4(pcols,pver) ![kg/kg/s] Nucleated so4 mass tendency from RM's parameterization
+ real(r8) :: nuclsoa(pcols,pver) ![kg/kg/s] Nucleated soa mass tendency from RM's parameterization
+ integer :: cond_vap_idx
+
+ !Initialize h2so4 and soa nucl variables
+ coagulationSink(:,:)=0.0_r8
+ condensationSinkFraction(:,:,:,:) = 0.0_r8 !Sink to the coming "receiver" of any vapour
+ numberConcentrationExtMix(:,:,:) = 0.0_r8
+!ak+
+! normCSmode1(:,:)=0.0_r8
+!ak-
+
+ do k=1,pver
+ do i=1,ncol
+
+ condensationSink(:,:) = 0.0_r8 !Sink to the coming "receiver" of any vapour
+
+ !NB: The following is duplicated code, coordinate with koagsub!!
+ !Initialize number concentration for this receiver
+
+ !Air density
+ rhoAir(i,k) = pmid(i,k)/rair/temperature(i,k)
+
+
+ numberConcentration(:) = 0.0_r8
+
+ !Go though all modes receiving condensation
+ do mode_index_receiver = 0, nmodes
+
+ !Go through all core species in that mode
+ do tracerIndex = 1, getNumberOfBackgroundTracersInMode(mode_index_receiver)
+
+ !Find the lifecycle-specie receiving the condensation
+ l_receiver = getTracerIndex(mode_index_receiver, tracerIndex, .true.)
+
+ !Add up the number concentration of the receiving mode [#/m3]
+ numberConcentration(mode_index_receiver) = numberConcentration(mode_index_receiver) & !previous value
+ + q(i,k,l_receiver) & !kg/kg
+ / rhopart(physicsIndex(l_receiver)) & !m3/kg ==> m3_{aer}/kg_{air}
+ * volumeToNumber(mode_index_receiver) & !#/m3 ==> #/kg_{air}
+ * rhoAir(i,k) !kg/m3 ==> #/m3_{air}
+ end do !Lifecycle "core" species in this mode
+ enddo
+
+
+ !All modes are condensation receivers
+ do cond_vap_idx=1,N_COND_VAP
+ do mode_index_receiver = 0, nmodes
+
+ !This is the loss rate a gas molecule will see due to aerosol surface area
+ condensationSink(mode_index_receiver,cond_vap_idx) = normalizedCondensationSink(mode_index_receiver,cond_vap_idx) & ![m3/#/s]
+ * numberConcentration(mode_index_receiver) ![#/m3]
+ !==> [1/s]
+ end do !Loop over receivers
+ end do
+
+ !Find concentration after condensation of all
+ !condenseable vapours
+ do cond_vap_idx=1,N_COND_VAP
+
+ !sum of cond. sink for this vapour [1/s]
+ sumCondensationSink(i,k,cond_vap_idx) = sum(condensationSink(:,cond_vap_idx))
+
+
+ !Solve the intermediate (end of timestep) concentration using
+ !euler backward solution C_{old} + P *dt - L*C_{new}*dt = C_{new} ==>
+ !Cnew -Cold = prod - loss ==>
+ intermediateConcentration(i,k,cond_vap_idx) = &
+ ( q(i,k,cond_vap_map(cond_vap_idx)) + cond_vap_gasprod(i,k,cond_vap_idx)*dt ) &
+ / (1.0_r8 + sumCondensationSink(i,k,cond_vap_idx)*dt)
+ end do
+
+ !Save the fraction of condensation sink for the externally mixed modes
+ !(Needed below to find volume shell)
+ do cond_vap_idx=1,N_COND_VAP
+
+ do iDonor = 1,numberOfExternallyMixedModes
+ !Find the mode in question
+ mode_index_donor = externallyMixedMode(iDonor)
+
+ !Remember fraction of cond sink for this mode
+ condensationSinkFraction(i,k,iDonor,cond_vap_idx) = &
+ condensationSink(mode_index_donor,cond_vap_idx) &
+ / sumCondensationSink(i,k,cond_vap_idx)
+
+ !Remember number concentration in this mode
+ numberConcentrationExtMix(i,k,iDonor) = &
+ numberConcentration(mode_index_donor)
+ end do
+ end do
+
+ !Assume only a fraction of ORG_LV left can contribute to nucleation
+ soa_lv_forNucleation(i,k) = lvocfrac*intermediateConcentration(i,k,COND_VAP_ORG_LV) !fraction of soa_lv left that is assumend to have low enough
+ !volatility to nucleate.
+
+ modeIndexReceiverCoag = 0
+ !Sum coagulation sink for nucleated so4 and soa particles over all receivers of coagulate. Needed for RM's nucleation code
+ !OBS - looks like RM's coagulation sink is multiplied by 10^-12??
+ do iCoagReceiver = 1, numberOfCoagulationReceivers
+
+ modeIndexReceiverCoag = receiverMode(iCoagReceiver)
+
+ coagulationSink(i,k) = & ![1/s]
+ coagulationSink(i,k) + & ![1/] previous value
+ normalizedCoagulationSink(modeIndexReceiverCoag,MODE_IDX_SO4SOA_AIT) & ![m3/#/s]
+ * numberConcentration(modeIndexReceiverCoag) !numberConcentration (#/m3)
+ end do !coagulation sink
+
+!nuctst3+
+! coagulationSink(i,k) = coagulationSink(i,k) + &
+! normCoagSinkMode1*numberConcentration(1)
+! if (i.eq.1.and.k.eq.30) write(*,*) 'cSink, dcSink = ', coagulationSink(i,k), normCoagSinkMode1*numberConcentration(1)
+! if (i.eq.1.and.k.eq.30) write(*,*) 'nConc1 = ', numberConcentration(1)
+!nuctst3-
+!ak+
+ !Sum coagulation sink for nucleated so4 and soa particles over all additional
+ !receivers od coagulate (not directly affecting the life-cycle).
+ do iCoagReceiver = 1, numberOfAddCoagReceivers
+
+ modeIndexReceiverCoag = addReceiverMode(iCoagReceiver)
+
+ coagulationSink(i,k) = & ![1/s]
+ coagulationSink(i,k) + & ![1/] previous value
+ normCoagSinkAdd(iCoagReceiver) & ![m3/#/s]
+ * numberConcentration(modeIndexReceiverCoag) !numberConcentration (#/m3)
+ end do !coagulation sink
+!ak-
+
+ end do !index i
+ end do !index k
+
+ !Calculate nucleated masses of so4 and soa (nuclso4, nuclsoa)
+ !following RM's parameterization (cka)
+ call aeronucl(lchnk,ncol,temperature, pmid, qh20, &
+ intermediateConcentration(:,:,COND_VAP_H2SO4), soa_lv_forNucleation, &
+ coagulationSink, nuclso4, nuclsoa, zm, pblh)
+
+
+ firstOrderLossRateNucl(:,:,:)=0.0_r8
+ do k=1,pver
+ do i=1,ncol
+
+ !First order loss rate (1/s) for nucleation
+ firstOrderLossRateNucl(i,k,COND_VAP_H2SO4) = nuclSo4(i,k)/intermediateConcentration(i,k,COND_VAP_H2SO4)
+
+ !First order loss rate (1/s) for nucleation
+ firstOrderLossRateNucl(i,k,COND_VAP_ORG_LV) = nuclSOA(i,k)/intermediateConcentration(i,k,COND_VAP_ORG_LV)
+
+ do cond_vap_idx = 1,N_COND_VAP
+ !Solve implicitly (again)
+ !C_new - C_old = PROD_{gas} - CS*C_new*dt - LR_{nucl}*C_new =>
+ intermediateConcentration(i,k,cond_vap_idx) = &
+ ( q(i,k,cond_vap_map(cond_vap_idx)) + cond_vap_gasprod(i,k,cond_vap_idx)*dt ) &
+ / (1.0_r8 + sumCondensationSink(i,k,cond_vap_idx)*dt + firstOrderLossRateNucl(i,k,cond_vap_idx)*dt)
+
+ !fraction nucleated
+ fracNucl(i,k,cond_vap_idx) = firstOrderLossRateNucl(i,k,cond_vap_idx) &
+ /(firstOrderLossRateNucl(i,k,cond_vap_idx) + sumCondensationSink(i,k,cond_vap_idx))
+ !From budget, we get: lost = prod -cnew + cold
+ gasLost(i,k,cond_vap_idx) = cond_vap_gasprod(i,k,cond_vap_idx)*dt & !Produced
+ + q(i,k,cond_vap_map(cond_vap_idx)) & !cold
+ - intermediateConcentration(i,k,cond_vap_idx) !cnew
+
+ end do !cond_vap_idx
+
+ !Add nuceated mass to so4_na mode
+ q(i,k,chemistryIndex(l_so4_na)) = q(i,k,chemistryIndex(l_so4_na)) &
+ + gasLost(i,k,COND_VAP_H2SO4)*fracNucl(i,k,COND_VAP_H2SO4)
+
+ !H2SO4 condensate
+ q(i,k,chemistryIndex(l_so4_a1)) = q(i,k,chemistryIndex(l_so4_a1)) &
+ + gasLost(i,k,COND_VAP_H2SO4)*(1.0_r8-fracNucl(i,k,COND_VAP_H2SO4))
+
+ !Add nucleated mass to soa_na mode
+ q(i,k,chemistryIndex(l_soa_na)) = q(i,k,chemistryIndex(l_soa_na)) &
+ + gasLost(i,k,COND_VAP_ORG_LV)*fracNucl(i,k,COND_VAP_ORG_LV)
+
+ !Organic condensate (from both soa_lv and soa_sv) goes to the soaCondensateReceiver tracer (cka)
+ q(i,k,chemistryIndex(l_soa_a1)) = q(i,k,chemistryIndex(l_soa_a1)) &
+ + gasLost(i,k,COND_VAP_ORG_SV) & ! "semi volatile" can not nucleate
+ + gasLost(i,k,COND_VAP_ORG_LV)*(1.0_r8-fracNucl(i,k,COND_VAP_ORG_LV)) ! part of low volatile which does not nucleate
+
+ !condenseable vapours
+ q(i,k,chemistryIndex(l_h2so4)) = intermediateConcentration(i,k,COND_VAP_H2SO4)
+ q(i,k,chemistryIndex(l_soa_lv)) = intermediateConcentration(i,k,COND_VAP_ORG_LV)
+ q(i,k,chemistryIndex(l_soa_sv)) = intermediateConcentration(i,k,COND_VAP_ORG_SV)
+
+
+ !Condensation transfers mass from externally mixed to internally mixed modes
+ do iDonor = 1,numberOfExternallyMixedModes
+
+ !Find the mode in question
+ mode_index_donor = externallyMixedMode(iDonor)
+
+ if(getNumberOfTracersInMode(mode_index_donor) .eq. 0)then
+ cycle
+ end if
+
+ volume_shell = 0.0_r8
+ do cond_vap_idx = 1, N_COND_VAP
+
+ !Add up volume shell for this
+ !condenseable vapour
+ volume_shell = volume_shell &
+ + condensationSinkFraction(i,k,iDonor,cond_vap_idx) & ![frc]
+ * gasLost(i,k,cond_vap_idx)*(1.0_r8-fracNucl(i,k,cond_vap_idx)) & ![kg/kg]
+ * invRhoPart(physicsIndex(cond_vap_map(cond_vap_idx))) & !*[m3/kg] ==> [m3/kg_{air}
+ * rhoAir(i,k) !*[kg/m3] ==> m3/m3
+
+ end do
+
+ area_core=numberConcentrationExtMix(i,k,iDonor)*numberToSurface(mode_index_donor) !#/m3 * m2/# ==> m2/m3
+ vol_monolayer=area_core*dr_so4_monolayers_age
+
+ ! Small fraction retained to avoid numerical irregularities
+ frac_transfer=min((volume_shell/vol_monolayer),0.999_r8)
+
+ !How many tracers exist in donor mode?
+ !The "donor" is the externally mixed mode which will soon
+ !become internally mixed. The externally mixed is donating mass
+ !and the internally mixed is receiving...
+ do tracerIndex = 1, getNumberOfTracersInMode(mode_index_donor)
+
+ !Indexes here are in "chemistry space"
+ l_donor = getTracerIndex(mode_index_donor, tracerIndex,.true.)
+ l_receiver = lifeCycleReceiver(l_donor)
+
+ if( l_receiver .le. 0)then
+ stop !something wrong
+ endif
+
+ !Transfer from donor to receiver takes into account
+ !fraction transferred
+ totalLoss(i,k,l_donor) = frac_transfer*q(i,k,l_donor)
+ q(i,k,l_donor) = q(i,k,l_donor) - totalLoss(i,k,l_donor)
+ q(i,k,l_receiver) = q(i,k,l_receiver) + totalLoss(i,k,l_donor)
+ end do !tracers in mode
+ end do !loop over receivers
+ end do !physical index k
+ end do !physical index i
+
+ !Output for diagnostics
+ call phys_getopts(history_aerosol_out = history_aerosol)
+
+ if(history_aerosol)then
+ coltend(:ncol,:) = 0.0_r8
+ do i=1,gas_pcnst
+ !Check if species contributes to condensation
+ if(lifeCycleReceiver(i) .gt. 0)then
+ !Loss from the donor specie
+ tracer_coltend(:ncol) = sum(totalLoss(:ncol, :,i)*pdel(:ncol,:),2)/gravit/dt
+ coltend(:ncol,i) = coltend(:ncol,i) - tracer_coltend(:ncol) !negative (loss for donor)
+ coltend(:ncol,lifeCycleReceiver(i)) = coltend(:ncol,lifeCycleReceiver(i)) + tracer_coltend(:ncol)
+ endif
+ end do
+
+ ! Remove so4_n ---> directly into so4_na
+ coltend(:ncol,chemistryIndex(l_so4_na)) = coltend(:ncol,chemistryIndex(l_so4_na)) + &
+ sum( &
+ gasLost(:ncol,:,COND_VAP_H2SO4) &
+ *fracNucl(:ncol,:,COND_VAP_H2SO4)*pdel(:ncol,:) , 2 &
+ )/gravit/dt
+
+ !Take into account H2SO4 (gas) condensed in budget
+ coltend(:ncol,chemistryIndex(l_so4_a1)) = coltend(:ncol,chemistryIndex(l_so4_a1)) + &
+ sum( &
+ gasLost(:ncol,:,COND_VAP_H2SO4) &
+ *(1.0_r8 - fracNucl(:ncol,:,COND_VAP_H2SO4))*pdel(:ncol,:) , 2 &
+ )/gravit/dt
+
+ !Take into account soa_lv (gas) nucleated in budget
+ coltend(:ncol,chemistryIndex(l_soa_na)) = coltend(:ncol,chemistryIndex(l_soa_na)) + &
+ sum( &
+ gasLost(:ncol,:,COND_VAP_ORG_LV) &
+ *fracNucl(:ncol,:,COND_VAP_ORG_LV)*pdel(:ncol,:) , 2 &
+ )/gravit/dt
+
+ !Take into account soa gas condensed in the budget (both LV and SV)
+ coltend(:ncol,chemistryIndex(l_soa_a1)) = coltend(:ncol,chemistryIndex(l_soa_a1)) + &
+ sum( &
+ gasLost(:ncol,:,COND_VAP_ORG_LV) &
+ *(1.0_r8 - fracNucl(:ncol,:,COND_VAP_ORG_LV))*pdel(:ncol,:) , 2 &
+ )/gravit/dt &
+ + &
+ sum( &
+ gasLost(:ncol,:,COND_VAP_ORG_SV)*pdel(:ncol,:) , 2 &
+ )/gravit/dt
+
+ do i=1,gas_pcnst
+ if(lifeCycleReceiver(i) .gt. 0 )then
+ long_name= trim(solsym(i))//"condTend"
+ call outfld(long_name, coltend(:ncol,i), pcols, lchnk)
+ long_name= trim(solsym(lifeCycleReceiver(i)))//"condTend"
+ call outfld(long_name, coltend(:ncol,lifeCycleReceiver(i)),pcols,lchnk)
+ end if
+ end do
+ long_name=trim(solsym(chemistryIndex(l_so4_a1)))//"condTend"
+ call outfld(long_name, coltend(:ncol,chemistryIndex(l_so4_a1)),pcols,lchnk)
+ long_name=trim(solsym(chemistryIndex(l_soa_a1)))//"condTend"
+ call outfld(long_name, coltend(:ncol,chemistryIndex(l_soa_a1)),pcols,lchnk)
+ long_name=trim(solsym(chemistryIndex(l_so4_na)))//"condTend"
+ call outfld(long_name, coltend(:ncol,chemistryIndex(l_so4_na)),pcols,lchnk)
+ long_name=trim(solsym(chemistryIndex(l_soa_na)))//"condTend"
+ call outfld(long_name, coltend(:ncol,chemistryIndex(l_soa_na)),pcols,lchnk)
+
+ endif
+
+
+ return
+ end subroutine condtend_sub
+
+
+end module condtend
diff --git a/src/chemistry/oslo_aero/const.F90 b/src/chemistry/oslo_aero/const.F90
new file mode 100644
index 0000000000..4a6ed3ec8f
--- /dev/null
+++ b/src/chemistry/oslo_aero/const.F90
@@ -0,0 +1,83 @@
+module const
+
+!-----------------------------------------------------------------------------
+!Module containing subroutines constants, koagsub and parmix and declaration
+!of the variables required by them. Updated with one internally mixed and one
+!externally mixed OC mode November 2004.
+!Updated with extra variables for SOA by Alf Kirkevåg May 2013, and
+!with explicit equations for diffusion variables for SOA and H2SO4 in July 2015
+!(moved to condtend.F90).
+!-----------------------------------------------------------------------------
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+! use aerosoldef, only: nmodes
+ use commondefinitions, only: nmodes
+ use physconst, only: pi
+!
+implicit none
+!
+public
+save
+
+ real(r8), parameter:: smallNumber = 1.e-100_r8
+
+ !Essential size distribution parameters
+ real(r8), parameter :: rTabMin = 1.e-9_r8 ![m] smallest lookup table size
+ real(r8), parameter :: rTabMax = 20.e-6_r8 ![m] largest lookup table size
+ integer, parameter :: nBinsTab = 44 ![nbr] number of tabulated bins
+
+
+!cak: diff, th and mfv for H2SO4 and SOA are now calculated in condtend.F90
+
+
+ !Smallest particle which can receive aquous chemistry mass
+ real(r8), parameter :: rMinAquousChemistry = 0.05e-6_r8
+ real(r8) nk(0:nmodes,nbinsTab) !dN/dlogr for modes
+ real(r8) normnk(0:nmodes,nbinsTab) !dN for modes (sums to one over size range)
+
+ real(r8) rBinEdge(nBinsTab+1)
+ real(r8) rBinMidpoint(nBinsTab)
+
+!soa
+! real(r8) :: rrr1to3 (3,16) !TS: Modal radius array, mode 1 - 3
+! real(r8) :: sss1to3 (3,16) !TS: Standard deviation array, Mode 1 -3
+! real(r8) :: calog1to3(3,16) !TS: Array for reading catot from file
+! real(r8) :: rk1to3 (3,16) !TS: Array for reading modal radius from file
+! real(r8) :: stdv1to3 (3,16) !TS: Array for reading std. dev. from file
+!soa
+ real(r8) :: rrr1to3 (3,16,6) !TS: Modal radius array, mode 1 - 3
+ real(r8) :: sss1to3 (3,16,6) !TS: Standard deviation array, Mode 1 -3
+ real(r8) :: calog1to3(3,96) !TS: Array for reading catot from file
+ real(r8) :: rk1to3 (3,96) !TS: Array for reading modal radius from file
+ real(r8) :: stdv1to3 (3,96) !TS: Array for reading std. dev. from file
+ real(r8) :: fraclog1to3 (3,96) !TS: Same as frac4, but for initlogn.F90
+!soa
+
+ real(r8) :: rrr4 (16,6,6) !TS: Modal radius array, mode 4
+ real(r8) :: sss4 (16,6,6) !TS: Modal radius array, mode 4
+ real(r8) :: calog4(576) !TS: Same as catot4, but for initlogn.F90
+ real(r8) :: fraclog4 (576) !TS: Same as frac4, but for initlogn.F90
+ real(r8) :: fraqlog4 (576) !TS: Same as fraq4, but for initlogn.F90
+ real(r8) :: rk4 (576) !TS: Array for reading modal radius from file
+ real(r8) :: stdv4 (576) !TS: Array for reading std. dev. from file
+
+ real(r8) :: rrr (5:10,6,6,6,6) !TS: Modal radius array, mode 5 - 10
+ real(r8) :: sss (5:10,6,6,6,6) !TS: Standard deviation array, mode 5 - 10
+ real(r8) :: calog (5:10,1296) !TS: Same as catot, but for initlogn.F90
+ real(r8) :: fraclog5to10 (5:10,1296) !TS: Same as frac5to10, but for initlogn.F90
+ real(r8) :: fabclog5to10 (5:10,1296) !TS: Same as fabc5to10, but for initlogn.F90
+ real(r8) :: fraqlog5to10 (5:10,1296) !TS: Same as fraq5to10, but for initlogn.F90
+ real(r8) :: rk5to10 (5:10,1296) !TS: Array for reading modal radius from file
+ real(r8) :: stdv5to10 (5:10,1296) !TS: Array for reading std. dev. from file
+
+
+ real(r8), parameter :: sq2pi = 1._r8/sqrt(2.0_r8*pi)
+ real(r8), dimension(0:nmodes) :: volumeToNumber !m3 ==> #
+ real(r8), dimension(0:nmodes) :: numberToSurface !# ==> m2
+
+
+end module const
+
+
+
+
diff --git a/src/chemistry/oslo_aero/constants.F90 b/src/chemistry/oslo_aero/constants.F90
new file mode 100644
index 0000000000..5e58b488d6
--- /dev/null
+++ b/src/chemistry/oslo_aero/constants.F90
@@ -0,0 +1,123 @@
+
+subroutine constants
+!
+! A number of constants used in the emission and size-calculation in CAM-Oslo
+! �S Jan 2011.
+! Updated by Alf Kirkev�g May 2013.
+! Updated by Alf Grini February 2014.
+!
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use physconst, only: pi
+ use const
+ use aerosoldef
+ use koagsub, only : initializeCoagulationReceivers, initializeCoagulationCoefficients &
+ , initializeCoagulationOutput
+
+ use oslo_utils
+ implicit none
+
+
+ integer kcomp,i
+ real(r8),dimension(0:nmodes) :: rhob !density of background aerosol in mode
+
+ real(r8) :: rhorbc !This has to do with fractal dimensions of bc, come back to this!!
+ real(r8) :: sumnormnk
+ real(r8) :: totalLogDelta
+ real(r8) :: logDeltaBin
+ real(r8) :: logNextEdge
+
+ rhob(:)=-1.0_r8
+ volumeToNumber(:)=-1.0_r8
+ numberToSurface(:)=-1.0_r8
+ !Prepare modal properties
+ do i=0, nmodes
+
+ if(getNumberOfTracersInMode(i) .gt. 0)then
+
+ !Approximate density of mode
+ rhob(i) = rhopart(getTracerIndex(i,1,.false.)) !density of mode is density of first species in mode
+
+ !REPLACE THE EFACT-VARIABLE WITH THIS!!
+ volumeToNumber(i) = 1.0_r8 &
+ / &
+ ( DEXP ( 4.5_r8 * ( log(originalSigma(i)) * log(originalSigma(i)) ) ) &
+ *(4.0_r8/3.0_r8)*pi*(originalNumberMedianRadius(i))**3 )
+
+ numberToSurface(i) = 4.0_r8*pi*lifeCycleNumberMedianRadius(i)*lifeCycleNumberMedianRadius(i)&
+ *DEXP(log(lifeCycleSigma(i))*log(lifeCycleSigma(i)))
+ end if
+ end do
+
+
+ !Find radius in edges and midpoints of bin
+ rBinEdge(1) = rTabMin
+ totalLogDelta = log(rTabMax/rTabMin)
+ logDeltaBin = totalLogDelta / nBinsTab
+ do i=2,nBinsTab+1
+ logNextEdge = log(rBinEdge(i-1)) + logDeltaBin
+ rBinEdge(i) = DEXP(logNextEdge)
+ rBinMidPoint(i-1) = sqrt(rBinEdge(i)*rBinEdge(i-1))
+ end do
+
+ !Calculate the fraction of a mode which goes to aquous chemstry
+ numberFractionAvailableAqChem(:)=0.0_r8
+ do i=1,nbmodes
+ if(isTracerInMode(i,l_so4_a2))then
+ numberFractionAvailableAqChem(i) = 1.0_r8 - calculateLognormalCDF(rMinAquousChemistry &
+ , originalNumberMedianRadius(i) &
+ , originalSigma(i) &
+ )
+ end if
+ end do
+
+ !Set the density of the fractal mode ==> we get lesser density
+ !than the emitted density, so for a given mass emitted, we get
+ !more number-concentration!! This is a way of simulating that the
+ !aerosols take up more space
+ rhorbc = calculateEquivalentDensityOfFractalMode( &
+ rhopart(l_bc_n) & !emitted density
+ ,originalNumberMedianRadius(MODE_IDX_BC_NUC) & !emitted size
+ ,2.5_r8 & !fractal dim
+ ,originalNumberMedianRadius(MODE_IDX_BC_EXT_AC) & !diameter of mode
+ ,originalSigma(MODE_IDX_BC_EXT_AC)) !sigma mode
+
+ rhopart(l_bc_ax) = rhorbc
+ !fxm: not the right place for this change of value,
+ !but anyway.. this re-calculateion of tracer density
+ !influences density of mode used in coagulation
+ rhob(MODE_IDX_BC_EXT_AC)=rhorbc
+
+ !Size distribution of the modes!
+ !Unclear if this should use the radii assuming growth or not!
+ !Mostly used in code where it is sensible to assume some growth has
+ !happened, so it is used here
+ do kcomp = 0,nmodes
+ do i=1,nBinsTab
+ !dN/dlogR (does not sum to one over size range)
+ nk(kcomp,i) = calculatedNdLogR(rBinMidPoint(i), lifeCycleNumberMedianRadius(kcomp), lifeCycleSigma(kcomp))
+ !dN (sums to one) over the size range
+ normnk(kcomp,i) =logDeltaBin*nk(kcomp,i)
+ enddo
+ enddo ! kcomp
+
+ !++test: Normalized size distribution must sum to one (accept 2% error)
+ do kcomp=0,nmodes
+ sumNormNk = sum(normnk(kcomp,:))
+ if(abs(sum(normnk(kcomp,:)) - 1.0_r8) .gt. 2.0e-2_r8)then
+ print*, "sum normnk", sum(normnk(kcomp,:))
+ stop
+ endif
+ enddo
+ !--test
+
+ !Initialize coagulation
+ call initializeCoagulationReceivers()
+
+ !Calculate the coagulation coefficients Note: Inaccurate density used!
+ call initializeCoagulationCoefficients(rhob, lifeCycleNumberMedianRadius)
+
+
+ call initializeCoagulationOutput()
+
+ return
+ end subroutine constants
diff --git a/src/chemistry/oslo_aero/dust_model.F90 b/src/chemistry/oslo_aero/dust_model.F90
new file mode 100644
index 0000000000..4d03c4c97e
--- /dev/null
+++ b/src/chemistry/oslo_aero/dust_model.F90
@@ -0,0 +1,228 @@
+module dust_model
+ use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl
+ use spmd_utils, only: masterproc
+ use cam_abortutils, only: endrun
+
+use constituents, only: cnst_name
+use aerosoldef, only: l_dst_a2, l_dst_a3
+use camsrfexch, only: cam_in_t
+use ppgrid, only: pcols
+use cam_logfile, only: iulog
+
+implicit none
+private
+save
+
+ integer, parameter :: numberOfDustModes = 2 !define in aerosoldef?
+
+ !This can be refined, but the fractions in coarse/fine mode are approx ok
+ real(r8), parameter, dimension(numberOfDustModes) :: emis_fraction_in_mode = (/0.13_r8, 0.87_r8 /)
+ integer, dimension(numberOfDustModes) :: tracerMap = (/-99, -99/) !index of dust tracers in the modes
+ character(len=6), public, dimension(10) :: dust_names
+ integer, parameter, public :: dust_nbin = numberOfDustModes
+
+ !Related to soil erodibility
+ real(r8) :: dust_emis_fact = -1.e36_r8 ! tuning parameter for dust emissions
+ character(len=cl) :: soil_erod_file = 'soil_erod_file' ! full pathname for soil erodibility dataset
+
+ logical, parameter, public :: dust_active = .TRUE.
+public oslo_dust_emis_intr
+public getNumberOfDustModes
+public getDustTracerIndexInMode
+public getEmissionFractionInDustMode
+public isOsloDustTracer
+public dust_init
+public dust_readnl
+
+
+!===============================================================================
+contains
+!===============================================================================
+
+ subroutine dust_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use mpishorthand
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'dust_readnl'
+
+ namelist /dust_nl/ dust_emis_fact, soil_erod_file
+
+ !-----------------------------------------------------------------------------
+
+ ! Read namelist
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'dust_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, dust_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+ end if
+
+#ifdef SPMD
+ ! Broadcast namelist variables
+ call mpibcast(dust_emis_fact, 1, mpir8, 0, mpicom)
+ call mpibcast(soil_erod_file, len(soil_erod_file), mpichar, 0, mpicom)
+#endif
+
+
+
+ end subroutine dust_readnl
+ function getEmissionFractionInDustMode(modeIndex) RESULT(fraction)
+ integer, intent(in) :: modeIndex
+ real(r8) :: fraction
+ fraction = emis_fraction_in_mode(modeIndex)
+ end function getEmissionFractionInDustMode
+
+ function getNumberOfDustModes() RESULT(answer)
+ integer answer
+ answer = numberOfDustModes
+ end function getNumberOfDustModes
+
+
+ subroutine dust_init()
+
+ use soil_erod_mod, only: soil_erod_init
+ implicit none
+ integer :: i
+
+
+ call soil_erod_init( dust_emis_fact, soil_erod_file )
+
+ call set_oslo_indices()
+
+ dust_names(:)=" "
+ do i=1,numberOfDustModes
+ dust_names(i) = cnst_name(tracerMap(i))
+ end do
+
+ end subroutine dust_init
+
+ subroutine set_oslo_indices()
+ implicit none
+ tracerMap(1) = l_dst_a2
+ tracerMap(2) = l_dst_a3
+ end subroutine set_oslo_indices
+
+
+ !****************************************************
+ !This is copied from the MAM aerosols. Should not really
+ !be necessary since the land model could calculate emissions
+ !based on soil erodibility.
+
+ !However, the following code in dustMod.F90 (land model) makes it
+ !necessary to apply it here!
+ !715 Set basin factor to 1 for now
+ !716
+ !717 call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp)
+ !718 do c = begc, endc
+ !719 l = clm3%g%l%c%landunit(c)
+ !720 if (.not. clm3%g%l%lakpoi(l)) then
+ !721 mbl_bsn_fct(c) = 1.0_r8
+ !722 end if
+ !723 end do
+
+ !For a general discussion of these factors, see:
+ !Zender et al JGR (vol 108, D16, 2003)
+ !http://onlinelibrary.wiley.com/doi/10.1029/2002JD003039/abstract
+
+ function getDustTracerIndexInMode(modeIndex)RESULT(answer)
+ integer, intent(in) :: modeIndex
+ integer answer
+
+ answer = tracerMap(modeIndex)
+
+ end function getDustTracerIndexInMode
+
+ function isOsloDustTracer(physTracerIndex) RESULT(answer)
+ implicit none
+ integer, intent(in) :: physTracerIndex
+ integer :: n
+ logical :: answer
+ answer = .FALSE.
+ do n = 1, numberOfDustModes
+ if(tracerMap(n) .eq. physTracerIndex)then
+ answer = .TRUE.
+ end if
+ end do
+ end function isOsloDustTracer
+
+ subroutine oslo_dust_emis_intr(state, cam_in)
+
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! Interface to emission of all dusts.
+ ! Notice that the mobilization is calculated in the land model (need #define BGC) and
+ ! the soil erodibility factor is applied here.
+ !
+ ! see comments above in subroutine read_soil_erodibility_data
+ !-----------------------------------------------------------------------
+ use cam_history, only: outfld
+ use physics_types, only: physics_state
+ use soil_erod_mod, only : soil_erod_fact
+ use soil_erod_mod, only : soil_erodibility
+
+ implicit none
+
+ ! Arguments:
+
+ type(physics_state), intent(in) :: state ! Physics state variables
+ type(cam_in_t), target, intent(inout) :: cam_in ! import state
+
+ ! Local variables
+
+ integer :: lchnk
+ integer :: ncol
+ integer :: i,n
+ real(r8) :: soil_erod_tmp(pcols)
+ real(r8) :: totalEmissionFlux(pcols)
+ real(r8), pointer :: cflx(:,:)
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ !Filter away unreasonable values for soil erodibility
+ !(using low values e.g. gives emissions in greenland..)
+ where(soil_erodibility(:,lchnk) .lt. 0.1_r8)
+ soil_erod_tmp(:)=0.0_r8
+ elsewhere
+ soil_erod_tmp(:)=soil_erodibility(:,lchnk)
+ end where
+
+ totalEmissionFlux(:)=0.0_r8
+ do i=1,ncol
+ totalEmissionFlux(i) = totalEmissionFlux(i) + sum(cam_in%dstflx(i,:))
+ end do
+
+ cflx => cam_in%cflx
+
+ !Note that following CESM use of "dust_emis_fact", the emissions are
+ !scaled by the INVERSE of the factor!!
+ !There is another random scale factor of 1.15 there. Adapting the exact
+ !same formulation as MAM now and tune later
+ !As of NE-380: Oslo dust emissions are 2/3 of CAM emissions
+ do n=1, numberOfDustModes
+ cflx(:ncol, tracerMap(n)) = -1.0_r8*emis_fraction_in_mode(n) &
+ *totalEmissionFlux(:ncol)*soil_erod_tmp(:ncol)/(dust_emis_fact)*1.15_r8 ! gives better AOD close to dust sources
+ end do
+
+
+ !call outfld('MBL_BSN_FCT',soil_erod_tmp,pcols,lchnk)
+ !call outfld('OSLO_DUST_EMIS',totalEmissionFlux,pcols,lchnk)
+
+ return
+ end subroutine oslo_dust_emis_intr
+
+end module dust_model
diff --git a/src/chemistry/oslo_aero/dust_sediment_mod.F90 b/src/chemistry/oslo_aero/dust_sediment_mod.F90
new file mode 100644
index 0000000000..09bd7dcefa
--- /dev/null
+++ b/src/chemistry/oslo_aero/dust_sediment_mod.F90
@@ -0,0 +1,506 @@
+module dust_sediment_mod
+
+!---------------------------------------------------------------------------------
+! Purpose:
+!
+! Contains routines to compute tendencies from sedimentation of dust
+!
+! Author: Phil Rasch
+!
+!---------------------------------------------------------------------------------
+
+ use shr_kind_mod, only: r8=>shr_kind_r8
+ use ppgrid, only: pcols, pver, pverp
+ use physconst, only: gravit, rair
+ use cam_logfile, only: iulog
+ use cam_abortutils, only: endrun
+
+ private
+ public :: dust_sediment_vel, dust_sediment_tend
+
+
+ real (r8), parameter :: vland = 2.8_r8 ! dust fall velocity over land (cm/s)
+ real (r8), parameter :: vocean = 1.5_r8 ! dust fall velocity over ocean (cm/s)
+ real (r8), parameter :: mxsedfac = 0.99_r8 ! maximum sedimentation flux factor
+
+contains
+
+!===============================================================================
+ subroutine dust_sediment_vel (ncol, &
+ icefrac , landfrac, ocnfrac , pmid , pdel , t , &
+ dustmr , pvdust )
+
+!----------------------------------------------------------------------
+
+! Compute gravitational sedimentation velocities for dust
+
+ implicit none
+
+! Arguments
+ integer, intent(in) :: ncol ! number of colums to process
+
+ real(r8), intent(in) :: icefrac (pcols) ! sea ice fraction (fraction)
+ real(r8), intent(in) :: landfrac(pcols) ! land fraction (fraction)
+ real(r8), intent(in) :: ocnfrac (pcols) ! ocean fraction (fraction)
+ real(r8), intent(in) :: pmid (pcols,pver) ! pressure of midpoint levels (Pa)
+ real(r8), intent(in) :: pdel (pcols,pver) ! pressure diff across layer (Pa)
+ real(r8), intent(in) :: t (pcols,pver) ! temperature (K)
+ real(r8), intent(in) :: dustmr(pcols,pver) ! dust (kg/kg)
+
+ real(r8), intent(out) :: pvdust (pcols,pverp) ! vertical velocity of dust (Pa/s)
+! -> note that pvel is at the interfaces (loss from cell is based on pvel(k+1))
+
+! Local variables
+ real (r8) :: rho(pcols,pver) ! air density in kg/m3
+ real (r8) :: vfall(pcols) ! settling velocity of dust particles (m/s)
+
+ integer i,k
+
+ real (r8) :: lbound, ac, bc, cc
+
+!-----------------------------------------------------------------------
+!--------------------- dust fall velocity ----------------------------
+!-----------------------------------------------------------------------
+
+ do k = 1,pver
+ do i = 1,ncol
+
+ ! merge the dust fall velocities for land and ocean (cm/s)
+ ! SHOULD ALSO ACCOUNT FOR ICEFRAC
+ vfall(i) = vland*landfrac(i) + vocean*(1._r8-landfrac(i))
+ !! vfall(i) = vland*landfrac(i) + vocean*ocnfrac(i) + vseaice*icefrac(i)
+
+ ! fall velocity (assume positive downward)
+ pvdust(i,k+1) = vfall(i)
+ end do
+ end do
+
+ return
+ end subroutine dust_sediment_vel
+
+
+!===============================================================================
+ subroutine dust_sediment_tend ( &
+ ncol, dtime, pint, pmid, pdel, t, &
+ dustmr ,pvdust, dusttend, sfdust, dusttend_to_ll_out )
+
+!----------------------------------------------------------------------
+! Apply Particle Gravitational Sedimentation
+!----------------------------------------------------------------------
+
+ implicit none
+
+! Arguments
+ integer, intent(in) :: ncol ! number of colums to process
+
+ real(r8), intent(in) :: dtime ! time step
+ real(r8), intent(in) :: pint (pcols,pverp) ! interfaces pressure (Pa)
+ real(r8), intent(in) :: pmid (pcols,pver) ! midpoint pressures (Pa)
+ real(r8), intent(in) :: pdel (pcols,pver) ! pressure diff across layer (Pa)
+ real(r8), intent(in) :: t (pcols,pver) ! temperature (K)
+ real(r8), intent(in) :: dustmr(pcols,pver) ! dust (kg/kg)
+ real(r8), intent(in) :: pvdust (pcols,pverp) ! vertical velocity of dust drops (Pa/s)
+! -> note that pvel is at the interfaces (loss from cell is based on pvel(k+1))
+
+ real(r8), intent(out) :: dusttend(pcols,pver) ! dust tend
+ real(r8), intent(out) :: sfdust (pcols) ! surface flux of dust (rain, kg/m/s)
+
+ real(r8),intent(out),optional :: dusttend_to_ll_out(pcols) ! fluxes at the interfaces, dust (positive = down)
+! Local variables
+ real(r8) :: fxdust(pcols,pverp) ! fluxes at the interfaces, dust (positive = down)
+
+ integer :: i,k
+!----------------------------------------------------------------------
+
+! initialize variables
+ fxdust (:ncol,:) = 0._r8 ! flux at interfaces (dust)
+ dusttend(:ncol,:) = 0._r8 ! tend (dust)
+ sfdust(:ncol) = 0._r8 ! sedimentation flux out bot of column (dust)
+
+! fluxes at interior points
+ call getflx(ncol, pint, dustmr, pvdust, dtime, fxdust)
+
+! calculate fluxes at boundaries
+ do i = 1,ncol
+ fxdust(i,1) = 0
+! surface flux by upstream scheme
+ fxdust(i,pverp) = dustmr(i,pver) * pvdust(i,pverp) * dtime
+ end do
+
+! filter out any negative fluxes from the getflx routine
+ do k = 2,pver
+ fxdust(:ncol,k) = max(0._r8, fxdust(:ncol,k))
+ end do
+
+! Limit the flux out of the bottom of each cell to the water content in each phase.
+! Apply mxsedfac to prevent generating very small negative cloud water/ice
+! NOTE, REMOVED CLOUD FACTOR FROM AVAILABLE WATER. ALL CLOUD WATER IS IN CLOUDS.
+! ***Should we include the flux in the top, to allow for thin surface layers?
+! ***Requires simple treatment of cloud overlap, already included below.
+ do k = 1,pver
+ do i = 1,ncol
+ fxdust(i,k+1) = min( fxdust(i,k+1), mxsedfac * dustmr(i,k) * pdel(i,k) )
+!!$ fxdust(i,k+1) = min( fxdust(i,k+1), dustmr(i,k) * pdel(i,k) + fxdust(i,k))
+ end do
+ end do
+
+! Now calculate the tendencies
+ do k = 1,pver
+ do i = 1,ncol
+! net flux into cloud changes cloud dust/ice (all flux is out of cloud)
+ dusttend(i,k) = (fxdust(i,k) - fxdust(i,k+1)) / (dtime * pdel(i,k))
+ end do
+ end do
+
+! convert flux out the bottom to mass units Pa -> kg/m2/s
+ sfdust(:ncol) = fxdust(:ncol,pverp) / (dtime*gravit)
+
+ if(present(dusttend_to_ll_out))then
+ dusttend_to_ll_out(1:ncol) = fxdust(:ncol,pver)/(dtime*pdel(:ncol,pver))
+ endif
+
+ return
+ end subroutine dust_sediment_tend
+
+!===============================================================================
+ subroutine getflx(ncol, xw, phi, vel, deltat, flux)
+
+!.....xw1.......xw2.......xw3.......xw4.......xw5.......xw6
+!....psiw1.....psiw2.....psiw3.....psiw4.....psiw5.....psiw6
+!....velw1.....velw2.....velw3.....velw4.....velw5.....velw6
+!.........phi1......phi2.......phi3.....phi4.......phi5.......
+
+
+ implicit none
+
+ integer ncol ! number of colums to process
+
+ integer i
+ integer k
+
+ real (r8) vel(pcols,pverp)
+ real (r8) flux(pcols,pverp)
+ real (r8) xw(pcols,pverp)
+ real (r8) psi(pcols,pverp)
+ real (r8) phi(pcols,pverp-1)
+ real (r8) fdot(pcols,pverp)
+ real (r8) xx(pcols)
+ real (r8) fxdot(pcols)
+ real (r8) fxdd(pcols)
+
+ real (r8) psistar(pcols)
+ real (r8) deltat
+
+ real (r8) xxk(pcols,pver)
+
+ do i = 1,ncol
+! integral of phi
+ psi(i,1) = 0._r8
+! fluxes at boundaries
+ flux(i,1) = 0
+ flux(i,pverp) = 0._r8
+ end do
+
+! integral function
+ do k = 2,pverp
+ do i = 1,ncol
+ psi(i,k) = phi(i,k-1)*(xw(i,k)-xw(i,k-1)) + psi(i,k-1)
+ end do
+ end do
+
+
+! calculate the derivatives for the interpolating polynomial
+ call cfdotmc_pro (ncol, xw, psi, fdot)
+
+! NEW WAY
+! calculate fluxes at interior pts
+ do k = 2,pver
+ do i = 1,ncol
+ xxk(i,k) = xw(i,k)-vel(i,k)*deltat
+ end do
+ end do
+ do k = 2,pver
+ call cfint2(ncol, xw, psi, fdot, xxk(1,k), fxdot, fxdd, psistar)
+ do i = 1,ncol
+ flux(i,k) = (psi(i,k)-psistar(i))
+ end do
+ end do
+
+
+ return
+ end subroutine getflx
+
+
+
+!##############################################################################
+
+ subroutine cfint2 (ncol, x, f, fdot, xin, fxdot, fxdd, psistar)
+
+
+ implicit none
+
+! input
+ integer ncol ! number of colums to process
+
+ real (r8) x(pcols, pverp)
+ real (r8) f(pcols, pverp)
+ real (r8) fdot(pcols, pverp)
+ real (r8) xin(pcols)
+
+! output
+ real (r8) fxdot(pcols)
+ real (r8) fxdd(pcols)
+ real (r8) psistar(pcols)
+
+ integer i
+ integer k
+ integer intz(pcols)
+ real (r8) dx
+ real (r8) s
+ real (r8) c2
+ real (r8) c3
+ real (r8) xx
+ real (r8) xinf
+ real (r8) psi1, psi2, psi3, psim
+ real (r8) cfint
+ real (r8) cfnew
+ real (r8) xins(pcols)
+
+! the minmod function
+ real (r8) a, b, c
+ real (r8) minmod
+ real (r8) medan
+ minmod(a,b) = 0.5_r8*(sign(1._r8,a) + sign(1._r8,b))*min(abs(a),abs(b))
+ medan(a,b,c) = a + minmod(b-a,c-a)
+
+ do i = 1,ncol
+ xins(i) = medan(x(i,1), xin(i), x(i,pverp))
+ intz(i) = 0
+ end do
+
+! first find the interval
+ do k = 1,pverp-1
+ do i = 1,ncol
+ if ((xins(i)-x(i,k))*(x(i,k+1)-xins(i)).ge.0._r8) then
+ intz(i) = k
+ endif
+ end do
+ end do
+
+ do i = 1,ncol
+ if (intz(i).eq.0) then
+ write(iulog,*) ' interval was not found for col i ', i
+ call endrun('DUST_SEDIMENT_MOD:cfint2 -- interval was not found ')
+ endif
+ end do
+
+! now interpolate
+ do i = 1,ncol
+ k = intz(i)
+ dx = (x(i,k+1)-x(i,k))
+ s = (f(i,k+1)-f(i,k))/dx
+ c2 = (3*s-2*fdot(i,k)-fdot(i,k+1))/dx
+ c3 = (fdot(i,k)+fdot(i,k+1)-2*s)/dx**2
+ xx = (xins(i)-x(i,k))
+ fxdot(i) = (3*c3*xx + 2*c2)*xx + fdot(i,k)
+ fxdd(i) = 6*c3*xx + 2*c2
+ cfint = ((c3*xx + c2)*xx + fdot(i,k))*xx + f(i,k)
+
+! limit the interpolant
+ psi1 = f(i,k)+(f(i,k+1)-f(i,k))*xx/dx
+ if (k.eq.1) then
+ psi2 = f(i,1)
+ else
+ psi2 = f(i,k) + (f(i,k)-f(i,k-1))*xx/(x(i,k)-x(i,k-1))
+ endif
+ if (k+1.eq.pverp) then
+ psi3 = f(i,pverp)
+ else
+ psi3 = f(i,k+1) - (f(i,k+2)-f(i,k+1))*(dx-xx)/(x(i,k+2)-x(i,k+1))
+ endif
+ psim = medan(psi1, psi2, psi3)
+ cfnew = medan(cfint, psi1, psim)
+ if (abs(cfnew-cfint)/(abs(cfnew)+abs(cfint)+1.e-36_r8) .gt..03_r8) then
+! CHANGE THIS BACK LATER!!!
+! $ .gt..1) then
+
+
+! UNCOMMENT THIS LATER!!!
+! write(iulog,*) ' cfint2 limiting important ', cfint, cfnew
+
+
+ endif
+ psistar(i) = cfnew
+ end do
+
+ return
+ end subroutine cfint2
+
+
+
+!##############################################################################
+
+ subroutine cfdotmc_pro (ncol, x, f, fdot)
+
+! prototype version; eventually replace with final SPITFIRE scheme
+
+! calculate the derivative for the interpolating polynomial
+! multi column version
+
+
+ implicit none
+
+! input
+ integer ncol ! number of colums to process
+
+ real (r8) x(pcols, pverp)
+ real (r8) f(pcols, pverp)
+! output
+ real (r8) fdot(pcols, pverp) ! derivative at nodes
+
+! assumed variable distribution
+! x1.......x2.......x3.......x4.......x5.......x6 1,pverp points
+! f1.......f2.......f3.......f4.......f5.......f6 1,pverp points
+! ...sh1.......sh2......sh3......sh4......sh5.... 1,pver points
+! .........d2.......d3.......d4.......d5......... 2,pver points
+! .........s2.......s3.......s4.......s5......... 2,pver points
+! .............dh2......dh3......dh4............. 2,pver-1 points
+! .............eh2......eh3......eh4............. 2,pver-1 points
+! ..................e3.......e4.................. 3,pver-1 points
+! .................ppl3......ppl4................ 3,pver-1 points
+! .................ppr3......ppr4................ 3,pver-1 points
+! .................t3........t4.................. 3,pver-1 points
+! ................fdot3.....fdot4................ 3,pver-1 points
+
+
+! work variables
+
+
+ integer i
+ integer k
+
+ real (r8) a ! work var
+ real (r8) b ! work var
+ real (r8) c ! work var
+ real (r8) s(pcols,pverp) ! first divided differences at nodes
+ real (r8) sh(pcols,pverp) ! first divided differences between nodes
+ real (r8) d(pcols,pverp) ! second divided differences at nodes
+ real (r8) dh(pcols,pverp) ! second divided differences between nodes
+ real (r8) e(pcols,pverp) ! third divided differences at nodes
+ real (r8) eh(pcols,pverp) ! third divided differences between nodes
+ real (r8) pp ! p prime
+ real (r8) ppl(pcols,pverp) ! p prime on left
+ real (r8) ppr(pcols,pverp) ! p prime on right
+ real (r8) qpl
+ real (r8) qpr
+ real (r8) ttt
+ real (r8) t
+ real (r8) tmin
+ real (r8) tmax
+ real (r8) delxh(pcols,pverp)
+
+
+! the minmod function
+ real (r8) minmod
+ real (r8) medan
+ minmod(a,b) = 0.5_r8*(sign(1._r8,a) + sign(1._r8,b))*min(abs(a),abs(b))
+ medan(a,b,c) = a + minmod(b-a,c-a)
+
+ do k = 1,pver
+
+
+! first divided differences between nodes
+ do i = 1, ncol
+ delxh(i,k) = (x(i,k+1)-x(i,k))
+ sh(i,k) = (f(i,k+1)-f(i,k))/delxh(i,k)
+ end do
+
+! first and second divided differences at nodes
+ if (k.ge.2) then
+ do i = 1,ncol
+ d(i,k) = (sh(i,k)-sh(i,k-1))/(x(i,k+1)-x(i,k-1))
+ s(i,k) = minmod(sh(i,k),sh(i,k-1))
+ end do
+ endif
+ end do
+
+! second and third divided diffs between nodes
+ do k = 2,pver-1
+ do i = 1, ncol
+ eh(i,k) = (d(i,k+1)-d(i,k))/(x(i,k+2)-x(i,k-1))
+ dh(i,k) = minmod(d(i,k),d(i,k+1))
+ end do
+ end do
+
+! treat the boundaries
+ do i = 1,ncol
+ e(i,2) = eh(i,2)
+ e(i,pver) = eh(i,pver-1)
+! outside level
+ fdot(i,1) = sh(i,1) - d(i,2)*delxh(i,1) &
+ - eh(i,2)*delxh(i,1)*(x(i,1)-x(i,3))
+ fdot(i,1) = minmod(fdot(i,1),3*sh(i,1))
+ fdot(i,pverp) = sh(i,pver) + d(i,pver)*delxh(i,pver) &
+ + eh(i,pver-1)*delxh(i,pver)*(x(i,pverp)-x(i,pver-1))
+ fdot(i,pverp) = minmod(fdot(i,pverp),3*sh(i,pver))
+! one in from boundary
+ fdot(i,2) = sh(i,1) + d(i,2)*delxh(i,1) - eh(i,2)*delxh(i,1)*delxh(i,2)
+ fdot(i,2) = minmod(fdot(i,2),3*s(i,2))
+ fdot(i,pver) = sh(i,pver) - d(i,pver)*delxh(i,pver) &
+ - eh(i,pver-1)*delxh(i,pver)*delxh(i,pver-1)
+ fdot(i,pver) = minmod(fdot(i,pver),3*s(i,pver))
+ end do
+
+
+ do k = 3,pver-1
+ do i = 1,ncol
+ e(i,k) = minmod(eh(i,k),eh(i,k-1))
+ end do
+ end do
+
+
+
+ do k = 3,pver-1
+
+ do i = 1,ncol
+
+! p prime at k-0.5
+ ppl(i,k)=sh(i,k-1) + dh(i,k-1)*delxh(i,k-1)
+! p prime at k+0.5
+ ppr(i,k)=sh(i,k) - dh(i,k) *delxh(i,k)
+
+ t = minmod(ppl(i,k),ppr(i,k))
+
+! derivate from parabola thru f(i,k-1), f(i,k), and f(i,k+1)
+ pp = sh(i,k-1) + d(i,k)*delxh(i,k-1)
+
+! quartic estimate of fdot
+ fdot(i,k) = pp &
+ - delxh(i,k-1)*delxh(i,k) &
+ *( eh(i,k-1)*(x(i,k+2)-x(i,k )) &
+ + eh(i,k )*(x(i,k )-x(i,k-2)) &
+ )/(x(i,k+2)-x(i,k-2))
+
+! now limit it
+ qpl = sh(i,k-1) &
+ + delxh(i,k-1)*minmod(d(i,k-1)+e(i,k-1)*(x(i,k)-x(i,k-2)), &
+ d(i,k) -e(i,k)*delxh(i,k))
+ qpr = sh(i,k) &
+ + delxh(i,k )*minmod(d(i,k) +e(i,k)*delxh(i,k-1), &
+ d(i,k+1)+e(i,k+1)*(x(i,k)-x(i,k+2)))
+
+ fdot(i,k) = medan(fdot(i,k), qpl, qpr)
+
+ ttt = minmod(qpl, qpr)
+ tmin = min(0._r8,3*s(i,k),1.5_r8*t,ttt)
+ tmax = max(0._r8,3*s(i,k),1.5_r8*t,ttt)
+
+ fdot(i,k) = fdot(i,k) + minmod(tmin-fdot(i,k), tmax-fdot(i,k))
+
+ end do
+
+ end do
+
+ return
+ end subroutine cfdotmc_pro
+end module dust_sediment_mod
diff --git a/src/chemistry/oslo_aero/hetfrz_classnuc_oslo.F90 b/src/chemistry/oslo_aero/hetfrz_classnuc_oslo.F90
new file mode 100644
index 0000000000..aadea38e2d
--- /dev/null
+++ b/src/chemistry/oslo_aero/hetfrz_classnuc_oslo.F90
@@ -0,0 +1,945 @@
+module hetfrz_classnuc_oslo
+
+!---------------------------------------------------------------------------------
+!
+! CAM Interfaces for hetfrz_classnuc module.
+!
+!---------------------------------------------------------------------------------
+
+use shr_kind_mod, only: r8=>shr_kind_r8
+use spmd_utils, only: masterproc
+use ppgrid, only: pcols, pver, begchunk, endchunk
+use physconst, only: rair, cpair, rh2o, rhoh2o, mwh2o, tmelt, pi
+use constituents, only: cnst_get_ind, pcnst
+use physics_types, only: physics_state
+use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field
+use phys_control, only: phys_getopts, use_hetfrz_classnuc
+
+use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_old_tim_idx, &
+ pbuf_get_index, pbuf_get_field
+use cam_history, only: addfld, add_default, outfld
+
+use ref_pres, only: top_lev => trop_cloud_top_lev
+use wv_saturation, only: svp_water, svp_ice
+
+use cam_logfile, only: iulog
+use error_messages, only: handle_errmsg, alloc_err
+use cam_abortutils, only: endrun
+
+use hetfrz_classnuc, only: hetfrz_classnuc_init, hetfrz_classnuc_calc
+use oslo_utils, only: CalculateNumberConcentration, calculateNumberMedianRadius
+use aerosoldef, only : MODE_IDX_DST_A2, MODE_IDX_DST_A3, MODE_IDX_OMBC_INTMIX_COAT_AIT
+implicit none
+private
+save
+
+public :: &
+ hetfrz_classnuc_oslo_readnl, &
+ hetfrz_classnuc_oslo_register, &
+ hetfrz_classnuc_oslo_init, &
+ hetfrz_classnuc_oslo_calc, &
+ hetfrz_classnuc_oslo_save_cbaero
+
+! Namelist variables
+logical :: hist_hetfrz_classnuc = .false.
+
+! Vars set via init method.
+real(r8) :: mincld ! minimum allowed cloud fraction
+
+! constituent indices
+integer :: &
+ cldliq_idx = -1, &
+ cldice_idx = -1, &
+ numliq_idx = -1, &
+ numice_idx = -1
+
+! pbuf indices for fields provided by heterogeneous freezing
+integer :: &
+ frzimm_idx, &
+ frzcnt_idx, &
+ frzdep_idx
+
+! pbuf indices for fields needed by heterogeneous freezing
+integer :: &
+ ast_idx = -1
+
+! specie properties
+real(r8) :: specdens_dust
+real(r8) :: specdens_so4
+real(r8) :: specdens_bc
+real(r8) :: specdens_soa
+real(r8) :: specdens_pom
+
+! List all species
+integer :: ncnst = 0 ! Total number of constituents (mass and number) needed
+ ! by the parameterization (depends on aerosol model used)
+
+integer :: so4_accum ! sulfate in accumulation mode
+integer :: bc_accum ! black-c in accumulation mode
+integer :: pom_accum ! p-organic in accumulation mode
+integer :: soa_accum ! s-organic in accumulation mode
+integer :: dst_accum ! dust in accumulation mode
+integer :: ncl_accum ! seasalt in accumulation mode
+integer :: num_accum ! number in accumulation mode
+
+integer :: dst_coarse ! dust in coarse mode
+integer :: ncl_coarse ! seasalt in coarse mode
+integer :: so4_coarse ! sulfate in coarse mode
+integer :: num_coarse ! number in coarse mode
+
+integer :: dst_finedust ! dust in finedust mode
+integer :: so4_finedust ! sulfate in finedust mode
+integer :: num_finedust ! number in finedust mode
+
+integer :: dst_coardust ! dust in coardust mode
+integer :: so4_coardust ! sulfate in coardust mode
+integer :: num_coardust ! number in coardust mode
+
+integer :: bc_pcarbon ! black-c in primary carbon mode
+integer :: pom_pcarbon ! p-organic in primary carbon mode
+integer :: num_pcarbon ! number in primary carbon mode
+
+! Index arrays for looping over all constituents
+integer, allocatable :: mode_idx(:)
+integer, allocatable :: spec_idx(:)
+
+! Copy of cloud borne aerosols before modification by droplet nucleation
+! The basis is converted from mass to volume.
+real(r8), allocatable :: aer_cb(:,:,:,:)
+
+! Copy of interstitial aerosols with basis converted from mass to volume.
+real(r8), allocatable :: aer(:,:,:,:)
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine hetfrz_classnuc_oslo_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use mpishorthand
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'hetfrz_classnuc_cam_readnl'
+
+ namelist /hetfrz_classnuc_nl/ hist_hetfrz_classnuc
+
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'hetfrz_classnuc_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, hetfrz_classnuc_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+
+ end if
+
+#ifdef SPMD
+ ! Broadcast namelist variables
+ call mpibcast(hist_hetfrz_classnuc, 1, mpilog, 0, mpicom)
+#endif
+
+end subroutine hetfrz_classnuc_oslo_readnl
+
+!================================================================================================
+
+subroutine hetfrz_classnuc_oslo_register()
+
+ if (.not. use_hetfrz_classnuc) return
+
+ ! pbuf fields provided by hetfrz_classnuc
+ call pbuf_add_field('FRZIMM', 'physpkg', dtype_r8, (/pcols,pver/), frzimm_idx)
+ call pbuf_add_field('FRZCNT', 'physpkg', dtype_r8, (/pcols,pver/), frzcnt_idx)
+ call pbuf_add_field('FRZDEP', 'physpkg', dtype_r8, (/pcols,pver/), frzdep_idx)
+
+end subroutine hetfrz_classnuc_oslo_register
+
+!================================================================================================
+
+subroutine hetfrz_classnuc_oslo_init(mincld_in)
+
+ real(r8), intent(in) :: mincld_in
+
+ ! local variables
+ logical :: prog_modal_aero
+ integer :: m, n, nspec
+ integer :: istat
+
+ real(r8) :: sigma_logr_aer
+
+ character(len=32) :: str32
+ character(len=*), parameter :: routine = 'hetfrz_classnuc_cam_init'
+ !--------------------------------------------------------------------------------------------
+
+ if (.not. use_hetfrz_classnuc) return
+
+ ! This parameterization currently assumes that prognostic modal aerosols are on. Check...
+ call phys_getopts(prog_modal_aero_out=prog_modal_aero)
+
+ mincld = mincld_in
+
+ call cnst_get_ind('CLDLIQ', cldliq_idx)
+ call cnst_get_ind('CLDICE', cldice_idx)
+ call cnst_get_ind('NUMLIQ', numliq_idx)
+ call cnst_get_ind('NUMICE', numice_idx)
+
+ ! pbuf fields used by hetfrz_classnuc
+ ast_idx = pbuf_get_index('AST')
+
+ call addfld('bc_num', (/ 'lev' /), 'A', '#/cm3', 'total bc number')
+ call addfld('dst1_num', (/ 'lev' /), 'A', '#/cm3', 'total dst1 number')
+ call addfld('dst3_num', (/ 'lev' /), 'A', '#/cm3', 'total dst3 number')
+ call addfld('bcc_num', (/ 'lev' /), 'A', '#/cm3', 'coated bc number')
+ call addfld('dst1c_num', (/ 'lev' /), 'A', '#/cm3', 'coated dst1 number')
+ call addfld('dst3c_num', (/ 'lev' /), 'A', '#/cm3', 'coated dst3 number')
+ call addfld('bcuc_num', (/ 'lev' /), 'A', '#/cm3', 'uncoated bc number')
+ call addfld('dst1uc_num', (/ 'lev' /), 'A', '#/cm3', 'uncoated dst1 number')
+ call addfld('dst3uc_num', (/ 'lev' /), 'A', '#/cm3', 'uncoated dst3 number')
+
+ call addfld('bc_a1_num', (/ 'lev' /), 'A', '#/cm3', 'interstitial bc number')
+ call addfld('dst_a1_num', (/ 'lev' /), 'A', '#/cm3', 'interstitial dst1 number')
+ call addfld('dst_a3_num', (/ 'lev' /), 'A', '#/cm3', 'interstitial dst3 number')
+ call addfld('bc_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne bc number')
+ call addfld('dst_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst1 number')
+ call addfld('dst_c3_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst3 number')
+
+ call addfld('fn_bc_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne bc number derived from fn')
+ call addfld('fn_dst_c1_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst1 number derived from fn')
+ call addfld('fn_dst_c3_num', (/ 'lev' /), 'A', '#/cm3', 'cloud borne dst3 number derived from fn')
+
+ call addfld('na500', (/ 'lev' /), 'A', '#/cm3', 'interstitial aerosol number with D>500 nm')
+ call addfld('totna500', (/ 'lev' /), 'A', '#/cm3', 'total aerosol number with D>500 nm')
+
+ call addfld('FREQIMM', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of immersion freezing')
+ call addfld('FREQCNT', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of contact freezing')
+ call addfld('FREQDEP', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of deposition freezing')
+ call addfld('FREQMIX', (/ 'lev' /), 'A', 'fraction', 'Fractional occurance of mixed-phase clouds' )
+
+ call addfld('DSTFREZIMM', (/ 'lev' /), 'A', 'm-3s-1', 'dust immersion freezing rate')
+ call addfld('DSTFREZCNT', (/ 'lev' /), 'A', 'm-3s-1', 'dust contact freezing rate')
+ call addfld('DSTFREZDEP', (/ 'lev' /), 'A', 'm-3s-1', 'dust deposition freezing rate')
+
+ call addfld('BCFREZIMM', (/ 'lev' /), 'A', 'm-3s-1', 'bc immersion freezing rate')
+ call addfld('BCFREZCNT', (/ 'lev' /), 'A', 'm-3s-1', 'bc contact freezing rate')
+ call addfld('BCFREZDEP', (/ 'lev' /), 'A', 'm-3s-1', 'bc deposition freezing rate')
+
+ call addfld('NIMIX_IMM', (/ 'lev' /), 'A', '#/m3', &
+ 'Activated Ice Number Concentration due to het immersion freezing in Mixed Clouds')
+ call addfld('NIMIX_CNT', (/ 'lev' /), 'A', '#/m3', &
+ 'Activated Ice Number Concentration due to het contact freezing in Mixed Clouds')
+ call addfld('NIMIX_DEP', (/ 'lev' /), 'A', '#/m3', &
+ 'Activated Ice Number Concentration due to het deposition freezing in Mixed Clouds')
+
+ call addfld('DSTNIDEP', (/ 'lev' /), 'A', '#/m3', &
+ 'Activated Ice Number Concentration due to dst dep freezing in Mixed Clouds')
+ call addfld('DSTNICNT', (/ 'lev' /), 'A', '#/m3', &
+ 'Activated Ice Number Concentration due to dst cnt freezing in Mixed Clouds')
+ call addfld('DSTNIIMM', (/ 'lev' /), 'A', '#/m3', &
+ 'Activated Ice Number Concentration due to dst imm freezing in Mixed Clouds')
+
+ call addfld('BCNIDEP', (/ 'lev' /), 'A', '#/m3', &
+ 'Activated Ice Number Concentration due to bc dep freezing in Mixed Clouds')
+ call addfld('BCNICNT', (/ 'lev' /), 'A', '#/m3', &
+ 'Activated Ice Number Concentration due to bc cnt freezing in Mixed Clouds')
+ call addfld('BCNIIMM', (/ 'lev' /), 'A', '#/m3', &
+ 'Activated Ice Number Concentration due to bc imm freezing in Mixed Clouds')
+
+ call addfld('NUMICE10s', (/ 'lev' /), 'A', '#/m3', &
+ 'Ice Number Concentration due to het freezing in Mixed Clouds during 10-s period')
+ call addfld('NUMIMM10sDST', (/ 'lev' /), 'A', '#/m3', &
+ 'Ice Number Concentration due to imm freezing by dst in Mixed Clouds during 10-s period')
+ call addfld('NUMIMM10sBC', (/ 'lev' /), 'A', '#/m3', &
+ 'Ice Number Concentration due to imm freezing by bc in Mixed Clouds during 10-s period')
+
+ if (hist_hetfrz_classnuc) then
+
+ call add_default('bc_num', 1, ' ')
+ call add_default('dst1_num', 1, ' ')
+ call add_default('dst3_num', 1, ' ')
+ call add_default('bcc_num', 1, ' ')
+ call add_default('dst1c_num', 1, ' ')
+ call add_default('dst3c_num', 1, ' ')
+ call add_default('bcuc_num', 1, ' ')
+ call add_default('dst1uc_num', 1, ' ')
+ call add_default('dst3uc_num', 1, ' ')
+
+ call add_default('bc_a1_num', 1, ' ')
+ call add_default('dst_a1_num', 1, ' ')
+ call add_default('dst_a3_num', 1, ' ')
+ call add_default('bc_c1_num', 1, ' ')
+ call add_default('dst_c1_num', 1, ' ')
+ call add_default('dst_c3_num', 1, ' ')
+
+ call add_default('fn_bc_c1_num', 1, ' ')
+ call add_default('fn_dst_c1_num', 1, ' ')
+ call add_default('fn_dst_c3_num', 1, ' ')
+
+ call add_default('na500', 1, ' ')
+ call add_default('totna500', 1, ' ')
+
+ call add_default('FREQIMM', 1, ' ')
+ call add_default('FREQCNT', 1, ' ')
+ call add_default('FREQDEP', 1, ' ')
+ call add_default('FREQMIX', 1, ' ')
+
+ call add_default('DSTFREZIMM', 1, ' ')
+ call add_default('DSTFREZCNT', 1, ' ')
+ call add_default('DSTFREZDEP', 1, ' ')
+
+ call add_default('BCFREZIMM', 1, ' ')
+ call add_default('BCFREZCNT', 1, ' ')
+ call add_default('BCFREZDEP', 1, ' ')
+
+ call add_default('NIMIX_IMM', 1, ' ')
+ call add_default('NIMIX_CNT', 1, ' ')
+ call add_default('NIMIX_DEP', 1, ' ')
+
+ call add_default('DSTNIDEP', 1, ' ')
+ call add_default('DSTNICNT', 1, ' ')
+ call add_default('DSTNIIMM', 1, ' ')
+
+ call add_default('BCNIDEP', 1, ' ')
+ call add_default('BCNICNT', 1, ' ')
+ call add_default('BCNIIMM', 1, ' ')
+
+ call add_default('NUMICE10s', 1, ' ')
+ call add_default('NUMIMM10sDST', 1, ' ')
+ call add_default('NUMIMM10sBC', 1, ' ')
+
+ end if
+
+ ! The following code sets indices of the mode specific species used
+ ! in the module. Having a list of the species needed allows us to
+ ! allocate temporary space for just those species rather than for all the
+ ! CAM species (pcnst) which may be considerably more than needed.
+ !
+ ! The indices set below are for use with the CAM rad_constituents
+ ! interfaces. Using the rad_constituents interfaces isolates the physics
+ ! parameterization which requires constituent information from the chemistry
+ ! code which provides that information.
+
+ ! Allocate space for copy of cloud borne aerosols before modification by droplet nucleation.
+ allocate(aer_cb(pcols,pver,pcnst,begchunk:endchunk), stat=istat)
+ call alloc_err(istat, routine, 'aer_cb', pcols*pver*ncnst*(endchunk-begchunk+1))
+
+ ! Allocate space for copy of interstitial aerosols with modified basis
+ allocate(aer(pcols,pver,pcnst,begchunk:endchunk), stat=istat)
+ call alloc_err(istat, routine, 'aer', pcols*pver*ncnst*(endchunk-begchunk+1))
+ call hetfrz_classnuc_init( &
+ rair, cpair, rh2o, rhoh2o, mwh2o, &
+ tmelt, pi, iulog)
+
+end subroutine hetfrz_classnuc_oslo_init
+
+!================================================================================================
+
+subroutine hetfrz_classnuc_oslo_calc( &
+ state, deltatin, factnum, pbuf &
+ ,numberConcentration, volumeConcentration &
+ ,f_acm, f_bcm, f_aqm, f_so4_condm, f_soam &
+ ,hygroscopicity, lnsigma, cam, volumeCore, volumeCoat)
+
+ use commondefinitions, only: nmodes_oslo => nmodes
+ use modal_aero_data, only : qqcw_get_field
+ use aerosoldef, only : getNumberOfTracersInMode, getTracerIndex
+ implicit none
+
+ ! arguments
+ type(physics_state), target, intent(in) :: state
+ real(r8), intent(in) :: deltatin ! time step (s)
+ real(r8), intent(in) :: factnum(:,:,:) ! activation fraction for aerosol number
+ real(r8), intent(in) :: numberConcentration(pcols,pver,0:nmodes_oslo)
+ real(r8), intent(in) :: volumeConcentration(pcols,pver,nmodes_oslo)
+
+ real(r8),intent(in) :: f_acm(pcols,pver, nmodes_oslo)
+ real(r8),intent(in) :: f_bcm(pcols,pver, nmodes_oslo)
+ real(r8),intent(in) :: f_aqm(pcols, pver, nmodes_oslo)
+ real(r8),intent(in) :: f_so4_condm(pcols, pver, nmodes_oslo) !Needed in "get component fraction"
+ real(r8),intent(in) :: f_soam(pcols, pver, nmodes_oslo)
+
+ real(r8),intent(in) :: hygroscopicity(pcols,pver,nmodes_oslo) ![mol_{aer}/mol_{water}] hygroscopicity
+ real(r8),intent(in) :: lnsigma(pcols,pver,nmodes_oslo) ![-] log(base e) sigma
+ real(r8),intent(in) :: cam(pcols,pver,nmodes_oslo)
+ real(r8),intent(in) :: volumeCore(pcols,pver,nmodes_oslo)
+ real(r8),intent(in) :: volumeCoat(pcols,pver,nmodes_oslo)
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! local workspace
+
+ ! outputs shared with the microphysics via the pbuf
+ real(r8), pointer :: frzimm(:,:)
+ real(r8), pointer :: frzcnt(:,:)
+ real(r8), pointer :: frzdep(:,:)
+
+ integer :: itim_old
+ integer :: i, k
+
+ real(r8) :: rho(pcols,pver) ! air density (kg m-3)
+
+ real(r8), pointer :: ast(:,:)
+
+ real(r8) :: lcldm(pcols,pver)
+
+ real(r8), pointer :: ptr2d(:,:)
+
+ real(r8) :: fn(3)
+ real(r8) :: awcam(pcols,pver,3)
+ real(r8) :: awfacm(pcols,pver,3)
+ real(r8) :: hetraer(pcols,pver,3)
+ real(r8) :: dstcoat(pcols,pver,3)
+ real(r8) :: total_interstitial_aer_num(pcols,pver,3)
+ real(r8) :: total_cloudborne_aer_num(pcols,pver,3)
+ real(r8) :: total_aer_num(pcols,pver,3)
+ real(r8) :: coated_aer_num(pcols,pver,3)
+ real(r8) :: uncoated_aer_num(pcols,pver,3)
+
+ real(r8) :: fn_cloudborne_aer_num(pcols,pver,3)
+
+
+ real(r8) :: con1, r3lx, supersatice
+
+ real(r8) :: qcic
+ real(r8) :: ncic
+
+ real(r8) :: frzbcimm(pcols,pver), frzduimm(pcols,pver)
+ real(r8) :: frzbccnt(pcols,pver), frzducnt(pcols,pver)
+ real(r8) :: frzbcdep(pcols,pver), frzdudep(pcols,pver)
+
+ real(r8) :: freqimm(pcols,pver), freqcnt(pcols,pver), freqdep(pcols,pver), freqmix(pcols,pver)
+ real(r8) :: nnuccc_bc(pcols,pver), nnucct_bc(pcols,pver), nnudep_bc(pcols,pver)
+ real(r8) :: nnuccc_dst(pcols,pver), nnucct_dst(pcols,pver), nnudep_dst(pcols,pver)
+ real(r8) :: niimm_bc(pcols,pver), nicnt_bc(pcols,pver), nidep_bc(pcols,pver)
+ real(r8) :: niimm_dst(pcols,pver), nicnt_dst(pcols,pver), nidep_dst(pcols,pver)
+ real(r8) :: numice10s(pcols,pver)
+ real(r8) :: numice10s_imm_dst(pcols,pver)
+ real(r8) :: numice10s_imm_bc(pcols,pver)
+
+!++oslo aerosol specific
+ real(r8) :: qaercwpt(pcols,pver,pcnst)
+ real(r8) :: CloudnumberConcentration(pcols,pver,0:nmodes_oslo)
+ real(r8) :: numberMedianRadius(pcols,pver,nmodes_oslo)
+!--oslo aerosol specific
+
+ real(r8) :: na500(pcols,pver)
+ real(r8) :: tot_na500(pcols,pver)
+
+ character(128) :: errstring ! Error status
+
+ integer :: n, m, kk
+ !-------------------------------------------------------------------------------
+
+ associate( &
+ lchnk => state%lchnk, &
+ ncol => state%ncol, &
+ t => state%t, &
+ qc => state%q(:pcols,:pver,cldliq_idx), &
+ nc => state%q(:pcols,:pver,numliq_idx), &
+ pmid => state%pmid )
+
+ itim_old = pbuf_old_tim_idx()
+ call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+
+ rho(:,:) = 0._r8
+
+ do k = top_lev, pver
+ do i = 1, ncol
+ rho(i,k) = pmid(i,k)/(rair*t(i,k))
+ end do
+ end do
+
+ do k = top_lev, pver
+ do i = 1, ncol
+ lcldm(i,k) = max(ast(i,k), mincld)
+ end do
+ end do
+
+ ! Convert interstitial and cloud borne aerosols from a mass to a volume basis before
+ ! being used in get_aer_num
+ do i = 1, pcnst
+ aer_cb(:ncol,:,i,lchnk) = aer_cb(:ncol,:,i,lchnk) * rho(:ncol,:)
+
+ ! Check whether constituent is a mass or number mixing ratio
+ !if (spec_idx(i) == 0) then
+ ! call rad_cnst_get_mode_num(0, mode_idx(i), 'a', state, pbuf, ptr2d)
+ !else
+ ! call rad_cnst_get_aer_mmr(0, mode_idx(i), spec_idx(i), 'a', state, pbuf, ptr2d)
+ !end if
+ !aer(:ncol,:,i,lchnk) = ptr2d(:ncol,:) * rho(:ncol,:)
+ end do
+
+ ! Init top levels of outputs of get_aer_num
+ total_aer_num = 0._r8
+ coated_aer_num = 0._r8
+ uncoated_aer_num = 0._r8
+ total_interstitial_aer_num = 0._r8
+ total_cloudborne_aer_num = 0._r8
+ hetraer = 0._r8
+ awcam = 0._r8
+ awfacm = 0._r8
+ dstcoat = 0._r8
+ na500 = 0._r8
+ tot_na500 = 0._r8
+
+
+ !Get estimate of number of aerosols inside clouds
+ call calculateNumberConcentration(ncol, aer_cb, rho, CloudnumberConcentration)
+ call calculateNumberMedianRadius(numberConcentration, volumeConcentration, lnSigma, numberMedianRadius, ncol)
+ !End estimate of number inside clouds
+
+ ! output aerosols as reference information for heterogeneous freezing
+ do i = 1, ncol
+ do k = top_lev, pver
+ call get_aer_num(numberConcentration(i,k,:), CloudnumberConcentration(i,k,:), rho(i,k), &
+ !++ MH_2015/04/10
+ f_acm(i,k,:), f_so4_condm(i,k,:), cam(i,k,:), volumeCore(i,k,:), volumeCoat(i,k,:), &
+ !-- MH_2015/04/10
+ total_aer_num(i,k,:), coated_aer_num(i,k,:), uncoated_aer_num(i,k,:), &
+ total_interstitial_aer_num(i,k,:), total_cloudborne_aer_num(i,k,:), &
+ hetraer(i,k,:), awcam(i,k,:), awfacm(i,k,:), dstcoat(i,k,:), &
+ na500(i,k), tot_na500(i,k))
+
+ fn_cloudborne_aer_num(i,k,1) = total_aer_num(i,k,1)*factnum(i,k,MODE_IDX_OMBC_INTMIX_COAT_AIT) ! bc
+ fn_cloudborne_aer_num(i,k,2) = total_aer_num(i,k,2)*factnum(i,k,MODE_IDX_DST_A2)
+ fn_cloudborne_aer_num(i,k,3) = total_aer_num(i,k,3)*factnum(i,k,MODE_IDX_DST_A3)
+ end do
+ end do
+
+ call outfld('bc_num', total_aer_num(:,:,1), pcols, lchnk)
+ call outfld('dst1_num', total_aer_num(:,:,2), pcols, lchnk)
+ call outfld('dst3_num', total_aer_num(:,:,3), pcols, lchnk)
+
+ call outfld('bcc_num', coated_aer_num(:,:,1), pcols, lchnk)
+ call outfld('dst1c_num', coated_aer_num(:,:,2), pcols, lchnk)
+ call outfld('dst3c_num', coated_aer_num(:,:,3), pcols, lchnk)
+
+ call outfld('bcuc_num', uncoated_aer_num(:,:,1), pcols, lchnk)
+ call outfld('dst1uc_num', uncoated_aer_num(:,:,2), pcols, lchnk)
+ call outfld('dst3uc_num', uncoated_aer_num(:,:,3), pcols, lchnk)
+
+ call outfld('bc_a1_num', total_interstitial_aer_num(:,:,1), pcols, lchnk)
+ call outfld('dst_a1_num', total_interstitial_aer_num(:,:,2), pcols, lchnk)
+ call outfld('dst_a3_num', total_interstitial_aer_num(:,:,3), pcols, lchnk)
+
+ call outfld('bc_c1_num', total_cloudborne_aer_num(:,:,1), pcols, lchnk)
+ call outfld('dst_c1_num', total_cloudborne_aer_num(:,:,2), pcols, lchnk)
+ call outfld('dst_c3_num', total_cloudborne_aer_num(:,:,3), pcols, lchnk)
+
+ call outfld('fn_bc_c1_num', fn_cloudborne_aer_num(:,:,1), pcols, lchnk)
+ call outfld('fn_dst_c1_num', fn_cloudborne_aer_num(:,:,2), pcols, lchnk)
+ call outfld('fn_dst_c3_num', fn_cloudborne_aer_num(:,:,3), pcols, lchnk)
+
+ call outfld('na500', na500, pcols, lchnk)
+ call outfld('totna500', tot_na500, pcols, lchnk)
+
+ ! frzimm, frzcnt, frzdep are the outputs of this parameterization used by the microphysics
+ call pbuf_get_field(pbuf, frzimm_idx, frzimm)
+ call pbuf_get_field(pbuf, frzcnt_idx, frzcnt)
+ call pbuf_get_field(pbuf, frzdep_idx, frzdep)
+
+ frzimm(:ncol,:) = 0._r8
+ frzcnt(:ncol,:) = 0._r8
+ frzdep(:ncol,:) = 0._r8
+
+ frzbcimm(:ncol,:) = 0._r8
+ frzduimm(:ncol,:) = 0._r8
+ frzbccnt(:ncol,:) = 0._r8
+ frzducnt(:ncol,:) = 0._r8
+ frzbcdep(:ncol,:) = 0._r8
+ frzdudep(:ncol,:) = 0._r8
+
+ freqimm(:ncol,:) = 0._r8
+ freqcnt(:ncol,:) = 0._r8
+ freqdep(:ncol,:) = 0._r8
+ freqmix(:ncol,:) = 0._r8
+
+ numice10s(:ncol,:) = 0._r8
+ numice10s_imm_dst(:ncol,:) = 0._r8
+ numice10s_imm_bc(:ncol,:) = 0._r8
+
+ nnuccc_bc(:,:) = 0._r8
+ nnucct_bc(:,:) = 0._r8
+ nnudep_bc(:,:) = 0._r8
+
+ nnuccc_dst(:,:) = 0._r8
+ nnucct_dst(:,:) = 0._r8
+ nnudep_dst(:,:) = 0._r8
+
+ niimm_bc(:,:) = 0._r8
+ nicnt_bc(:,:) = 0._r8
+ nidep_bc(:,:) = 0._r8
+
+ niimm_dst(:,:) = 0._r8
+ nicnt_dst(:,:) = 0._r8
+ nidep_dst(:,:) = 0._r8
+
+ do i = 1, ncol
+ do k = top_lev, pver
+
+ if (t(i,k) > 235.15_r8 .and. t(i,k) < 269.15_r8) then
+ qcic = min(qc(i,k)/lcldm(i,k), 5.e-3_r8)
+ ncic = max(nc(i,k)/lcldm(i,k), 0._r8)
+
+ con1 = 1._r8/(1.333_r8*pi)**0.333_r8
+ r3lx = con1*(rho(i,k)*qcic/(rhoh2o*max(ncic*rho(i,k), 1.0e6_r8)))**0.333_r8 ! in m
+ r3lx = max(4.e-6_r8, r3lx)
+ supersatice = svp_water(t(i,k))/svp_ice(t(i,k))
+ fn(1) = factnum(i,k,MODE_IDX_OMBC_INTMIX_COAT_AIT) ! bc accumulation mode
+ fn(2) = factnum(i,k,MODE_IDX_DST_A2) ! dust_a1 accumulation mode
+ fn(3) = factnum(i,k,MODE_IDX_DST_A3) ! dust_a3 coarse mode
+
+ call hetfrz_classnuc_calc( &
+ deltatin, t(i,k), pmid(i,k), supersatice, &
+ fn, r3lx, ncic*rho(i,k)*1.0e-6_r8, frzbcimm(i,k), frzduimm(i,k), &
+ frzbccnt(i,k), frzducnt(i,k), frzbcdep(i,k), frzdudep(i,k), hetraer(i,k,:), &
+ awcam(i,k,:), awfacm(i,k,:), dstcoat(i,k,:), total_aer_num(i,k,:), &
+ coated_aer_num(i,k,:), uncoated_aer_num(i,k,:), total_interstitial_aer_num(i,k,:), &
+ total_cloudborne_aer_num(i,k,:), errstring)
+
+ call handle_errmsg(errstring, subname="hetfrz_classnuc_calc")
+
+ frzimm(i,k) = frzbcimm(i,k) + frzduimm(i,k)
+ frzcnt(i,k) = frzbccnt(i,k) + frzducnt(i,k)
+ frzdep(i,k) = frzbcdep(i,k) + frzdudep(i,k)
+
+ if (frzimm(i,k) > 0._r8) freqimm(i,k) = 1._r8
+ if (frzcnt(i,k) > 0._r8) freqcnt(i,k) = 1._r8
+ if (frzdep(i,k) > 0._r8) freqdep(i,k) = 1._r8
+ if ((frzimm(i,k) + frzcnt(i,k) + frzdep(i,k)) > 0._r8) freqmix(i,k) = 1._r8
+ else
+ frzimm(i,k) = 0._r8
+ frzcnt(i,k) = 0._r8
+ frzdep(i,k) = 0._r8
+ end if
+
+ nnuccc_bc(i,k) = frzbcimm(i,k)*1.0e6_r8*ast(i,k)
+ nnucct_bc(i,k) = frzbccnt(i,k)*1.0e6_r8*ast(i,k)
+ nnudep_bc(i,k) = frzbcdep(i,k)*1.0e6_r8*ast(i,k)
+
+ nnuccc_dst(i,k) = frzduimm(i,k)*1.0e6_r8*ast(i,k)
+ nnucct_dst(i,k) = frzducnt(i,k)*1.0e6_r8*ast(i,k)
+ nnudep_dst(i,k) = frzdudep(i,k)*1.0e6_r8*ast(i,k)
+
+ niimm_bc(i,k) = frzbcimm(i,k)*1.0e6_r8*deltatin
+ nicnt_bc(i,k) = frzbccnt(i,k)*1.0e6_r8*deltatin
+ nidep_bc(i,k) = frzbcdep(i,k)*1.0e6_r8*deltatin
+
+ niimm_dst(i,k) = frzduimm(i,k)*1.0e6_r8*deltatin
+ nicnt_dst(i,k) = frzducnt(i,k)*1.0e6_r8*deltatin
+ nidep_dst(i,k) = frzdudep(i,k)*1.0e6_r8*deltatin
+
+ numice10s(i,k) = (frzimm(i,k)+frzcnt(i,k)+frzdep(i,k))*1.0e6_r8*deltatin*(10._r8/deltatin)
+ numice10s_imm_dst(i,k) = frzduimm(i,k)*1.0e6_r8*deltatin*(10._r8/deltatin)
+ numice10s_imm_bc(i,k) = frzbcimm(i,k)*1.0e6_r8*deltatin*(10._r8/deltatin)
+ end do
+ end do
+
+ call outfld('FREQIMM', freqimm, pcols, lchnk)
+ call outfld('FREQCNT', freqcnt, pcols, lchnk)
+ call outfld('FREQDEP', freqdep, pcols, lchnk)
+ call outfld('FREQMIX', freqmix, pcols, lchnk)
+
+ call outfld('DSTFREZIMM', nnuccc_dst, pcols, lchnk)
+ call outfld('DSTFREZCNT', nnucct_dst, pcols, lchnk)
+ call outfld('DSTFREZDEP', nnudep_dst, pcols, lchnk)
+
+ call outfld('BCFREZIMM', nnuccc_bc, pcols, lchnk)
+ call outfld('BCFREZCNT', nnucct_bc, pcols, lchnk)
+ call outfld('BCFREZDEP', nnudep_bc, pcols, lchnk)
+
+ call outfld('NIMIX_IMM', niimm_bc+niimm_dst, pcols, lchnk)
+ call outfld('NIMIX_CNT', nicnt_bc+nicnt_dst, pcols, lchnk)
+ call outfld('NIMIX_DEP', nidep_bc+nidep_dst, pcols, lchnk)
+
+ call outfld('DSTNICNT', nicnt_dst, pcols, lchnk)
+ call outfld('DSTNIDEP', nidep_dst, pcols, lchnk)
+ call outfld('DSTNIIMM', niimm_dst, pcols, lchnk)
+
+ call outfld('BCNICNT', nicnt_bc, pcols, lchnk)
+ call outfld('BCNIDEP', nidep_bc, pcols, lchnk)
+ call outfld('BCNIIMM', niimm_bc, pcols, lchnk)
+
+ call outfld('NUMICE10s', numice10s, pcols, lchnk)
+ call outfld('NUMIMM10sDST', numice10s_imm_dst, pcols, lchnk)
+ call outfld('NUMIMM10sBC', numice10s_imm_bc, pcols, lchnk)
+
+ end associate
+
+end subroutine hetfrz_classnuc_oslo_calc
+
+!====================================================================================================
+
+subroutine hetfrz_classnuc_oslo_save_cbaero(state, pbuf)
+
+ use commondefinitions, only: nmodes_oslo => nmodes
+ use aerosoldef, only: getTracerIndex, getNumberOfTracersInMode
+ use modal_aero_data, only: qqcw_get_field
+
+ ! Save the required cloud borne aerosol constituents.
+ type(physics_state), intent(in) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! local variables
+ integer :: i, lchnk, kk, ncol, m, n
+ real(r8), pointer :: ptr2d(:,:)
+ type qqcw_type
+ real(r8), pointer :: fldcw(:,:)
+ end type qqcw_type
+ type(qqcw_type) :: qqcw(pcnst)
+ !-------------------------------------------------------------------------------
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ ! loop over the cloud borne constituents required by this module and save
+ ! a local copy
+
+ aer_cb(1:ncol,1:pver,:,lchnk) = 0.0_r8
+ do m=1,nmodes_oslo
+ do n=1,getNumberOfTracersInMode(m)
+ kk=getTracerIndex(m,n,.false.)! This gives the tracer index used in the q-array
+ qqcw(kk)%fldcw => qqcw_get_field(pbuf,kk,lchnk,.TRUE.)
+ if(associated(qqcw(kk)%fldcw))then
+ aer_cb(:,:,kk,lchnk) = qqcw(kk)%fldcw
+ end if
+ end do
+ end do
+
+end subroutine hetfrz_classnuc_oslo_save_cbaero
+
+!====================================================================================================
+
+subroutine get_aer_num(qaerpt, qaercwpt, rhoair, & ! input
+ f_acm, f_condm, &
+ cam, volumeCore, volumeCoat, &
+ total_aer_num, & ! output
+ coated_aer_num, &
+ uncoated_aer_num, &
+ total_interstial_aer_num, &
+ total_cloudborne_aer_num, &
+ hetraer, awcam, awfacm, dstcoat, &
+!++ wy4.0
+ na500, tot_na500)
+!-- wy4.0
+
+ use spmd_utils, only: iam
+ use shr_kind_mod, only: r8 => shr_kind_r8
+! use ppgrid, only : pcols, pver
+ use constituents, only: pcnst
+ use commondefinitions, only: nmodes_oslo => nmodes
+ use aerosoldef, only:MODE_IDX_DST_A2, MODE_IDX_DST_A3, &
+ l_dst_a2, l_dst_a3, l_bc_ai, &
+ MODE_IDX_OMBC_INTMIX_COAT_AIT, l_bc_ac, &
+ lifeCycleNumberMedianRadius, &
+ lifeCycleSigma
+
+
+ implicit none
+
+ ! input
+ real(r8), intent(in) :: qaerpt(0:nmodes_oslo) ! aerosol number and mass mixing ratios(instertitial)
+ real(r8), intent(in) :: qaercwpt(0:nmodes_oslo) ! cloud borne aerosol number and mass mixing ratios
+ real(r8), intent(in) :: rhoair ! air density (kg/m3)
+ real(r8), intent(in) :: f_acm(nmodes_oslo)
+ real(r8), intent(in) :: f_condm(nmodes_oslo)
+ real(r8), intent(in) :: cam(nmodes_oslo)
+ real(r8), intent(in) :: volumeCoat(nmodes_oslo)
+ real(r8), intent(in) :: volumeCore(nmodes_oslo)
+ real(r8) :: sigmag_amode(3)
+
+
+ ! output
+ real(r8), intent(out) :: total_aer_num(3) ! #/cm^3
+ real(r8), intent(out) :: total_interstial_aer_num(3) ! #/cm^3
+ real(r8), intent(out) :: total_cloudborne_aer_num(3) ! #/cm^3
+ real(r8), intent(out) :: coated_aer_num(3) ! #/cm^3
+ real(r8), intent(out) :: uncoated_aer_num(3) ! #/cm^3
+ real(r8), intent(out) :: hetraer(3) ! BC and Dust mass mean radius [m]
+ real(r8), intent(out) :: awcam(3) ! modal added mass [mug m-3]
+ real(r8), intent(out) :: awfacm(3) ! (OC+BC)/(OC+BC+SO4)
+ real(r8), intent(out) :: dstcoat(3) ! coated fraction
+ real(r8), intent(out) :: na500 ! #/cm^3 interstitial aerosol number with D>500 nm (#/cm^3)
+ real(r8), intent(out) :: tot_na500 ! #/cm^3 total aerosol number with D>500 nm (#/cm^3)
+ !local variables
+ !------------coated variables--------------------
+ real(r8), parameter :: n_so4_monolayers_dust = 1.0_r8 ! number of so4(+nh4) monolayers needed to coat a dust particle
+ real(r8), parameter :: dr_so4_monolayers_dust = n_so4_monolayers_dust * 4.76e-10
+ real(r8) :: tmp1, tmp2
+
+ real(r8) :: bc_num ! bc number in accumulation mode
+ real(r8) :: dst1_num, dst3_num ! dust number in accumulation and corase mode
+ real(r8) :: dst1_num_imm, dst3_num_imm, bc_num_imm
+ real(r8) :: fac_volsfc_bc, fac_volsfc_dust_a1, fac_volsfc_dust_a3
+
+ real(r8) :: r_bc ! model radii of BC modes [m]
+ real(r8) :: r_dust_a1, r_dust_a3 ! model radii of dust modes [m]
+
+ integer :: i
+
+ integer :: num_bc_idx, num_dst1_idx, num_dst3_idx ! mode indices
+
+ num_bc_idx = MODE_IDX_OMBC_INTMIX_COAT_AIT
+ num_dst1_idx = MODE_IDX_DST_A2
+ num_dst3_idx = MODE_IDX_DST_A3
+
+
+!*****************************************************************************
+! calculate intersitial aerosol
+!*****************************************************************************
+
+ dst1_num = qaerpt(num_dst1_idx)*1.0e-6_r8 ! #/cm3
+ dst3_num = qaerpt(num_dst3_idx)*1.0e-6_r8 ! #/cm3
+ bc_num = qaerpt(num_bc_idx)*1.0e-6_r8 ! #/cm3
+
+
+!*****************************************************************************
+! calculate cloud borne aerosol
+!*****************************************************************************
+
+ dst1_num_imm = qaercwpt(num_dst1_idx)*1.0e-6_r8 ! #/cm3
+ dst3_num_imm = qaercwpt(num_dst3_idx)*1.0e-6_r8 ! #/cm3
+ bc_num_imm = qaercwpt(num_bc_idx)*1.0e-6_r8 ! #/cm3
+
+! calculate mass mean radius
+ r_dust_a1 = lifeCycleNumberMedianRadius(num_dst1_idx)
+ r_dust_a3 = lifeCycleNumberMedianRadius(num_dst3_idx)
+ r_bc = lifeCycleNumberMedianRadius(num_bc_idx)
+
+ hetraer(1) = r_bc
+ hetraer(2) = r_dust_a1
+ hetraer(3) = r_dust_a3
+
+
+!*****************************************************************************
+! calculate coated fraction
+!*****************************************************************************
+
+! volumeCore and volumeCoat from subroutine calculateHygroscopicity in paramix_progncdnc.f90
+
+ sigmag_amode(1) = lifeCycleSigma(num_bc_idx)
+ sigmag_amode(2) = lifeCycleSigma(num_dst1_idx)
+ sigmag_amode(3) = lifeCycleSigma(num_dst3_idx)
+
+ fac_volsfc_bc = exp(2.5*(log(sigmag_amode(1))**2))
+ fac_volsfc_dust_a1 = exp(2.5*(log(sigmag_amode(2))**2))
+ fac_volsfc_dust_a3 = exp(2.5*(log(sigmag_amode(3))**2))
+
+ tmp1 = volumeCoat(num_bc_idx)*(r_bc*2._r8)*fac_volsfc_bc
+ tmp2 = max(6.0_r8*dr_so4_monolayers_dust*volumeCore(num_bc_idx), 0.0_r8) ! dr_so4_monolayers_dust = n_so4_monolayers_dust (=1) * 4.67e-10
+ dstcoat(1) = tmp1/tmp2
+
+ tmp1 = volumeCoat(num_dst1_idx)*(r_dust_a1*2._r8)*fac_volsfc_dust_a1
+ tmp2 = max(6.0_r8*dr_so4_monolayers_dust*volumeCore(num_dst1_idx), 0.0_r8) ! dr_so4_monolayers_dust = n_so4_monolayers_dust (=1) * 4.67e-10
+ dstcoat(2) = tmp1/tmp2
+
+ tmp1 = volumeCoat(num_dst3_idx)*(r_dust_a3*2._r8)*fac_volsfc_dust_a3
+ tmp2 = max(6.0_r8*dr_so4_monolayers_dust*volumeCore(num_dst3_idx), 0.0_r8) ! dr_so4_monolayers_dust = n_so4_monolayers_dust (=1) * 4.67e-10
+ dstcoat(3) = tmp1/tmp2
+
+ if (dstcoat(1) > 1._r8) dstcoat(1) = 1._r8
+ if (dstcoat(1) < 0.001_r8) dstcoat(1) = 0.001_r8
+ if (dstcoat(2) > 1._r8) dstcoat(2) = 1._r8
+ if (dstcoat(2) < 0.001_r8) dstcoat(2) = 0.001_r8
+ if (dstcoat(3) > 1._r8) dstcoat(3) = 1._r8
+ if (dstcoat(3) < 0.001_r8) dstcoat(3) = 0.001_r8
+
+!*****************************************************************************
+! prepare some variables for water activity
+!*****************************************************************************
+! cam ([kg/m3] added mass distributed to modes) from paramix_progncdnc.f90
+
+ ! accumulation mode for dust_a1
+ if (qaerpt(num_dst1_idx) > 0._r8) then
+ awcam(2) = cam(num_dst1_idx)*1.e9_r8 ! kg/m3 -> ug/m3
+ else
+ awcam(2) = 0._r8
+ end if
+ if (awcam(2) >0._r8) then
+ awfacm(2) = f_acm(num_dst1_idx)
+ else
+ awfacm(2) = 0._r8
+ end if
+
+ ! accumulation mode for dust_a3
+ if (qaerpt(num_dst3_idx) > 0._r8) then
+ awcam(3) = cam(num_dst3_idx)*1.e9_r8 ! kg/m3 -> ug/m3
+ else
+ awcam(3) = 0._r8
+ end if
+ if (awcam(3) >0._r8) then
+ awfacm(3) = f_acm(num_dst3_idx)
+ else
+ awfacm(3) = 0._r8
+ end if
+
+
+ ! accumulation mode for bc
+ if (qaerpt(num_bc_idx) > 0._r8) then
+ awcam(1) = cam(num_bc_idx)*1.e9_r8 ! kg/m3 -> ug/m3
+ else
+ awcam(1) = 0._r8
+ end if
+ if (awcam(1) >0._r8) then
+ awfacm(1) = f_acm(num_bc_idx)
+ else
+ awfacm(1) = 0._r8
+ end if
+
+
+!*****************************************************************************
+! prepare output
+!*****************************************************************************
+
+ total_interstial_aer_num(1) = bc_num
+ total_interstial_aer_num(2) = dst1_num
+ total_interstial_aer_num(3) = dst3_num
+
+ total_cloudborne_aer_num(1) = bc_num_imm
+ total_cloudborne_aer_num(2) = dst1_num_imm
+ total_cloudborne_aer_num(3) = dst3_num_imm
+
+ do i = 1, 3
+ total_aer_num(i) = total_interstial_aer_num(i)+total_cloudborne_aer_num(i)
+ coated_aer_num(i) = total_interstial_aer_num(i)*dstcoat(i)
+ uncoated_aer_num(i) = total_interstial_aer_num(i)*(1._r8-dstcoat(i))
+ end do
+
+
+ tot_na500 = total_aer_num(1)*0.0256_r8 & ! scaled for D>0.5 um using Clarke et al., 1997; 2004; 2007: rg=0.1um, sig=1.6
+!#ifdef MODAL_AERO
+!#if (defined MODAL_AERO_3MODE)
+ +total_aer_num(2)*0.488_r8 & ! scaled for D>0.5-1 um from 0.1-1 um
+!#elif (defined MODAL_AERO_7MODE)
+! +total_aer_num(2)*0.566_r8 & ! scaled for D>0.5-2 um from 0.1-2 um
+!#endif
+ +total_aer_num(3)
+!#endif
+
+ na500 = total_interstial_aer_num(1)*0.0256_r8 & ! scaled for D>0.5 um using Clarke et al., 1997; 2004; 2007: rg=0.1um, sig=1.6
+!#ifdef MODAL_AERO
+!#if (defined MODAL_AERO_3MODE)
+ +total_interstial_aer_num(2)*0.488_r8 & ! scaled for D>0.5-1 um from 0.1-1 um
+!#elif (defined MODAL_AERO_7MODE)
+! +total_interstial_aer_num(2)*0.566_r8 & ! scaled for D>0.5-2 um from 0.1-2 um
+!#endif
+ +total_interstial_aer_num(3)
+!#endif
+
+!-- wy4.0
+
+end subroutine get_aer_num
+
+!====================================================================================================
+
+end module hetfrz_classnuc_oslo
diff --git a/src/chemistry/oslo_aero/initlogn.F90 b/src/chemistry/oslo_aero/initlogn.F90
new file mode 100644
index 0000000000..0fff53e2fd
--- /dev/null
+++ b/src/chemistry/oslo_aero/initlogn.F90
@@ -0,0 +1,289 @@
+subroutine initlogn
+
+! Created for CAM3 by Trude Storelvmo, Fall 2007.
+! This subroutine reads the tabulated parameters for "best lognormal fits"
+! of the aerosol size distribution wrt CCN activation as calculated by Alf Kirkevaag.
+! Updated for new kcomp1.out including condensed SOA - Alf Kirkevaag, May 2013
+! Updated for reading inout files with extra header info - Alf Kirkevaag, May 2015,
+! and for new tables including SOA September 2015.
+! Modified for optimized added masses and mass fractions for concentrations from
+! condensation, coagulation or cloud-processing - Alf Kirkevaag, May 2016.
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use aerosoldef
+ use opttab, only: cat,fac,fbc,faq,cate
+ use const
+ use cam_logfile, only: iulog
+ use oslo_control, only: oslo_getopts,dir_string_length
+
+ implicit none
+
+ integer kcomp, ictot, ifac, ifbc, ifaq, irk, istdv
+ integer ic, ifil, lin
+ character(len=dir_string_length) :: aerotab_table_dir
+ real(r8) :: eps2 = 1.e-2_r8
+ real(r8) :: eps4 = 1.e-4_r8
+
+ write(iulog,*)'b4 nlog open ok'
+
+ !Where are the tables stored??
+ call oslo_getopts(aerotab_table_dir_out=aerotab_table_dir)
+
+ open(20,file=trim(aerotab_table_dir)//'/logntilp1.out' & ! SO4&SOA(n/Ait)
+ ,form='formatted',status='old')
+ open(21,file=trim(aerotab_table_dir)//'/logntilp2.out' & ! BC(n/Ait)
+ ,form='formatted',status='old')
+ open(22,file=trim(aerotab_table_dir)//'/logntilp3.out' & ! OC(n/Ait)
+ ,form='formatted',status='old')
+ open(23,file=trim(aerotab_table_dir)//'/logntilp4.out' & ! BC&OC(n/Ait)
+ ,form='formatted',status='old')
+ open(24,file=trim(aerotab_table_dir)//'/logntilp5.out' & ! SO4(Ait75)
+ ,form='formatted',status='old')
+ open(25,file=trim(aerotab_table_dir)//'/logntilp6.out' & ! MINACC
+ ,form='formatted',status='old')
+ open(26,file=trim(aerotab_table_dir)//'/logntilp7.out' & ! MINCOA
+ ,form='formatted',status='old')
+ open(27,file=trim(aerotab_table_dir)//'/logntilp8.out' & ! SEASF
+ ,form='formatted',status='old')
+ open(28,file=trim(aerotab_table_dir)//'/logntilp9.out' & ! SEASACC
+ ,form='formatted',status='old')
+ open(29,file=trim(aerotab_table_dir)//'/logntilp10.out' & ! SEASCOA
+ ,form='formatted',status='old')
+
+ write(iulog,*)'nlog open ok'
+
+! Skipping the header-text in all input files (Later: use it to check AeroTab - CAM5-Oslo consistency!)
+ do ifil = 20,29
+ call checkTableHeader (ifil)
+ enddo
+
+! ************************************************************************
+! Mode 1 (SO4&SOA + condesate from H2SO4 and SOA)
+! Modes 2 to 3 (BC/OC + condesate from H2SO4 and SOA)
+!
+! These two are treated the same way since there is no dependence on
+! fombg (SOA fraction in the background) for mode 1.
+! ************************************************************************
+
+! do ifil = 1,3
+ do ifil = 1,2
+ do lin = 1,96 ! 16*6 entries
+ read(19+ifil,993) kcomp, calog1to3(ifil,lin), fraclog1to3 (ifil, lin), &
+ rk1to3(ifil,lin), stdv1to3(ifil,lin)
+
+ do ic=1,16
+! if(calog1to3(ifil,lin).eq.cate(kcomp,ic)) then
+ if(abs((calog1to3(ifil,lin)-cate(kcomp,ic))/cate(kcomp,ic)) shr_kind_r8
+ use ppgrid, only: pcols
+ use const, only: sss1to3, rrr1to3
+ use opttab, only: cate, fac
+
+ implicit none
+
+ integer, intent(in) :: ncol
+ integer, intent(in) :: ind(pcols)
+ integer, intent(in) :: kcomp
+ real(r8), intent(in) :: Nnat(pcols) ! Modal number concentration
+ real(r8), intent(in) :: xctin(pcols) ! total internally mixed conc. (ug/m3)
+ real(r8), intent(in) :: xfacin(pcols) ! SOA/(SOA+H2SO4) for condensated mass
+ real(r8), intent(out) :: xstdv(pcols) ! log10 of standard deviation for lognormal fit
+ real(r8), intent(out) :: xrk(pcols) ! Modal radius for lognormal fit
+ real(r8), intent(out) :: cxs(pcols) ! excess (modal) internally mixed conc.
+
+ real(r8) camdiff
+ real(r8), dimension(pcols) :: xct
+ real(r8) xfac(ncol)
+ integer lon, long
+
+ integer i, ictot, ict1, ict2
+ real(r8) r1, r2, s1, s2
+ integer ifac, ifac1, ifac2
+ real(r8) t_fac1, t_fac2, t_xfac, t_xct, t_cat1, t_cat2
+ real(r8) r11, r12, r21, r22, s11, s12, s21, s22
+ real(r8) d2mx(2), dxm1(2), invd(2)
+
+ real(r8) esssf10, ess
+
+ real(r8), parameter :: eps= 1.0e-10_r8
+
+! Initialize excess mass cxs, wrt. maximum allowed internal mixing
+ do lon=1,ncol
+ cxs(lon) = 0.0_r8
+ xct(lon) = 0.0_r8
+ xfac(lon) = 0.0_r8
+ enddo
+
+ do long=1,ncol
+ lon=ind(long)
+ xstdv(lon) = 0._r8
+ xrk(lon) = 0._r8
+
+ xct(lon) = min(max(xctin(lon)/(Nnat(lon)+eps),cate(kcomp,1)),cate(kcomp,16))
+ xfac(lon) = min(max(xfacin(lon),fac(1)),fac(6))
+ camdiff = xctin(lon)-xct(lon)*(Nnat(lon)+eps)
+
+ cxs(lon) = max(0.0_r8,camdiff)
+
+ ictot=1
+ ess = xct(lon)
+ do while (ictot.lt.15.and.(ess.lt.cate(kcomp,ictot).or. &
+ ess.gt.cate(kcomp,ictot+1)))
+ ictot=ictot+1
+ enddo
+ ict1=ictot
+ ict2=ictot+1
+
+ ifac=1
+ ess = xfac(lon)
+ do while (ifac.lt.5.and.(ess.lt.fac(ifac).or. &
+ ess.gt.fac(ifac+1)))
+ ifac=ifac+1
+ enddo
+ ifac1=ifac
+ ifac2=ifac+1
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+
+ t_cat1 = cate(kcomp,ict1)
+ t_cat2 = cate(kcomp,ict2)
+ t_fac1 = fac(ifac1)
+ t_fac2 = fac(ifac2)
+
+ t_xct = xct(lon)
+ t_xfac = xfac(lon)
+
+! partial lengths along each dimension (1-2) for interpolation
+
+ d2mx(1) = (t_cat2-t_xct)
+ dxm1(1) = (t_xct-t_cat1)
+ invd(1) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(2) = (t_fac2-t_xfac)
+ dxm1(2) = (t_xfac-t_fac1)
+ invd(2) = 1.0_r8/(t_fac2-t_fac1)
+
+! interpolated (in 2 dimensions) modal median radius:
+
+ r11=rrr1to3(kcomp,ict1,ifac1)
+ r12=rrr1to3(kcomp,ict1,ifac2)
+ r21=rrr1to3(kcomp,ict2,ifac1)
+ r22=rrr1to3(kcomp,ict2,ifac2)
+
+ r1 =d2mx(2)*r11+dxm1(2)*r12
+ r2 =d2mx(2)*r21+dxm1(2)*r22
+
+ xrk(lon) = (d2mx(1)*r1+dxm1(1)*r2)*invd(2)*invd(1)*1.e-6_r8 !Look-up table radii in um
+
+! interpolated (in 2 dimensions) modal standard deviation:
+
+ s11=sss1to3(kcomp,ict1,ifac1)
+ s12=sss1to3(kcomp,ict1,ifac2)
+ s21=sss1to3(kcomp,ict2,ifac1)
+ s22=sss1to3(kcomp,ict2,ifac2)
+
+ s1 =d2mx(2)*s11+dxm1(2)*s12
+ s2 =d2mx(2)*s21+dxm1(2)*s22
+
+ xstdv(lon) = (d2mx(1)*s1+dxm1(1)*s2)*invd(2)*invd(1)
+
+
+ end do ! lon
+
+ return
+ end subroutine intlog1to3_sub
+
+end module intlog1to3
+
diff --git a/src/chemistry/oslo_aero/intlog4.F90 b/src/chemistry/oslo_aero/intlog4.F90
new file mode 100644
index 0000000000..0c8466e86d
--- /dev/null
+++ b/src/chemistry/oslo_aero/intlog4.F90
@@ -0,0 +1,171 @@
+module intlog4
+
+contains
+ subroutine intlog4_sub (ncol, ind, kcomp, xctin, Nnat, &
+ xfacin, xfaqin, cxs, xstdv, xrk)
+
+! Created by Trude Storelvmo, fall 2007. This subroutine gives as output
+! the "new" modal radius and standard deviation for aerosol mode kcomp=4.
+! These parameters are calculated for a best lognormal fit approximation of
+! the aerosol size distribution. This because the aerosol activation routine
+! (developed by Abdul-Razzak & Ghan, 2000) requires the size distribution
+! to be described by lognormal modes.
+! Changed by Alf Kirkevåg to take into account condensation of SOA, September
+! 2015, and also rewritten to a more generalized for for interpolations using
+! common subroutines interpol*dim.
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use ppgrid, only: pcols
+ use const, only: sss4, rrr4
+ use opttab, only: nbmp1, cate, fac, faq
+ implicit none
+
+ integer, intent(in) :: ncol
+ integer, intent(in) :: ind(pcols)
+ integer, intent(in) :: kcomp
+ real(r8), intent(in) :: Nnat(pcols) ! Modal number concentration
+ real(r8), intent(in) :: xctin(pcols) ! total internally mixed conc. (ug/m3)
+ real(r8), intent(in) :: xfacin(pcols) ! SOA/(SOA+H2SO4) for condensated mass
+ real(r8), intent(in) :: xfaqin(pcols) ! = Cso4a2/(Cso4a1+Cso4a2)
+ real(r8), intent(out) :: xstdv(pcols) ! log10 of standard deviation for lognormal fit
+ real(r8), intent(out) :: xrk(pcols) ! Modal radius for lognormal fit
+ real(r8), intent(out) :: cxs(pcols) ! excess (modal) internally mixed conc.
+
+ real(r8) camdiff
+ real(r8), dimension(pcols) :: xct, xfac, xfaq
+!ces: integer arrays ict1, ict2, ifaq1 and ifaq2
+! substituted with scalar variables with the same name.
+
+ integer lon, long
+
+ integer i, ictot, ifac, ifaq, &
+ ict1, ict2, ifac1, ifac2, ifaq1, ifaq2
+
+ real(r8) t_fac1, t_fac2, t_xfac, t_xct, t_cat1, t_cat2, &
+ t_faq1, t_faq2, t_xfaq
+ real(r8) r1, r2, s1, s2, tmp, e
+ real(r8) d2mx(3), dxm1(3), invd(3)
+ real(r8) sizepar3d(2,2,2)
+
+!ces: New local variables introduced by (or inspired by) Egil Stoeren:
+
+ real(r8), parameter :: eps=1.0e-60_r8
+
+! Initialize excess mass cxs, wrt. maximum allowed internal mixing
+ do lon=1,ncol
+ cxs(lon) = 0.0_r8
+ xct(lon) = 0.0_r8
+ xfac(lon) = 0.0_r8
+ xfaq(lon) = 0.0_r8
+ enddo
+
+!ces: All loops "do long=1,nlons" combined to one loop:
+
+! do lon=1,ncol
+ do long=1,ncol
+ lon=ind(long)
+ xstdv(lon) = 0._r8
+ xrk(lon) = 0._r8
+
+ xct(lon) = min(max(xctin(lon)/(Nnat(lon)+eps),cate(kcomp,1)),cate(kcomp,16))
+ xfac(lon) = min(max(xfacin(lon),fac(1)),fac(6))
+ xfaq(lon) = min(max(xfaqin(lon),faq(1)),faq(6))
+
+ camdiff = xctin(lon)-xct(lon)*(Nnat(lon)+eps)
+
+ cxs(lon) = max(0.0_r8,camdiff)
+
+ ictot=1
+ tmp = xct(lon)
+ do while (ictot.lt.15.and.(tmp.lt.cate(kcomp,ictot).or. &
+ tmp.gt.cate(kcomp,ictot+1)))
+ ictot=ictot+1
+ enddo
+ ict1=ictot
+ ict2=ictot+1
+
+ ifac=1
+ tmp = xfac(lon)
+ do while (ifac.lt.5.and.(tmp.lt.fac(ifac).or. &
+ tmp.gt.fac(ifac+1)))
+ ifac=ifac+1
+ enddo
+ ifac1=ifac
+ ifac2=ifac+1
+
+ ifaq=1
+ tmp = xfaq(lon)
+ do while (ifaq.lt.5.and.(tmp.lt.faq(ifaq) &
+ .or.tmp.gt.faq(ifaq+1)))
+ ifaq=ifaq+1
+ enddo
+ ifaq1=ifaq
+ ifaq2=ifaq+1
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+ t_cat1 = cate(kcomp,ict1)
+ t_cat2 = cate(kcomp,ict2)
+ t_fac1 = fac(ifac1)
+ t_fac2 = fac(ifac2)
+ t_faq1 = faq(ifaq1)
+ t_faq2 = faq(ifaq2)
+
+ t_xct = xct(lon)
+ t_xfac = xfac(lon)
+ t_xfaq = xfaq(lon)
+
+! partial lengths along each dimension (1-4) for interpolation
+ d2mx(1) = (t_cat2-t_xct)
+ dxm1(1) = (t_xct-t_cat1)
+ invd(1) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(2) = (t_fac2-t_xfac)
+ dxm1(2) = (t_xfac-t_fac1)
+ invd(2) = 1.0_r8/(t_fac2-t_fac1)
+ d2mx(3) = (t_faq2-t_xfaq)
+ dxm1(3) = (t_xfaq-t_faq1)
+ invd(3) = 1.0_r8/(t_faq2-t_faq1)
+
+! Table points as basis for multidimentional linear interpolation,
+! modal median radius:
+
+ sizepar3d(1,1,1)=rrr4(ict1,ifac1,ifaq1)
+ sizepar3d(1,1,2)=rrr4(ict1,ifac1,ifaq2)
+ sizepar3d(1,2,1)=rrr4(ict1,ifac2,ifaq1)
+ sizepar3d(1,2,2)=rrr4(ict1,ifac2,ifaq2)
+ sizepar3d(2,1,1)=rrr4(ict2,ifac1,ifaq1)
+ sizepar3d(2,1,2)=rrr4(ict2,ifac1,ifaq2)
+ sizepar3d(2,2,1)=rrr4(ict2,ifac2,ifaq1)
+ sizepar3d(2,2,2)=rrr4(ict2,ifac2,ifaq2)
+
+! interpolation in the faq and fac dimension
+ call lininterpol3dim (d2mx, dxm1, invd, sizepar3d, r1, r2)
+
+! finally, interpolation in the cate dimension
+ xrk(lon)=(d2mx(1)*r1+dxm1(1)*r2)*invd(1)*1.e-6_r8 ! look up table radii in um
+
+
+! Table points as basis for multidimentional linear interpolation,
+! modal standard deviation:
+ sizepar3d(1,1,1)=sss4(ict1,ifac1,ifaq1)
+ sizepar3d(1,1,2)=sss4(ict1,ifac1,ifaq2)
+ sizepar3d(1,2,1)=sss4(ict1,ifac2,ifaq1)
+ sizepar3d(1,2,2)=sss4(ict1,ifac2,ifaq2)
+ sizepar3d(2,1,1)=sss4(ict2,ifac1,ifaq1)
+ sizepar3d(2,1,2)=sss4(ict2,ifac1,ifaq2)
+ sizepar3d(2,2,1)=sss4(ict2,ifac2,ifaq1)
+ sizepar3d(2,2,2)=sss4(ict2,ifac2,ifaq2)
+
+! interpolation in the faq and fac dimension
+ call lininterpol3dim (d2mx, dxm1, invd, sizepar3d, s1, s2)
+
+! finally, interpolation in the cate dimension
+ xstdv(lon)=(d2mx(1)*s1+dxm1(1)*s2)*invd(1)
+
+ end do ! lon
+
+ return
+end subroutine intlog4_sub
+
+end module intlog4
+
diff --git a/src/chemistry/oslo_aero/intlog5to10.F90 b/src/chemistry/oslo_aero/intlog5to10.F90
new file mode 100644
index 0000000000..4c32b525d1
--- /dev/null
+++ b/src/chemistry/oslo_aero/intlog5to10.F90
@@ -0,0 +1,203 @@
+module intlog5to10
+
+contains
+
+ subroutine intlog5to10_sub (ncol, ind, kcomp, xctin, Nnat, &
+ xfacin, xfbcin, xfaqin, cxs, xstdv, xrk)
+
+!Created by Trude Storelvmo, fall 2007, based on method of A. Kirkevag.
+!This subroutine gives as output the "new" modal radius and standard deviation
+!for a given aerosol mode, kcomp 1-5. These parameters are calculated for a
+!best lognormal fit approximation of the aerosol size distribution.
+!This because the aerosol activation routine (developed by Abdul-Razzak & Ghan,
+!2000) requires the size distribution to be described by lognormal modes.
+!Rewritten by Alf Kirkevaag September 2015 to a more generalized for for
+!interpolations using common subroutines interpol*dim.
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use ppgrid, only : pcols
+ use commondefinitions, only: nmodes, nbmodes
+ use const, only : sss, rrr
+ use opttab, only: cat, fbc, fac, faq
+
+ implicit none
+
+ integer, intent(in) :: ncol
+ integer, intent(in) :: ind(pcols)
+ integer, intent(in) :: kcomp
+ real(r8), intent(in) :: Nnat(pcols) ! Modal number concentration
+ real(r8), intent(in) :: xctin(pcols) ! total internally mixed conc. (ug/m3)
+ real(r8), intent(in) :: xfacin(pcols) ! = (Cbc+Coc)/(Cbc+Coc+Cso4)
+ real(r8), intent(in) :: xfbcin(pcols) ! = Cbc/(Cbc+Coc)
+ real(r8), intent(in) :: xfaqin(pcols) ! = Cso4a2/(Cso4a1+Cso4a2)
+ real(r8), intent(out) :: xstdv(pcols) ! log10 of standard deviation of lognormal fit
+ real(r8), intent(out) :: xrk(pcols) ! Modal radius of lognormal fit
+ real(r8), intent(out) :: cxs(pcols) ! excess (modal) internally mixed conc.
+
+ real(r8) xctsave, camdiff
+ real(r8), dimension(pcols) :: xct, xfac, xfbc, xfaq
+
+ integer lon, long
+
+ integer i, ictot, ifac, ifbc, ifaq, &
+ ict1, ict2, ifac1, ifac2, &
+ ifbc1, ifbc2, ifaq1, ifaq2
+
+ real(r8) t_fac1, t_fac2, t_xfac, t_xct, t_cat1, t_cat2, &
+ t_faq1, t_faq2, t_xfaq, t_fbc1, t_fbc2, t_xfbc
+ real(r8) r1, r2, s1, s2, tmp, e
+ real(r8) d2mx(4), dxm1(4), invd(4)
+ real(r8) sizepar4d(2,2,2,2)
+
+ real(r8), parameter :: eps=1.0e-10_r8
+
+! Initialize excess mass cxs, wrt. maximum allowed internal mixing
+ do lon=1,ncol
+ cxs(lon) = 0.0_r8
+ xct(lon) = 0.0_r8
+ xfac(lon) = 0.0_r8
+ xfbc(lon) = 0.0_r8
+ xfaq(lon) = 0.0_r8
+ enddo
+
+!ces: All loops "do long=1,nlons" combined to one loop:
+
+! do lon=1,ncol
+ do long=1,ncol
+ lon=ind(long)
+ xstdv(lon) = 0._r8
+ xrk(lon) = 0._r8
+
+ xct(lon) = min(max(xctin(lon)/(Nnat(lon)+eps),cat(kcomp,1)),cat(kcomp,6))
+ xfac(lon) = min(max(xfacin(lon),fac(1)),fac(6))
+ xfbc(lon) = min(max(xfbcin(lon),fbc(1)),fbc(6))
+ xfaq(lon) = min(max(xfaqin(lon),faq(1)),faq(6))
+
+ camdiff = xctin(lon)-xct(lon)*(Nnat(lon)+eps)
+
+ cxs(lon) = max(0.0_r8,camdiff)
+
+ ictot=1
+ tmp = xct(lon)
+ do while (ictot.lt.5.and.(tmp.lt.cat(kcomp,ictot).or. &
+ tmp.gt.cat(kcomp,ictot+1)))
+ ictot=ictot+1
+ enddo
+ ict1=ictot
+ ict2=ictot+1
+
+ ifac=1
+ tmp = xfac(lon)
+ do while (ifac.lt.5.and.(tmp.lt.fac(ifac).or. &
+ tmp.gt.fac(ifac+1)))
+ ifac=ifac+1
+ enddo
+ ifac1=ifac
+ ifac2=ifac+1
+
+ ifbc=1
+ tmp = xfbc(lon)
+ do while (ifbc.lt.5.and.(tmp.lt.fbc(ifbc).or. &
+ tmp.gt.fbc(ifbc+1)))
+ ifbc=ifbc+1
+ enddo
+ ifbc1=ifbc
+ ifbc2=ifbc+1
+
+ ifaq=1
+ tmp = xfaq(lon)
+ do while (ifaq.lt.5.and.(tmp.lt.faq(ifaq) &
+ .or.tmp.gt.faq(ifaq+1)))
+ ifaq=ifaq+1
+ enddo
+ ifaq1=ifaq
+ ifaq2=ifaq+1
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+ t_cat1 = cat(kcomp,ict1)
+ t_cat2 = cat(kcomp,ict2)
+ t_fac1 = fac(ifac1)
+ t_fac2 = fac(ifac2)
+ t_fbc1 = fbc(ifbc1)
+ t_fbc2 = fbc(ifbc2)
+ t_faq1 = faq(ifaq1)
+ t_faq2 = faq(ifaq2)
+
+ t_xct = xct(lon)
+ t_xfac = xfac(lon)
+ t_xfbc = xfbc(lon)
+ t_xfaq = xfaq(lon)
+
+! partial lengths along each dimension (1-4) for interpolation
+ d2mx(1) = (t_cat2-t_xct)
+ dxm1(1) = (t_xct-t_cat1)
+ invd(1) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(2) = (t_fac2-t_xfac)
+ dxm1(2) = (t_xfac-t_fac1)
+ invd(2) = 1.0_r8/(t_fac2-t_fac1)
+ d2mx(3) = (t_fbc2-t_xfbc)
+ dxm1(3) = (t_xfbc-t_fbc1)
+ invd(3) = 1.0_r8/(t_fbc2-t_fbc1)
+ d2mx(4) = (t_faq2-t_xfaq)
+ dxm1(4) = (t_xfaq-t_faq1)
+ invd(4) = 1.0_r8/(t_faq2-t_faq1)
+
+! Table points as basis for multidimentional linear interpolation,
+! modal median radius:
+
+ sizepar4d(1,1,1,1)=rrr(kcomp,ict1,ifac1,ifbc1,ifaq1)
+ sizepar4d(1,1,1,2)=rrr(kcomp,ict1,ifac1,ifbc1,ifaq2)
+ sizepar4d(1,1,2,1)=rrr(kcomp,ict1,ifac1,ifbc2,ifaq1)
+ sizepar4d(1,1,2,2)=rrr(kcomp,ict1,ifac1,ifbc2,ifaq2)
+ sizepar4d(1,2,1,1)=rrr(kcomp,ict1,ifac2,ifbc1,ifaq1)
+ sizepar4d(1,2,1,2)=rrr(kcomp,ict1,ifac2,ifbc1,ifaq2)
+ sizepar4d(1,2,2,1)=rrr(kcomp,ict1,ifac2,ifbc2,ifaq1)
+ sizepar4d(1,2,2,2)=rrr(kcomp,ict1,ifac2,ifbc2,ifaq2)
+ sizepar4d(2,1,1,1)=rrr(kcomp,ict2,ifac1,ifbc1,ifaq1)
+ sizepar4d(2,1,1,2)=rrr(kcomp,ict2,ifac1,ifbc1,ifaq2)
+ sizepar4d(2,1,2,1)=rrr(kcomp,ict2,ifac1,ifbc2,ifaq1)
+ sizepar4d(2,1,2,2)=rrr(kcomp,ict2,ifac1,ifbc2,ifaq2)
+ sizepar4d(2,2,1,1)=rrr(kcomp,ict2,ifac2,ifbc1,ifaq1)
+ sizepar4d(2,2,1,2)=rrr(kcomp,ict2,ifac2,ifbc1,ifaq2)
+ sizepar4d(2,2,2,1)=rrr(kcomp,ict2,ifac2,ifbc2,ifaq1)
+ sizepar4d(2,2,2,2)=rrr(kcomp,ict2,ifac2,ifbc2,ifaq2)
+
+! interpolation in the faq, fbc, fac and cat dimensions
+ call lininterpol4dim (d2mx, dxm1, invd, sizepar4d, r1, r2)
+
+! finally, interpolation in the cat dimension
+ xrk(lon)=(d2mx(1)*r1+dxm1(1)*r2)*invd(1)*1.e-6_r8 ! look-up table radii in um
+
+! Table points as basis for multidimentional linear interpolation,
+! modal standard deviation:
+
+ sizepar4d(1,1,1,1)=sss(kcomp,ict1,ifac1,ifbc1,ifaq1)
+ sizepar4d(1,1,1,2)=sss(kcomp,ict1,ifac1,ifbc1,ifaq2)
+ sizepar4d(1,1,2,1)=sss(kcomp,ict1,ifac1,ifbc2,ifaq1)
+ sizepar4d(1,1,2,2)=sss(kcomp,ict1,ifac1,ifbc2,ifaq2)
+ sizepar4d(1,2,1,1)=sss(kcomp,ict1,ifac2,ifbc1,ifaq1)
+ sizepar4d(1,2,1,2)=sss(kcomp,ict1,ifac2,ifbc1,ifaq2)
+ sizepar4d(1,2,2,1)=sss(kcomp,ict1,ifac2,ifbc2,ifaq1)
+ sizepar4d(1,2,2,2)=sss(kcomp,ict1,ifac2,ifbc2,ifaq2)
+ sizepar4d(2,1,1,1)=sss(kcomp,ict2,ifac1,ifbc1,ifaq1)
+ sizepar4d(2,1,1,2)=sss(kcomp,ict2,ifac1,ifbc1,ifaq2)
+ sizepar4d(2,1,2,1)=sss(kcomp,ict2,ifac1,ifbc2,ifaq1)
+ sizepar4d(2,1,2,2)=sss(kcomp,ict2,ifac1,ifbc2,ifaq2)
+ sizepar4d(2,2,1,1)=sss(kcomp,ict2,ifac2,ifbc1,ifaq1)
+ sizepar4d(2,2,1,2)=sss(kcomp,ict2,ifac2,ifbc1,ifaq2)
+ sizepar4d(2,2,2,1)=sss(kcomp,ict2,ifac2,ifbc2,ifaq1)
+ sizepar4d(2,2,2,2)=sss(kcomp,ict2,ifac2,ifbc2,ifaq2)
+
+! interpolation in the faq, fbc, fac and cat dimensions
+ call lininterpol4dim (d2mx, dxm1, invd, sizepar4d, s1, s2)
+
+! finally, interpolation in the cat dimension
+ xstdv(lon)=(d2mx(1)*s1+dxm1(1)*s2)*invd(1)
+
+ end do ! lon
+ return
+end subroutine intlog5to10_sub
+
+end module intlog5to10
+
diff --git a/src/chemistry/oslo_aero/koagsub.F90 b/src/chemistry/oslo_aero/koagsub.F90
new file mode 100644
index 0000000000..a183a4647e
--- /dev/null
+++ b/src/chemistry/oslo_aero/koagsub.F90
@@ -0,0 +1,821 @@
+module koagsub
+
+ use phys_control, only: phys_getopts
+ use aerosoldef
+ use chem_mods, only: gas_pcnst
+ use mo_tracname, only: solsym
+ use const
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use physconst, only: rair, gravit
+ use cam_logfile, only : iulog
+ save
+
+ real(r8), parameter :: kboltzmann = 1.3806488e-23_r8 ![m2 kg s-2 K-1]
+ real(r8), parameter :: temperatureLookupTables = 293.15_r8 !Temperature used in look up tables
+ real(r8), parameter :: mfpAir = 63.3e-9_r8 ![m] mean free path air
+ real(r8), parameter :: viscosityAir = 1.983e-5_r8 ![Pa s] viscosity of air
+
+ real(r8), parameter :: rhoh2o = 1000._r8 ! Density of water
+
+ integer, parameter :: numberOfCoagulatingModes = 6
+ integer, parameter :: numberOfCoagulationReceivers = 6
+
+ real(r8), dimension(0:nmodes,0:nmodes) :: normalizedCoagulationSink ![m3/#/s]
+ real(r8), dimension(0:nmodes) :: NCloudCoagulationSink ![m3/#/s]
+
+!nuctst3+
+ real(r8) normCoagSinkMode1 ![m3/#/s]
+!nuctst3-
+!aktest+
+ integer, parameter :: numberOfAddCoagReceivers = 6
+ real(r8), dimension(numberOfAddCoagReceivers) :: normCoagSinkAdd ![m3/#/s]
+!aktest-
+
+ !These are the modes which are coagulating (belonging to mixtures no. 0, 1, 2, 4, 12, 14)
+ integer, dimension(numberOfCoagulatingModes) :: coagulatingMode = &
+ (/MODE_IDX_BC_EXT_AC & !inert mode
+ , MODE_IDX_SO4SOA_AIT, MODE_IDX_BC_AIT, MODE_IDX_OMBC_INTMIX_COAT_AIT & !internally mixed small modes
+ , MODE_IDX_BC_NUC, MODE_IDX_OMBC_INTMIX_AIT /) !externally mixed small modes
+
+ !These are the modes which are receiving coagulating material in OsloAero
+ ! (belonging to mixtures no. 5, 6, 7, 8, 9, 10)
+ integer, dimension(numberOfCoagulationReceivers) :: receiverMode = &
+ (/MODE_IDX_SO4_AC,MODE_IDX_DST_A2, MODE_IDX_DST_A3, MODE_IDX_SS_A1, MODE_IDX_SS_A2, MODE_IDX_SS_A3 /)
+
+!aktest+
+ !And these are the additional modes which are allowed to contribute to the
+ ! coagulation sink, defined here and to be used only in the nucleation code in condtend.F90
+ ! (belonging to mixtures no. 0, 1, 2, 4, 12, 14)
+ integer, dimension(numberOfAddCoagReceivers) :: addReceiverMode = &
+ (/MODE_IDX_BC_EXT_AC,MODE_IDX_SO4SOA_AIT,MODE_IDX_BC_AIT, &
+ MODE_IDX_OMBC_INTMIX_COAT_AIT,MODE_IDX_BC_NUC,MODE_IDX_OMBC_INTMIX_AIT /)
+!aktest-
+
+ !Coagulation moves aerosol mass to the "coagulate" species, so some
+ !lifecycle species will receive mass in this routine!
+ integer, dimension(gas_pcnst) :: lifeCycleReceiver
+
+ ! Coagulation between aerosol and cloud droplets move coagulate into
+ ! the equivalent value for aerosol concentration in cloud water.
+ ! Exception: Sulphate coagulation with cloud droplets is merged with
+ ! component from aqueous phase chemistry in order to take advantage of the
+ ! more detailed addition onto larger particles.
+
+ integer, dimension(gas_pcnst) :: CloudAerReceiver
+
+! Closest Table index for assumed size of droplets used in coagulation
+ integer :: tableindexcloud
+ real(r8),parameter :: rcoagdroplet = 10.e-6 ! m
+
+
+contains
+
+subroutine initializeCoagulationOutput()
+
+ use ppgrid, only: pver
+ use cam_history, only: addfld, add_default, fieldname_len, horiz_only
+ implicit none
+ integer :: imode
+ integer :: iChem
+ integer :: modeIndexCoagulator
+
+ character(len=fieldname_len+3) :: fieldname_receiver
+ character(len=fieldname_len+3) :: fieldname_donor
+ character(8) :: unit
+ logical :: history_aerosol
+ logical, dimension(gas_pcnst) :: isAlreadyOnList
+
+ call phys_getopts(history_aerosol_out = history_aerosol)
+
+ isAlreadyOnList(:) = .FALSE.
+ do iChem = 1,gas_pcnst
+ !Does this tracer have a receiver? If yes: It contributes to coagulation
+ if(lifeCycleReceiver(iChem) .gt. 0)then
+ unit = "kg/m2/s"
+ fieldname_donor = trim(solsym(iChem))//"coagTend"
+ fieldname_receiver = trim(solsym(lifeCycleReceiver(iChem)))//"coagTend"
+ if(.not. isAlreadyOnList(lifeCycleReceiver(iChem)))then
+ call addfld( fieldname_receiver, horiz_only ,"A", unit, "coagulation tendency")
+ isAlreadyOnList(lifeCycleReceiver(iChem))=.TRUE.
+ end if
+ call addfld( fieldname_donor, horiz_only, 'A', unit, "coagulation tendency" )
+ if(history_aerosol)then
+ call add_default( fieldname_receiver, 1, ' ' )
+ call add_default( fieldname_donor , 1, ' ')
+ end if
+ end if
+ end do
+
+ isAlreadyOnList(:) = .FALSE.
+ do iChem = 1,gas_pcnst
+ if(CloudAerReceiver(iChem) .gt. 0)then
+ unit = "kg/m2/s"
+ fieldname_donor = trim(solsym(iChem))//"clcoagTend"
+ fieldname_receiver = trim(solsym(CloudAerReceiver(iChem)))//"_OCWclcoagTend"
+ if(.not. isAlreadyOnList(CloudAerReceiver(iChem)))then
+ call addfld( fieldname_receiver, horiz_only, 'A', unit, "coagulation tendency" )
+ isAlreadyOnList(CloudAerReceiver(iChem))=.TRUE.
+ end if
+ call addfld( fieldname_donor, horiz_only, "A", unit, "coagulation tendency" )
+ if(history_aerosol)then
+ call add_default( fieldname_receiver, 1, ' ' )
+ call add_default( fieldname_donor , 1, ' ')
+ end if
+ end if
+
+ end do
+
+end subroutine initializeCoagulationOutput
+
+subroutine initializeCoagulationReceivers()
+ implicit none
+
+ !These are the lifecycle-species receiving coagulate
+ lifeCycleReceiver(:) = -99
+ lifeCycleReceiver(chemistryIndex(l_bc_ax)) = chemistryIndex(l_bc_ac)
+ lifeCycleReceiver(chemistryIndex(l_so4_na)) = chemistryIndex(l_so4_ac) !create so4 coagulate from so4 in mode 1
+ lifeCycleReceiver(chemistryIndex(l_bc_a)) = chemistryIndex(l_bc_ac) !create bc coagulate from bc in mode 2
+ lifeCycleReceiver(chemistryIndex(l_bc_ai)) = chemistryIndex(l_bc_ac) !create bc coagulate from bc in mode 4
+ lifeCycleReceiver(chemistryIndex(l_om_ai)) = chemistryIndex(l_om_ac) !create om coagulate from om in mode 4
+ lifeCycleReceiver(chemistryIndex(l_bc_n)) = chemistryIndex(l_bc_ac) !create bc coagulate from bc in mode 12
+ lifeCycleReceiver(chemistryIndex(l_bc_ni)) = chemistryIndex(l_bc_ac) !create bc coagulate from om in mode 14
+ lifeCycleReceiver(chemistryIndex(l_om_ni)) = chemistryIndex(l_om_ac) !create om coagulate from om in mode 14
+ lifeCycleReceiver(chemistryIndex(l_so4_a1)) = chemistryIndex(l_so4_ac) !Create so4 coagulate from so4 condensate
+ lifeCycleReceiver(chemistryINdex(l_soa_na)) = chemistryIndex(l_soa_a1)
+
+ !These are the lifecycle-species receiving coagulate
+ CloudAerReceiver(:) = -99
+ CloudAerReceiver(chemistryIndex(l_bc_ax)) = chemistryIndex(l_bc_ac)
+ CloudAerReceiver(chemistryIndex(l_so4_na)) = chemistryIndex(l_so4_a2) !create so4 coagulate from so4 in mode 1
+ CloudAerReceiver(chemistryIndex(l_bc_a)) = chemistryIndex(l_bc_ac) !create bc coagulate from bc in mode 2
+ CloudAerReceiver(chemistryIndex(l_bc_ai)) = chemistryIndex(l_bc_ac) !create bc coagulate from bc in mode 4
+ CloudAerReceiver(chemistryIndex(l_om_ai)) = chemistryIndex(l_om_ac) !create om coagulate from om in mode 4
+ CloudAerReceiver(chemistryIndex(l_bc_n)) = chemistryIndex(l_bc_ac) !create bc coagulate from bc in mode 12
+ CloudAerReceiver(chemistryIndex(l_bc_ni)) = chemistryIndex(l_bc_ac) !create bc coagulate from om in mode 14
+ CloudAerReceiver(chemistryIndex(l_om_ni)) = chemistryIndex(l_om_ac) !create om coagulate from om in mode 14
+ CloudAerReceiver(chemistryIndex(l_so4_a1)) = chemistryIndex(l_so4_a2) !Create so4 coagulate from so4 condensate
+ cloudAerReceiver(chemistryIndex(l_soa_na)) = chemistryIndex(l_soa_a1)
+
+
+end subroutine initializeCoagulationReceivers
+
+subroutine initializeCoagulationCoefficients(rhob,rk)
+
+ use mo_constants, only: pi
+ use const, only: normnk
+
+ implicit none
+
+ real(r8), intent(in) :: rk(0:nmodes) ![unit] radius of background (receiver) mode
+ real(r8), intent(in) :: rhob(0:nmodes) !density of background mode
+
+ real(r8), dimension(numberOfCoagulationReceivers, numberOfCoagulatingModes, nBinsTab) :: K12 = 0.0_r8 !Coagulation coefficient (m3/s)
+
+!nuctst3+
+! real(r8), dimension(nBinsTab) :: CoagCoeffMode1 = 0.0_r8 !Coagulation coefficient mode 1 with 1 (m3/s)
+!nuctst3-
+!ak+
+ real(r8), dimension(numberOfAddCoagReceivers,nBinsTab) :: CoagCoeffModeAdd = 0.0_r8 !Coagulation coefficient mode 1 (m3/s)
+!ak-
+
+ real(r8), dimension(numberOfCoagulatingModes,nBinsTab) :: K12Cl = 0.0_r8 !Coagulation coefficient (m3/s)
+
+ real(r8), dimension(nBinsTab) :: coagulationCoefficient
+ integer :: aMode
+ integer :: modeIndex
+ integer :: modeIndexCoagulator !Index of coagulating mode
+ integer :: modeIndexReceiver !Index of receiving mode
+ integer :: iCoagulatingMode !Counter for coagulating mode
+ integer :: iReceiverMode !Counter for receiver modes
+ integer :: nsiz !counter for look up table sizes
+
+ do iReceiverMode = 1, numberOfCoagulationReceivers
+ do iCoagulatingMode = 1,numberOfCoagulatingModes
+
+ !Index of the coagulating mode (0-14), see list above
+ modeIndexCoagulator = coagulatingMode(iCoagulatingMode)
+
+ !Index of receiver mode (0-14), see list above
+ modeIndexReceiver = receiverMode(iReceiverMode)
+
+ !Pre-calculate coagulation coefficients for this coagulator..
+ !Note: Not using actual density of coagulator here
+ !Since this is not known at init-time
+ call calculateCoagulationCoefficient(CoagulationCoefficient & !O [m3/s] coagulation coefficient
+ , rk(modeIndexCoagulator) & !I [m] radius of coagulator
+ , rhob(modeIndexCoagulator) & !I [kg/m3] density of coagulator
+ , rhob(modeIndexReceiver) ) !IÂ [kg/m3] density of receiver
+
+ !Save values
+ K12(iReceiverMode,iCoagulatingMode,:) = CoagulationCoefficient(:)
+
+ enddo
+ end do !receiver modes
+
+!nuctst3+
+! call calculateCoagulationCoefficient(CoagulationCoefficient & !O [m3/s] coagulation coefficient
+! , rk(1) & !I [m] radius of coagulator
+! , rhob(1) & !I [kg/m3] density of coagulator
+! , rhob(1) ) !IÂ [kg/m3] density of receiver
+! CoagCoeffMode1(:) = CoagulationCoefficient(:)
+!nuctst3-
+!ak+
+ do iReceiverMode = 1, numberOfAddCoagReceivers
+ iCoagulatingMode = 1
+
+ !Index of the coagulating mode (0-14), see list above
+ modeIndexCoagulator = coagulatingMode(iCoagulatingMode)
+
+ !Index of receiver mode (0-14), see list above
+ modeIndexReceiver = addReceiverMode(iReceiverMode)
+
+ !Pre-calculate coagulation coefficients for this coagulator..
+ !Note: Not using actual density of coagulator here
+ !Since this is not known at init-time
+ call calculateCoagulationCoefficient(CoagulationCoefficient & !O [m3/s] coagulation coefficient
+ , rk(modeIndexCoagulator) & !I [m] radius of coagulator
+ , rhob(modeIndexCoagulator) & !I [kg/m3] density of coagulator
+ , rhob(modeIndexReceiver) ) !IÂ [kg/m3] density of receiver
+
+ !Save values
+ CoagCoeffModeAdd(iReceiverMode,:) = CoagulationCoefficient(:)
+
+ end do !receiver modes
+!ak-
+
+! Onl one receivermode for cloud coagulation (water)
+ do iCoagulatingMode = 1,numberOfCoagulatingModes
+
+ !Index of the coagulating mode (0-14), see list above
+ modeIndexCoagulator = coagulatingMode(iCoagulatingMode)
+
+ !Pre-calculate coagulation coefficients for this coagulator..
+ !Note: Not using actual density of coagulator here
+ !Since this is not known at init-time
+ call calculateCoagulationCoefficient(CoagulationCoefficient & !O [m3/s] coagulation coefficient
+ , rk(modeIndexCoagulator) & !I [m] radius of coagulator
+ , rhob(modeIndexCoagulator) & !I [kg/m3] density of coagulator
+ , rhoh2o ) !IÂ [kg/m3] density of receiver
+
+ !Save values
+ K12Cl(iCoagulatingMode,:) = CoagulationCoefficient(:)
+
+ enddo
+
+
+
+ !We don't need to remember K12 for all lookuptable sizes!!
+ !We only need to rember for 1 [#/m3] of each receiver mode
+ !and then later scale by number concentration in receiver modes
+ normalizedCoagulationSink(:,:) = 0.0_r8
+
+ do iCoagulatingMode = 1, numberOfCoagulatingModes
+
+ !Sum the loss for all possible receivers
+ do iReceiverMode = 1, numberOfCoagulationReceivers
+
+ modeIndexCoagulator = coagulatingMode(iCoagulatingMode) !Index of the coagulating mode
+
+ modeIndexReceiver = receiverMode(iReceiverMode) !Index of receiver mode
+
+ do nsiz=1,nBinsTab !aerotab bin sizes
+
+ !Sum up coagulation sink for this coagulating species (for all receiving modes)
+ normalizedCoagulationSink(modeIndexReceiver, modeIndexCoagulator) = & ![m3/#/s]
+ normalizedCoagulationSink(modeIndexReceiver, modeIndexCoagulator) & ![m3/#/s] Previous value
+ + normnk(modeIndexReceiver, nsiz) & !Normalized size distribution for receiver mode
+ * K12(iReceiverMode, iCoagulatingMode, nsiz) !Koagulation coefficient (m3/#/s)
+ end do !Look up table size
+ end do !receiver modes
+ end do !coagulator
+
+
+!nuctst3+
+! !Add simple self coagulation sink for mode 1 (with 1) in such a way that it
+! !affects coagulationSink but not the lifecycling (directly) otherwise
+! normCoagSinkMode1 = 0.0_r8
+! do nsiz=1,nBinsTab !aerotab bin sizes
+! normCoagSinkMode1 = normCoagSinkMode1 + normnk(1,nsiz) * CoagCoeffMode1(nsiz)
+! end do !Look up table size
+!nuctst3-
+!ak+
+ !Calculate additional coagulation sink for mode 1 in such a way that it
+ !affects coagulationSink but not the lifecycling (directly) otherwise
+
+ !Sum the loss for all possible receivers
+ normCoagSinkAdd(:) = 0.0_r8
+ iCoagulatingMode = 1
+ do iReceiverMode = 1, numberOfAddCoagReceivers
+
+ modeIndexReceiver = addReceiverMode(iReceiverMode) !Index of additional receiver mode
+
+ do nsiz=1,nBinsTab !aerotab bin sizes
+
+ !Sum up coagulation sink for this coagulating species (for all receiving modes)
+ normCoagSinkAdd(iReceiverMode) = & ![m3/#/s]
+ normCoagSinkAdd(iReceiverMode) & ![m3/#/s] Previous value
+ + normnk(modeIndexReceiver, nsiz) & !Normalized size distribution for receiver mode
+ * CoagCoeffModeAdd(iReceiverMode, nsiz) !Koagulation coefficient (m3/#/s)
+ end do !Look up table size
+ end do !receiver modes
+!ak-
+
+ nsiz=1
+ do while (rBinMidPoint(nsiz).lt.rcoagdroplet.and.nsiz.lt.nBinsTab)
+ nsiz=nsiz+1
+ end do
+
+ if (abs(rBinMidPoint(nsiz-1)-rcoagdroplet).lt.abs(rBinMidPoint(nsiz)-rcoagdroplet)) then
+ tableindexcloud=nsiz-1
+ else
+ tableindexcloud=nsiz
+ end if
+ write(iulog,*) 'Assumed droplet size and table bin number for cloud &
+ coagulation ',rcoagdroplet, ' nbin ',tableindexcloud,'binmid',rBinMidPoint(tableindexcloud)
+
+ do iCoagulatingMode = 1, numberOfCoagulatingModes
+ modeIndexCoagulator = coagulatingMode(iCoagulatingMode) !Index of the coagulating mode
+
+ NCloudCoagulationSink(modeIndexCoagulator) = & ![m3/#/s]
+ K12Cl(iCoagulatingMode, tableindexcloud) !Koagulation coefficient (m3/#/s)
+
+ end do
+
+end subroutine initializeCoagulationCoefficients
+
+!Calculates coagulation coefficient for a coagulator mode
+!with a given radius with all look-up table modes
+subroutine calculateCoagulationCoefficient(CoagulationCoefficient, modeRadius, modeDensity, receiverDensity)
+
+ implicit none
+
+ real(r8), intent(in) :: modeRadius ! [m] (?)
+ real(r8), intent(in) :: modeDensity ! [kg/m3] densityi
+ real(r8), intent(in) :: receiverDensity ! [kg/m3] density of receiver
+ real(r8), intent(out), dimension(:) :: coagulationCoefficient ![m3/s]
+
+ integer :: i !Counter for look-up tables
+
+ real(r8) :: diff1 ![m2/s] diffusivity
+ real(r8) :: diff2 ![m2/s] diffusivity
+ real(r8) :: g12 ![-] factor
+ real(r8) :: g1 ![-] factor
+ real(r8) :: g2 ![-] factor
+ real(r8) :: c12 ![m/s] average particle thermal velocity
+ real(r8) :: c1 ![m/s] particle thermal velocity
+ real(r8) :: c2 ![m/s] particle thermal velocity
+ real(r8) :: mfv1 ![m] mean free path particle
+ real(r8) :: mfv2 ![m] mean free path particle
+
+! coagulation coefficient for SO4 (Brownian, Fuchs form)
+ !Loop through indexes in look-up table
+ do i=1,nBinsTab
+ c1=calculateThermalVelocity(rBinMidPoint(i), receiverDensity) !receiving size
+ c2=calculateThermalVelocity(modeRadius, modeDensity) !coagulating aerosol
+ c12=sqrt(c1**2+c2**2)
+
+ diff1 = calculateParticleDiffusivity(rBinMidPoint(i)) !receiving particle
+ diff2 = calculateParticleDiffusivity(modeRadius) !coagulating particle
+
+ mfv1=calculateMeanFreePath(diff1,c1) !receiving particle
+ mfv2=calculateMeanFreePath(diff2,c2) !coagulating particle
+
+ g1 = calculateGFactor(rBinMidPoint(i), mfv1)
+ g2 = calculateGFactor(modeRadius, mfv2)
+
+ g12=sqrt(g1**2+g2**2)
+
+ !Coagulation coefficient of receiver size "i" with the coagulating
+ !mode "kcomp"
+ CoagulationCoefficient(i) = &
+ 4.0_r8*pi*(rBinMidPoint(i)+modeRadius)*(diff1+diff2) &
+ /((rBinMidPoint(i)+modeRadius)/(rBinMidPoint(i)+modeRadius+g12) &
+ +(4.0_r8/c12)*(diff1+diff2)/(modeRadius+rBinMidPoint(i)))
+
+ enddo ! loop on imax
+
+ return
+
+end subroutine calculateCoagulationCoefficient
+
+
+!Time step routine for coagulation
+!Called from chemistry
+
+subroutine coagtend( q, pmid, pdel, temperature, delt_inverse, ncol , lchnk)
+
+! Calculate the coagulation of small aerosols with larger particles and
+! cloud droplets. Only particles smaller that dry radius of
+! 40 nm is assumed to have an efficient coagulation with other particles.
+
+use shr_kind_mod, only: r8 => shr_kind_r8
+use ppgrid, only : pcols, pver
+use cam_history, only: outfld
+use aerosoldef
+use const
+use physics_buffer, only : physics_buffer_desc
+use modal_aero_data, only : qqcw_get_field
+implicit none
+
+
+! input arguments
+ integer, intent(in) :: ncol ! number of horizontal grid cells (columns)
+ real(r8), intent(inout) :: q(pcols,pver,gas_pcnst) ! TMR [kg/kg] including moisture
+ real(r8), intent(in) :: pmid(pcols,pver) ! [Pa] midpoint pressure
+ real(r8), intent(in) :: pdel(pcols,pver)
+ real(r8), intent(in) :: temperature(pcols,pver) ! [K] temperature
+ real(r8), intent(in) :: delt_inverse ! [1/s] inverse time step
+ integer, intent(in) :: lchnk ! [] chnk id needed for output
+! local
+ integer :: k ! level counter
+ integer :: i ! horizontal counter
+ integer :: m ! Species counter
+ integer :: iCoagulator !counter for species coagulating
+ integer :: iReceiver !counter for species receiving coagulate
+ integer :: iSpecie !counter for species in mode
+ integer :: nsiz !loop up table size
+ integer :: l_index_receiver
+ integer :: l_index_donor
+ integer :: modeIndexCoagulator !Index of coagulating mode
+ integer :: modeIndexReceiver !Index of receiving mode
+ real(r8) :: rhoAir ![kg/m3] air density
+ real(r8) :: coagulationSink ![1/s] loss for coagulating specie
+ real(r8), dimension(numberOfCoagulationReceivers):: numberConcentration ![#/m3] number concentration
+ real(r8) :: totalLoss(pcols,pver,gas_pcnst) ![kg/kg] tracer lost
+ character(128) :: long_name ![-] needed for diagnostics
+ real(r8), pointer :: fldcw(:,:)
+ real(r8), dimension(pcols, gas_pcnst) :: coltend
+ real(r8), dimension(pcols) :: tracer_coltend
+ logical :: history_aerosol
+
+
+ totalLoss(:,:,:)=0.0_r8
+
+
+ call phys_getopts(history_aerosol_out = history_aerosol)
+
+ do k=1,pver
+ do i=1,ncol
+
+ !Air density
+ rhoAir = pmid(i,k)/rair/temperature(i,k)
+
+ !Initialize number concentration for all receivers
+ numberConcentration(:) = 0.0_r8
+
+ !Go though all modes receiving coagulation
+ do ireceiver = 1,numberOfCoagulationReceivers
+
+ !Go through all core species in that mode
+ do iSpecie = 1,getNumberOfTracersInMode(receiverMode(ireceiver))
+
+ !Find the lifecycle-specie receiving the coagulation
+ l_index_receiver = getTracerIndex(receiverMode(ireceiver) , iSpecie , .true.)
+
+ long_name = solsym(l_index_receiver) !For testing
+
+
+ if(.NOT. is_process_mode(l_index_receiver,.true.)) then
+ !Add up the number concentration of the receiving mode
+ numberConcentration(iReceiver) = numberConcentration(iReceiver) & !previous value
+ + q(i,k,l_index_receiver) & !kg/kg
+ / rhopart(physicsIndex(l_index_receiver)) & !*[m3/kg] ==> m3/kg
+ * volumeToNumber(receiverMode(ireceiver)) & ![#/m3] ==> #/kg
+ * rhoAir !#/kg ==> #/m3
+ end if
+ end do !Lifecycle "core" species in this mode
+ enddo
+
+
+ !Go through all coagulating modes
+ do iCoagulator = 1, numberOfCoagulatingModes
+
+ !Initialize loss (for a coagulator) summed over all receivers
+ coagulationSink = 0.0_r8
+
+ modeIndexCoagulator = coagulatingMode(iCoagulator)
+
+ !Sum the loss for all possible receivers
+ do iReceiver = 1, numberOfCoagulationReceivers
+
+ modeIndexReceiver = receiverMode(iReceiver)
+
+ !Sum up coagulation sink for this coagulating species (for all receiving modes)
+ coagulationSink = & ![1/s]
+ coagulationSink + & ![1/] previous value
+ normalizedCoagulationSink(modeIndexReceiver, modeIndexCoagulator) & ![m3/#/s]
+ * numberConcentration(ireceiver) !numberConcentration (#/m3)
+ end do !receiver modes
+
+ !SOME LIFECYCLE SPECIES CHANGE "HOST MODE" WHEN THEY PARTICIPATE
+ !IN COAGULATION (THEY GO FROM EXTERNALLY MIXED TO INTERNALLY MIXED MODES)
+
+ !Each coagulating mode can contain several species
+ do ispecie = 1, getNumberOfTracersInMode(modeIndexCoagulator)
+
+ !Get the lifecycle specie which is lost
+ l_index_donor = getTracerIndex(modeIndexCoagulator , ispecie,.true. )
+
+ !Move lifecycle species to new lifecycle species due to coagulation
+
+ !process modes don't change mode except so4 condensate which becomes coagulate instead
+ !assumed to have same sink as MODE_IDX_OMBC_INTMIX_AIT
+ if( .NOT. is_process_mode(l_index_donor,.true.) &
+ .OR. ( (l_index_donor.eq.chemistryIndex(l_so4_a1)) .AND. modeIndexCoagulator .eq. MODE_IDX_OMBC_INTMIX_COAT_AIT) ) then
+
+ !Done summing total loss of this coagulating specie
+ totalLoss(i,k,l_index_donor) = coagulationSink & !loss rate for a mode in [1/s] summed over all receivers
+ * q(i,k,l_index_donor) & !* mixing ratio ==> MMR/s
+ / delt_inverse ! seconds ==> MMR
+
+ !Can not loose more than we have
+ totalLoss(i,k,l_index_donor) = min(totalLoss(i,k,l_index_donor) , q(i,k,l_index_donor))
+
+
+ end if !check on process modes
+ end do !species in mode
+
+ end do !coagulator mode
+ end do ! i
+ end do ! k
+
+
+ !UPDATE THE TRACERS AND DO DIAGNOSTICS
+ do iCoagulator = 1, numberOfCoagulatingModes
+ do ispecie = 1, getNumberOfTracersInMode(coagulatingMode(iCoagulator))
+
+ l_index_donor = getTracerIndex(coagulatingMode(iCoagulator) , ispecie ,.true.)
+
+ !so4_a1 is a process mode (condensate), but is still lost in coagulation
+ if( .NOT. is_process_mode(l_index_donor, .true.) &
+ .OR. ( (l_index_donor.eq.chemistryIndex(l_so4_a1)) .AND. coagulatingMode(iCoagulator) .eq. MODE_IDX_OMBC_INTMIX_COAT_AIT) ) then
+
+ l_index_donor = getTracerIndex(coagulatingMode(iCoagulator) , ispecie,.true. )
+
+ !index of mode gaining mass (l_so4_ac, l_om_ac, l_bc_ac), coagulate
+ l_index_receiver = lifeCycleReceiver(l_index_donor)
+
+ do k=1,pver
+ !Loose mass from tracer in donor mode
+ q(:ncol,k,l_index_donor) = q(:ncol,k,l_index_donor) - totalLoss(:ncol,k,l_index_donor)
+
+ !Give mass to tracer in receiver mode
+ q(:ncol,k,l_index_receiver) = q(:ncol,k,l_index_receiver) + totalLoss(:ncol,k,l_index_donor)
+ end do !k
+ endif
+ end do
+ end do
+
+ !Output for diagnostics
+ if(history_aerosol)then
+ coltend(:ncol,:) = 0.0_r8
+ do i=1,gas_pcnst
+ !Check if species contributes to coagulation
+ if(lifeCycleReceiver(i) .gt. 0)then
+ !Loss from the donor specie
+ tracer_coltend(:ncol) = sum(totalLoss(:ncol, :,i)*pdel(:ncol,:),2)/gravit*delt_inverse
+ coltend(:ncol,i) = coltend(:ncol,i) - tracer_coltend(:ncol) !negative, loss for donor
+ coltend(:ncol,lifeCycleReceiver(i)) = coltend(:ncol,lifeCycleReceiver(i)) + tracer_coltend(:ncol)
+ endif
+ end do
+ do i=1,gas_pcnst
+ if(lifeCycleReceiver(i) .gt. 0)then
+ long_name= trim(solsym(i))//"coagTend"
+ call outfld(long_name, coltend(:ncol,i), pcols, lchnk)
+ long_name= trim(solsym(lifeCycleReceiver(i)))//"coagTend"
+ call outfld(long_name, coltend(:ncol,lifeCycleReceiver(i)),pcols,lchnk)
+ end if
+ end do
+ endif
+
+end subroutine coagtend
+
+subroutine clcoag( q, pmid, pdel, temperature, cldnum, cldfrc, delt_inverse, ncol , lchnk, im, pbuf)
+
+! Calculate the coagulation of small aerosols with larger particles and
+! cloud droplets. Only particles smaller that dry radius of
+! 40 nm is assumed to have an efficient coagulation with other particles.
+
+use shr_kind_mod, only: r8 => shr_kind_r8
+use ppgrid, only : pcols, pver
+use cam_history, only: outfld
+use aerosoldef
+use const
+use physics_buffer, only : physics_buffer_desc
+use modal_aero_data, only : qqcw_get_field
+implicit none
+
+
+! input arguments
+ integer, intent(in) :: ncol ! number of horizontal grid cells (columns)
+ real(r8), intent(inout) :: q(pcols,pver,gas_pcnst) ! TMR [kg/kg] including moisture
+ real(r8), intent(in) :: pmid(pcols,pver) ! [Pa] midpoint pressure
+ real(r8), intent(in) :: pdel(pcols,pver)
+ real(r8), intent(in) :: temperature(pcols,pver) ! [K] temperature
+
+ real(r8), dimension(ncol,pver),intent(in) :: cldnum ! Droplet concentration #/kg
+ real(r8), dimension(ncol,pver),intent(in) :: cldfrc ! Cloud volume fraction
+
+ real(r8), intent(in) :: delt_inverse ! [1/s] inverse time step
+ integer, intent(in) :: lchnk ! [] chnk id needed for output
+ integer, intent(in) :: im
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+
+! local
+ integer :: k ! level counter
+ integer :: i ! horizontal counter
+ integer :: m ! Species counter
+ integer :: iCoagulator !counter for species coagulating
+ integer :: iReceiver !counter for species receiving coagulate
+ integer :: iSpecie !counter for species in mode
+ integer :: nsiz !loop up table size
+ integer :: l_index_receiver
+ integer :: l_index_donor
+ integer :: modeIndexCoagulator !Index of coagulating mode
+ integer :: modeIndexReceiver !Index of receiving mode
+ real(r8) :: coagulationSink ![1/s] loss for coagulating specie
+ real(r8), dimension(numberOfCoagulationReceivers):: numberConcentration ![#/m3] number concentration
+ real(r8) :: cloudLoss(pcols,pver,gas_pcnst) ![kg/kg] tracer lost
+ character(128) :: long_name ![-] needed for diagnostics
+ real(r8) :: rhoAir ![kg/m3] air density
+ real(r8), pointer :: fldcw(:,:)
+ real(r8), dimension(pcols, gas_pcnst) :: coltend
+ real(r8), dimension(pcols) :: tracer_coltend
+ logical :: history_aerosol
+
+
+ call phys_getopts(history_aerosol_out = history_aerosol)
+
+ cloudLoss(:,:,:)=0.0_r8
+
+
+ do k=1,pver
+ do i=1,ncol
+ if (cldfrc(i,k).gt.1.e-2) then
+ rhoAir = pmid(i,k)/rair/temperature(i,k)
+ !Go through all coagulating modes
+ do iCoagulator = 1, numberOfCoagulatingModes
+
+ !Initialize loss (for a coagulator) summed over all receivers
+ coagulationSink = 0.0_r8
+
+ modeIndexCoagulator = coagulatingMode(iCoagulator)
+
+ !Receiver for cloud coagulation is water droplets so do not need
+ !go through the coagulation receivers.
+
+ !Sum up coagulation sink for this coagulating species (for all receiving modes)
+ coagulationSink = & ![1/s]
+ NCloudCoagulationSink(modeIndexCoagulator) & ![m3/#/s]
+ * (rhoair*cldnum(i,k)/cldfrc(i,k)) ![kg/m3*#/kg
+
+ !Each coagulating mode can contain several species
+ do ispecie = 1, getNumberOfTracersInMode(modeIndexCoagulator)
+
+ !Get the lifecycle specie which is lost
+ l_index_donor = getTracerIndex(modeIndexCoagulator , ispecie,.true. )
+
+ !Move lifecycle species to new lifecycle species due to coagulation
+
+ !process modes don't change mode except so4 condensate which becomes coagulate instead
+ !assumed to have same sink as MODE_IDX_OMBC_INTMIX_AIT
+ if( .NOT. is_process_mode(l_index_donor,.true.) &
+ .OR. ( (l_index_donor.eq.chemistryIndex(l_so4_a1)) .AND. modeIndexCoagulator .eq. MODE_IDX_OMBC_INTMIX_COAT_AIT) ) then
+
+ !Done summing total loss of this coagulating specie
+ cloudLoss(i,k,l_index_donor) = coagulationSink & !loss rate for a mode in [1/s] summed over all receivers
+ * cldfrc(i,k)*q(i,k,l_index_donor) & !* mixing ratio ==> MMR/s
+ / delt_inverse ! seconds ==> MMR
+
+ !Can not loose more than we have
+ ! At present day assumed lost within the cloud
+ cloudLoss(i,k,l_index_donor) = min(cloudLoss(i,k,l_index_donor) , cldfrc(i,k)*q(i,k,l_index_donor))
+
+
+ end if !check on process modes
+ end do !species in mode
+
+ end do !coagulator mode
+ end if ! cldfrc .gt. 0.01
+ end do ! i
+ end do ! k
+
+!UPDATE THE TRACERS AND DO DIAGNOSTICS
+ do iCoagulator = 1, numberOfCoagulatingModes
+ do ispecie = 1, getNumberOfTracersInMode(coagulatingMode(iCoagulator))
+
+ l_index_donor = getTracerIndex(coagulatingMode(iCoagulator) , ispecie ,.true.)
+
+ !so4_a1 is a process mode (condensate), but is still lost in coagulation
+ if( .NOT. is_process_mode(l_index_donor, .true.) &
+ .OR. ( (l_index_donor.eq.chemistryIndex(l_so4_a1)) .AND. coagulatingMode(iCoagulator) .eq. MODE_IDX_OMBC_INTMIX_COAT_AIT) ) then
+
+ l_index_donor = getTracerIndex(coagulatingMode(iCoagulator) , ispecie,.true. )
+
+ !index of mode gaining mass (l_so4_a2, l_om_ac, l_bc_ac), coagulate
+ l_index_receiver = CloudAerReceiver(l_index_donor)
+ fldcw => qqcw_get_field(pbuf, CloudAerReceiver(l_index_donor)+im,lchnk,errorhandle=.true.)
+ do k=1,pver
+ !Loose mass from tracer in donor mode
+ q(:ncol,k,l_index_donor) = q(:ncol,k,l_index_donor) - cloudLoss(:ncol,k,l_index_donor)
+ !Give mass to tracer in receiver mode
+ if(associated(fldcw)) then
+ fldcw(:ncol,k) = fldcw(:ncol,k) + cloudLoss(:ncol,k,l_index_donor)
+ end if
+ end do !k
+ endif
+ end do
+ end do
+
+
+ !Output for diagnostics
+ if(history_aerosol)then
+ coltend(:ncol,:) = 0.0_r8
+ do i=1,gas_pcnst
+ !Check if species contributes to coagulation
+ if(CloudAerReceiver(i) .gt. 0)then
+ !Loss from the donor specie
+ tracer_coltend(:ncol) = sum(cloudLoss(:ncol, :,i)*pdel(:ncol,:),2)/gravit*delt_inverse
+
+ coltend(:ncol,i) = coltend(:ncol,i) - tracer_coltend(:ncol) !negative, loss for donor
+ coltend(:ncol,CloudAerReceiver(i)) = coltend(:ncol,CloudAerReceiver(i)) + tracer_coltend(:ncol)
+ endif
+ end do
+ do i=1,gas_pcnst
+ if(CloudAerReceiver(i) .gt. 0)then
+ long_name= trim(solsym(i))//"clcoagTend"
+ call outfld(long_name, coltend(:ncol,i), pcols, lchnk)
+ long_name= trim(solsym(CloudAerReceiver(i)))//"_OCWclcoagTend"
+ call outfld(long_name, coltend(:ncol,CloudAerReceiver(i)),pcols,lchnk)
+ end if
+ end do
+ endif
+
+
+
+
+end subroutine clcoag
+
+function calculateThermalVelocity(radius, density) result(thermalVelocity)
+ implicit none
+ real(r8), intent(in) :: radius ![m]
+ real(r8), intent(in) :: density ![kg/m3]
+ real(r8) :: thermalVelocity ![m/s]
+
+ !Formula for "c1" in Seinfeld & Pandis, table 12.1
+ thermalVelocity = sqrt(8.0_r8*kboltzmann*temperatureLookupTables/pi/pi/((4.0_r8/3.0_r8)*density*radius**3))
+end function calculateThermalVelocity
+
+
+
+
+function calculateParticleDiffusivity(radius) result (diffusivity)
+ implicit none
+ real(r8), intent(in) :: radius ![m] particle radius
+ real(r8) :: knudsenNumber ![-] knudsen number
+ real(r8) :: diffusivity ![m2/s] diffusivity
+
+ real(r8) :: factor
+ real(r8) :: numerator, nominator
+
+
+ !Solve eqn for diffusivity in Seinfeld/Pandis, table 12.1
+
+ knudsenNumber = mfpAir/radius
+
+ factor = (kboltzmann*temperatureLookupTables/3.0_r8/pi/viscosityAir/2.0_r8/radius)
+ numerator = 5.0_r8 + 4.0_r8*knudsenNumber + 6.0_r8*knudsenNumber**2 + 18.0_r8*knudsenNumber**3
+ nominator = 5.0_r8 - knudsenNumber + (8.0_r8 + pi)*knudsenNumber**2
+
+ diffusivity = factor*numerator/nominator
+end function calculateParticleDiffusivity
+
+
+
+
+function calculateMeanFreePath(diffusivity,thermalVelocity) result(MeanFreePath)
+ implicit none
+ real(r8) :: diffusivity ![m2/s]
+ real(r8) :: thermalVelocity ![m/s]
+ real(r8) :: meanFreePath ![m]
+
+ meanFreePath = 8.0_r8*diffusivity/(pi*thermalVelocity)
+end function calculateMeanFreePath
+
+
+function calculateGFactor(radius, meanFreePath) result(g)
+ implicit none
+ real(r8) :: radius ![m]
+ real(r8) :: meanFreePath ![m]
+ real(r8) :: g
+
+ g = ((2.0_r8*radius+meanFreePath)**3 &
+ -(4.0_r8*radius**2+meanFreePath**2)**1.5_r8) &
+ /(6.0_r8*radius*meanFreePath) &
+ -2.0_r8*radius
+
+end function calculateGFactor
+
+end module koagsub
diff --git a/src/chemistry/oslo_aero/microp_aero.F90 b/src/chemistry/oslo_aero/microp_aero.F90
new file mode 100644
index 0000000000..a45ca985ad
--- /dev/null
+++ b/src/chemistry/oslo_aero/microp_aero.F90
@@ -0,0 +1,906 @@
+module microp_aero
+
+!---------------------------------------------------------------------------------
+! Purpose:
+! CAM driver layer for aerosol activation processes.
+!
+! ***N.B.*** This module is currently hardcoded to recognize only the aerosols/modes that
+! affect the climate calculation. This is implemented by using list
+! index 0 in all the calls to rad_constituent interfaces.
+!
+! Author: Andrew Gettelman
+! Based on code from: Hugh Morrison, Xiaohong Liu and Steve Ghan
+! May 2010
+! Description in: Morrison and Gettelman, 2008. J. Climate (MG2008)
+! Gettelman et al., 2010 J. Geophys. Res. - Atmospheres (G2010)
+! for questions contact Andrew Gettelman (andrew@ucar.edu)
+! Modifications: A. Gettelman Nov 2010 - changed to support separation of
+! microphysics and macrophysics and concentrate aerosol information here
+! B. Eaton, Sep 2014 - Refactored to move CAM interface code into the CAM
+! interface modules and preserve just the driver layer functionality here.
+!
+!---------------------------------------------------------------------------------
+
+use shr_kind_mod, only: r8=>shr_kind_r8
+use spmd_utils, only: masterproc
+use ppgrid, only: pcols, pver, pverp
+use ref_pres, only: top_lev => trop_cloud_top_lev
+use physconst, only: rair
+use constituents, only: cnst_get_ind
+use physics_types, only: physics_state, physics_ptend, physics_ptend_init, physics_ptend_sum, &
+ physics_state_copy, physics_update
+use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field
+use phys_control, only: phys_getopts, use_hetfrz_classnuc
+use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_aer_mmr, rad_cnst_get_aer_props, &
+ rad_cnst_get_mode_num
+#ifndef OSLO_AERO
+use nucleate_ice_cam, only: use_preexisting_ice, nucleate_ice_cam_readnl, nucleate_ice_cam_register, &
+ nucleate_ice_cam_init, nucleate_ice_cam_calc
+#endif
+
+use ndrop, only: ndrop_init, dropmixnuc
+use ndrop_bam, only: ndrop_bam_init, ndrop_bam_run, ndrop_bam_ccn
+
+#ifndef OSLO_AERO
+use hetfrz_classnuc_cam, only: hetfrz_classnuc_cam_readnl, hetfrz_classnuc_cam_register, hetfrz_classnuc_cam_init, &
+ hetfrz_classnuc_cam_save_cbaero, hetfrz_classnuc_cam_calc
+
+#endif
+use cam_history, only: addfld, add_default, outfld
+use cam_logfile, only: iulog
+use cam_abortutils, only: endrun
+
+
+#ifdef OSLO_AERO
+use commondefinitions, only: nmodes_oslo => nmodes
+use aerosoldef, only: MODE_IDX_DST_A2, MODE_IDX_DST_A3, MODE_IDX_SO4_AC &
+ ,MODE_IDX_OMBC_INTMIX_COAT_AIT, lifeCycleNumberMedianRadius, &
+ l_dst_a2, l_dst_a3, l_bc_ai, getNumberOfTracersInMode, &
+ getTracerIndex, getCloudTracerIndex
+use oslo_utils, only: CalculateNumberConcentration
+use parmix_progncdnc
+use hetfrz_classnuc_oslo
+use nucleate_ice_oslo
+#endif
+
+implicit none
+private
+save
+
+public :: microp_aero_init, microp_aero_run, microp_aero_readnl, microp_aero_register
+
+! Private module data
+
+character(len=16) :: eddy_scheme
+
+! contact freezing due to dust
+! dust number mean radius (m), Zender et al JGR 2003 assuming number mode radius of 0.6 micron, sigma=2
+real(r8), parameter :: rn_dst1 = 0.258e-6_r8
+real(r8), parameter :: rn_dst2 = 0.717e-6_r8
+real(r8), parameter :: rn_dst3 = 1.576e-6_r8
+real(r8), parameter :: rn_dst4 = 3.026e-6_r8
+
+real(r8) :: bulk_scale ! prescribed aerosol bulk sulfur scale factor
+
+! smallest mixing ratio considered in microphysics
+real(r8), parameter :: qsmall = 1.e-18_r8
+
+! minimum allowed cloud fraction
+real(r8), parameter :: mincld = 0.0001_r8
+
+! indices in state%q and pbuf structures
+integer :: cldliq_idx = -1
+integer :: cldice_idx = -1
+integer :: numliq_idx = -1
+integer :: numice_idx = -1
+integer :: kvh_idx = -1
+integer :: tke_idx = -1
+integer :: wp2_idx = -1
+integer :: ast_idx = -1
+integer :: cldo_idx = -1
+integer :: dgnumwet_idx = -1
+
+! Bulk aerosols
+character(len=20), allocatable :: aername(:)
+real(r8), allocatable :: num_to_mass_aer(:)
+
+integer :: naer_all ! number of aerosols affecting climate
+integer :: idxsul = -1 ! index in aerosol list for sulfate
+integer :: idxdst2 = -1 ! index in aerosol list for dust2
+integer :: idxdst3 = -1 ! index in aerosol list for dust3
+integer :: idxdst4 = -1 ! index in aerosol list for dust4
+
+! modal aerosols
+logical :: clim_modal_aero
+
+integer :: mode_accum_idx = -1 ! index of accumulation mode
+integer :: mode_aitken_idx = -1 ! index of aitken mode
+integer :: mode_coarse_idx = -1 ! index of coarse mode
+integer :: mode_coarse_dst_idx = -1 ! index of coarse dust mode
+integer :: mode_coarse_slt_idx = -1 ! index of coarse sea salt mode
+integer :: coarse_dust_idx = -1 ! index of dust in coarse mode
+integer :: coarse_nacl_idx = -1 ! index of nacl in coarse mode
+integer :: coarse_so4_idx = -1 ! index of sulfate in coarse mode
+
+integer :: npccn_idx, rndst_idx, nacon_idx
+
+logical :: separate_dust = .false.
+
+!=========================================================================================
+contains
+!=========================================================================================
+
+subroutine microp_aero_register
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! Register pbuf fields for aerosols needed by microphysics
+ !
+ ! Author: Cheryl Craig October 2012
+ !
+ !-----------------------------------------------------------------------
+ use ppgrid, only: pcols
+ use physics_buffer, only: pbuf_add_field, dtype_r8
+
+ call pbuf_add_field('NPCCN', 'physpkg',dtype_r8,(/pcols,pver/), npccn_idx)
+
+ call pbuf_add_field('RNDST', 'physpkg',dtype_r8,(/pcols,pver,4/), rndst_idx)
+ call pbuf_add_field('NACON', 'physpkg',dtype_r8,(/pcols,pver,4/), nacon_idx)
+
+ call nucleate_ice_oslo_register()
+ call hetfrz_classnuc_oslo_register()
+
+end subroutine microp_aero_register
+
+!=========================================================================================
+
+subroutine microp_aero_init
+
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! Initialize constants for aerosols needed by microphysics
+ !
+ ! Author: Andrew Gettelman May 2010
+ !
+ !-----------------------------------------------------------------------
+
+ ! local variables
+ integer :: iaer, ierr
+ integer :: m, n, nmodes, nspec
+
+ character(len=32) :: str32
+ character(len=*), parameter :: routine = 'microp_aero_init'
+ logical :: history_amwg
+ !-----------------------------------------------------------------------
+
+ ! Query the PBL eddy scheme
+ call phys_getopts(eddy_scheme_out = eddy_scheme, &
+ history_amwg_out = history_amwg )
+
+ ! Access the physical properties of the aerosols that are affecting the climate
+ ! by using routines from the rad_constituents module.
+
+ ! get indices into state and pbuf structures
+ call cnst_get_ind('CLDLIQ', cldliq_idx)
+ call cnst_get_ind('CLDICE', cldice_idx)
+ call cnst_get_ind('NUMLIQ', numliq_idx)
+ call cnst_get_ind('NUMICE', numice_idx)
+
+ select case(trim(eddy_scheme))
+ case ('diag_TKE')
+ tke_idx = pbuf_get_index('tke')
+ case ('CLUBB_SGS')
+ wp2_idx = pbuf_get_index('WP2_nadv')
+ case default
+ kvh_idx = pbuf_get_index('kvh')
+ end select
+
+ ! clim_modal_aero determines whether modal aerosols are used in the climate calculation.
+ ! The modal aerosols can be either prognostic or prescribed.
+ call rad_cnst_get_info(0, nmodes=nmodes)
+ clim_modal_aero = (nmodes > 0)
+
+ ast_idx = pbuf_get_index('AST')
+
+#if (defined OSLO_AERO)
+ cldo_idx = pbuf_get_index('CLDO')
+ clim_modal_aero = .true. !Needed to avoid ending up in BAM routines
+
+ call ndrop_init()
+#else
+ if (clim_modal_aero) then
+
+ cldo_idx = pbuf_get_index('CLDO')
+ dgnumwet_idx = pbuf_get_index('DGNUMWET')
+
+ call ndrop_init()
+
+ ! Init indices for specific modes/species
+
+ ! mode index for specified mode types
+ do m = 1, nmodes
+ call rad_cnst_get_info(0, m, mode_type=str32)
+ select case (trim(str32))
+ case ('accum')
+ mode_accum_idx = m
+ case ('aitken')
+ mode_aitken_idx = m
+ case ('coarse')
+ mode_coarse_idx = m
+ case ('coarse_dust')
+ mode_coarse_dst_idx = m
+ case ('coarse_seasalt')
+ mode_coarse_slt_idx = m
+ end select
+ end do
+
+ ! check if coarse dust is in separate mode
+ separate_dust = mode_coarse_dst_idx > 0
+
+ ! for 3-mode
+ if ( mode_coarse_dst_idx<0 ) mode_coarse_dst_idx = mode_coarse_idx
+ if ( mode_coarse_slt_idx<0 ) mode_coarse_slt_idx = mode_coarse_idx
+
+ ! Check that required mode types were found
+ if (mode_accum_idx == -1 .or. mode_aitken_idx == -1 .or. &
+ mode_coarse_dst_idx == -1.or. mode_coarse_slt_idx == -1) then
+ write(iulog,*) routine//': ERROR required mode type not found - mode idx:', &
+ mode_accum_idx, mode_aitken_idx, mode_coarse_dst_idx, mode_coarse_slt_idx
+ call endrun(routine//': ERROR required mode type not found')
+ end if
+
+ ! species indices for specified types
+ ! find indices for the dust and seasalt species in the coarse mode
+ call rad_cnst_get_info(0, mode_coarse_dst_idx, nspec=nspec)
+ do n = 1, nspec
+ call rad_cnst_get_info(0, mode_coarse_dst_idx, n, spec_type=str32)
+ select case (trim(str32))
+ case ('dust')
+ coarse_dust_idx = n
+ end select
+ end do
+ call rad_cnst_get_info(0, mode_coarse_slt_idx, nspec=nspec)
+ do n = 1, nspec
+ call rad_cnst_get_info(0, mode_coarse_slt_idx, n, spec_type=str32)
+ select case (trim(str32))
+ case ('seasalt')
+ coarse_nacl_idx = n
+ end select
+ end do
+ if (mode_coarse_idx>0) then
+ call rad_cnst_get_info(0, mode_coarse_idx, nspec=nspec)
+ do n = 1, nspec
+ call rad_cnst_get_info(0, mode_coarse_idx, n, spec_type=str32)
+ select case (trim(str32))
+ case ('sulfate')
+ coarse_so4_idx = n
+ end select
+ end do
+ endif
+
+ ! Check that required mode specie types were found
+ if ( coarse_dust_idx == -1 .or. coarse_nacl_idx == -1 ) then
+ write(iulog,*) routine//': ERROR required mode-species type not found - indicies:', &
+ coarse_dust_idx, coarse_nacl_idx
+ call endrun(routine//': ERROR required mode-species type not found')
+ end if
+
+ else
+
+ ! Props needed for BAM number concentration calcs.
+
+ call rad_cnst_get_info(0, naero=naer_all)
+ allocate( &
+ aername(naer_all), &
+ num_to_mass_aer(naer_all) )
+
+ do iaer = 1, naer_all
+ call rad_cnst_get_aer_props(0, iaer, &
+ aername = aername(iaer), &
+ num_to_mass_aer = num_to_mass_aer(iaer) )
+
+ ! Look for sulfate, dust, and soot in this list (Bulk aerosol only)
+ if (trim(aername(iaer)) == 'SULFATE') idxsul = iaer
+ if (trim(aername(iaer)) == 'DUST2') idxdst2 = iaer
+ if (trim(aername(iaer)) == 'DUST3') idxdst3 = iaer
+ if (trim(aername(iaer)) == 'DUST4') idxdst4 = iaer
+ end do
+
+ call ndrop_bam_init()
+
+ end if
+
+#endif
+
+ call addfld('LCLOUD', (/ 'lev' /), 'A', ' ', 'Liquid cloud fraction used in stratus activation')
+
+ call addfld('WSUB', (/ 'lev' /), 'A', 'm/s', 'Diagnostic sub-grid vertical velocity' )
+ call addfld('WSUBI', (/ 'lev' /), 'A', 'm/s', 'Diagnostic sub-grid vertical velocity for ice' )
+
+ if (history_amwg) then
+ call add_default ('WSUB ', 1, ' ')
+ end if
+
+ call nucleate_ice_oslo_init(mincld, bulk_scale)
+ call hetfrz_classnuc_oslo_init(mincld)
+
+end subroutine microp_aero_init
+
+!=========================================================================================
+
+subroutine microp_aero_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use mpishorthand
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Namelist variables
+ real(r8) :: microp_aero_bulk_scale = 2._r8 ! prescribed aerosol bulk sulfur scale factor
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'microp_aero_readnl'
+
+ namelist /microp_aero_nl/ microp_aero_bulk_scale
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'microp_aero_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, microp_aero_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+ end if
+
+#ifdef SPMD
+ ! Broadcast namelist variable
+ call mpibcast(microp_aero_bulk_scale, 1, mpir8, 0, mpicom)
+#endif
+
+ ! set local variables
+ bulk_scale = microp_aero_bulk_scale
+
+ call nucleate_ice_oslo_readnl(nlfile)
+ call hetfrz_classnuc_oslo_readnl(nlfile)
+
+end subroutine microp_aero_readnl
+
+!=========================================================================================
+
+subroutine microp_aero_run ( &
+ state, ptend_all, deltatin, pbuf)
+
+ ! input arguments
+ type(physics_state), intent(in) :: state
+ type(physics_ptend), intent(out) :: ptend_all
+ real(r8), intent(in) :: deltatin ! time step (s)
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! local workspace
+ ! all units mks unless otherwise stated
+
+ integer :: i, k, m
+ integer :: itim_old
+ integer :: nmodes
+
+ type(physics_state) :: state1 ! Local copy of state variable
+ type(physics_ptend) :: ptend_loc
+
+ real(r8), pointer :: ast(:,:)
+
+ real(r8), pointer :: npccn(:,:) ! number of CCN (liquid activated)
+
+ real(r8), pointer :: rndst(:,:,:) ! radius of 4 dust bins for contact freezing
+ real(r8), pointer :: nacon(:,:,:) ! number in 4 dust bins for contact freezing
+
+ real(r8), pointer :: num_coarse(:,:) ! number m.r. of coarse mode
+ real(r8), pointer :: coarse_dust(:,:) ! mass m.r. of coarse dust
+ real(r8), pointer :: coarse_nacl(:,:) ! mass m.r. of coarse nacl
+ real(r8), pointer :: coarse_so4(:,:) ! mass m.r. of coarse sulfate
+
+ real(r8), pointer :: kvh(:,:) ! vertical eddy diff coef (m2 s-1)
+ real(r8), pointer :: tke(:,:) ! TKE from the UW PBL scheme (m2 s-2)
+ real(r8), pointer :: wp2(:,:) ! CLUBB vertical velocity variance
+
+ real(r8), pointer :: cldn(:,:) ! cloud fraction
+ real(r8), pointer :: cldo(:,:) ! old cloud fraction
+
+ real(r8), pointer :: dgnumwet(:,:,:) ! aerosol mode diameter
+
+ real(r8), pointer :: aer_mmr(:,:) ! aerosol mass mixing ratio
+
+ real(r8) :: rho(pcols,pver) ! air density (kg m-3)
+
+ real(r8) :: lcldm(pcols,pver) ! liq cloud fraction
+
+ real(r8) :: lcldn(pcols,pver) ! fractional coverage of new liquid cloud
+ real(r8) :: lcldo(pcols,pver) ! fractional coverage of old liquid cloud
+ real(r8) :: cldliqf(pcols,pver) ! fractional of total cloud that is liquid
+ real(r8) :: qcld ! total cloud water
+ real(r8) :: nctend_mixnuc(pcols,pver)
+ real(r8) :: dum, dum2 ! temporary dummy variable
+ real(r8) :: dmc, ssmc, so4mc ! variables for modal scheme.
+ integer :: dst_idx, num_idx
+
+ ! bulk aerosol variables
+ real(r8), allocatable :: naer2(:,:,:) ! bulk aerosol number concentration (1/m3)
+ real(r8), allocatable :: maerosol(:,:,:) ! bulk aerosol mass conc (kg/m3)
+
+ real(r8) :: wsub(pcols,pver) ! diagnosed sub-grid vertical velocity st. dev. (m/s)
+ real(r8) :: wsubi(pcols,pver) ! diagnosed sub-grid vertical velocity ice (m/s)
+ real(r8) :: nucboas
+
+ real(r8) :: wght
+
+ integer :: lchnk, ncol
+
+ !++ MH_2015/04/10
+ real(r8) :: factnum(pcols,pver,0:nmodes_oslo) ! activation fraction for aerosol number
+ type qqcw_type
+ real(r8), pointer :: fldcw(:,:)
+ end type qqcw_type
+ type(qqcw_type) :: qqcw(pcnst)
+ real(r8) :: qaercwpt(pcols,pver,pcnst)
+ integer :: kk
+
+ !++ MH_2015/04/10
+#ifdef OSLO_AERO
+ logical :: hasAerosol(pcols, pver, nmodes_oslo)
+ real(r8) :: f_acm(pcols,pver, nmodes_oslo)
+ real(r8) :: f_bcm(pcols,pver, nmodes_oslo)
+ real(r8) :: f_aqm(pcols, pver, nmodes_oslo)
+ real(r8) :: f_so4_condm(pcols, pver, nmodes_oslo) !Needed in "get component fraction"
+ real(r8) :: f_soam(pcols, pver, nmodes_oslo) !Needed in "get component fraction"
+ real(r8) :: numberConcentration(pcols,pver,0:nmodes_oslo) ![#/m3] number concentraiton
+ real(r8) :: volumeConcentration(pcols,pver,nmodes_oslo) ![m3/m3] volume concentration
+ real(r8) :: hygroscopicity(pcols,pver,nmodes_oslo) ![mol_{aer}/mol_{water}] hygroscopicity
+ real(r8) :: lnsigma(pcols,pver,nmodes_oslo) ![-] log(base e) sigma
+ real(r8) :: CProcessModes(pcols,pver)
+ real(r8) :: cam(pcols,pver,nmodes_oslo)
+ real(r8) :: f_c(pcols, pver)
+ real(r8) :: f_aq(pcols,pver)
+ real(r8) :: f_bc(pcols,pver)
+ real(r8) :: f_so4_cond(pcols,pver)
+ real(r8) :: f_soa(pcols,pver)
+ real(r8) :: volumeCore(pcols,pver,nmodes_oslo)
+ real(r8) :: volumeCoat(pcols,pver,nmodes_oslo)
+ real(r8) :: sigmag_amode(3)
+ real(r8) :: CloudnumberConcentration(pcols,pver,0:nmodes_oslo)
+
+ real(r8) :: fn_bc(pcols,pver), fn_dst1(pcols,pver), fn_dst3(pcols,pver)
+ real(r8) :: hetraer_bc(pcols,pver), hetraer_dst1(pcols,pver), hetraer_dst3(pcols,pver)
+ real(r8) :: dstcoat_bc(pcols,pver), dstcoat_dst1(pcols,pver), dstcoat_dst3(pcols,pver)
+#endif
+ !-- MH_2015/04/10
+
+ !-------------------------------------------------------------------------------
+
+ call physics_state_copy(state,state1)
+
+ lchnk = state1%lchnk
+ ncol = state1%ncol
+
+ itim_old = pbuf_old_tim_idx()
+ call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+
+ call pbuf_get_field(pbuf, npccn_idx, npccn)
+
+ call pbuf_get_field(pbuf, nacon_idx, nacon)
+ call pbuf_get_field(pbuf, rndst_idx, rndst)
+
+ call physics_ptend_init(ptend_all, state%psetcols, 'microp_aero')
+
+ if (clim_modal_aero) then
+
+ itim_old = pbuf_old_tim_idx()
+
+ call pbuf_get_field(pbuf, ast_idx, cldn, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ call pbuf_get_field(pbuf, cldo_idx, cldo, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+#ifndef OSLO_AERO
+ call rad_cnst_get_info(0, nmodes=nmodes)
+ call pbuf_get_field(pbuf, dgnumwet_idx, dgnumwet, start=(/1,1,1/), kount=(/pcols,pver,nmodes/) )
+
+ allocate(factnum(pcols,pver,nmodes))
+#endif
+
+ end if
+
+ ! initialize output
+ npccn(1:ncol,1:pver) = 0._r8
+
+ nacon(1:ncol,1:pver,:) = 0._r8
+
+ ! set default or fixed dust bins for contact freezing
+ rndst(1:ncol,1:pver,1) = rn_dst1
+ rndst(1:ncol,1:pver,2) = rn_dst2
+ rndst(1:ncol,1:pver,3) = rn_dst3
+ rndst(1:ncol,1:pver,4) = rn_dst4
+
+ ! save copy of cloud borne aerosols for use in heterogeneous freezing
+ if (use_hetfrz_classnuc) then
+ call hetfrz_classnuc_oslo_save_cbaero(state, pbuf)
+ end if
+
+ ! initialize time-varying parameters
+ do k = top_lev, pver
+ do i = 1, ncol
+ rho(i,k) = state1%pmid(i,k)/(rair*state1%t(i,k))
+ end do
+ end do
+
+!++ MH_2015/04/10
+ factnum(1:ncol,1:pver,0:nmodes_oslo) = 0._r8
+
+ !hetraer(1:ncol,1:pver,1:3) = 0._r8
+ !total_aer_num(1:ncol,1:pver,1:3) = 0._r8
+ !coated_aer_num(1:ncol,1:pver,1:3) = 0._r8
+ !uncoated_aer_num(1:ncol,1:pver,1:3) = 0._r8
+ !total_interstitial_aer_num(1:ncol,1:pver,1:3) = 0._r8
+ !total_cloudborne_aer_num(1:ncol,1:pver,1:3) = 0._r8
+ !awcam(1:ncol,1:pver,1:3) = 0._r8
+ !awfacm(1:ncol,1:pver,1:3) = 0._r8
+ !dstcoat(1:ncol,1:pver,1:3) = 0._r8
+ !++ wy4.0
+ !na500(1:ncol,1:pver) = 0._r8
+ !tot_na500(1:ncol,1:pver) = 0._r8
+ !-- wy4.0
+
+#ifdef OSLO_AERO
+ !qaercwpt(1:ncol,1:pver,:) = 0.0_r8
+ ! do m=1,nmodes_oslo
+ ! do n=1,getNumberOfTracersInMode(m)
+ ! kk=getTracerIndex(m,n,.false.)! This gives the tracer index used in the q-array
+ ! qqcw(kk)%fldcw => qqcw_get_field(pbuf,kk,lchnk)
+ ! qaercwpt(:,:,kk) = qqcw(kk)%fldcw
+ ! end do
+ ! end do
+#endif
+!-- MH_2015/04/10
+
+
+#ifndef OSLO_AERO
+ if (clim_modal_aero) then
+ ! mode number mixing ratios
+ call rad_cnst_get_mode_num(0, mode_coarse_dst_idx, 'a', state1, pbuf, num_coarse)
+
+ ! mode specie mass m.r.
+ call rad_cnst_get_aer_mmr(0, mode_coarse_dst_idx, coarse_dust_idx, 'a', state1, pbuf, coarse_dust)
+ call rad_cnst_get_aer_mmr(0, mode_coarse_slt_idx, coarse_nacl_idx, 'a', state1, pbuf, coarse_nacl)
+ if (mode_coarse_idx>0) then
+ call rad_cnst_get_aer_mmr(0, mode_coarse_idx, coarse_so4_idx, 'a', state1, pbuf, coarse_so4)
+ endif
+
+ else
+ ! init number/mass arrays for bulk aerosols
+ allocate( &
+ naer2(pcols,pver,naer_all), &
+ maerosol(pcols,pver,naer_all))
+
+ do m = 1, naer_all
+ call rad_cnst_get_aer_mmr(0, m, state1, pbuf, aer_mmr)
+ maerosol(:ncol,:,m) = aer_mmr(:ncol,:)*rho(:ncol,:)
+
+ if (m .eq. idxsul) then
+ naer2(:ncol,:,m) = maerosol(:ncol,:,m)*num_to_mass_aer(m)*bulk_scale
+ else
+ naer2(:ncol,:,m) = maerosol(:ncol,:,m)*num_to_mass_aer(m)
+ end if
+ end do
+ end if
+#endif
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! More refined computation of sub-grid vertical velocity
+ ! Set to be zero at the surface by initialization.
+
+ select case (trim(eddy_scheme))
+ case ('diag_TKE')
+ call pbuf_get_field(pbuf, tke_idx, tke)
+ case ('CLUBB_SGS')
+ itim_old = pbuf_old_tim_idx()
+ call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/),kount=(/pcols,pverp,1/))
+ allocate(tke(pcols,pverp))
+ tke(:ncol,:) = (3._r8/2._r8)*wp2(:ncol,:)
+
+ case default
+ call pbuf_get_field(pbuf, kvh_idx, kvh)
+ end select
+
+ ! Set minimum values above top_lev.
+ wsub(:ncol,:top_lev-1) = 0.20_r8
+ wsubi(:ncol,:top_lev-1) = 0.001_r8
+
+ do k = top_lev, pver
+ do i = 1, ncol
+
+ select case (trim(eddy_scheme))
+ case ('diag_TKE', 'CLUBB_SGS')
+ wsub(i,k) = sqrt(0.5_r8*(tke(i,k) + tke(i,k+1))*(2._r8/3._r8))
+ wsub(i,k) = min(wsub(i,k),10._r8)
+ case default
+ ! get sub-grid vertical velocity from diff coef.
+ ! following morrison et al. 2005, JAS
+ ! assume mixing length of 30 m
+ dum = (kvh(i,k) + kvh(i,k+1))/2._r8/30._r8
+ ! use maximum sub-grid vertical vel of 10 m/s
+ dum = min(dum, 10._r8)
+ ! set wsub to value at current vertical level
+ wsub(i,k) = dum
+ end select
+
+ wsubi(i,k) = max(0.001_r8, wsub(i,k))
+ if (.not. use_preexisting_ice) then
+ wsubi(i,k) = min(wsubi(i,k), 0.2_r8)
+ endif
+
+ wsub(i,k) = max(0.20_r8, wsub(i,k))
+
+ end do
+ end do
+
+ call outfld('WSUB', wsub, pcols, lchnk)
+ call outfld('WSUBI', wsubi, pcols, lchnk)
+
+ if (trim(eddy_scheme) == 'CLUBB_SGS') deallocate(tke)
+
+!++ MH_2015/04/10
+#ifdef OSLO_AERO
+
+!Get size distributed interstitial aerosol
+ call parmix_progncdnc_sub( &
+ ncol & !I [nbr] number of columns used
+ ,state%q & !I [kg/kg] mass mixing ratio of tracers
+ ,rho & !I [kg/m3] air density
+ ,CProcessModes & !O [kg/m3] added mass (total distributed all background modes)
+ ,f_c & !O
+ ,f_bc & !O
+ ,f_aq & !O
+ ,f_so4_cond & !O
+ ,f_soa &
+ ,cam & !O
+ ,f_acm & !O [frc] carbon fraction in mode
+ ,f_bcm & !O [frc] fraction of c being bc
+ ,f_aqm & !O [frc] fraction of sulfate being aquous
+ ,f_so4_condm & !O [frc] fraction of non-aquous SO4 being condensate
+ ,f_soam &
+ ,numberConcentration & !O [#/m3] number concentration
+ ,volumeConcentration & !O [m3/m3] volume concentration
+ ,hygroscopicity & !O [mol/mol]
+ ,lnsigma & !O [-] log sigma
+ ,hasAerosol & !I [t/f] do we have this type of aerosol here?
+ ,volumeCore &
+ ,volumeCoat &
+ )
+#endif
+!-- MH_2015/04/10
+
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ !ICE Nucleation
+
+ call nucleate_ice_oslo_calc(state1, wsubi, pbuf, deltatin, ptend_loc, numberConcentration)
+
+ call physics_ptend_sum(ptend_loc, ptend_all, ncol)
+ call physics_update(state1, ptend_loc, deltatin)
+
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! get liquid cloud fraction, check for minimum
+
+ do k = top_lev, pver
+ do i = 1, ncol
+ lcldm(i,k) = max(ast(i,k), mincld)
+ end do
+ end do
+
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! Droplet Activation
+
+ if (clim_modal_aero) then
+
+ ! for modal aerosol
+
+ ! partition cloud fraction into liquid water part
+ lcldn = 0._r8
+ lcldo = 0._r8
+ cldliqf = 0._r8
+ do k = top_lev, pver
+ do i = 1, ncol
+ qcld = state1%q(i,k,cldliq_idx) + state1%q(i,k,cldice_idx)
+ if (qcld > qsmall) then
+ lcldn(i,k) = cldn(i,k)*state1%q(i,k,cldliq_idx)/qcld
+ lcldo(i,k) = cldo(i,k)*state1%q(i,k,cldliq_idx)/qcld
+ cldliqf(i,k) = state1%q(i,k,cldliq_idx)/qcld
+ end if
+ end do
+ end do
+
+ call outfld('LCLOUD', lcldn, pcols, lchnk)
+
+ ! If not using preexsiting ice, then only use cloudbourne aerosol for the
+ ! liquid clouds. This is the same behavior as CAM5.
+ if (use_preexisting_ice) then
+ call dropmixnuc( &
+ state1, ptend_loc, deltatin, pbuf, wsub, & ! Input
+ cldn, cldo, cldliqf, &
+ !++ MH_2015/09/07
+ hasAerosol, &
+ CProcessModes, f_c, f_bc, f_aq, f_so4_cond, &
+ f_soa, &
+ cam, f_acm, f_bcm, f_aqm, f_so4_condm, &
+ f_soam, &
+ numberConcentration, volumeConcentration, &
+ hygroscopicity, lnsigma, &
+ !-- MH_2015/09/07
+ nctend_mixnuc, & ! Output
+ !++ MH_2015/04/10
+ factnum )
+ !-- MH_2015/04/10
+ else
+ ! Note difference in arguments lcldn, lcldo
+ cldliqf = 1._r8
+ call dropmixnuc( &
+ state1, ptend_loc, deltatin, pbuf, wsub, & ! Input
+ lcldn, lcldo, cldliqf, &
+ !++ MH_2015/09/07
+ hasAerosol, &
+ CProcessModes, f_c, f_bc, f_aq, f_so4_cond, &
+ f_soa, &
+ cam, f_acm, f_bcm, f_aqm, f_so4_condm, &
+ f_soam, &
+ numberConcentration, volumeConcentration, &
+ hygroscopicity, lnsigma, &
+ !-- MH_2015/09/07
+ nctend_mixnuc, & ! Output
+ !++ MH_2015/04/10
+ factnum )
+ !-- MH_2015/04/10
+ end if
+
+ npccn(:ncol,:) = nctend_mixnuc(:ncol,:)
+
+ else
+
+ ! for bulk aerosol
+
+ ! no tendencies returned from ndrop_bam_run, so just init ptend here
+ call physics_ptend_init(ptend_loc, state1%psetcols, 'none')
+
+ do k = top_lev, pver
+ do i = 1, ncol
+
+ if (state1%q(i,k,cldliq_idx) >= qsmall) then
+
+ ! get droplet activation rate
+
+ call ndrop_bam_run( &
+ wsub(i,k), state1%t(i,k), rho(i,k), naer2(i,k,:), naer_all, &
+ naer_all, maerosol(i,k,:), &
+ dum2)
+ dum = dum2
+ else
+ dum = 0._r8
+ end if
+
+ npccn(i,k) = (dum*lcldm(i,k) - state1%q(i,k,numliq_idx))/deltatin
+ end do
+ end do
+
+ end if
+
+ call physics_ptend_sum(ptend_loc, ptend_all, ncol)
+ call physics_update(state1, ptend_loc, deltatin)
+
+
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! Contact freezing (-40 0.0_r8) then
+ nacon(i,k,3) = wght*num_coarse(i,k)*rho(i,k)
+ else
+ nacon(i,k,3) = 0._r8
+ end if
+
+ !also redefine parameters based on size...
+
+ rndst(i,k,3) = 0.5_r8*dgnumwet(i,k,mode_coarse_dst_idx)
+ if (rndst(i,k,3) <= 0._r8) then
+ rndst(i,k,3) = rn_dst3
+ end if
+
+#endif
+ else
+
+ !For Bulk Aerosols: set equal to aerosol number for dust for bins 2-4 (bin 1=0)
+
+ if (idxdst2 > 0) then
+ nacon(i,k,2) = naer2(i,k,idxdst2)
+ end if
+ if (idxdst3 > 0) then
+ nacon(i,k,3) = naer2(i,k,idxdst3)
+ end if
+ if (idxdst4 > 0) then
+ nacon(i,k,4) = naer2(i,k,idxdst4)
+ end if
+ end if
+
+ end if
+ end do
+ end do
+
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ !bulk aerosol ccn concentration (modal does it in ndrop, from dropmixnuc)
+
+ if (.not. clim_modal_aero) then
+
+ ! ccn concentration as diagnostic
+ call ndrop_bam_ccn(lchnk, ncol, maerosol, naer2)
+
+ deallocate( &
+ naer2, &
+ maerosol)
+
+ end if
+
+ ! heterogeneous freezing
+ if (use_hetfrz_classnuc) then
+
+ call hetfrz_classnuc_oslo_calc(state1, deltatin, factnum, pbuf &
+ ,numberConcentration, volumeConcentration &
+ ,f_acm, f_bcm, f_aqm, f_so4_condm, f_soam &
+ ,hygroscopicity, lnsigma, cam, volumeCore, volumeCoat)
+
+
+ end if
+#ifndef OSLO_AERO
+ if (clim_modal_aero) then
+ deallocate(factnum)
+ end if
+#endif
+
+end subroutine microp_aero_run
+
+!=========================================================================================
+
+end module microp_aero
diff --git a/src/chemistry/oslo_aero/mo_chm_diags.F90 b/src/chemistry/oslo_aero/mo_chm_diags.F90
new file mode 100644
index 0000000000..ab0c663d1d
--- /dev/null
+++ b/src/chemistry/oslo_aero/mo_chm_diags.F90
@@ -0,0 +1,1076 @@
+module mo_chm_diags
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : gas_pcnst
+ use mo_tracname, only : solsym
+ use chem_mods, only : rxntot, nfs, gas_pcnst, indexm, adv_mass
+ use ppgrid, only : pver
+ use mo_constants, only : rgrav, rearth
+ use mo_chem_utls, only : get_rxt_ndx, get_spc_ndx
+ use cam_history, only : fieldname_len
+ use mo_jeuv, only : neuv
+ use gas_wetdep_opts,only : gas_wetdep_method
+
+ implicit none
+ private
+
+ public :: chm_diags_inti
+ public :: chm_diags
+ public :: het_diags
+
+ integer :: id_n,id_no,id_no2,id_no3,id_n2o5,id_hno3,id_ho2no2,id_clono2,id_brono2
+ integer :: id_cl,id_clo,id_hocl,id_cl2,id_cl2o2,id_oclo,id_hcl,id_brcl
+ integer :: id_ccl4,id_cfc11,id_cfc113,id_ch3ccl3,id_cfc12,id_ch3cl,id_hcfc22,id_cf3br,id_cf2clbr
+ integer :: id_cfc114,id_cfc115,id_hcfc141b,id_hcfc142b,id_h1202,id_h2402,id_ch2br2,id_chbr3
+ integer :: id_hf,id_f,id_cof2,id_cofcl,id_ch3br
+ integer :: id_br,id_bro,id_hbr,id_hobr,id_ch4,id_h2o,id_h2
+ integer :: id_o,id_o2,id_h, id_h2o2, id_n2o
+ integer :: id_co2,id_o3,id_oh,id_ho2,id_so4_a1,id_so4_a2,id_so4_a3
+ integer :: id_num_a2,id_num_a3,id_dst_a3,id_ncl_a3
+ integer :: id_ndep,id_nhdep
+
+ integer, parameter :: NJEUV = neuv
+ integer :: rid_jeuv(NJEUV), rid_jno_i, rid_jno
+
+ logical :: has_jeuvs, has_jno_i, has_jno
+
+ integer :: nox_species(3), noy_species(26)
+ integer :: clox_species(6), cloy_species(9), tcly_species(21)
+ integer :: brox_species(4), broy_species(6), tbry_species(13)
+ integer :: foy_species(4), tfy_species(16)
+ integer :: hox_species(4)
+ integer :: toth_species(3)
+ integer :: sox_species(3)
+ integer :: nhx_species(2)
+ integer :: aer_species(gas_pcnst)
+
+ character(len=fieldname_len) :: dtchem_name(gas_pcnst)
+ character(len=fieldname_len) :: depvel_name(gas_pcnst)
+ character(len=fieldname_len) :: depflx_name(gas_pcnst)
+ character(len=fieldname_len) :: wetdep_name(gas_pcnst)
+ character(len=fieldname_len) :: wtrate_name(gas_pcnst)
+#ifdef OSLO_AERO
+ character(len=fieldname_len) :: wetdep_name_area(gas_pcnst)
+#endif
+
+ real(r8), parameter :: N_molwgt = 14.00674_r8
+ real(r8), parameter :: S_molwgt = 32.066_r8
+
+contains
+
+ subroutine chm_diags_inti
+ !--------------------------------------------------------------------
+ ! ... initialize utility routine
+ !--------------------------------------------------------------------
+
+ use cam_history, only : addfld, add_default, horiz_only
+ use constituents, only : cnst_get_ind, cnst_longname
+ use phys_control, only : phys_getopts
+ use mo_drydep, only : has_drydep
+ use species_sums_diags, only : species_sums_init
+#if (defined OSLO_AERO)
+! use aerosoldef, only: getCloudTracerIndexDirect, getCloudTracerName &
+! , N_AEROSOL_TYPES, aerosol_type_name, isAerosol
+ use commondefinitions
+ use aerosoldef, only: getCloudTracerIndexDirect, getCloudTracerName &
+ , isAerosol
+#endif
+ implicit none
+
+ integer :: j, k, m, n
+ character(len=16) :: jname, spc_name, attr
+ character(len=2) :: jchar
+ character(len=2) :: unit_basename ! Units 'kg' or '1'
+
+ integer :: id_pan, id_onit, id_mpan, id_isopno3, id_onitr, id_nh4no3
+ integer :: id_so2, id_so4, id_h2so4
+ integer :: id_nh3, id_nh4
+ integer :: id_honitr
+ integer :: id_alknit
+ integer :: id_isopnita
+ integer :: id_isopnitb
+ integer :: id_isopnooh
+ integer :: id_nc4ch2oh
+ integer :: id_nc4cho
+ integer :: id_noa
+ integer :: id_nterpooh
+ integer :: id_pbznit
+ integer :: id_terpnit
+ integer :: id_dst01, id_dst02, id_dst03, id_dst04, id_sslt01, id_sslt02, id_sslt03, id_sslt04
+ integer :: id_soa, id_oc1, id_oc2, id_cb1, id_cb2
+ integer :: id_soam,id_soai,id_soat,id_soab,id_soax
+ integer :: id_bry, id_cly
+
+ logical :: history_aerosol ! Output the MAM aerosol tendencies
+ logical :: history_chemistry
+ logical :: history_cesm_forcing
+ logical :: history_scwaccm_forcing
+ logical :: history_chemspecies_srf ! output the chemistry constituents species in the surface layer
+ integer :: bulkaero_species(20)
+#ifdef OSLO_AERO
+ integer :: cloudTracerIndex
+ character(len=20) :: cloudTracerName
+#endif
+
+ !-----------------------------------------------------------------------
+
+ call phys_getopts( history_aerosol_out = history_aerosol, &
+ history_chemistry_out = history_chemistry, &
+ history_chemspecies_srf_out = history_chemspecies_srf, &
+ history_cesm_forcing_out = history_cesm_forcing, &
+ history_scwaccm_forcing_out = history_scwaccm_forcing )
+
+ id_bry = get_spc_ndx( 'BRY' )
+ id_cly = get_spc_ndx( 'CLY' )
+
+ id_n = get_spc_ndx( 'N' )
+ id_no = get_spc_ndx( 'NO' )
+ id_no2 = get_spc_ndx( 'NO2' )
+ id_no3 = get_spc_ndx( 'NO3' )
+ id_n2o5 = get_spc_ndx( 'N2O5' )
+ id_n2o = get_spc_ndx( 'N2O' )
+ id_hno3 = get_spc_ndx( 'HNO3' )
+ id_ho2no2 = get_spc_ndx( 'HO2NO2' )
+ id_clono2 = get_spc_ndx( 'CLONO2' )
+ id_brono2 = get_spc_ndx( 'BRONO2' )
+ id_cl = get_spc_ndx( 'CL' )
+ id_clo = get_spc_ndx( 'CLO' )
+ id_hocl = get_spc_ndx( 'HOCL' )
+ id_cl2 = get_spc_ndx( 'CL2' )
+ id_cl2o2 = get_spc_ndx( 'CL2O2' )
+ id_oclo = get_spc_ndx( 'OCLO' )
+ id_hcl = get_spc_ndx( 'HCL' )
+ id_brcl = get_spc_ndx( 'BRCL' )
+
+ id_co2 = get_spc_ndx( 'CO2' )
+ id_o3 = get_spc_ndx( 'O3' )
+ id_oh = get_spc_ndx( 'OH' )
+ id_ho2 = get_spc_ndx( 'HO2' )
+ id_h2o2 = get_spc_ndx( 'H2O2' )
+ id_so4_a1 = get_spc_ndx( 'so4_a1' )
+ id_so4_a2 = get_spc_ndx( 'so4_a2' )
+ id_so4_a3 = get_spc_ndx( 'so4_a3' )
+ id_num_a2 = get_spc_ndx( 'num_a2' )
+ id_num_a3 = get_spc_ndx( 'num_a3' )
+ id_dst_a3 = get_spc_ndx( 'dst_a3' )
+ id_ncl_a3 = get_spc_ndx( 'ncl_a3' )
+
+ id_f = get_spc_ndx( 'F' )
+ id_hf = get_spc_ndx( 'HF' )
+ id_cofcl = get_spc_ndx( 'COFCL' )
+ id_cof2 = get_spc_ndx( 'COF2' )
+
+ id_ccl4 = get_spc_ndx( 'CCL4' )
+ id_cfc11 = get_spc_ndx( 'CFC11' )
+
+ id_cfc113 = get_spc_ndx( 'CFC113' )
+ id_cfc114 = get_spc_ndx( 'CFC114' )
+ id_cfc115 = get_spc_ndx( 'CFC115' )
+
+ id_ch3ccl3 = get_spc_ndx( 'CH3CCL3' )
+ id_cfc12 = get_spc_ndx( 'CFC12' )
+ id_ch3cl = get_spc_ndx( 'CH3CL' )
+
+ id_hcfc22 = get_spc_ndx( 'HCFC22' )
+ id_hcfc141b= get_spc_ndx( 'HCFC141B' )
+ id_hcfc142b= get_spc_ndx( 'HCFC142B' )
+
+ id_cf2clbr = get_spc_ndx( 'CF2CLBR' )
+ id_cf3br = get_spc_ndx( 'CF3BR' )
+ id_ch3br = get_spc_ndx( 'CH3BR' )
+ id_h1202 = get_spc_ndx( 'H1202' )
+ id_h2402 = get_spc_ndx( 'H2402' )
+ id_ch2br2 = get_spc_ndx( 'CH2BR2' )
+ id_chbr3 = get_spc_ndx( 'CHBR3' )
+
+ id_br = get_spc_ndx( 'BR' )
+ id_bro = get_spc_ndx( 'BRO' )
+ id_hbr = get_spc_ndx( 'HBR' )
+ id_hobr = get_spc_ndx( 'HOBR' )
+ id_ch4 = get_spc_ndx( 'CH4' )
+ id_h2o = get_spc_ndx( 'H2O' )
+ id_h2 = get_spc_ndx( 'H2' )
+ id_o = get_spc_ndx( 'O' )
+ id_o2 = get_spc_ndx( 'O2' )
+ id_h = get_spc_ndx( 'H' )
+
+ id_pan = get_spc_ndx( 'PAN' )
+ id_onit = get_spc_ndx( 'ONIT' )
+ id_mpan = get_spc_ndx( 'MPAN' )
+ id_isopno3 = get_spc_ndx( 'ISOPNO3' )
+ id_onitr = get_spc_ndx( 'ONITR' )
+ id_nh4no3 = get_spc_ndx( 'NH4NO3' )
+
+ id_honitr = get_spc_ndx( 'HONITR' )
+ id_alknit = get_spc_ndx( 'ALKNIT' )
+ id_isopnita = get_spc_ndx( 'ISOPNITA' )
+ id_isopnitb = get_spc_ndx( 'ISOPNITB' )
+ id_isopnooh = get_spc_ndx( 'ISOPNOOH' )
+ id_nc4ch2oh = get_spc_ndx( 'NC4CH2OH' )
+ id_nc4cho = get_spc_ndx( 'NC4CHO' )
+ id_noa = get_spc_ndx( 'NOA' )
+ id_nterpooh = get_spc_ndx( 'NTERPOOH' )
+ id_pbznit = get_spc_ndx( 'PBZNIT' )
+ id_terpnit = get_spc_ndx( 'TERPNIT' )
+ id_ndep = get_spc_ndx( 'NDEP' )
+ id_nhdep = get_spc_ndx( 'NHDEP' )
+
+ id_so2 = get_spc_ndx( 'SO2' )
+ id_so4 = get_spc_ndx( 'SO4' )
+ id_h2so4 = get_spc_ndx( 'H2SO4' )
+
+ id_nh3 = get_spc_ndx( 'NH3' )
+ id_nh4 = get_spc_ndx( 'NH4' )
+ id_nh4no3 = get_spc_ndx( 'NH4NO3' )
+
+ id_dst01 = get_spc_ndx( 'DST01' )
+ id_dst02 = get_spc_ndx( 'DST02' )
+ id_dst03 = get_spc_ndx( 'DST03' )
+ id_dst04 = get_spc_ndx( 'DST04' )
+ id_sslt01 = get_spc_ndx( 'SSLT01' )
+ id_sslt02 = get_spc_ndx( 'SSLT02' )
+ id_sslt03 = get_spc_ndx( 'SSLT03' )
+ id_sslt04 = get_spc_ndx( 'SSLT04' )
+ id_soa = get_spc_ndx( 'SOA' )
+ id_so4 = get_spc_ndx( 'SO4' )
+ id_oc1 = get_spc_ndx( 'OC1' )
+ id_oc2 = get_spc_ndx( 'OC2' )
+ id_cb1 = get_spc_ndx( 'CB1' )
+ id_cb2 = get_spc_ndx( 'CB2' )
+
+ rid_jno = get_rxt_ndx( 'jno' )
+ rid_jno_i = get_rxt_ndx( 'jno_i' )
+
+ id_soam = get_spc_ndx( 'SOAM' )
+ id_soai = get_spc_ndx( 'SOAI' )
+ id_soat = get_spc_ndx( 'SOAT' )
+ id_soab = get_spc_ndx( 'SOAB' )
+ id_soax = get_spc_ndx( 'SOAX' )
+
+
+!... NOY species
+ nox_species = (/ id_n, id_no, id_no2 /)
+ noy_species = (/ id_n, id_no, id_no2, id_no3, id_n2o5, id_hno3, id_ho2no2, id_clono2, &
+ id_brono2, id_pan, id_onit, id_mpan, id_isopno3, id_onitr, id_nh4no3, &
+ id_honitr, id_alknit, id_isopnita, id_isopnitb, id_isopnooh, id_nc4ch2oh, &
+ id_nc4cho, id_noa, id_nterpooh, id_pbznit, id_terpnit /)
+!... HOX species
+ hox_species = (/ id_h, id_oh, id_ho2, id_h2o2 /)
+
+!... CLOY species
+ clox_species = (/ id_cl, id_clo, id_hocl, id_cl2, id_cl2o2, id_oclo /)
+ cloy_species = (/ id_cl, id_clo, id_hocl, id_cl2, id_cl2o2, id_oclo, id_hcl, id_clono2, id_brcl /)
+ tcly_species = (/ id_cl, id_clo, id_hocl, id_cl2, id_cl2o2, id_oclo, id_hcl, id_clono2, id_brcl, &
+ id_ccl4, id_cfc11, id_cfc113, id_cfc114, id_cfc115, id_ch3ccl3, id_cfc12, id_ch3cl, &
+ id_hcfc22, id_hcfc141b, id_hcfc142b, id_cf2clbr /)
+
+!... FOY species
+ foy_species = (/ id_F, id_hf, id_cofcl, id_cof2 /)
+ tfy_species = (/ id_f, id_hf, id_cofcl, id_cof2, id_cfc11, id_cfc12, id_cfc113, id_cfc114, id_cfc115, &
+ id_hcfc22, id_hcfc141b, id_hcfc142b, id_cf2clbr, id_cf3br, id_h1202, id_h2402 /)
+
+!... BROY species
+ brox_species = (/ id_br, id_bro, id_brcl, id_hobr /)
+ broy_species = (/ id_br, id_bro, id_hbr, id_brono2, id_brcl, id_hobr /)
+ tbry_species = (/ id_br, id_bro, id_hbr, id_brono2, id_brcl, id_hobr, id_cf2clbr, id_cf3br, id_ch3br, id_h1202, &
+ id_h2402, id_ch2br2, id_chbr3 /)
+
+ sox_species = (/ id_so2, id_so4, id_h2so4 /)
+ nhx_species = (/ id_nh3, id_nh4 /)
+ bulkaero_species(:) = -1
+ bulkaero_species(1:20) = (/ id_dst01, id_dst02, id_dst03, id_dst04, &
+ id_sslt01, id_sslt02, id_sslt03, id_sslt04, &
+ id_soa, id_so4, id_oc1, id_oc2, id_cb1, id_cb2, id_nh4no3, &
+ id_soam,id_soai,id_soat,id_soab,id_soax /)
+
+ aer_species(:) = -1
+ n = 1
+ do m = 1,gas_pcnst
+ k=0
+ if ( any(bulkaero_species(:)==m) ) k=1
+ if ( k==0 ) k = index(trim(solsym(m)), '_a')
+ if ( k==0 ) k = index(trim(solsym(m)), '_c')
+ if ( k>0 ) then ! must be aerosol species
+ aer_species(n) = m
+ n = n+1
+ endif
+ enddo
+
+ toth_species = (/ id_ch4, id_h2o, id_h2 /)
+
+ call addfld( 'NOX', (/ 'lev' /), 'A', 'mol/mol', 'nox (N+NO+NO2)' )
+ call addfld( 'NOY', (/ 'lev' /), 'A', 'mol/mol', &
+ 'noy = total nitrogen (N+NO+NO2+NO3+2N2O5+HNO3+HO2NO2+ORGNOY+NH4NO3' )
+ call addfld( 'NOY_SRF', horiz_only, 'A', 'mol/mol', 'surface noy volume mixing ratio' )
+ call addfld( 'HOX', (/ 'lev' /), 'A', 'mol/mol', 'HOx (H+OH+HO2+2H2O2)' )
+
+ call addfld( 'BROX', (/ 'lev' /), 'A', 'mol/mol', 'brox (Br+BrO+BRCl+HOBr)' )
+ call addfld( 'BROY', (/ 'lev' /), 'A', 'mol/mol', 'total inorganic bromine (Br+BrO+HOBr+BrONO2+HBr+BrCl)' )
+ call addfld( 'TBRY', (/ 'lev' /), 'A', 'mol/mol', 'total Br (ORG+INORG) volume mixing ratio' )
+
+ call addfld( 'CLOX', (/ 'lev' /), 'A', 'mol/mol', 'clox (Cl+CLO+HOCl+2Cl2+2Cl2O2+OClO' )
+ call addfld( 'CLOY', (/ 'lev' /), 'A', 'mol/mol', 'total inorganic chlorine (Cl+ClO+2Cl2+2Cl2O2+OClO+HOCl+ClONO2+HCl+BrCl)' )
+ call addfld( 'TCLY', (/ 'lev' /), 'A', 'mol/mol', 'total Cl (ORG+INORG) volume mixing ratio' )
+
+ call addfld( 'FOY', (/ 'lev' /), 'A', 'mol/mol', 'total inorganic fluorine (F+HF+COFCL+2COF2)' )
+ call addfld( 'TFY', (/ 'lev' /), 'A', 'mol/mol', 'total F (ORG+INORG) volume mixing ratio' )
+
+ call addfld( 'TOTH', (/ 'lev' /), 'A', 'mol/mol', 'total H2 volume mixing ratio' )
+
+ call addfld( 'NOY_mmr', (/ 'lev' /), 'A', 'kg/kg', 'NOy mass mixing ratio' )
+ call addfld( 'SOX_mmr', (/ 'lev' /), 'A', 'kg/kg', 'SOx mass mixing ratio' )
+ call addfld( 'NHX_mmr', (/ 'lev' /), 'A', 'kg/kg', 'NHx mass mixing ratio' )
+
+ do j = 1,NJEUV
+ write( jchar, '(I2)' ) j
+ jname = 'jeuv_'//trim(adjustl(jchar))
+ rid_jeuv(j) = get_rxt_ndx( trim(jname) )
+ enddo
+
+ has_jeuvs = all( rid_jeuv(:) > 0 )
+ has_jno_i = rid_jno_i>0
+ has_jno = rid_jno>0
+
+ if ( has_jeuvs ) then
+ call addfld( 'PION_EUV', (/ 'lev' /), 'I', '/cm^3/s', 'total euv ionization rate' )
+ call addfld( 'PEUV1', (/ 'lev' /), 'I', '/cm^3/s', '(j1+j2+j3)*o' )
+ call addfld( 'PEUV1e', (/ 'lev' /), 'I', '/cm^3/s', '(j14+j15+j16)*o' )
+ call addfld( 'PEUV2', (/ 'lev' /), 'I', '/cm^3/s', 'j4*n' )
+ call addfld( 'PEUV3', (/ 'lev' /), 'I', '/cm^3/s', '(j5+j7+j8+j9)*o2' )
+ call addfld( 'PEUV3e', (/ 'lev' /), 'I', '/cm^3/s', '(j17+j19+j20+j21)*o2' )
+ call addfld( 'PEUV4', (/ 'lev' /), 'I', '/cm^3/s', '(j10+j11)*n2' )
+ call addfld( 'PEUV4e', (/ 'lev' /), 'I', '/cm^3/s', '(j22+j23)*n2' )
+ call addfld( 'PEUVN2D', (/ 'lev' /), 'I', '/cm^3/s', '(j11+j13)*n2' )
+ call addfld( 'PEUVN2De', (/ 'lev' /), 'I', '/cm^3/s', '(j23+j25)*n2' )
+ endif
+ if ( has_jno ) then
+ call addfld( 'PJNO', (/ 'lev' /), 'I', '/cm^3/s', 'jno*no' )
+ endif
+ if ( has_jno_i ) then
+ call addfld( 'PJNO_I', (/ 'lev' /), 'I', '/cm^3/s', 'jno_i*no' )
+ endif
+!
+! CCMI
+!
+ call addfld( 'DO3CHM_TRP', horiz_only, 'A', 'kg/s', 'integrated net tendency from chem in troposphere', &
+ flag_xyfill=.True. )
+ call addfld( 'DO3CHM_LMS', horiz_only, 'A', 'kg/s', 'integrated net tendency from chem in lowermost stratosphere', &
+ flag_xyfill=.True. )
+!
+ do m = 1,gas_pcnst
+
+ spc_name = trim(solsym(m))
+
+ call cnst_get_ind(spc_name, n, abort=.false. )
+ if ( n > 0 ) then
+ attr = cnst_longname(n)
+ elseif ( trim(spc_name) == 'H2O' ) then
+ attr = 'water vapor'
+ else
+ attr = spc_name
+ endif
+
+ depvel_name(m) = 'DV_'//trim(spc_name)
+ depflx_name(m) = 'DF_'//trim(spc_name)
+ dtchem_name(m) = 'D'//trim(spc_name)//'CHM'
+
+ call addfld( depvel_name(m), horiz_only, 'A', 'cm/s', 'deposition velocity ' )
+ call addfld( depflx_name(m), horiz_only, 'A', 'kg/m2/s', 'dry deposition flux ' )
+ call addfld( dtchem_name(m), (/ 'lev' /), 'A', 'kg/s', 'net tendency from chem' )
+
+ if (has_drydep(spc_name).and.history_chemistry) then
+ call add_default( depflx_name(m), 1, ' ' )
+ endif
+
+ if (gas_wetdep_method=='MOZ') then
+ wetdep_name(m) = 'WD_'//trim(spc_name)
+ wtrate_name(m) = 'WDR_'//trim(spc_name)
+
+ call addfld( wetdep_name(m), horiz_only, 'A', 'kg/s', spc_name//' wet deposition' )
+ call addfld( wtrate_name(m), (/ 'lev' /), 'A', '/s', spc_name//' wet deposition rate' )
+ endif
+
+#if defined OSLO_AERO
+ wetdep_name_area(m)='WD_A_'//trim(spc_name)
+ call addfld( wetdep_name_area(m), horiz_only, 'A', 'kg/m2/s ', spc_name//' wet deposition' )
+
+ !Needed for budget term of gases! Aerosols have their own budget terms
+ if(n.gt.0) then
+ if(.NOT. isAerosol(n))then
+ if(history_chemistry)then
+ call add_default( wetdep_name_area(m), 1, ' ')
+ end if
+ endif
+ end if
+#endif
+
+ if (spc_name(1:3) == 'num') then
+ unit_basename = ' 1'
+ else
+ unit_basename = 'kg'
+ endif
+
+!akc6 if ( any( aer_species == m ) ) then
+!akc6! if ( any( aer_species == m ) .or. isAerosol(n) ) then
+!akc6+
+#ifndef OSLO_AERO
+ if ( any( aer_species == m ) ) then
+#else
+ if (n.gt.0) then
+ if ( any( aer_species == m ) .or. isAerosol(n) ) then
+!akc6-
+#endif
+ call addfld( spc_name, (/ 'lev' /), 'A', unit_basename//'/kg ', trim(attr)//' concentration')
+ call addfld( trim(spc_name)//'_SRF', horiz_only, 'A', unit_basename//'/kg', trim(attr)//" in bottom layer")
+ else
+ call addfld( spc_name, (/ 'lev' /), 'A', 'mol/mol', trim(attr)//' concentration')
+ call addfld( trim(spc_name)//'_SRF', horiz_only, 'A', 'mol/mol', trim(attr)//" in bottom layer")
+ endif
+!akc6+
+#ifdef OSLO_AERO
+ else
+ call addfld( spc_name, (/ 'lev' /), 'A', 'mol/mol', trim(attr)//' concentration')
+ call addfld( trim(spc_name)//'_SRF', horiz_only, 'A', 'mol/mol', trim(attr)//" in bottom layer")
+ endif
+#endif
+!akc6-
+ if ((m /= id_cly) .and. (m /= id_bry)) then
+ if (history_aerosol.or.history_chemistry) then
+ call add_default( spc_name, 1, ' ' )
+ endif
+ if (history_chemspecies_srf) then
+ call add_default( trim(spc_name)//'_SRF', 1, ' ' )
+ endif
+ endif
+
+ if ( history_cesm_forcing ) then
+ if (m==id_o3) call add_default( spc_name, 1, ' ')
+ if (m==id_oh) call add_default( spc_name, 1, ' ')
+ if (m==id_no3) call add_default( spc_name, 1, ' ')
+ if (m==id_ho2) call add_default( spc_name, 1, ' ')
+
+ if (m==id_o3) call add_default( spc_name, 8, ' ')
+ if (m==id_so4_a1) call add_default( spc_name, 8, ' ')
+ if (m==id_so4_a2) call add_default( spc_name, 8, ' ')
+ if (m==id_so4_a3) call add_default( spc_name, 8, ' ')
+
+ if (m==id_num_a2) call add_default( spc_name, 8, ' ')
+ if (m==id_num_a3) call add_default( spc_name, 8, ' ')
+ if (m==id_dst_a3) call add_default( spc_name, 8, ' ')
+ if (m==id_ncl_a3) call add_default( spc_name, 8, ' ')
+
+ endif
+ if ( history_scwaccm_forcing ) then
+ if (m==id_co2) call add_default( spc_name, 8, ' ')
+ if (m==id_h) call add_default( spc_name, 8, ' ')
+ if (m==id_no) call add_default( spc_name, 8, ' ')
+ if (m==id_o) call add_default( spc_name, 8, ' ')
+ if (m==id_o2) call add_default( spc_name, 8, ' ')
+ if (m==id_o3) call add_default( spc_name, 8, ' ')
+ if (m==id_h2o) call add_default( spc_name, 1, ' ')
+ if (m==id_ch4 ) call add_default( spc_name, 1, ' ')
+ if (m==id_n2o ) call add_default( spc_name, 1, ' ')
+ if (m==id_cfc11 ) call add_default( spc_name, 1, ' ')
+ if (m==id_cfc12 ) call add_default( spc_name, 1, ' ')
+ endif
+
+#ifdef OSLO_AERO
+ call add_default( spc_name, 1, ' ' )
+#endif
+
+#if defined OSLO_AERO
+ !output 3d-field of aersol tracer in cloud water
+ if(n > 0) then
+ cloudTracerIndex = getCloudTracerIndexDirect(n)
+ if(cloudTracerIndex > 0)then
+ cloudTracerName(1:len(CloudTracerName))=" "
+ cloudTracerName = getCloudTracerName(n)
+ call addfld( trim(cloudTracerName), (/'lev'/), 'A','kg/kg', &
+ trim(cloudTracerName)//' in cloud water')
+ call add_default( trim(cloudTracerName), 1, ' ' )
+
+ !Add column burden of cloud tracers
+ call addfld('cb_'//trim(cloudTracerName),horiz_only, 'A', 'kg/m2', &
+ 'cb_'//trim(cloudTracerName)//' column in cloud water')
+ call add_default('cb_'//trim(cloudTracerName),1,' ')
+ endif
+ !..and column burden in clean air
+ call addfld('cb_'//trim(spc_name),horiz_only, 'A', 'kg/m2', &
+ 'cb_'//trim(spc_name)//' in column')
+ call add_default('cb_'//trim(spc_name),1,' ' )
+
+ if(history_aerosol)then
+ if(cloudTracerIndex > 0)then
+ !Output budget-terms for cloud borne aerosols
+ call add_default (trim(cloudTracerName)//'GVF', 1, ' ')
+ call add_default (trim(cloudTracerName)//'SFWET', 1, ' ')
+ call add_default (trim(cloudTracerName)//'TBF', 1, ' ')
+ call add_default (trim(cloudTracerName)//'DDF', 1, ' ')
+ call add_default (trim(cloudTracerName)//'SFSBS', 1, ' ')
+ call add_default (trim(cloudTracerName)//'SFSIC', 1, ' ')
+ call add_default (trim(cloudTracerName)//'SFSBC', 1, ' ')
+ call add_default (trim(cloudTracerName)//'SFSIS', 1, ' ')
+ endif
+ endif
+ end if
+#endif
+
+ enddo
+
+ call addfld( 'MASS', (/ 'lev' /), 'A', 'kg', 'mass of grid box' )
+ call addfld( 'AREA', horiz_only, 'A', 'm2', 'area of grid box' )
+#ifdef OSLO_AERO
+ do n=1,N_AEROSOL_TYPES
+ call addfld('cb_'//trim(aerosol_type_name(n)),horiz_only, 'A', 'kg/m2',&
+ 'cb_'//trim(aerosol_type_name(n))//' column of aerosol type')
+ call add_default('cb_'//trim(aerosol_type_name(n)), 1, ' ')
+ call addfld('mmr_'//trim(aerosol_type_name(n)),(/'lev'/),'A','kg/kg' ,&
+ 'mmr_'//trim(aerosol_type_name(n))//' mmr of aerosol type')
+ call add_default('mmr_'//trim(aerosol_type_name(n)), 1, ' ')
+ end do
+#endif
+
+ call addfld( 'dry_deposition_NOy_as_N', horiz_only, 'I', 'kg/m2/s', 'NOy dry deposition flux ' )
+ call addfld( 'DF_SOX', horiz_only, 'I', 'kg/m2/s', 'SOx dry deposition flux ' )
+ call addfld( 'dry_deposition_NHx_as_N', horiz_only, 'I', 'kg/m2/s', 'NHx dry deposition flux ' )
+ if (gas_wetdep_method=='NEU') then
+ call addfld( 'wet_deposition_NOy_as_N', horiz_only, 'A', 'kg/m2/s', 'NOy wet deposition' )
+ call addfld( 'wet_deposition_NHx_as_N', horiz_only, 'A', 'kg/m2/s', 'NHx wet deposition' )
+ elseif (gas_wetdep_method=='MOZ') then
+ call addfld( 'wet_deposition_NOy_as_N', horiz_only, 'A', 'kg/s', 'NOy wet deposition' )
+ call addfld( 'WD_SOX', horiz_only, 'A', 'kg/s', 'SOx wet deposition' )
+ call addfld( 'wet_deposition_NHx_as_N', horiz_only, 'A', 'kg/s', 'NHx wet deposition' )
+ endif
+ if ( history_cesm_forcing ) then
+ call add_default('dry_deposition_NOy_as_N', 1, ' ')
+ call add_default('dry_deposition_NHx_as_N', 1, ' ')
+ call add_default('wet_deposition_NOy_as_N', 1, ' ')
+ call add_default('wet_deposition_NHx_as_N', 1, ' ')
+ endif
+
+ call species_sums_init()
+
+ end subroutine chm_diags_inti
+
+ subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depflx, mmr_tend, pdel, pmid, ltrop, &
+ wetdepflx, nhx_nitrogen_flx, noy_nitrogen_flx, pbuf)
+ !--------------------------------------------------------------------
+ ! ... utility routine to output chemistry diagnostic variables
+ !--------------------------------------------------------------------
+
+ use cam_history, only : outfld
+ use phys_grid, only : get_area_all_p
+ use species_sums_diags, only : species_sums_output
+#if (defined OSLO_AERO)
+ use constituents, only : cnst_get_ind
+ use phys_grid, only : pcols
+ use commondefinitions
+ use aerosoldef, only : getCloudTracerIndexDirect, getCloudTracerName &
+ , aerosolType, isAerosol
+ use physics_buffer, only : pbuf_get_field, pbuf_get_index
+ use physics_buffer, only : physics_buffer_desc
+#endif
+!
+! CCMI
+!
+ use cam_history_support, only : fillvalue
+
+ !--------------------------------------------------------------------
+ ! ... dummy arguments
+ !--------------------------------------------------------------------
+ integer, intent(in) :: lchnk
+ integer, intent(in) :: ncol
+ real(r8), intent(in) :: vmr(ncol,pver,gas_pcnst)
+ real(r8), intent(in) :: mmr(ncol,pver,gas_pcnst)
+ real(r8), intent(in) :: rxt_rates(ncol,pver,rxntot)
+ real(r8), intent(in) :: invariants(ncol,pver,max(1,nfs))
+ real(r8), intent(in) :: depvel(ncol, gas_pcnst)
+ real(r8), intent(in) :: depflx(ncol, gas_pcnst)
+ real(r8), intent(in) :: mmr_tend(ncol,pver,gas_pcnst)
+ real(r8), intent(in) :: pdel(ncol,pver)
+ real(r8), intent(in) :: pmid(ncol,pver)
+ integer, intent(in) :: ltrop(ncol)
+ real(r8), intent(in) :: wetdepflx(ncol, gas_pcnst)
+ real(r8), intent(out) :: nhx_nitrogen_flx(ncol) ! kgN/m2/sec
+ real(r8), intent(out) :: noy_nitrogen_flx(ncol) ! kgN/m2/sec
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+#ifdef OSLO_AERO
+ real(r8), dimension(:,:), pointer :: cloudTracerField
+ integer :: cloudTracerIndex
+ character(len=20) :: cloudTracerName
+ real(r8) :: mass_tmp(pcols,pver)
+ real(r8) :: cb(pcols)
+ real(r8) :: cb_aerosol_type(pcols,N_AEROSOL_TYPES) !column burden aerosol types
+ real(r8) :: mmr_aerosol_type(pcols,pver,N_AEROSOL_TYPES) !concentration aerosol types
+#endif
+ !--------------------------------------------------------------------
+ ! ... local variables
+ !--------------------------------------------------------------------
+ integer :: i, k, m, n
+ real(r8) :: wrk(ncol,pver)
+ ! real(r8) :: tmp(ncol,pver)
+ ! real(r8) :: m(ncol,pver)
+ real(r8) :: un2(ncol)
+
+ real(r8), dimension(ncol,pver) :: vmr_nox, vmr_noy, vmr_clox, vmr_cloy, vmr_tcly, vmr_brox, vmr_broy, vmr_toth
+ real(r8), dimension(ncol,pver) :: vmr_tbry, vmr_foy, vmr_tfy
+ real(r8), dimension(ncol,pver) :: mmr_noy, mmr_sox, mmr_nhx, net_chem
+ real(r8), dimension(ncol) :: df_noy, df_sox, df_nhx, do3chm_trp, do3chm_lms
+ real(r8), dimension(ncol) :: wd_noy, wd_nhx
+ real(r8), dimension(ncol,pver) :: vmr_hox
+
+ real(r8) :: area(ncol), mass(ncol,pver)
+ real(r8) :: wgt
+ character(len=16) :: spc_name
+
+
+ !--------------------------------------------------------------------
+ ! ... "diagnostic" groups
+ !--------------------------------------------------------------------
+ vmr_nox(:ncol,:) = 0._r8
+ vmr_noy(:ncol,:) = 0._r8
+ vmr_hox(:ncol,:) = 0._r8
+ vmr_clox(:ncol,:) = 0._r8
+ vmr_cloy(:ncol,:) = 0._r8
+ vmr_tcly(:ncol,:) = 0._r8
+ vmr_brox(:ncol,:) = 0._r8
+ vmr_broy(:ncol,:) = 0._r8
+ vmr_tbry(:ncol,:) = 0._r8
+ vmr_foy(:ncol,:) = 0._r8
+ vmr_tfy(:ncol,:) = 0._r8
+ vmr_toth(:ncol,:) = 0._r8
+ mmr_noy(:ncol,:) = 0._r8
+ mmr_sox(:ncol,:) = 0._r8
+ mmr_nhx(:ncol,:) = 0._r8
+ df_noy(:ncol) = 0._r8
+ df_sox(:ncol) = 0._r8
+ df_nhx(:ncol) = 0._r8
+
+ wd_noy(:ncol) = 0._r8
+ wd_nhx(:ncol) = 0._r8
+
+ call get_area_all_p(lchnk, ncol, area)
+ area = area * rearth**2
+
+ do k = 1,pver
+ mass(:ncol,k) = pdel(:ncol,k) * area(:ncol) * rgrav
+ enddo
+
+ call outfld( 'AREA', area(:ncol), ncol, lchnk )
+ call outfld( 'MASS', mass(:ncol,:), ncol, lchnk )
+
+#ifdef OSLO_AERO
+ cb_aerosol_type(:,:) = 0.0_r8
+ mmr_aerosol_type(:,:,:) = 0.0_r8
+#endif
+ do m = 1,gas_pcnst
+
+ !...FOY (counting Fluorines, not chlorines or bromines)
+ if ( m == id_cfc12 .or. m == id_hcfc22 .or. m == id_cf2clbr .or. m == id_h1202 .or. m == id_hcfc142b &
+ .or. m == id_cof2 ) then
+ wgt = 2._r8
+ elseif ( m == id_cfc113 .or. m == id_cf3br ) then
+ wgt = 3._r8
+ elseif ( m == id_cfc114 .or. m == id_h2402 ) then
+ wgt = 4._r8
+ elseif ( m == id_cfc115 ) then
+ wgt = 5._r8
+ else
+ wgt = 1._r8
+ endif
+ if ( any( foy_species == m ) ) then
+ vmr_foy(:ncol,:) = vmr_foy(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+ if ( any( tfy_species == m ) ) then
+ vmr_tfy(:ncol,:) = vmr_tfy(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+
+!... counting chlorine and bromines, etc... (and total H2 species)
+ if ( m == id_ch4 .or. m == id_n2o5 .or. m == id_cfc12 .or. m == id_cl2 .or. m == id_cl2o2 .or. m==id_h2o2 ) then
+ wgt = 2._r8
+ elseif (m == id_cfc114 .or. m == id_hcfc141b .or. m == id_h1202 .or. m == id_h2402 .or. m == id_ch2br2 ) then
+ wgt = 2._r8
+ elseif ( m == id_cfc11 .or. m == id_cfc113 .or. m == id_ch3ccl3 .or. m == id_chbr3 ) then
+ wgt = 3._r8
+ elseif ( m == id_ccl4 ) then
+ wgt = 4._r8
+ else
+ wgt = 1._r8
+ endif
+!...NOY
+ if ( any( nox_species == m ) ) then
+ vmr_nox(:ncol,:) = vmr_nox(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+ if ( any( noy_species == m ) ) then
+ vmr_noy(:ncol,:) = vmr_noy(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+!...NOY, SOX, NHX
+ if ( any( noy_species == m ) ) then
+ mmr_noy(:ncol,:) = mmr_noy(:ncol,:) + wgt * mmr(:ncol,:,m)
+ endif
+ if ( any( sox_species == m ) ) then
+ mmr_sox(:ncol,:) = mmr_sox(:ncol,:) + wgt * mmr(:ncol,:,m)
+ endif
+ if ( any( nhx_species == m ) ) then
+ mmr_nhx(:ncol,:) = mmr_nhx(:ncol,:) + wgt * mmr(:ncol,:,m)
+ endif
+!...CLOY
+ if ( any( clox_species == m ) ) then
+ vmr_clox(:ncol,:) = vmr_clox(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+ if ( any( cloy_species == m ) ) then
+ vmr_cloy(:ncol,:) = vmr_cloy(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+ if ( any( tcly_species == m ) ) then
+ vmr_tcly(:ncol,:) = vmr_tcly(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+!...BROY
+ if ( any( brox_species == m ) ) then
+ vmr_brox(:ncol,:) = vmr_brox(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+ if ( any( broy_species == m ) ) then
+ vmr_broy(:ncol,:) = vmr_broy(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+ if ( any( tbry_species == m ) ) then
+ vmr_tbry(:ncol,:) = vmr_tbry(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+!...HOY
+ if ( any ( toth_species == m ) ) then
+ vmr_toth(:ncol,:) = vmr_toth(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+!...HOx
+ if ( any( hox_species == m ) ) then
+ vmr_hox(:ncol,:) = vmr_hox(:ncol,:) + wgt * vmr(:ncol,:,m)
+ endif
+
+#if defined OSLO_AERO
+ spc_name = trim(solsym(m))
+ call cnst_get_ind(spc_name, n, abort=.false.)
+#endif
+
+#ifndef OSLO_AERO
+ if ( any( aer_species == m ) ) then
+#else
+ if (n.gt.0) then
+ if ( any( aer_species == m ) .or. isAerosol(n) ) then
+#endif
+ call outfld( solsym(m), mmr(:ncol,:,m), ncol ,lchnk )
+ call outfld( trim(solsym(m))//'_SRF', mmr(:ncol,pver,m), ncol ,lchnk )
+ else
+ call outfld( solsym(m), vmr(:ncol,:,m), ncol ,lchnk )
+ call outfld( trim(solsym(m))//'_SRF', vmr(:ncol,pver,m), ncol ,lchnk )
+ endif
+#ifdef OSLO_AERO
+ else
+ call outfld( solsym(m), vmr(:ncol,:,m), ncol ,lchnk )
+ call outfld( trim(solsym(m))//'_SRF', vmr(:ncol,pver,m), ncol ,lchnk )
+ end if
+#endif
+#if defined OSLO_AERO
+ if(n > 0) then
+ cloudTracerIndex = getCloudTracerIndexDirect(n)
+ if(cloudTracerIndex > 0)then
+ cloudTracerName = getCloudTracerName(n)
+ call pbuf_get_field(pbuf, cloudTracerIndex, cloudTracerField )
+ call outfld ( trim(cloudTracerName),cloudTracerField,pcols,lchnk)
+
+ !Treat column burden (cloud tracer)
+ mass_tmp(:ncol,:) = cloudTracerField(:ncol,:) *pdel(:ncol,:) * rgrav
+ cb(:ncol) = sum(mass_tmp(:ncol,:),2)
+ call outfld(trim('cb_'//trim(cloudTracerName)), cb, pcols, lchnk)
+ endif
+ !Treat column burden (normal tracer)
+ mass_tmp(:ncol,:) = mmr(:ncol,:,m) * pdel(:ncol,:) * rgrav
+ cb(:ncol) = sum(mass_tmp(:ncol,:),2)
+ call outfld(trim('cb_'//trim(spc_name)), cb, pcols, lchnk)
+
+ !Sum column burden per aerosol type
+ if(aerosolType(n) .gt. 0)then
+ cb_aerosol_type(:ncol,aerosolType(n)) = &
+ cb_aerosol_type(:ncol,aerosolType(n)) &
+ + cb(:ncol)
+
+ !Total mass mixing ratio of aerosol type
+ mmr_aerosol_type(:ncol,:,aerosolType(n)) = &
+ mmr_aerosol_type(:ncol,:,aerosolType(n)) &
+ + mmr(:ncol,:,m)
+ endif
+
+ end if !Check if this is a chemistry tracer
+#endif
+
+ call outfld( depvel_name(m), depvel(:ncol,m), ncol ,lchnk )
+ call outfld( depflx_name(m), depflx(:ncol,m), ncol ,lchnk )
+
+ if ( any( noy_species == m ) ) then
+ df_noy(:ncol) = df_noy(:ncol) + wgt * depflx(:ncol,m)*N_molwgt/adv_mass(m)
+ endif
+ if ( any( sox_species == m ) ) then
+ df_sox(:ncol) = df_sox(:ncol) + wgt * depflx(:ncol,m)*S_molwgt/adv_mass(m)
+ endif
+ if ( any( nhx_species == m ) ) then
+ df_nhx(:ncol) = df_nhx(:ncol) + wgt * depflx(:ncol,m)*N_molwgt/adv_mass(m)
+ endif
+
+ if ( any( noy_species == m ) ) then
+ wd_noy(:ncol) = wd_noy(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m)
+ endif
+ if ( any( nhx_species == m ) ) then
+ wd_nhx(:ncol) = wd_nhx(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m)
+ endif
+!
+! add contribution from non-conservation tracers
+!
+ if ( id_ndep == m ) then
+ wd_noy(:ncol) = wd_noy(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m)
+ end if
+ if ( id_nhdep == m ) then
+ wd_nhx(:ncol) = wd_nhx(:ncol) + wgt * wetdepflx(:ncol,m)*N_molwgt/adv_mass(m)
+ end if
+
+ do k=1,pver
+ do i=1,ncol
+ net_chem(i,k) = mmr_tend(i,k,m) * mass(i,k)
+ end do
+ end do
+ call outfld( dtchem_name(m), net_chem(:ncol,:), ncol, lchnk )
+!
+! CCMI
+!
+ if ( trim(dtchem_name(m)) == 'DO3CHM' ) then
+ do3chm_trp(:) = 0._r8
+ do i=1,ncol
+ do k=ltrop(i),pver
+ do3chm_trp(i) = do3chm_trp(i) + net_chem(i,k)
+ end do
+ end do
+ where ( do3chm_trp == 0._r8 )
+ do3chm_trp = fillvalue
+ end where
+ call outfld('DO3CHM_TRP',do3chm_trp(:ncol), ncol, lchnk )
+ do3chm_lms(:) = 0._r8
+ do i=1,ncol
+ do k=1,pver
+ if ( pmid(i,k) > 100.e2_r8 .and. k < ltrop(i) ) then
+ do3chm_lms(i) = do3chm_lms(i) + net_chem(i,k)
+ end if
+ end do
+ end do
+ where ( do3chm_lms == 0._r8 )
+ do3chm_lms = fillvalue
+ end where
+ call outfld('DO3CHM_LMS',do3chm_lms(:ncol), ncol, lchnk )
+ end if
+!
+ enddo
+
+#ifdef OSLO_AERO
+ do n=1,N_AEROSOL_TYPES
+ call outfld("mmr_"//trim(aerosol_type_name(n)), mmr_aerosol_type(:ncol,:,n), ncol,lchnk)
+ call outfld("cb_"//trim(aerosol_type_name(n)), cb_aerosol_type(:ncol,n), ncol,lchnk)
+ enddo
+#endif
+ call outfld( 'NOX', vmr_nox (:ncol,:), ncol, lchnk )
+ call outfld( 'NOY', vmr_noy (:ncol,:), ncol, lchnk )
+ call outfld( 'HOX', vmr_hox (:ncol,:), ncol, lchnk )
+ call outfld( 'NOY_SRF', vmr_noy(:ncol,pver), ncol, lchnk )
+ call outfld( 'CLOX', vmr_clox (:ncol,:), ncol, lchnk )
+ call outfld( 'CLOY', vmr_cloy (:ncol,:), ncol, lchnk )
+ call outfld( 'BROX', vmr_brox (:ncol,:), ncol, lchnk )
+ call outfld( 'BROY', vmr_broy (:ncol,:), ncol, lchnk )
+ call outfld( 'TCLY', vmr_tcly (:ncol,:), ncol, lchnk )
+ call outfld( 'TBRY', vmr_tbry (:ncol,:), ncol, lchnk )
+ call outfld( 'FOY', vmr_foy (:ncol,:), ncol, lchnk )
+ call outfld( 'TFY', vmr_tfy (:ncol,:), ncol, lchnk )
+ call outfld( 'TOTH', vmr_toth (:ncol,:), ncol, lchnk )
+
+ call outfld( 'NOY_mmr', mmr_noy(:ncol,:), ncol ,lchnk )
+ call outfld( 'SOX_mmr', mmr_sox(:ncol,:), ncol ,lchnk )
+ call outfld( 'NHX_mmr', mmr_nhx(:ncol,:), ncol ,lchnk )
+ call outfld( 'dry_deposition_NOy_as_N', df_noy(:ncol), ncol ,lchnk )
+ call outfld( 'DF_SOX', df_sox(:ncol), ncol ,lchnk )
+ call outfld( 'dry_deposition_NHx_as_N', df_nhx(:ncol), ncol ,lchnk )
+ if (gas_wetdep_method=='NEU') then
+ wd_noy(:ncol) = -wd_noy(:ncol) ! downward is possitive
+ wd_nhx(:ncol) = -wd_nhx(:ncol)
+ call outfld( 'wet_deposition_NOy_as_N', wd_noy(:ncol), ncol, lchnk )
+ call outfld( 'wet_deposition_NHx_as_N', wd_nhx(:ncol), ncol, lchnk )
+ end if
+
+ nhx_nitrogen_flx = df_nhx + wd_nhx
+ noy_nitrogen_flx = df_noy + wd_noy
+
+ !--------------------------------------------------------------------
+ ! ... euv ion production
+ !--------------------------------------------------------------------
+
+ jeuvs: if ( has_jeuvs ) then
+ do k = 1,pver
+ un2(:) = 1._r8 - (vmr(:,k,id_o) + vmr(:,k,id_o2) + vmr(:,k,id_h))
+ wrk(:,k) = vmr(:,k,id_o)*(rxt_rates(:,k,rid_jeuv(1)) + rxt_rates(:,k,rid_jeuv(2)) &
+ + rxt_rates(:,k,rid_jeuv(3)) + rxt_rates(:,k,rid_jeuv(14)) &
+ + rxt_rates(:,k,rid_jeuv(15)) + rxt_rates(:,k,rid_jeuv(16))) &
+ + vmr(:,k,id_n)*rxt_rates(:,k,rid_jeuv(4)) &
+ + vmr(:,k,id_o2)*(rxt_rates(:,k,rid_jeuv(5)) + rxt_rates(:,k,rid_jeuv(7)) &
+ + rxt_rates(:,k,rid_jeuv(8)) + rxt_rates(:,k,rid_jeuv(9)) &
+ + rxt_rates(:,k,rid_jeuv(17)) + rxt_rates(:,k,rid_jeuv(19)) &
+ + rxt_rates(:,k,rid_jeuv(20)) + rxt_rates(:,k,rid_jeuv(21))) &
+ + un2(:)*(rxt_rates(:,k,rid_jeuv(6)) + rxt_rates(:,k,rid_jeuv(10)) &
+ + rxt_rates(:,k,rid_jeuv(11)) + rxt_rates(:,k,rid_jeuv(18)) &
+ + rxt_rates(:,k,rid_jeuv(22)) + rxt_rates(:,k,rid_jeuv(23)))
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PION_EUV', wrk, ncol, lchnk )
+
+ do k = 1,pver
+ wrk(:,k) = vmr(:,k,id_o)*(rxt_rates(:,k,rid_jeuv(1)) + rxt_rates(:,k,rid_jeuv(2)) &
+ + rxt_rates(:,k,rid_jeuv(3)))
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PEUV1', wrk, ncol, lchnk )
+ do k = 1,pver
+ wrk(:,k) = vmr(:,k,id_o)*(rxt_rates(:,k,rid_jeuv(14)) + rxt_rates(:,k,rid_jeuv(15)) &
+ + rxt_rates(:,k,rid_jeuv(16)))
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PEUV1e', wrk, ncol, lchnk )
+ do k = 1,pver
+ wrk(:,k) = vmr(:,k,id_n)*rxt_rates(:,k,rid_jeuv(4))
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PEUV2', wrk, ncol, lchnk )
+ do k = 1,pver
+ wrk(:,k) = vmr(:,k,id_o2)*(rxt_rates(:,k,rid_jeuv(5)) + rxt_rates(:,k,rid_jeuv(7)) &
+ + rxt_rates(:,k,rid_jeuv(8)) + rxt_rates(:,k,rid_jeuv(9)))
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PEUV3', wrk, ncol, lchnk )
+ do k = 1,pver
+ wrk(:,k) = vmr(:,k,id_o2)*(rxt_rates(:,k,rid_jeuv(17)) + rxt_rates(:,k,rid_jeuv(19)) &
+ + rxt_rates(:,k,rid_jeuv(20)) + rxt_rates(:,k,rid_jeuv(21)))
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PEUV3e', wrk, ncol, lchnk )
+ do k = 1,pver
+ un2(:) = 1._r8 - (vmr(:,k,id_o) + vmr(:,k,id_o2) + vmr(:,k,id_h))
+ wrk(:,k) = un2(:)*(rxt_rates(:,k,rid_jeuv(6)) + rxt_rates(:,k,rid_jeuv(10)) + rxt_rates(:,k,rid_jeuv(11)))
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PEUV4', wrk, ncol, lchnk )
+ do k = 1,pver
+ un2(:) = 1._r8 - (vmr(:,k,id_o) + vmr(:,k,id_o2) + vmr(:,k,id_h))
+ wrk(:,k) = un2(:)*(rxt_rates(:,k,rid_jeuv(18)) + rxt_rates(:,k,rid_jeuv(22)) + rxt_rates(:,k,rid_jeuv(23)))
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PEUV4e', wrk, ncol, lchnk )
+ do k = 1,pver
+ un2(:) = 1._r8 - (vmr(:,k,id_o) + vmr(:,k,id_o2) + vmr(:,k,id_h))
+ wrk(:,k) = un2(:)*(rxt_rates(:,k,rid_jeuv(11)) + rxt_rates(:,k,rid_jeuv(13)))
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PEUVN2D', wrk, ncol, lchnk )
+ do k = 1,pver
+ un2(:) = 1._r8 - (vmr(:,k,id_o) + vmr(:,k,id_o2) + vmr(:,k,id_h))
+ wrk(:,k) = un2(:)*(rxt_rates(:,k,rid_jeuv(23)) + rxt_rates(:,k,rid_jeuv(25)))
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PEUVN2De', wrk, ncol, lchnk )
+ endif jeuvs
+
+ if ( has_jno_i ) then
+ do k = 1,pver
+ wrk(:,k) = vmr(:,k,id_no)*rxt_rates(:,k,rid_jno_i)
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PJNO_I', wrk, ncol, lchnk )
+ endif
+ if ( has_jno ) then
+ do k = 1,pver
+ wrk(:,k) = vmr(:,k,id_no)*rxt_rates(:,k,rid_jno)
+ wrk(:,k) = wrk(:,k) * invariants(:,k,indexm)
+ end do
+ call outfld( 'PJNO', wrk, ncol, lchnk )
+ endif
+
+ call species_sums_output(vmr, mmr, ncol, lchnk)
+
+ end subroutine chm_diags
+
+ subroutine het_diags( het_rates, mmr, pdel, lchnk, ncol )
+
+ use cam_history, only : outfld
+#ifndef OSLO_AERO
+ use phys_grid, only : get_wght_all_p
+#else
+ use phys_grid, only : get_wght_all_p, get_area_all_p
+#endif
+ implicit none
+
+ integer, intent(in) :: lchnk
+ integer, intent(in) :: ncol
+ real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst))
+ real(r8), intent(in) :: mmr(ncol,pver,gas_pcnst)
+ real(r8), intent(in) :: pdel(ncol,pver)
+
+ real(r8), dimension(ncol) :: noy_wk, sox_wk, nhx_wk, wrk_wd
+#ifdef OSLO_AERO
+ real(r8), dimension(ncol) :: area
+#endif OSLO_AERO
+ integer :: m, k
+ real(r8) :: wght(ncol)
+ !
+ ! output integrated wet deposition field
+ !
+ noy_wk(:) = 0._r8
+ sox_wk(:) = 0._r8
+ nhx_wk(:) = 0._r8
+
+#ifdef OSLO_AERO
+ call get_area_all_p(lchnk, ncol, area)
+ area = area * rearth**2
+#endif OSLO_AERO
+
+ call get_wght_all_p(lchnk, ncol, wght)
+
+ do m = 1,gas_pcnst
+ !
+ ! compute vertical integral
+ !
+ wrk_wd(:ncol) = 0._r8
+ do k = 1,pver
+ wrk_wd(:ncol) = wrk_wd(:ncol) + het_rates(:ncol,k,m) * mmr(:ncol,k,m) * pdel(:ncol,k)
+ end do
+ !
+ wrk_wd(:ncol) = wrk_wd(:ncol) * rgrav * wght(:ncol) * rearth**2
+ !
+ if (gas_wetdep_method=='MOZ') then
+ call outfld( wetdep_name(m), wrk_wd(:ncol), ncol, lchnk )
+#ifdef OSLO_AERO
+ call outfld( wetdep_name_area(m), wrk_wd(:ncol)/area(:ncol) ,ncol, lchnk )
+#endif
+ call outfld( wtrate_name(m), het_rates(:ncol,:,m), ncol, lchnk )
+
+ if ( any(noy_species == m ) ) then
+ noy_wk(:ncol) = noy_wk(:ncol) + wrk_wd(:ncol)*N_molwgt/adv_mass(m)
+ endif
+ if ( m == id_n2o5 ) then ! 2 NOy molecules in N2O5
+ noy_wk(:ncol) = noy_wk(:ncol) + wrk_wd(:ncol)*N_molwgt/adv_mass(m)
+ endif
+ if ( any(sox_species == m ) ) then
+ sox_wk(:ncol) = sox_wk(:ncol) + wrk_wd(:ncol)*S_molwgt/adv_mass(m)
+ endif
+ if ( any(nhx_species == m ) ) then
+ nhx_wk(:ncol) = nhx_wk(:ncol) + wrk_wd(:ncol)*N_molwgt/adv_mass(m)
+ endif
+ endif
+ end do
+ if (gas_wetdep_method=='MOZ') then
+ call outfld( 'wet_deposition_NOy_as_N', noy_wk(:ncol), ncol, lchnk )
+ call outfld( 'WD_SOX', sox_wk(:ncol), ncol, lchnk )
+ call outfld( 'wet_deposition_NHx_as_N', nhx_wk(:ncol), ncol, lchnk )
+ endif
+
+ end subroutine het_diags
+
+end module mo_chm_diags
diff --git a/src/chemistry/oslo_aero/mo_drydep.F90 b/src/chemistry/oslo_aero/mo_drydep.F90
new file mode 100644
index 0000000000..e81f3d66f7
--- /dev/null
+++ b/src/chemistry/oslo_aero/mo_drydep.F90
@@ -0,0 +1,3303 @@
+module mo_drydep
+
+ !---------------------------------------------------------------------
+ ! ... Dry deposition velocity input data and code for netcdf input
+ !---------------------------------------------------------------------
+
+!LKE (10/11/2010): added HCN, CH3CN, HCOOH
+!LKE (7/30/2015): added new TS1 species (phenooh, iepox, noa, etc.)
+
+ use shr_kind_mod, only : r8 => shr_kind_r8, shr_kind_cl
+ use chem_mods, only : gas_pcnst
+ use pmgrid, only : plev, plevp
+ use spmd_utils, only : masterproc, iam
+ use ppgrid, only : pcols, begchunk, endchunk
+ use mo_tracname, only : solsym
+ use cam_abortutils, only : endrun
+ use ioFileMod, only : getfil
+ use pio
+ use cam_pio_utils, only : cam_pio_openfile, cam_pio_closefile
+ use cam_logfile, only : iulog
+ use dyn_grid, only : get_dyn_grid_parm, get_horiz_grid_d
+ use scamMod, only : single_column
+
+ use seq_drydep_mod, only : nddvels => n_drydep, drydep_list, mapping
+ use physconst, only : karman
+
+ implicit none
+
+ save
+
+ interface drydep_inti
+ module procedure dvel_inti_table
+ module procedure dvel_inti_xactive
+ module procedure dvel_inti_fromlnd
+ end interface
+
+ interface drydep
+ module procedure drydep_table
+ module procedure drydep_xactive
+ module procedure drydep_fromlnd
+ end interface
+
+ private
+ public :: drydep_inti, drydep, set_soilw, chk_soilw, has_drydep
+ public :: drydep_update
+ public :: n_land_type, fraction_landuse, drydep_srf_file
+
+ real(r8) :: dels
+ real(r8), allocatable :: days(:) ! day of year for soilw
+ real(r8), allocatable :: dvel(:,:,:,:) ! depvel array interpolated to model grid
+ real(r8), allocatable :: dvel_interp(:,:,:) ! depvel array interpolated to grid and time
+ integer :: last, next ! day indicies
+ integer :: ndays ! # of days in soilw file
+ integer :: map(gas_pcnst) ! indices for drydep species
+ integer :: nspecies ! number of depvel species in input file
+
+ integer :: pan_ndx, mpan_ndx, no2_ndx, hno3_ndx, o3_ndx, &
+ h2o2_ndx, onit_ndx, onitr_ndx, ch4_ndx, ch2o_ndx, &
+ ch3ooh_ndx, pooh_ndx, ch3coooh_ndx, c2h5ooh_ndx, eooh_ndx, &
+ c3h7ooh_ndx, rooh_ndx, ch3cocho_ndx, co_ndx, ch3coch3_ndx, &
+ no_ndx, ho2no2_ndx, glyald_ndx, hyac_ndx, ch3oh_ndx, c2h5oh_ndx, &
+ hydrald_ndx, h2_ndx, Pb_ndx, o3s_ndx, o3inert_ndx, macrooh_ndx, &
+ xooh_ndx, ch3cho_ndx, isopooh_ndx
+ integer :: alkooh_ndx, mekooh_ndx, tolooh_ndx, terpooh_ndx, ch3cooh_ndx
+ integer :: soa_ndx, so4_ndx, cb1_ndx, cb2_ndx, oc1_ndx, oc2_ndx, nh3_ndx, nh4no3_ndx, &
+ sa1_ndx, sa2_ndx, sa3_ndx, sa4_ndx, nh4_ndx
+ integer :: soam_ndx, soai_ndx, soat_ndx, soab_ndx, soax_ndx, &
+ sogm_ndx, sogi_ndx, sogt_ndx, sogb_ndx, sogx_ndx
+
+ logical :: alkooh_dd, mekooh_dd, tolooh_dd, terpooh_dd, ch3cooh_dd
+ logical :: soa_dd, so4_dd, cb1_dd, cb2_dd, oc1_dd, oc2_dd, nh3_dd, nh4no3_dd, &
+ sa1_dd, sa2_dd, sa3_dd, sa4_dd, nh4_dd
+ logical :: soam_dd, soai_dd, soat_dd, soab_dd, soax_dd, &
+ sogm_dd, sogi_dd, sogt_dd, sogb_dd, sogx_dd
+
+ logical :: pan_dd, mpan_dd, no2_dd, hno3_dd, o3_dd, isopooh_dd, ch4_dd,&
+ h2o2_dd, onit_dd, onitr_dd, ch2o_dd, macrooh_dd, xooh_dd, &
+ ch3ooh_dd, pooh_dd, ch3coooh_dd, c2h5ooh_dd, eooh_dd, ch3cho_dd, c2h5oh_dd, &
+ c3h7ooh_dd, rooh_dd, ch3cocho_dd, co_dd, ch3coch3_dd, &
+ glyald_dd, hyac_dd, ch3oh_dd, hydrald_dd, h2_dd, Pb_dd, o3s_dd, o3inert_dd
+
+ integer :: so2_ndx
+ integer :: ch3cn_ndx, hcn_ndx, hcooh_ndx
+ logical :: ch3cn_dd, hcn_dd, hcooh_dd
+
+ integer :: o3a_ndx,xpan_ndx,xmpan_ndx,xno2_ndx,xhno3_ndx,xonit_ndx,xonitr_ndx,xno_ndx,xho2no2_ndx,xnh4no3_ndx
+ logical :: o3a_dd, xpan_dd, xmpan_dd, xno2_dd, xhno3_dd, xonit_dd, xonitr_dd, xno_dd, xho2no2_dd, xnh4no3_dd
+
+!lke-TS1
+ integer :: phenooh_ndx, benzooh_ndx, c6h5ooh_ndx, bzooh_ndx, xylolooh_ndx, xylenooh_ndx
+ integer :: terp2ooh_ndx, terprod1_ndx, terprod2_ndx, hmprop_ndx, mboooh_ndx, hpald_ndx, iepox_ndx
+ integer :: noa_ndx, alknit_ndx, isopnita_ndx, isopnitb_ndx, honitr_ndx, isopnooh_ndx
+ integer :: nc4cho_ndx, nc4ch2oh_ndx, terpnit_ndx, nterpooh_ndx
+ logical :: phenooh_dd, benzooh_dd, c6h5ooh_dd, bzooh_dd, xylolooh_dd, xylenooh_dd
+ logical :: terp2ooh_dd, terprod1_dd, terprod2_dd, hmprop_dd, mboooh_dd, hpald_dd, iepox_dd
+ logical :: noa_dd, alknit_dd, isopnita_dd, isopnitb_dd, honitr_dd, isopnooh_dd
+ logical :: nc4cho_dd, nc4ch2oh_dd, terpnit_dd, nterpooh_dd
+
+ integer :: cohc_ndx=-1, come_ndx=-1
+ integer, parameter :: NTAGS = 50
+ integer :: cotag_ndx(NTAGS)
+ integer :: tag_cnt
+
+ integer :: &
+ o3_tab_ndx = -1, &
+ h2o2_tab_ndx = -1, &
+ ch3ooh_tab_ndx = -1, &
+ co_tab_ndx = -1, &
+ ch3cho_tab_ndx = -1
+ logical :: &
+ o3_in_tab = .false., &
+ h2o2_in_tab = .false., &
+ ch3ooh_in_tab = .false., &
+ co_in_tab = .false., &
+ ch3cho_in_tab = .false.
+
+ real(r8), parameter :: small_value = 1.e-36_r8
+ real(r8), parameter :: large_value = 1.e36_r8
+ real(r8), parameter :: diffm = 1.789e-5_r8
+ real(r8), parameter :: diffk = 1.461e-5_r8
+ real(r8), parameter :: difft = 2.060e-5_r8
+ real(r8), parameter :: vonkar = karman
+ real(r8), parameter :: ric = 0.2_r8
+ real(r8), parameter :: r = 287.04_r8
+ real(r8), parameter :: cp = 1004._r8
+ real(r8), parameter :: grav = 9.81_r8
+ real(r8), parameter :: p00 = 100000._r8
+ real(r8), parameter :: wh2o = 18.0153_r8
+ real(r8), parameter :: ph = 1.e-5_r8
+ real(r8), parameter :: ph_inv = 1._r8/ph
+ real(r8), parameter :: rovcp = r/cp
+
+ integer, pointer :: index_season_lai(:,:)
+
+ logical, public :: has_dvel(gas_pcnst) = .false.
+ integer :: map_dvel(gas_pcnst) = 0
+ real(r8) , allocatable :: soilw_3d(:,:,:)
+
+ logical, parameter :: dyn_soilw = .false.
+
+ real(r8), allocatable :: fraction_landuse(:,:,:)
+ real(r8), allocatable, dimension(:,:,:) :: dep_ra ! [s/m] aerodynamic resistance
+ real(r8), allocatable, dimension(:,:,:) :: dep_rb ! [s/m] resistance across sublayer
+ integer, parameter :: n_land_type = 11
+
+ integer, allocatable :: spc_ndx(:) ! nddvels
+ real(r8), public :: crb
+
+ type lnd_dvel_type
+ real(r8), pointer :: dvel(:,:) ! deposition velocity over land (cm/s)
+ end type lnd_dvel_type
+
+ type(lnd_dvel_type), allocatable :: lnd(:)
+ character(len=SHR_KIND_CL) :: drydep_srf_file
+
+contains
+
+ !---------------------------------------------------------------------------
+ !---------------------------------------------------------------------------
+ subroutine dvel_inti_fromlnd
+ use mo_chem_utls, only : get_spc_ndx
+ use cam_abortutils, only : endrun
+ use chem_mods, only : adv_mass
+ use seq_drydep_mod, only : dfoxd
+
+ implicit none
+
+ integer :: ispc, l
+
+ allocate(spc_ndx(nddvels))
+ allocate( lnd(begchunk:endchunk) )
+
+ do ispc = 1,nddvels
+
+ spc_ndx(ispc) = get_spc_ndx(drydep_list(ispc))
+ if (spc_ndx(ispc) < 1) then
+ write(*,*) 'drydep_inti: '//trim(drydep_list(ispc))//' is not included in species set'
+ call endrun('drydep_init: invalid dry deposition species')
+ endif
+
+ enddo
+
+ crb = (difft/diffm)**(2._r8/3._r8) !.666666_r8
+
+ endsubroutine dvel_inti_fromlnd
+
+ !-------------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------------
+ subroutine drydep_update( state, cam_in )
+ use physics_types, only : physics_state
+ use camsrfexch, only : cam_in_t
+ use seq_drydep_mod, only : drydep_method, DD_XLND
+
+ type(physics_state), intent(in) :: state ! Physics state variables
+ type(cam_in_t), intent(in) :: cam_in
+
+ if (nddvels<1) return
+ if (drydep_method /= DD_XLND) return
+
+ lnd(state%lchnk)%dvel => cam_in%depvel
+
+ end subroutine drydep_update
+
+ !-------------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------------
+ subroutine drydep_fromlnd( ocnfrac, icefrac, ncdate, sfc_temp, pressure_sfc, &
+ wind_speed, spec_hum, air_temp, pressure_10m, rain, &
+ snow, solar_flux, dvelocity, dflx, mmr, &
+ tv, soilw, rh, ncol, lonndx, latndx, lchnk )
+
+ !-------------------------------------------------------------------------------------
+ ! combines the deposition velocities provided by the land model with deposition
+ ! velocities over ocean and sea ice
+ !-------------------------------------------------------------------------------------
+
+ use ppgrid, only : pcols
+ use chem_mods, only : gas_pcnst
+
+#if (defined OFFLINE_DYN)
+ use metdata, only: get_met_fields
+#endif
+
+ implicit none
+
+ !-------------------------------------------------------------------------------------
+ ! ... dummy arguments
+ !-------------------------------------------------------------------------------------
+
+ real(r8), intent(in) :: icefrac(pcols)
+ real(r8), intent(in) :: ocnfrac(pcols)
+
+ integer, intent(in) :: ncol
+ integer, intent(in) :: ncdate ! present date (yyyymmdd)
+ real(r8), intent(in) :: sfc_temp(pcols) ! surface temperature (K)
+ real(r8), intent(in) :: pressure_sfc(pcols) ! surface pressure (Pa)
+ real(r8), intent(in) :: wind_speed(pcols) ! 10 meter wind speed (m/s)
+ real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg)
+ real(r8), intent(in) :: rh(ncol,1) ! relative humidity
+ real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K)
+ real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa)
+ real(r8), intent(in) :: rain(pcols)
+ real(r8), intent(in) :: snow(pcols) ! snow height (m)
+ real(r8), intent(in) :: soilw(pcols) ! soil moisture fraction
+ real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2)
+ real(r8), intent(in) :: tv(pcols) ! potential temperature
+ real(r8), intent(in) :: mmr(pcols,plev,gas_pcnst) ! constituent concentration (kg/kg)
+ real(r8), intent(out) :: dvelocity(ncol,gas_pcnst) ! deposition velocity (cm/s)
+ real(r8), intent(inout) :: dflx(pcols,gas_pcnst) ! deposition flux (/cm^2/s)
+
+ integer, intent(in) :: latndx(pcols) ! chunk latitude indicies
+ integer, intent(in) :: lonndx(pcols) ! chunk longitude indicies
+ integer, intent(in) :: lchnk ! chunk number
+
+ !-------------------------------------------------------------------------------------
+ ! ... local variables
+ !-------------------------------------------------------------------------------------
+ real(r8) :: ocnice_dvel(ncol,gas_pcnst)
+ real(r8) :: ocnice_dflx(pcols,gas_pcnst)
+
+ real(r8), dimension(ncol) :: term ! work array
+ integer :: ispec
+ real(r8) :: lndfrac(pcols)
+#if (defined OFFLINE_DYN)
+ real(r8) :: met_ocnfrac(pcols)
+ real(r8) :: met_icefrac(pcols)
+#endif
+ integer :: i
+
+ lndfrac(:ncol) = 1._r8 - ocnfrac(:ncol) - icefrac(:ncol)
+
+ where( lndfrac(:ncol) < 0._r8 )
+ lndfrac(:ncol) = 0._r8
+ endwhere
+
+#if (defined OFFLINE_DYN)
+ call get_met_fields(lndfrac, met_ocnfrac, met_icefrac, lchnk, ncol)
+#endif
+
+ !-------------------------------------------------------------------------------------
+ ! ... initialize
+ !-------------------------------------------------------------------------------------
+ dvelocity(:,:) = 0._r8
+
+ !-------------------------------------------------------------------------------------
+ ! ... compute the dep velocities over ocean and sea ice
+ ! land type 7 is used for ocean
+ ! land type 8 is used for sea ice
+ !-------------------------------------------------------------------------------------
+ call drydep_xactive( ncdate, sfc_temp, pressure_sfc, &
+ wind_speed, spec_hum, air_temp, pressure_10m, rain, &
+ snow, solar_flux, ocnice_dvel, ocnice_dflx, mmr, &
+ tv, soilw, rh, ncol, lonndx, latndx, lchnk, &
+#if (defined OFFLINE_DYN)
+ ocnfrc=met_ocnfrac,icefrc=met_icefrac, beglandtype=7, endlandtype=8 )
+#else
+ ocnfrc=ocnfrac,icefrc=icefrac, beglandtype=7, endlandtype=8 )
+#endif
+ term(:ncol) = 1.e-2_r8 * pressure_10m(:ncol) / (r*tv(:ncol))
+
+ do ispec = 1,nddvels
+ !-------------------------------------------------------------------------------------
+ ! ... merge the land component with the non-land component
+ ! ocn and ice already have fractions factored in
+ !-------------------------------------------------------------------------------------
+ dvelocity(:ncol,spc_ndx(ispec)) = lnd(lchnk)%dvel(:ncol,ispec)*lndfrac(:ncol) &
+ + ocnice_dvel(:ncol,spc_ndx(ispec))
+ enddo
+
+ !-------------------------------------------------------------------------------------
+ ! ... special adjustments
+ !-------------------------------------------------------------------------------------
+ if( mpan_ndx>0 ) then
+ dvelocity(:ncol,mpan_ndx) = dvelocity(:ncol,mpan_ndx)/3._r8
+ endif
+ if( xmpan_ndx>0 ) then
+ dvelocity(:ncol,xmpan_ndx) = dvelocity(:ncol,xmpan_ndx)/3._r8
+ endif
+ if( hcn_ndx>0 ) then
+ dvelocity(:ncol,hcn_ndx) = ocnice_dvel(:ncol,hcn_ndx) ! should be zero over land
+ endif
+ if( ch3cn_ndx>0 ) then
+ dvelocity(:ncol,ch3cn_ndx) = ocnice_dvel(:ncol,ch3cn_ndx) ! should be zero over land
+ endif
+
+ ! HCOOH, use CH3COOH dep.vel
+ if( hcooh_ndx > 0 .and. ch3cooh_ndx > 0 ) then
+ if( has_dvel(hcooh_ndx) ) then
+ dvelocity(:ncol,hcooh_ndx) = dvelocity(:ncol,ch3cooh_ndx)
+ end if
+ end if
+
+ !-------------------------------------------------------------------------------------
+ ! ... assign CO tags to CO
+ ! put this kludge in for now ...
+ ! -- should be able to set all these via the table mapping in seq_drydep_mod
+ !-------------------------------------------------------------------------------------
+ if( cohc_ndx>0 .and. co_ndx>0 ) then
+ dvelocity(:ncol,cohc_ndx) = dvelocity(:ncol,co_ndx)
+ dflx(:ncol,cohc_ndx) = dvelocity(:ncol,co_ndx) * term(:ncol) * mmr(:ncol,plev,cohc_ndx)
+ endif
+ if( come_ndx>0 .and. co_ndx>0 ) then
+ dvelocity(:ncol,come_ndx) = dvelocity(:ncol,co_ndx)
+ dflx(:ncol,come_ndx) = dvelocity(:ncol,co_ndx) * term(:ncol) * mmr(:ncol,plev,come_ndx)
+ endif
+
+ if ( co_ndx>0 ) then
+ do i=1,tag_cnt
+ dvelocity(:ncol,cotag_ndx(i)) = dvelocity(:ncol,co_ndx)
+ dflx(:ncol,cotag_ndx(i)) = dvelocity(:ncol,co_ndx) * term(:ncol) * mmr(:ncol,plev,cotag_ndx(i))
+ enddo
+ endif
+
+ do ispec = 1,nddvels
+ !-------------------------------------------------------------------------------------
+ ! ... compute the deposition flux
+ !-------------------------------------------------------------------------------------
+ dflx(:ncol,spc_ndx(ispec)) = dvelocity(:ncol,spc_ndx(ispec)) * term(:ncol) * mmr(:ncol,plev,spc_ndx(ispec))
+ end do
+
+ end subroutine drydep_fromlnd
+
+ !---------------------------------------------------------------------------
+ !---------------------------------------------------------------------------
+ subroutine dvel_inti_table( depvel_file )
+ !---------------------------------------------------------------------------
+ ! ... Initialize module, depvel arrays, and a few other variables.
+ ! The depvel fields will be linearly interpolated to the correct time
+ !---------------------------------------------------------------------------
+
+ use mo_constants, only : d2r, r2d
+ use ioFileMod, only : getfil
+ use string_utils, only : to_lower, GLC
+ use mo_chem_utls, only : get_spc_ndx
+ use constituents, only : pcnst
+ use interpolate_data, only : lininterp_init, lininterp, lininterp_finish,interp_type
+ use mo_constants, only : pi
+ use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p
+
+ implicit none
+
+ character(len=*), intent(in) :: depvel_file
+
+ !---------------------------------------------------------------------------
+ ! ... Local variables
+ !---------------------------------------------------------------------------
+ integer :: nlat, nlon, nmonth, ndims
+ integer :: dimid_lat, dimid_lon, dimid_species, dimid_time
+ integer :: dimid(4), count(4), start(4)
+ integer :: m, ispecies, nchar, ierr
+ real(r8) :: scale_factor
+
+ real(r8), allocatable :: dvel_lats(:), dvel_lons(:)
+ real(r8), allocatable :: dvel_in(:,:,:,:) ! input depvel array
+ character(len=50) :: units
+ character(len=20), allocatable :: species_names(:) ! names of depvel species
+ logical :: found
+ type(file_desc_t) :: piofile
+ type(var_desc_t) :: vid, vid_dvel
+
+ character(len=shr_kind_cl) :: locfn
+ integer :: mm,n
+
+ integer :: i, c, ncols
+ real(r8) :: to_lats(pcols), to_lons(pcols)
+ type(interp_type) :: lon_wgts, lat_wgts
+ real(r8), parameter :: zero=0._r8, twopi=2._r8*pi
+
+ mm = 1
+ do m = 1,pcnst
+ if ( len_trim(drydep_list(m))==0 ) exit
+ n = get_spc_ndx(drydep_list(m))
+ if ( n < 1 ) then
+ write(iulog,*) 'drydep_inti: '//drydep_list(m)//' is not included in species set'
+ call endrun('drydep_init: invalid dry deposition species')
+ endif
+ enddo
+
+ if( masterproc ) then
+ write(iulog,*) 'drydep_inti: following species have dry deposition'
+ do i=1,nddvels
+ if( len_trim(drydep_list(i)) > 0 ) then
+ write(iulog,*) 'drydep_inti: '//trim(drydep_list(i))//' is requested to have dry dep'
+ endif
+ enddo
+ write(iulog,*) 'drydep_inti:'
+ endif
+
+ if ( nddvels < 1 ) return
+
+ !---------------------------------------------------------------------------
+ ! ... Setup species maps
+ !---------------------------------------------------------------------------
+ o3a_ndx = get_spc_ndx( 'O3A')
+ xpan_ndx = get_spc_ndx( 'XPAN')
+ xmpan_ndx = get_spc_ndx( 'XMPAN')
+ xno2_ndx = get_spc_ndx( 'XNO2')
+ xhno3_ndx = get_spc_ndx( 'XHNO3')
+ xonit_ndx = get_spc_ndx( 'XONIT')
+ xonitr_ndx = get_spc_ndx( 'XONITR')
+ xno_ndx = get_spc_ndx( 'XNO')
+ xho2no2_ndx = get_spc_ndx( 'XHO2NO2')
+ o3a_dd = has_drydep( 'O3A')
+ xpan_dd = has_drydep( 'XPAN')
+ xmpan_dd = has_drydep( 'XMPAN')
+ xno2_dd = has_drydep( 'XNO2')
+ xhno3_dd = has_drydep( 'XHNO3')
+ xonit_dd = has_drydep( 'XONIT')
+ xonitr_dd = has_drydep( 'XONITR')
+ xno_dd = has_drydep( 'XNO')
+ xho2no2_dd = has_drydep( 'XHO2NO2')
+
+ pan_ndx = get_spc_ndx( 'PAN')
+ mpan_ndx = get_spc_ndx( 'MPAN')
+ no2_ndx = get_spc_ndx( 'NO2')
+ hno3_ndx = get_spc_ndx( 'HNO3')
+ co_ndx = get_spc_ndx( 'CO')
+ o3_ndx = get_spc_ndx( 'O3')
+ if( o3_ndx < 1 ) then
+ o3_ndx = get_spc_ndx( 'OX')
+ end if
+ h2o2_ndx = get_spc_ndx( 'H2O2')
+ onit_ndx = get_spc_ndx( 'ONIT')
+ onitr_ndx = get_spc_ndx( 'ONITR')
+ ch4_ndx = get_spc_ndx( 'CH4')
+ ch2o_ndx = get_spc_ndx( 'CH2O')
+ ch3ooh_ndx = get_spc_ndx( 'CH3OOH')
+ ch3cho_ndx = get_spc_ndx( 'CH3CHO')
+ ch3cocho_ndx = get_spc_ndx( 'CH3COCHO')
+ pooh_ndx = get_spc_ndx( 'POOH')
+ ch3coooh_ndx = get_spc_ndx( 'CH3COOOH')
+ c2h5ooh_ndx = get_spc_ndx( 'C2H5OOH')
+ eooh_ndx = get_spc_ndx( 'EOOH')
+ c3h7ooh_ndx = get_spc_ndx( 'C3H7OOH')
+ rooh_ndx = get_spc_ndx( 'ROOH')
+ ch3coch3_ndx = get_spc_ndx( 'CH3COCH3')
+ no_ndx = get_spc_ndx( 'NO')
+ ho2no2_ndx = get_spc_ndx( 'HO2NO2')
+ glyald_ndx = get_spc_ndx( 'GLYALD')
+ hyac_ndx = get_spc_ndx( 'HYAC')
+ ch3oh_ndx = get_spc_ndx( 'CH3OH')
+ c2h5oh_ndx = get_spc_ndx( 'C2H5OH')
+ macrooh_ndx = get_spc_ndx( 'MACROOH')
+ isopooh_ndx = get_spc_ndx( 'ISOPOOH')
+ xooh_ndx = get_spc_ndx( 'XOOH')
+ hydrald_ndx = get_spc_ndx( 'HYDRALD')
+ h2_ndx = get_spc_ndx( 'H2')
+ Pb_ndx = get_spc_ndx( 'Pb')
+ o3s_ndx = get_spc_ndx( 'O3S')
+ o3inert_ndx = get_spc_ndx( 'O3INERT')
+ alkooh_ndx = get_spc_ndx( 'ALKOOH')
+ mekooh_ndx = get_spc_ndx( 'MEKOOH')
+ tolooh_ndx = get_spc_ndx( 'TOLOOH')
+ terpooh_ndx = get_spc_ndx( 'TERPOOH')
+ ch3cooh_ndx = get_spc_ndx( 'CH3COOH')
+ soam_ndx = get_spc_ndx( 'SOAM' )
+ soai_ndx = get_spc_ndx( 'SOAI' )
+ soat_ndx = get_spc_ndx( 'SOAT' )
+ soab_ndx = get_spc_ndx( 'SOAB' )
+ soax_ndx = get_spc_ndx( 'SOAX' )
+ sogm_ndx = get_spc_ndx( 'SOGM' )
+ sogi_ndx = get_spc_ndx( 'SOGI' )
+ sogt_ndx = get_spc_ndx( 'SOGT' )
+ sogb_ndx = get_spc_ndx( 'SOGB' )
+ sogx_ndx = get_spc_ndx( 'SOGX' )
+ soa_ndx = get_spc_ndx( 'SOA' )
+ so4_ndx = get_spc_ndx( 'SO4' )
+ cb1_ndx = get_spc_ndx( 'CB1' )
+ cb2_ndx = get_spc_ndx( 'CB2' )
+ oc1_ndx = get_spc_ndx( 'OC1' )
+ oc2_ndx = get_spc_ndx( 'OC2' )
+ nh3_ndx = get_spc_ndx( 'NH3' )
+ nh4no3_ndx = get_spc_ndx( 'NH4NO3' )
+ xnh4no3_ndx = get_spc_ndx( 'XNH4NO3' )
+ sa1_ndx = get_spc_ndx( 'SA1' )
+ sa2_ndx = get_spc_ndx( 'SA2' )
+ sa3_ndx = get_spc_ndx( 'SA3' )
+ sa4_ndx = get_spc_ndx( 'SA4' )
+ nh4_ndx = get_spc_ndx( 'NH4' )
+ alkooh_dd = has_drydep( 'ALKOOH')
+ mekooh_dd = has_drydep( 'MEKOOH')
+ tolooh_dd = has_drydep( 'TOLOOH')
+ terpooh_dd = has_drydep( 'TERPOOH')
+ ch3cooh_dd = has_drydep( 'CH3COOH')
+ soam_dd = has_drydep( 'SOAM' )
+ soai_dd = has_drydep( 'SOAI' )
+ soat_dd = has_drydep( 'SOAT' )
+ soab_dd = has_drydep( 'SOAB' )
+ soax_dd = has_drydep( 'SOAX' )
+ sogm_dd = has_drydep( 'SOGM' )
+ sogi_dd = has_drydep( 'SOGI' )
+ sogt_dd = has_drydep( 'SOGT' )
+ sogb_dd = has_drydep( 'SOGB' )
+ sogx_dd = has_drydep( 'SOGX' )
+ soa_dd = has_drydep( 'SOA' )
+ so4_dd = has_drydep( 'SO4' )
+ cb1_dd = has_drydep( 'CB1' )
+ cb2_dd = has_drydep( 'CB2' )
+ oc1_dd = has_drydep( 'OC1' )
+ oc2_dd = has_drydep( 'OC2' )
+ nh3_dd = has_drydep( 'NH3' )
+ nh4no3_dd = has_drydep( 'NH4NO3' )
+ xnh4no3_dd = has_drydep( 'XNH4NO3' )
+ sa1_dd = has_drydep( 'SA1' )
+ sa2_dd = has_drydep( 'SA2' )
+ sa3_dd = has_drydep( 'SA3' )
+ sa4_dd = has_drydep( 'SA4' )
+ nh4_dd = has_drydep( 'NH4' )
+ pan_dd = has_drydep( 'PAN')
+ mpan_dd = has_drydep( 'MPAN')
+ no2_dd = has_drydep( 'NO2')
+ hno3_dd = has_drydep( 'HNO3')
+ co_dd = has_drydep( 'CO')
+ o3_dd = has_drydep( 'O3')
+ if( .not. o3_dd ) then
+ o3_dd = has_drydep( 'OX')
+ end if
+ h2o2_dd = has_drydep( 'H2O2')
+ onit_dd = has_drydep( 'ONIT')
+ onitr_dd = has_drydep( 'ONITR')
+ ch4_dd = has_drydep( 'CH4')
+ ch2o_dd = has_drydep( 'CH2O')
+ ch3ooh_dd = has_drydep( 'CH3OOH')
+ ch3cho_dd = has_drydep( 'CH3CHO')
+ c2h5oh_dd = has_drydep( 'C2H5OH')
+ eooh_dd = has_drydep( 'EOOH')
+ ch3cocho_dd = has_drydep( 'CH3COCHO')
+ pooh_dd = has_drydep( 'POOH')
+ ch3coooh_dd = has_drydep( 'CH3COOOH')
+ c2h5ooh_dd = has_drydep( 'C2H5OOH')
+ c3h7ooh_dd = has_drydep( 'C3H7OOH')
+ rooh_dd = has_drydep( 'ROOH')
+ ch3coch3_dd = has_drydep( 'CH3COCH3')
+ glyald_dd = has_drydep( 'GLYALD')
+ hyac_dd = has_drydep( 'HYAC')
+ ch3oh_dd = has_drydep( 'CH3OH')
+ macrooh_dd = has_drydep( 'MACROOH')
+ isopooh_dd = has_drydep( 'ISOPOOH')
+ xooh_dd = has_drydep( 'XOOH')
+ hydrald_dd = has_drydep( 'HYDRALD')
+ h2_dd = has_drydep( 'H2')
+ Pb_dd = has_drydep( 'Pb')
+ o3s_dd = has_drydep( 'O3S')
+ o3inert_dd = has_drydep( 'O3INERT')
+ ch3cn_dd = has_drydep( 'CH3CN')
+ hcn_dd = has_drydep( 'HCN')
+ hcooh_dd = has_drydep( 'HCOOH')
+ ch3cn_ndx = get_spc_ndx( 'CH3CN')
+ hcn_ndx = get_spc_ndx( 'HCN')
+ hcooh_ndx = get_spc_ndx( 'HCOOH' )
+
+ if( masterproc ) then
+ write(iulog,*) 'dvel_inti: diagnostics'
+ write(iulog,'(10i5)') pan_ndx, mpan_ndx, no2_ndx, hno3_ndx, o3_ndx, &
+ h2o2_ndx, onit_ndx, onitr_ndx, ch4_ndx, ch2o_ndx, &
+ ch3ooh_ndx, pooh_ndx, ch3coooh_ndx, c2h5ooh_ndx, eooh_ndx, &
+ c3h7ooh_ndx, rooh_ndx, ch3cocho_ndx, co_ndx, ch3coch3_ndx, &
+ no_ndx, ho2no2_ndx, glyald_ndx, hyac_ndx, ch3oh_ndx, c2h5oh_ndx, &
+ hydrald_ndx, h2_ndx, Pb_ndx, o3s_ndx, o3inert_ndx, macrooh_ndx, &
+ xooh_ndx, ch3cho_ndx, isopooh_ndx, noa_ndx, alknit_ndx, isopnita_ndx, &
+ honitr_ndx, isopnooh_ndx, nc4cho_ndx, nc4ch2oh_ndx, terpnit_ndx, nterpooh_ndx
+ write(iulog,*) pan_dd, mpan_dd, no2_dd, hno3_dd, o3_dd, isopooh_dd, ch4_dd,&
+ h2o2_dd, onit_dd, onitr_dd, ch2o_dd, macrooh_dd, xooh_dd, &
+ ch3ooh_dd, pooh_dd, ch3coooh_dd, c2h5ooh_dd, eooh_dd, ch3cho_dd, c2h5oh_dd, &
+ c3h7ooh_dd, rooh_dd, ch3cocho_dd, co_dd, ch3coch3_dd, &
+ glyald_dd, hyac_dd, ch3oh_dd, hydrald_dd, h2_dd, Pb_dd, o3s_dd, o3inert_dd, &
+ noa_dd, alknit_dd, isopnita_dd, &
+ honitr_dd, isopnooh_dd, nc4cho_dd, nc4ch2oh_dd, terpnit_dd, nterpooh_dd
+ endif
+ !---------------------------------------------------------------------------
+ ! ... Open NetCDF file
+ !---------------------------------------------------------------------------
+ call getfil (depvel_file, locfn, 0)
+ call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE)
+
+ !---------------------------------------------------------------------------
+ ! ... Get variable ID for dep vel array
+ !---------------------------------------------------------------------------
+ ierr = pio_inq_varid( piofile, 'dvel', vid_dvel )
+
+ !---------------------------------------------------------------------------
+ ! ... Inquire about dimensions
+ !---------------------------------------------------------------------------
+ ierr = pio_inq_dimid( piofile, 'lon', dimid_lon )
+ ierr = pio_inq_dimlen( piofile, dimid_lon, nlon )
+ ierr = pio_inq_dimid( piofile, 'lat', dimid_lat )
+ ierr = pio_inq_dimlen( piofile, dimid_lat, nlat )
+ ierr = pio_inq_dimid( piofile, 'species', dimid_species )
+ ierr = pio_inq_dimlen( piofile, dimid_species, nspecies )
+ ierr = pio_inq_dimid( piofile, 'time', dimid_time )
+ ierr = pio_inq_dimlen( piofile, dimid_time, nmonth )
+ if(masterproc) write(iulog,*) 'dvel_inti: dimensions (nlon,nlat,nspecies,nmonth) = ',nlon,nlat,nspecies,nmonth
+
+ !---------------------------------------------------------------------------
+ ! ... Check dimensions of dvel variable. Must be (lon, lat, species, month).
+ !---------------------------------------------------------------------------
+ ierr = pio_inq_varndims( piofile, vid_dvel, ndims )
+
+ if( masterproc .and. ndims /= 4 ) then
+ write(iulog,*) 'dvel_inti: dvel has ',ndims,' dimensions. Expecting 4.'
+ call endrun
+ end if
+ ierr = pio_inq_vardimid( piofile, vid_dvel, dimid )
+
+ if( dimid(1) /= dimid_lon .or. dimid(2) /= dimid_lat .or. &
+ dimid(3) /= dimid_species .or. dimid(4) /= dimid_time ) then
+ write(iulog,*) 'dvel_inti: Dimensions in wrong order for dvel'
+ write(iulog,*) '... Expecting (lon, lat, species, month)'
+ call endrun
+ end if
+
+ !---------------------------------------------------------------------------
+ ! ... Allocate depvel lats, lons and read
+ !---------------------------------------------------------------------------
+ allocate( dvel_lats(nlat), stat=ierr )
+ if( ierr /= 0 ) then
+ write(iulog,*) 'dvel_inti: Failed to allocate dvel_lats vector'
+ call endrun
+ end if
+ allocate( dvel_lons(nlon), stat=ierr )
+ if( ierr /= 0 ) then
+ write(iulog,*) 'dvel_inti: Failed to allocate dvel_lons vector'
+ call endrun
+ end if
+
+ ierr = pio_inq_varid( piofile, 'lat', vid )
+ ierr = pio_get_var( piofile, vid, dvel_lats )
+ ierr = pio_inq_varid( piofile, 'lon', vid )
+ ierr = pio_get_var( piofile, vid, dvel_lons )
+
+ !---------------------------------------------------------------------------
+ ! ... Set the transform from inputs lats to simulation lats
+ !---------------------------------------------------------------------------
+ dvel_lats(:nlat) = d2r * dvel_lats(:nlat)
+ dvel_lons(:nlon) = d2r * dvel_lons(:nlon)
+
+ !---------------------------------------------------------------------------
+ ! ... Allocate dvel and read data from file
+ !---------------------------------------------------------------------------
+ allocate( dvel_in(nlon, nlat ,nspecies, nmonth), stat=ierr )
+ if( ierr /= 0 ) then
+ write(iulog,*) 'dvel_inti: Failed to allocate dvel_in'
+ call endrun
+ end if
+ start = (/ 1, 1, 1, 1 /)
+ count = (/ nlon, nlat, nspecies, nmonth /)
+
+ ierr = pio_get_var( piofile, vid_dvel, start, count, dvel_in )
+
+
+ !---------------------------------------------------------------------------
+ ! ... Check units of deposition velocity. If necessary, convert to cm/s.
+ !---------------------------------------------------------------------------
+ units(:) = ' '
+ ierr = pio_get_att( piofile, vid_dvel, 'units', units )
+ if( to_lower(trim(units(:GLC(units)))) == 'm/s' ) then
+#ifdef DEBUG
+ if(masterproc) write(iulog,*) 'dvel_inti: depvel units = m/s. Converting to cm/s'
+#endif
+ scale_factor = 100._r8
+ elseif( to_lower(trim(units(:GLC(units)))) == 'cm/s' ) then
+#ifdef DEBUG
+ if(masterproc) write(iulog,*) 'dvel_inti: depvel units = cm/s'
+#endif
+ scale_factor = 1._r8
+ else
+#ifdef DEBUG
+ if(masterproc) then
+ write(iulog,*) 'dvel_inti: Warning! depvel units unknown = ', to_lower(trim(units))
+ write(iulog,*) ' ... proceeding with scale_factor=1'
+ end if
+#endif
+ scale_factor = 1._r8
+ end if
+
+ dvel_in(:,:,:,:) = scale_factor*dvel_in(:,:,:,:)
+
+ !---------------------------------------------------------------------------
+ ! ... Regrid deposition velocities
+ !---------------------------------------------------------------------------
+ allocate( dvel(pcols,begchunk:endchunk,nspecies,nmonth),stat=ierr )
+ if( ierr /= 0 ) then
+ write(iulog,*) 'dvel_inti: Failed to allocate dvel'
+ call endrun
+ end if
+
+ do c=begchunk,endchunk
+ ncols = get_ncols_p(c)
+ call get_rlat_all_p(c, pcols, to_lats)
+ call get_rlon_all_p(c, pcols, to_lons)
+ call lininterp_init(dvel_lons, nlon, to_lons, ncols, 2, lon_wgts, zero, twopi)
+ call lininterp_init(dvel_lats, nlat, to_lats, ncols, 1, lat_wgts)
+
+ do ispecies = 1,nspecies
+ do m = 1,12
+ call lininterp( dvel_in( :,:,ispecies,m ), nlon, nlat, dvel(:,c,ispecies,m), ncols,lon_wgts,lat_wgts)
+ end do
+ end do
+
+ call lininterp_finish(lat_wgts)
+ call lininterp_finish(lon_wgts)
+ end do
+
+ deallocate( dvel_in )
+ deallocate( dvel_lats, dvel_lons )
+
+ !---------------------------------------------------------------------------
+ ! ... Read in species names and determine mapping to tracer numbers
+ !---------------------------------------------------------------------------
+ allocate( species_names(nspecies), stat=ierr )
+ if( ierr /= 0 ) then
+ write(iulog,*) 'dvel_inti: species_names allocation error = ',ierr
+ call endrun
+ end if
+ ierr = pio_inq_varid( piofile, 'species_name', vid )
+ ierr = pio_inq_varndims( piofile, vid, ndims )
+
+ ierr = pio_inq_vardimid( piofile, vid, dimid )
+
+ ierr = pio_inq_dimlen( piofile, dimid(1), nchar )
+ map(:) = 0
+ do ispecies = 1,nspecies
+ start(:2) = (/ 1, ispecies /)
+ count(:2) = (/ nchar, 1 /)
+ species_names(ispecies)(:) = ' '
+ ierr = pio_get_var( piofile, vid, start(1:2), count(1:2), species_names(ispecies:ispecies) )
+ if( species_names(ispecies) == 'O3' ) then
+ o3_in_tab = .true.
+ o3_tab_ndx = ispecies
+ else if( species_names(ispecies) == 'H2O2' ) then
+ h2o2_in_tab = .true.
+ h2o2_tab_ndx = ispecies
+ else if( species_names(ispecies) == 'CH3OOH' ) then
+ ch3ooh_in_tab = .true.
+ ch3ooh_tab_ndx = ispecies
+ else if( species_names(ispecies) == 'CO' ) then
+ co_in_tab = .true.
+ co_tab_ndx = ispecies
+ else if( species_names(ispecies) == 'CH3CHO' ) then
+ ch3cho_in_tab = .true.
+ ch3cho_tab_ndx = ispecies
+ end if
+ found = .false.
+ do m = 1,gas_pcnst
+ if( species_names(ispecies) == solsym(m) .or. &
+ (species_names(ispecies) == 'O3' .and. solsym(m) == 'OX') .or. &
+ (species_names(ispecies) == 'HNO4' .and. solsym(m) == 'HO2NO2') ) then
+ if ( has_drydep( solsym(m) ) ) then
+ map(m) = ispecies
+ found = .true.
+#ifdef DEBUG
+ if( masterproc ) then
+ write(iulog,*) 'dvel_inti: ispecies, m, tracnam = ',ispecies,m,trim(solsym(m))
+ end if
+#endif
+ exit
+ end if
+ end if
+ end do
+ if( .not. found ) then
+ write(iulog,*) 'dvel_inti: Warning! DVEL species ',trim(species_names(ispecies)),' not found'
+ endif
+ end do
+ deallocate( species_names )
+
+ call cam_pio_closefile( piofile )
+
+ !---------------------------------------------------------------------------
+ ! ... Allocate dvel_interp array
+ !---------------------------------------------------------------------------
+ allocate( dvel_interp(pcols,begchunk:endchunk,nspecies),stat=ierr )
+ if( ierr /= 0 ) then
+ write(iulog,*) 'dvel_inti: Failed to allocate dvel_interp; error = ',ierr
+ call endrun
+ end if
+
+ end subroutine dvel_inti_table
+
+ !-------------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------------
+ subroutine interpdvel( calday, ncol, lchnk )
+ !---------------------------------------------------------------------------
+ ! ... Interpolate the fields whose values are required at the
+ ! begining of a timestep.
+ !---------------------------------------------------------------------------
+
+ use time_manager, only : get_calday
+
+ implicit none
+
+ !---------------------------------------------------------------------------
+ ! ... Dummy arguments
+ !---------------------------------------------------------------------------
+ real(r8), intent(in) :: calday ! Interpolate the input data to calday
+ integer, intent(in) :: ncol, lchnk
+
+ !---------------------------------------------------------------------------
+ ! ... Local variables
+ !---------------------------------------------------------------------------
+ integer :: m, last, next
+ integer :: dates(12) = (/ 116, 214, 316, 415, 516, 615, &
+ 716, 816, 915, 1016, 1115, 1216 /)
+ real(r8) :: calday_loc, last_days, next_days
+ real(r8), save :: dys(12)
+ logical, save :: entered = .false.
+
+ if( .not. entered ) then
+ do m = 1,12
+ dys(m) = get_calday( dates(m), 0 )
+ end do
+ entered = .true.
+ end if
+
+ if( calday < dys(1) ) then
+ next = 1
+ last = 12
+ else if( calday >= dys(12) ) then
+ next = 1
+ last = 12
+ else
+ do m = 11,1,-1
+ if( calday >= dys(m) ) then
+ exit
+ end if
+ end do
+ last = m
+ next = m + 1
+ end if
+
+ last_days = dys( last )
+ next_days = dys( next )
+ calday_loc = calday
+
+ if( next_days < last_days ) then
+ next_days = next_days + 365._r8
+ end if
+ if( calday_loc < last_days ) then
+ calday_loc = calday_loc + 365._r8
+ end if
+
+ do m = 1,nspecies
+ call intp2d( last_days, next_days, calday_loc, ncol, lchnk, &
+ dvel(:,lchnk,m,last), &
+ dvel(:,lchnk,m,next), &
+ dvel_interp(:,lchnk,m) )
+ end do
+
+ end subroutine interpdvel
+
+ !-------------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------------
+ subroutine intp2d( t1, t2, tint, ncol, lchnk, f1, f2, fint )
+ !-----------------------------------------------------------------------
+ ! ... Linearly interpolate between f1(t1) and f2(t2) to fint(tint).
+ !-----------------------------------------------------------------------
+
+ implicit none
+
+ !-----------------------------------------------------------------------
+ ! ... Dummy arguments
+ !-----------------------------------------------------------------------
+ real(r8), intent(in) :: &
+ t1, & ! time level of f1
+ t2, & ! time level of f2
+ tint ! interpolant time
+ real(r8), dimension(pcols), intent(in) :: &
+ f1, & ! field at time t1
+ f2 ! field at time t2
+
+ integer, intent(in) :: ncol, lchnk
+
+ real(r8), intent(out) :: &
+ fint(pcols) ! field at time tint
+
+
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ real(r8) :: factor
+
+ factor = (tint - t1)/(t2 - t1)
+
+ fint(:ncol) = f1(:ncol) + (f2(:ncol) - f1(:ncol))*factor
+
+ end subroutine intp2d
+
+ !-------------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------------
+ subroutine drydep_table( calday, tsurf, zen_angle, &
+ depvel, dflx, q, p, &
+ tv, ncol, icefrac, ocnfrac, lchnk )
+ !--------------------------------------------------------
+ ! ... Form the deposition velocities for this
+ ! latitude slice
+ !--------------------------------------------------------
+
+ use physconst, only : rair,pi
+ use dycore, only : dycore_is
+
+ implicit none
+
+ !--------------------------------------------------------
+ ! ... Dummy arguments
+ !--------------------------------------------------------
+ integer, intent(in) :: ncol ! columns in chunk
+ real(r8), intent(in) :: q(pcols,plev,gas_pcnst) ! tracer mmr (kg/kg)
+ real(r8), intent(in) :: p(pcols) ! midpoint pressure in surface layer (Pa)
+ real(r8), intent(in) :: tv(pcols) ! virtual temperature in surface layer (K)
+ real(r8), intent(in) :: calday ! time of year in days
+ real(r8), intent(in) :: tsurf(pcols) ! surface temperature (K)
+ real(r8), intent(in) :: zen_angle(ncol) ! zenith angle (radians)
+ real(r8), intent(inout) :: dflx(pcols,gas_pcnst) ! flux due to dry deposition (kg/m^2/sec)
+ real(r8), intent(out) :: depvel(ncol,gas_pcnst) ! deposition vel (cm/s)
+
+ real(r8), intent(in) :: icefrac(pcols) ! sea-ice areal fraction
+ real(r8), intent(in) :: ocnfrac(pcols) ! ocean areal fraction
+
+ integer, intent(in) :: lchnk
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ integer :: m, i
+ real(r8), dimension(ncol) :: vel, glace, temp_fac, wrk, tmp
+ real(r8), dimension(ncol) :: o3_tab_dvel
+ real(r8), dimension(ncol) :: ocean
+
+ real(r8), parameter :: pid2 = .5_r8 * pi
+
+ if(dycore_is('UNSTRUCTURED')) then
+ call endrun( 'Option not supported for unstructured atmosphere grids ')
+ end if
+
+ !-----------------------------------------------------------------------
+ ! ... Note the factor 1.e-2 in the wrk array calculation is
+ ! to transform the incoming dep vel from cm/s to m/s
+ !-----------------------------------------------------------------------
+ wrk(:ncol) = 1.e-2_r8 * p(:ncol) / (rair * tv(:ncol))
+
+ !--------------------------------------------------------
+ ! ... Initialize all deposition velocities to zero
+ !--------------------------------------------------------
+ depvel(:,:) = 0._r8
+
+ !--------------------------------------------------------
+ ! ... Time interpolate primary depvel array
+ ! (also seaice and npp)
+ !--------------------------------------------------------
+ call interpdvel( calday, ncol, lchnk )
+
+ if( o3_in_tab ) then
+ do i=1,ncol
+ o3_tab_dvel(i) = dvel_interp(i,lchnk,o3_tab_ndx)
+ enddo
+ end if
+
+ !--------------------------------------------------------
+ ! ... Set deposition velocities
+ !--------------------------------------------------------
+ do m = 1,gas_pcnst
+ if( map(m) /= 0 ) then
+ do i = 1,ncol
+ depvel(i,m) = dvel_interp(i,lchnk,map(m))
+ dflx(i,m) = wrk(i) * depvel(i,m) * q(i,plev,m)
+ enddo
+ end if
+ end do
+
+ !--------------------------------------------------------
+ ! ... Set some variables needed for some dvel calculations
+ !--------------------------------------------------------
+ temp_fac(:ncol) = min( 1._r8, max( 0._r8, (tsurf(:ncol) - 268._r8) / 5._r8 ) )
+ ocean(:ncol) = icefrac(:ncol)+ocnfrac(:ncol)
+ glace(:ncol) = icefrac(:ncol) + (1._r8 - ocean(:ncol)) * (1._r8 - temp_fac(:ncol))
+ glace(:ncol) = min( 1._r8,glace(:ncol) )
+
+ !--------------------------------------------------------
+ ! ... Set pan & mpan
+ !--------------------------------------------------------
+ if( o3_in_tab ) then
+ tmp(:ncol) = o3_tab_dvel(:ncol) / 3._r8
+ else
+ tmp(:) = 0._r8
+ end if
+ if( pan_dd ) then
+ if( map(pan_ndx) == 0 ) then
+ depvel(:ncol,pan_ndx) = tmp(:ncol)
+ dflx(:ncol,pan_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,pan_ndx)
+ end if
+ end if
+ if( mpan_dd ) then
+ if( map(mpan_ndx) == 0 ) then
+ depvel(:ncol,mpan_ndx) = tmp(:ncol)
+ dflx(:ncol,mpan_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,mpan_ndx)
+ end if
+ end if
+
+ !--------------------------------------------------------
+ ! ... Set no2 dvel
+ !--------------------------------------------------------
+ if( no2_dd ) then
+ if( map(no2_ndx) == 0 .and. o3_in_tab ) then
+ depvel(:ncol,no2_ndx) = (.6_r8*o3_tab_dvel(:ncol) + .055_r8*ocean(:ncol)) * .9_r8
+ dflx(:ncol,no2_ndx) = wrk(:) * depvel(:ncol,no2_ndx) * q(:ncol,plev,no2_ndx)
+ end if
+ end if
+
+ !--------------------------------------------------------
+ ! ... Set hno3 dvel
+ !--------------------------------------------------------
+ tmp(:ncol) = (2._r8 - ocnfrac(:ncol)) * (1._r8 - glace(:ncol)) + .05_r8 * glace(:ncol)
+ if( hno3_dd ) then
+ if( map(hno3_ndx) == 0 ) then
+ depvel(:ncol,hno3_ndx) = tmp(:ncol)
+ dflx(:ncol,hno3_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hno3_ndx)
+ else
+ tmp(:ncol) = depvel(:ncol,hno3_ndx)
+ end if
+ end if
+ if( onitr_dd ) then
+ if( map(onitr_ndx) == 0 ) then
+ depvel(:ncol,onitr_ndx) = tmp(:ncol)
+ dflx(:ncol,onitr_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,onitr_ndx)
+ end if
+ end if
+ if( isopooh_dd ) then
+ if( map(isopooh_ndx) == 0 ) then
+ depvel(:ncol,isopooh_ndx) = tmp(:ncol)
+ dflx(:ncol,isopooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,isopooh_ndx)
+ end if
+ end if
+
+ !--------------------------------------------------------
+ ! ... Set h2o2 dvel
+ !--------------------------------------------------------
+ if( .not. h2o2_in_tab ) then
+ if( o3_in_tab ) then
+ tmp(:ncol) = .05_r8*glace(:ncol) + ocean(:ncol) - icefrac(:ncol) &
+ + (1._r8 - (glace(:) + ocean(:ncol)) + icefrac(:ncol)) &
+ *max( 1._r8,1._r8/(.5_r8 + 1._r8/(6._r8*o3_tab_dvel(:ncol))) )
+ else
+ tmp(:ncol) = 0._r8
+ end if
+ else
+ do i=1,ncol
+ tmp(i) = dvel_interp(i,lchnk,h2o2_tab_ndx)
+ enddo
+ end if
+ if( h2o2_dd ) then
+ if( map(h2o2_ndx) == 0 ) then
+ depvel(:ncol,h2o2_ndx) = tmp(:ncol)
+ dflx(:ncol,h2o2_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,h2o2_ndx)
+ end if
+ end if
+ !--------------------------------------------------------
+ ! ... Set hcn dvel
+ !--------------------------------------------------------
+ if( hcn_dd ) then
+ if( map(hcn_ndx) == 0 ) then
+ depvel(:ncol,hcn_ndx) = ocnfrac(:ncol)*0.2_r8
+ endif
+ endif
+ !--------------------------------------------------------
+ ! ... Set ch3cn dvel
+ !--------------------------------------------------------
+ if( ch3cn_dd ) then
+ if( map(ch3cn_ndx) == 0 ) then
+ depvel(:,ch3cn_ndx) = ocnfrac(:ncol)*0.2_r8
+ endif
+ endif
+ !--------------------------------------------------------
+ ! ... Set onit
+ !--------------------------------------------------------
+ if( onit_dd ) then
+ if( map(onit_ndx) == 0 ) then
+ depvel(:ncol,onit_ndx) = tmp(:ncol)
+ dflx(:ncol,onit_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,onit_ndx)
+ end if
+ end if
+ if( ch3cocho_dd ) then
+ if( map(ch3cocho_ndx) == 0 ) then
+ depvel(:ncol,ch3cocho_ndx) = tmp(:ncol)
+ dflx(:ncol,ch3cocho_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3cocho_ndx)
+ end if
+ end if
+ if( ch3ooh_in_tab ) then
+ do i=1,ncol
+ tmp(i) = dvel_interp(i,lchnk,ch3ooh_tab_ndx)
+ enddo
+ else
+ tmp(:ncol) = .5_r8 * tmp(:ncol)
+ end if
+ if( ch3ooh_dd ) then
+ if( map(ch3ooh_ndx) == 0 ) then
+ depvel(:ncol,ch3ooh_ndx) = tmp(:ncol)
+ dflx(:ncol,ch3ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3ooh_ndx)
+ end if
+ end if
+ if( pooh_dd ) then
+ if( map(pooh_ndx) == 0 ) then
+ depvel(:ncol,pooh_ndx) = tmp(:ncol)
+ dflx(:ncol,pooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,pooh_ndx)
+ end if
+ end if
+ if( ch3coooh_dd ) then
+ if( map(ch3coooh_ndx) == 0 ) then
+ depvel(:ncol,ch3coooh_ndx) = tmp(:ncol)
+ dflx(:ncol,ch3coooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3coooh_ndx)
+ end if
+ end if
+ if( c2h5ooh_dd ) then
+ if( map(c2h5ooh_ndx) == 0 ) then
+ depvel(:ncol,c2h5ooh_ndx) = tmp(:ncol)
+ dflx(:ncol,c2h5ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c2h5ooh_ndx)
+ end if
+ end if
+ if( c3h7ooh_dd ) then
+ if( map(c3h7ooh_ndx) == 0 ) then
+ depvel(:ncol,c3h7ooh_ndx) = tmp(:ncol)
+ dflx(:ncol,c3h7ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c3h7ooh_ndx)
+ end if
+ end if
+ if( rooh_dd ) then
+ if( map(rooh_ndx) == 0 ) then
+ depvel(:ncol,rooh_ndx) = tmp(:ncol)
+ dflx(:ncol,rooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,rooh_ndx)
+ end if
+ end if
+ if( macrooh_dd ) then
+ if( map(macrooh_ndx) == 0 ) then
+ depvel(:ncol,macrooh_ndx) = tmp(:ncol)
+ dflx(:ncol,macrooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,macrooh_ndx)
+ end if
+ end if
+ if( xooh_dd ) then
+ if( map(xooh_ndx) == 0 ) then
+ depvel(:ncol,xooh_ndx) = tmp(:ncol)
+ dflx(:ncol,xooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,xooh_ndx)
+ end if
+ end if
+ if( ch3oh_dd ) then
+ if( map(ch3oh_ndx) == 0 ) then
+ depvel(:ncol,ch3oh_ndx) = tmp(:ncol)
+ dflx(:ncol,ch3oh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3oh_ndx)
+ end if
+ end if
+ if( c2h5oh_dd ) then
+ if( map(c2h5oh_ndx) == 0 ) then
+ depvel(:ncol,c2h5oh_ndx) = tmp(:ncol)
+ dflx(:ncol,c2h5oh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,c2h5oh_ndx)
+ end if
+ end if
+ if( alkooh_dd ) then
+ if( map(alkooh_ndx) == 0 ) then
+ depvel(:ncol,alkooh_ndx) = tmp(:ncol)
+ dflx(:ncol,alkooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,alkooh_ndx)
+ end if
+ end if
+ if( mekooh_dd ) then
+ if( map(mekooh_ndx) == 0 ) then
+ depvel(:ncol,mekooh_ndx) = tmp(:ncol)
+ dflx(:ncol,mekooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,mekooh_ndx)
+ end if
+ end if
+ if( tolooh_dd ) then
+ if( map(tolooh_ndx) == 0 ) then
+ depvel(:ncol,tolooh_ndx) = tmp(:ncol)
+ dflx(:ncol,tolooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,tolooh_ndx)
+ end if
+ end if
+ if( o3_in_tab ) then
+ tmp(:ncol) = o3_tab_dvel(:ncol)
+ else
+ tmp(:ncol) = 0._r8
+ end if
+ if( ch2o_dd ) then
+ if( map(ch2o_ndx) == 0 ) then
+ depvel(:ncol,ch2o_ndx) = tmp(:ncol)
+ dflx(:ncol,ch2o_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch2o_ndx)
+ end if
+ end if
+
+ if( hydrald_dd ) then
+ if( map(hydrald_ndx) == 0 ) then
+ depvel(:ncol,hydrald_ndx) = tmp(:ncol)
+ dflx(:ncol,hydrald_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hydrald_ndx)
+ end if
+ end if
+ if( ch3cooh_dd ) then
+ if( map(ch3cooh_ndx) == 0 ) then
+ depvel(:ncol,ch3cooh_ndx) = depvel(:ncol,ch2o_ndx)
+ dflx(:ncol,ch3cooh_ndx) = wrk(:ncol) * depvel(:ncol,ch3cooh_ndx) * q(:ncol,plev,ch3cooh_ndx)
+ end if
+ end if
+ if( eooh_dd ) then
+ if( map(eooh_ndx) == 0 ) then
+ depvel(:ncol,eooh_ndx) = depvel(:ncol,ch2o_ndx)
+ dflx(:ncol,eooh_ndx) = wrk(:ncol) * depvel(:ncol,eooh_ndx) * q(:ncol,plev,eooh_ndx)
+ end if
+ end if
+ ! HCOOH - set to CH3COOH
+ if( hcooh_dd ) then
+ if( map(hcooh_ndx) == 0 ) then
+ depvel(:ncol,hcooh_ndx) = depvel(:ncol,ch2o_ndx)
+ dflx(:ncol,hcooh_ndx) = wrk(:ncol) * depvel(:ncol,hcooh_ndx) * q(:ncol,plev,hcooh_ndx)
+ end if
+ end if
+
+ !--------------------------------------------------------
+ ! ... Set co and related species dep vel
+ !--------------------------------------------------------
+ if( co_in_tab ) then
+ do i=1,ncol
+ tmp(i) = dvel_interp(i,lchnk,co_tab_ndx)
+ enddo
+ else
+ tmp(:) = 0._r8
+ end if
+ if( co_dd ) then
+ if( map(co_ndx) == 0 ) then
+ depvel(:ncol,co_ndx) = tmp(:ncol)
+ dflx(:ncol,co_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,co_ndx)
+ end if
+ end if
+ if( ch3coch3_dd ) then
+ if( map(ch3coch3_ndx) == 0 ) then
+ depvel(:ncol,ch3coch3_ndx) = tmp(:ncol)
+ dflx(:ncol,ch3coch3_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,ch3coch3_ndx)
+ end if
+ end if
+ if( hyac_dd ) then
+ if( map(hyac_ndx) == 0 ) then
+ depvel(:ncol,hyac_ndx) = tmp(:ncol)
+ dflx(:ncol,hyac_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,hyac_ndx)
+ end if
+ end if
+ if( h2_dd ) then
+ if( map(h2_ndx) == 0 ) then
+ depvel(:ncol,h2_ndx) = tmp(:ncol) * 1.5_r8 ! Hough(1991)
+ dflx(:ncol,h2_ndx) = wrk(:ncol) * depvel(:ncol,h2_ndx) * q(:ncol,plev,h2_ndx)
+ end if
+ end if
+
+ !--------------------------------------------------------
+ ! ... Set glyald
+ !--------------------------------------------------------
+ if( glyald_dd ) then
+ if( map(glyald_ndx) == 0 ) then
+ if( ch3cho_dd ) then
+ depvel(:ncol,glyald_ndx) = depvel(:ncol,ch3cho_ndx)
+ else if( ch3cho_in_tab ) then
+ do i=1,ncol
+ depvel(i,glyald_ndx) = dvel_interp(i,lchnk,ch3cho_tab_ndx)
+ enddo
+ else
+ depvel(:ncol,glyald_ndx) = 0._r8
+ end if
+ dflx(:ncol,glyald_ndx) = wrk(:ncol) * depvel(:ncol,glyald_ndx) * q(:ncol,plev,glyald_ndx)
+ end if
+ end if
+
+ !--------------------------------------------------------
+ ! ... Lead deposition
+ !--------------------------------------------------------
+ if( Pb_dd ) then
+ if( map(Pb_ndx) == 0 ) then
+ depvel(:ncol,Pb_ndx) = ocean(:ncol) * .05_r8 + (1._r8 - ocean(:ncol)) * .2_r8
+ dflx(:ncol,Pb_ndx) = wrk(:ncol) * depvel(:ncol,Pb_ndx) * q(:ncol,plev,Pb_ndx)
+ end if
+ end if
+
+ !--------------------------------------------------------
+ ! ... diurnal dependence for OX dvel
+ !--------------------------------------------------------
+ if( o3_dd .or. o3s_dd .or. o3inert_dd ) then
+ if( o3_dd .or. o3_in_tab ) then
+ if( o3_dd ) then
+ tmp(:ncol) = max( 1._r8,sqrt( (depvel(:ncol,o3_ndx) - .2_r8)**3/.27_r8 + 4._r8*depvel(:ncol,o3_ndx) + .67_r8 ) )
+ vel(:ncol) = depvel(:ncol,o3_ndx)
+ else if( o3_in_tab ) then
+ tmp(:ncol) = max( 1._r8,sqrt( (o3_tab_dvel(:ncol) - .2_r8)**3/.27_r8 + 4._r8*o3_tab_dvel(:ncol) + .67_r8 ) )
+ vel(:ncol) = o3_tab_dvel(:ncol)
+ end if
+ where( abs( zen_angle(:) ) > pid2 )
+ vel(:) = vel(:) / tmp(:)
+ elsewhere
+ vel(:) = vel(:) * tmp(:)
+ endwhere
+
+ else
+ vel(:ncol) = 0._r8
+ end if
+ if( o3_dd ) then
+ depvel(:ncol,o3_ndx) = vel(:ncol)
+ dflx(:ncol,o3_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3_ndx)
+ end if
+ !--------------------------------------------------------
+ ! ... Set stratospheric O3 deposition
+ !--------------------------------------------------------
+ if( o3s_dd ) then
+ depvel(:ncol,o3s_ndx) = vel(:ncol)
+ dflx(:ncol,o3s_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3s_ndx)
+ end if
+ if( o3inert_dd ) then
+ depvel(:ncol,o3inert_ndx) = vel(:ncol)
+ dflx(:ncol,o3inert_ndx) = wrk(:ncol) * vel(:ncol) * q(:ncol,plev,o3inert_ndx)
+ end if
+ end if
+
+ if( xno2_dd ) then
+ if( map(xno2_ndx) == 0 ) then
+ depvel(:ncol,xno2_ndx) = depvel(:ncol,no2_ndx)
+ dflx(:ncol,xno2_ndx) = wrk(:ncol) * depvel(:ncol,xno2_ndx) * q(:ncol,plev,xno2_ndx)
+ end if
+ endif
+ if( o3a_dd ) then
+ if( map(o3a_ndx) == 0 ) then
+ depvel(:ncol,o3a_ndx) = depvel(:ncol,o3_ndx)
+ dflx(:ncol,o3a_ndx) = wrk(:ncol) * depvel(:ncol,o3a_ndx) * q(:ncol,plev,o3a_ndx)
+ end if
+ endif
+ if( xhno3_dd ) then
+ if( map(xhno3_ndx) == 0 ) then
+ depvel(:ncol,xhno3_ndx) = depvel(:ncol,hno3_ndx)
+ dflx(:ncol,xhno3_ndx) = wrk(:ncol) * depvel(:ncol,xhno3_ndx) * q(:ncol,plev,xhno3_ndx)
+ end if
+ endif
+ if( xnh4no3_dd ) then
+ if( map(xnh4no3_ndx) == 0 ) then
+ depvel(:ncol,xnh4no3_ndx) = depvel(:ncol,nh4no3_ndx)
+ dflx(:ncol,xnh4no3_ndx) = wrk(:ncol) * depvel(:ncol,xnh4no3_ndx) * q(:ncol,plev,xnh4no3_ndx)
+ end if
+ endif
+ if( xpan_dd ) then
+ if( map(xpan_ndx) == 0 ) then
+ depvel(:ncol,xpan_ndx) = depvel(:ncol,pan_ndx)
+ dflx(:ncol,xpan_ndx) = wrk(:ncol) * depvel(:ncol,xpan_ndx) * q(:ncol,plev,xpan_ndx)
+ end if
+ endif
+ if( xmpan_dd ) then
+ if( map(xmpan_ndx) == 0 ) then
+ depvel(:ncol,xmpan_ndx) = depvel(:ncol,mpan_ndx)
+ dflx(:ncol,xmpan_ndx) = wrk(:ncol) * depvel(:ncol,xmpan_ndx) * q(:ncol,plev,xmpan_ndx)
+ end if
+ endif
+ if( xonit_dd ) then
+ if( map(xonit_ndx) == 0 ) then
+ depvel(:ncol,xonit_ndx) = depvel(:ncol,onit_ndx)
+ dflx(:ncol,xonit_ndx) = wrk(:ncol) * depvel(:ncol,xonit_ndx) * q(:ncol,plev,xonit_ndx)
+ end if
+ endif
+ if( xonitr_dd ) then
+ if( map(xonitr_ndx) == 0 ) then
+ depvel(:ncol,xonitr_ndx) = depvel(:ncol,onitr_ndx)
+ dflx(:ncol,xonitr_ndx) = wrk(:ncol) * depvel(:ncol,xonitr_ndx) * q(:ncol,plev,xonitr_ndx)
+ end if
+ endif
+ if( xno_dd ) then
+ if( map(xno_ndx) == 0 ) then
+ depvel(:ncol,xno_ndx) = depvel(:ncol,no_ndx)
+ dflx(:ncol,xno_ndx) = wrk(:ncol) * depvel(:ncol,xno_ndx) * q(:ncol,plev,xno_ndx)
+ end if
+ endif
+ if( xho2no2_dd ) then
+ if( map(xho2no2_ndx) == 0 ) then
+ depvel(:ncol,xho2no2_ndx) = depvel(:ncol,ho2no2_ndx)
+ dflx(:ncol,xho2no2_ndx) = wrk(:ncol) * depvel(:ncol,xho2no2_ndx) * q(:ncol,plev,xho2no2_ndx)
+ end if
+ endif
+ !lke-TS1
+ if( phenooh_dd ) then
+ if( map(phenooh_ndx) == 0 ) then
+ depvel(:ncol,phenooh_ndx) = depvel(:ncol,ch3ooh_ndx)
+ dflx(:ncol,phenooh_ndx) = wrk(:ncol) * depvel(:ncol,phenooh_ndx) * q(:ncol,plev,phenooh_ndx)
+ end if
+ endif
+ if( benzooh_dd ) then
+ if( map(benzooh_ndx) == 0 ) then
+ depvel(:ncol,benzooh_ndx) = depvel(:ncol,ch3ooh_ndx)
+ dflx(:ncol,benzooh_ndx) = wrk(:ncol) * depvel(:ncol,benzooh_ndx) * q(:ncol,plev,benzooh_ndx)
+ end if
+ endif
+ if( c6h5ooh_dd ) then
+ if( map(c6h5ooh_ndx) == 0 ) then
+ depvel(:ncol,c6h5ooh_ndx) = depvel(:ncol,ch3ooh_ndx)
+ dflx(:ncol,c6h5ooh_ndx) = wrk(:ncol) * depvel(:ncol,c6h5ooh_ndx) * q(:ncol,plev,c6h5ooh_ndx)
+ end if
+ endif
+ if( bzooh_dd ) then
+ if( map(bzooh_ndx) == 0 ) then
+ depvel(:ncol,bzooh_ndx) = depvel(:ncol,ch3ooh_ndx)
+ dflx(:ncol,bzooh_ndx) = wrk(:ncol) * depvel(:ncol,bzooh_ndx) * q(:ncol,plev,bzooh_ndx)
+ end if
+ endif
+ if( xylolooh_dd ) then
+ if( map(xylolooh_ndx) == 0 ) then
+ depvel(:ncol,xylolooh_ndx) = depvel(:ncol,ch3ooh_ndx)
+ dflx(:ncol,xylolooh_ndx) = wrk(:ncol) * depvel(:ncol,xylolooh_ndx) * q(:ncol,plev,xylolooh_ndx)
+ end if
+ endif
+ if( xylenooh_dd ) then
+ if( map(xylenooh_ndx) == 0 ) then
+ depvel(:ncol,xylenooh_ndx) = depvel(:ncol,ch3ooh_ndx)
+ dflx(:ncol,xylenooh_ndx) = wrk(:ncol) * depvel(:ncol,xylenooh_ndx) * q(:ncol,plev,xylenooh_ndx)
+ end if
+ endif
+ if( terpooh_dd ) then
+ if( map(terpooh_ndx) == 0 ) then
+ depvel(:ncol,terpooh_ndx) = depvel(:ncol,isopooh_ndx)
+ dflx(:ncol,terpooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,terpooh_ndx)
+ end if
+ end if
+ if( terp2ooh_dd ) then
+ if( map(terp2ooh_ndx) == 0 ) then
+ depvel(:ncol,terp2ooh_ndx) = depvel(:ncol,isopooh_ndx)
+ dflx(:ncol,terp2ooh_ndx) = wrk(:ncol) * tmp(:ncol) * q(:ncol,plev,terp2ooh_ndx)
+ end if
+ end if
+ if( terprod1_dd ) then
+ if( map(terprod1_ndx) == 0 ) then
+ depvel(:ncol,terprod1_ndx) = depvel(:ncol,hyac_ndx)
+ dflx(:ncol,terprod1_ndx) = wrk(:ncol) * depvel(:ncol,terprod1_ndx) * q(:ncol,plev,terprod1_ndx)
+ end if
+ endif
+ if( terprod2_dd ) then
+ if( map(terprod2_ndx) == 0 ) then
+ depvel(:ncol,terprod2_ndx) = depvel(:ncol,hyac_ndx)
+ dflx(:ncol,terprod2_ndx) = wrk(:ncol) * depvel(:ncol,terprod2_ndx) * q(:ncol,plev,terprod2_ndx)
+ end if
+ endif
+ if( hmprop_dd ) then
+ if( map(hmprop_ndx) == 0 ) then
+ depvel(:ncol,hmprop_ndx) = depvel(:ncol,glyald_ndx)
+ dflx(:ncol,hmprop_ndx) = wrk(:ncol) * depvel(:ncol,hmprop_ndx) * q(:ncol,plev,hmprop_ndx)
+ end if
+ endif
+ if( mboooh_dd ) then
+ if( map(mboooh_ndx) == 0 ) then
+ depvel(:ncol,mboooh_ndx) = depvel(:ncol,isopooh_ndx)
+ dflx(:ncol,mboooh_ndx) = wrk(:ncol) * depvel(:ncol,mboooh_ndx) * q(:ncol,plev,mboooh_ndx)
+ end if
+ endif
+ if( hpald_dd ) then
+ if( map(hpald_ndx) == 0 ) then
+ depvel(:ncol,hpald_ndx) = depvel(:ncol,ch3ooh_ndx)
+ dflx(:ncol,hpald_ndx) = wrk(:ncol) * depvel(:ncol,hpald_ndx) * q(:ncol,plev,hpald_ndx)
+ end if
+ endif
+ if( iepox_dd ) then
+ if( map(iepox_ndx) == 0 ) then
+ depvel(:ncol,iepox_ndx) = depvel(:ncol,hyac_ndx)
+ dflx(:ncol,iepox_ndx) = wrk(:ncol) * depvel(:ncol,iepox_ndx) * q(:ncol,plev,iepox_ndx)
+ end if
+ endif
+ if( noa_dd ) then
+ if( map(noa_ndx) == 0 ) then
+ depvel(:ncol,noa_ndx) = depvel(:ncol,h2o2_ndx)
+ dflx(:ncol,noa_ndx) = wrk(:ncol) * depvel(:ncol,noa_ndx) * q(:ncol,plev,noa_ndx)
+ end if
+ endif
+ if( alknit_dd ) then
+ if( map(alknit_ndx) == 0 ) then
+ depvel(:ncol,alknit_ndx) = depvel(:ncol,h2o2_ndx)
+ dflx(:ncol,alknit_ndx) = wrk(:ncol) * depvel(:ncol,alknit_ndx) * q(:ncol,plev,alknit_ndx)
+ end if
+ endif
+ if( isopnita_dd ) then
+ if( map(isopnita_ndx) == 0 ) then
+ depvel(:ncol,isopnita_ndx) = depvel(:ncol,h2o2_ndx)
+ dflx(:ncol,isopnita_ndx) = wrk(:ncol) * depvel(:ncol,isopnita_ndx) * q(:ncol,plev,isopnita_ndx)
+ end if
+ endif
+ if( isopnitb_dd ) then
+ if( map(isopnitb_ndx) == 0 ) then
+ depvel(:ncol,isopnitb_ndx) = depvel(:ncol,h2o2_ndx)
+ dflx(:ncol,isopnitb_ndx) = wrk(:ncol) * depvel(:ncol,isopnitb_ndx) * q(:ncol,plev,isopnitb_ndx)
+ end if
+ endif
+ if( honitr_dd ) then
+ if( map(honitr_ndx) == 0 ) then
+ depvel(:ncol,honitr_ndx) = depvel(:ncol,h2o2_ndx)
+ dflx(:ncol,honitr_ndx) = wrk(:ncol) * depvel(:ncol,honitr_ndx) * q(:ncol,plev,honitr_ndx)
+ end if
+ endif
+ if( isopnooh_dd ) then
+ if( map(isopnooh_ndx) == 0 ) then
+ depvel(:ncol,isopnooh_ndx) = depvel(:ncol,h2o2_ndx)
+ dflx(:ncol,isopnooh_ndx) = wrk(:ncol) * depvel(:ncol,isopnooh_ndx) * q(:ncol,plev,isopnooh_ndx)
+ end if
+ endif
+ if( nc4cho_dd ) then
+ if( map(nc4cho_ndx) == 0 ) then
+ depvel(:ncol,nc4cho_ndx) = depvel(:ncol,h2o2_ndx)
+ dflx(:ncol,nc4cho_ndx) = wrk(:ncol) * depvel(:ncol,nc4cho_ndx) * q(:ncol,plev,nc4cho_ndx)
+ end if
+ endif
+ if( nc4ch2oh_dd ) then
+ if( map(nc4ch2oh_ndx) == 0 ) then
+ depvel(:ncol,nc4ch2oh_ndx) = depvel(:ncol,h2o2_ndx)
+ dflx(:ncol,nc4ch2oh_ndx) = wrk(:ncol) * depvel(:ncol,nc4ch2oh_ndx) * q(:ncol,plev,nc4ch2oh_ndx)
+ end if
+ endif
+ if( terpnit_dd ) then
+ if( map(terpnit_ndx) == 0 ) then
+ depvel(:ncol,terpnit_ndx) = depvel(:ncol,h2o2_ndx)
+ dflx(:ncol,terpnit_ndx) = wrk(:ncol) * depvel(:ncol,terpnit_ndx) * q(:ncol,plev,terpnit_ndx)
+ end if
+ endif
+ if( nterpooh_dd ) then
+ if( map(nterpooh_ndx) == 0 ) then
+ depvel(:ncol,nterpooh_ndx) = depvel(:ncol,h2o2_ndx)
+ dflx(:ncol,nterpooh_ndx) = wrk(:ncol) * depvel(:ncol,nterpooh_ndx) * q(:ncol,plev,nterpooh_ndx)
+ end if
+ endif
+
+
+ end subroutine drydep_table
+
+ !-------------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------------
+ subroutine dvel_inti_xactive( depvel_lnd_file, clim_soilw_file, season_wes_file )
+ !-------------------------------------------------------------------------------------
+ ! ... intialize interactive drydep
+ !-------------------------------------------------------------------------------------
+ use dycore, only : dycore_is
+ use mo_constants, only : r2d
+ use chem_mods, only : adv_mass
+ use mo_chem_utls, only : get_spc_ndx
+ use seq_drydep_mod,only : drydep_method, DD_XATM, DD_XLND
+ use phys_control, only : phys_getopts
+
+ implicit none
+
+ !-------------------------------------------------------------------------------------
+ ! ... dummy arguments
+ !-------------------------------------------------------------------------------------
+ character(len=*), intent(in) :: depvel_lnd_file, clim_soilw_file, season_wes_file
+
+ !-------------------------------------------------------------------------------------
+ ! ... local variables
+ !-------------------------------------------------------------------------------------
+ integer :: i, j, ii, jj, jl, ju
+ integer :: nlon_veg, nlat_veg, npft_veg
+ integer :: nlat_lai, npft_lai, pos_min, imin
+ integer :: dimid
+ integer :: m, n, l, id
+ integer :: length1, astat
+ integer, allocatable :: wk_lai(:,:,:)
+ integer, allocatable :: index_season_lai_j(:,:)
+ integer :: k, num_max, k_max
+ integer :: num_seas(5)
+ integer :: plon, plat
+ integer :: ierr, ndx
+
+ real(r8) :: spc_mass
+ real(r8) :: diff_min, target_lat
+ real(r8), allocatable :: vegetation_map(:,:,:)
+ real(r8), pointer :: soilw_map(:,:,:)
+ real(r8), allocatable :: work(:,:)
+ real(r8), allocatable :: landmask(:,:)
+ real(r8), allocatable :: urban(:,:)
+ real(r8), allocatable :: lake(:,:)
+ real(r8), allocatable :: wetland(:,:)
+ real(r8), allocatable :: lon_veg(:)
+ real(r8), allocatable :: lon_veg_edge(:)
+ real(r8), allocatable :: lat_veg(:)
+ real(r8), allocatable :: lat_veg_edge(:)
+ real(r8), allocatable :: lat_lai(:)
+ real(r8), allocatable :: clat(:)
+ character(len=32) :: test_name
+ character(len=4) :: tag_name
+ type(file_desc_t) :: piofile
+ type(var_desc_t) :: vid
+ logical :: do_soilw
+
+ character(len=shr_kind_cl) :: locfn
+ logical :: prog_modal_aero
+
+ ! determine if modal aerosols are active so that fraction_landuse array is initialized for modal aerosal dry dep
+ call phys_getopts(prog_modal_aero_out=prog_modal_aero)
+#ifdef OSLO_AERO
+ prog_modal_aero = .TRUE.
+#endif
+
+ call dvel_inti_fromlnd()
+
+ if( masterproc ) then
+ write(iulog,*) 'drydep_inti: following species have dry deposition'
+ do i=1,nddvels
+ if( len_trim(drydep_list(i)) > 0 ) then
+ write(iulog,*) 'drydep_inti: '//trim(drydep_list(i))//' is requested to have dry dep'
+ endif
+ enddo
+ write(iulog,*) 'drydep_inti:'
+ endif
+
+ !-------------------------------------------------------------------------------------
+ ! ... get species indices
+ !-------------------------------------------------------------------------------------
+ xpan_ndx = get_spc_ndx( 'XPAN' )
+ xmpan_ndx = get_spc_ndx( 'XMPAN' )
+ o3a_ndx = get_spc_ndx( 'O3A' )
+
+ ch4_ndx = get_spc_ndx( 'CH4' )
+ h2_ndx = get_spc_ndx( 'H2' )
+ co_ndx = get_spc_ndx( 'CO' )
+ Pb_ndx = get_spc_ndx( 'Pb' )
+ pan_ndx = get_spc_ndx( 'PAN' )
+ mpan_ndx = get_spc_ndx( 'MPAN' )
+ o3_ndx = get_spc_ndx( 'OX' )
+ if( o3_ndx < 0 ) then
+ o3_ndx = get_spc_ndx( 'O3' )
+ end if
+ so2_ndx = get_spc_ndx( 'SO2' )
+ alkooh_ndx = get_spc_ndx( 'ALKOOH')
+ mekooh_ndx = get_spc_ndx( 'MEKOOH')
+ tolooh_ndx = get_spc_ndx( 'TOLOOH')
+ terpooh_ndx = get_spc_ndx( 'TERPOOH')
+ ch3cooh_ndx = get_spc_ndx( 'CH3COOH')
+ soa_ndx = get_spc_ndx( 'SOA' )
+ so4_ndx = get_spc_ndx( 'SO4' )
+ cb1_ndx = get_spc_ndx( 'CB1' )
+ cb2_ndx = get_spc_ndx( 'CB2' )
+ oc1_ndx = get_spc_ndx( 'OC1' )
+ oc2_ndx = get_spc_ndx( 'OC2' )
+ nh3_ndx = get_spc_ndx( 'NH3' )
+ nh4no3_ndx = get_spc_ndx( 'NH4NO3' )
+ sa1_ndx = get_spc_ndx( 'SA1' )
+ sa2_ndx = get_spc_ndx( 'SA2' )
+ sa3_ndx = get_spc_ndx( 'SA3' )
+ sa4_ndx = get_spc_ndx( 'SA4' )
+ nh4_ndx = get_spc_ndx( 'NH4' )
+ alkooh_dd = has_drydep( 'ALKOOH')
+ mekooh_dd = has_drydep( 'MEKOOH')
+ tolooh_dd = has_drydep( 'TOLOOH')
+ terpooh_dd = has_drydep( 'TERPOOH')
+ ch3cooh_dd = has_drydep( 'CH3COOH')
+ soa_dd = has_drydep( 'SOA' )
+ so4_dd = has_drydep( 'SO4' )
+ cb1_dd = has_drydep( 'CB1' )
+ cb2_dd = has_drydep( 'CB2' )
+ oc1_dd = has_drydep( 'OC1' )
+ oc2_dd = has_drydep( 'OC2' )
+ nh3_dd = has_drydep( 'NH3' )
+ nh4no3_dd = has_drydep( 'NH4NO3' )
+ sa1_dd = has_drydep( 'SA1' )
+ sa2_dd = has_drydep( 'SA2' )
+ sa3_dd = has_drydep( 'SA3' )
+ sa4_dd = has_drydep( 'SA4' )
+ nh4_dd = has_drydep( 'NH4' )
+!
+ soam_ndx = get_spc_ndx( 'SOAM' )
+ soai_ndx = get_spc_ndx( 'SOAI' )
+ soat_ndx = get_spc_ndx( 'SOAT' )
+ soab_ndx = get_spc_ndx( 'SOAB' )
+ soax_ndx = get_spc_ndx( 'SOAX' )
+ sogm_ndx = get_spc_ndx( 'SOGM' )
+ sogi_ndx = get_spc_ndx( 'SOGI' )
+ sogt_ndx = get_spc_ndx( 'SOGT' )
+ sogb_ndx = get_spc_ndx( 'SOGB' )
+ sogx_ndx = get_spc_ndx( 'SOGX' )
+ soam_dd = has_drydep ( 'SOAM' )
+ soai_dd = has_drydep ( 'SOAI' )
+ soat_dd = has_drydep ( 'SOAT' )
+ soab_dd = has_drydep ( 'SOAB' )
+ soax_dd = has_drydep ( 'SOAX' )
+ sogm_dd = has_drydep ( 'SOGM' )
+ sogi_dd = has_drydep ( 'SOGI' )
+ sogt_dd = has_drydep ( 'SOGT' )
+ sogb_dd = has_drydep ( 'SOGB' )
+ sogx_dd = has_drydep ( 'SOGX' )
+!
+ hcn_ndx = get_spc_ndx( 'HCN')
+ ch3cn_ndx = get_spc_ndx( 'CH3CN')
+
+!lke-TS1
+ phenooh_ndx = get_spc_ndx( 'PHENOOH')
+ benzooh_ndx = get_spc_ndx( 'BENZOOH')
+ c6h5ooh_ndx = get_spc_ndx( 'C6H5OOH')
+ bzooh_ndx = get_spc_ndx( 'BZOOH')
+ xylolooh_ndx = get_spc_ndx( 'XYLOLOOH')
+ xylenooh_ndx = get_spc_ndx( 'XYLENOOH')
+ terp2ooh_ndx = get_spc_ndx( 'TERP2OOH')
+ terprod1_ndx = get_spc_ndx( 'TERPROD1')
+ terprod2_ndx = get_spc_ndx( 'TERPROD2')
+ hmprop_ndx = get_spc_ndx( 'HMPROP')
+ mboooh_ndx = get_spc_ndx( 'MBOOOH')
+ hpald_ndx = get_spc_ndx( 'HPALD')
+ iepox_ndx = get_spc_ndx( 'IEPOX')
+ noa_ndx = get_spc_ndx( 'NOA')
+ alknit_ndx = get_spc_ndx( 'ALKNIT')
+ isopnita_ndx = get_spc_ndx( 'ISOPNITA')
+ isopnitb_ndx = get_spc_ndx( 'ISOPNITB')
+ honitr_ndx = get_spc_ndx( 'HONITR')
+ isopnooh_ndx = get_spc_ndx( 'ISOPNOOH')
+ nc4cho_ndx = get_spc_ndx( 'NC4CHO')
+ nc4ch2oh_ndx = get_spc_ndx( 'NC4CH2OH')
+ terpnit_ndx = get_spc_ndx( 'TERPNIT')
+ nterpooh_ndx = get_spc_ndx( 'NTERPOOH')
+ phenooh_dd = has_drydep( 'PHENOOH')
+ benzooh_dd = has_drydep( 'BENZOOH')
+ c6h5ooh_dd = has_drydep( 'C6H5OOH')
+ bzooh_dd = has_drydep( 'BZOOH')
+ xylolooh_dd = has_drydep( 'XYLOLOOH')
+ xylenooh_dd = has_drydep( 'XYLENOOH')
+ terp2ooh_dd = has_drydep( 'TERP2OOH')
+ terprod1_dd = has_drydep( 'TERPROD1')
+ terprod2_dd = has_drydep( 'TERPROD2')
+ hmprop_dd = has_drydep( 'HMPROP')
+ mboooh_dd = has_drydep( 'MBOOOH')
+ hpald_dd = has_drydep( 'HPALD')
+ iepox_dd = has_drydep( 'IEPOX')
+ noa_dd = has_drydep( 'NOA')
+ alknit_dd = has_drydep( 'ALKNIT')
+ isopnita_dd = has_drydep( 'ISOPNITA')
+ isopnitb_dd = has_drydep( 'ISOPNITB')
+ honitr_dd = has_drydep( 'HONITR')
+ isopnooh_dd = has_drydep( 'ISOPNOOH')
+ nc4cho_dd = has_drydep( 'NC4CHO')
+ nc4ch2oh_dd = has_drydep( 'NC4CH2OH')
+ terpnit_dd = has_drydep( 'TERPNIT')
+ nterpooh_dd = has_drydep( 'NTERPOOH')
+!
+ cohc_ndx = get_spc_ndx( 'COhc' )
+ come_ndx = get_spc_ndx( 'COme' )
+
+ tag_cnt=0
+ cotag_ndx(:)=-1
+ do i = 1,NTAGS
+ write(tag_name,'(a2,i2.2)') 'CO',i
+ ndx = get_spc_ndx(tag_name)
+ if (ndx>0) then
+ tag_cnt = tag_cnt+1
+ cotag_ndx(tag_cnt) = ndx
+ endif
+ enddo
+
+ o3s_ndx = get_spc_ndx( 'O3S' )
+
+ do i=1,nddvels
+ if ( mapping(i) > 0 ) then
+ test_name = drydep_list(i)
+ m = get_spc_ndx( test_name )
+ has_dvel(m) = .true.
+ map_dvel(m) = i
+ endif
+ enddo
+
+ if( all( .not. has_dvel(:) ) ) then
+ return
+ end if
+
+ !---------------------------------------------------------------------------
+ ! ... allocate module variables
+ !---------------------------------------------------------------------------
+ allocate( dep_ra(pcols,n_land_type,begchunk:endchunk),stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'dvel_inti: failed to allocate dep_ra; error = ',astat
+ call endrun
+ end if
+ allocate( dep_rb(pcols,n_land_type,begchunk:endchunk),stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'dvel_inti: failed to allocate dep_rb; error = ',astat
+ call endrun
+ end if
+
+ if (drydep_method == DD_XLND .and. (.not.prog_modal_aero)) then
+ return
+ endif
+
+ do_soilw = .not. dyn_soilw .and. (has_drydep( 'H2' ) .or. has_drydep( 'CO' ))
+ allocate( fraction_landuse(pcols,n_land_type, begchunk:endchunk),stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'dvel_inti: failed to allocate fraction_landuse; error = ',astat
+ call endrun
+ end if
+ if(do_soilw) then
+ allocate(soilw_3d(pcols,12,begchunk:endchunk),stat=astat)
+ if( astat /= 0 ) then
+ write(iulog,*) 'dvel_inti: failed to allocate soilw_3d error = ',astat
+ call endrun
+ end if
+ end if
+
+ plon = get_dyn_grid_parm('plon')
+ plat = get_dyn_grid_parm('plat')
+ allocate( index_season_lai_j(n_land_type,12),stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'dvel_inti: failed to allocate index_season_lai_j; error = ',astat
+ call endrun
+ end if
+ if(dycore_is('UNSTRUCTURED') ) then
+ call get_landuse_and_soilw_from_file(do_soilw)
+ allocate( index_season_lai(plon,12),stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'dvel_inti: failed to allocate index_season_lai; error = ',astat
+ call endrun
+ end if
+ else
+ allocate( index_season_lai(plat,12),stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'dvel_inti: failed to allocate index_season_lai; error = ',astat
+ call endrun
+ end if
+ !---------------------------------------------------------------------------
+ ! ... read landuse map
+ !---------------------------------------------------------------------------
+ call getfil (depvel_lnd_file, locfn, 0)
+ call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE)
+ !---------------------------------------------------------------------------
+ ! ... get the dimensions
+ !---------------------------------------------------------------------------
+ ierr = pio_inq_dimid( piofile, 'lon', dimid )
+ ierr = pio_inq_dimlen( piofile, dimid, nlon_veg )
+ ierr = pio_inq_dimid( piofile, 'lat', dimid )
+ ierr = pio_inq_dimlen( piofile, dimid, nlat_veg )
+ ierr = pio_inq_dimid( piofile, 'pft', dimid )
+ ierr = pio_inq_dimlen( piofile, dimid, npft_veg )
+ !---------------------------------------------------------------------------
+ ! ... allocate arrays
+ !---------------------------------------------------------------------------
+ allocate( vegetation_map(nlon_veg,nlat_veg,npft_veg), work(nlon_veg,nlat_veg), stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat
+ call endrun
+ end if
+ allocate( urban(nlon_veg,nlat_veg), lake(nlon_veg,nlat_veg), &
+ landmask(nlon_veg,nlat_veg), wetland(nlon_veg,nlat_veg), stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat
+ call endrun
+ end if
+ allocate( lon_veg(nlon_veg), lat_veg(nlat_veg), &
+ lon_veg_edge(nlon_veg+1), lat_veg_edge(nlat_veg+1), stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'dvel_inti: failed to allocate vegation lon, lat arrays; error = ',astat
+ call endrun
+ end if
+ !---------------------------------------------------------------------------
+ ! ... read the vegetation map and landmask
+ !---------------------------------------------------------------------------
+ ierr = pio_inq_varid( piofile, 'PCT_PFT', vid )
+ ierr = pio_get_var( piofile, vid, vegetation_map )
+
+ ierr = pio_inq_varid( piofile, 'LANDMASK', vid )
+ ierr = pio_get_var( piofile, vid, landmask )
+
+ ierr = pio_inq_varid( piofile, 'PCT_URBAN', vid )
+ ierr = pio_get_var( piofile, vid, urban )
+
+ ierr = pio_inq_varid( piofile, 'PCT_LAKE', vid )
+ ierr = pio_get_var( piofile, vid, lake )
+
+ ierr = pio_inq_varid( piofile, 'PCT_WETLAND', vid )
+ ierr = pio_get_var( piofile, vid, wetland )
+
+ call cam_pio_closefile( piofile )
+
+ !---------------------------------------------------------------------------
+ ! scale vegetation, urban, lake, and wetland to fraction
+ !---------------------------------------------------------------------------
+ vegetation_map(:,:,:) = .01_r8 * vegetation_map(:,:,:)
+ wetland(:,:) = .01_r8 * wetland(:,:)
+ lake(:,:) = .01_r8 * lake(:,:)
+ urban(:,:) = .01_r8 * urban(:,:)
+#ifdef DEBUG
+ if(masterproc) then
+ write(iulog,*) 'minmax vegetation_map ',minval(vegetation_map),maxval(vegetation_map)
+ write(iulog,*) 'minmax wetland ',minval(wetland),maxval(wetland)
+ write(iulog,*) 'minmax landmask ',minval(landmask),maxval(landmask)
+ end if
+#endif
+ !---------------------------------------------------------------------------
+ ! ... define lat-lon of vegetation map (1x1)
+ !---------------------------------------------------------------------------
+ lat_veg(:) = (/ (-89.5_r8 + (i-1),i=1,nlat_veg ) /)
+ lon_veg(:) = (/ ( 0.5_r8 + (i-1),i=1,nlon_veg ) /)
+ lat_veg_edge(:) = (/ (-90.0_r8 + (i-1),i=1,nlat_veg+1) /)
+ lon_veg_edge(:) = (/ ( 0.0_r8 + (i-1),i=1,nlon_veg+1) /)
+ !---------------------------------------------------------------------------
+ ! ... read soilw table if necessary
+ !---------------------------------------------------------------------------
+
+ if( do_soilw ) then
+ call soilw_inti( clim_soilw_file, nlon_veg, nlat_veg, soilw_map )
+ end if
+
+ !---------------------------------------------------------------------------
+ ! ... regrid to model grid
+ !---------------------------------------------------------------------------
+
+ call interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, &
+ lon_veg, lon_veg_edge, landmask, urban, lake, &
+ wetland, vegetation_map, soilw_map, do_soilw )
+
+ deallocate( vegetation_map, work, stat=astat )
+ deallocate( lon_veg, lat_veg, lon_veg_edge, lat_veg_edge, stat=astat )
+ deallocate( landmask, urban, lake, wetland, stat=astat )
+ if( do_soilw ) then
+ deallocate( soilw_map, stat=astat )
+ end if
+ endif ! Unstructured grid
+
+ if (drydep_method == DD_XLND) then
+ return
+ endif
+
+ !---------------------------------------------------------------------------
+ ! ... read LAI based season indeces
+ !---------------------------------------------------------------------------
+ call getfil (season_wes_file, locfn, 0)
+ call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE)
+ !---------------------------------------------------------------------------
+ ! ... get the dimensions
+ !---------------------------------------------------------------------------
+ ierr = pio_inq_dimid( piofile, 'lat', dimid )
+ ierr = pio_inq_dimlen( piofile, dimid, nlat_lai )
+ ierr = pio_inq_dimid( piofile, 'pft', dimid )
+ ierr = pio_inq_dimlen( piofile, dimid, npft_lai )
+ !---------------------------------------------------------------------------
+ ! ... allocate arrays
+ !---------------------------------------------------------------------------
+ allocate( lat_lai(nlat_lai), wk_lai(nlat_lai,npft_lai,12), stat=astat )
+ if( astat /= 0 ) then
+ write(iulog,*) 'dvel_inti: failed to allocate vegation_map; error = ',astat
+ call endrun
+ end if
+ !---------------------------------------------------------------------------
+ ! ... read the latitude and the season indicies
+ !---------------------------------------------------------------------------
+ ierr = pio_inq_varid( piofile, 'lat', vid )
+ ierr = pio_get_var( piofile, vid, lat_lai )
+
+ ierr = pio_inq_varid( piofile, 'season_wes', vid )
+ ierr = pio_get_var( piofile, vid, wk_lai )
+
+ call cam_pio_closefile( piofile )
+
+
+ if(dycore_is('UNSTRUCTURED') ) then
+ ! For unstructured grids plon is the 1d horizontal grid size and plat=1
+ allocate(clat(plon))
+ call get_horiz_grid_d(plon, clat_d_out=clat)
+ jl = 1
+ ju = plon
+ else
+ allocate(clat(plat))
+ call get_horiz_grid_d(plat, clat_d_out=clat)
+ jl = 1
+ ju = plat
+ end if
+ imin = 1
+ do j = 1,ju
+ diff_min = 10._r8
+ pos_min = -99
+ target_lat = clat(j)*r2d
+ do i = imin,nlat_lai
+ if( abs(lat_lai(i) - target_lat) < diff_min ) then
+ diff_min = abs(lat_lai(i) - target_lat)
+ pos_min = i
+ end if
+ end do
+ if( pos_min < 0 ) then
+ write(iulog,*) 'dvel_inti: cannot find ',target_lat,' at j,pos_min,diff_min = ',j,pos_min,diff_min
+ write(iulog,*) 'dvel_inti: imin,nlat_lai = ',imin,nlat_lai
+ write(iulog,*) 'dvel_inti: lat_lai'
+ write(iulog,'(1p,10g12.5)') lat_lai(:)
+ call endrun
+ end if
+ if(dycore_is('UNSTRUCTURED') ) then
+ imin=1
+ else
+ imin = pos_min
+ end if
+ index_season_lai_j(:,:) = wk_lai(pos_min,:,:)
+
+ !---------------------------------------------------------------------------
+ ! specify the season as the most frequent in the 11 vegetation classes
+ ! this was done to remove a banding problem in dvel (JFL Oct 04)
+ !---------------------------------------------------------------------------
+ do m = 1,12
+ num_seas = 0
+ do l = 1,11
+ do k = 1,5
+ if( index_season_lai_j(l,m) == k ) then
+ num_seas(k) = num_seas(k) + 1
+ exit
+ end if
+ end do
+ end do
+
+ num_max = -1
+ do k = 1,5
+ if( num_seas(k) > num_max ) then
+ num_max = num_seas(k)
+ k_max = k
+ endif
+ end do
+
+ index_season_lai(j,m) = k_max
+ end do
+ end do
+
+ deallocate( lat_lai, wk_lai, clat, index_season_lai_j)
+
+ end subroutine dvel_inti_xactive
+
+ !-------------------------------------------------------------------------------------
+ subroutine get_landuse_and_soilw_from_file(do_soilw)
+ use ncdio_atm, only : infld
+ logical, intent(in) :: do_soilw
+ logical :: readvar
+
+ type(file_desc_t) :: piofile
+ character(len=shr_kind_cl) :: locfn
+ logical :: lexist
+
+ call getfil (drydep_srf_file, locfn, 1, lexist)
+ if(lexist) then
+ call cam_pio_openfile(piofile, locfn, PIO_NOWRITE)
+
+ call infld('fraction_landuse', piofile, 'ncol','class',1,pcols,1,n_land_type, begchunk,endchunk, &
+ fraction_landuse, readvar, gridname='physgrid')
+ if (.not. readvar) then
+ write(iulog,*)'**************************************'
+ write(iulog,*)'get_landuse_and_soilw_from_file: INFO:'
+ write(iulog,*)' fraction_landuse not read from file: '
+ write(iulog,*)' ', trim(locfn)
+ write(iulog,*)' setting all values to zero'
+ write(iulog,*)'**************************************'
+ fraction_landuse = 0._r8
+ end if
+
+ if(do_soilw) then
+ call infld('soilw', piofile, 'ncol','month',1,pcols,1,12, begchunk,endchunk, &
+ soilw_3d, readvar, gridname='physgrid')
+ end if
+
+ call cam_pio_closefile(piofile)
+ else
+ call endrun('Unstructured grids require drydep_srf_file ')
+ end if
+
+
+ end subroutine get_landuse_and_soilw_from_file
+
+ !-------------------------------------------------------------------------------------
+ subroutine interp_map( plon, plat, nlon_veg, nlat_veg, npft_veg, lat_veg, lat_veg_edge, &
+ lon_veg, lon_veg_edge, landmask, urban, lake, &
+ wetland, vegetation_map, soilw_map, do_soilw )
+
+ use mo_constants, only : r2d
+ use scamMod, only : latiop,loniop,scmlat,scmlon,scm_cambfb_mode
+ use shr_scam_mod , only: shr_scam_getCloseLatLon ! Standardized system subroutines
+ use cam_initfiles, only: initial_file_get_id
+ use dycore, only : dycore_is
+ use phys_grid, only : scatter_field_to_chunk
+ implicit none
+
+ !-------------------------------------------------------------------------------------
+ ! ... dummy arguments
+ !-------------------------------------------------------------------------------------
+ integer, intent(in) :: plon, plat, nlon_veg, nlat_veg, npft_veg
+ real(r8), pointer :: soilw_map(:,:,:)
+ real(r8), intent(in) :: landmask(nlon_veg,nlat_veg)
+ real(r8), intent(in) :: urban(nlon_veg,nlat_veg)
+ real(r8), intent(in) :: lake(nlon_veg,nlat_veg)
+ real(r8), intent(in) :: wetland(nlon_veg,nlat_veg)
+ real(r8), intent(in) :: vegetation_map(nlon_veg,nlat_veg,npft_veg)
+ real(r8), intent(in) :: lon_veg(nlon_veg)
+ real(r8), intent(in) :: lon_veg_edge(nlon_veg+1)
+ real(r8), intent(in) :: lat_veg(nlat_veg)
+ real(r8), intent(in) :: lat_veg_edge(nlat_veg+1)
+ logical, intent(in) :: do_soilw
+
+ !-------------------------------------------------------------------------------------
+ ! ... local variables
+ !-------------------------------------------------------------------------------------
+ real(r8) :: closelat,closelon
+ integer :: latidx,lonidx
+
+ integer, parameter :: veg_ext = 20
+ type(file_desc_t), pointer :: piofile
+ integer :: i, j, ii, jj, jl, ju, i_ndx, n
+ integer, dimension(plon+1) :: ind_lon
+ integer, dimension(plat+1) :: ind_lat
+ real(r8) :: total_land
+ real(r8), dimension(plon+1) :: lon_edge
+ real(r8), dimension(plat+1) :: lat_edge
+ real(r8) :: lat1, lat2, lon1, lon2
+ real(r8) :: x1, x2, y1, y2, dx, dy
+ real(r8) :: area, total_area
+ real(r8), dimension(npft_veg+3) :: fraction
+ real(r8) :: total_soilw_area
+ real(r8) :: fraction_soilw
+ real(r8) :: total_soilw(12)
+
+ real(r8), dimension(-veg_ext:nlon_veg+veg_ext) :: lon_veg_edge_ext
+ integer, dimension(-veg_ext:nlon_veg+veg_ext) :: mapping_ext
+
+ real(r8), allocatable :: lam(:), phi(:), garea(:)
+
+ logical, parameter :: has_npole = .true.
+ integer :: ploniop,platiop
+ real(r8) :: tmp_frac_lu(plon,n_land_type,plat), tmp_soilw_3d(plon,12,plat)
+
+ if(dycore_is('UNSTRUCTURED') ) then
+ ! For unstructured grids plon is the 1d horizontal grid size and plat=1
+ allocate(lam(plon), phi(plon))
+ call get_horiz_grid_d(plon, clat_d_out=phi)
+ else
+ allocate(lam(plon), phi(plat))
+ call get_horiz_grid_d(plat, clat_d_out=phi)
+ endif
+ call get_horiz_grid_d(plon, clon_d_out=lam)
+
+
+ jl = 1
+ ju = plon
+
+ if (single_column) then
+ if (scm_cambfb_mode) then
+ piofile => initial_file_get_id()
+ call shr_scam_getCloseLatLon(piofile%fh,scmlat,scmlon,closelat,closelon,latidx,lonidx)
+ ploniop=size(loniop)
+ platiop=size(latiop)
+ else
+ latidx=1
+ lonidx=1
+ ploniop=1
+ platiop=1
+ end if
+
+ lon_edge(1) = loniop(lonidx) * r2d - .5_r8*(loniop(2) - loniop(1)) * r2d
+
+ if (lonidx.lt.ploniop) then
+ lon_edge(2) = loniop(lonidx+1) * r2d - .5_r8*(loniop(2) - loniop(1)) * r2d
+ else
+ lon_edge(2) = lon_edge(1) + (loniop(2) - loniop(1)) * r2d
+ end if
+
+ lat_edge(1) = latiop(latidx) * r2d - .5_r8*(latiop(2) - latiop(1)) * r2d
+
+ if (latidx.lt.platiop) then
+ lat_edge(2) = latiop(latidx+1) * r2d - .5_r8*(latiop(2) - latiop(1)) * r2d
+ else
+ lat_edge(2) = lat_edge(1) + (latiop(2) - latiop(1)) * r2d
+ end if
+ else
+ do i = 1,plon
+ lon_edge(i) = lam(i) * r2d - .5_r8*(lam(2) - lam(1)) * r2d
+ end do
+ lon_edge(plon+1) = lon_edge(plon) + (lam(2) - lam(1)) * r2d
+ if( .not. has_npole ) then
+ do j = 1,plat+1
+ lat_edge(j) = phi(j) * r2d - .5_r8*(phi(2) - phi(1)) * r2d
+ end do
+ else
+ do j = 1,plat
+ lat_edge(j) = phi(j) * r2d - .5_r8*(phi(2) - phi(1)) * r2d
+ end do
+ lat_edge(plat+1) = lat_edge(plat) + (phi(2) - phi(1)) * r2d
+ end if
+ end if
+ do j = 1,plat+1
+ lat_edge(j) = min( lat_edge(j), 90._r8 )
+ lat_edge(j) = max( lat_edge(j),-90._r8 )
+ end do
+
+ !-------------------------------------------------------------------------------------
+ ! wrap around the longitudes
+ !-------------------------------------------------------------------------------------
+ do i = -veg_ext,0
+ lon_veg_edge_ext(i) = lon_veg_edge(nlon_veg+i) - 360._r8
+ mapping_ext (i) = nlon_veg+i
+ end do
+ do i = 1,nlon_veg
+ lon_veg_edge_ext(i) = lon_veg_edge(i)
+ mapping_ext (i) = i
+ end do
+ do i = nlon_veg+1,nlon_veg+veg_ext
+ lon_veg_edge_ext(i) = lon_veg_edge(i-nlon_veg) + 360._r8
+ mapping_ext (i) = i-nlon_veg
+ end do
+#ifdef DEBUG
+ write(iulog,*) 'interp_map : lon_edge ',lon_edge
+ write(iulog,*) 'interp_map : lat_edge ',lat_edge
+ write(iulog,*) 'interp_map : mapping_ext ',mapping_ext
+#endif
+ do j = 1,plon+1
+ lon1 = lon_edge(j)
+ do i = -veg_ext,nlon_veg+veg_ext
+ dx = lon_veg_edge_ext(i ) - lon1
+ dy = lon_veg_edge_ext(i+1) - lon1
+ if( dx*dy <= 0._r8 ) then
+ ind_lon(j) = i
+ exit
+ end if
+ end do
+ end do
+
+ do j = 1,plat+1
+ lat1 = lat_edge(j)
+ do i = 1,nlat_veg
+ dx = lat_veg_edge(i ) - lat1
+ dy = lat_veg_edge(i+1) - lat1
+ if( dx*dy <= 0._r8 ) then
+ ind_lat(j) = i
+ exit
+ end if
+ end do
+ end do
+#ifdef DEBUG
+ write(iulog,*) 'interp_map : ind_lon ',ind_lon
+ write(iulog,*) 'interp_map : ind_lat ',ind_lat
+#endif
+ lat_loop : do j = 1,plat
+ lon_loop : do i = 1,plon
+ total_area = 0._r8
+ fraction = 0._r8
+ total_soilw(:) = 0._r8
+ total_soilw_area = 0._r8
+ do jj = ind_lat(j),ind_lat(j+1)
+ y1 = max( lat_edge(j),lat_veg_edge(jj) )
+ y2 = min( lat_edge(j+1),lat_veg_edge(jj+1) )
+ dy = (y2 - y1)/(lat_veg_edge(jj+1) - lat_veg_edge(jj))
+ do ii =ind_lon(i),ind_lon(i+1)
+ i_ndx = mapping_ext(ii)
+ x1 = max( lon_edge(i),lon_veg_edge_ext(ii) )
+ x2 = min( lon_edge(i+1),lon_veg_edge_ext(ii+1) )
+ dx = (x2 - x1)/(lon_veg_edge_ext(ii+1) - lon_veg_edge_ext(ii))
+ area = dx * dy
+ total_area = total_area + area
+ !-----------------------------------------------------------------
+ ! ... special case for ocean grid point
+ !-----------------------------------------------------------------
+ if( nint(landmask(i_ndx,jj)) == 0 ) then
+ fraction(npft_veg+1) = fraction(npft_veg+1) + area
+ else
+ do n = 1,npft_veg
+ fraction(n) = fraction(n) + vegetation_map(i_ndx,jj,n) * area
+ end do
+ fraction(npft_veg+1) = fraction(npft_veg+1) + area * lake (i_ndx,jj)
+ fraction(npft_veg+2) = fraction(npft_veg+2) + area * wetland(i_ndx,jj)
+ fraction(npft_veg+3) = fraction(npft_veg+3) + area * urban (i_ndx,jj)
+ !-----------------------------------------------------------------
+ ! ... check if land accounts for the whole area.
+ ! If not, the remaining area is in the ocean
+ !-----------------------------------------------------------------
+ total_land = sum(vegetation_map(i_ndx,jj,:)) &
+ + urban (i_ndx,jj) &
+ + lake (i_ndx,jj) &
+ + wetland(i_ndx,jj)
+ if( total_land < 1._r8 ) then
+ fraction(npft_veg+1) = fraction(npft_veg+1) + (1._r8 - total_land) * area
+ end if
+ !-------------------------------------------------------------------------------------
+ ! ... compute weighted average of soilw over grid (non-water only)
+ !-------------------------------------------------------------------------------------
+ if( do_soilw ) then
+ fraction_soilw = total_land - (lake(i_ndx,jj) + wetland(i_ndx,jj))
+ total_soilw_area = total_soilw_area + fraction_soilw * area
+ total_soilw(:) = total_soilw(:) + fraction_soilw * area * soilw_map(i_ndx,jj,:)
+ end if
+ end if
+ end do
+ end do
+ !-------------------------------------------------------------------------------------
+ ! ... divide by total area of grid box
+ !-------------------------------------------------------------------------------------
+ fraction(:) = fraction(:)/total_area
+ !-------------------------------------------------------------------------------------
+ ! ... make sure we don't have too much or too little
+ !-------------------------------------------------------------------------------------
+ if( abs( sum(fraction) - 1._r8) > .001_r8 ) then
+ fraction(:) = fraction(:)/sum(fraction)
+ end if
+ !-------------------------------------------------------------------------------------
+ ! ... map to Wesely land classification
+ !-------------------------------------------------------------------------------------
+
+
+
+
+ tmp_frac_lu(i, 1, j) = fraction(20)
+ tmp_frac_lu(i, 2, j) = sum(fraction(16:17))
+ tmp_frac_lu(i, 3, j) = sum(fraction(13:15))
+ tmp_frac_lu(i, 4, j) = sum(fraction( 5: 9))
+ tmp_frac_lu(i, 5, j) = sum(fraction( 2: 4))
+ tmp_frac_lu(i, 6, j) = fraction(19)
+ tmp_frac_lu(i, 7, j) = fraction(18)
+ tmp_frac_lu(i, 8, j) = fraction( 1)
+ tmp_frac_lu(i, 9, j) = 0._r8
+ tmp_frac_lu(i,10, j) = 0._r8
+ tmp_frac_lu(i,11, j) = sum(fraction(10:12))
+ if( do_soilw ) then
+ if( total_soilw_area > 0._r8 ) then
+ tmp_soilw_3d(i,:,j) = total_soilw(:)/total_soilw_area
+ else
+ tmp_soilw_3d(i,:,j) = -99._r8
+ end if
+ end if
+ end do lon_loop
+ end do lat_loop
+ !-------------------------------------------------------------------------------------
+ ! ... reshape according to lat-lon blocks
+ !-------------------------------------------------------------------------------------
+ call scatter_field_to_chunk(1,n_land_type,1,plon,tmp_frac_lu,fraction_landuse)
+ if(do_soilw) call scatter_field_to_chunk(1,12,1,plon,tmp_soilw_3d,soilw_3d)
+ !-------------------------------------------------------------------------------------
+ ! ... make sure there are no out of range values
+ !-------------------------------------------------------------------------------------
+ where (fraction_landuse < 0._r8) fraction_landuse = 0._r8
+ where (fraction_landuse > 1._r8) fraction_landuse = 1._r8
+
+ end subroutine interp_map
+
+ !-------------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------------
+ subroutine drydep_xactive( ncdate, sfc_temp, pressure_sfc, &
+ wind_speed, spec_hum, air_temp, pressure_10m, rain, &
+ snow, solar_flux, dvel, dflx, mmr, &
+ tv, soilw, rh, ncol, lonndx, latndx, lchnk, &
+ ocnfrc, icefrc, beglandtype, endlandtype )
+ !-------------------------------------------------------------------------------------
+ ! code based on wesely (atmospheric environment, 1989, vol 23, p. 1293-1304) for
+ ! calculation of r_c, and on walcek et. al. (atmospheric enviroment, 1986,
+ ! vol. 20, p. 949-964) for calculation of r_a and r_b
+ !
+ ! as suggested in walcek (u_i)(u*_i) = (u_a)(u*_a)
+ ! is kept constant where i represents a subgrid environment and a the
+ ! grid average environment. thus the calculation proceeds as follows:
+ ! va the grid averaged wind is calculated on dots
+ ! z0(i) the grid averaged roughness coefficient is calculated
+ ! ri(i) the grid averaged richardson number is calculated
+ ! --> the grid averaged (u_a)(u*_a) is calculated
+ ! --> subgrid scale u*_i is calculated assuming (u_i) given as above
+ ! --> final deposotion velocity is weighted average of subgrid scale velocities
+ !
+ ! code written by P. Hess, rewritten in fortran 90 by JFL (August 2000)
+ ! modified by JFL to be used in MOZART-2 (October 2002)
+ !-------------------------------------------------------------------------------------
+
+ use seq_drydep_mod, only: z0, rgso, rgss, h2_a, h2_b, h2_c, ri, rclo, rcls, rlu, rac
+ use seq_drydep_mod, only: seq_drydep_setHCoeff, foxd, drat
+ use physconst, only: tmelt
+ use seq_drydep_mod, only: drydep_method, DD_XLND
+
+ implicit none
+
+ !-------------------------------------------------------------------------------------
+ ! ... dummy arguments
+ !-------------------------------------------------------------------------------------
+ integer, intent(in) :: ncol
+ integer, intent(in) :: ncdate ! present date (yyyymmdd)
+ real(r8), intent(in) :: sfc_temp(pcols) ! surface temperature (K)
+ real(r8), intent(in) :: pressure_sfc(pcols) ! surface pressure (Pa)
+ real(r8), intent(in) :: wind_speed(pcols) ! 10 meter wind speed (m/s)
+ real(r8), intent(in) :: spec_hum(pcols) ! specific humidity (kg/kg)
+ real(r8), intent(in) :: rh(ncol,1) ! relative humidity
+ real(r8), intent(in) :: air_temp(pcols) ! surface air temperature (K)
+ real(r8), intent(in) :: pressure_10m(pcols) ! 10 meter pressure (Pa)
+ real(r8), intent(in) :: rain(pcols)
+ real(r8), intent(in) :: snow(pcols) ! snow height (m)
+ real(r8), intent(in) :: soilw(pcols) ! soil moisture fraction
+ real(r8), intent(in) :: solar_flux(pcols) ! direct shortwave radiation at surface (W/m^2)
+ real(r8), intent(in) :: tv(pcols) ! potential temperature
+ real(r8), intent(in) :: mmr(pcols,plev,gas_pcnst) ! constituent concentration (kg/kg)
+ real(r8), intent(out) :: dvel(ncol,gas_pcnst) ! deposition velocity (cm/s)
+ real(r8), intent(inout) :: dflx(pcols,gas_pcnst) ! deposition flux (/cm^2/s)
+
+ integer, intent(in) :: latndx(pcols) ! chunk latitude indicies
+ integer, intent(in) :: lonndx(pcols) ! chunk longitude indicies
+ integer, intent(in) :: lchnk ! chunk number
+
+ integer, intent(in), optional :: beglandtype
+ integer, intent(in), optional :: endlandtype
+
+ real(r8), intent(in), optional :: ocnfrc(pcols)
+ real(r8), intent(in), optional :: icefrc(pcols)
+
+ !-------------------------------------------------------------------------------------
+ ! ... local variables
+ !-------------------------------------------------------------------------------------
+ real(r8), parameter :: scaling_to_cm_per_s = 100._r8
+ real(r8), parameter :: rain_threshold = 1.e-7_r8 ! of the order of 1cm/day expressed in m/s
+
+ integer :: i, ispec, lt, m
+ integer :: sndx
+ integer :: month
+
+ real(r8) :: slope = 0._r8
+ real(r8) :: z0water ! revised z0 over water
+ real(r8) :: p ! pressure at midpoint first layer
+ real(r8) :: pg ! surface pressure
+ real(r8) :: es ! saturation vapor pressure
+ real(r8) :: ws ! saturation mixing ratio
+ real(r8) :: hvar ! constant to compute xmol
+ real(r8) :: h ! constant to compute xmol
+ real(r8) :: psih ! stability correction factor
+ real(r8) :: rs ! constant for calculating rsmx
+ real(r8) :: rmx ! resistance by vegetation
+ real(r8) :: zovl ! ratio of z to m-o length
+ real(r8) :: cvarb ! cvar averaged over landtypes
+ real(r8) :: bb ! b averaged over landtypes
+ real(r8) :: ustarb ! ustar averaged over landtypes
+ real(r8) :: tc(ncol) ! temperature in celsius
+ real(r8) :: cts(ncol) ! correction to rlu rcl and rgs for frost
+
+ !-------------------------------------------------------------------------------------
+ ! local arrays: dependent on location and species
+ !-------------------------------------------------------------------------------------
+ real(r8), dimension(ncol,nddvels) :: heff
+
+ !-------------------------------------------------------------------------------------
+ ! local arrays: dependent on location only
+ !-------------------------------------------------------------------------------------
+ integer :: index_season(ncol,n_land_type)
+ real(r8), dimension(ncol) :: tha ! atmospheric virtual potential temperature
+ real(r8), dimension(ncol) :: thg ! ground virtual potential temperature
+ real(r8), dimension(ncol) :: z ! height of lowest level
+ real(r8), dimension(ncol) :: va ! magnitude of v on cross points
+ real(r8), dimension(ncol) :: ribn ! richardson number
+ real(r8), dimension(ncol) :: qs ! saturation specific humidity
+ real(r8), dimension(ncol) :: crs ! multiplier to calculate crs
+ real(r8), dimension(ncol) :: rdc ! part of lower canopy resistance
+ real(r8), dimension(ncol) :: uustar ! u*ustar (assumed constant over grid)
+ real(r8), dimension(ncol) :: z0b ! average roughness length over grid
+ real(r8), dimension(ncol) :: wrk ! work array
+ real(r8), dimension(ncol) :: term ! work array
+ real(r8), dimension(ncol) :: resc ! work array
+ real(r8), dimension(ncol) :: lnd_frc ! work array
+ logical, dimension(ncol) :: unstable
+ logical, dimension(ncol) :: has_rain
+ logical, dimension(ncol) :: has_dew
+
+ !-------------------------------------------------------------------------------------
+ ! local arrays: dependent on location and landtype
+ !-------------------------------------------------------------------------------------
+ real(r8), dimension(ncol,n_land_type) :: rds ! resistance for deposition of sulfate
+ real(r8), dimension(ncol,n_land_type) :: b ! buoyancy parameter for unstable conditions
+ real(r8), dimension(ncol,n_land_type) :: cvar ! height parameter
+ real(r8), dimension(ncol,n_land_type) :: ustar ! friction velocity
+ real(r8), dimension(ncol,n_land_type) :: xmol ! monin-obukhov length
+
+ !-------------------------------------------------------------------------------------
+ ! local arrays: dependent on location, landtype and species
+ !-------------------------------------------------------------------------------------
+ real(r8), dimension(ncol,n_land_type,gas_pcnst) :: rsmx ! vegetative resistance (plant mesophyll)
+ real(r8), dimension(ncol,n_land_type,gas_pcnst) :: rclx ! lower canopy resistance
+ real(r8), dimension(ncol,n_land_type,gas_pcnst) :: rlux ! vegetative resistance (upper canopy)
+ real(r8), dimension(ncol,n_land_type) :: rlux_o3 ! vegetative resistance (upper canopy)
+ real(r8), dimension(ncol,n_land_type,gas_pcnst) :: rgsx ! ground resistance
+ real(r8) :: pmid(ncol,1) ! for seasalt aerosols
+ real(r8) :: tfld(ncol,1) ! for seasalt aerosols
+ real(r8) :: fact, vds
+ real(r8) :: rc ! combined surface resistance
+ real(r8) :: var_soilw, dv_soil_h2, fact_h2 ! h2 dvel wrking variables
+ logical :: fr_lnduse(ncol,n_land_type) ! wrking array
+ real(r8) :: dewm ! multiplier for rs when dew occurs
+
+ real(r8) :: lcl_frc_landuse(ncol,n_land_type)
+
+ integer :: beglt, endlt
+
+ !-------------------------------------------------------------------------------------
+ ! jfl : mods for PAN
+ !-------------------------------------------------------------------------------------
+ real(r8) :: dv_pan
+ real(r8) :: c0_pan(11) = (/ 0.000_r8, 0.006_r8, 0.002_r8, 0.009_r8, 0.015_r8, &
+ 0.006_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.002_r8, 0.002_r8 /)
+ real(r8) :: k_pan (11) = (/ 0.000_r8, 0.010_r8, 0.005_r8, 0.004_r8, 0.003_r8, &
+ 0.005_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.075_r8, 0.002_r8 /)
+
+ if (present( beglandtype)) then
+ beglt = beglandtype
+ else
+ beglt = 1
+ endif
+ if (present( endlandtype)) then
+ endlt = endlandtype
+ else
+ endlt = n_land_type
+ endif
+
+ !-------------------------------------------------------------------------------------
+ ! initialize
+ !-------------------------------------------------------------------------------------
+ do m = 1,gas_pcnst
+ dvel(:,m) = 0._r8
+ end do
+
+ if( all( .not. has_dvel(:) ) ) then
+ return
+ end if
+
+ !-------------------------------------------------------------------------------------
+ ! define species-dependent parameters (temperature dependent)
+ !-------------------------------------------------------------------------------------
+ call seq_drydep_setHCoeff( ncol, sfc_temp, heff )
+
+ do lt = 1,n_land_type
+ dep_ra (:,lt,lchnk) = 0._r8
+ dep_rb (:,lt,lchnk) = 0._r8
+ rds(:,lt) = 0._r8
+ end do
+
+ !-------------------------------------------------------------------------------------
+ ! ... set month
+ !-------------------------------------------------------------------------------------
+ month = mod( ncdate,10000 )/100
+
+ !-------------------------------------------------------------------------------------
+ ! define which season (relative to Northern hemisphere climate)
+ !-------------------------------------------------------------------------------------
+
+ !-------------------------------------------------------------------------------------
+ ! define season index based on fixed LAI
+ !-------------------------------------------------------------------------------------
+ if ( drydep_method == DD_XLND ) then
+ index_season = 4
+ else
+ do i = 1,ncol
+ index_season(i,:) = index_season_lai(latndx(i),month)
+ end do
+ endif
+ !-------------------------------------------------------------------------------------
+ ! special case for snow covered terrain
+ !-------------------------------------------------------------------------------------
+ do i = 1,ncol
+ if( snow(i) > .01_r8 ) then
+ index_season(i,:) = 4
+ end if
+ end do
+ !-------------------------------------------------------------------------------------
+ ! scale rain and define logical arrays
+ !-------------------------------------------------------------------------------------
+ has_rain(:ncol) = rain(:ncol) > rain_threshold
+
+ !-------------------------------------------------------------------------------------
+ ! loop over longitude points
+ !-------------------------------------------------------------------------------------
+ col_loop : do i = 1,ncol
+ p = pressure_10m(i)
+ pg = pressure_sfc(i)
+ !-------------------------------------------------------------------------------------
+ ! potential temperature
+ !-------------------------------------------------------------------------------------
+ tha(i) = air_temp(i) * (p00/p )**rovcp * (1._r8 + .61_r8*spec_hum(i))
+ thg(i) = sfc_temp(i) * (p00/pg)**rovcp * (1._r8 + .61_r8*spec_hum(i))
+ !-------------------------------------------------------------------------------------
+ ! height of 1st level
+ !-------------------------------------------------------------------------------------
+ z(i) = - r/grav * air_temp(i) * (1._r8 + .61_r8*spec_hum(i)) * log(p/pg)
+ !-------------------------------------------------------------------------------------
+ ! wind speed
+ !-------------------------------------------------------------------------------------
+ va(i) = max( .01_r8,wind_speed(i) )
+ !-------------------------------------------------------------------------------------
+ ! Richardson number
+ !-------------------------------------------------------------------------------------
+ ribn(i) = z(i) * grav * (tha(i) - thg(i))/thg(i) / (va(i)*va(i))
+ ribn(i) = min( ribn(i),ric )
+ unstable(i) = ribn(i) < 0._r8
+ !-------------------------------------------------------------------------------------
+ ! saturation vapor pressure (Pascals)
+ ! saturation mixing ratio
+ ! saturation specific humidity
+ !-------------------------------------------------------------------------------------
+ es = 611._r8*exp( 5414.77_r8*(sfc_temp(i) - tmelt)/(tmelt*sfc_temp(i)) )
+ ws = .622_r8*es/(pg - es)
+ qs(i) = ws/(1._r8 + ws)
+ has_dew(i) = .false.
+ if( qs(i) <= spec_hum(i) ) then
+ has_dew(i) = .true.
+ end if
+ if( sfc_temp(i) < tmelt ) then
+ has_dew(i) = .false.
+ end if
+ !-------------------------------------------------------------------------------------
+ ! constant in determining rs
+ !-------------------------------------------------------------------------------------
+ tc(i) = sfc_temp(i) - tmelt
+ if( sfc_temp(i) > tmelt .and. sfc_temp(i) < 313.15_r8 ) then
+ crs(i) = (1._r8 + (200._r8/(solar_flux(i) + .1_r8))**2) * (400._r8/(tc(i)*(40._r8 - tc(i))))
+ else
+ crs(i) = large_value
+ end if
+ !-------------------------------------------------------------------------------------
+ ! rdc (lower canopy res)
+ !-------------------------------------------------------------------------------------
+ rdc(i) = 100._r8*(1._r8 + 1000._r8/(solar_flux(i) + 10._r8))/(1._r8 + 1000._r8*slope)
+ end do col_loop
+
+ !-------------------------------------------------------------------------------------
+ ! ... form working arrays
+ !-------------------------------------------------------------------------------------
+ do lt = 1,n_land_type
+ do i=1,ncol
+ if ( drydep_method == DD_XLND ) then
+ lcl_frc_landuse(i,lt) = 0._r8
+ else
+ lcl_frc_landuse(i,lt) = fraction_landuse(i,lt,lchnk)
+ endif
+ enddo
+ end do
+ if ( present(ocnfrc) .and. present(icefrc) ) then
+ do i=1,ncol
+ ! land type 7 is used for ocean
+ ! land type 8 is used for sea ice
+ lcl_frc_landuse(i,7) = ocnfrc(i)
+ lcl_frc_landuse(i,8) = icefrc(i)
+ enddo
+ endif
+ do lt = 1,n_land_type
+ do i=1,ncol
+ fr_lnduse(i,lt) = lcl_frc_landuse(i,lt) > 0._r8
+ enddo
+ end do
+
+ !-------------------------------------------------------------------------------------
+ ! find grid averaged z0: z0bar (the roughness length) z_o=exp[S(f_i*ln(z_oi))]
+ ! this is calculated so as to find u_i, assuming u*u=u_i*u_i
+ !-------------------------------------------------------------------------------------
+ z0b(:) = 0._r8
+ do lt = 1,n_land_type
+ do i = 1,ncol
+ if( fr_lnduse(i,lt) ) then
+ z0b(i) = z0b(i) + lcl_frc_landuse(i,lt) * log( z0(index_season(i,lt),lt) )
+ end if
+ end do
+ end do
+
+ !-------------------------------------------------------------------------------------
+ ! find the constant velocity uu*=(u_i)(u*_i)
+ !-------------------------------------------------------------------------------------
+ do i = 1,ncol
+ z0b(i) = exp( z0b(i) )
+ cvarb = vonkar/log( z(i)/z0b(i) )
+ !-------------------------------------------------------------------------------------
+ ! unstable and stable cases
+ !-------------------------------------------------------------------------------------
+ if( unstable(i) ) then
+ bb = 9.4_r8*(cvarb**2)*sqrt( abs(ribn(i))*z(i)/z0b(i) )
+ ustarb = cvarb * va(i) * sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8 + 7.4_r8*bb)) )
+ else
+ ustarb = cvarb * va(i)/(1._r8 + 4.7_r8*ribn(i))
+ end if
+ uustar(i) = va(i)*ustarb
+ end do
+
+ !-------------------------------------------------------------------------------------
+ ! calculate the friction velocity for each land type u_i=uustar/u*_i
+ !-------------------------------------------------------------------------------------
+ do lt = beglt,endlt
+ do i = 1,ncol
+ if( fr_lnduse(i,lt) ) then
+ if( unstable(i) ) then
+ cvar(i,lt) = vonkar/log( z(i)/z0(index_season(i,lt),lt) )
+ b(i,lt) = 9.4_r8*(cvar(i,lt)**2)* sqrt( abs(ribn(i))*z(i)/z0(index_season(i,lt),lt) )
+ ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)*sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8 + 7.4_r8*b(i,lt))) ) )
+ else
+ cvar(i,lt) = vonkar/log( z(i)/z0(index_season(i,lt),lt) )
+ ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)/(1._r8 + 4.7_r8*ribn(i)) )
+ end if
+ end if
+ end do
+ end do
+
+ !-------------------------------------------------------------------------------------
+ ! revise calculation of friction velocity and z0 over water
+ !-------------------------------------------------------------------------------------
+ lt = 7
+ do i = 1,ncol
+ if( fr_lnduse(i,lt) ) then
+ if( unstable(i) ) then
+ z0water = (.016_r8*(ustar(i,lt)**2)/grav) + diffk/(9.1_r8*ustar(i,lt))
+ cvar(i,lt) = vonkar/(log( z(i)/z0water ))
+ b(i,lt) = 9.4_r8*(cvar(i,lt)**2)*sqrt( abs(ribn(i))*z(i)/z0water )
+ ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)* sqrt( 1._r8 - (9.4_r8*ribn(i)/(1._r8+ 7.4_r8*b(i,lt))) ) )
+ else
+ z0water = (.016_r8*(ustar(i,lt)**2)/grav) + diffk/(9.1_r8*ustar(i,lt))
+ cvar(i,lt) = vonkar/(log(z(i)/z0water))
+ ustar(i,lt) = sqrt( cvar(i,lt)*uustar(i)/(1._r8 + 4.7_r8*ribn(i)) )
+ end if
+ end if
+ end do
+
+ !-------------------------------------------------------------------------------------
+ ! compute monin-obukhov length for unstable and stable conditions/ sublayer resistance
+ !-------------------------------------------------------------------------------------
+ do lt = beglt,endlt
+ do i = 1,ncol
+ if( fr_lnduse(i,lt) ) then
+ hvar = (va(i)/0.74_r8) * (tha(i) - thg(i)) * (cvar(i,lt)**2)
+ if( unstable(i) ) then ! unstable
+ h = hvar*(1._r8 - (9.4_r8*ribn(i)/(1._r8 + 5.3_r8*b(i,lt))))
+ else
+ h = hvar/((1._r8+4.7_r8*ribn(i))**2)
+ end if
+ xmol(i,lt) = thg(i) * ustar(i,lt) * ustar(i,lt) / (vonkar * grav * h)
+ end if
+ end do
+ end do
+
+ !-------------------------------------------------------------------------------------
+ ! psih
+ !-------------------------------------------------------------------------------------
+ do lt = beglt,endlt
+ do i = 1,ncol
+ if( fr_lnduse(i,lt) ) then
+ if( xmol(i,lt) < 0._r8 ) then
+ zovl = z(i)/xmol(i,lt)
+ zovl = max( -1._r8,zovl )
+ psih = exp( .598_r8 + .39_r8*log( -zovl ) - .09_r8*(log( -zovl ))**2 )
+ vds = 2.e-3_r8*ustar(i,lt) * (1._r8 + (300/(-xmol(i,lt)))**0.666_r8)
+ else
+ zovl = z(i)/xmol(i,lt)
+ zovl = min( 1._r8,zovl )
+ psih = -5._r8 * zovl
+ vds = 2.e-3_r8*ustar(i,lt)
+ end if
+ dep_ra (i,lt,lchnk) = (vonkar - psih*cvar(i,lt))/(ustar(i,lt)*vonkar*cvar(i,lt))
+ dep_rb (i,lt,lchnk) = (2._r8/(vonkar*ustar(i,lt))) * crb
+ rds(i,lt) = 1._r8/vds
+ end if
+ end do
+ end do
+
+ !-------------------------------------------------------------------------------------
+ ! surface resistance : depends on both land type and species
+ ! land types are computed seperately, then resistance is computed as average of values
+ ! following wesely rc=(1/(rs+rm) + 1/rlu +1/(rdc+rcl) + 1/(rac+rgs))**-1
+ !
+ ! compute rsmx = 1/(rs+rm) : multiply by 3 if surface is wet
+ !-------------------------------------------------------------------------------------
+ species_loop1 : do ispec = 1,gas_pcnst
+ if( has_dvel(ispec) ) then
+ m = map_dvel(ispec)
+ do lt = beglt,endlt
+ do i = 1,ncol
+ if( fr_lnduse(i,lt) ) then
+ sndx = index_season(i,lt)
+ if( ispec == o3_ndx .or. ispec == o3a_ndx .or. ispec == so2_ndx ) then
+ rmx = 0._r8
+ else
+ rmx = 1._r8/(heff(i,m)/3000._r8 + 100._r8*foxd(m))
+ end if
+ cts(i) = 1000._r8*exp( - tc(i) - 4._r8 ) ! correction for frost
+ rgsx(i,lt,ispec) = cts(i) + 1._r8/((heff(i,m)/(1.e5_r8*rgss(sndx,lt))) + (foxd(m)/rgso(sndx,lt)))
+ !-------------------------------------------------------------------------------------
+ ! special case for H2 and CO;; CH4 is set ot a fraction of dv(H2)
+ !-------------------------------------------------------------------------------------
+ if( ispec == h2_ndx .or. ispec == co_ndx .or. ispec == ch4_ndx ) then
+ if( ispec == co_ndx ) then
+ fact_h2 = 1.0_r8
+ elseif ( ispec == h2_ndx ) then
+ fact_h2 = 0.5_r8
+ elseif ( ispec == ch4_ndx ) then
+ fact_h2 = 50.0_r8
+ end if
+ !-------------------------------------------------------------------------------------
+ ! no deposition on snow, ice, desert, and water
+ !-------------------------------------------------------------------------------------
+ if( lt == 1 .or. lt == 7 .or. lt == 8 .or. sndx == 4 ) then
+ rgsx(i,lt,ispec) = large_value
+ else
+ var_soilw = max( .1_r8,min( soilw(i),.3_r8 ) )
+ if( lt == 3 ) then
+ var_soilw = log( var_soilw )
+ end if
+ dv_soil_h2 = h2_c(lt) + var_soilw*(h2_b(lt) + var_soilw*h2_a(lt))
+ if( dv_soil_h2 > 0._r8 ) then
+ rgsx(i,lt,ispec) = fact_h2/(dv_soil_h2*1.e-4_r8)
+ end if
+ end if
+ end if
+ if( lt == 7 ) then
+ rclx(i,lt,ispec) = large_value
+ rsmx(i,lt,ispec) = large_value
+ rlux(i,lt,ispec) = large_value
+ else
+ rs = ri(sndx,lt)*crs(i)
+ if ( has_dew(i) .or. has_rain(i) ) then
+ dewm = 3._r8
+ else
+ dewm = 1._r8
+ end if
+ rsmx(i,lt,ispec) = (dewm*rs*drat(m) + rmx)
+ !-------------------------------------------------------------------------------------
+ ! jfl : special case for PAN
+ !-------------------------------------------------------------------------------------
+ if( ispec == pan_ndx .or. ispec == xpan_ndx ) then
+ dv_pan = c0_pan(lt) * (1._r8 - exp( -k_pan(lt)*(dewm*rs*drat(m))*1.e-2_r8 ))
+ if( dv_pan > 0._r8 .and. sndx /= 4 ) then
+ rsmx(i,lt,ispec) = ( 1._r8/dv_pan )
+ end if
+ end if
+ rclx(i,lt,ispec) = cts(i) + 1._r8/((heff(i,m)/(1.e5_r8*rcls(sndx,lt))) + (foxd(m)/rclo(sndx,lt)))
+ rlux(i,lt,ispec) = cts(i) + rlu(sndx,lt)/(1.e-5_r8*heff(i,m) + foxd(m))
+ end if
+ end if
+ end do
+ end do
+ end if
+ end do species_loop1
+
+ do lt = beglt,endlt
+ if( lt /= 7 ) then
+ do i = 1,ncol
+ if( fr_lnduse(i,lt) ) then
+ sndx = index_season(i,lt)
+ !-------------------------------------------------------------------------------------
+ ! ... no effect if sfc_temp < O C
+ !-------------------------------------------------------------------------------------
+ if( sfc_temp(i) > tmelt ) then
+ if( has_dew(i) ) then
+ rlux_o3(i,lt) = 3000._r8*rlu(sndx,lt)/(1000._r8 + rlu(sndx,lt))
+ if( o3_ndx > 0 ) then
+ rlux(i,lt,o3_ndx) = rlux_o3(i,lt)
+ endif
+ if( o3a_ndx > 0 ) then
+ rlux(i,lt,o3a_ndx) = rlux_o3(i,lt)
+ endif
+ end if
+ if( has_rain(i) ) then
+ ! rlux(i,lt,o3_ndx) = 1./(1.e-3 + (1./(3.*rlu(sndx,lt))))
+ rlux_o3(i,lt) = 3000._r8*rlu(sndx,lt)/(1000._r8 + 3._r8*rlu(sndx,lt))
+ if( o3_ndx > 0 ) then
+ rlux(i,lt,o3_ndx) = rlux_o3(i,lt)
+ endif
+ if( o3a_ndx > 0 ) then
+ rlux(i,lt,o3a_ndx) = rlux_o3(i,lt)
+ endif
+ end if
+ end if
+
+ if ( o3_ndx > 0 ) then
+ rclx(i,lt,o3_ndx) = cts(i) + rclo(index_season(i,lt),lt)
+ rlux(i,lt,o3_ndx) = cts(i) + rlux(i,lt,o3_ndx)
+ end if
+ if ( o3a_ndx > 0 ) then
+ rclx(i,lt,o3a_ndx) = cts(i) + rclo(index_season(i,lt),lt)
+ rlux(i,lt,o3a_ndx) = cts(i) + rlux(i,lt,o3a_ndx)
+ end if
+
+ end if
+ end do
+ end if
+ end do
+
+ species_loop2 : do ispec = 1,gas_pcnst
+ m = map_dvel(ispec)
+ if( has_dvel(ispec) ) then
+ if( ispec /= o3_ndx .and. ispec /= o3a_ndx .and. ispec /= so2_ndx ) then
+ do lt = beglt,endlt
+ if( lt /= 7 ) then
+ do i = 1,ncol
+ if( fr_lnduse(i,lt) ) then
+ !-------------------------------------------------------------------------------------
+ ! no effect if sfc_temp < O C
+ !-------------------------------------------------------------------------------------
+ if( sfc_temp(i) > tmelt ) then
+ if( has_dew(i) ) then
+ rlux(i,lt,ispec) = 1._r8/((1._r8/(3._r8*rlux(i,lt,ispec))) &
+ + 1.e-7_r8*heff(i,m) + foxd(m)/rlux_o3(i,lt))
+ end if
+ end if
+
+ end if
+ end do
+ end if
+ end do
+ else if( ispec == so2_ndx ) then
+ do lt = beglt,endlt
+ if( lt /= 7 ) then
+ do i = 1,ncol
+ if( fr_lnduse(i,lt) ) then
+ !-------------------------------------------------------------------------------------
+ ! no effect if sfc_temp < O C
+ !-------------------------------------------------------------------------------------
+ if( sfc_temp(i) > tmelt ) then
+ if( qs(i) <= spec_hum(i) ) then
+ rlux(i,lt,ispec) = 100._r8
+ end if
+ if( has_rain(i) ) then
+ ! rlux(i,lt,ispec) = 1./(2.e-4 + (1./(3.*rlu(index_season(i,lt),lt))))
+ rlux(i,lt,ispec) = 15._r8*rlu(index_season(i,lt),lt)/(5._r8 + 3.e-3_r8*rlu(index_season(i,lt),lt))
+ end if
+ end if
+ rclx(i,lt,ispec) = cts(i) + rcls(index_season(i,lt),lt)
+ rlux(i,lt,ispec) = cts(i) + rlux(i,lt,ispec)
+
+ end if
+ end do
+ end if
+ end do
+ do i = 1,ncol
+ if( fr_lnduse(i,1) .and. (has_dew(i) .or. has_rain(i)) ) then
+ rlux(i,1,ispec) = 50._r8
+ end if
+ end do
+ end if
+ end if
+ end do species_loop2
+
+ !-------------------------------------------------------------------------------------
+ ! compute rc
+ !-------------------------------------------------------------------------------------
+ term(:ncol) = 1.e-2_r8 * pressure_10m(:ncol) / (r*tv(:ncol))
+ species_loop3 : do ispec = 1,gas_pcnst
+ if( has_dvel(ispec) ) then
+ wrk(:) = 0._r8
+ lt_loop: do lt = beglt,endlt
+ do i = 1,ncol
+ if (fr_lnduse(i,lt)) then
+ resc(i) = 1._r8/( 1._r8/rsmx(i,lt,ispec) + 1._r8/rlux(i,lt,ispec) &
+ + 1._r8/(rdc(i) + rclx(i,lt,ispec)) &
+ + 1._r8/(rac(index_season(i,lt),lt) + rgsx(i,lt,ispec)))
+
+ resc(i) = max( 10._r8,resc(i) )
+
+ lnd_frc(i) = lcl_frc_landuse(i,lt)
+ endif
+ enddo
+ !-------------------------------------------------------------------------------------
+ ! ... compute average deposition velocity
+ !-------------------------------------------------------------------------------------
+ select case( solsym(ispec) )
+ case( 'SO2' )
+ if( lt == 7 ) then
+ where( fr_lnduse(:ncol,lt) )
+ ! assume no surface resistance for SO2 over water`
+ wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk))
+ endwhere
+ else
+ where( fr_lnduse(:ncol,lt) )
+ wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk) + resc(:))
+ endwhere
+ end if
+
+ ! JFL - increase in dry deposition of SO2 to improve bias over US/Europe
+ wrk(:) = wrk(:) * 2._r8
+
+ case( 'SO4' )
+ where( fr_lnduse(:ncol,lt) )
+ wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + rds(:,lt))
+ endwhere
+ case( 'NH4', 'NH4NO3', 'XNH4NO3' )
+ where( fr_lnduse(:ncol,lt) )
+ wrk(:) = wrk(:) + lnd_frc(:)/(dep_ra(:ncol,lt,lchnk) + 0.5_r8*rds(:,lt))
+ endwhere
+
+ !-------------------------------------------------------------------------------------
+ ! ... special case for Pb (for consistency with offline code)
+ !-------------------------------------------------------------------------------------
+ case( 'Pb' )
+ if( lt == 7 ) then
+ where( fr_lnduse(:ncol,lt) )
+ wrk(:) = wrk(:) + lnd_frc(:) * 0.05e-2_r8
+ endwhere
+ else
+ where( fr_lnduse(:ncol,lt) )
+ wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.2e-2_r8
+ endwhere
+ end if
+
+ !-------------------------------------------------------------------------------------
+ ! ... special case for carbon aerosols
+ !-------------------------------------------------------------------------------------
+ case( 'CB1', 'CB2', 'OC1', 'OC2', 'SOAM', 'SOAI', 'SOAT', 'SOAB','SOAX' )
+ if ( drydep_method == DD_XLND ) then
+ where( fr_lnduse(:ncol,lt) )
+ wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.10e-2_r8
+ endwhere
+ else
+ wrk(:ncol) = 0.10e-2_r8
+ endif
+
+ !-------------------------------------------------------------------------------------
+ ! deposition over ocean for HCN, CH3CN
+ ! velocity estimated from aircraft measurements (E.Apel, INTEX-B)
+ !-------------------------------------------------------------------------------------
+ case( 'HCN','CH3CN' )
+ if( lt == 7 ) then ! over ocean only
+ where( fr_lnduse(:ncol,lt) .and. snow(:ncol) < 0.01_r8 )
+ wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol) * 0.2e-2_r8
+ endwhere
+ end if
+ case default
+ where( fr_lnduse(:ncol,lt) )
+ wrk(:ncol) = wrk(:ncol) + lnd_frc(:ncol)/(dep_ra(:ncol,lt,lchnk) + dep_rb(:ncol,lt,lchnk) + resc(:ncol))
+ endwhere
+ end select
+ end do lt_loop
+ dvel(:ncol,ispec) = wrk(:ncol) * scaling_to_cm_per_s
+ dflx(:ncol,ispec) = term(:ncol) * dvel(:ncol,ispec) * mmr(:ncol,plev,ispec)
+ end if
+
+ end do species_loop3
+
+ if ( beglt > 1 ) return
+
+ !-------------------------------------------------------------------------------------
+ ! ... special adjustments
+ !-------------------------------------------------------------------------------------
+ if( mpan_ndx > 0 ) then
+ if( has_dvel(mpan_ndx) ) then
+ dvel(:ncol,mpan_ndx) = dvel(:ncol,mpan_ndx)/3._r8
+ dflx(:ncol,mpan_ndx) = term(:ncol) * dvel(:ncol,mpan_ndx) * mmr(:ncol,plev,mpan_ndx)
+ end if
+ end if
+ if( xmpan_ndx > 0 ) then
+ if( has_dvel(xmpan_ndx) ) then
+ dvel(:ncol,xmpan_ndx) = dvel(:ncol,xmpan_ndx)/3._r8
+ dflx(:ncol,xmpan_ndx) = term(:ncol) * dvel(:ncol,xmpan_ndx) * mmr(:ncol,plev,xmpan_ndx)
+ end if
+ end if
+
+ ! HCOOH, use CH3COOH dep.vel
+ if( hcooh_ndx > 0) then
+ if( has_dvel(hcooh_ndx) ) then
+ dvel(:ncol,hcooh_ndx) = dvel(:ncol,ch3cooh_ndx)
+ dflx(:ncol,hcooh_ndx) = term(:ncol) * dvel(:ncol,hcooh_ndx) * mmr(:ncol,plev,hcooh_ndx)
+ end if
+ end if
+!
+! SOG species
+!
+ if( sogm_ndx > 0) then
+ if( has_dvel(sogm_ndx) ) then
+ dvel(:ncol,sogm_ndx) = dvel(:ncol,ch3cooh_ndx)
+ dflx(:ncol,sogm_ndx) = term(:ncol) * dvel(:ncol,sogm_ndx) * mmr(:ncol,plev,sogm_ndx)
+ end if
+ end if
+ if( sogi_ndx > 0) then
+ if( has_dvel(sogi_ndx) ) then
+ dvel(:ncol,sogi_ndx) = dvel(:ncol,ch3cooh_ndx)
+ dflx(:ncol,sogi_ndx) = term(:ncol) * dvel(:ncol,sogi_ndx) * mmr(:ncol,plev,sogi_ndx)
+ end if
+ end if
+ if( sogt_ndx > 0) then
+ if( has_dvel(sogt_ndx) ) then
+ dvel(:ncol,sogt_ndx) = dvel(:ncol,ch3cooh_ndx)
+ dflx(:ncol,sogt_ndx) = term(:ncol) * dvel(:ncol,sogt_ndx) * mmr(:ncol,plev,sogt_ndx)
+ end if
+ end if
+ if( sogb_ndx > 0) then
+ if( has_dvel(sogb_ndx) ) then
+ dvel(:ncol,sogb_ndx) = dvel(:ncol,ch3cooh_ndx)
+ dflx(:ncol,sogb_ndx) = term(:ncol) * dvel(:ncol,sogb_ndx) * mmr(:ncol,plev,sogb_ndx)
+ end if
+ end if
+ if( sogx_ndx > 0) then
+ if( has_dvel(sogx_ndx) ) then
+ dvel(:ncol,sogx_ndx) = dvel(:ncol,ch3cooh_ndx)
+ dflx(:ncol,sogx_ndx) = term(:ncol) * dvel(:ncol,sogx_ndx) * mmr(:ncol,plev,sogx_ndx)
+ end if
+ end if
+!
+ end subroutine drydep_xactive
+
+ !-------------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------------
+ subroutine soilw_inti( ncfile, nlon_veg, nlat_veg, soilw_map )
+ !------------------------------------------------------------------
+ ! ... read primary soil moisture table
+ !------------------------------------------------------------------
+
+ use time_manager, only : get_calday
+
+ implicit none
+
+ !------------------------------------------------------------------
+ ! ... dummy args
+ !------------------------------------------------------------------
+ integer, intent(in) :: &
+ nlon_veg, &
+ nlat_veg
+ real(r8), pointer :: soilw_map(:,:,:)
+ character(len=*), intent(in) :: ncfile ! file name of netcdf file containing data
+
+ !------------------------------------------------------------------
+ ! ... local variables
+ !------------------------------------------------------------------
+ integer :: gndx = 0
+ integer :: nlat, & ! # of lats in soilw file
+ nlon ! # of lons in soilw file
+ integer :: i, ip, k, m
+ integer :: j, jl, ju
+ integer :: lev, day, ierr
+ type(file_desc_t) :: piofile
+ type(var_desc_t) :: vid
+
+ integer :: dimid_lat, dimid_lon, dimid_time
+ integer :: dates(12) = (/ 116, 214, 316, 415, 516, 615, &
+ 716, 816, 915, 1016, 1115, 1216 /)
+
+ character(len=shr_kind_cl) :: locfn
+
+ !-----------------------------------------------------------------------
+ ! ... open netcdf file
+ !-----------------------------------------------------------------------
+ call getfil (ncfile, locfn, 0)
+ call cam_pio_openfile (piofile, trim(locfn), PIO_NOWRITE)
+
+ !-----------------------------------------------------------------------
+ ! ... get longitudes
+ !-----------------------------------------------------------------------
+ ierr = pio_inq_dimid( piofile, 'lon', dimid_lon )
+ ierr = pio_inq_dimlen( piofile, dimid_lon, nlon )
+ if( nlon /= nlon_veg ) then
+ write(iulog,*) 'soilw_inti: soil and vegetation lons differ; ',nlon, nlon_veg
+ call endrun
+ end if
+ !-----------------------------------------------------------------------
+ ! ... get latitudes
+ !-----------------------------------------------------------------------
+ ierr = pio_inq_dimid( piofile, 'lat', dimid_lat )
+ ierr = pio_inq_dimlen( piofile, dimid_lat, nlat )
+ if( nlat /= nlat_veg ) then
+ write(iulog,*) 'soilw_inti: soil and vegetation lats differ; ',nlat, nlat_veg
+ call endrun
+ end if
+ !-----------------------------------------------------------------------
+ ! ... set times (days of year)
+ !-----------------------------------------------------------------------
+ ierr = pio_inq_dimid( piofile, 'time', dimid_time )
+ ierr = pio_inq_dimlen( piofile, dimid_time, ndays )
+ if( ndays /= 12 ) then
+ write(iulog,*) 'soilw_inti: dataset not a cyclical year'
+ call endrun
+ end if
+ allocate( days(ndays),stat=ierr )
+ if( ierr /= 0 ) then
+ write(iulog,*) 'soilw_inti: days allocation error = ',ierr
+ call endrun
+ end if
+ do m = 1,min(12,ndays)
+ days(m) = get_calday( dates(m), 0 )
+ end do
+
+ !------------------------------------------------------------------
+ ! ... allocate arrays
+ !------------------------------------------------------------------
+ allocate( soilw_map(nlon,nlat,ndays), stat=ierr )
+ if( ierr /= 0 ) then
+ write(iulog,*) 'soilw_inti: soilw_map allocation error = ',ierr
+ call endrun
+ end if
+
+ !------------------------------------------------------------------
+ ! ... read in the soil moisture
+ !------------------------------------------------------------------
+ ierr = pio_inq_varid( piofile, 'SOILW', vid )
+ ierr = pio_get_var( piofile, vid, soilw_map )
+ !------------------------------------------------------------------
+ ! ... close file
+ !------------------------------------------------------------------
+ call cam_pio_closefile( piofile )
+
+ end subroutine soilw_inti
+
+ !-------------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------------
+ subroutine chk_soilw( calday )
+ !--------------------------------------------------------------------
+ ! ... check timing for ub values
+ !--------------------------------------------------------------------
+
+ use mo_constants, only : dayspy
+
+ implicit none
+
+ !--------------------------------------------------------------------
+ ! ... dummy args
+ !--------------------------------------------------------------------
+ real(r8), intent(in) :: calday
+
+ !--------------------------------------------------------------------
+ ! ... local variables
+ !--------------------------------------------------------------------
+ integer :: m, upper
+ real(r8) :: numer, denom
+
+ !--------------------------------------------------------
+ ! ... setup the time interpolation
+ !--------------------------------------------------------
+ if( calday < days(1) ) then
+ next = 1
+ last = ndays
+ else
+ if( days(ndays) < dayspy ) then
+ upper = ndays
+ else
+ upper = ndays - 1
+ end if
+ do m = upper,1,-1
+ if( calday >= days(m) ) then
+ exit
+ end if
+ end do
+ last = m
+ next = mod( m,ndays ) + 1
+ end if
+ numer = calday - days(last)
+ denom = days(next) - days(last)
+ if( numer < 0._r8 ) then
+ numer = dayspy + numer
+ end if
+ if( denom < 0._r8 ) then
+ denom = dayspy + denom
+ end if
+ dels = max( min( 1._r8,numer/denom ),0._r8 )
+
+ end subroutine chk_soilw
+
+ !-------------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------------
+ subroutine set_soilw( soilw, lchnk, calday )
+ !--------------------------------------------------------------------
+ ! ... set the soil moisture
+ !--------------------------------------------------------------------
+
+ implicit none
+
+ !--------------------------------------------------------------------
+ ! ... dummy args
+ !--------------------------------------------------------------------
+ real(r8), intent(inout) :: soilw(pcols)
+ integer, intent(in) :: lchnk ! chunk indice
+ real(r8), intent(in) :: calday
+
+
+ integer :: i, ilon,ilat
+
+ call chk_soilw( calday )
+
+ soilw(:) = soilw_3d(:,last,lchnk) + dels *( soilw_3d(:,next,lchnk) - soilw_3d(:,last,lchnk))
+
+ end subroutine set_soilw
+
+ !-------------------------------------------------------------------------------------
+ !-------------------------------------------------------------------------------------
+ function has_drydep( name )
+
+ implicit none
+
+ character(len=*), intent(in) :: name
+
+ logical :: has_drydep
+ integer :: i
+
+ has_drydep = .false.
+
+ do i=1,nddvels
+ if ( trim(name) == trim(drydep_list(i)) ) then
+ has_drydep = .true.
+ exit
+ endif
+ enddo
+
+ endfunction has_drydep
+
+end module mo_drydep
diff --git a/src/chemistry/oslo_aero/mo_extfrc.F90 b/src/chemistry/oslo_aero/mo_extfrc.F90
new file mode 100644
index 0000000000..85efe5e92e
--- /dev/null
+++ b/src/chemistry/oslo_aero/mo_extfrc.F90
@@ -0,0 +1,416 @@
+module mo_extfrc
+ !---------------------------------------------------------------
+ ! ... insitu forcing module
+ !---------------------------------------------------------------
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use ppgrid, only : pver, pverp
+ use chem_mods, only : gas_pcnst, extcnt, extfrc_lst, frc_from_dataset, adv_mass
+ use spmd_utils, only : masterproc
+ use cam_abortutils,only : endrun
+ use cam_history, only : addfld, outfld, add_default, horiz_only
+ use cam_history_support,only : max_fieldname_len
+ use cam_logfile, only : iulog
+ use tracer_data, only : trfld,trfile
+ use mo_constants, only : avogadro
+
+ implicit none
+
+ type :: forcing
+ integer :: frc_ndx
+ real(r8) :: scalefactor
+ character(len=265):: filename
+ character(len=16) :: species
+ integer :: nsectors
+ character(len=32),pointer :: sectors(:)
+ type(trfld), pointer :: fields(:)
+ type(trfile) :: file
+ end type forcing
+
+ private
+ public :: extfrc_inti
+ public :: extfrc_set
+ public :: extfrc_timestep_init
+
+ save
+
+ integer, parameter :: time_span = 1
+
+ character(len=256) :: filename
+
+ type(forcing), allocatable :: forcings(:)
+ integer :: n_frc_files = 0
+
+contains
+
+ subroutine extfrc_inti( extfrc_specifier, extfrc_type_in, extfrc_cycle_yr, extfrc_fixed_ymd, extfrc_fixed_tod)
+
+ !-----------------------------------------------------------------------
+ ! ... initialize the surface forcings
+ !-----------------------------------------------------------------------
+ use cam_pio_utils, only : cam_pio_openfile, cam_pio_closefile
+ use pio, only : pio_inquire, pio_inq_varndims
+ use pio, only : pio_inq_varname, pio_nowrite, file_desc_t
+ use pio, only : pio_get_att, PIO_NOERR, PIO_GLOBAL
+ use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR,PIO_INTERNAL_ERROR
+ use mo_chem_utls, only : get_extfrc_ndx
+ use chem_mods, only : frc_from_dataset
+ use tracer_data, only : trcdata_init
+ use phys_control, only : phys_getopts
+ use string_utils, only : GLC
+ use m_MergeSorts, only : IndexSort
+
+ implicit none
+
+ !-----------------------------------------------------------------------
+ ! ... dummy arguments
+ !-----------------------------------------------------------------------
+ character(len=*), dimension(:), intent(in) :: extfrc_specifier
+ character(len=*), intent(in) :: extfrc_type_in
+ integer , intent(in) :: extfrc_cycle_yr
+ integer , intent(in) :: extfrc_fixed_ymd
+ integer , intent(in) :: extfrc_fixed_tod
+
+ !-----------------------------------------------------------------------
+ ! ... local variables
+ !-----------------------------------------------------------------------
+ integer :: astat
+ integer :: j, l, m, n, i,mm ! Indices
+ character(len=16) :: spc_name
+ character(len=256) :: frc_fnames(gas_pcnst)
+ real(r8) :: frc_scalefactor(gas_pcnst)
+ character(len=16) :: frc_species(gas_pcnst)
+ integer :: frc_indexes(gas_pcnst)
+ integer :: indx(gas_pcnst)
+
+ integer :: vid, ndims, nvars, isec, ierr
+ type(file_desc_t) :: ncid
+ character(len=32) :: varname
+
+ character(len=1), parameter :: filelist = ''
+ character(len=1), parameter :: datapath = ''
+ logical , parameter :: rmv_file = .false.
+ logical :: history_aerosol
+ logical :: history_chemistry
+ logical :: history_cesm_forcing
+
+ character(len=32) :: extfrc_type = ' '
+ character(len=80) :: file_interp_type = ' '
+ character(len=256) :: tmp_string = ' '
+ character(len=32) :: xchr = ' '
+ real(r8) :: xdbl
+
+ !-----------------------------------------------------------------------
+
+ call phys_getopts( &
+ history_aerosol_out = history_aerosol, &
+ history_chemistry_out = history_chemistry, &
+ history_cesm_forcing_out = history_cesm_forcing )
+
+ !-----------------------------------------------------------------------
+ ! ... species has insitu forcing ?
+ !-----------------------------------------------------------------------
+
+ !write(iulog,*) 'Species with insitu forcings'
+ mm = 0
+ indx(:) = 0
+
+ count_emis: do n=1,gas_pcnst
+
+ if ( len_trim(extfrc_specifier(n) ) == 0 ) then
+ exit count_emis
+ endif
+
+ i = scan(extfrc_specifier(n),'->')
+ spc_name = trim(adjustl(extfrc_specifier(n)(:i-1)))
+
+ ! need to parse out scalefactor ...
+ tmp_string = adjustl(extfrc_specifier(n)(i+2:))
+ j = scan( tmp_string, '*' )
+ if (j>0) then
+ xchr = tmp_string(1:j-1) ! get the multipler (left of the '*')
+ read( xchr, * ) xdbl ! convert the string to a real
+ tmp_string = adjustl(tmp_string(j+1:)) ! get the filepath name (right of the '*')
+ else
+ xdbl = 1._r8
+ endif
+ filename = trim(tmp_string)
+
+ m = get_extfrc_ndx( spc_name )
+
+ if ( m < 1 ) then
+ call endrun('extfrc_inti: '//trim(spc_name)// ' does not have an external source')
+ endif
+
+ if ( .not. frc_from_dataset(m) ) then
+ call endrun('extfrc_inti: '//trim(spc_name)//' cannot have external forcing from additional dataset')
+ endif
+
+ mm = mm+1
+ frc_species(mm) = spc_name
+ frc_fnames(mm) = filename
+ frc_indexes(mm) = m
+ frc_scalefactor(mm) = xdbl
+
+ indx(n)=n
+
+ enddo count_emis
+
+ n_frc_files = mm
+
+ if( n_frc_files < 1 ) then
+ if (masterproc) write(iulog,*) 'There are no species with insitu forcings'
+ return
+ end if
+
+ if (masterproc) write(iulog,*) ' '
+
+ !-----------------------------------------------------------------------
+ ! ... allocate forcings type array
+ !-----------------------------------------------------------------------
+ allocate( forcings(n_frc_files), stat=astat )
+ if( astat/= 0 ) then
+ write(iulog,*) 'extfrc_inti: failed to allocate forcings array; error = ',astat
+ call endrun('extfrc_inti: failed to allocate forcings array')
+ end if
+
+ !-----------------------------------------------------------------------
+ ! Sort the input files so that the emissions sources are summed in the
+ ! same order regardless of the order of the input files in the namelist
+ !-----------------------------------------------------------------------
+ if (n_frc_files > 0) then
+ call IndexSort(n_frc_files, indx, frc_fnames)
+ end if
+
+ !-----------------------------------------------------------------------
+ ! ... setup the forcing type array
+ !-----------------------------------------------------------------------
+ do m=1,n_frc_files
+ forcings(m)%frc_ndx = frc_indexes(indx(m))
+ forcings(m)%species = frc_species(indx(m))
+ forcings(m)%filename = frc_fnames(indx(m))
+ forcings(m)%scalefactor = frc_scalefactor(indx(m))
+ enddo
+
+ do n= 1,extcnt
+ if (frc_from_dataset(n)) then
+ spc_name = extfrc_lst(n)
+ call addfld( trim(spc_name)//'_XFRC', (/ 'lev' /), 'A', 'molec/cm3/s', &
+ 'external forcing for '//trim(spc_name) )
+ call addfld( trim(spc_name)//'_CLXF', horiz_only, 'A', 'molec/cm2/s', &
+ 'vertically integrated external forcing for '//trim(spc_name) )
+ call addfld( trim(spc_name)//'_CMXF', horiz_only, 'A', 'kg/m2/s', &
+ 'vertically integrated external forcing for '//trim(spc_name) )
+ if ( history_aerosol .or. history_chemistry ) then
+ call add_default( trim(spc_name)//'_CLXF', 1, ' ' )
+ call add_default( trim(spc_name)//'_CMXF', 1, ' ' )
+ endif
+ if ( history_cesm_forcing .and. spc_name == 'NO2' ) then
+ call add_default( trim(spc_name)//'_CLXF', 1, ' ' )
+ call add_default( trim(spc_name)//'_CMXF', 1, ' ' )
+ endif
+ endif
+ enddo
+
+ if (masterproc) then
+ !-----------------------------------------------------------------------
+ ! ... diagnostics
+ !-----------------------------------------------------------------------
+ write(iulog,*) ' '
+ write(iulog,*) 'extfrc_inti: diagnostics'
+ write(iulog,*) ' '
+ write(iulog,*) 'extfrc timing specs'
+ write(iulog,*) 'type = ',extfrc_type
+ if( extfrc_type == 'FIXED' ) then
+ write(iulog,*) ' fixed date = ', extfrc_fixed_ymd
+ write(iulog,*) ' fixed time = ', extfrc_fixed_tod
+ else if( extfrc_type == 'CYCLICAL' ) then
+ write(iulog,*) ' cycle year = ',extfrc_cycle_yr
+ end if
+ write(iulog,*) ' '
+ write(iulog,*) 'there are ',n_frc_files,' species with external forcing files'
+ do m = 1,n_frc_files
+ write(iulog,*) ' '
+ write(iulog,*) 'forcing type ',m
+ write(iulog,*) 'species = ',trim(forcings(m)%species)
+ write(iulog,*) 'frc ndx = ',forcings(m)%frc_ndx
+ write(iulog,*) 'filename= ',trim(forcings(m)%filename)
+ end do
+ write(iulog,*) ' '
+ endif
+
+ !-----------------------------------------------------------------------
+ ! read emis files to determine number of sectors
+ !-----------------------------------------------------------------------
+ frcing_loop: do m = 1, n_frc_files
+
+ forcings(m)%nsectors = 0
+
+ call cam_pio_openfile ( ncid, trim(forcings(m)%filename), PIO_NOWRITE)
+ ierr = pio_inquire (ncid, nVariables=nvars)
+
+ do vid = 1,nvars
+
+ ierr = pio_inq_varndims (ncid, vid, ndims)
+
+ if( ndims < 4 ) then
+ cycle
+ elseif( ndims > 4 ) then
+ ierr = pio_inq_varname (ncid, vid, varname)
+ write(iulog,*) 'extfrc_inti: Skipping variable ', trim(varname),', ndims = ',ndims, &
+ ' , species=',trim(forcings(m)%species)
+ cycle
+ end if
+
+ forcings(m)%nsectors = forcings(m)%nsectors+1
+
+ enddo
+
+ allocate( forcings(m)%sectors(forcings(m)%nsectors), stat=astat )
+ if( astat/= 0 ) then
+ write(iulog,*) 'extfrc_inti: failed to allocate forcings(m)%sectors array; error = ',astat
+ call endrun
+ end if
+
+ isec = 1
+ do vid = 1,nvars
+
+ ierr = pio_inq_varndims (ncid, vid, ndims)
+ if( ndims == 4 ) then
+ ierr = pio_inq_varname(ncid, vid, forcings(m)%sectors(isec))
+ isec = isec+1
+ endif
+
+ enddo
+
+ ! Global attribute 'input_method' overrides the ext_frc_type namelist setting on
+ ! a file-by-file basis. If the ext_frc file does not contain the 'input_method'
+ ! attribute then the ext_frc_type namelist setting is used.
+ call pio_seterrorhandling(ncid, PIO_BCAST_ERROR)
+ ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type)
+ call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR)
+ if ( ierr == PIO_NOERR) then
+ l = GLC(file_interp_type)
+ extfrc_type(1:l) = file_interp_type(1:l)
+ extfrc_type(l+1:) = ' '
+ else
+ extfrc_type = trim(extfrc_type_in)
+ endif
+
+ call cam_pio_closefile (ncid)
+
+ allocate(forcings(m)%file%in_pbuf(size(forcings(m)%sectors)))
+ forcings(m)%file%in_pbuf(:) = .false.
+ call trcdata_init( forcings(m)%sectors, &
+ forcings(m)%filename, filelist, datapath, &
+ forcings(m)%fields, &
+ forcings(m)%file, &
+ rmv_file, extfrc_cycle_yr, extfrc_fixed_ymd, extfrc_fixed_tod, trim(extfrc_type) )
+
+ enddo frcing_loop
+
+
+ end subroutine extfrc_inti
+
+ subroutine extfrc_timestep_init( pbuf2d, state )
+ !-----------------------------------------------------------------------
+ ! ... check serial case for time span
+ !-----------------------------------------------------------------------
+
+ use physics_types,only : physics_state
+ use ppgrid, only : begchunk, endchunk
+ use tracer_data, only : advance_trcdata
+ use physics_buffer, only : physics_buffer_desc
+
+ implicit none
+
+ type(physics_state), intent(in):: state(begchunk:endchunk)
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ !-----------------------------------------------------------------------
+ ! ... local variables
+ !-----------------------------------------------------------------------
+ integer :: m
+
+ do m = 1,n_frc_files
+ call advance_trcdata( forcings(m)%fields, forcings(m)%file, state, pbuf2d )
+ end do
+
+ end subroutine extfrc_timestep_init
+
+ subroutine extfrc_set( lchnk, zint, frcing, ncol )
+
+ !--------------------------------------------------------
+ ! ... form the external forcing
+ !--------------------------------------------------------
+ use mo_chem_utls, only : get_spc_ndx
+
+ implicit none
+
+ !--------------------------------------------------------
+ ! ... dummy arguments
+ !--------------------------------------------------------
+ integer, intent(in) :: ncol ! columns in chunk
+ integer, intent(in) :: lchnk ! chunk index
+ real(r8), intent(in) :: zint(ncol, pverp) ! interface geopot above surface (km)
+ real(r8), intent(inout) :: frcing(ncol,pver,extcnt) ! insitu forcings (molec/cm^3/s)
+
+ !--------------------------------------------------------
+ ! ... local variables
+ !--------------------------------------------------------
+ integer :: m, n
+ character(len=max_fieldname_len) :: xfcname
+ real(r8) :: frcing_col(1:ncol), frcing_col_kg(1:ncol)
+ integer :: k, isec
+ real(r8),parameter :: km_to_cm = 1.e5_r8
+ real(r8),parameter :: cm2_to_m2 = 1.e4_r8
+ real(r8),parameter :: kg_to_g = 1.e-3_r8
+ real(r8) :: molec_to_kg
+ integer :: spc_ndx
+
+ if( n_frc_files < 1 .or. extcnt < 1 ) then
+ return
+ end if
+
+ frcing(:,:,:) = 0._r8
+
+ !--------------------------------------------------------
+ ! ... set non-zero forcings
+ !--------------------------------------------------------
+ file_loop : do m = 1,n_frc_files
+
+ n = forcings(m)%frc_ndx
+
+ do isec = 1,forcings(m)%nsectors
+ frcing(:ncol,:,n) = frcing(:ncol,:,n) + forcings(m)%scalefactor*forcings(m)%fields(isec)%data(:ncol,:,lchnk)
+ enddo
+
+ enddo file_loop
+
+ frc_loop : do n = 1,extcnt
+ if (frc_from_dataset(n)) then
+
+ xfcname = trim(extfrc_lst(n))//'_XFRC'
+ call outfld( xfcname, frcing(:ncol,:,n), ncol, lchnk )
+
+ spc_ndx = get_spc_ndx( extfrc_lst(n) )
+ molec_to_kg = adv_mass( spc_ndx ) / avogadro *cm2_to_m2 * kg_to_g
+
+ frcing_col(:ncol) = 0._r8
+ frcing_col_kg(:ncol) = 0._r8
+ do k = 1,pver
+ frcing_col(:ncol) = frcing_col(:ncol) + frcing(:ncol,k,n)*(zint(:ncol,k)-zint(:ncol,k+1))*km_to_cm
+ frcing_col_kg(:ncol) = frcing_col_kg(:ncol) + frcing(:ncol,k,n)*(zint(:ncol,k)-zint(:ncol,k+1))*km_to_cm*molec_to_kg
+ enddo
+
+ xfcname = trim(extfrc_lst(n))//'_CLXF'
+ call outfld( xfcname, frcing_col(:ncol), ncol, lchnk )
+ xfcname = trim(extfrc_lst(n))//'_CMXF'
+ call outfld( xfcname, frcing_col_kg(:ncol), ncol, lchnk )
+ endif
+ end do frc_loop
+
+ end subroutine extfrc_set
+
+
+end module mo_extfrc
diff --git a/src/chemistry/oslo_aero/mo_gas_phase_chemdr.F90 b/src/chemistry/oslo_aero/mo_gas_phase_chemdr.F90
new file mode 100644
index 0000000000..cd3388b1f0
--- /dev/null
+++ b/src/chemistry/oslo_aero/mo_gas_phase_chemdr.F90
@@ -0,0 +1,1237 @@
+module mo_gas_phase_chemdr
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use shr_const_mod, only : pi => shr_const_pi
+ use constituents, only : pcnst
+ use cam_history, only : fieldname_len
+ use chem_mods, only : phtcnt, rxntot, gas_pcnst
+ use chem_mods, only : rxt_tag_cnt, rxt_tag_lst, rxt_tag_map, extcnt, num_rnts
+ use dust_model, only : dust_names, ndust => dust_nbin
+ use ppgrid, only : pcols, pver
+ use phys_control, only : phys_getopts
+ use carma_flags_mod, only : carma_hetchem_feedback
+ use chem_prod_loss_diags, only: chem_prod_loss_diags_init, chem_prod_loss_diags_out
+
+ implicit none
+ save
+
+ private
+ public :: gas_phase_chemdr, gas_phase_chemdr_inti
+ public :: map2chm
+
+ integer :: map2chm(pcnst) = 0 ! index map to/from chemistry/constituents list
+
+ integer :: synoz_ndx, so4_ndx, h2o_ndx, o2_ndx, o_ndx, hno3_ndx, hcl_ndx, dst_ndx, cldice_ndx, snow_ndx
+ integer :: o3_ndx, o3s_ndx
+ integer :: het1_ndx
+ integer :: ndx_cldfr, ndx_cmfdqr, ndx_nevapr, ndx_cldtop, ndx_prain
+ integer :: ndx_h2so4
+#ifdef OSLO_AERO
+ logical :: inv_o3, inv_oh, inv_no3, inv_ho2
+ integer :: id_o3, id_oh, id_no3, id_ho2
+#endif
+!
+! CCMI
+!
+ integer :: st80_25_ndx
+ integer :: st80_25_tau_ndx
+ integer :: aoa_nh_ndx
+ integer :: aoa_nh_ext_ndx
+ integer :: nh_5_ndx
+ integer :: nh_50_ndx
+ integer :: nh_50w_ndx
+ integer :: sad_pbf_ndx
+ integer :: cb1_ndx,cb2_ndx,oc1_ndx,oc2_ndx,dst1_ndx,dst2_ndx,sslt1_ndx,sslt2_ndx
+ integer :: soa_ndx,soai_ndx,soam_ndx,soat_ndx,soab_ndx,soax_ndx
+
+ character(len=fieldname_len),dimension(rxt_tag_cnt) :: tag_names
+ character(len=fieldname_len),dimension(extcnt) :: extfrc_name
+
+ logical :: pm25_srf_diag
+ logical :: pm25_srf_diag_soa
+
+ logical :: convproc_do_aer
+ integer :: ele_temp_ndx, ion_temp_ndx
+
+contains
+
+ subroutine gas_phase_chemdr_inti()
+
+ use mo_chem_utls, only : get_spc_ndx, get_extfrc_ndx, get_rxt_ndx, get_inv_ndx
+ use cam_history, only : addfld,add_default,horiz_only
+ use mo_chm_diags, only : chm_diags_inti
+ use constituents, only : cnst_get_ind
+ use physics_buffer, only : pbuf_get_index
+ use rate_diags, only : rate_diags_init
+ use cam_abortutils, only : endrun
+
+ implicit none
+
+ character(len=3) :: string
+ integer :: n, m, err, ii
+ logical :: history_cesm_forcing
+ character(len=16) :: unitstr
+ !-----------------------------------------------------------------------
+ logical :: history_scwaccm_forcing
+
+ call phys_getopts( history_scwaccm_forcing_out = history_scwaccm_forcing )
+
+ call phys_getopts( convproc_do_aer_out = convproc_do_aer, history_cesm_forcing_out=history_cesm_forcing )
+
+#if defined(OSLO_AERO)
+ inv_o3 = get_inv_ndx('O3') > 0
+ inv_oh = get_inv_ndx('OH') > 0
+ inv_no3 = get_inv_ndx('NO3') > 0
+ inv_ho2 = get_inv_ndx('HO2') > 0
+ if (inv_o3) then
+ id_o3 = get_inv_ndx('O3')
+ endif
+ if (inv_oh) then
+ id_oh = get_inv_ndx('OH')
+ endif
+ if (inv_no3) then
+ id_no3 = get_inv_ndx('NO3')
+ endif
+ if (inv_ho2) then
+ id_ho2 = get_inv_ndx('HO2')
+ endif
+#endif
+
+ ndx_h2so4 = get_spc_ndx('H2SO4')
+!
+! CCMI
+!
+ st80_25_ndx = get_spc_ndx ('ST80_25')
+ st80_25_tau_ndx = get_rxt_ndx ('ST80_25_tau')
+ aoa_nh_ndx = get_spc_ndx ('AOA_NH')
+ aoa_nh_ext_ndx = get_extfrc_ndx('AOA_NH')
+ nh_5_ndx = get_spc_ndx('NH_5')
+ nh_50_ndx = get_spc_ndx('NH_50')
+ nh_50w_ndx = get_spc_ndx('NH_50W')
+!
+ cb1_ndx = get_spc_ndx('CB1')
+ cb2_ndx = get_spc_ndx('CB2')
+ oc1_ndx = get_spc_ndx('OC1')
+ oc2_ndx = get_spc_ndx('OC2')
+ dst1_ndx = get_spc_ndx('DST01')
+ dst2_ndx = get_spc_ndx('DST02')
+ sslt1_ndx = get_spc_ndx('SSLT01')
+ sslt2_ndx = get_spc_ndx('SSLT02')
+ soa_ndx = get_spc_ndx('SOA')
+ soam_ndx = get_spc_ndx('SOAM')
+ soai_ndx = get_spc_ndx('SOAI')
+ soat_ndx = get_spc_ndx('SOAT')
+ soab_ndx = get_spc_ndx('SOAB')
+ soax_ndx = get_spc_ndx('SOAX')
+
+ pm25_srf_diag = cb1_ndx>0 .and. cb2_ndx>0 .and. oc1_ndx>0 .and. oc2_ndx>0 &
+ .and. dst1_ndx>0 .and. dst2_ndx>0 .and. sslt1_ndx>0 .and. sslt2_ndx>0 &
+ .and. soa_ndx>0
+
+ pm25_srf_diag_soa = cb1_ndx>0 .and. cb2_ndx>0 .and. oc1_ndx>0 .and. oc2_ndx>0 &
+ .and. dst1_ndx>0 .and. dst2_ndx>0 .and. sslt1_ndx>0 .and. sslt2_ndx>0 &
+ .and. soam_ndx>0 .and. soai_ndx>0 .and. soat_ndx>0 .and. soab_ndx>0 .and. soax_ndx>0
+
+ if ( pm25_srf_diag .or. pm25_srf_diag_soa) then
+ call addfld('PM25_SRF',horiz_only,'I','kg/kg','bottom layer PM2.5 mixing ratio' )
+ endif
+ call addfld('U_SRF',horiz_only,'I','m/s','bottom layer wind velocity' )
+ call addfld('V_SRF',horiz_only,'I','m/s','bottom layer wind velocity' )
+ call addfld('Q_SRF',horiz_only,'I','kg/kg','bottom layer specific humidity' )
+!
+ het1_ndx= get_rxt_ndx('het1')
+ o3_ndx = get_spc_ndx('O3')
+ o3s_ndx = get_spc_ndx('O3S')
+ o_ndx = get_spc_ndx('O')
+ o2_ndx = get_spc_ndx('O2')
+ so4_ndx = get_spc_ndx('SO4')
+ h2o_ndx = get_spc_ndx('H2O')
+ hno3_ndx = get_spc_ndx('HNO3')
+ hcl_ndx = get_spc_ndx('HCL')
+ dst_ndx = get_spc_ndx( dust_names(1) )
+ synoz_ndx = get_extfrc_ndx( 'SYNOZ' )
+ call cnst_get_ind( 'CLDICE', cldice_ndx )
+ call cnst_get_ind( 'SNOWQM', snow_ndx, abort=.false. )
+
+
+ do m = 1,extcnt
+ WRITE(UNIT=string, FMT='(I2.2)') m
+ extfrc_name(m) = 'extfrc_'// trim(string)
+ call addfld( extfrc_name(m), (/ 'lev' /), 'I', ' ', 'ext frcing' )
+ end do
+
+ do n = 1,rxt_tag_cnt
+ tag_names(n) = trim(rxt_tag_lst(n))
+ if (n<=phtcnt) then
+ call addfld( tag_names(n), (/ 'lev' /), 'I', '/s', 'photolysis rate constant' )
+ else
+ ii = n-phtcnt
+ select case(num_rnts(ii))
+ case(1)
+ unitstr='/s'
+ case(2)
+ unitstr='cm3/molecules/s'
+ case(3)
+ unitstr='cm6/molecules2/s'
+ case default
+ call endrun('gas_phase_chemdr_inti: invalid value in num_rnts used to set units in reaction rate constant')
+ end select
+ call addfld( tag_names(n), (/ 'lev' /), 'I', unitstr, 'reaction rate constant' )
+ endif
+ if (history_scwaccm_forcing) then
+ select case (trim(tag_names(n)))
+ case ('jh2o_a', 'jh2o_b', 'jh2o_c' )
+ call add_default( tag_names(n), 1, ' ')
+ end select
+ endif
+ enddo
+
+ call addfld( 'DTCBS', horiz_only, 'I', ' ','photolysis diagnostic black carbon OD' )
+ call addfld( 'DTOCS', horiz_only, 'I', ' ','photolysis diagnostic organic carbon OD' )
+ call addfld( 'DTSO4', horiz_only, 'I', ' ','photolysis diagnostic SO4 OD' )
+ call addfld( 'DTSOA', horiz_only, 'I', ' ','photolysis diagnostic SOA OD' )
+ call addfld( 'DTANT', horiz_only, 'I', ' ','photolysis diagnostic NH4SO4 OD' )
+ call addfld( 'DTSAL', horiz_only, 'I', ' ','photolysis diagnostic salt OD' )
+ call addfld( 'DTDUST', horiz_only, 'I', ' ','photolysis diagnostic dust OD' )
+ call addfld( 'DTTOTAL', horiz_only, 'I', ' ','photolysis diagnostic total aerosol OD' )
+ call addfld( 'FRACDAY', horiz_only, 'I', ' ','photolysis diagnostic fraction of day' )
+
+ call addfld( 'QDSAD', (/ 'lev' /), 'I', '/s', 'water vapor sad delta' )
+ call addfld( 'SAD_STRAT', (/ 'lev' /), 'I', 'cm2/cm3', 'stratospheric aerosol SAD' )
+ call addfld( 'SAD_SULFC', (/ 'lev' /), 'I', 'cm2/cm3', 'chemical sulfate aerosol SAD' )
+ call addfld( 'SAD_SAGE', (/ 'lev' /), 'I', 'cm2/cm3', 'SAGE sulfate aerosol SAD' )
+ call addfld( 'SAD_LNAT', (/ 'lev' /), 'I', 'cm2/cm3', 'large-mode NAT aerosol SAD' )
+ call addfld( 'SAD_ICE', (/ 'lev' /), 'I', 'cm2/cm3', 'water-ice aerosol SAD' )
+ call addfld( 'RAD_SULFC', (/ 'lev' /), 'I', 'cm', 'chemical sad sulfate' )
+ call addfld( 'RAD_LNAT', (/ 'lev' /), 'I', 'cm', 'large nat radius' )
+ call addfld( 'RAD_ICE', (/ 'lev' /), 'I', 'cm', 'sad ice' )
+ call addfld( 'SAD_TROP', (/ 'lev' /), 'I', 'cm2/cm3', 'tropospheric aerosol SAD' )
+ call addfld( 'SAD_AERO', (/ 'lev' /), 'I', 'cm2/cm3', 'aerosol surface area density' )
+ if (history_cesm_forcing) then
+ call add_default ('SAD_AERO',8,' ')
+ endif
+ call addfld( 'REFF_AERO', (/ 'lev' /), 'I', 'cm', 'aerosol effective radius' )
+ call addfld( 'SULF_TROP', (/ 'lev' /), 'I', 'mol/mol', 'tropospheric aerosol SAD' )
+ call addfld( 'QDSETT', (/ 'lev' /), 'I', '/s', 'water vapor settling delta' )
+ call addfld( 'QDCHEM', (/ 'lev' /), 'I', '/s', 'water vapor chemistry delta')
+ call addfld( 'HNO3_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'total HNO3' )
+ call addfld( 'HNO3_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensed HNO3' )
+ call addfld( 'HNO3_NAT', (/ 'lev' /), 'I', 'mol/mol', 'NAT condensed HNO3' )
+ call addfld( 'HNO3_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase hno3' )
+ call addfld( 'H2O_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase h2o' )
+ call addfld( 'HCL_TOTAL', (/ 'lev' /), 'I', 'mol/mol', 'total hcl' )
+ call addfld( 'HCL_GAS', (/ 'lev' /), 'I', 'mol/mol', 'gas-phase hcl' )
+ call addfld( 'HCL_STS', (/ 'lev' /), 'I', 'mol/mol', 'STS condensed HCL' )
+
+ !++IH: Adding extra fields for oxi-output (before and after diurnal variations.)
+ call addfld ('OH_bef ', (/ 'lev' /), 'A','unit', 'OH invariants before adding diurnal variations' )
+ call addfld ('HO2_bef ', (/ 'lev' /), 'A','unit', 'HO2 invariants before adding diurnal variations' )
+ call addfld ('NO3_bef ', (/ 'lev' /), 'A','unit', 'NO3 invariants before adding diurnal variations' )
+ call addfld ('OH_aft ', (/ 'lev' /), 'A','unit', 'OH invariants after adding diurnal variations' )
+ call addfld ('HO2_aft ', (/ 'lev' /), 'A','unit', 'HO2 invariants after adding diurnal variations' )
+ call addfld ('NO3_aft ', (/ 'lev' /), 'A','unit', 'NO3 invariants after adding diurnal variations' )
+
+ call add_default ('OH_bef ', 1, ' ')
+ call add_default ('HO2_bef ', 1, ' ')
+ call add_default ('NO3_bef ', 1, ' ')
+ call add_default ('OH_aft ', 1, ' ')
+ call add_default ('HO2_aft ', 1, ' ')
+ call add_default ('NO3_aft ', 1, ' ')
+ !--IH
+
+ if (het1_ndx>0) then
+ call addfld( 'het1_total', (/ 'lev' /), 'I', '/s', 'total N2O5 + H2O het rate constant' )
+ endif
+ call addfld( 'SZA', horiz_only, 'I', 'degrees', 'solar zenith angle' )
+
+ call chm_diags_inti()
+ call rate_diags_init()
+
+!-----------------------------------------------------------------------
+! get pbuf indicies
+!-----------------------------------------------------------------------
+ ndx_cldfr = pbuf_get_index('CLD')
+ ndx_cmfdqr = pbuf_get_index('RPRDTOT')
+ ndx_nevapr = pbuf_get_index('NEVAPR')
+ ndx_prain = pbuf_get_index('PRAIN')
+ ndx_cldtop = pbuf_get_index('CLDTOP')
+
+ sad_pbf_ndx= pbuf_get_index('VOLC_SAD',errcode=err) ! prescribed strat aerosols (volcanic)
+ if (.not.sad_pbf_ndx>0) sad_pbf_ndx = pbuf_get_index('SADSULF',errcode=err) ! CARMA's version of strat aerosols
+
+ ele_temp_ndx = pbuf_get_index('TElec',errcode=err)! electron temperature index
+ ion_temp_ndx = pbuf_get_index('TIon',errcode=err) ! ion temperature index
+
+ ! diagnostics for stratospheric heterogeneous reactions
+ call addfld( 'GAMMA_HET1', (/ 'lev' /), 'I', '1', 'Reaction Probability' )
+ call addfld( 'GAMMA_HET2', (/ 'lev' /), 'I', '1', 'Reaction Probability' )
+ call addfld( 'GAMMA_HET3', (/ 'lev' /), 'I', '1', 'Reaction Probability' )
+ call addfld( 'GAMMA_HET4', (/ 'lev' /), 'I', '1', 'Reaction Probability' )
+ call addfld( 'GAMMA_HET5', (/ 'lev' /), 'I', '1', 'Reaction Probability' )
+ call addfld( 'GAMMA_HET6', (/ 'lev' /), 'I', '1', 'Reaction Probability' )
+ call addfld( 'WTPER', (/ 'lev' /), 'I', '%', 'H2SO4 Weight Percent' )
+
+ call chem_prod_loss_diags_init
+
+ end subroutine gas_phase_chemdr_inti
+
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, &
+ phis, zm, zi, calday, &
+ tfld, pmid, pdel, pint, &
+ cldw, troplev, troplevchem, &
+ ncldwtr, ufld, vfld, &
+ delt, ps, xactive_prates, &
+ fsds, ts, asdir, ocnfrac, icefrac, &
+ precc, precl, snowhland, ghg_chem, latmapback, &
+ drydepflx, wetdepflx, cflx, fire_sflx, fire_ztop, nhx_nitrogen_flx, noy_nitrogen_flx, qtend, pbuf)
+
+ !-----------------------------------------------------------------------
+ ! ... Chem_solver advances the volumetric mixing ratio
+ ! forward one time step via a combination of explicit,
+ ! ebi, hov, fully implicit, and/or rodas algorithms.
+ !-----------------------------------------------------------------------
+
+ use chem_mods, only : nabscol, nfs, indexm, clscnt4
+ use physconst, only : rga
+ use mo_photo, only : set_ub_col, setcol, table_photo, xactive_photo
+ use mo_exp_sol, only : exp_sol
+ use mo_imp_sol, only : imp_sol
+ use mo_setrxt, only : setrxt
+ use mo_adjrxt, only : adjrxt
+ use mo_phtadj, only : phtadj
+ use llnl_O1D_to_2OH_adj,only : O1D_to_2OH_adj
+ use mo_usrrxt, only : usrrxt
+ use mo_setinv, only : setinv
+ use mo_negtrc, only : negtrc
+ use mo_sulf, only : sulf_interp
+ use mo_setext, only : setext
+ use fire_emissions, only : fire_emissions_vrt
+ use mo_sethet, only : sethet
+ use mo_drydep, only : drydep, set_soilw
+ use seq_drydep_mod, only : DD_XLND, DD_XATM, DD_TABL, drydep_method
+ use mo_fstrat, only : set_fstrat_vals, set_fstrat_h2o
+ use noy_ubc, only : noy_ubc_set
+ use mo_flbc, only : flbc_set
+ use phys_grid, only : get_rlat_all_p, get_rlon_all_p, get_lat_all_p, get_lon_all_p
+ use mo_mean_mass, only : set_mean_mass
+ use cam_history, only : outfld
+ use wv_saturation, only : qsat
+ use constituents, only : cnst_mw
+ use mo_drydep, only : has_drydep
+ use time_manager, only : get_ref_date
+ use mo_ghg_chem, only : ghg_chem_set_rates, ghg_chem_set_flbc
+ use mo_sad, only : sad_strat_calc
+ use charge_neutrality, only : charge_balance
+ use mo_strato_rates, only : ratecon_sfstrat
+ use mo_aero_settling, only : strat_aer_settling
+ use shr_orb_mod, only : shr_orb_decl
+ use cam_control_mod, only : lambm0, eccen, mvelpp, obliqr
+ use mo_strato_rates, only : has_strato_chem
+ use short_lived_species,only: set_short_lived_species,get_short_lived_species
+ use mo_chm_diags, only : chm_diags, het_diags
+ use perf_mod, only : t_startf, t_stopf
+ use gas_wetdep_opts, only : gas_wetdep_method
+#if (defined OSLO_AERO)
+ use oxi_diurnal_var, only : set_diurnal_invariants
+#endif
+ use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx
+ use infnan, only : nan, assignment(=)
+ use rate_diags, only : rate_diags_calc
+ use mo_mass_xforms, only : mmr2vmr, vmr2mmr, h2o_to_vmr, mmr2vmri
+ use orbit, only : zenith
+!
+! LINOZ
+!
+ use lin_strat_chem, only : do_lin_strat_chem, lin_strat_chem_solve
+ use linoz_data, only : has_linoz_data
+!
+! for aqueous chemistry and aerosol growth
+!
+ use aero_model, only : aero_model_gasaerexch
+
+ use aero_model, only : aero_model_strat_surfarea
+
+ implicit none
+
+ !-----------------------------------------------------------------------
+ ! ... Dummy arguments
+ !-----------------------------------------------------------------------
+ integer, intent(in) :: lchnk ! chunk index
+ integer, intent(in) :: ncol ! number columns in chunk
+ integer, intent(in) :: imozart ! gas phase start index in q
+ real(r8), intent(in) :: delt ! timestep (s)
+ real(r8), intent(in) :: calday ! day of year
+ real(r8), intent(in) :: ps(pcols) ! surface pressure
+ real(r8), intent(in) :: phis(pcols) ! surface geopotential
+ real(r8),target,intent(in) :: tfld(pcols,pver) ! midpoint temperature (K)
+ real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures (Pa)
+ real(r8), intent(in) :: pdel(pcols,pver) ! pressure delta about midpoints (Pa)
+ real(r8), intent(in) :: ufld(pcols,pver) ! zonal velocity (m/s)
+ real(r8), intent(in) :: vfld(pcols,pver) ! meridional velocity (m/s)
+ real(r8), intent(in) :: cldw(pcols,pver) ! cloud water (kg/kg)
+ real(r8), intent(in) :: ncldwtr(pcols,pver) ! droplet number concentration (#/kg)
+ real(r8), intent(in) :: zm(pcols,pver) ! midpoint geopotential height above the surface (m)
+ real(r8), intent(in) :: zi(pcols,pver+1) ! interface geopotential height above the surface (m)
+ real(r8), intent(in) :: pint(pcols,pver+1) ! interface pressures (Pa)
+ real(r8), intent(in) :: q(pcols,pver,pcnst) ! species concentrations (kg/kg)
+ real(r8),pointer, intent(in) :: fire_sflx(:,:) ! fire emssions surface flux (kg/m^2/s)
+ real(r8),pointer, intent(in) :: fire_ztop(:) ! top of vertical distribution of fire emssions (m)
+ logical, intent(in) :: xactive_prates
+ real(r8), intent(in) :: fsds(pcols) ! longwave down at sfc
+ real(r8), intent(in) :: icefrac(pcols) ! sea-ice areal fraction
+ real(r8), intent(in) :: ocnfrac(pcols) ! ocean areal fraction
+ real(r8), intent(in) :: asdir(pcols) ! albedo: shortwave, direct
+ real(r8), intent(in) :: ts(pcols) ! sfc temp (merged w/ocean if coupled)
+ real(r8), intent(in) :: precc(pcols) !
+ real(r8), intent(in) :: precl(pcols) !
+ real(r8), intent(in) :: snowhland(pcols) !
+ logical, intent(in) :: ghg_chem
+ integer, intent(in) :: latmapback(pcols)
+ integer, intent(in) :: troplev(pcols) ! trop/strat separation vertical index
+ integer, intent(in) :: troplevchem(pcols) ! trop/strat chemistry separation vertical index
+ real(r8), intent(inout) :: qtend(pcols,pver,pcnst) ! species tendencies (kg/kg/s)
+ real(r8), intent(inout) :: cflx(pcols,pcnst) ! constituent surface flux (kg/m^2/s)
+ real(r8), intent(out) :: drydepflx(pcols,pcnst) ! dry deposition flux (kg/m^2/s)
+ real(r8), intent(in) :: wetdepflx(pcols,pcnst) ! wet deposition flux (kg/m^2/s)
+ real(r8), intent(out) :: nhx_nitrogen_flx(pcols)
+ real(r8), intent(out) :: noy_nitrogen_flx(pcols)
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ real(r8), parameter :: m2km = 1.e-3_r8
+ real(r8), parameter :: Pa2mb = 1.e-2_r8
+
+ real(r8), pointer :: prain(:,:)
+ real(r8), pointer :: nevapr(:,:)
+ real(r8), pointer :: cmfdqr(:,:)
+ real(r8), pointer :: cldfr(:,:)
+ real(r8), pointer :: cldtop(:)
+
+ integer :: i, k, m, n
+ integer :: tim_ndx
+ real(r8) :: delt_inverse
+ real(r8) :: esfact
+ integer :: latndx(pcols) ! chunk lat indicies
+ integer :: lonndx(pcols) ! chunk lon indicies
+ real(r8) :: invariants(ncol,pver,nfs)
+ real(r8) :: col_dens(ncol,pver,max(1,nabscol)) ! column densities (molecules/cm^2)
+ real(r8) :: col_delta(ncol,0:pver,max(1,nabscol)) ! layer column densities (molecules/cm^2)
+ real(r8) :: extfrc(ncol,pver,max(1,extcnt))
+ real(r8) :: vmr(ncol,pver,gas_pcnst) ! xported species (vmr)
+ real(r8) :: reaction_rates(ncol,pver,max(1,rxntot)) ! reaction rates
+ real(r8) :: depvel(ncol,gas_pcnst) ! dry deposition velocity (cm/s)
+ real(r8) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! washout rate (1/s)
+ real(r8), dimension(ncol,pver) :: &
+ h2ovmr, & ! water vapor volume mixing ratio
+ mbar, & ! mean wet atmospheric mass ( amu )
+ zmid, & ! midpoint geopotential in km
+ zmidr, & ! midpoint geopotential in km realitive to surf
+ sulfate, & ! trop sulfate aerosols
+ pmb ! pressure at midpoints ( hPa )
+ real(r8), dimension(ncol,pver) :: &
+ cwat, & ! cloud water mass mixing ratio (kg/kg)
+ wrk
+ real(r8), dimension(ncol,pver+1) :: &
+ zintr ! interface geopotential in km realitive to surf
+ real(r8), dimension(ncol,pver+1) :: &
+ zint ! interface geopotential in km
+ real(r8), dimension(ncol) :: &
+ zen_angle, & ! solar zenith angles
+ zsurf, & ! surface height (m)
+ rlats, rlons ! chunk latitudes and longitudes (radians)
+ real(r8) :: sza(ncol) ! solar zenith angles (degrees)
+ real(r8), parameter :: rad2deg = 180._r8/pi ! radians to degrees conversion factor
+ real(r8) :: relhum(ncol,pver) ! relative humidity
+ real(r8) :: satv(ncol,pver) ! wrk array for relative humidity
+ real(r8) :: satq(ncol,pver) ! wrk array for relative humidity
+
+ integer :: j
+ integer :: ltrop_sol(pcols) ! tropopause vertical index used in chem solvers
+ real(r8), pointer :: strato_sad(:,:) ! stratospheric sad (1/cm)
+
+ real(r8) :: sad_trop(pcols,pver) ! total tropospheric sad (cm^2/cm^3)
+ real(r8) :: reff(pcols,pver) ! aerosol effective radius (cm)
+ real(r8) :: reff_strat(pcols,pver) ! stratospheric aerosol effective radius (cm)
+
+ real(r8) :: tvs(pcols)
+ integer :: ncdate,yr,mon,day,sec
+ real(r8) :: wind_speed(pcols) ! surface wind speed (m/s)
+ logical, parameter :: dyn_soilw = .false.
+ logical :: table_soilw
+ real(r8) :: soilw(pcols)
+ real(r8) :: prect(pcols)
+ real(r8) :: sflx(pcols,gas_pcnst)
+ real(r8) :: wetdepflx_diag(pcols,gas_pcnst)
+ real(r8) :: dust_vmr(ncol,pver,ndust)
+ real(r8) :: dt_diag(pcols,8) ! od diagnostics
+ real(r8) :: fracday(pcols) ! fraction of day
+ real(r8) :: o2mmr(ncol,pver) ! o2 concentration (kg/kg)
+ real(r8) :: ommr(ncol,pver) ! o concentration (kg/kg)
+ real(r8) :: mmr(pcols,pver,gas_pcnst) ! chem working concentrations (kg/kg)
+ real(r8) :: mmr_new(pcols,pver,gas_pcnst) ! chem working concentrations (kg/kg)
+ real(r8) :: hno3_gas(ncol,pver) ! hno3 gas phase concentration (mol/mol)
+ real(r8) :: hno3_cond(ncol,pver,2) ! hno3 condensed phase concentration (mol/mol)
+ real(r8) :: hcl_gas(ncol,pver) ! hcl gas phase concentration (mol/mol)
+ real(r8) :: hcl_cond(ncol,pver) ! hcl condensed phase concentration (mol/mol)
+ real(r8) :: h2o_gas(ncol,pver) ! h2o gas phase concentration (mol/mol)
+ real(r8) :: h2o_cond(ncol,pver) ! h2o condensed phase concentration (mol/mol)
+ real(r8) :: cldice(pcols,pver) ! cloud water "ice" (kg/kg)
+ real(r8) :: radius_strat(ncol,pver,3) ! radius of sulfate, nat, & ice ( cm )
+ real(r8) :: sad_strat(ncol,pver,3) ! surf area density of sulfate, nat, & ice ( cm^2/cm^3 )
+ real(r8) :: mmr_tend(pcols,pver,gas_pcnst) ! chemistry species tendencies (kg/kg/s)
+ real(r8) :: qh2o(pcols,pver) ! specific humidity (kg/kg)
+ real(r8) :: delta
+
+ ! for aerosol formation....
+ real(r8) :: del_h2so4_gasprod(ncol,pver)
+ real(r8) :: vmr0(ncol,pver,gas_pcnst)
+
+!
+! CCMI
+!
+ real(r8) :: xlat
+ real(r8) :: pm25(ncol)
+
+ real(r8) :: dlats(ncol)
+
+ real(r8), dimension(ncol,pver) :: & ! aerosol reaction diagnostics
+ gprob_n2o5, &
+ gprob_cnt_hcl, &
+ gprob_cnt_h2o, &
+ gprob_bnt_h2o, &
+ gprob_hocl_hcl, &
+ gprob_hobr_hcl, &
+ wtper
+
+ real(r8), pointer :: ele_temp_fld(:,:) ! electron temperature pointer
+ real(r8), pointer :: ion_temp_fld(:,:) ! ion temperature pointer
+ real(r8) :: prod_out(ncol,pver,max(1,clscnt4))
+ real(r8) :: loss_out(ncol,pver,max(1,clscnt4))
+
+ if ( ele_temp_ndx>0 .and. ion_temp_ndx>0 ) then
+ call pbuf_get_field(pbuf, ele_temp_ndx, ele_temp_fld)
+ call pbuf_get_field(pbuf, ion_temp_ndx, ion_temp_fld)
+ else
+ ele_temp_fld => tfld
+ ion_temp_fld => tfld
+ endif
+
+ ! initialize to NaN to hopefully catch user defined rxts that go unset
+ reaction_rates(:,:,:) = nan
+
+ delt_inverse = 1._r8 / delt
+ !-----------------------------------------------------------------------
+ ! ... Get chunck latitudes and longitudes
+ !-----------------------------------------------------------------------
+ call get_lat_all_p( lchnk, ncol, latndx )
+ call get_lon_all_p( lchnk, ncol, lonndx )
+ call get_rlat_all_p( lchnk, ncol, rlats )
+ call get_rlon_all_p( lchnk, ncol, rlons )
+ tim_ndx = pbuf_old_tim_idx()
+ call pbuf_get_field(pbuf, ndx_prain, prain, start=(/1,1/), kount=(/ncol,pver/))
+ call pbuf_get_field(pbuf, ndx_cldfr, cldfr, start=(/1,1,tim_ndx/), kount=(/ncol,pver,1/) )
+ call pbuf_get_field(pbuf, ndx_cmfdqr, cmfdqr, start=(/1,1/), kount=(/ncol,pver/))
+ call pbuf_get_field(pbuf, ndx_nevapr, nevapr, start=(/1,1/), kount=(/ncol,pver/))
+ call pbuf_get_field(pbuf, ndx_cldtop, cldtop )
+
+ reff_strat(:,:) = 0._r8
+
+ dlats(:) = rlats(:)*rad2deg ! convert to degrees
+
+ !-----------------------------------------------------------------------
+ ! ... Calculate cosine of zenith angle
+ ! then cast back to angle (radians)
+ !-----------------------------------------------------------------------
+ call zenith( calday, rlats, rlons, zen_angle, ncol , delt) !+tht delt
+ zen_angle(:) = acos( zen_angle(:) )
+
+ sza(:) = zen_angle(:) * rad2deg
+ call outfld( 'SZA', sza, ncol, lchnk )
+
+ !-----------------------------------------------------------------------
+ ! ... Xform geopotential height from m to km
+ ! and pressure from Pa to mb
+ !-----------------------------------------------------------------------
+ zsurf(:ncol) = rga * phis(:ncol)
+ do k = 1,pver
+ zintr(:ncol,k) = m2km * zi(:ncol,k)
+ zmidr(:ncol,k) = m2km * zm(:ncol,k)
+ zmid(:ncol,k) = m2km * (zm(:ncol,k) + zsurf(:ncol))
+ zint(:ncol,k) = m2km * (zi(:ncol,k) + zsurf(:ncol))
+ pmb(:ncol,k) = Pa2mb * pmid(:ncol,k)
+ end do
+ zint(:ncol,pver+1) = m2km * (zi(:ncol,pver+1) + zsurf(:ncol))
+ zintr(:ncol,pver+1)= m2km * zi(:ncol,pver+1)
+
+ !-----------------------------------------------------------------------
+ ! ... map incoming concentrations to working array
+ !-----------------------------------------------------------------------
+ do m = 1,pcnst
+ n = map2chm(m)
+ if( n > 0 ) then
+ mmr(:ncol,:,n) = q(:ncol,:,m)
+ end if
+ end do
+
+ call get_short_lived_species( mmr, lchnk, ncol, pbuf )
+
+ !-----------------------------------------------------------------------
+ ! ... Set atmosphere mean mass
+ !-----------------------------------------------------------------------
+ call set_mean_mass( ncol, mmr, mbar )
+
+ !-----------------------------------------------------------------------
+ ! ... Xform from mmr to vmr
+ !-----------------------------------------------------------------------
+ call mmr2vmr( mmr(:ncol,:,:), vmr(:ncol,:,:), mbar(:ncol,:), ncol )
+
+!
+! CCMI
+!
+! reset STE tracer to specific vmr of 200 ppbv
+!
+ if ( st80_25_ndx > 0 ) then
+ where ( pmid(:ncol,:) < 80.e+2_r8 )
+ vmr(:ncol,:,st80_25_ndx) = 200.e-9_r8
+ end where
+ end if
+!
+! reset AOA_NH, NH_5, NH_50, NH_50W surface mixing ratios between 30N and 50N
+!
+ if ( aoa_nh_ndx>0 ) then
+ do j=1,ncol
+ xlat = dlats(j)
+ if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then
+ vmr(j,pver,aoa_nh_ndx) = 0._r8
+ end if
+ end do
+ end if
+ if ( nh_5_ndx>0 ) then
+ do j=1,ncol
+ xlat = dlats(j)
+ if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then
+ vmr(j,pver,nh_5_ndx) = 100.e-9_r8
+ end if
+ end do
+ end if
+ if ( nh_50_ndx>0 ) then
+ do j=1,ncol
+ xlat = dlats(j)
+ if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then
+ vmr(j,pver,nh_50_ndx) = 100.e-9_r8
+ end if
+ end do
+ end if
+ if ( nh_50w_ndx>0 ) then
+ do j=1,ncol
+ xlat = dlats(j)
+ if ( xlat >= 30._r8 .and. xlat <= 50._r8 ) then
+ vmr(j,pver,nh_50w_ndx) = 100.e-9_r8
+ end if
+ end do
+ end if
+
+ if (h2o_ndx>0) then
+ !-----------------------------------------------------------------------
+ ! ... store water vapor in wrk variable
+ !-----------------------------------------------------------------------
+ qh2o(:ncol,:) = mmr(:ncol,:,h2o_ndx)
+ h2ovmr(:ncol,:) = vmr(:ncol,:,h2o_ndx)
+ else
+ qh2o(:ncol,:) = q(:ncol,:,1)
+ !-----------------------------------------------------------------------
+ ! ... Xform water vapor from mmr to vmr and set upper bndy values
+ !-----------------------------------------------------------------------
+ call h2o_to_vmr( q(:ncol,:,1), h2ovmr(:ncol,:), mbar(:ncol,:), ncol )
+
+ call set_fstrat_h2o( h2ovmr, pmid, troplev, calday, ncol, lchnk )
+
+ endif
+
+ !-----------------------------------------------------------------------
+ ! ... force ion/electron balance
+ !-----------------------------------------------------------------------
+ call charge_balance( ncol, vmr )
+
+ !-----------------------------------------------------------------------
+ ! ... Set the "invariants"
+ !-----------------------------------------------------------------------
+ call setinv( invariants, tfld, h2ovmr, vmr, pmid, ncol, lchnk, pbuf )
+
+ !-----------------------------------------------------------------------
+#if defined (OSLO_AERO)
+ ! ... Set the "day/night cycle for prescribed oxidants"
+ !-----------------------------------------------------------------------
+
+ !++IH
+ call outfld('OH_bef', invariants(:,:,id_oh), ncol, lchnk)
+ call outfld('HO2_bef', invariants(:,:,id_ho2), ncol, lchnk)
+ call outfld('NO3_bef', invariants(:,:,id_no3), ncol, lchnk)
+ !--IH
+
+ if (inv_oh.or.inv_ho2.or.inv_no3) & !++IH: added inv_no3
+ call set_diurnal_invariants(invariants,delt,ncol,lchnk,inv_oh,inv_ho2,id_oh,id_ho2,inv_no3,id_no3) !++IH: added inv_no3 and id_no3
+
+ !++IH
+ call outfld('OH_aft', invariants(:,:,id_oh), ncol, lchnk)
+ call outfld('HO2_aft', invariants(:,:,id_ho2), ncol, lchnk)
+ call outfld('NO3_aft', invariants(:,:,id_no3), ncol, lchnk)
+ !--IH
+
+#endif
+ ! ... stratosphere aerosol surface area
+ !-----------------------------------------------------------------------
+ if (sad_pbf_ndx>0) then
+ call pbuf_get_field(pbuf, sad_pbf_ndx, strato_sad)
+ else
+ allocate(strato_sad(pcols,pver))
+ strato_sad(:,:) = 0._r8
+
+ ! Prognostic modal stratospheric sulfate: compute dry strato_sad
+ call aero_model_strat_surfarea( ncol, mmr, pmid, tfld, troplevchem, pbuf, strato_sad, reff_strat )
+
+ endif
+
+ stratochem: if ( has_strato_chem ) then
+ !-----------------------------------------------------------------------
+ ! ... initialize condensed and gas phases; all hno3 to gas
+ !-----------------------------------------------------------------------
+ hcl_cond(:,:) = 0.0_r8
+ hcl_gas (:,:) = 0.0_r8
+ do k = 1,pver
+ hno3_gas(:,k) = vmr(:,k,hno3_ndx)
+ h2o_gas(:,k) = h2ovmr(:,k)
+ hcl_gas(:,k) = vmr(:,k,hcl_ndx)
+ wrk(:,k) = h2ovmr(:,k)
+ if (snow_ndx>0) then
+ cldice(:ncol,k) = q(:ncol,k,cldice_ndx) + q(:ncol,k,snow_ndx)
+ else
+ cldice(:ncol,k) = q(:ncol,k,cldice_ndx)
+ endif
+ end do
+ do m = 1,2
+ do k = 1,pver
+ hno3_cond(:,k,m) = 0._r8
+ end do
+ end do
+
+ call mmr2vmri( cldice(:ncol,:), h2o_cond(:ncol,:), mbar(:ncol,:), cnst_mw(cldice_ndx), ncol )
+
+ !-----------------------------------------------------------------------
+ ! ... call SAD routine
+ !-----------------------------------------------------------------------
+ call sad_strat_calc( lchnk, invariants(:ncol,:,indexm), pmb, tfld, hno3_gas, &
+ hno3_cond, h2o_gas, h2o_cond, hcl_gas, hcl_cond, strato_sad(:ncol,:), radius_strat, &
+ sad_strat, ncol, pbuf )
+
+! NOTE: output of total HNO3 is before vmr is set to gas-phase.
+ call outfld( 'HNO3_TOTAL', vmr(:ncol,:,hno3_ndx), ncol ,lchnk )
+
+
+ do k = 1,pver
+ vmr(:,k,hno3_ndx) = hno3_gas(:,k)
+ h2ovmr(:,k) = h2o_gas(:,k)
+ vmr(:,k,h2o_ndx) = h2o_gas(:,k)
+ wrk(:,k) = (h2ovmr(:,k) - wrk(:,k))*delt_inverse
+ end do
+
+ call outfld( 'QDSAD', wrk(:,:), ncol, lchnk )
+!
+ call outfld( 'SAD_STRAT', strato_sad(:ncol,:), ncol, lchnk )
+ call outfld( 'SAD_SULFC', sad_strat(:,:,1), ncol, lchnk )
+ call outfld( 'SAD_LNAT', sad_strat(:,:,2), ncol, lchnk )
+ call outfld( 'SAD_ICE', sad_strat(:,:,3), ncol, lchnk )
+!
+ call outfld( 'RAD_SULFC', radius_strat(:,:,1), ncol, lchnk )
+ call outfld( 'RAD_LNAT', radius_strat(:,:,2), ncol, lchnk )
+ call outfld( 'RAD_ICE', radius_strat(:,:,3), ncol, lchnk )
+!
+ call outfld( 'HNO3_GAS', vmr(:ncol,:,hno3_ndx), ncol, lchnk )
+ call outfld( 'HNO3_STS', hno3_cond(:,:,1), ncol, lchnk )
+ call outfld( 'HNO3_NAT', hno3_cond(:,:,2), ncol, lchnk )
+!
+ call outfld( 'HCL_TOTAL', vmr(:ncol,:,hcl_ndx), ncol, lchnk )
+ call outfld( 'HCL_GAS', hcl_gas (:,:), ncol ,lchnk )
+ call outfld( 'HCL_STS', hcl_cond(:,:), ncol ,lchnk )
+
+ !-----------------------------------------------------------------------
+ ! ... call aerosol reaction rates
+ !-----------------------------------------------------------------------
+ call ratecon_sfstrat( ncol, invariants(:,:,indexm), pmid, tfld, &
+ radius_strat(:,:,1), sad_strat(:,:,1), sad_strat(:,:,2), &
+ sad_strat(:,:,3), h2ovmr, vmr, reaction_rates, &
+ gprob_n2o5, gprob_cnt_hcl, gprob_cnt_h2o, gprob_bnt_h2o, &
+ gprob_hocl_hcl, gprob_hobr_hcl, wtper )
+
+ call outfld( 'GAMMA_HET1', gprob_n2o5 (:ncol,:), ncol, lchnk )
+ call outfld( 'GAMMA_HET2', gprob_cnt_h2o (:ncol,:), ncol, lchnk )
+ call outfld( 'GAMMA_HET3', gprob_bnt_h2o (:ncol,:), ncol, lchnk )
+ call outfld( 'GAMMA_HET4', gprob_cnt_hcl (:ncol,:), ncol, lchnk )
+ call outfld( 'GAMMA_HET5', gprob_hocl_hcl(:ncol,:), ncol, lchnk )
+ call outfld( 'GAMMA_HET6', gprob_hobr_hcl(:ncol,:), ncol, lchnk )
+ call outfld( 'WTPER', wtper (:ncol,:), ncol, lchnk )
+
+ endif stratochem
+
+! NOTE: For gas-phase solver only.
+! ratecon_sfstrat needs total hcl.
+ if (hcl_ndx>0) then
+ vmr(:,:,hcl_ndx) = hcl_gas(:,:)
+ endif
+
+ !-----------------------------------------------------------------------
+ ! ... Set the column densities at the upper boundary
+ !-----------------------------------------------------------------------
+ call set_ub_col( col_delta, vmr, invariants, pint(:,1), pdel, ncol, lchnk)
+
+ !-----------------------------------------------------------------------
+ ! ... Set rates for "tabular" and user specified reactions
+ !-----------------------------------------------------------------------
+ call setrxt( reaction_rates, tfld, invariants(1,1,indexm), ncol )
+
+ sulfate(:,:) = 0._r8
+ if ( .not. carma_hetchem_feedback ) then
+ if( so4_ndx < 1 ) then ! get offline so4 field if not prognostic
+ call sulf_interp( ncol, lchnk, sulfate )
+ else
+ sulfate(:,:) = vmr(:,:,so4_ndx)
+ endif
+ endif
+
+ !-----------------------------------------------------------------
+ ! ... zero out sulfate above tropopause
+ !-----------------------------------------------------------------
+ do k = 1, pver
+ do i = 1, ncol
+ if (k < troplevchem(i)) then
+ sulfate(i,k) = 0.0_r8
+ end if
+ end do
+ end do
+
+ call outfld( 'SULF_TROP', sulfate(:ncol,:), ncol, lchnk )
+
+ !-----------------------------------------------------------------
+ ! ... compute the relative humidity
+ !-----------------------------------------------------------------
+ call qsat(tfld(:ncol,:), pmid(:ncol,:), satv, satq)
+
+ do k = 1,pver
+ relhum(:,k) = .622_r8 * h2ovmr(:,k) / satq(:,k)
+ relhum(:,k) = max( 0._r8,min( 1._r8,relhum(:,k) ) )
+ end do
+
+ cwat(:ncol,:pver) = cldw(:ncol,:pver)
+
+ call usrrxt( reaction_rates, tfld, ion_temp_fld, ele_temp_fld, invariants, h2ovmr, &
+ pmid, invariants(:,:,indexm), sulfate, mmr, relhum, strato_sad, &
+ troplevchem, dlats, ncol, sad_trop, reff, cwat, mbar, pbuf )
+
+ call outfld( 'SAD_TROP', sad_trop(:ncol,:), ncol, lchnk )
+
+ ! Add trop/strat components of SAD for output
+ sad_trop(:ncol,:)=sad_trop(:ncol,:)+strato_sad(:ncol,:)
+ call outfld( 'SAD_AERO', sad_trop(:ncol,:), ncol, lchnk )
+
+ ! Add trop/strat components of effective radius for output
+ reff(:ncol,:)=reff(:ncol,:)+reff_strat(:ncol,:)
+ call outfld( 'REFF_AERO', reff(:ncol,:), ncol, lchnk )
+
+ if (het1_ndx>0) then
+ call outfld( 'het1_total', reaction_rates(:,:,het1_ndx), ncol, lchnk )
+ endif
+
+ if (ghg_chem) then
+ call ghg_chem_set_rates( reaction_rates, latmapback, zen_angle, ncol, lchnk )
+ endif
+
+ do i = phtcnt+1,rxt_tag_cnt
+ call outfld( tag_names(i), reaction_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk )
+ enddo
+
+ call adjrxt( reaction_rates, invariants, invariants(1,1,indexm), ncol,pver )
+
+ !-----------------------------------------------------------------------
+ ! ... Compute the photolysis rates at time = t(n+1)
+ !-----------------------------------------------------------------------
+ !-----------------------------------------------------------------------
+ ! ... Set the column densities
+ !-----------------------------------------------------------------------
+ call setcol( col_delta, col_dens, vmr, pdel, ncol )
+
+ !-----------------------------------------------------------------------
+ ! ... Calculate the photodissociation rates
+ !-----------------------------------------------------------------------
+
+ esfact = 1._r8
+ call shr_orb_decl( calday, eccen, mvelpp, lambm0, obliqr , &
+ delta, esfact )
+
+
+ if ( xactive_prates ) then
+ if ( dst_ndx > 0 ) then
+ dust_vmr(:ncol,:,1:ndust) = vmr(:ncol,:,dst_ndx:dst_ndx+ndust-1)
+ else
+ dust_vmr(:ncol,:,:) = 0._r8
+ endif
+
+ !-----------------------------------------------------------------
+ ! ... compute the photolysis rates
+ !-----------------------------------------------------------------
+ call xactive_photo( reaction_rates, vmr, tfld, cwat, cldfr, &
+ pmid, zmidr, col_dens, zen_angle, asdir, &
+ invariants(1,1,indexm), ps, ts, &
+ esfact, relhum, dust_vmr, dt_diag, fracday, ncol, lchnk )
+
+ call outfld('DTCBS', dt_diag(:ncol,1), ncol, lchnk )
+ call outfld('DTOCS', dt_diag(:ncol,2), ncol, lchnk )
+ call outfld('DTSO4', dt_diag(:ncol,3), ncol, lchnk )
+ call outfld('DTANT', dt_diag(:ncol,4), ncol, lchnk )
+ call outfld('DTSAL', dt_diag(:ncol,5), ncol, lchnk )
+ call outfld('DTDUST', dt_diag(:ncol,6), ncol, lchnk )
+ call outfld('DTSOA', dt_diag(:ncol,7), ncol, lchnk )
+ call outfld('DTTOTAL', dt_diag(:ncol,8), ncol, lchnk )
+ call outfld('FRACDAY', fracday(:ncol), ncol, lchnk )
+
+ else
+ !-----------------------------------------------------------------
+ ! ... lookup the photolysis rates from table
+ !-----------------------------------------------------------------
+ call table_photo( reaction_rates, pmid, pdel, tfld, zmid, zint, &
+ col_dens, zen_angle, asdir, cwat, cldfr, &
+ esfact, vmr, invariants, ncol, lchnk, pbuf )
+ endif
+
+ do i = 1,phtcnt
+ call outfld( tag_names(i), reaction_rates(:ncol,:,rxt_tag_map(i)), ncol, lchnk )
+ enddo
+
+ !-----------------------------------------------------------------------
+ ! ... Adjust the photodissociation rates
+ !-----------------------------------------------------------------------
+ call O1D_to_2OH_adj( reaction_rates, invariants, invariants(:,:,indexm), ncol, tfld )
+ call phtadj( reaction_rates, invariants, invariants(:,:,indexm), ncol,pver )
+
+ !-----------------------------------------------------------------------
+ ! ... Compute the extraneous frcing at time = t(n+1)
+ !-----------------------------------------------------------------------
+ if ( o2_ndx > 0 .and. o_ndx > 0 ) then
+ do k = 1,pver
+ o2mmr(:ncol,k) = mmr(:ncol,k,o2_ndx)
+ ommr(:ncol,k) = mmr(:ncol,k,o_ndx)
+ end do
+ endif
+ call setext( extfrc, zint, zintr, cldtop, &
+ zmid, lchnk, tfld, o2mmr, ommr, &
+ pmid, mbar, rlats, calday, ncol, rlons, pbuf )
+ ! include forcings from fire emissions ...
+ call fire_emissions_vrt( ncol, lchnk, zint, fire_sflx, fire_ztop, extfrc )
+
+ do m = 1,extcnt
+ if( m /= synoz_ndx .and. m /= aoa_nh_ext_ndx ) then
+ do k = 1,pver
+ extfrc(:ncol,k,m) = extfrc(:ncol,k,m) / invariants(:ncol,k,indexm)
+ end do
+ endif
+ call outfld( extfrc_name(m), extfrc(:ncol,:,m), ncol, lchnk )
+ end do
+
+ !-----------------------------------------------------------------------
+ ! ... Form the washout rates
+ !-----------------------------------------------------------------------
+ if ( gas_wetdep_method=='MOZ' ) then
+ call sethet( het_rates, pmid, zmid, phis, tfld, &
+ cmfdqr, prain, nevapr, delt, invariants(:,:,indexm), &
+ vmr, ncol, lchnk )
+ if (.not. convproc_do_aer) then
+ call het_diags( het_rates(:ncol,:,:), mmr(:ncol,:,:), pdel(:ncol,:), lchnk, ncol )
+ endif
+ else
+ het_rates = 0._r8
+ end if
+!
+! CCMI
+!
+! set loss to below the tropopause only
+!
+ if ( st80_25_tau_ndx > 0 ) then
+ do i = 1,ncol
+ reaction_rates(i,1:troplev(i),st80_25_tau_ndx) = 0._r8
+ enddo
+ end if
+
+ if ( has_linoz_data ) then
+ ltrop_sol(:ncol) = troplev(:ncol)
+ else
+ ltrop_sol(:ncol) = 0 ! apply solver to all levels
+ endif
+
+ ! save h2so4 before gas phase chem (for later new particle nucleation)
+ if (ndx_h2so4 > 0) then
+ del_h2so4_gasprod(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4)
+ else
+ del_h2so4_gasprod(:,:) = 0.0_r8
+ endif
+
+ vmr0(:ncol,:,:) = vmr(:ncol,:,:) ! mixing ratios before chemistry changes
+
+ !=======================================================================
+ ! ... Call the class solution algorithms
+ !=======================================================================
+ !-----------------------------------------------------------------------
+ ! ... Solve for "Explicit" species
+ !-----------------------------------------------------------------------
+ call exp_sol( vmr, reaction_rates, het_rates, extfrc, delt, invariants(1,1,indexm), ncol, lchnk, ltrop_sol )
+
+ !-----------------------------------------------------------------------
+ ! ... Solve for "Implicit" species
+ !-----------------------------------------------------------------------
+ if ( has_strato_chem ) wrk(:,:) = vmr(:,:,h2o_ndx)
+ call t_startf('imp_sol')
+ !
+ call imp_sol( vmr, reaction_rates, het_rates, extfrc, delt, &
+ ncol,pver, lchnk, prod_out, loss_out )
+
+ call t_stopf('imp_sol')
+
+ call chem_prod_loss_diags_out( ncol, lchnk, vmr, reaction_rates, prod_out, loss_out, invariants(:ncol,:,indexm) )
+ if( h2o_ndx>0) call outfld( 'H2O_GAS', vmr(1,1,h2o_ndx), ncol ,lchnk )
+
+ ! reset O3S to O3 in the stratosphere ...
+ if ( o3_ndx > 0 .and. o3s_ndx > 0 ) then
+ do i = 1,ncol
+ vmr(i,1:troplev(i),o3s_ndx) = vmr(i,1:troplev(i),o3_ndx)
+ end do
+ end if
+
+ if (convproc_do_aer) then
+ call vmr2mmr( vmr(:ncol,:,:), mmr_new(:ncol,:,:), mbar(:ncol,:), ncol )
+ ! mmr_new = average of mmr values before and after imp_sol
+ mmr_new(:ncol,:,:) = 0.5_r8*( mmr(:ncol,:,:) + mmr_new(:ncol,:,:) )
+ call het_diags( het_rates(:ncol,:,:), mmr_new(:ncol,:,:), pdel(:ncol,:), lchnk, ncol )
+ endif
+
+ ! save h2so4 change by gas phase chem (for later new particle nucleation)
+ if (ndx_h2so4 > 0) then
+ del_h2so4_gasprod(1:ncol,:) = vmr(1:ncol,:,ndx_h2so4) - del_h2so4_gasprod(1:ncol,:)
+ endif
+
+!
+! Aerosol processes ...
+!
+
+ call aero_model_gasaerexch( imozart-1, ncol, lchnk, troplevchem, delt, reaction_rates, &
+ tfld, pmid, pdel, mbar, relhum, &
+ zm, qh2o, cwat, cldfr, ncldwtr, &
+ invariants(:,:,indexm), invariants, del_h2so4_gasprod, &
+ vmr0, vmr, pbuf )
+
+ if ( has_strato_chem ) then
+
+ wrk(:ncol,:) = (vmr(:ncol,:,h2o_ndx) - wrk(:ncol,:))*delt_inverse
+ call outfld( 'QDCHEM', wrk(:ncol,:), ncol, lchnk )
+ call outfld( 'HNO3_GAS', vmr(:ncol,:,hno3_ndx), ncol ,lchnk )
+
+ !-----------------------------------------------------------------------
+ ! ... aerosol settling
+ ! first settle hno3(2) using radius ice
+ ! secnd settle hno3(3) using radius large nat
+ !-----------------------------------------------------------------------
+ wrk(:,:) = vmr(:,:,h2o_ndx)
+#ifdef ALT_SETTL
+ where( h2o_cond(:,:) > 0._r8 )
+ settl_rad(:,:) = radius_strat(:,:,3)
+ elsewhere
+ settl_rad(:,:) = 0._r8
+ endwhere
+ call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, &
+ hno3_cond(1,1,2), settl_rad, ncol, lchnk, 1 )
+
+ where( h2o_cond(:,:) == 0._r8 )
+ settl_rad(:,:) = radius_strat(:,:,2)
+ elsewhere
+ settl_rad(:,:) = 0._r8
+ endwhere
+ call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, &
+ hno3_cond(1,1,2), settl_rad, ncol, lchnk, 2 )
+#else
+ call strat_aer_settling( invariants(1,1,indexm), pmid, delt, zmid, tfld, &
+ hno3_cond(1,1,2), radius_strat(1,1,2), ncol, lchnk, 2 )
+#endif
+
+ !-----------------------------------------------------------------------
+ ! ... reform total hno3 and hcl = gas + all condensed
+ !-----------------------------------------------------------------------
+! NOTE: vmr for hcl and hno3 is gas-phase at this point.
+! hno3_cond(:,k,1) = STS; hno3_cond(:,k,2) = NAT
+
+ do k = 1,pver
+ vmr(:,k,hno3_ndx) = vmr(:,k,hno3_ndx) + hno3_cond(:,k,1) &
+ + hno3_cond(:,k,2)
+ vmr(:,k,hcl_ndx) = vmr(:,k,hcl_ndx) + hcl_cond(:,k)
+
+ end do
+
+ wrk(:,:) = (vmr(:,:,h2o_ndx) - wrk(:,:))*delt_inverse
+ call outfld( 'QDSETT', wrk(:,:), ncol, lchnk )
+
+ endif
+
+!
+! LINOZ
+!
+ if ( do_lin_strat_chem ) then
+ call lin_strat_chem_solve( ncol, lchnk, vmr(:,:,o3_ndx), col_dens(:,:,1), tfld, zen_angle, pmid, delt, rlats, troplev )
+ end if
+
+ !-----------------------------------------------------------------------
+ ! ... Check for negative values and reset to zero
+ !-----------------------------------------------------------------------
+ call negtrc( 'After chemistry ', vmr, ncol )
+
+ !-----------------------------------------------------------------------
+ ! ... Set upper boundary mmr values
+ !-----------------------------------------------------------------------
+ call set_fstrat_vals( vmr, pmid, pint, troplev, calday, ncol,lchnk )
+
+ !-----------------------------------------------------------------------
+ ! ... Set fixed lower boundary mmr values
+ !-----------------------------------------------------------------------
+ call flbc_set( vmr, ncol, lchnk, map2chm )
+
+ !-----------------------------------------------------------------------
+ ! set NOy UBC
+ !-----------------------------------------------------------------------
+ call noy_ubc_set( lchnk, ncol, vmr )
+
+ if ( ghg_chem ) then
+ call ghg_chem_set_flbc( vmr, ncol )
+ endif
+
+ !-----------------------------------------------------------------------
+ ! force ion/electron balance -- ext forcings likely do not conserve charge
+ !-----------------------------------------------------------------------
+ call charge_balance( ncol, vmr )
+
+ !-----------------------------------------------------------------------
+ ! ... Xform from vmr to mmr
+ !-----------------------------------------------------------------------
+ call vmr2mmr( vmr(:ncol,:,:), mmr_tend(:ncol,:,:), mbar(:ncol,:), ncol )
+
+ call set_short_lived_species( mmr_tend, lchnk, ncol, pbuf )
+
+ !-----------------------------------------------------------------------
+ ! ... Form the tendencies
+ !-----------------------------------------------------------------------
+ do m = 1,gas_pcnst
+ mmr_new(:ncol,:,m) = mmr_tend(:ncol,:,m)
+ mmr_tend(:ncol,:,m) = (mmr_tend(:ncol,:,m) - mmr(:ncol,:,m))*delt_inverse
+ enddo
+
+ do m = 1,pcnst
+ n = map2chm(m)
+ if( n > 0 ) then
+ qtend(:ncol,:,m) = qtend(:ncol,:,m) + mmr_tend(:ncol,:,n)
+ end if
+ end do
+
+ tvs(:ncol) = tfld(:ncol,pver) * (1._r8 + qh2o(:ncol,pver))
+
+ sflx(:,:) = 0._r8
+ call get_ref_date(yr, mon, day, sec)
+ ncdate = yr*10000 + mon*100 + day
+ wind_speed(:ncol) = sqrt( ufld(:ncol,pver)*ufld(:ncol,pver) + vfld(:ncol,pver)*vfld(:ncol,pver) )
+ prect(:ncol) = precc(:ncol) + precl(:ncol)
+
+ if ( drydep_method == DD_XLND ) then
+ soilw = -99
+ call drydep( ocnfrac, icefrac, ncdate, ts, ps, &
+ wind_speed, qh2o(:,pver), tfld(:,pver), pmid(:,pver), prect, &
+ snowhland, fsds, depvel, sflx, mmr, &
+ tvs, soilw, relhum(:,pver:pver), ncol, lonndx, latndx, lchnk )
+ else if ( drydep_method == DD_XATM ) then
+ table_soilw = has_drydep( 'H2' ) .or. has_drydep( 'CO' )
+ if( .not. dyn_soilw .and. table_soilw ) then
+ call set_soilw( soilw, lchnk, calday )
+ end if
+ call drydep( ncdate, ts, ps, &
+ wind_speed, qh2o(:,pver), tfld(:,pver), pmid(:,pver), prect, &
+ snowhland, fsds, depvel, sflx, mmr, &
+ tvs, soilw, relhum(:,pver:pver), ncol, lonndx, latndx, lchnk )
+ else if ( drydep_method == DD_TABL ) then
+ call drydep( calday, ts, zen_angle, &
+ depvel, sflx, mmr, pmid(:,pver), &
+ tvs, ncol, icefrac, ocnfrac, lchnk )
+ endif
+
+ drydepflx(:,:) = 0._r8
+ do m = 1,pcnst
+ n = map2chm( m )
+ if ( n > 0 ) then
+ cflx(:ncol,m) = cflx(:ncol,m) - sflx(:ncol,n)
+ drydepflx(:ncol,m) = sflx(:ncol,n)
+ wetdepflx_diag(:ncol,n) = wetdepflx(:ncol,m)
+ endif
+ end do
+
+ call chm_diags( lchnk, ncol, vmr(:ncol,:,:), mmr_new(:ncol,:,:), &
+ reaction_rates(:ncol,:,:), invariants(:ncol,:,:), depvel(:ncol,:), sflx(:ncol,:), &
+ mmr_tend(:ncol,:,:), pdel(:ncol,:), pmid(:ncol,:), troplev(:ncol), wetdepflx_diag(:ncol,:), &
+ nhx_nitrogen_flx(:ncol), noy_nitrogen_flx(:ncol), pbuf )
+
+ call rate_diags_calc( reaction_rates(:,:,:), vmr(:,:,:), invariants(:,:,indexm), ncol, lchnk )
+!
+! jfl
+!
+! surface vmr
+!
+ if ( pm25_srf_diag ) then
+ pm25(:ncol) = mmr_new(:ncol,pver,cb1_ndx) &
+ + mmr_new(:ncol,pver,cb2_ndx) &
+ + mmr_new(:ncol,pver,oc1_ndx) &
+ + mmr_new(:ncol,pver,oc2_ndx) &
+ + mmr_new(:ncol,pver,dst1_ndx) &
+ + mmr_new(:ncol,pver,dst2_ndx) &
+ + mmr_new(:ncol,pver,sslt1_ndx) &
+ + mmr_new(:ncol,pver,sslt2_ndx) &
+ + mmr_new(:ncol,pver,soa_ndx) &
+ + mmr_new(:ncol,pver,so4_ndx)
+ call outfld('PM25_SRF',pm25(:ncol) , ncol, lchnk )
+ endif
+ if ( pm25_srf_diag_soa ) then
+ pm25(:ncol) = mmr_new(:ncol,pver,cb1_ndx) &
+ + mmr_new(:ncol,pver,cb2_ndx) &
+ + mmr_new(:ncol,pver,oc1_ndx) &
+ + mmr_new(:ncol,pver,oc2_ndx) &
+ + mmr_new(:ncol,pver,dst1_ndx) &
+ + mmr_new(:ncol,pver,dst2_ndx) &
+ + mmr_new(:ncol,pver,sslt1_ndx) &
+ + mmr_new(:ncol,pver,sslt2_ndx) &
+ + mmr_new(:ncol,pver,soam_ndx) &
+ + mmr_new(:ncol,pver,soai_ndx) &
+ + mmr_new(:ncol,pver,soat_ndx) &
+ + mmr_new(:ncol,pver,soab_ndx) &
+ + mmr_new(:ncol,pver,soax_ndx) &
+ + mmr_new(:ncol,pver,so4_ndx)
+ call outfld('PM25_SRF',pm25(:ncol) , ncol, lchnk )
+ endif
+!
+!
+ call outfld('Q_SRF',qh2o(:ncol,pver) , ncol, lchnk )
+ call outfld('U_SRF',ufld(:ncol,pver) , ncol, lchnk )
+ call outfld('V_SRF',vfld(:ncol,pver) , ncol, lchnk )
+
+!
+ if (.not.sad_pbf_ndx>0) then
+ deallocate(strato_sad)
+ endif
+
+ end subroutine gas_phase_chemdr
+
+end module mo_gas_phase_chemdr
diff --git a/src/chemistry/oslo_aero/mo_neu_wetdep.F90 b/src/chemistry/oslo_aero/mo_neu_wetdep.F90
new file mode 100644
index 0000000000..eae583761a
--- /dev/null
+++ b/src/chemistry/oslo_aero/mo_neu_wetdep.F90
@@ -0,0 +1,1793 @@
+!
+! code written by J.-F. Lamarque, S. Walters and F. Vitt
+! based on the original code from J. Neu developed for UC Irvine
+! model
+!
+! LKE 2/23/2018 - correct setting flag for mass-limited (HNO3,etc.) vs Henry's Law washout
+!
+module mo_neu_wetdep
+!
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use cam_logfile, only : iulog
+ use constituents, only : pcnst
+ use spmd_utils, only : masterproc
+ use cam_abortutils, only : endrun
+ use seq_drydep_mod, only : n_species_table, species_name_table, dheff
+ use gas_wetdep_opts, only : gas_wetdep_method, gas_wetdep_list, gas_wetdep_cnt
+#ifdef OSLO_AERO
+ use phys_control, only: phys_getopts
+ use mo_constants, only: rgrav
+ use phys_control, only: phys_getopts
+#endif
+!
+ implicit none
+!
+ private
+ public :: neu_wetdep_init
+ public :: neu_wetdep_tend
+!
+ save
+!
+ integer, allocatable, dimension(:) :: mapping_to_heff,mapping_to_mmr
+ real(r8),allocatable, dimension(:) :: mol_weight
+ logical ,allocatable, dimension(:) :: ice_uptake
+ integer :: index_cldice,index_cldliq,nh3_ndx,co2_ndx
+ logical :: debug = .false.
+ integer :: hno3_ndx = 0
+ integer :: h2o2_ndx = 0
+!
+! diagnostics
+!
+ logical :: do_diag = .false.
+ integer, parameter :: kdiag = 18
+!
+ real(r8), parameter :: zero = 0._r8
+ real(r8), parameter :: one = 1._r8
+!
+ logical :: do_neu_wetdep
+!
+ real(r8), parameter :: TICE=263._r8
+
+contains
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+subroutine neu_wetdep_init
+!
+ use constituents, only : cnst_get_ind,cnst_mw
+ use cam_history, only : addfld, add_default, horiz_only
+ use phys_control, only : phys_getopts
+!
+ integer :: m,l
+ character*20 :: test_name
+
+ logical :: history_chemistry
+
+ call phys_getopts(history_chemistry_out=history_chemistry)
+
+ do_neu_wetdep = gas_wetdep_method == 'NEU' .and. gas_wetdep_cnt>0
+
+ if (.not.do_neu_wetdep) return
+
+ allocate( mapping_to_heff(gas_wetdep_cnt) )
+ allocate( mapping_to_mmr(gas_wetdep_cnt) )
+ allocate( ice_uptake(gas_wetdep_cnt) )
+ allocate( mol_weight(gas_wetdep_cnt) )
+
+!
+! find mapping to heff table
+!
+ if ( debug ) then
+ print '(a,i4)','gas_wetdep_cnt=',gas_wetdep_cnt
+ print '(a,i4)','n_species_table=',n_species_table
+ end if
+ mapping_to_heff = -99
+ do m=1,gas_wetdep_cnt
+!
+ test_name = gas_wetdep_list(m)
+ if ( debug ) print '(i4,a)',m,trim(test_name)
+!
+! mapping based on the MOZART4 wet removal subroutine;
+! this might need to be redone (JFL: Sep 2010)
+!
+ select case( trim(test_name) )
+!
+! CCMI: added SO2t and NH_50W
+!
+ case( 'HYAC', 'CH3COOH' , 'HCOOH', 'EOOH', 'IEPOX' )
+ test_name = 'CH2O'
+ case ( 'SOGB','SOGI','SOGM','SOGT','SOGX' )
+ test_name = 'H2O2'
+ case ( 'SO2t' )
+ test_name = 'SO2'
+ case ( 'CLONO2','BRONO2','HCL','HOCL','HOBR','HBR', 'Pb', 'MACROOH', 'ISOPOOH', 'XOOH', 'H2SO4', 'HF', 'COF2', 'COFCL')
+ test_name = 'HNO3'
+ case ( 'NH_50W', 'NDEP', 'NHDEP', 'NH4', 'NH4NO3' )
+ test_name = 'HNO3'
+ case ( 'ALKOOH', 'MEKOOH', 'TOLOOH' )
+ test_name = 'CH3OOH'
+ case( 'PHENOOH', 'BENZOOH', 'C6H5OOH', 'BZOOH', 'XYLOLOOH', 'XYLENOOH', 'HPALD' )
+ test_name = 'CH3OOH'
+ case( 'TERPOOH', 'TERP2OOH', 'MBOOOH' )
+ test_name = 'HNO3'
+ case( 'TERPROD1', 'TERPROD2' )
+ test_name = 'CH2O'
+ case( 'HMPROP' )
+ test_name = 'GLYALD'
+ case( 'NOA', 'ALKNIT', 'ISOPNITA', 'ISOPNITB', 'HONITR', 'ISOPNOOH' )
+ test_name = 'H2O2'
+ case( 'NC4CHO', 'NC4CH2OH', 'TERPNIT', 'NTERPOOH' )
+ test_name = 'H2O2'
+ case( 'SOAGbb0' ) ! Henry's Law coeff. added for VBS SOA's, biomass burning is the same as fossil fuels
+ test_name = 'SOAGff0'
+ case( 'SOAGbb1' )
+ test_name = 'SOAGff1'
+ case( 'SOAGbb2' )
+ test_name = 'SOAGff2'
+ case( 'SOAGbb3' )
+ test_name = 'SOAGff3'
+ case( 'SOAGbb4' )
+ test_name = 'SOAGff4'
+ end select
+!
+ do l = 1,n_species_table
+!
+! if ( debug ) print '(i4,a)',l,trim(species_name_table(l))
+!
+ if( trim(test_name) == trim( species_name_table(l) ) ) then
+ mapping_to_heff(m) = l
+ if ( debug ) print '(a,a,i4)','mapping to heff of ',trim(species_name_table(l)),l
+ exit
+ end if
+ end do
+ if ( mapping_to_heff(m) == -99 ) then
+ if (masterproc) print *,'problem with mapping_to_heff of ',trim(test_name)
+! call endrun()
+ end if
+!
+! special cases for NH3 and CO2
+!
+ if ( trim(test_name) == 'NH3' ) then
+ nh3_ndx = m
+ end if
+ if ( trim(test_name) == 'CO2' ) then
+ co2_ndx = m
+ end if
+ if ( trim(gas_wetdep_list(m)) == 'HNO3' ) then
+ hno3_ndx = m
+ end if
+!
+ end do
+
+ if (any ( mapping_to_heff(:) == -99 )) call endrun('mo_neu_wet->depwetdep_init: unmapped species error' )
+!
+ if ( debug ) then
+ print '(a,i4)','co2_ndx',co2_ndx
+ print '(a,i4)','nh3_ndx',nh3_ndx
+ end if
+!
+! find mapping to species
+!
+ mapping_to_mmr = -99
+ do m=1,gas_wetdep_cnt
+ if ( debug ) print '(i4,a)',m,trim(gas_wetdep_list(m))
+ call cnst_get_ind(gas_wetdep_list(m), mapping_to_mmr(m), abort=.false. )
+ if ( debug ) print '(a,i4)','mapping_to_mmr ',mapping_to_mmr(m)
+ if ( mapping_to_mmr(m) <= 0 ) then
+ print *,'problem with mapping_to_mmr of ',gas_wetdep_list(m)
+ call endrun('problem with mapping_to_mmr of '//trim(gas_wetdep_list(m)))
+ end if
+ end do
+!
+! define species-dependent arrays
+!
+ do m=1,gas_wetdep_cnt
+!
+ mol_weight(m) = cnst_mw(mapping_to_mmr(m))
+ if ( debug ) print '(i4,a,f8.4)',m,' mol_weight ',mol_weight(m)
+ ice_uptake(m) = .false.
+ if ( trim(gas_wetdep_list(m)) == 'HNO3' ) then
+ ice_uptake(m) = .true.
+ end if
+!
+!
+ end do
+!
+! indices for cloud quantities
+!
+ call cnst_get_ind( 'CLDICE', index_cldice )
+ call cnst_get_ind( 'CLDLIQ', index_cldliq )
+!
+! define output
+!
+ do m=1,gas_wetdep_cnt
+ call addfld ('DTWR_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','kg/kg/s','wet removal Neu scheme tendency')
+ call addfld ('WD_'//trim(gas_wetdep_list(m)),horiz_only, 'A','kg/m2/s','vertical integrated wet deposition flux')
+ call addfld ('HEFF_'//trim(gas_wetdep_list(m)),(/ 'lev' /), 'A','M/atm','Effective Henrys Law coeff.')
+ if (history_chemistry) then
+ call add_default('DTWR_'//trim(gas_wetdep_list(m)), 1, ' ')
+ call add_default('WD_'//trim(gas_wetdep_list(m)), 1, ' ')
+ end if
+ end do
+!
+ if ( do_diag ) then
+ call addfld ('QT_RAIN_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency')
+ call addfld ('QT_RIME_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency')
+ call addfld ('QT_WASH_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency')
+ call addfld ('QT_EVAP_HNO3',(/ 'lev' /), 'A','mol/mol/s','wet removal Neu scheme rain tendency')
+ if (history_chemistry) then
+ call add_default('QT_RAIN_HNO3',1,' ')
+ call add_default('QT_RIME_HNO3',1,' ')
+ call add_default('QT_WASH_HNO3',1,' ')
+ call add_default('QT_EVAP_HNO3',1,' ')
+ end if
+ end if
+!
+ return
+!
+end subroutine neu_wetdep_init
+!
+subroutine neu_wetdep_tend(lchnk,ncol,mmr,pmid,pdel,zint,tfld,delt, &
+ prain, nevapr, cld, cmfdqr, wd_tend, wd_tend_int)
+!
+ use ppgrid, only : pcols, pver
+!!DEK
+ use phys_grid, only : get_area_all_p, get_rlat_all_p
+ use shr_const_mod, only : SHR_CONST_REARTH,SHR_CONST_G
+ use cam_history, only : outfld
+!
+ implicit none
+!
+ integer, intent(in) :: lchnk,ncol
+ real(r8), intent(in) :: mmr(pcols,pver,pcnst) ! mass mixing ratio (kg/kg)
+ real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressures (Pa)
+ real(r8), intent(in) :: pdel(pcols,pver) ! pressure delta about midpoints (Pa)
+ real(r8), intent(in) :: zint(pcols,pver+1) ! interface geopotential height above the surface (m)
+ real(r8), intent(in) :: tfld(pcols,pver) ! midpoint temperature (K)
+ real(r8), intent(in) :: delt ! timestep (s)
+!
+ real(r8), intent(in) :: prain(ncol, pver)
+ real(r8), intent(in) :: nevapr(ncol, pver)
+ real(r8), intent(in) :: cld(ncol, pver)
+ real(r8), intent(in) :: cmfdqr(ncol, pver)
+ real(r8), intent(inout) :: wd_tend(pcols,pver,pcnst)
+ real(r8), intent(inout) :: wd_tend_int(pcols,pcnst)
+!
+! local arrays and variables
+!
+ integer :: i,k,l,kk,m,id
+ real(r8), parameter :: rearth = SHR_CONST_REARTH ! radius earth (m)
+ real(r8), parameter :: gravit = SHR_CONST_G ! m/s^2
+ real(r8), dimension(ncol) :: area, wk_out
+ real(r8), dimension(ncol,pver) :: cldice,cldliq,cldfrc,totprec,totevap,delz,delp,p
+ real(r8), dimension(ncol,pver) :: rls,evaprate,mass_in_layer,temp
+ real(r8), dimension(ncol,pver,gas_wetdep_cnt) :: trc_mass,heff,dtwr
+ real(r8), dimension(ncol,pver,gas_wetdep_cnt) :: wd_mmr
+ logical , dimension(gas_wetdep_cnt) :: tckaqb
+ integer , dimension(ncol) :: test_flag
+!
+! arrays for HNO3 diagnostics
+!
+ real(r8), dimension(ncol,pver) :: qt_rain,qt_rime,qt_wash,qt_evap
+!
+! for Henry's law calculations
+!
+ real(r8), parameter :: t0 = 298._r8
+ real(r8), parameter :: ph = 1.e-5_r8
+ real(r8), parameter :: ph_inv = 1._r8/ph
+ real(r8) :: e298, dhr
+ real(r8), dimension(ncol) :: dk1s,dk2s,wrk
+!!DEK
+ real(r8) :: pi
+ real(r8) :: lats(pcols)
+
+#ifdef OSLO_AERO
+ real(r8) :: wrk_wd(pcols)
+ logical history_aerosol
+#endif
+
+call phys_getopts( history_aerosol_out = history_aerosol)
+!
+! from cam/src/physics/cam/stratiform.F90
+!
+!!DEK
+ pi = 4._r8*atan(1.0_r8)
+
+ if (.not.do_neu_wetdep) return
+!
+! don't do anything if there are no species to be removed
+!
+ if ( gas_wetdep_cnt == 0 ) return
+!
+! reset output variables
+!
+ wd_tend_int = 0._r8
+!
+! get area (in radians square)
+!
+ call get_area_all_p(lchnk, ncol, area)
+ area = area * rearth**2 ! in m^2
+!
+! reverse order along the vertical before calling
+! J. Neu's wet removal subroutine
+!
+ do k=1,pver
+ kk = pver - k + 1
+ do i=1,ncol
+!
+ mass_in_layer(i,k) = area(i) * pdel(i,kk)/gravit ! kg
+!
+ cldice (i,k) = mmr(i,kk,index_cldice) ! kg/kg
+ cldliq (i,k) = mmr(i,kk,index_cldliq) ! kg/kg
+ cldfrc (i,k) = cld(i,kk) ! unitless
+!
+ totprec(i,k) = (prain(i,kk)+cmfdqr(i,kk)) &
+ * mass_in_layer(i,k) ! kg/s
+ totevap(i,k) = nevapr(i,kk) * mass_in_layer(i,k) ! kg/s
+!
+ delz(i,k) = zint(i,kk) - zint(i,kk+1) ! in m
+!
+ temp(i,k) = tfld(i,kk)
+!
+! convert tracer mass to kg to kg/kg
+!
+ trc_mass(i,k,:) = mmr(i,kk,mapping_to_mmr(:)) * mass_in_layer(i,k)
+!
+ delp(i,k) = pdel(i,kk) * 0.01_r8 ! in hPa
+ p (i,k) = pmid(i,kk) * 0.01_r8 ! in hPa
+!
+ end do
+ end do
+!
+! define array for tendency calculation (on model grid)
+!
+ dtwr(1:ncol,:,:) = mmr(1:ncol,:,mapping_to_mmr(:))
+!
+! compute 1) integrated precipitation flux across the interfaces (rls)
+! 2) evaporation rate
+!
+ rls (:,pver) = 0._r8
+ evaprate (:,pver) = 0._r8
+ do k=pver-1,1,-1
+ rls (:,k) = max(0._r8,totprec(:,k)-totevap(:,k)+rls(:,k+1))
+ !evaprate(:,k) = min(1._r8,totevap(:,k)/(rls(:,k+1)+totprec(:,k)+1.e-36_r8))
+ evaprate(:,k) = min(1._r8,totevap(:,k)/(rls(:,k+1)+1.e-36_r8))
+ end do
+!
+! compute effective Henry's law coefficients
+! code taken from models/drv/shr/seq_drydep_mod.F90
+!
+ heff = 0._r8
+ do k=1,pver
+!
+ kk = pver - k + 1
+!
+ wrk(:) = (t0-tfld(1:ncol,kk))/(t0*tfld(1:ncol,kk))
+!
+ do m=1,gas_wetdep_cnt
+!
+ l = mapping_to_heff(m)
+ id = 6*(l - 1)
+ e298 = dheff(id+1)
+ dhr = dheff(id+2)
+ heff(:,k,m) = e298*exp( dhr*wrk(:) )
+ test_flag = -99
+ if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then
+ e298 = dheff(id+3)
+ dhr = dheff(id+4)
+ dk1s(:) = e298*exp( dhr*wrk(:) )
+ where( heff(:,k,m) /= 0._r8 )
+ heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv)
+ elsewhere
+ test_flag = 1
+ heff(:,k,m) = dk1s(:)*ph_inv
+ endwhere
+ end if
+!
+ if (k.eq.1 .and. maxval(test_flag) > 0 .and. debug ) print '(a,i4)','heff for m=',m
+!
+ if( dheff(id+5) /= 0._r8 ) then
+ if( nh3_ndx > 0 .or. co2_ndx > 0 ) then
+ e298 = dheff(id+3)
+ dhr = dheff(id+4)
+ dk1s(:) = e298*exp( dhr*wrk(:) )
+ e298 = dheff(id+5)
+ dhr = dheff(id+6)
+ dk2s(:) = e298*exp( dhr*wrk(:) )
+ if( m == co2_ndx ) then
+ heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph_inv)*(1._r8 + dk2s(:)*ph_inv)
+ else if( m == nh3_ndx ) then
+ heff(:,k,m) = heff(:,k,m)*(1._r8 + dk1s(:)*ph/dk2s(:))
+ else
+ write(iulog,*) 'error in assigning henrys law coefficients'
+ write(iulog,*) 'species ',m
+ end if
+ end if
+ end if
+!
+ end do
+ end do
+!
+ if ( debug ) then
+ print '(a,50f8.2)','tckaqb ',tckaqb
+ print '(a,50e12.4)','heff ',heff(1,1,:)
+ print '(a,50i4)' ,'ice_uptake ',ice_uptake
+ print '(a,50f8.2)','mol_weight ',mol_weight(:)
+ print '(a,50f8.2)','temp ',temp(1,:)
+ print '(a,50f8.2)','p ',p (1,:)
+ end if
+!
+! call J. Neu's subroutine
+!
+ do i=1,ncol
+!
+ call washo(pver,gas_wetdep_cnt,delt,trc_mass(i,:,:),mass_in_layer(i,:),p(i,:),delz(i,:) &
+ ,rls(i,:),cldliq(i,:),cldice(i,:),cldfrc(i,:),temp(i,:),evaprate(i,:) &
+ ,area(i),heff(i,:,:),mol_weight(:),tckaqb(:),ice_uptake(:) &
+ ,qt_rain(i,:),qt_rime(i,:),qt_wash(i,:),qt_evap(i,:) )
+!
+ end do
+!
+! compute tendencies and convert back to mmr
+! on original vertical grid
+!
+ do k=1,pver
+ kk = pver - k + 1
+ do i=1,ncol
+!
+! convert tracer mass from kg
+!
+ wd_mmr(i,kk,:) = trc_mass(i,k,:) / mass_in_layer(i,k)
+!
+ end do
+ end do
+!
+! tendency calculation (on model grid)
+!
+ dtwr(1:ncol,:,:) = wd_mmr(1:ncol,:,:) - dtwr(1:ncol,:,:)
+ dtwr(1:ncol,:,:) = dtwr(1:ncol,:,:) / delt
+
+!!DEK polarward of 60S, 60N and <200hPa set to zero!
+ call get_rlat_all_p(lchnk, pcols, lats )
+ do k = 1, pver
+ do i= 1, ncol
+ if ( abs( lats(i)*180._r8/pi ) > 60._r8 ) then
+ if ( pmid(i,k) < 20000._r8) then
+ dtwr(i,k,:) = 0._r8
+ endif
+ endif
+ end do
+ end do
+!
+! output tendencies
+!
+ do m=1,gas_wetdep_cnt
+ wd_tend(1:ncol,:,mapping_to_mmr(m)) = wd_tend(1:ncol,:,mapping_to_mmr(m)) + dtwr(1:ncol,:,m)
+ call outfld( 'DTWR_'//trim(gas_wetdep_list(m)),dtwr(:,:,m),ncol,lchnk )
+
+ call outfld( 'HEFF_'//trim(gas_wetdep_list(m)),heff(:,pver:1:-1,m),ncol,lchnk )
+!
+! vertical integrated wet deposition rate [kg/m2/s]
+!
+ wk_out = 0._r8
+ do k=1,pver
+ kk = pver - k + 1
+ wk_out(1:ncol) = wk_out(1:ncol) + (dtwr(1:ncol,k,m) * mass_in_layer(1:ncol,kk)/area(1:ncol))
+ end do
+ call outfld( 'WD_'//trim(gas_wetdep_list(m)),wk_out,ncol,lchnk )
+!
+! to be used in mo_chm_diags to compute wet_deposition_NOy_as_N and wet_deposition_NHx_as_N (units: kg/m2/s)
+!
+ if ( debug) print *,'mo_neu ',mapping_to_mmr(m),(wk_out(1:ncol))
+ wd_tend_int(1:ncol,mapping_to_mmr(m)) = wk_out(1:ncol)
+!
+ end do
+
+!This is output normally in mo_chm_diags, but
+!if neu wetdep, we have to output it here!
+#ifdef OSLO_AERO
+ if(history_aerosol)then
+ do m=1,gas_wetdep_cnt
+ wrk_wd(:ncol) = 0.0_r8
+ do k=1,pver
+ !Note sign: tendency is negative, so this becomes a positive flux!
+ wrk_wd(:ncol) = wrk_wd(:ncol) &
+ - wd_tend(1:ncol,k,mapping_to_mmr(m))*pdel(:ncol,k)*rgrav !kg/m2/sec
+ end do
+ call outfld('WD_A_'//trim(gas_wetdep_list(m)),wrk_wd(:ncol),ncol,lchnk)
+ end do
+ end if
+#endif
+!
+ if ( do_diag ) then
+ call outfld('QT_RAIN_HNO3', qt_rain, ncol, lchnk )
+ call outfld('QT_RIME_HNO3', qt_rime, ncol, lchnk )
+ call outfld('QT_WASH_HNO3', qt_wash, ncol, lchnk )
+ call outfld('QT_EVAP_HNO3', qt_evap, ncol, lchnk )
+ end if
+!
+ return
+end subroutine neu_wetdep_tend
+
+!-----------------------------------------------------------------------
+!
+! Original code from Jessica Neu
+! Updated by S. Walters and J.-F. Lamarque (March-April 2011)
+!
+!-----------------------------------------------------------------------
+
+ subroutine WASHO(LPAR,NTRACE,DTSCAV,QTTJFL,QM,POFL,DELZ, &
+ RLS,CLWC,CIWC,CFR,TEM,EVAPRATE,GAREA,HSTAR,TCMASS,TCKAQB, &
+ TCNION, qt_rain, qt_rime, qt_wash, qt_evap)
+!
+ implicit none
+
+!-----------------------------------------------------------------------
+!---p-conde 5.4 (2007) -----called from main-----
+!---called from pmain to calculate rainout and washout of tracers
+!---revised by JNEU 8/2007
+!---
+!-LAER has been removed - no scavenging for aerosols
+!-LAER could be used as LWASHTYP
+!---WILL THIS WORK FOR T42->T21???????????
+!-----------------------------------------------------------------------
+
+ integer LPAR, NTRACE
+ real(r8), intent(inout) :: QTTJFL(LPAR,NTRACE)
+ real(r8), intent(in) :: DTSCAV, QM(LPAR),POFL(LPAR),DELZ(LPAR),GAREA
+ real(r8), intent(in) :: RLS(LPAR),CLWC(LPAR),CIWC(LPAR),CFR(LPAR),TEM(LPAR), &
+ EVAPRATE(LPAR)
+ real(r8), intent(in) :: HSTAR(LPAR,NTRACE),TCMASS(NTRACE)
+ logical , intent(in) :: TCKAQB(NTRACE),TCNION(NTRACE)
+!
+ real(r8), intent(inout) :: qt_rain(lpar)
+ real(r8), intent(inout) :: qt_rime(lpar)
+ real(r8), intent(inout) :: qt_wash(lpar)
+ real(r8), intent(inout) :: qt_evap(lpar)
+!
+ integer I,J,L,N,LE, LM1
+ real(r8), dimension(LPAR) :: CFXX
+ real(r8), dimension(LPAR) :: QTT, QTTNEW
+
+ real(r8) WRK, RNEW_TST
+ real(r8) CLWX
+ real(r8) RNEW,RPRECIP,DELTARIMEMASS,DELTARIME,RAMPCT
+ real(r8) MASSLOSS
+ real(r8) DOR,DNEW,DEMP,COLEFFSNOW,RHOSNOW
+ real(r8) WEMP,REMP,RRAIN,RWASH
+ real(r8) QTPRECIP,QTRAIN,QTCXA,QTAX,QTOC
+
+ real(r8) FAMA,RAMA,DAMA,FCA,RCA,DCA
+ real(r8) FAX,RAX,DAX,FCXA,RCXA,DCXA,FCXB,RCXB,DCXB
+ real(r8) RAXADJ,FAXADJ,RAXADJF
+ real(r8) QTDISCF,QTDISRIME,QTDISCXA
+ real(r8) QTEVAPAXP,QTEVAPAXW,QTEVAPAX
+ real(r8) QTWASHAX
+ real(r8) QTEVAPCXAP,QTEVAPCXAW,QTEVAPCXA
+ real(r8) QTWASHCXA,QTRIMECXA
+ real(r8) QTRAINCXA,QTRAINCXB
+ real(r8) QTTOPCA,QTTOPAA,QTTOPCAX,QTTOPAAX
+
+ real(r8) AMPCT,AMCLPCT,CLNEWPCT,CLNEWAMPCT,CLOLDPCT,CLOLDAMPCT
+ real(r8) RAXLOC,RCXALOC,RCXBLOC,RCALOC,RAMALOC,RCXPCT
+
+ real(r8) QTNETLCXA,QTNETLCXB,QTNETLAX,QTNETL
+ real(r8) QTDISSTAR
+
+
+ real(r8), parameter :: CFMIN=0.1_r8
+ real(r8), parameter :: CWMIN=1.0e-5_r8
+ real(r8), parameter :: DMIN=1.0e-1_r8 !mm
+ real(r8), parameter :: VOLPOW=1._r8/3._r8
+ real(r8), parameter :: RHORAIN=1.0e3_r8 !kg/m3
+ real(r8), parameter :: RHOSNOWFIX=1.0e2_r8 !kg/m3
+ real(r8), parameter :: COLEFFRAIN=0.7_r8
+ real(r8), parameter :: TMIX=258._r8
+ real(r8), parameter :: TFROZ=240._r8
+ real(r8), parameter :: COLEFFAER=0.05_r8
+!
+! additional work arrays and diagnostics
+!
+ real(r8) :: rls_wrk(lpar)
+ real(r8) :: rnew_wrk(lpar)
+ real(r8) :: rca_wrk(lpar)
+ real(r8) :: fca_wrk(lpar)
+ real(r8) :: rcxa_wrk(lpar)
+ real(r8) :: fcxa_wrk(lpar)
+ real(r8) :: rcxb_wrk(lpar)
+ real(r8) :: fcxb_wrk(lpar)
+ real(r8) :: rax_wrk(lpar,2)
+ real(r8) :: fax_wrk(lpar,2)
+ real(r8) :: rama_wrk(lpar)
+ real(r8) :: fama_wrk(lpar)
+ real(r8) :: deltarime_wrk(lpar)
+ real(r8) :: clwx_wrk(lpar)
+ real(r8) :: frc(lpar,3)
+ real(r8) :: rlsog(lpar)
+!
+ logical :: is_hno3
+ logical :: rls_flag(lpar)
+ logical :: rnew_flag(lpar)
+ logical :: cf_trigger(lpar)
+ logical :: freezing(lpar)
+!
+ real(r8), parameter :: four = 4._r8
+ real(r8), parameter :: adj_factor = one + 10._r8*epsilon( one )
+!
+ integer :: LWASHTYP,LICETYP
+!
+ if ( debug ) then
+ print '(a,50f8.2)','tckaqb ',tckaqb
+ print '(a,50e12.4)','hstar ',hstar(1,:)
+ print '(a,50i4)' ,'ice_uptake ',TCNION
+ print '(a,50f8.2)','mol_weight ',TCMASS(:)
+ print '(a,50f8.2)','temp ',tem(:)
+ print '(a,50f8.2)','p ',pofl(:)
+ end if
+
+!-----------------------------------------------------------------------
+ LE = LPAR-1
+!
+ rls_flag(1:le) = rls(1:le) > zero
+ freezing(1:le) = tem(1:le) < tice
+ rlsog(1:le) = rls(1:le)/garea
+!
+species_loop : &
+ do N = 1,NTRACE
+ QTT(:lpar) = QTTJFL(:lpar,N)
+ QTTNEW(:lpar) = QTTJFL(:lpar,N)
+ is_hno3 = n == hno3_ndx
+ if( is_hno3 ) then
+ qt_rain(:lpar) = zero
+ qt_rime(:lpar) = zero
+ qt_wash(:lpar) = zero
+ qt_evap(:lpar) = zero
+ rca_wrk(:lpar) = zero
+ fca_wrk(:lpar) = zero
+ rcxa_wrk(:lpar) = zero
+ fcxa_wrk(:lpar) = zero
+ rcxb_wrk(:lpar) = zero
+ fcxb_wrk(:lpar) = zero
+ rls_wrk(:lpar) = zero
+ rnew_wrk(:lpar) = zero
+ cf_trigger(:lpar) = .false.
+ clwx_wrk(:lpar) = -9999._r8
+ deltarime_wrk(:lpar) = -9999._r8
+ rax_wrk(:lpar,:) = zero
+ fax_wrk(:lpar,:) = zero
+ endif
+
+!-----------------------------------------------------------------------
+! check whether soluble in ice
+!-----------------------------------------------------------------------
+ if( TCNION(N) ) then
+ LICETYP = 1
+ else
+ LICETYP = 2
+ end if
+
+!-----------------------------------------------------------------------
+! initialization
+!-----------------------------------------------------------------------
+ QTTOPAA = zero
+ QTTOPCA = zero
+
+ RCA = zero
+ FCA = zero
+ DCA = zero
+ RAMA = zero
+ FAMA = zero
+ DAMA = zero
+
+ AMPCT = zero
+ AMCLPCT = zero
+ CLNEWPCT = zero
+ CLNEWAMPCT = zero
+ CLOLDPCT = zero
+ CLOLDAMPCT = zero
+!-----------------------------------------------------------------------
+! Check whether precip in top layer - if so, require CF ge 0.2
+!-----------------------------------------------------------------------
+ if( RLS(LE) > zero ) then
+ CFXX(LE) = max( CFMIN,CFR(LE) )
+ else
+ CFXX(LE) = CFR(LE)
+ endif
+
+ rnew_flag(1:le) = .false.
+
+level_loop : &
+ do L = LE,1,-1
+ LM1 = L - 1
+ FAX = zero
+ RAX = zero
+ DAX = zero
+ FCXA = zero
+ FCXB = zero
+ DCXA = zero
+ DCXB = zero
+ RCXA = zero
+ RCXB = zero
+
+ QTDISCF = zero
+ QTDISRIME = zero
+ QTDISCXA = zero
+
+ QTEVAPAXP = zero
+ QTEVAPAXW = zero
+ QTEVAPAX = zero
+ QTWASHAX = zero
+
+ QTEVAPCXAP = zero
+ QTEVAPCXAW = zero
+ QTEVAPCXA = zero
+ QTRIMECXA = zero
+ QTWASHCXA = zero
+ QTRAINCXA = zero
+ QTRAINCXB = zero
+
+ RAMPCT = zero
+ RCXPCT = zero
+
+ RCXALOC = zero
+ RCXBLOC = zero
+ RAXLOC = zero
+ RAMALOC = zero
+ RCALOC = zero
+
+ RPRECIP = zero
+ DELTARIMEMASS = zero
+ DELTARIME = zero
+ DOR = zero
+ DNEW = zero
+
+ QTTOPAAX = zero
+ QTTOPCAX = zero
+
+has_rls : &
+ if( rls_flag(l) ) then
+!-----------------------------------------------------------------------
+!-----Evaporate ambient precip and decrease area-------------------------
+!-----If ice, diam=diam falling from above If rain, diam=4mm (not used)
+!-----Evaporate tracer contained in evaporated precip
+!-----Can't evaporate more than we start with-----------------------------
+!-----Don't do washout until we adjust ambient precip to match Rbot if needed
+!------(after RNEW if statements)
+!-----------------------------------------------------------------------
+ FAX = max( zero,FAMA*(one - evaprate(l)) )
+ RAX = RAMA !kg/m2/s
+ if ( debug ) then
+ if( (l == 3 .or. l == 2) ) then
+ write(*,*) 'washout: l,rls,fax = ',l,rls(l),fax
+ endif
+ endif
+ if( FAMA > zero ) then
+ if( freezing(l) ) then
+ DAX = DAMA !mm
+ else
+ DAX = four !mm - not necessary
+ endif
+ else
+ DAX = zero
+ endif
+
+ if( RAMA > zero ) then
+ QTEVAPAXP = min( QTTOPAA,EVAPRATE(L)*QTTOPAA )
+ else
+ QTEVAPAXP = zero
+ endif
+ if( is_hno3 ) then
+ rax_wrk(l,1) = rax
+ fax_wrk(l,1) = fax
+ endif
+
+
+!-----------------------------------------------------------------------
+! Determine how much the in-cloud precip rate has increased------
+!-----------------------------------------------------------------------
+ WRK = RAX*FAX + RCA*FCA
+ if( WRK > 0._r8 ) then
+ RNEW_TST = RLS(L)/(GAREA * WRK)
+ else
+ RNEW_TST = 10._r8
+ endif
+ RNEW = RLSOG(L) - (RAX*FAX + RCA*FCA) !GBA*CF
+ rnew_wrk(l) = rnew_tst
+ if ( debug ) then
+ if( is_hno3 .and. l == kdiag-1 ) then
+ write(*,*) ' '
+ write(*,*) 'washout: rls,rax,fax,rca,fca'
+ write(*,'(1p,5g15.7)') rls(l),rax,fax,rca,fca
+ write(*,*) ' '
+ endif
+ endif
+!-----------------------------------------------------------------------
+! if RNEW>0, there is growth and/or new precip formation
+!-----------------------------------------------------------------------
+has_rnew: if( rlsog(l) > adj_factor*(rax*fax + rca*fca) ) then
+!-----------------------------------------------------------------------
+! Min cloudwater requirement for cloud with new precip
+! Min CF is set at top for LE, at end for other levels
+! CWMIN is only needed for new precip formation - do not need for RNEW<0
+!-----------------------------------------------------------------------
+ if( cfxx(l) == zero ) then
+ if ( do_diag ) then
+ write(*,*) 'cfxx(l) == zero',l
+ write(*,*) qttjfl(:,n)
+ write(*,*) qm(:)
+ write(*,*) pofl(:)
+ write(*,*) delz(:)
+ write(*,*) rls(:)
+ write(*,*) clwc(:)
+ write(*,*) ciwc(:)
+ write(*,*) cfr(:)
+ write(*,*) tem(:)
+ write(*,*) evaprate(:)
+ write(*,*) hstar(:,n)
+ end if
+!
+! if we are here,, that means that there is
+! a inconsistency and this will lead to a division
+! by 0 later on! This column should then be skipped
+!
+ QTTJFL(:lpar,n) = QTT(:lpar)
+ cycle species_loop
+!
+! call endrun()
+!
+ endif
+ rnew_flag(l) = .true.
+ CLWX = max( CLWC(L)+CIWC(L),CWMIN*CFXX(L) )
+ if( is_hno3 ) then
+ clwx_wrk(l) = clwx
+ endif
+!-----------------------------------------------------------------------
+! Area of old cloud and new cloud
+!-----------------------------------------------------------------------
+ FCXA = FCA
+ FCXB = max( zero,CFXX(L)-FCXA )
+!-----------------------------------------------------------------------
+! ICE
+! For ice and mixed phase, grow precip in old cloud by riming
+! Use only portion of cloudwater in old cloud fraction
+! and rain above old cloud fraction
+! COLEFF from Lohmann and Roeckner (1996), Loss rate from Rotstayn (1997)
+!-----------------------------------------------------------------------
+is_freezing : &
+ if( freezing(l) ) then
+ COLEFFSNOW = exp( 2.5e-2_r8*(TEM(L) - TICE) )
+ if( TEM(L) <= TFROZ ) then
+ RHOSNOW = RHOSNOWFIX
+ else
+ RHOSNOW = 0.303_r8*(TEM(L) - TFROZ)*RHOSNOWFIX
+ endif
+ if( FCXA > zero ) then
+ if( DCA > zero ) then
+ DELTARIMEMASS = CLWX*QM(L)*(FCXA/CFXX(L))* &
+ (one - exp( (-COLEFFSNOW/(DCA*1.e-3_r8))*((RCA)/(2._r8*RHOSNOW))*DTSCAV )) !uses GBA R
+ else
+ DELTARIMEMASS = zero
+ endif
+ else
+ DELTARIMEMASS = zero
+ endif
+!-----------------------------------------------------------------------
+! Increase in precip rate due to riming (kg/m2/s):
+! Limit to total increase in R in cloud
+!-----------------------------------------------------------------------
+ if( FCXA > zero ) then
+ DELTARIME = min( RNEW/FCXA,DELTARIMEMASS/(FCXA*GAREA*DTSCAV) ) !GBA
+ else
+ DELTARIME = zero
+ endif
+ if( is_hno3 ) then
+ deltarime_wrk(l) = deltarime
+ endif
+!-----------------------------------------------------------------------
+! Find diameter of rimed precip, must be at least .1mm
+!-----------------------------------------------------------------------
+ if( RCA > zero ) then
+ DOR = max( DMIN,(((RCA+DELTARIME)/RCA)**VOLPOW)*DCA )
+ else
+ DOR = zero
+ endif
+!-----------------------------------------------------------------------
+! If there is some in-cloud precip left, we have new precip formation
+! Will be spread over whole cloud fraction
+!-----------------------------------------------------------------------
+! Calculate precip rate in old and new cloud fractions
+!-----------------------------------------------------------------------
+ RPRECIP = (RNEW-(DELTARIME*FCXA))/CFXX(L) !kg/m2/s !GBA
+!-----------------------------------------------------------------------
+! Calculate precip rate in old and new cloud fractions
+!-----------------------------------------------------------------------
+ RCXA = RCA + DELTARIME + RPRECIP !kg/m2/s GBA
+ RCXB = RPRECIP !kg/m2/s GBA
+
+!-----------------------------------------------------------------------
+! Find diameter of new precip from empirical relation using Rprecip
+! in given area of box- use density of water, not snow, to convert kg/s
+! to mm/s -> as given in Field and Heymsfield
+! Also calculate diameter of mixed precip,DCXA, from empirical relation
+! using total R in FCXA - this will give larger particles than averaging DOR and
+! DNEW in the next level
+! DNEW and DCXA must be at least .1mm
+!-----------------------------------------------------------------------
+ if( RPRECIP > zero ) then
+ WEMP = (CLWX*QM(L))/(GAREA*CFXX(L)*DELZ(L)) !kg/m3
+ REMP = RPRECIP/((RHORAIN/1.e3_r8)) !mm/s local
+ DNEW = DEMPIRICAL( WEMP, REMP )
+ if ( debug ) then
+ if( is_hno3 .and. l >= 15 ) then
+ write(*,*) ' '
+ write(*,*) 'washout: wemp,remp.dnew @ l = ',l
+ write(*,'(1p,3g15.7)') wemp,remp,dnew
+ write(*,*) ' '
+ endif
+ endif
+ DNEW = max( DMIN,DNEW )
+ if( FCXB > zero ) then
+ DCXB = DNEW
+ else
+ DCXB = zero
+ endif
+ else
+ DCXB = zero
+ endif
+
+ if( FCXA > zero ) then
+ WEMP = (CLWX*QM(L)*(FCXA/CFXX(L)))/(GAREA*FCXA*DELZ(L)) !kg/m3
+ REMP = RCXA/((RHORAIN/1.e3_r8)) !mm/s local
+ DEMP = DEMPIRICAL( WEMP, REMP )
+ DCXA = ((RCA+DELTARIME)/RCXA)*DOR + (RPRECIP/RCXA)*DNEW
+ DCXA = max( DEMP,DCXA )
+ DCXA = max( DMIN,DCXA )
+ else
+ DCXA = zero
+ endif
+ if ( debug ) then
+ if( is_hno3 .and. l >= 15 ) then
+ write(*,*) ' '
+ write(*,*) 'washout: rca,rcxa,deltarime,dor,rprecip,dnew @ l = ',l
+ write(*,'(1p,6g15.7)') rca,rcxa,deltarime,dor,rprecip,dnew
+ write(*,*) 'washout: dcxa,dcxb,wemp,remp,demp'
+ write(*,'(1p,5g15.7)') dcxa,dcxb,wemp,remp,demp
+ write(*,*) ' '
+ end if
+ endif
+
+ if( QTT(L) > zero ) then
+!-----------------------------------------------------------------------
+! ICE SCAVENGING
+!-----------------------------------------------------------------------
+! For ice, rainout only hno3/aerosols using new precip
+! Tracer dissolved given by Kaercher and Voigt (2006) for T<258K
+! For T>258K, use Henry's Law with Retention coefficient
+! Rain out in whole CF
+!-----------------------------------------------------------------------
+ if( RPRECIP > zero ) then
+ if( LICETYP == 1 ) then
+ RRAIN = RPRECIP*GAREA !kg/s local
+ call DISGAS( CLWX, CFXX(L), TCMASS(N), HSTAR(L,N), &
+ TEM(L),POFL(L),QM(L), &
+ QTT(L)*CFXX(L),QTDISCF )
+ call RAINGAS( RRAIN, DTSCAV, CLWX, CFXX(L), &
+ QM(L), QTT(L), QTDISCF, QTRAIN )
+ WRK = QTRAIN/CFXX(L)
+ QTRAINCXA = FCXA*WRK
+ QTRAINCXB = FCXB*WRK
+ elseif( LICETYP == 2 ) then
+ QTRAINCXA = zero
+ QTRAINCXB = zero
+ endif
+ if( debug .and. is_hno3 .and. l == kdiag ) then
+ write(*,*) ' '
+ write(*,*) 'washout: Ice Scavenging'
+ write(*,*) 'washout: qtraincxa, qtraincxb, fcxa, fcxb, qt_rain, cfxx(l), wrk @ level = ',l
+ write(*,'(1p,7g15.7)') qtraincxa, qtraincxb, fcxa, fcxb, qt_rain(l), cfxx(l), wrk
+ write(*,*) ' '
+ endif
+ endif
+!-----------------------------------------------------------------------
+! For ice, accretion removal for hno3 and aerosols is propotional to riming,
+! no accretion removal for gases
+! remove only in mixed portion of cloud
+! Limit DELTARIMEMASS to RNEW*DTSCAV for ice - evaporation of rimed ice to match
+! RNEW precip rate would result in HNO3 escaping from ice (no trapping)
+!-----------------------------------------------------------------------
+ if( DELTARIME > zero ) then
+ if( LICETYP == 1 ) then
+ if( TEM(L) <= TFROZ ) then
+ RHOSNOW = RHOSNOWFIX
+ else
+ RHOSNOW = 0.303_r8*(TEM(L) - TFROZ)*RHOSNOWFIX
+ endif
+ QTCXA = QTT(L)*FCXA
+ call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), &
+ HSTAR(L,N), TEM(L), POFL(L), &
+ QM(L), QTCXA, QTDISRIME )
+ QTDISSTAR = (QTDISRIME*QTCXA)/(QTDISRIME + QTCXA)
+ if ( debug ) then
+ if( is_hno3 .and. l >= 15 ) then
+ write(*,*) ' '
+ write(*,*) 'washout: fcxa,dca,rca,qtdisstar @ l = ',l
+ write(*,'(1p,4g15.7)') fcxa,dca,rca,qtdisstar
+ write(*,*) ' '
+ endif
+ endif
+ QTRIMECXA = QTCXA* &
+ (one - exp((-COLEFFSNOW/(DCA*1.e-3_r8))* &
+ (RCA/(2._r8*RHOSNOW))* & !uses GBA R
+ (QTDISSTAR/QTCXA)*DTSCAV))
+ QTRIMECXA = min( QTRIMECXA, &
+ ((RNEW*GAREA*DTSCAV)/(CLWX*QM(L)*(FCXA/CFXX(L))))*QTDISSTAR)
+ elseif( LICETYP == 2 ) then
+ QTRIMECXA = zero
+ endif
+ endif
+ else
+ QTRAINCXA = zero
+ QTRAINCXB = zero
+ QTRIMECXA = zero
+ endif
+!-----------------------------------------------------------------------
+! For ice, no washout in interstitial cloud air
+!-----------------------------------------------------------------------
+ QTWASHCXA = zero
+ QTEVAPCXA = zero
+
+!-----------------------------------------------------------------------
+! RAIN
+! For rain, accretion increases rain rate but diameter remains constant
+! Diameter is 4mm (not used)
+!-----------------------------------------------------------------------
+ else is_freezing
+ if( FCXA > zero ) then
+ DELTARIMEMASS = (CLWX*QM(L))*(FCXA/CFXX(L))* &
+ (one - exp( -0.24_r8*COLEFFRAIN*((RCA)**0.75_r8)*DTSCAV )) !local
+ else
+ DELTARIMEMASS = zero
+ endif
+!-----------------------------------------------------------------------
+! Increase in precip rate due to riming (kg/m2/s):
+! Limit to total increase in R in cloud
+!-----------------------------------------------------------------------
+ if( FCXA > zero ) then
+ DELTARIME = min( RNEW/FCXA,DELTARIMEMASS/(FCXA*GAREA*DTSCAV) ) !GBA
+ else
+ DELTARIME = zero
+ endif
+!-----------------------------------------------------------------------
+! If there is some in-cloud precip left, we have new precip formation
+!-----------------------------------------------------------------------
+ RPRECIP = (RNEW-(DELTARIME*FCXA))/CFXX(L) !GBA
+
+ RCXA = RCA + DELTARIME + RPRECIP !kg/m2/s GBA
+ RCXB = RPRECIP !kg/m2/s GBA
+ DCXA = FOUR
+ if( FCXB > zero ) then
+ DCXB = FOUR
+ else
+ DCXB = zero
+ endif
+!-----------------------------------------------------------------------
+! RAIN SCAVENGING
+! For rain, rainout both hno3/aerosols and gases using new precip
+!-----------------------------------------------------------------------
+ if( QTT(L) > zero ) then
+ if( RPRECIP > zero ) then
+ RRAIN = (RPRECIP*GAREA) !kg/s local
+ call DISGAS( CLWX, CFXX(L), TCMASS(N), HSTAR(L,N), &
+ TEM(L), POFL(L), QM(L), &
+ QTT(L)*CFXX(L), QTDISCF )
+ call RAINGAS( RRAIN, DTSCAV, CLWX, CFXX(L), &
+ QM(L), QTT(L), QTDISCF, QTRAIN )
+ WRK = QTRAIN/CFXX(L)
+ QTRAINCXA = FCXA*WRK
+ QTRAINCXB = FCXB*WRK
+ if( debug .and. is_hno3 .and. l == kdiag ) then
+ write(*,*) ' '
+ write(*,*) 'washout: Rain Scavenging'
+ write(*,*) 'washout: qtraincxa, qtraincxb, fcxa, fcxb, qt_rain, cfxx(l), wrk @ level = ',l
+ write(*,'(1p,7g15.7)') qtraincxa, qtraincxb, fcxa, fcxb, qt_rain(l), cfxx(l), wrk
+ write(*,*) ' '
+ endif
+ endif
+!-----------------------------------------------------------------------
+! For rain, accretion removal is propotional to riming
+! caclulate for hno3/aerosols and gases
+! Remove only in mixed portion of cloud
+! Limit DELTARIMEMASS to RNEW*DTSCAV
+!-----------------------------------------------------------------------
+ if( DELTARIME > zero ) then
+ QTCXA = QTT(L)*FCXA
+ call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), &
+ HSTAR(L,N), TEM(L), POFL(L), &
+ QM(L), QTCXA, QTDISRIME )
+ QTDISSTAR = (QTDISRIME*QTCXA)/(QTDISRIME + QTCXA)
+ QTRIMECXA = QTCXA* &
+ (one - exp(-0.24_r8*COLEFFRAIN* &
+ ((RCA)**0.75_r8)* & !local
+ (QTDISSTAR/QTCXA)*DTSCAV))
+ QTRIMECXA = min( QTRIMECXA, &
+ ((RNEW*GAREA*DTSCAV)/(CLWX*QM(L)*(FCXA/CFXX(L))))*QTDISSTAR)
+ else
+ QTRIMECXA = zero
+ endif
+ else
+ QTRAINCXA = zero
+ QTRAINCXB = zero
+ QTRIMECXA = zero
+ endif
+!-----------------------------------------------------------------------
+! For rain, washout gases and HNO3/aerosols using rain from above old cloud
+! Washout for HNO3/aerosols is only on non-dissolved portion, impaction-style
+! Washout for gases is on non-dissolved portion, limited by QTTOP+QTRIME
+!-----------------------------------------------------------------------
+ if( RCA > zero ) then
+ QTPRECIP = FCXA*QTT(L) - QTDISRIME
+ if( HSTAR(L,N) > 1.e4_r8 ) then
+ if( QTPRECIP > zero ) then
+ QTWASHCXA = QTPRECIP*(one - exp( -0.24_r8*COLEFFAER*((RCA)**0.75_r8)*DTSCAV )) !local
+ else
+ QTWASHCXA = zero
+ endif
+ QTEVAPCXA = zero
+ else
+ RWASH = RCA*GAREA !kg/s local
+ if( QTPRECIP > zero ) then
+ call WASHGAS( RWASH, FCA, DTSCAV, QTTOPCA+QTRIMECXA, &
+ HSTAR(L,N), TEM(L), POFL(L), &
+ QM(L), QTPRECIP, QTWASHCXA, QTEVAPCXA )
+ else
+ QTWASHCXA = zero
+ QTEVAPCXA = zero
+ endif
+ endif
+ endif
+ endif is_freezing
+!-----------------------------------------------------------------------
+! If RNEW zero ) then
+ RCXA = min( RCA,RLS(L)/(GAREA*FCXA) ) !kg/m2/s GBA
+ if( FAX > zero .and. ((RCXA+1.e-12_r8) < RLS(L)/(GAREA*FCXA)) ) then
+ RAXADJF = RLS(L)/GAREA - RCXA*FCXA
+ RAMPCT = RAXADJF/(RAX*FAX)
+ FAXADJ = RAMPCT*FAX
+ if( FAXADJ > zero ) then
+ RAXADJ = RAXADJF/FAXADJ
+ else
+ RAXADJ = zero
+ endif
+ else
+ RAXADJ = zero
+ RAMPCT = zero
+ FAXADJ = zero
+ endif
+ else
+ RCXA = zero
+ if( FAX > zero ) then
+ RAXADJF = RLS(L)/GAREA
+ RAMPCT = RAXADJF/(RAX*FAX)
+ FAXADJ = RAMPCT*FAX
+ if( FAXADJ > zero ) then
+ RAXADJ = RAXADJF/FAXADJ
+ else
+ RAXADJ = zero
+ endif
+ else
+ RAXADJ = zero
+ RAMPCT = zero
+ FAXADJ = zero
+ endif
+ endif
+
+ QTEVAPAXP = min( QTTOPAA,QTTOPAA - (RAMPCT*(QTTOPAA-QTEVAPAXP)) )
+ FAX = FAXADJ
+ RAX = RAXADJ
+ if ( debug ) then
+ if( (l == 3 .or. l == 2) ) then
+ write(*,*) 'washout: l,fcxa,fax = ',l,fcxa,fax
+ endif
+ endif
+
+!-----------------------------------------------------------------------
+! IN-CLOUD EVAPORATION/WASHOUT
+! If precip out the bottom of the cloud is 0, evaporate everything
+! If there is no cloud, QTTOPCA=0, so nothing happens
+!-----------------------------------------------------------------------
+ if( RCXA <= zero ) then
+ QTEVAPCXA = QTTOPCA
+ RCXA = zero
+ DCXA = zero
+ else
+!-----------------------------------------------------------------------
+! If rain out the bottom of the cloud is >0 (but .le. RCA):
+! For ice, decrease particle size,
+! no washout
+! no evap for non-ice gases (b/c there is nothing in ice)
+! TTmix, hno3&aerosols are incorporated into ice structure:
+! do not release
+! For rain, assume full evaporation of some raindrops
+! proportional evaporation for all species
+! washout for gases using Rbot
+! impact washout for hno3/aerosol portion in gas phase
+!-----------------------------------------------------------------------
+! if (TEM(L) < TICE ) then
+is_freezing_a : &
+ if( freezing(l) ) then
+ QTWASHCXA = zero
+ DCXA = ((RCXA/RCA)**VOLPOW)*DCA
+ if( LICETYP == 1 ) then
+ if( TEM(L) <= TMIX ) then
+ MASSLOSS = (RCA-RCXA)*FCXA*GAREA*DTSCAV
+!-----------------------------------------------------------------------
+! note-QTT doesn't matter b/c T<258K
+!-----------------------------------------------------------------------
+ call DISGAS( (MASSLOSS/QM(L)), FCXA, TCMASS(N), &
+ HSTAR(L,N), TEM(L), POFL(L), &
+ QM(L), QTT(L), QTEVAPCXA )
+ QTEVAPCXA = min( QTTOPCA,QTEVAPCXA )
+ else
+ QTEVAPCXA = zero
+ endif
+ elseif( LICETYP == 2 ) then
+ QTEVAPCXA = zero
+ endif
+ else is_freezing_a
+ QTEVAPCXAP = (RCA - RCXA)/RCA*QTTOPCA
+ DCXA = FOUR
+ QTCXA = FCXA*QTT(L)
+ if( HSTAR(L,N) > 1.e4_r8 ) then
+ if( QTT(L) > zero ) then
+ call DISGAS( CLWX*(FCXA/CFXX(L)), FCXA, TCMASS(N), &
+ HSTAR(L,N), TEM(L), POFL(L), &
+ QM(L), QTCXA, QTDISCXA )
+ if( QTCXA > QTDISCXA ) then
+ QTWASHCXA = (QTCXA - QTDISCXA)*(one - exp( -0.24_r8*COLEFFAER*((RCXA)**0.75_r8)*DTSCAV )) !local
+ else
+ QTWASHCXA = zero
+ endif
+ QTEVAPCXAW = zero
+ else
+ QTWASHCXA = zero
+ QTEVAPCXAW = zero
+ endif
+ else
+ RWASH = RCXA*GAREA !kg/s local
+ call WASHGAS( RWASH, FCXA, DTSCAV, QTTOPCA, HSTAR(L,N), &
+ TEM(L), POFL(L), QM(L), &
+ QTCXA-QTDISCXA, QTWASHCXA, QTEVAPCXAW )
+ endif
+ QTEVAPCXA = QTEVAPCXAP + QTEVAPCXAW
+ endif is_freezing_a
+ endif
+ endif has_rnew
+
+!-----------------------------------------------------------------------
+! AMBIENT WASHOUT
+! Ambient precip is finalized - if it is rain, washout
+! no ambient washout for ice, since gases are in vapor phase
+!-----------------------------------------------------------------------
+ if( RAX > zero ) then
+ if( .not. freezing(l) ) then
+ QTAX = FAX*QTT(L)
+ if( HSTAR(L,N) > 1.e4_r8 ) then
+ QTWASHAX = QTAX* &
+ (one - exp(-0.24_r8*COLEFFAER* &
+ ((RAX)**0.75_r8)*DTSCAV)) !local
+ QTEVAPAXW = zero
+ else
+ RWASH = RAX*GAREA !kg/s local
+ call WASHGAS( RWASH, FAX, DTSCAV, QTTOPAA, HSTAR(L,N), &
+ TEM(L), POFL(L), QM(L), QTAX, &
+ QTWASHAX, QTEVAPAXW )
+ endif
+ else
+ QTEVAPAXW = zero
+ QTWASHAX = zero
+ endif
+ else
+ QTEVAPAXW = zero
+ QTWASHAX = zero
+ endif
+ QTEVAPAX = QTEVAPAXP + QTEVAPAXW
+
+!-----------------------------------------------------------------------
+! END SCAVENGING
+! Require CF if our ambient evaporation rate would give less
+! precip than R from model.
+!-----------------------------------------------------------------------
+ if( do_diag .and. is_hno3 ) then
+ rls_wrk(l) = rls(l)/garea
+ rca_wrk(l) = rca
+ fca_wrk(l) = fca
+ rcxa_wrk(l) = rcxa
+ fcxa_wrk(l) = fcxa
+ rcxb_wrk(l) = rcxb
+ fcxb_wrk(l) = fcxb
+ rax_wrk(l,2) = rax
+ fax_wrk(l,2) = fax
+ endif
+upper_level : &
+ if( L > 1 ) then
+ FAMA = max( FCXA + FCXB + FAX - CFR(LM1),zero )
+ if( FAX > zero ) then
+ RAXLOC = RAX/FAX
+ else
+ RAXLOC = zero
+ endif
+ if( FCXA > zero ) then
+ RCXALOC = RCXA/FCXA
+ else
+ RCXALOC = zero
+ endif
+ if( FCXB > zero ) then
+ RCXBLOC = RCXB/FCXB
+ else
+ RCXBLOC = zero
+ endif
+
+ if( CFR(LM1) >= CFMIN ) then
+ CFXX(LM1) = CFR(LM1)
+ else
+ if( adj_factor*RLSOG(LM1) >= (RCXA*FCXA + RCXB*FCXB + RAX*FAX)*(one - EVAPRATE(LM1)) ) then
+ CFXX(LM1) = CFMIN
+ cf_trigger(lm1) = .true.
+ else
+ CFXX(LM1) = CFR(LM1)
+ endif
+ if( is_hno3 .and. lm1 == kdiag .and. debug ) then
+ write(*,*) ' '
+ write(*,*) 'washout: rls,garea,rcxa,fcxa,rcxb,fcxb,rax,fax'
+ write(*,'(1p,8g15.7)') rls(lm1),garea,rcxa,fcxa,rcxb,fcxb,rax,fax
+ write(*,*) ' '
+ endif
+ endif
+!-----------------------------------------------------------------------
+! Figure out what will go into ambient and cloud below
+! Don't do for lowest level
+!-----------------------------------------------------------------------
+ if( FAX > zero ) then
+ RAXLOC = RAX/FAX
+ AMPCT = max( zero,min( one,(CFXX(L) + FAX - CFXX(LM1))/FAX ) )
+ AMCLPCT = one - AMPCT
+ else
+ RAXLOC = zero
+ AMPCT = zero
+ AMCLPCT = zero
+ endif
+ if( FCXB > zero ) then
+ RCXBLOC = RCXB/FCXB
+ CLNEWPCT = max( zero,min( (CFXX(LM1) - FCXA)/FCXB,one ) )
+ CLNEWAMPCT = one - CLNEWPCT
+ else
+ RCXBLOC = zero
+ CLNEWPCT = zero
+ CLNEWAMPCT = zero
+ endif
+ if( FCXA > zero ) then
+ RCXALOC = RCXA/FCXA
+ CLOLDPCT = max( zero,min( CFXX(LM1)/FCXA,one ) )
+ CLOLDAMPCT = one - CLOLDPCT
+ else
+ RCXALOC = zero
+ CLOLDPCT = zero
+ CLOLDAMPCT = zero
+ endif
+!-----------------------------------------------------------------------
+! Remix everything for the next level
+!-----------------------------------------------------------------------
+ FCA = min( CFXX(LM1),FCXA*CLOLDPCT + CLNEWPCT*FCXB + AMCLPCT*FAX )
+ if( FCA > zero ) then
+!-----------------------------------------------------------------------
+! Maintain cloud core by reducing NC and AM area going into cloud below
+!-----------------------------------------------------------------------
+ RCA = (RCXA*FCXA*CLOLDPCT + RCXB*FCXB*CLNEWPCT + RAX*FAX*AMCLPCT)/FCA
+ if ( debug ) then
+ if( is_hno3 ) then
+ write(*,*) ' '
+ write(*,*) 'washout: rcxa,fcxa,cloldpctrca,rca,fca,dcxa @ l = ',l
+ write(*,'(1p,6g15.7)') rcxa,fcxa,cloldpct,rca,fca,dcxa
+ write(*,*) 'washout: rcxb,fcxb,clnewpct,dcxb'
+ write(*,'(1p,4g15.7)') rcxb,fcxb,clnewpct,dcxb
+ write(*,*) 'washout: rax,fax,amclpct,dax'
+ write(*,'(1p,4g15.7)') rax,fax,amclpct,dax
+ write(*,*) ' '
+ endif
+ endif
+
+ if (RCA > zero) then
+ DCA = (RCXA*FCXA*CLOLDPCT)/(RCA*FCA)*DCXA + &
+ (RCXB*FCXB*CLNEWPCT)/(RCA*FCA)*DCXB + &
+ (RAX*FAX*AMCLPCT)/(RCA*FCA)*DAX
+ else
+ DCA = zero
+ FCA = zero
+ endif
+
+ else
+ FCA = zero
+ DCA = zero
+ RCA = zero
+ endif
+
+ FAMA = FCXA + FCXB + FAX - CFXX(LM1)
+ if( FAMA > zero ) then
+ RAMA = (RCXA*FCXA*CLOLDAMPCT + RCXB*FCXB*CLNEWAMPCT + RAX*FAX*AMPCT)/FAMA
+ if( RAMA > zero ) then
+ DAMA = (RCXA*FCXA*CLOLDAMPCT)/(RAMA*FAMA)*DCXA + &
+ (RCXB*FCXB*CLNEWAMPCT)/(RAMA*FAMA)*DCXB + &
+ (RAX*FAX*AMPCT)/(RAMA*FAMA)*DAX
+ else
+ FAMA = zero
+ DAMA = zero
+ endif
+ else
+ FAMA = zero
+ DAMA = zero
+ RAMA = zero
+ endif
+ else upper_level
+ AMPCT = zero
+ AMCLPCT = zero
+ CLNEWPCT = zero
+ CLNEWAMPCT = zero
+ CLOLDPCT = zero
+ CLOLDAMPCT = zero
+ endif upper_level
+ else has_rls
+ RNEW = zero
+ QTEVAPCXA = QTTOPCA
+ QTEVAPAX = QTTOPAA
+ if( L > 1 ) then
+ if( RLS(LM1) > zero ) then
+ CFXX(LM1) = max( CFMIN,CFR(LM1) )
+! if( CFR(LM1) >= CFMIN ) then
+! CFXX(LM1) = CFR(LM1)
+! else
+! CFXX(LM1) = CFMIN
+! endif
+ else
+ CFXX(LM1) = CFR(LM1)
+ endif
+ endif
+ AMPCT = zero
+ AMCLPCT = zero
+ CLNEWPCT = zero
+ CLNEWAMPCT = zero
+ CLOLDPCT = zero
+ CLOLDAMPCT = zero
+ RCA = zero
+ RAMA = zero
+ FCA = zero
+ FAMA = zero
+ DCA = zero
+ DAMA = zero
+ endif has_rls
+
+ if( do_diag .and. is_hno3 ) then
+ fama_wrk(l) = fama
+ rama_wrk(l) = rama
+ endif
+!-----------------------------------------------------------------------
+! Net loss can not exceed QTT in each region
+!-----------------------------------------------------------------------
+ QTNETLCXA = QTRAINCXA + QTRIMECXA + QTWASHCXA - QTEVAPCXA
+ QTNETLCXA = min( QTT(L)*FCXA,QTNETLCXA )
+
+ QTNETLCXB =QTRAINCXB
+ QTNETLCXB = min( QTT(L)*FCXB,QTNETLCXB )
+
+ QTNETLAX = QTWASHAX - QTEVAPAX
+ QTNETLAX = min( QTT(L)*FAX,QTNETLAX )
+
+ QTTNEW(L) = QTT(L) - (QTNETLCXA + QTNETLCXB + QTNETLAX)
+
+ if( do_diag .and. is_hno3 ) then
+ qt_rain(l) = qtraincxa + qtraincxb
+ qt_rime(l) = qtrimecxa
+ qt_wash(l) = qtwashcxa + qtwashax
+ qt_evap(l) = qtevapcxa + qtevapax
+ frc(l,1) = qtnetlcxa
+ frc(l,2) = qtnetlcxb
+ frc(l,3) = qtnetlax
+ endif
+ if( debug .and. is_hno3 .and. l == kdiag ) then
+ write(*,*) ' '
+ write(*,*) 'washout: qtraincxa, qtraincxb, qtrimecxa @ level = ',l
+ write(*,'(1p,3g15.7)') qtraincxa, qtraincxb, qtrimecxa
+ write(*,*) ' '
+ endif
+ if ( debug ) then
+ if( (l == 3 .or. l == 2) ) then
+ write(*,*) 'washout: hno3, hno3, qtnetlca,b, qtnetlax @ level = ',l
+ write(*,'(1p,5g15.7)') qttnew(l), qtt(l), qtnetlcxa, qtnetlcxb, qtnetlax
+ write(*,*) 'washout: qtwashax, qtevapax,fax,fama'
+ write(*,'(1p,5g15.7)') qtwashax, qtevapax, fax, fama
+ endif
+ endif
+
+ QTTOPCAX = (QTTOPCA + QTNETLCXA)*CLOLDPCT + QTNETLCXB*CLNEWPCT + (QTTOPAA + QTNETLAX)*AMCLPCT
+ QTTOPAAX = (QTTOPCA + QTNETLCXA)*CLOLDAMPCT + QTNETLCXB*CLNEWAMPCT + (QTTOPAA + QTNETLAX)*AMPCT
+ QTTOPCA = QTTOPCAX
+ QTTOPAA = QTTOPAAX
+ end do level_loop
+
+ if ( debug ) then
+ if( is_hno3 ) then
+ write(*,*) ' '
+ write(*,*) 'washout: clwx_wrk'
+ write(*,'(1p,5g15.7)') clwx_wrk(1:le)
+ write(*,*) 'washout: cfr'
+ write(*,'(1p,5g15.7)') cfr(1:le)
+ write(*,*) 'washout: cfxx'
+ write(*,'(1p,5g15.7)') cfxx(1:le)
+ write(*,*) 'washout: cf trigger'
+ write(*,'(10l4)') cf_trigger(1:le)
+ write(*,*) 'washout: evaprate'
+ write(*,'(1p,5g15.7)') evaprate(1:le)
+ write(*,*) 'washout: rls'
+ write(*,'(1p,5g15.7)') rls(1:le)
+ write(*,*) 'washout: rls/garea'
+ write(*,'(1p,5g15.7)') rls_wrk(1:le)
+ write(*,*) 'washout: rnew_wrk'
+ write(*,'(1p,5g15.7)') rnew_wrk(1:le)
+ write(*,*) 'washout: rnew_flag'
+ write(*,'(10l4)') rnew_flag(1:le)
+ write(*,*) 'washout: deltarime_wrk'
+ write(*,'(1p,5g15.7)') deltarime_wrk(1:le)
+ write(*,*) 'washout: rama_wrk'
+ write(*,'(1p,5g15.7)') rama_wrk(1:le)
+ write(*,*) 'washout: fama_wrk'
+ write(*,'(1p,5g15.7)') fama_wrk(1:le)
+ write(*,*) 'washout: rca_wrk'
+ write(*,'(1p,5g15.7)') rca_wrk(1:le)
+ write(*,*) 'washout: fca_wrk'
+ write(*,'(1p,5g15.7)') fca_wrk(1:le)
+ write(*,*) 'washout: rcxa_wrk'
+ write(*,'(1p,5g15.7)') rcxa_wrk(1:le)
+ write(*,*) 'washout: fcxa_wrk'
+ write(*,'(1p,5g15.7)') fcxa_wrk(1:le)
+ write(*,*) 'washout: rcxb_wrk'
+ write(*,'(1p,5g15.7)') rcxb_wrk(1:le)
+ write(*,*) 'washout: fcxb_wrk'
+ write(*,'(1p,5g15.7)') fcxb_wrk(1:le)
+ write(*,*) 'washout: rax1_wrk'
+ write(*,'(1p,5g15.7)') rax_wrk(1:le,1)
+ write(*,*) 'washout: fax1_wrk'
+ write(*,'(1p,5g15.7)') fax_wrk(1:le,1)
+ write(*,*) 'washout: rax2_wrk'
+ write(*,'(1p,5g15.7)') rax_wrk(1:le,2)
+ write(*,*) 'washout: fax2_wrk'
+ write(*,'(1p,5g15.7)') fax_wrk(1:le,2)
+ write(*,*) 'washout: rls_flag'
+ write(*,'(1p,10l4)') rls_flag(1:le)
+ write(*,*) 'washout: freezing'
+ write(*,'(1p,10l4)') freezing(1:le)
+ write(*,*) 'washout: qtnetlcxa'
+ write(*,'(1p,5g15.7)') frc(1:le,1)
+ write(*,*) 'washout: qtnetlcxb'
+ write(*,'(1p,5g15.7)') frc(1:le,2)
+ write(*,*) 'washout: qtnetlax'
+ write(*,'(1p,5g15.7)') frc(1:le,3)
+ write(*,*) ' '
+ endif
+ endif
+!-----------------------------------------------------------------------
+! reload new tracer mass and rescale moments: check upper limits (LE)
+!-----------------------------------------------------------------------
+ QTTJFL(:le,N) = QTTNEW(:le)
+
+ end do species_loop
+!
+ return
+ end subroutine washo
+!---------------------------------------------------------------------
+ subroutine DISGAS (CLWX,CFX,MOLMASS,HSTAR,TM,PR,QM,QT,QTDIS)
+!---------------------------------------------------------------------
+ implicit none
+ real(r8), intent(in) :: CLWX,CFX !cloud water,cloud fraction
+ real(r8), intent(in) :: MOLMASS !molecular mass of tracer
+ real(r8), intent(in) :: HSTAR !Henry's Law coeffs A*exp(-B/T)
+ real(r8), intent(in) :: TM !temperature of box (K)
+ real(r8), intent(in) :: PR !pressure of box (hPa)
+ real(r8), intent(in) :: QM !air mass in box (kg)
+ real(r8), intent(in) :: QT !tracer in box (kg)
+ real(r8), intent(out) :: QTDIS !tracer dissolved in aqueous phase
+
+ real(r8) MUEMP
+ real(r8), parameter :: INV298 = 1._r8/298._r8
+ real(r8), parameter :: TMIX=258._r8
+ real(r8), parameter :: RETEFF=0.5_r8
+!---Next calculate rate of uptake of tracer
+
+!---effective Henry's Law constant: H* = moles-T / liter-precip / press(atm-T)
+!---p(atm of tracer-T) = (QT/QM) * (.029/MolWt-T) * pressr(hPa)/1000
+!---limit temperature effects to T above freezing
+!----MU from fit to Kaercher and Voigt (2006)
+
+ if(TM .ge. TICE) then
+ QTDIS=(HSTAR*(QT/(QM*CFX))*0.029_r8*(PR/1.0e3_r8))*(CLWX*QM)
+ elseif (TM .le. TMIX) then
+ MUEMP=exp(-14.2252_r8+(1.55704e-1_r8*TM)-(7.1929e-4_r8*(TM**2.0_r8)))
+ QTDIS=MUEMP*(MOLMASS/18._r8)*(CLWX*QM)
+ else
+ QTDIS=RETEFF*((HSTAR*(QT/(QM*CFX))*0.029_r8*(PR/1.0e3_r8))*(CLWX*QM))
+ endif
+
+ return
+ end subroutine DISGAS
+
+!-----------------------------------------------------------------------
+ subroutine RAINGAS (RRAIN,DTSCAV,CLWX,CFX,QM,QT,QTDIS,QTRAIN)
+!-----------------------------------------------------------------------
+!---New trace-gas rainout from large-scale precip with two time scales,
+!---one based on precip formation from cloud water and one based on
+!---Henry's Law solubility: correct limit for delta-t
+!---
+!---NB this code does not consider the aqueous dissociation (eg, C-q)
+!--- that makes uptake of HNO3 and H2SO4 so complete. To do so would
+!--- require that we keep track of the pH of the falling rain.
+!---THUS the Henry's Law coefficient KHA needs to be enhanced to incldue this!
+!---ALSO the possible formation of other soluble species from, eg, CH2O, H2O2
+!--- can be considered with enhanced values of KHA.
+!---
+!---Does NOT now use RMC (moist conv rain) but could, assuming 30% coverage
+!-----------------------------------------------------------------------
+ implicit none
+ real(r8), intent(in) :: RRAIN !new rain formation in box (kg/s)
+ real(r8), intent(in) :: DTSCAV !time step (s)
+ real(r8), intent(in) :: CLWX,CFX !cloud water and cloud fraction
+ real(r8), intent(in) :: QM !air mass in box (kg)
+ real(r8), intent(in) :: QT !tracer in box (kg)
+ real(r8), intent(in) :: QTDIS !tracer in aqueous phase (kg)
+ real(r8), intent(out) :: QTRAIN !tracer picked up by new rain
+
+ real(r8) QTLF,QTDISSTAR
+
+
+
+
+
+ QTDISSTAR=(QTDIS*(QT*CFX))/(QTDIS+(QT*CFX))
+
+!---Tracer Loss frequency (1/s) within cloud fraction:
+ QTLF = (RRAIN*QTDISSTAR)/(CLWX*QM*QT*CFX)
+
+!---in time = DTSCAV, the amount of QTT scavenged is calculated
+!---from CF*AMOUNT OF UPTAKE
+ QTRAIN = QT*CFX*(1._r8 - exp(-DTSCAV*QTLF))
+
+ return
+ end subroutine RAINGAS
+
+
+!-----------------------------------------------------------------------
+ subroutine WASHGAS (RWASH,BOXF,DTSCAV,QTRTOP,HSTAR,TM,PR,QM, &
+ QT,QTWASH,QTEVAP)
+!-----------------------------------------------------------------------
+!---for most gases below-cloud washout assume Henry-Law equilib with precip
+!---assumes that precip is liquid, if frozen, do not call this sub
+!---since solubility is moderate, fraction of box with rain does not matter
+!---NB this code does not consider the aqueous dissociation (eg, C-q)
+!--- that makes uptake of HNO3 and H2SO4 so complete. To do so would
+!--- require that we keep track of the pH of the falling rain.
+!---THUS the Henry's Law coefficient KHA needs to be enhanced to incldue this!
+!---ALSO the possible formation of other soluble species from, eg, CH2O, H2O2
+!--- can be considered with enhanced values of KHA.
+!-----------------------------------------------------------------------
+ implicit none
+ real(r8), intent(in) :: RWASH ! precip leaving bottom of box (kg/s)
+ real(r8), intent(in) :: BOXF ! fraction of box with washout
+ real(r8), intent(in) :: DTSCAV ! time step (s)
+ real(r8), intent(in) :: QTRTOP ! tracer-T in rain entering top of box
+! over time step (kg)
+ real(r8), intent(in) :: HSTAR ! Henry's Law coeffs A*exp(-B/T)
+ real(r8), intent(in) :: TM ! temperature of box (K)
+ real(r8), intent(in) :: PR ! pressure of box (hPa)
+ real(r8), intent(in) :: QT ! tracer in box (kg)
+ real(r8), intent(in) :: QM ! air mass in box (kg)
+ real(r8), intent(out) :: QTWASH ! tracer picked up by precip (kg)
+ real(r8), intent(out) :: QTEVAP ! tracer evaporated from precip (kg)
+
+ real(r8), parameter :: INV298 = 1._r8/298._r8
+ real(r8) :: FWASH, QTMAX, QTDIF
+
+!---effective Henry's Law constant: H* = moles-T / liter-precip / press(atm-T)
+!---p(atm of tracer-T) = (QT/QM) * (.029/MolWt-T) * pressr(hPa)/1000
+!---limit temperature effects to T above freezing
+
+!
+! jfl
+!
+! added test for BOXF = 0.
+!
+ if ( BOXF == 0._r8 ) then
+ QTWASH = 0._r8
+ QTEVAP = 0._r8
+ return
+ end if
+
+!---effective washout frequency (1/s):
+ FWASH = (RWASH*HSTAR*29.e-6_r8*PR)/(QM*BOXF)
+!---equilib amount of T (kg) in rain thru bottom of box over time step
+ QTMAX = QT*FWASH*DTSCAV
+ if (QTMAX .gt. QTRTOP) then
+!---more of tracer T can go into rain
+ QTDIF = min (QT, QTMAX-QTRTOP)
+ QTWASH = QTDIF * (1._r8 - exp(-DTSCAV*FWASH))
+ QTEVAP=0._r8
+ else
+!--too much of T in rain, must degas/evap T
+ QTWASH = 0._r8
+ QTEVAP = QTRTOP - QTMAX
+ endif
+
+ return
+ end subroutine WASHGAS
+
+!-----------------------------------------------------------------------
+ function DEMPIRICAL (CWATER,RRATE)
+!-----------------------------------------------------------------------
+ use shr_spfn_mod, only: shr_spfn_gamma
+
+ implicit none
+ real(r8), intent(in) :: CWATER
+ real(r8), intent(in) :: RRATE
+
+ real(r8) :: DEMPIRICAL
+
+ real(r8) RRATEX,WX,THETA,PHI,ETA,BETA,ALPHA,BEE
+ real(r8) GAMTHETA,GAMBETA
+
+
+
+ RRATEX=RRATE*3600._r8 !mm/hr
+ WX=CWATER*1.0e3_r8 !g/m3
+
+ if(RRATEX .gt. 0.04_r8) then
+ THETA=exp(-1.43_r8*dlog10(7._r8*RRATEX))+2.8_r8
+ else
+ THETA=5._r8
+ endif
+ PHI=RRATEX/(3600._r8*10._r8) !cgs units
+ ETA=exp((3.01_r8*THETA)-10.5_r8)
+ BETA=THETA/(1._r8+0.638_r8)
+ ALPHA=exp(4._r8*(BETA-3.5_r8))
+ BEE=(.638_r8*THETA/(1._r8+.638_r8))-1.0_r8
+ GAMTHETA = shr_spfn_gamma(THETA)
+ GAMBETA = shr_spfn_gamma(BETA+1._r8)
+ DEMPIRICAL=(((WX*ETA*GAMTHETA)/(1.0e6_r8*ALPHA*PHI*GAMBETA))** &
+ (-1._r8/BEE))*10._r8 ! in mm (wx/1e6 for cgs)
+
+
+ return
+ end function DEMPIRICAL
+!
+end module mo_neu_wetdep
diff --git a/src/chemistry/oslo_aero/mo_setsox.F90 b/src/chemistry/oslo_aero/mo_setsox.F90
new file mode 100644
index 0000000000..669d8e7e17
--- /dev/null
+++ b/src/chemistry/oslo_aero/mo_setsox.F90
@@ -0,0 +1,884 @@
+
+module MO_SETSOX
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use cam_logfile, only : iulog
+
+ private
+ public :: sox_inti, setsox
+ public :: has_sox
+
+ save
+ logical :: inv_o3
+ integer :: id_msa
+
+ integer :: id_so2, id_nh3, id_hno3, id_h2o2, id_o3, id_ho2
+ integer :: id_so4, id_h2so4
+
+ logical :: has_sox = .true.
+ logical :: inv_so2, inv_nh3, inv_hno3, inv_h2o2, inv_ox, inv_nh4no3, inv_ho2
+
+ logical :: cloud_borne = .false.
+ logical :: modal_aerosols = .false.
+
+contains
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ subroutine sox_inti
+ !-----------------------------------------------------------------------
+ ! ... initialize the hetero sox routine
+ !-----------------------------------------------------------------------
+
+ use mo_chem_utls, only : get_spc_ndx, get_inv_ndx
+ use spmd_utils, only : masterproc
+ use phys_control, only : phys_getopts
+ use sox_cldaero_mod, only : sox_cldaero_init
+
+ implicit none
+
+
+ call phys_getopts( &
+ prog_modal_aero_out=modal_aerosols )
+
+ cloud_borne = modal_aerosols
+
+#ifdef OSLO_AERO
+ cloud_borne = .TRUE.
+ modal_aerosols = .TRUE.
+#endif
+
+ !-----------------------------------------------------------------
+ ! ... get species indicies
+ !-----------------------------------------------------------------
+
+ if (cloud_borne) then
+ id_h2so4 = get_spc_ndx( 'H2SO4' )
+ else
+ id_so4 = get_spc_ndx( 'SO4' )
+ endif
+ id_msa = get_spc_ndx( 'MSA' )
+
+ inv_so2 = .false.
+ id_so2 = get_inv_ndx( 'SO2' )
+ inv_so2 = id_so2 > 0
+ if ( .not. inv_so2 ) then
+ id_so2 = get_spc_ndx( 'SO2' )
+ endif
+
+ inv_NH3 = .false.
+ id_NH3 = get_inv_ndx( 'NH3' )
+ inv_NH3 = id_NH3 > 0
+ if ( .not. inv_NH3 ) then
+ id_NH3 = get_spc_ndx( 'NH3' )
+ endif
+
+ inv_HNO3 = .false.
+ id_HNO3 = get_inv_ndx( 'HNO3' )
+ inv_HNO3 = id_hno3 > 0
+ if ( .not. inv_HNO3 ) then
+ id_HNO3 = get_spc_ndx( 'HNO3' )
+ endif
+
+ inv_H2O2 = .false.
+ id_H2O2 = get_inv_ndx( 'H2O2' )
+ inv_H2O2 = id_H2O2 > 0
+ if ( .not. inv_H2O2 ) then
+ id_H2O2 = get_spc_ndx( 'H2O2' )
+ endif
+
+ inv_HO2 = .false.
+ id_HO2 = get_inv_ndx( 'HO2' )
+ inv_HO2 = id_HO2 > 0
+ if ( .not. inv_HO2 ) then
+ id_HO2 = get_spc_ndx( 'HO2' )
+ endif
+
+ inv_o3 = get_inv_ndx( 'O3' ) > 0
+ if (inv_o3) then
+ id_o3 = get_inv_ndx( 'O3' )
+ else
+ id_o3 = get_spc_ndx( 'O3' )
+ endif
+ inv_ho2 = get_inv_ndx( 'HO2' ) > 0
+ if (inv_ho2) then
+ id_ho2 = get_inv_ndx( 'HO2' )
+ else
+ id_ho2 = get_spc_ndx( 'HO2' )
+ endif
+
+ has_sox = (id_so2>0) .and. (id_h2o2>0) .and. (id_o3>0) .and. (id_ho2>0)
+ if (cloud_borne) then
+ has_sox = has_sox .and. (id_h2so4>0)
+ else
+ has_sox = has_sox .and. (id_so4>0) .and. (id_nh3>0)
+ endif
+
+ if (masterproc) then
+ write(iulog,*) 'sox_inti: has_sox = ',has_sox
+ endif
+
+ if( has_sox ) then
+ if (masterproc) then
+ write(iulog,*) '-----------------------------------------'
+ write(iulog,*) 'mozart will do sox aerosols'
+ write(iulog,*) '-----------------------------------------'
+ endif
+ else
+ return
+ end if
+
+ call sox_cldaero_init()
+
+ end subroutine sox_inti
+
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+ subroutine SETSOX( &
+ ncol, &
+ lchnk, &
+ loffset,&
+ dtime, &
+ press, &
+ pdel, &
+ tfld, &
+ mbar, &
+ lwc, &
+ cldfrc, &
+ cldnum, &
+ xhnm, &
+ invariants, &
+ qcw, &
+ qin, &
+ xphlwc, &
+ aqso4, &
+ aqh2so4,&
+ aqso4_h2o2, &
+ aqso4_o3, &
+ yph_in, &
+ aqso4_h2o2_3d, &
+ aqso4_o3_3d &
+ )
+
+ !-----------------------------------------------------------------------
+ ! ... Compute heterogeneous reactions of SOX
+ !
+ ! (0) using initial PH to calculate PH
+ ! (a) HENRYs law constants
+ ! (b) PARTIONING
+ ! (c) PH values
+ !
+ ! (1) using new PH to repeat
+ ! (a) HENRYs law constants
+ ! (b) PARTIONING
+ ! (c) REACTION rates
+ ! (d) PREDICTION
+ !-----------------------------------------------------------------------
+ !
+ use ppgrid, only : pcols, pver
+ use chem_mods, only : gas_pcnst, nfs
+ use chem_mods, only : adv_mass
+ use physconst, only : mwdry, gravit
+ use mo_constants, only : pi
+ use sox_cldaero_mod, only : sox_cldaero_update, sox_cldaero_create_obj, sox_cldaero_destroy_obj
+ use cldaero_mod, only : cldaero_conc_t
+
+ !
+ implicit none
+ !
+ !-----------------------------------------------------------------------
+ ! ... Dummy arguments
+ !-----------------------------------------------------------------------
+ integer, intent(in) :: ncol ! num of columns in chunk
+ integer, intent(in) :: lchnk ! chunk id
+ integer, intent(in) :: loffset ! offset of chem tracers in the advected tracers array
+ real(r8), intent(in) :: dtime ! time step (sec)
+ real(r8), intent(in) :: press(:,:) ! midpoint pressure ( Pa )
+ real(r8), intent(in) :: pdel(:,:) ! pressure thickness of levels (Pa)
+ real(r8), intent(in) :: tfld(:,:) ! temperature
+ real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu )
+ real(r8), target, intent(in) :: lwc(:,:) ! cloud liquid water content (kg/kg)
+ real(r8), target, intent(in) :: cldfrc(:,:) ! cloud fraction
+ real(r8), intent(in) :: cldnum(:,:) ! droplet number concentration (#/kg)
+ real(r8), intent(in) :: xhnm(:,:) ! total atms density ( /cm**3)
+ real(r8), intent(in) :: invariants(:,:,:)
+ real(r8), target, intent(inout) :: qcw(:,:,:) ! cloud-borne aerosol (vmr)
+ real(r8), intent(inout) :: qin(:,:,:) ! transported species ( vmr )
+ real(r8), intent(out) :: xphlwc(:,:) ! pH value multiplied by lwc
+
+ real(r8), intent(out) :: aqso4(:,:) ! aqueous phase chemistry
+ real(r8), intent(out) :: aqh2so4(:,:) ! aqueous phase chemistry
+ real(r8), intent(out) :: aqso4_h2o2(:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2)
+ real(r8), intent(out) :: aqso4_o3(:) ! SO4 aqueous phase chemistry due to O3 (kg/m2)
+ real(r8), intent(in), optional :: yph_in ! ph value
+ real(r8), intent(out), optional :: aqso4_h2o2_3d(:, :) ! 3D SO4 aqueous phase chemistry due to H2O2 (kg/m2)
+ real(r8), intent(out), optional :: aqso4_o3_3d(:, :) ! 3D SO4 aqueous phase chemistry due to O3 (kg/m2)
+
+
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !
+ ! xhno3 ... in mixing ratio
+ !-----------------------------------------------------------------------
+ integer, parameter :: itermax = 20
+ real(r8), parameter :: ph0 = 5.0_r8 ! INITIAL PH VALUES
+ real(r8), parameter :: const0 = 1.e3_r8/6.023e23_r8
+ real(r8), parameter :: xa0 = 11._r8
+ real(r8), parameter :: xb0 = -.1_r8
+ real(r8), parameter :: xa1 = 1.053_r8
+ real(r8), parameter :: xb1 = -4.368_r8
+ real(r8), parameter :: xa2 = 1.016_r8
+ real(r8), parameter :: xb2 = -2.54_r8
+ real(r8), parameter :: xa3 = .816e-32_r8
+ real(r8), parameter :: xb3 = .259_r8
+
+ real(r8), parameter :: kh0 = 9.e3_r8 ! HO2(g) -> Ho2(a)
+ real(r8), parameter :: kh1 = 2.05e-5_r8 ! HO2(a) -> H+ + O2-
+ real(r8), parameter :: kh2 = 8.6e5_r8 ! HO2(a) + ho2(a) -> h2o2(a) + o2
+ real(r8), parameter :: kh3 = 1.e8_r8 ! HO2(a) + o2- -> h2o2(a) + o2
+ real(r8), parameter :: Ra = 8314._r8/101325._r8 ! universal constant (atm)/(M-K)
+ real(r8), parameter :: xkw = 1.e-14_r8 ! water acidity
+
+ !
+ real(r8) :: xdelso4hp(ncol,pver)
+
+ integer :: k, i, iter, file
+ real(r8) :: wrk, delta
+ real(r8) :: xph0, aden, xk, xe, x2
+ real(r8) :: tz, xl, px, qz, pz, es, qs, patm
+ real(r8) :: Eso2, Eso4, Ehno3, Eco2, Eh2o, Enh3
+ real(r8) :: so2g, h2o2g, co2g, o3g
+ real(r8) :: hno3a, nh3a, so2a, h2o2a, co2a, o3a
+ real(r8) :: rah2o2, rao3, pso4, ccc
+ real(r8) :: cnh3, chno3, com, com1, com2, xra
+
+ real(r8) :: hno3g(ncol,pver), nh3g(ncol,pver)
+ !
+ !-----------------------------------------------------------------------
+ ! for Ho2(g) -> H2o2(a) formation
+ ! schwartz JGR, 1984, 11589
+ !-----------------------------------------------------------------------
+ real(r8) :: kh4 ! kh2+kh3
+ real(r8) :: xam ! air density /cm3
+ real(r8) :: ho2s ! ho2s = ho2(a)+o2-
+ real(r8) :: r1h2o2 ! prod(h2o2) by ho2 in mole/L(w)/s
+ real(r8) :: r2h2o2 ! prod(h2o2) by ho2 in mix/s
+
+ real(r8), dimension(ncol,pver) :: &
+ xhno3, xh2o2, xso2, xso4, xno3, &
+ xnh3, xnh4, xo3, &
+ cfact, &
+ xph, xho2, &
+ xh2so4, xmsa, xso4_init, &
+ hehno3, & ! henry law const for hno3
+ heh2o2, & ! henry law const for h2o2
+ heso2, & ! henry law const for so2
+ henh3, & ! henry law const for nh3
+ heo3 !!, & ! henry law const for o3
+
+ real(r8) :: patm_x
+
+ real(r8), dimension(ncol) :: work1
+ logical :: converged
+
+ real(r8), pointer :: xso4c(:,:)
+ real(r8), pointer :: xnh4c(:,:)
+ real(r8), pointer :: xno3c(:,:)
+ type(cldaero_conc_t), pointer :: cldconc
+
+ real(r8) :: fact1_hno3, fact2_hno3, fact3_hno3
+ real(r8) :: fact1_so2, fact2_so2, fact3_so2, fact4_so2
+ real(r8) :: fact1_nh3, fact2_nh3, fact3_nh3
+ real(r8) :: tmp_hp, tmp_hso3, tmp_hco3, tmp_nh4, tmp_no3
+ real(r8) :: tmp_oh, tmp_so3, tmp_so4
+ real(r8) :: tmp_neg, tmp_pos
+ real(r8) :: yph, yph_lo, yph_hi
+ real(r8) :: ynetpos, ynetpos_lo, ynetpos_hi
+
+ !-----------------------------------------------------------------
+ ! ... NOTE: The press array is in pascals and must be
+ ! mutiplied by 10 to yield dynes/cm**2.
+ !-----------------------------------------------------------------
+ !==================================================================
+ ! ... First set the PH
+ !==================================================================
+ ! ... Initial values
+ ! The values of so2, so4 are after (1) SLT, and CHEM
+ !-----------------------------------------------------------------
+ xph0 = 10._r8**(-ph0) ! initial PH value
+
+ do k = 1,pver
+ cfact(:,k) = xhnm(:,k) & ! /cm3(a)
+ * 1.e6_r8 & ! /m3(a)
+ * 1.38e-23_r8/287._r8 & ! Kg(a)/m3(a)
+ * 1.e-3_r8 ! Kg(a)/L(a)
+ end do
+
+ cldconc => sox_cldaero_create_obj( cldfrc,qcw,lwc, cfact, ncol, loffset )
+ xso4c => cldconc%so4c
+ xnh4c => cldconc%nh4c
+ xno3c => cldconc%no3c
+
+ xso4(:,:) = 0._r8
+ xno3(:,:) = 0._r8
+ xnh4(:,:) = 0._r8
+
+ do k = 1,pver
+ xph(:,k) = xph0 ! initial PH value
+
+ if ( inv_so2 ) then
+ xso2 (:,k) = invariants(:,k,id_so2)/xhnm(:,k) ! mixing ratio
+ else
+ xso2 (:,k) = qin(:,k,id_so2) ! mixing ratio
+ endif
+
+ if (id_hno3 > 0) then
+ xhno3(:,k) = qin(:,k,id_hno3)
+ else
+ xhno3(:,k) = 0.0_r8
+ endif
+
+ if ( inv_h2o2 ) then
+ xh2o2 (:,k) = invariants(:,k,id_h2o2)/xhnm(:,k) ! mixing ratio
+ else
+ xh2o2 (:,k) = qin(:,k,id_h2o2) ! mixing ratio
+ endif
+
+ if (id_nh3 > 0) then
+ xnh3 (:,k) = qin(:,k,id_nh3)
+ else
+ xnh3 (:,k) = 0.0_r8
+ endif
+
+ if ( inv_o3 ) then
+ xo3 (:,k) = invariants(:,k,id_o3)/xhnm(:,k) ! mixing ratio
+ else
+ xo3 (:,k) = qin(:,k,id_o3) ! mixing ratio
+ endif
+ if ( inv_ho2 ) then
+ xho2 (:,k) = invariants(:,k,id_ho2)/xhnm(:,k)! mixing ratio
+ else
+ xho2 (:,k) = qin(:,k,id_ho2) ! mixing ratio
+ endif
+
+ if (cloud_borne) then
+ xh2so4(:,k) = qin(:,k,id_h2so4)
+ else
+ xso4 (:,k) = qin(:,k,id_so4) ! mixing ratio
+ endif
+ if (id_msa > 0) xmsa (:,k) = qin(:,k,id_msa)
+
+ end do
+
+ !-----------------------------------------------------------------
+ ! ... Temperature dependent Henry constants
+ !-----------------------------------------------------------------
+ ver_loop0: do k = 1,pver !! pver loop for STEP 0
+ col_loop0: do i = 1,ncol
+
+ if (cloud_borne .and. cldfrc(i,k)>0._r8) then
+ xso4(i,k) = xso4c(i,k) / cldfrc(i,k)
+ xnh4(i,k) = xnh4c(i,k) / cldfrc(i,k)
+ xno3(i,k) = xno3c(i,k) / cldfrc(i,k)
+ endif
+ xl = cldconc%xlwc(i,k)
+
+ if( xl >= 1.e-8_r8 ) then
+ work1(i) = 1._r8 / tfld(i,k) - 1._r8 / 298._r8
+
+ !-----------------------------------------------------------------
+ ! 21-mar-2011 changes by rce
+ ! ph calculation now uses bisection method to solve the electro-neutrality equation
+ ! 3-mode aerosols (where so4 is assumed to be nh4hso4)
+ ! old code set xnh4c = so4c
+ ! new code sets xnh4c = 0, then uses a -1 charge (instead of -2)
+ ! for so4 when solving the electro-neutrality equation
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ ! calculations done before iterating
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ pz = .01_r8*press(i,k) !! pressure in mb
+ tz = tfld(i,k)
+ patm = pz/1013._r8
+ xam = press(i,k)/(1.38e-23_r8*tz) !air density /M3
+
+ !-----------------------------------------------------------------
+ ! ... hno3
+ !-----------------------------------------------------------------
+ ! previous code
+ ! hehno3(i,k) = xk*(1._r8 + xe/xph(i,k))
+ ! px = hehno3(i,k) * Ra * tz * xl
+ ! hno3g = xhno3(i,k)/(1._r8 + px)
+ ! Ehno3 = xk*xe*hno3g *patm
+ ! equivalent new code
+ ! hehno3 = xk + xk*xe/hplus
+ ! hno3g = xhno3/(1 + px)
+ ! = xhno3/(1 + hehno3*ra*tz*xl)
+ ! = xhno3/(1 + xk*ra*tz*xl*(1 + xe/hplus)
+ ! ehno3 = hno3g*xk*xe*patm
+ ! = xk*xe*patm*xhno3/(1 + xk*ra*tz*xl*(1 + xe/hplus)
+ ! = ( fact1_hno3 )/(1 + fact2_hno3 *(1 + fact3_hno3/hplus)
+ ! [hno3-] = ehno3/hplus
+ xk = 2.1e5_r8 *EXP( 8700._r8*work1(i) )
+ xe = 15.4_r8
+ fact1_hno3 = xk*xe*patm*xhno3(i,k)
+ fact2_hno3 = xk*ra*tz*xl
+ fact3_hno3 = xe
+
+ !-----------------------------------------------------------------
+ ! ... so2
+ !-----------------------------------------------------------------
+ ! previous code
+ ! heso2(i,k) = xk*(1._r8 + wrk*(1._r8 + x2/xph(i,k)))
+ ! px = heso2(i,k) * Ra * tz * xl
+ ! so2g = xso2(i,k)/(1._r8+ px)
+ ! Eso2 = xk*xe*so2g *patm
+ ! equivalent new code
+ ! heso2 = xk + xk*xe/hplus * xk*xe*x2/hplus**2
+ ! so2g = xso2/(1 + px)
+ ! = xso2/(1 + heso2*ra*tz*xl)
+ ! = xso2/(1 + xk*ra*tz*xl*(1 + (xe/hplus)*(1 + x2/hplus))
+ ! eso2 = so2g*xk*xe*patm
+ ! = xk*xe*patm*xso2/(1 + xk*ra*tz*xl*(1 + (xe/hplus)*(1 + x2/hplus))
+ ! = ( fact1_so2 )/(1 + fact2_so2 *(1 + (fact3_so2/hplus)*(1 + fact4_so2/hplus)
+ ! [hso3-] + 2*[so3--] = (eso2/hplus)*(1 + 2*x2/hplus)
+ xk = 1.23_r8 *EXP( 3120._r8*work1(i) )
+ xe = 1.7e-2_r8*EXP( 2090._r8*work1(i) )
+ x2 = 6.0e-8_r8*EXP( 1120._r8*work1(i) )
+ fact1_so2 = xk*xe*patm*xso2(i,k)
+ fact2_so2 = xk*ra*tz*xl
+ fact3_so2 = xe
+ fact4_so2 = x2
+
+ !-----------------------------------------------------------------
+ ! ... nh3
+ !-----------------------------------------------------------------
+ ! previous code
+ ! henh3(i,k) = xk*(1._r8 + xe*xph(i,k)/xkw)
+ ! px = henh3(i,k) * Ra * tz * xl
+ ! nh3g = (xnh3(i,k)+xnh4(i,k))/(1._r8+ px)
+ ! Enh3 = xk*xe*nh3g/xkw *patm
+ ! equivalent new code
+ ! henh3 = xk + xk*xe*hplus/xkw
+ ! nh3g = xnh34/(1 + px)
+ ! = xnh34/(1 + henh3*ra*tz*xl)
+ ! = xnh34/(1 + xk*ra*tz*xl*(1 + xe*hplus/xkw)
+ ! enh3 = nh3g*xk*xe*patm/xkw
+ ! = ((xk*xe*patm/xkw)*xnh34)/(1 + xk*ra*tz*xl*(1 + xe*hplus/xkw)
+ ! = ( fact1_nh3 )/(1 + fact2_nh3 *(1 + fact3_nh3*hplus)
+ ! [nh4+] = enh3*hplus
+ xk = 58._r8 *EXP( 4085._r8*work1(i) )
+ xe = 1.7e-5_r8*EXP( -4325._r8*work1(i) )
+
+ fact1_nh3 = (xk*xe*patm/xkw)*(xnh3(i,k)+xnh4(i,k))
+ fact2_nh3 = xk*ra*tz*xl
+ fact3_nh3 = xe/xkw
+
+ !-----------------------------------------------------------------
+ ! ... h2o effects
+ !-----------------------------------------------------------------
+ Eh2o = xkw
+
+ !-----------------------------------------------------------------
+ ! ... co2 effects
+ !-----------------------------------------------------------------
+ co2g = 330.e-6_r8 !330 ppm = 330.e-6 atm
+ xk = 3.1e-2_r8*EXP( 2423._r8*work1(i) )
+ xe = 4.3e-7_r8*EXP(-913._r8 *work1(i) )
+ Eco2 = xk*xe*co2g *patm
+
+ !-----------------------------------------------------------------
+ ! ... so4 effect
+ !-----------------------------------------------------------------
+ Eso4 = xso4(i,k)*xhnm(i,k) & ! /cm3(a)
+ *const0/xl
+
+
+ !-----------------------------------------------------------------
+ ! now use bisection method to solve electro-neutrality equation
+ !
+ ! during the iteration loop,
+ ! yph_lo = lower ph value that brackets the root (i.e., correct ph)
+ ! yph_hi = upper ph value that brackets the root (i.e., correct ph)
+ ! yph = current ph value
+ ! yposnet_lo and yposnet_hi = net positive ions for
+ ! yph_lo and yph_hi
+ !-----------------------------------------------------------------
+ do iter = 1,itermax
+
+ if (.not. present(yph_in)) then
+ if (iter == 1) then
+ ! 1st iteration ph = lower bound value
+ yph_lo = 2.0_r8
+ yph_hi = yph_lo
+ yph = yph_lo
+ else if (iter == 2) then
+ ! 2nd iteration ph = upper bound value
+ yph_hi = 7.0_r8
+ yph = yph_hi
+ else
+ ! later iteration ph = mean of the two bracketing values
+ yph = 0.5_r8*(yph_lo + yph_hi)
+ end if
+ else
+ yph = yph_in
+ end if
+
+ ! calc current [H+] from ph
+ xph(i,k) = 10.0_r8**(-yph)
+
+
+ !-----------------------------------------------------------------
+ ! ... hno3
+ !-----------------------------------------------------------------
+ Ehno3 = fact1_hno3/(1.0_r8 + fact2_hno3*(1.0_r8 + fact3_hno3/xph(i,k)))
+
+ !-----------------------------------------------------------------
+ ! ... so2
+ !-----------------------------------------------------------------
+ Eso2 = fact1_so2/(1.0_r8 + fact2_so2*(1.0_r8 + (fact3_so2/xph(i,k)) &
+ *(1.0_r8 + fact4_so2/xph(i,k))))
+
+ !-----------------------------------------------------------------
+ ! ... nh3
+ !-----------------------------------------------------------------
+ Enh3 = fact1_nh3/(1.0_r8 + fact2_nh3*(1.0_r8 + fact3_nh3*xph(i,k)))
+
+ tmp_nh4 = Enh3 * xph(i,k)
+ tmp_hso3 = Eso2 / xph(i,k)
+ tmp_so3 = tmp_hso3 * 2.0_r8*fact4_so2/xph(i,k)
+ tmp_hco3 = Eco2 / xph(i,k)
+ tmp_oh = Eh2o / xph(i,k)
+ tmp_no3 = Ehno3 / xph(i,k)
+ tmp_so4 = cldconc%so4_fact*Eso4
+ tmp_pos = xph(i,k) + tmp_nh4
+ tmp_neg = tmp_oh + tmp_hco3 + tmp_no3 + tmp_hso3 + tmp_so3 + tmp_so4
+
+ ynetpos = tmp_pos - tmp_neg
+
+
+ ! yposnet = net positive ions/charge
+ ! if the correct ph is bracketed by yph_lo and yph_hi (with yph_lo < yph_hi),
+ ! then you will have yposnet_lo > 0 and yposnet_hi < 0
+ converged = .false.
+ if (iter > 2) then
+ if (ynetpos == 0.0_r8) then
+ ! the exact solution was found (very unlikely)
+ tmp_hp = xph(i,k)
+ converged = .true.
+ exit
+ else if (ynetpos >= 0.0_r8) then
+ ! net positive ions are >= 0 for both yph and yph_lo
+ ! so replace yph_lo with yph
+ yph_lo = yph
+ ynetpos_lo = ynetpos
+ else
+ ! net positive ions are <= 0 for both yph and yph_hi
+ ! so replace yph_hi with yph
+ yph_hi = yph
+ ynetpos_hi = ynetpos
+ end if
+
+ if (abs(yph_hi - yph_lo) .le. 0.005_r8) then
+ ! |yph_hi - yph_lo| <= convergence criterion, so set
+ ! final ph to their midpoint and exit
+ ! (.005 absolute error in pH gives .01 relative error in H+)
+ tmp_hp = xph(i,k)
+ yph = 0.5_r8*(yph_hi + yph_lo)
+ xph(i,k) = 10.0_r8**(-yph)
+ converged = .true.
+ exit
+ else
+ ! do another iteration
+ converged = .false.
+ end if
+
+ else if (iter == 1) then
+ if (ynetpos <= 0.0_r8) then
+ ! the lower and upper bound ph values (2.0 and 7.0) do not bracket
+ ! the correct ph, so use the lower bound
+ tmp_hp = xph(i,k)
+ converged = .true.
+ exit
+ end if
+ ynetpos_lo = ynetpos
+
+ else ! (iter == 2)
+ if (ynetpos >= 0.0_r8) then
+ ! the lower and upper bound ph values (2.0 and 7.0) do not bracket
+ ! the correct ph, so use they upper bound
+ tmp_hp = xph(i,k)
+ converged = .true.
+ exit
+ end if
+ ynetpos_hi = ynetpos
+ end if
+
+ end do ! iter
+
+ if( .not. converged ) then
+ write(iulog,*) 'SETSOX: pH failed to converge @ (',i,',',k,'), % change=', &
+ 100._r8*delta
+ end if
+ else
+ xph(i,k) = 1.e-7_r8
+ end if
+ end do col_loop0
+ end do ver_loop0 ! end pver loop for STEP 0
+
+ !==============================================================
+ ! ... Now use the actual PH
+ !==============================================================
+ ver_loop1: do k = 1,pver
+ col_loop1: do i = 1,ncol
+ work1(i) = 1._r8 / tfld(i,k) - 1._r8 / 298._r8
+ tz = tfld(i,k)
+
+ xl = cldconc%xlwc(i,k)
+
+ patm = press(i,k)/101300._r8 ! press is in pascal
+ xam = press(i,k)/(1.38e-23_r8*tz) ! air density /M3
+
+ !-----------------------------------------------------------------------
+ ! ... hno3
+ !-----------------------------------------------------------------------
+ xk = 2.1e5_r8 *EXP( 8700._r8*work1(i) )
+ xe = 15.4_r8
+ hehno3(i,k) = xk*(1._r8 + xe/xph(i,k))
+
+ !-----------------------------------------------------------------
+ ! ... h2o2
+ !-----------------------------------------------------------------
+ xk = 7.4e4_r8 *EXP( 6621._r8*work1(i) )
+ xe = 2.2e-12_r8 *EXP(-3730._r8*work1(i) )
+ heh2o2(i,k) = xk*(1._r8 + xe/xph(i,k))
+
+ !-----------------------------------------------------------------
+ ! ... so2
+ !-----------------------------------------------------------------
+ xk = 1.23_r8 *EXP( 3120._r8*work1(i) )
+ xe = 1.7e-2_r8*EXP( 2090._r8*work1(i) )
+ x2 = 6.0e-8_r8*EXP( 1120._r8*work1(i) )
+
+ wrk = xe/xph(i,k)
+ heso2(i,k) = xk*(1._r8 + wrk*(1._r8 + x2/xph(i,k)))
+
+ !-----------------------------------------------------------------
+ ! ... nh3
+ !-----------------------------------------------------------------
+ xk = 58._r8 *EXP( 4085._r8*work1(i) )
+ xe = 1.7e-5_r8*EXP(-4325._r8*work1(i) )
+ henh3(i,k) = xk*(1._r8 + xe*xph(i,k)/xkw)
+
+ !-----------------------------------------------------------------
+ ! ... o3
+ !-----------------------------------------------------------------
+ xk = 1.15e-2_r8 *EXP( 2560._r8*work1(i) )
+ heo3(i,k) = xk
+
+ !------------------------------------------------------------------------
+ ! ... for Ho2(g) -> H2o2(a) formation
+ ! schwartz JGR, 1984, 11589
+ !------------------------------------------------------------------------
+ kh4 = (kh2 + kh3*kh1/xph(i,k)) / ((1._r8 + kh1/xph(i,k))**2)
+ ho2s = kh0*xho2(i,k)*patm*(1._r8 + kh1/xph(i,k)) ! ho2s = ho2(a)+o2-
+ r1h2o2 = kh4*ho2s*ho2s ! prod(h2o2) in mole/L(w)/s
+
+ if ( cloud_borne ) then
+ r2h2o2 = r1h2o2*xl & ! mole/L(w)/s * L(w)/fm3(a) = mole/fm3(a)/s
+ / const0*1.e+6_r8 & ! correct a bug here ????
+ / xam
+ else
+ r2h2o2 = r1h2o2*xl & ! mole/L(w)/s * L(w)/fm3(a) = mole/fm3(a)/s
+ * const0 & ! mole/fm3(a)/s * 1.e-3 = mole/cm3(a)/s
+ / xam ! /cm3(a)/s / air-den = mix-ratio/s
+ endif
+
+ if ( .not. modal_aerosols ) then
+ xh2o2(i,k) = xh2o2(i,k) + r2h2o2*dtime ! updated h2o2 by het production
+ endif
+
+ !-----------------------------------------------
+ ! ... Partioning
+ !-----------------------------------------------
+
+ !-----------------------------------------------------------------
+ ! ... hno3
+ !-----------------------------------------------------------------
+ px = hehno3(i,k) * Ra * tz * xl
+ hno3g(i,k) = (xhno3(i,k)+xno3(i,k))/(1._r8 + px)
+
+ !------------------------------------------------------------------------
+ ! ... h2o2
+ !------------------------------------------------------------------------
+ px = heh2o2(i,k) * Ra * tz * xl
+ h2o2g = xh2o2(i,k)/(1._r8+ px)
+
+ !------------------------------------------------------------------------
+ ! ... so2
+ !------------------------------------------------------------------------
+ px = heso2(i,k) * Ra * tz * xl
+ so2g = xso2(i,k)/(1._r8+ px)
+
+ !------------------------------------------------------------------------
+ ! ... o3
+ !------------------------------------------------------------------------
+ px = heo3(i,k) * Ra * tz * xl
+ o3g = xo3(i,k)/(1._r8+ px)
+
+ !------------------------------------------------------------------------
+ ! ... nh3
+ !------------------------------------------------------------------------
+ px = henh3(i,k) * Ra * tz * xl
+ if (id_nh3>0) then
+ nh3g(i,k) = (xnh3(i,k)+xnh4(i,k))/(1._r8+ px)
+ else
+ nh3g(i,k) = 0._r8
+ endif
+
+ !-----------------------------------------------
+ ! ... Aqueous phase reaction rates
+ ! SO2 + H2O2 -> SO4
+ ! SO2 + O3 -> SO4
+ !-----------------------------------------------
+
+ !------------------------------------------------------------------------
+ ! ... S(IV) (HSO3) + H2O2
+ !------------------------------------------------------------------------
+ rah2o2 = 8.e4_r8 * EXP( -3650._r8*work1(i) ) &
+ / (.1_r8 + xph(i,k))
+
+ !------------------------------------------------------------------------
+ ! ... S(IV)+ O3
+ !------------------------------------------------------------------------
+ rao3 = 4.39e11_r8 * EXP(-4131._r8/tz) &
+ + 2.56e3_r8 * EXP(-996._r8 /tz) /xph(i,k)
+
+ !-----------------------------------------------------------------
+ ! ... Prediction after aqueous phase
+ ! so4
+ ! When Cloud is present
+ !
+ ! S(IV) + H2O2 = S(VI)
+ ! S(IV) + O3 = S(VI)
+ !
+ ! reference:
+ ! (1) Seinfeld
+ ! (2) Benkovitz
+ !-----------------------------------------------------------------
+
+ !............................
+ ! S(IV) + H2O2 = S(VI)
+ !............................
+
+ IF (XL .ge. 1.e-8_r8) THEN !! WHEN CLOUD IS PRESENTED
+
+ if (cloud_borne) then
+ patm_x = patm
+ else
+ patm_x = 1._r8
+ endif
+
+ if (modal_aerosols) then
+
+ pso4 = rah2o2 * 7.4e4_r8*EXP(6621._r8*work1(i)) * h2o2g * patm_x &
+ * 1.23_r8 *EXP(3120._r8*work1(i)) * so2g * patm_x
+ else
+ pso4 = rah2o2 * heh2o2(i,k) * h2o2g * patm_x &
+ * heso2(i,k) * so2g * patm_x ! [M/s]
+
+ endif
+
+ pso4 = pso4 & ! [M/s] = [mole/L(w)/s]
+ * xl & ! [mole/L(a)/s]
+ / const0 & ! [/L(a)/s]
+ / xhnm(i,k)
+
+
+ ccc = pso4*dtime
+ ccc = max(ccc, 1.e-30_r8)
+
+ xso4_init(i,k)=xso4(i,k)
+
+ IF (xh2o2(i,k) .gt. xso2(i,k)) THEN
+ if (ccc .gt. xso2(i,k)) then
+ xso4(i,k)=xso4(i,k)+xso2(i,k)
+ if (cloud_borne) then
+ xh2o2(i,k)=xh2o2(i,k)-xso2(i,k)
+ xso2(i,k)=1.e-20_r8
+ else ! ???? bug ????
+ xso2(i,k)=1.e-20_r8
+ xh2o2(i,k)=xh2o2(i,k)-xso2(i,k)
+ endif
+ else
+ xso4(i,k) = xso4(i,k) + ccc
+ xh2o2(i,k) = xh2o2(i,k) - ccc
+ xso2(i,k) = xso2(i,k) - ccc
+ end if
+
+ ELSE
+ if (ccc .gt. xh2o2(i,k)) then
+ xso4(i,k)=xso4(i,k)+xh2o2(i,k)
+ xso2(i,k)=xso2(i,k)-xh2o2(i,k)
+ xh2o2(i,k)=1.e-20_r8
+ else
+ xso4(i,k) = xso4(i,k) + ccc
+ xh2o2(i,k) = xh2o2(i,k) - ccc
+ xso2(i,k) = xso2(i,k) - ccc
+ end if
+ END IF
+
+ if (modal_aerosols) then
+ xdelso4hp(i,k) = xso4(i,k) - xso4_init(i,k)
+ endif
+ !...........................
+ ! S(IV) + O3 = S(VI)
+ !...........................
+
+ pso4 = rao3 * heo3(i,k)*o3g*patm_x * heso2(i,k)*so2g*patm_x ! [M/s]
+
+ pso4 = pso4 & ! [M/s] = [mole/L(w)/s]
+ * xl & ! [mole/L(a)/s]
+ / const0 & ! [/L(a)/s]
+ / xhnm(i,k) ! [mixing ratio/s]
+
+ ccc = pso4*dtime
+ ccc = max(ccc, 1.e-30_r8)
+
+ xso4_init(i,k)=xso4(i,k)
+
+ if (ccc .gt. xso2(i,k)) then
+ xso4(i,k) = xso4(i,k) + xso2(i,k)
+ xso2(i,k) = 1.e-20_r8
+ else
+ xso4(i,k) = xso4(i,k) + ccc
+ xso2(i,k) = xso2(i,k) - ccc
+ end if
+
+ END IF !! WHEN CLOUD IS PRESENTED
+
+ end do col_loop1
+ end do ver_loop1
+
+ call sox_cldaero_update( &
+ ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, cldconc%xlwc, &
+ xdelso4hp, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, &
+ aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d=aqso4_h2o2_3d, aqso4_o3_3d=aqso4_o3_3d )
+
+ xphlwc(:,:) = 0._r8
+ do k = 1, pver
+ do i = 1, ncol
+ if (cldfrc(i,k)>=1.e-5_r8 .and. lwc(i,k)>=1.e-8_r8) then
+ xphlwc(i,k) = -1._r8*log10(xph(i,k)) * lwc(i,k)
+ endif
+ end do
+ end do
+
+ call sox_cldaero_destroy_obj(cldconc)
+
+ end subroutine SETSOX
+
+end module MO_SETSOX
diff --git a/src/chemistry/oslo_aero/mo_srf_emissions.F90 b/src/chemistry/oslo_aero/mo_srf_emissions.F90
new file mode 100644
index 0000000000..f4e5549266
--- /dev/null
+++ b/src/chemistry/oslo_aero/mo_srf_emissions.F90
@@ -0,0 +1,465 @@
+module mo_srf_emissions
+ !---------------------------------------------------------------
+ ! ... surface emissions module
+ !---------------------------------------------------------------
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : gas_pcnst
+ use spmd_utils, only : masterproc,iam
+ use mo_tracname, only : solsym
+ use cam_abortutils,only : endrun
+ use ioFileMod, only : getfil
+ use ppgrid, only : pcols, begchunk, endchunk
+ use cam_logfile, only : iulog
+ use tracer_data, only : trfld,trfile
+#ifdef OSLO_AERO
+ use oslo_ocean_intr, only: oslo_dms_inq
+#endif
+
+ implicit none
+
+ type :: emission
+ integer :: spc_ndx
+ real(r8) :: mw
+ real(r8) :: scalefactor
+ character(len=256):: filename
+ character(len=16) :: species
+ character(len=8) :: units
+ integer :: nsectors
+ character(len=32),pointer :: sectors(:)
+ type(trfld), pointer :: fields(:)
+ type(trfile) :: file
+ end type emission
+
+ private
+
+ public :: srf_emissions_inti, set_srf_emissions, set_srf_emissions_time
+
+ save
+
+ real(r8), parameter :: amufac = 1.65979e-23_r8 ! 1.e4* kg / amu
+ logical :: has_emis(gas_pcnst)
+ type(emission), allocatable :: emissions(:)
+ integer :: n_emis_files
+ integer :: c10h16_ndx, isop_ndx
+ integer :: dms_ndx
+
+contains
+
+ subroutine srf_emissions_inti( srf_emis_specifier, emis_type_in, emis_cycle_yr, emis_fixed_ymd, emis_fixed_tod )
+
+ !-----------------------------------------------------------------------
+ ! ... initialize the surface emissions
+ !-----------------------------------------------------------------------
+
+ use chem_mods, only : adv_mass
+ use mo_constants, only : d2r, pi, rearth
+ use string_utils, only : to_upper
+ use mo_chem_utls, only : get_spc_ndx
+ use tracer_data, only : trcdata_init
+ use cam_pio_utils, only : cam_pio_openfile
+ use pio, only : pio_inquire, pio_nowrite, pio_closefile, pio_inq_varndims
+ use pio, only : pio_inq_varname, file_desc_t, pio_get_att, PIO_NOERR, PIO_GLOBAL
+ use pio, only : pio_seterrorhandling, PIO_BCAST_ERROR,PIO_INTERNAL_ERROR
+ use chem_surfvals, only : flbc_list
+ use string_utils, only : GLC
+ use m_MergeSorts, only : IndexSort
+
+ implicit none
+
+ !-----------------------------------------------------------------------
+ ! ... dummy arguments
+ !-----------------------------------------------------------------------
+ character(len=*), intent(in) :: srf_emis_specifier(:)
+ character(len=*), intent(in) :: emis_type_in
+ integer, intent(in) :: emis_cycle_yr
+ integer, intent(in) :: emis_fixed_ymd
+ integer, intent(in) :: emis_fixed_tod
+
+ !-----------------------------------------------------------------------
+ ! ... local variables
+ !-----------------------------------------------------------------------
+ integer :: astat
+ integer :: j, l, m, n, i, nn ! Indices
+ character(len=16) :: spc_name
+ character(len=256) :: filename
+
+ character(len=16) :: emis_species(gas_pcnst)
+ character(len=256) :: emis_filenam(gas_pcnst)
+ integer :: emis_indexes(gas_pcnst)
+ integer :: indx(gas_pcnst)
+ real(r8) :: emis_scalefactor(gas_pcnst)
+
+ integer :: vid, nvars, isec
+ integer, allocatable :: vndims(:)
+ type(file_desc_t) :: ncid
+ character(len=32) :: varname
+ character(len=256) :: locfn
+ integer :: ierr
+ character(len=1), parameter :: filelist = ''
+ character(len=1), parameter :: datapath = ''
+ logical , parameter :: rmv_file = .false.
+
+ character(len=32) :: emis_type = ' '
+ character(len=80) :: file_interp_type = ' '
+ character(len=256) :: tmp_string = ' '
+ character(len=32) :: xchr = ' '
+ real(r8) :: xdbl
+
+ has_emis(:) = .false.
+ nn = 0
+ indx(:) = 0
+
+ count_emis: do n=1,gas_pcnst
+ if ( len_trim(srf_emis_specifier(n) ) == 0 ) then
+ exit count_emis
+ endif
+
+ i = scan(srf_emis_specifier(n),'->')
+ spc_name = trim(adjustl(srf_emis_specifier(n)(:i-1)))
+
+ ! need to parse out scalefactor ...
+ tmp_string = adjustl(srf_emis_specifier(n)(i+2:))
+ j = scan( tmp_string, '*' )
+ if (j>0) then
+ xchr = tmp_string(1:j-1) ! get the multipler (left of the '*')
+ read( xchr, * ) xdbl ! convert the string to a real
+ tmp_string = adjustl(tmp_string(j+1:)) ! get the filepath name (right of the '*')
+ else
+ xdbl = 1._r8
+ endif
+ filename = trim(tmp_string)
+
+ m = get_spc_ndx(spc_name)
+
+ if (m > 0) then
+ has_emis(m) = .true.
+ else
+ write(iulog,*) 'srf_emis_inti: spc_name ',spc_name,' is not included in the simulation'
+ call endrun('srf_emis_inti: invalid surface emission specification')
+ endif
+
+ if (any( flbc_list == spc_name )) then
+ call endrun('srf_emis_inti: ERROR -- cannot specify both fixed LBC ' &
+ //'and emissions for the same species: '//trim(spc_name))
+ endif
+
+ nn = nn+1
+ emis_species(nn) = spc_name
+ emis_filenam(nn) = filename
+ emis_indexes(nn) = m
+ emis_scalefactor(nn) = xdbl
+
+ indx(n)=n
+
+ enddo count_emis
+
+ n_emis_files = nn
+
+ if (masterproc) write(iulog,*) 'srf_emis_inti: n_emis_files = ',n_emis_files
+
+ allocate( emissions(n_emis_files), stat=astat )
+ if( astat/= 0 ) then
+ write(iulog,*) 'srf_emis_inti: failed to allocate emissions array; error = ',astat
+ call endrun('srf_emis_inti: failed to allocate emissions array')
+ end if
+
+ !-----------------------------------------------------------------------
+ ! Sort the input files so that the emissions sources are summed in the
+ ! same order regardless of the order of the input files in the namelist
+ !-----------------------------------------------------------------------
+ if (n_emis_files > 0) then
+ call IndexSort(n_emis_files, indx, emis_filenam)
+ end if
+
+ !-----------------------------------------------------------------------
+ ! ... setup the emission type array
+ !-----------------------------------------------------------------------
+ do m=1,n_emis_files
+ emissions(m)%spc_ndx = emis_indexes(indx(m))
+ emissions(m)%units = 'Tg/y'
+ emissions(m)%species = emis_species(indx(m))
+ emissions(m)%mw = adv_mass(emis_indexes(indx(m))) ! g / mole
+ emissions(m)%filename = emis_filenam(indx(m))
+ emissions(m)%scalefactor = emis_scalefactor(indx(m))
+ enddo
+
+ !-----------------------------------------------------------------------
+ ! read emis files to determine number of sectors
+ !-----------------------------------------------------------------------
+ spc_loop: do m = 1, n_emis_files
+
+ emissions(m)%nsectors = 0
+
+ call getfil (emissions(m)%filename, locfn, 0)
+ call cam_pio_openfile ( ncid, trim(locfn), PIO_NOWRITE)
+ ierr = pio_inquire (ncid, nvariables=nvars)
+
+ allocate(vndims(nvars))
+
+ do vid = 1,nvars
+
+ ierr = pio_inq_varndims (ncid, vid, vndims(vid))
+
+ if( vndims(vid) < 3 ) then
+ cycle
+ elseif( vndims(vid) > 3 ) then
+ ierr = pio_inq_varname (ncid, vid, varname)
+ write(iulog,*) 'srf_emis_inti: Skipping variable ', trim(varname),', ndims = ',vndims(vid), &
+ ' , species=',trim(emissions(m)%species)
+ cycle
+ end if
+
+ emissions(m)%nsectors = emissions(m)%nsectors+1
+
+ enddo
+
+ allocate( emissions(m)%sectors(emissions(m)%nsectors), stat=astat )
+ if( astat/= 0 ) then
+ write(iulog,*) 'srf_emis_inti: failed to allocate emissions(m)%sectors array; error = ',astat
+ call endrun
+ end if
+
+ isec = 1
+
+ do vid = 1,nvars
+ if( vndims(vid) == 3 ) then
+ ierr = pio_inq_varname(ncid, vid, emissions(m)%sectors(isec))
+ isec = isec+1
+ endif
+
+ enddo
+ deallocate(vndims)
+
+ ! Global attribute 'input_method' overrides the srf_emis_type namelist setting on
+ ! a file-by-file basis. If the emis file does not contain the 'input_method'
+ ! attribute then the srf_emis_type namelist setting is used.
+ call pio_seterrorhandling(ncid, PIO_BCAST_ERROR)
+ ierr = pio_get_att(ncid, PIO_GLOBAL, 'input_method', file_interp_type)
+ call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR)
+ if ( ierr == PIO_NOERR) then
+ l = GLC(file_interp_type)
+ emis_type(1:l) = file_interp_type(1:l)
+ emis_type(l+1:) = ' '
+ else
+ emis_type = trim(emis_type_in)
+ endif
+
+ call pio_closefile (ncid)
+
+ allocate(emissions(m)%file%in_pbuf(size(emissions(m)%sectors)))
+ emissions(m)%file%in_pbuf(:) = .false.
+
+ call trcdata_init( emissions(m)%sectors, &
+ emissions(m)%filename, filelist, datapath, &
+ emissions(m)%fields, &
+ emissions(m)%file, &
+ rmv_file, emis_cycle_yr, emis_fixed_ymd, emis_fixed_tod, trim(emis_type) )
+
+ enddo spc_loop
+
+ c10h16_ndx = get_spc_ndx('C10H16')
+ isop_ndx = get_spc_ndx('ISOP')
+
+ dms_ndx = get_spc_ndx('DMS')
+
+ end subroutine srf_emissions_inti
+
+ subroutine set_srf_emissions_time( pbuf2d, state )
+ !-----------------------------------------------------------------------
+ ! ... check serial case for time span
+ !-----------------------------------------------------------------------
+
+ use physics_types,only : physics_state
+ use ppgrid, only : begchunk, endchunk
+ use tracer_data, only : advance_trcdata
+ use physics_buffer, only : physics_buffer_desc
+
+ implicit none
+
+ type(physics_state), intent(in):: state(begchunk:endchunk)
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ !-----------------------------------------------------------------------
+ ! ... local variables
+ !-----------------------------------------------------------------------
+ integer :: m
+
+ do m = 1,n_emis_files
+ call advance_trcdata( emissions(m)%fields, emissions(m)%file, state, pbuf2d )
+ end do
+
+ end subroutine set_srf_emissions_time
+
+ ! adds surf flux specified in file to sflx
+ subroutine set_srf_emissions( lchnk, ncol, sflx )
+ !--------------------------------------------------------
+ ! ... form the surface fluxes for this latitude slice
+ !--------------------------------------------------------
+
+ use mo_constants, only : pi
+ use time_manager, only : get_curr_calday
+ use string_utils, only : to_lower, GLC
+ use phys_grid, only : get_rlat_all_p, get_rlon_all_p
+
+ implicit none
+
+ !--------------------------------------------------------
+ ! ... Dummy arguments
+ !--------------------------------------------------------
+ integer, intent(in) :: ncol ! columns in chunk
+ integer, intent(in) :: lchnk ! chunk index
+ real(r8), intent(out) :: sflx(:,:) ! surface emissions ( kg/m^2/s )
+
+ !--------------------------------------------------------
+ ! ... local variables
+ !--------------------------------------------------------
+ integer :: i, m, n
+ real(r8) :: factor
+ real(r8) :: dayfrac ! fration of day in light
+ real(r8) :: iso_off ! time iso flux turns off
+ real(r8) :: iso_on ! time iso flux turns on
+
+ logical :: polar_day,polar_night
+ real(r8) :: doy_loc
+ real(r8) :: sunon,sunoff
+ real(r8) :: loc_angle
+ real(r8) :: latitude
+ real(r8) :: declination
+ real(r8) :: tod
+ real(r8) :: calday
+
+ real(r8), parameter :: dayspy = 365._r8
+ real(r8), parameter :: twopi = 2.0_r8 * pi
+ real(r8), parameter :: pid2 = 0.5_r8 * pi
+ real(r8), parameter :: dec_max = 23.45_r8 * pi/180._r8
+
+ real(r8) :: flux(ncol)
+ real(r8) :: mfactor
+ integer :: isec
+
+ character(len=12),parameter :: mks_units(4) = (/ "kg/m2/s ", &
+ "kg/m2/sec ", &
+ "kg/m^2/s ", &
+ "kg/m^2/sec " /)
+ character(len=12) :: units
+
+ real(r8), dimension(ncol) :: rlats, rlons
+
+ sflx(:,:) = 0._r8
+
+ !--------------------------------------------------------
+ ! ... set non-zero emissions
+ !--------------------------------------------------------
+ emis_loop : do m = 1,n_emis_files
+
+ n = emissions(m)%spc_ndx
+
+ flux(:) = 0._r8
+ do isec = 1,emissions(m)%nsectors
+ flux(:ncol) = flux(:ncol) + emissions(m)%scalefactor*emissions(m)%fields(isec)%data(:ncol,1,lchnk)
+ enddo
+
+ units = to_lower(trim(emissions(m)%fields(1)%units(:GLC(emissions(m)%fields(1)%units))))
+
+ if ( any( mks_units(:) == units ) ) then
+ sflx(:ncol,n) = sflx(:ncol,n) + flux(:ncol)
+ else
+ mfactor = amufac * emissions(m)%mw
+ sflx(:ncol,n) = sflx(:ncol,n) + flux(:ncol) * mfactor
+ endif
+
+ end do emis_loop
+
+ call get_rlat_all_p( lchnk, ncol, rlats )
+ call get_rlon_all_p( lchnk, ncol, rlons )
+
+ calday = get_curr_calday()
+ doy_loc = aint( calday )
+ declination = dec_max * cos((doy_loc - 172._r8)*twopi/dayspy)
+ tod = (calday - doy_loc) + .5_r8
+
+ !Remove DMS emissions if option is not "from file"
+ !Online emissions are treated in seasalt module
+ if(oslo_dms_inq() .eqv. .FALSE.)then !Returns "True" if "emissions from file"
+ if(dms_ndx .gt. 0)then
+ sflx(:,dms_ndx) = 0.0_r8
+ end if
+ end if
+
+ do i = 1,ncol
+ !
+ polar_day = .false.
+ polar_night = .false.
+ !
+ loc_angle = tod * twopi + rlons(i)
+ loc_angle = mod( loc_angle,twopi )
+ latitude = rlats(i)
+ !
+ !------------------------------------------------------------------
+ ! determine if in polar day or night
+ ! if not in polar day or night then
+ ! calculate terminator longitudes
+ !------------------------------------------------------------------
+ if( abs(latitude) >= (pid2 - abs(declination)) ) then
+ if( sign(1._r8,declination) == sign(1._r8,latitude) ) then
+ polar_day = .true.
+ sunoff = 2._r8*twopi
+ sunon = -twopi
+ else
+ polar_night = .true.
+ end if
+ else
+ sunoff = acos( -tan(declination)*tan(latitude) )
+ sunon = twopi - sunoff
+ end if
+
+ !--------------------------------------------------------
+ ! ... adjust alpha-pinene for diurnal variation
+ !--------------------------------------------------------
+ if( c10h16_ndx > 0 ) then
+ if( has_emis(c10h16_ndx) ) then
+ if( .not. polar_night .and. .not. polar_day ) then
+ dayfrac = sunoff / pi
+ sflx(i,c10h16_ndx) = sflx(i,c10h16_ndx) / (.7_r8 + .3_r8*dayfrac)
+ if( loc_angle >= sunoff .and. loc_angle <= sunon ) then
+ sflx(i,c10h16_ndx) = sflx(i,c10h16_ndx) * .7_r8
+ endif
+ end if
+ end if
+ end if
+
+ !--------------------------------------------------------
+ ! ... adjust isoprene for diurnal variation
+ !--------------------------------------------------------
+ if( isop_ndx > 0 ) then
+ if( has_emis(isop_ndx) ) then
+ if( .not. polar_night ) then
+ if( polar_day ) then
+ iso_off = .8_r8 * pi
+ iso_on = 1.2_r8 * pi
+ else
+ iso_off = .8_r8 * sunoff
+ iso_on = 2._r8 * pi - iso_off
+ end if
+ if( loc_angle >= iso_off .and. loc_angle <= iso_on ) then
+ sflx(i,isop_ndx) = 0._r8
+ else
+ factor = loc_angle - iso_on
+ if( factor <= 0._r8 ) then
+ factor = factor + 2._r8*pi
+ end if
+ factor = factor / (2._r8*iso_off + 1.e-6_r8)
+ sflx(i,isop_ndx) = sflx(i,isop_ndx) * 2._r8 / iso_off * pi * (sin(pi*factor))**2
+ end if
+ else
+ sflx(i,isop_ndx) = 0._r8
+ end if
+ end if
+ end if
+
+ end do
+
+ end subroutine set_srf_emissions
+
+end module mo_srf_emissions
diff --git a/src/chemistry/oslo_aero/mo_usrrxt.F90 b/src/chemistry/oslo_aero/mo_usrrxt.F90
new file mode 100644
index 0000000000..7834085cd8
--- /dev/null
+++ b/src/chemistry/oslo_aero/mo_usrrxt.F90
@@ -0,0 +1,1584 @@
+module mo_usrrxt
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use cam_logfile, only : iulog
+ use ppgrid, only : pver, pcols
+#ifdef OSLO_AERO
+! use aerosoldef, only: nmodes_oslo=> nmodes, lifeCycleNumberMedianRadius
+ use commondefinitions, only: nmodes_oslo=> nmodes
+#endif
+
+ implicit none
+
+ private
+ public :: usrrxt, usrrxt_inti, usrrxt_hrates
+
+ save
+
+ integer :: usr_O_O2_ndx
+ integer :: usr_HO2_HO2_ndx
+ integer :: usr_N2O5_M_ndx
+ integer :: usr_HNO3_OH_ndx
+ integer :: usr_HO2NO2_M_ndx
+ integer :: usr_N2O5_aer_ndx
+ integer :: usr_NO3_aer_ndx
+ integer :: usr_NO2_aer_ndx
+ integer :: usr_CO_OH_a_ndx
+ integer :: usr_CO_OH_b_ndx
+ integer :: usr_PAN_M_ndx
+ integer :: usr_CH3COCH3_OH_ndx
+ integer :: usr_MCO3_NO2_ndx
+ integer :: usr_MPAN_M_ndx
+ integer :: usr_XOOH_OH_ndx
+ integer :: usr_SO2_OH_ndx
+ integer :: usr_DMS_OH_ndx
+ integer :: usr_HO2_aer_ndx
+ integer :: usr_GLYOXAL_aer_ndx
+
+ integer :: tag_NO2_NO3_ndx
+ integer :: tag_NO2_OH_ndx
+ integer :: tag_NO2_HO2_ndx
+ integer :: tag_C2H4_OH_ndx
+ integer :: tag_C3H6_OH_ndx
+ integer :: tag_CH3CO3_NO2_ndx
+
+!lke-TS1
+ integer :: usr_PBZNIT_M_ndx
+ integer :: tag_ACBZO2_NO2_ndx
+ integer :: usr_ISOPNITA_aer_ndx
+ integer :: usr_ISOPNITB_aer_ndx
+ integer :: usr_ONITR_aer_ndx
+ integer :: usr_HONITR_aer_ndx
+ integer :: usr_TERPNIT_aer_ndx
+ integer :: usr_NTERPOOH_aer_ndx
+ integer :: usr_NC4CHO_aer_ndx
+ integer :: usr_NC4CH2OH_aer_ndx
+!
+ integer :: usr_OA_O2_NDX
+ integer :: usr_XNO2NO3_M_ndx
+ integer :: usr_NO2XNO3_M_ndx
+ integer :: usr_XHNO3_OH_ndx
+ integer :: usr_XHO2NO2_M_ndx
+ integer :: usr_XNO2NO3_aer_ndx
+ integer :: usr_NO2XNO3_aer_ndx
+ integer :: usr_XNO3_aer_ndx
+ integer :: usr_XNO2_aer_ndx
+ integer :: usr_XPAN_M_ndx
+ integer :: usr_XMPAN_M_ndx
+ integer :: usr_MCO3_XNO2_ndx
+
+ integer :: usr_C2O3_NO2_ndx
+ integer :: usr_C2H4_OH_ndx
+ integer :: usr_XO2N_HO2_ndx
+ integer :: usr_C2O3_XNO2_ndx
+
+ integer :: tag_XO2N_NO_ndx
+ integer :: tag_XO2_HO2_ndx
+ integer :: tag_XO2_NO_ndx
+
+ integer :: usr_O_O_ndx
+ integer :: usr_CL2O2_M_ndx
+ integer :: usr_SO3_H2O_ndx
+ integer :: tag_CLO_CLO_M_ndx
+
+ integer :: ion1_ndx, ion2_ndx, ion3_ndx, ion11_ndx
+ integer :: elec1_ndx, elec2_ndx, elec3_ndx
+ integer :: elec4_ndx, elec5_ndx, elec6_ndx
+ integer :: het1_ndx
+
+ integer, parameter :: nean = 3
+ integer :: ean_ndx(nean)
+ integer, parameter :: nrpe = 5
+ integer :: rpe_ndx(nrpe)
+ integer, parameter :: npir = 16
+ integer :: pir_ndx(npir)
+ integer, parameter :: nedn = 2
+ integer :: edn_ndx(nedn)
+ integer, parameter :: nnir = 13
+ integer :: nir_ndx(nnir)
+ integer, parameter :: niira = 112
+ integer :: iira_ndx(niira)
+ integer, parameter :: niirb = 14
+ integer :: iirb_ndx(niirb)
+
+ integer :: usr_clm_h2o_m_ndx, usr_clm_hcl_m_ndx
+ integer :: usr_oh_co_ndx, het_no2_h2o_ndx, usr_oh_dms_ndx, aq_so2_h2o2_ndx, aq_so2_o3_ndx
+
+ integer :: h2o_ndx
+!
+! jfl
+!
+ integer, parameter :: num_strat_tau = 22
+ integer :: usr_strat_tau_ndx(num_strat_tau)
+!
+!lke++
+ integer :: usr_COhc_OH_ndx
+ integer :: usr_COme_OH_ndx
+ integer :: usr_CO01_OH_ndx
+ integer :: usr_CO02_OH_ndx
+ integer :: usr_CO03_OH_ndx
+ integer :: usr_CO04_OH_ndx
+ integer :: usr_CO05_OH_ndx
+ integer :: usr_CO06_OH_ndx
+ integer :: usr_CO07_OH_ndx
+ integer :: usr_CO08_OH_ndx
+ integer :: usr_CO09_OH_ndx
+ integer :: usr_CO10_OH_ndx
+ integer :: usr_CO11_OH_ndx
+ integer :: usr_CO12_OH_ndx
+ integer :: usr_CO13_OH_ndx
+ integer :: usr_CO14_OH_ndx
+ integer :: usr_CO15_OH_ndx
+ integer :: usr_CO16_OH_ndx
+ integer :: usr_CO17_OH_ndx
+ integer :: usr_CO18_OH_ndx
+ integer :: usr_CO19_OH_ndx
+ integer :: usr_CO20_OH_ndx
+ integer :: usr_CO21_OH_ndx
+ integer :: usr_CO22_OH_ndx
+ integer :: usr_CO23_OH_ndx
+ integer :: usr_CO24_OH_ndx
+ integer :: usr_CO25_OH_ndx
+ integer :: usr_CO26_OH_ndx
+ integer :: usr_CO27_OH_ndx
+ integer :: usr_CO28_OH_ndx
+ integer :: usr_CO29_OH_ndx
+ integer :: usr_CO30_OH_ndx
+ integer :: usr_CO31_OH_ndx
+ integer :: usr_CO32_OH_ndx
+ integer :: usr_CO33_OH_ndx
+ integer :: usr_CO34_OH_ndx
+ integer :: usr_CO35_OH_ndx
+ integer :: usr_CO36_OH_ndx
+ integer :: usr_CO37_OH_ndx
+ integer :: usr_CO38_OH_ndx
+ integer :: usr_CO39_OH_ndx
+ integer :: usr_CO40_OH_ndx
+ integer :: usr_CO41_OH_ndx
+ integer :: usr_CO42_OH_ndx
+!lke--
+
+ real(r8), parameter :: t0 = 300._r8 ! K
+ real(r8), parameter :: trlim2 = 17._r8/3._r8 ! K
+ real(r8), parameter :: trlim3 = 15._r8/3._r8 ! K
+
+ logical :: has_ion_rxts, has_d_chem
+
+contains
+
+ subroutine usrrxt_inti
+ !-----------------------------------------------------------------
+ ! ... intialize the user reaction constants module
+ !-----------------------------------------------------------------
+
+ use mo_chem_utls, only : get_rxt_ndx, get_spc_ndx
+ use spmd_utils, only : masterproc
+
+ implicit none
+
+ character(len=4) :: xchar
+ character(len=32) :: rxtname
+ integer :: i
+
+!
+! full tropospheric chemistry
+!
+ usr_O_O2_ndx = get_rxt_ndx( 'usr_O_O2' )
+ usr_HO2_HO2_ndx = get_rxt_ndx( 'usr_HO2_HO2' )
+ usr_N2O5_M_ndx = get_rxt_ndx( 'usr_N2O5_M' )
+ usr_HNO3_OH_ndx = get_rxt_ndx( 'usr_HNO3_OH' )
+ usr_HO2NO2_M_ndx = get_rxt_ndx( 'usr_HO2NO2_M' )
+ usr_N2O5_aer_ndx = get_rxt_ndx( 'usr_N2O5_aer' )
+ usr_NO3_aer_ndx = get_rxt_ndx( 'usr_NO3_aer' )
+ usr_NO2_aer_ndx = get_rxt_ndx( 'usr_NO2_aer' )
+ usr_CO_OH_a_ndx = get_rxt_ndx( 'usr_CO_OH_a' )
+ usr_CO_OH_b_ndx = get_rxt_ndx( 'usr_CO_OH_b' )
+ usr_PAN_M_ndx = get_rxt_ndx( 'usr_PAN_M' )
+ usr_CH3COCH3_OH_ndx = get_rxt_ndx( 'usr_CH3COCH3_OH' )
+ usr_MCO3_NO2_ndx = get_rxt_ndx( 'usr_MCO3_NO2' )
+ usr_MPAN_M_ndx = get_rxt_ndx( 'usr_MPAN_M' )
+ usr_XOOH_OH_ndx = get_rxt_ndx( 'usr_XOOH_OH' )
+ usr_SO2_OH_ndx = get_rxt_ndx( 'usr_SO2_OH' )
+ usr_DMS_OH_ndx = get_rxt_ndx( 'usr_DMS_OH' )
+ usr_HO2_aer_ndx = get_rxt_ndx( 'usr_HO2_aer' )
+ usr_GLYOXAL_aer_ndx = get_rxt_ndx( 'usr_GLYOXAL_aer' )
+ !
+ tag_NO2_NO3_ndx = get_rxt_ndx( 'tag_NO2_NO3' )
+ tag_NO2_OH_ndx = get_rxt_ndx( 'tag_NO2_OH' )
+ tag_NO2_HO2_ndx = get_rxt_ndx( 'tag_NO2_HO2' )
+ tag_C2H4_OH_ndx = get_rxt_ndx( 'tag_C2H4_OH' )
+ tag_C3H6_OH_ndx = get_rxt_ndx( 'tag_C3H6_OH' )
+ tag_CH3CO3_NO2_ndx = get_rxt_ndx( 'tag_CH3CO3_NO2' )
+!lke-TS1
+ usr_PBZNIT_M_ndx = get_rxt_ndx( 'usr_PBZNIT_M' )
+ tag_ACBZO2_NO2_ndx = get_rxt_ndx( 'tag_ACBZO2_NO2' )
+ usr_ISOPNITA_aer_ndx = get_rxt_ndx( 'usr_ISOPNITA_aer' )
+ usr_ISOPNITB_aer_ndx = get_rxt_ndx( 'usr_ISOPNITB_aer' )
+ usr_ONITR_aer_ndx = get_rxt_ndx( 'usr_ONITR_aer' )
+ usr_HONITR_aer_ndx = get_rxt_ndx( 'usr_HONITR_aer' )
+ usr_TERPNIT_aer_ndx = get_rxt_ndx( 'usr_TERPNIT_aer' )
+ usr_NTERPOOH_aer_ndx = get_rxt_ndx( 'usr_NTERPOOH_aer' )
+ usr_NC4CHO_aer_ndx = get_rxt_ndx( 'usr_NC4CHO_aer' )
+ usr_NC4CH2OH_aer_ndx = get_rxt_ndx( 'usr_NC4CH2OH_aer' )
+ !
+ ! additional reactions for O3A/XNO
+ !
+ usr_OA_O2_ndx = get_rxt_ndx( 'usr_OA_O2' )
+ usr_XNO2NO3_M_ndx = get_rxt_ndx( 'usr_XNO2NO3_M' )
+ usr_NO2XNO3_M_ndx = get_rxt_ndx( 'usr_NO2XNO3_M' )
+ usr_XNO2NO3_aer_ndx = get_rxt_ndx( 'usr_XNO2NO3_aer' )
+ usr_NO2XNO3_aer_ndx = get_rxt_ndx( 'usr_NO2XNO3_aer' )
+ usr_XHNO3_OH_ndx = get_rxt_ndx( 'usr_XHNO3_OH' )
+ usr_XNO3_aer_ndx = get_rxt_ndx( 'usr_XNO3_aer' )
+ usr_XNO2_aer_ndx = get_rxt_ndx( 'usr_XNO2_aer' )
+ usr_MCO3_XNO2_ndx = get_rxt_ndx( 'usr_MCO3_XNO2' )
+ usr_XPAN_M_ndx = get_rxt_ndx( 'usr_XPAN_M' )
+ usr_XMPAN_M_ndx = get_rxt_ndx( 'usr_XMPAN_M' )
+ usr_XHO2NO2_M_ndx = get_rxt_ndx( 'usr_XHO2NO2_M' )
+!
+! reduced hydrocarbon chemistry
+!
+ usr_C2O3_NO2_ndx = get_rxt_ndx( 'usr_C2O3_NO2' )
+ usr_C2H4_OH_ndx = get_rxt_ndx( 'usr_C2H4_OH' )
+ usr_XO2N_HO2_ndx = get_rxt_ndx( 'usr_XO2N_HO2' )
+ usr_C2O3_XNO2_ndx = get_rxt_ndx( 'usr_C2O3_XNO2' )
+!
+ tag_XO2N_NO_ndx = get_rxt_ndx( 'tag_XO2N_NO' )
+ tag_XO2_HO2_ndx = get_rxt_ndx( 'tag_XO2_HO2' )
+ tag_XO2_NO_ndx = get_rxt_ndx( 'tag_XO2_NO' )
+!
+! stratospheric chemistry
+!
+ usr_O_O_ndx = get_rxt_ndx( 'usr_O_O' )
+ usr_CL2O2_M_ndx = get_rxt_ndx( 'usr_CL2O2_M' )
+ usr_SO3_H2O_ndx = get_rxt_ndx( 'usr_SO3_H2O' )
+!
+ tag_CLO_CLO_M_ndx = get_rxt_ndx( 'tag_CLO_CLO_M' )
+ if (tag_CLO_CLO_M_ndx<0) then ! for backwards compatibility
+ tag_CLO_CLO_M_ndx = get_rxt_ndx( 'tag_CLO_CLO' )
+ endif
+!
+! reactions to remove BAM aerosols in the stratosphere
+!
+ usr_strat_tau_ndx( 1) = get_rxt_ndx( 'usr_CB1_strat_tau' )
+ usr_strat_tau_ndx( 2) = get_rxt_ndx( 'usr_CB2_strat_tau' )
+ usr_strat_tau_ndx( 3) = get_rxt_ndx( 'usr_OC1_strat_tau' )
+ usr_strat_tau_ndx( 4) = get_rxt_ndx( 'usr_OC2_strat_tau' )
+ usr_strat_tau_ndx( 5) = get_rxt_ndx( 'usr_SO4_strat_tau' )
+ usr_strat_tau_ndx( 6) = get_rxt_ndx( 'usr_SOA_strat_tau' )
+ usr_strat_tau_ndx( 7) = get_rxt_ndx( 'usr_NH4_strat_tau' )
+ usr_strat_tau_ndx( 8) = get_rxt_ndx( 'usr_NH4NO3_strat_tau' )
+ usr_strat_tau_ndx( 9) = get_rxt_ndx( 'usr_SSLT01_strat_tau' )
+ usr_strat_tau_ndx(10) = get_rxt_ndx( 'usr_SSLT02_strat_tau' )
+ usr_strat_tau_ndx(11) = get_rxt_ndx( 'usr_SSLT03_strat_tau' )
+ usr_strat_tau_ndx(12) = get_rxt_ndx( 'usr_SSLT04_strat_tau' )
+ usr_strat_tau_ndx(13) = get_rxt_ndx( 'usr_DST01_strat_tau' )
+ usr_strat_tau_ndx(14) = get_rxt_ndx( 'usr_DST02_strat_tau' )
+ usr_strat_tau_ndx(15) = get_rxt_ndx( 'usr_DST03_strat_tau' )
+ usr_strat_tau_ndx(16) = get_rxt_ndx( 'usr_DST04_strat_tau' )
+ usr_strat_tau_ndx(17) = get_rxt_ndx( 'usr_SO2t_strat_tau' )
+ usr_strat_tau_ndx(18) = get_rxt_ndx( 'usr_SOAI_strat_tau' )
+ usr_strat_tau_ndx(19) = get_rxt_ndx( 'usr_SOAM_strat_tau' )
+ usr_strat_tau_ndx(20) = get_rxt_ndx( 'usr_SOAB_strat_tau' )
+ usr_strat_tau_ndx(21) = get_rxt_ndx( 'usr_SOAT_strat_tau' )
+ usr_strat_tau_ndx(22) = get_rxt_ndx( 'usr_SOAX_strat_tau' )
+!
+! stratospheric aerosol chemistry
+!
+ het1_ndx = get_rxt_ndx( 'het1' )
+!
+! ion chemistry
+!
+ ion1_ndx = get_rxt_ndx( 'ion_Op_O2' )
+ ion2_ndx = get_rxt_ndx( 'ion_Op_N2' )
+ ion3_ndx = get_rxt_ndx( 'ion_N2p_Oa' )
+ ion11_ndx = get_rxt_ndx( 'ion_N2p_Ob' )
+
+ elec1_ndx = get_rxt_ndx( 'elec1' )
+ elec2_ndx = get_rxt_ndx( 'elec2' )
+ elec3_ndx = get_rxt_ndx( 'elec3' )
+
+ do i = 1,nean
+ write (xchar,'(i4)') i
+ rxtname = 'ean'//trim(adjustl(xchar))
+ ean_ndx(i) = get_rxt_ndx(trim(rxtname))
+ enddo
+
+ do i = 1,nrpe
+ write (xchar,'(i4)') i
+ rxtname = 'rpe'//trim(adjustl(xchar))
+ rpe_ndx(i) = get_rxt_ndx(trim(rxtname))
+ enddo
+
+ do i = 1,npir
+ write (xchar,'(i4)') i
+ rxtname = 'pir'//trim(adjustl(xchar))
+ pir_ndx(i) = get_rxt_ndx(trim(rxtname))
+ enddo
+
+ do i = 1,nedn
+ write (xchar,'(i4)') i
+ rxtname = 'edn'//trim(adjustl(xchar))
+ edn_ndx(i) = get_rxt_ndx(trim(rxtname))
+ enddo
+
+ do i = 1,nnir
+ write (xchar,'(i4)') i
+ rxtname = 'nir'//trim(adjustl(xchar))
+ nir_ndx(i) = get_rxt_ndx(trim(rxtname))
+ enddo
+
+ do i = 1,niira
+ write (xchar,'(i4)') i
+ rxtname = 'iira'//trim(adjustl(xchar))
+ iira_ndx(i) = get_rxt_ndx(trim(rxtname))
+ enddo
+
+ do i = 1,niirb
+ write (xchar,'(i4)') i
+ rxtname = 'iirb'//trim(adjustl(xchar))
+ iirb_ndx(i) = get_rxt_ndx(trim(rxtname))
+ enddo
+
+ usr_clm_h2o_m_ndx = get_rxt_ndx( 'usr_CLm_H2O_M' )
+ usr_clm_hcl_m_ndx = get_rxt_ndx( 'usr_CLm_HCL_M' )
+
+ elec4_ndx = get_rxt_ndx( 'Op2P_ea' )
+ elec5_ndx = get_rxt_ndx( 'Op2P_eb' )
+ elec6_ndx = get_rxt_ndx( 'Op2D_e' )
+
+ has_ion_rxts = ion1_ndx>0 .and. ion2_ndx>0 .and. ion3_ndx>0 .and. elec1_ndx>0 &
+ .and. elec2_ndx>0 .and. elec3_ndx>0
+
+ has_d_chem = &
+ all(ean_ndx>0) .and. &
+ all(rpe_ndx>0) .and. &
+ all(pir_ndx>0) .and. &
+ all(edn_ndx>0) .and. &
+ all(nir_ndx>0) .and. &
+ all(iira_ndx>0) .and. &
+ all(iirb_ndx>0) .and. &
+ usr_clm_h2o_m_ndx>0 .and. usr_clm_hcl_m_ndx>0
+
+ h2o_ndx = get_spc_ndx( 'H2O' )
+
+ !
+ ! llnl super fast
+ !
+ usr_oh_co_ndx = get_rxt_ndx( 'usr_oh_co' )
+ het_no2_h2o_ndx = get_rxt_ndx( 'het_no2_h2o' )
+ usr_oh_dms_ndx = get_rxt_ndx( 'usr_oh_dms' )
+ aq_so2_h2o2_ndx = get_rxt_ndx( 'aq_so2_h2o2' )
+ aq_so2_o3_ndx = get_rxt_ndx( 'aq_so2_o3' )
+
+!lke++
+! CO tags
+!
+ usr_COhc_OH_ndx = get_rxt_ndx( 'usr_COhc_OH' )
+ usr_COme_OH_ndx = get_rxt_ndx( 'usr_COme_OH' )
+ usr_CO01_OH_ndx = get_rxt_ndx( 'usr_CO01_OH' )
+ usr_CO02_OH_ndx = get_rxt_ndx( 'usr_CO02_OH' )
+ usr_CO03_OH_ndx = get_rxt_ndx( 'usr_CO03_OH' )
+ usr_CO04_OH_ndx = get_rxt_ndx( 'usr_CO04_OH' )
+ usr_CO05_OH_ndx = get_rxt_ndx( 'usr_CO05_OH' )
+ usr_CO06_OH_ndx = get_rxt_ndx( 'usr_CO06_OH' )
+ usr_CO07_OH_ndx = get_rxt_ndx( 'usr_CO07_OH' )
+ usr_CO08_OH_ndx = get_rxt_ndx( 'usr_CO08_OH' )
+ usr_CO09_OH_ndx = get_rxt_ndx( 'usr_CO09_OH' )
+ usr_CO10_OH_ndx = get_rxt_ndx( 'usr_CO10_OH' )
+ usr_CO11_OH_ndx = get_rxt_ndx( 'usr_CO11_OH' )
+ usr_CO12_OH_ndx = get_rxt_ndx( 'usr_CO12_OH' )
+ usr_CO13_OH_ndx = get_rxt_ndx( 'usr_CO13_OH' )
+ usr_CO14_OH_ndx = get_rxt_ndx( 'usr_CO14_OH' )
+ usr_CO15_OH_ndx = get_rxt_ndx( 'usr_CO15_OH' )
+ usr_CO16_OH_ndx = get_rxt_ndx( 'usr_CO16_OH' )
+ usr_CO17_OH_ndx = get_rxt_ndx( 'usr_CO17_OH' )
+ usr_CO18_OH_ndx = get_rxt_ndx( 'usr_CO18_OH' )
+ usr_CO19_OH_ndx = get_rxt_ndx( 'usr_CO19_OH' )
+ usr_CO20_OH_ndx = get_rxt_ndx( 'usr_CO20_OH' )
+ usr_CO21_OH_ndx = get_rxt_ndx( 'usr_CO21_OH' )
+ usr_CO22_OH_ndx = get_rxt_ndx( 'usr_CO22_OH' )
+ usr_CO23_OH_ndx = get_rxt_ndx( 'usr_CO23_OH' )
+ usr_CO24_OH_ndx = get_rxt_ndx( 'usr_CO24_OH' )
+ usr_CO25_OH_ndx = get_rxt_ndx( 'usr_CO25_OH' )
+ usr_CO26_OH_ndx = get_rxt_ndx( 'usr_CO26_OH' )
+ usr_CO27_OH_ndx = get_rxt_ndx( 'usr_CO27_OH' )
+ usr_CO28_OH_ndx = get_rxt_ndx( 'usr_CO28_OH' )
+ usr_CO29_OH_ndx = get_rxt_ndx( 'usr_CO29_OH' )
+ usr_CO30_OH_ndx = get_rxt_ndx( 'usr_CO30_OH' )
+ usr_CO31_OH_ndx = get_rxt_ndx( 'usr_CO31_OH' )
+ usr_CO32_OH_ndx = get_rxt_ndx( 'usr_CO32_OH' )
+ usr_CO33_OH_ndx = get_rxt_ndx( 'usr_CO33_OH' )
+ usr_CO34_OH_ndx = get_rxt_ndx( 'usr_CO34_OH' )
+ usr_CO35_OH_ndx = get_rxt_ndx( 'usr_CO35_OH' )
+ usr_CO36_OH_ndx = get_rxt_ndx( 'usr_CO36_OH' )
+ usr_CO37_OH_ndx = get_rxt_ndx( 'usr_CO37_OH' )
+ usr_CO38_OH_ndx = get_rxt_ndx( 'usr_CO38_OH' )
+ usr_CO39_OH_ndx = get_rxt_ndx( 'usr_CO39_OH' )
+ usr_CO40_OH_ndx = get_rxt_ndx( 'usr_CO40_OH' )
+ usr_CO41_OH_ndx = get_rxt_ndx( 'usr_CO41_OH' )
+ usr_CO42_OH_ndx = get_rxt_ndx( 'usr_CO42_OH' )
+!lke--
+
+ if (masterproc) then
+ write(iulog,*) ' '
+ write(iulog,*) 'usrrxt_inti: diagnostics '
+ write(iulog,'(10i5)') usr_O_O2_ndx,usr_HO2_HO2_ndx,tag_NO2_NO3_ndx,usr_N2O5_M_ndx,tag_NO2_OH_ndx,usr_HNO3_OH_ndx &
+ ,tag_NO2_HO2_ndx,usr_HO2NO2_M_ndx,usr_N2O5_aer_ndx,usr_NO3_aer_ndx,usr_NO2_aer_ndx &
+ ,usr_CO_OH_b_ndx,tag_C2H4_OH_ndx,tag_C3H6_OH_ndx,tag_CH3CO3_NO2_ndx,usr_PAN_M_ndx,usr_CH3COCH3_OH_ndx &
+ ,usr_MCO3_NO2_ndx,usr_MPAN_M_ndx,usr_XOOH_OH_ndx,usr_SO2_OH_ndx,usr_DMS_OH_ndx,usr_HO2_aer_ndx &
+ ,usr_GLYOXAL_aer_ndx,usr_ISOPNITA_aer_ndx,usr_ISOPNITB_aer_ndx,usr_ONITR_aer_ndx,usr_HONITR_aer_ndx &
+ ,usr_TERPNIT_aer_ndx,usr_NTERPOOH_aer_ndx,usr_NC4CHO_aer_ndx,usr_NC4CH2OH_aer_ndx
+
+ end if
+
+ end subroutine usrrxt_inti
+
+ subroutine usrrxt( rxt, temp, tempi, tempe, invariants, h2ovmr, &
+ pmid, m, sulfate, mmr, relhum, strato_sad, &
+ tropchemlev, dlat, ncol, sad_trop, reff_trop, cwat, mbar, pbuf )
+
+!-----------------------------------------------------------------
+! ... set the user specified reaction rates
+!-----------------------------------------------------------------
+
+ use mo_constants, only : pi, avo => avogadro, boltz_cgs, rgas
+ use chem_mods, only : nfs, rxntot, gas_pcnst, inv_m_ndx=>indexm
+ use mo_setinv, only : inv_o2_ndx=>o2_ndx, inv_h2o_ndx=>h2o_ndx
+ use physics_buffer,only : physics_buffer_desc
+ use carma_flags_mod, only : carma_hetchem_feedback
+ use aero_model, only : aero_model_surfarea
+ use rad_constituents,only : rad_cnst_get_info
+
+ implicit none
+
+!-----------------------------------------------------------------
+! ... dummy arguments
+!-----------------------------------------------------------------
+ integer, intent(in) :: ncol
+ integer, intent(in) :: tropchemlev(pcols) ! trop/strat reaction separation vertical index
+ real(r8), intent(in) :: dlat(:) ! degrees latitude
+ real(r8), intent(in) :: temp(pcols,pver) ! temperature (K); neutral temperature
+ real(r8), intent(in) :: tempi(pcols,pver) ! ionic temperature (K); only used if ion chemistry
+ real(r8), intent(in) :: tempe(pcols,pver) ! electronic temperature (K); only used if ion chemistry
+ real(r8), intent(in) :: m(ncol,pver) ! total atm density (/cm^3)
+ real(r8), intent(in) :: sulfate(ncol,pver) ! sulfate aerosol (mol/mol)
+ real(r8), intent(in) :: strato_sad(pcols,pver) ! stratospheric aerosol sad (1/cm)
+ real(r8), intent(in) :: h2ovmr(ncol,pver) ! water vapor (mol/mol)
+ real(r8), intent(in) :: relhum(ncol,pver) ! relative humidity
+ real(r8), intent(in) :: pmid(pcols,pver) ! midpoint pressure (Pa)
+ real(r8), intent(in) :: invariants(ncol,pver,nfs) ! invariants density (/cm^3)
+ real(r8), intent(in) :: mmr(pcols,pver,gas_pcnst) ! species concentrations (kg/kg)
+ real(r8), intent(in) :: cwat(ncol,pver) !PJC Condensed Water (liquid+ice) (kg/kg)
+ real(r8), intent(in) :: mbar(ncol,pver) !PJC Molar mass of air (g/mol)
+ real(r8), intent(inout) :: rxt(ncol,pver,rxntot) ! gas phase rates
+ real(r8), intent(out) :: sad_trop(pcols,pver) ! tropospheric surface area density (cm2/cm3)
+ real(r8), intent(out) :: reff_trop(pcols,pver) ! tropospheric effective radius (cm)
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+!-----------------------------------------------------------------
+! ... local variables
+!-----------------------------------------------------------------
+
+ real(r8), parameter :: dg = 0.1_r8 ! mole diffusion =0.1 cm2/s (Dentener, 1993)
+
+!-----------------------------------------------------------------
+! ... reaction probabilities for heterogeneous reactions
+!-----------------------------------------------------------------
+ real(r8), parameter :: gamma_n2o5 = 0.10_r8 ! from Jacob, Atm Env, 34, 2131, 2000
+ real(r8), parameter :: gamma_ho2 = 0.20_r8 !
+ real(r8), parameter :: gamma_no2 = 0.0001_r8 !
+ real(r8), parameter :: gamma_no3 = 0.001_r8 !
+ real(r8), parameter :: gamma_glyoxal = 2.0e-4_r8 ! Washenfelder et al, JGR, 2011
+!TS1 species
+ real(r8), parameter :: gamma_isopnita = 0.005_r8 ! from Fisher et al., ACP, 2016
+ real(r8), parameter :: gamma_isopnitb = 0.005_r8 !
+ real(r8), parameter :: gamma_onitr = 0.005_r8 !
+ real(r8), parameter :: gamma_honitr = 0.005_r8 !
+ real(r8), parameter :: gamma_terpnit = 0.01_r8 !
+ real(r8), parameter :: gamma_nterpooh = 0.01_r8 !
+ real(r8), parameter :: gamma_nc4cho = 0.005_r8 !
+ real(r8), parameter :: gamma_nc4ch2oh = 0.005_r8 !
+
+
+ integer :: i, k
+ integer :: l
+ real(r8) :: tp(ncol) ! 300/t
+ real(r8) :: tinv(ncol) ! 1/t
+ real(r8) :: ko(ncol)
+ real(r8) :: term1(ncol)
+ real(r8) :: term2(ncol)
+ real(r8) :: kinf(ncol)
+ real(r8) :: fc(ncol)
+ real(r8) :: xr(ncol)
+ real(r8) :: sur(ncol)
+ real(r8) :: sqrt_t(ncol) ! sqrt( temp )
+ real(r8) :: sqrt_t_58(ncol) ! sqrt( temp / 58.)
+ real(r8) :: exp_fac(ncol) ! vector exponential
+ real(r8) :: lwc(ncol)
+ real(r8) :: ko_m(ncol)
+ real(r8) :: k0(ncol)
+ real(r8) :: kinf_m(ncol)
+ real(r8) :: o2(ncol)
+ real(r8) :: c_n2o5, c_ho2, c_no2, c_no3, c_glyoxal
+!TS1 species
+ real(r8) :: c_isopnita, c_isopnitb, c_onitr, c_honitr, c_terpnit, c_nterpooh
+ real(r8) :: c_nc4cho, c_nc4ch2oh
+
+ real(r8) :: amas
+ !-----------------------------------------------------------------
+ ! ... density of sulfate aerosol
+ !-----------------------------------------------------------------
+ real(r8), parameter :: gam1 = 0.04_r8 ! N2O5+SUL ->2HNO3
+ real(r8), parameter :: wso4 = 98._r8
+ real(r8), parameter :: den = 1.15_r8 ! each molecule of SO4(aer) density g/cm3
+ !-------------------------------------------------
+ ! ... volume of sulfate particles
+ ! assuming mean rm
+ ! continient 0.05um 0.07um 0.09um
+ ! ocean 0.09um 0.25um 0.37um
+ ! 0.16um Blake JGR,7195, 1995
+ !-------------------------------------------------
+ real(r8), parameter :: rm1 = 0.16_r8*1.e-4_r8 ! mean radii in cm
+ real(r8), parameter :: fare = 4._r8*pi*rm1*rm1 ! each mean particle(r=0.1u) area cm2/cm3
+
+ !-----------------------------------------------------------------------
+ ! ... Aqueous phase sulfur quantities for SO2 + H2O2 and SO2 + O3
+ !-----------------------------------------------------------------------
+ real(r8), parameter :: HENRY298_H2O2 = 7.45e+04_r8
+ real(r8), parameter :: H298_H2O2 = -1.45e+04_r8
+ real(r8), parameter :: HENRY298_SO2 = 1.23e+00_r8
+ real(r8), parameter :: H298_SO2 = -6.25e+03_r8
+ real(r8), parameter :: K298_SO2_HSO3 = 1.3e-02_r8
+ real(r8), parameter :: H298_SO2_HSO3 = -4.16e+03_r8
+ real(r8), parameter :: R_CONC = 82.05e+00_r8 / avo
+ real(r8), parameter :: R_CAL = rgas * 0.239006e+00_r8
+ real(r8), parameter :: K_AQ = 7.57e+07_r8
+ real(r8), parameter :: ER_AQ = 4.43e+03_r8
+
+ real(r8), parameter :: HENRY298_O3 = 1.13e-02_r8
+ real(r8), parameter :: H298_O3 = -5.04e+03_r8
+ real(r8), parameter :: K298_HSO3_SO3 = 6.6e-08_r8
+ real(r8), parameter :: H298_HSO3_SO3 = -2.23e+03_r8
+ real(r8), parameter :: K0_AQ = 2.4e+04_r8
+ real(r8), parameter :: ER0_AQ = 0.0e+00_r8
+ real(r8), parameter :: K1_AQ = 3.7e+05_r8
+ real(r8), parameter :: ER1_AQ = 5.53e+03_r8
+ real(r8), parameter :: K2_AQ = 1.5e+09_r8
+ real(r8), parameter :: ER2_AQ = 5.28e+03_r8
+
+ real(r8), parameter :: pH = 4.5e+00_r8
+
+ real(r8), pointer :: sfc(:), dm_aer(:)
+ integer :: ntot_amode
+
+ real(r8), pointer :: sfc_array(:,:,:), dm_array(:,:,:)
+
+#ifdef OSLO_AERO
+ ntot_amode = nmodes_oslo
+#else
+ ! get info about the modal aerosols
+ ! get ntot_amode
+ call rad_cnst_get_info(0, nmodes=ntot_amode)
+#endif
+ if (ntot_amode>0) then
+ allocate(sfc_array(pcols,pver,ntot_amode), dm_array(pcols,pver,ntot_amode) )
+ else
+ allocate(sfc_array(pcols,pver,5), dm_array(pcols,pver,5) )
+ endif
+
+ sfc_array(:,:,:) = 0._r8
+ dm_array(:,:,:) = 0._r8
+ sad_trop(:,:) = 0._r8
+ reff_trop(:,:) = 0._r8
+
+ if( usr_NO2_aer_ndx > 0 .or. usr_NO3_aer_ndx > 0 .or. usr_N2O5_aer_ndx > 0 .or. usr_HO2_aer_ndx > 0 ) then
+
+! sad_trop should be set outside of usrrxt ??
+ if( carma_hetchem_feedback ) then
+ sad_trop(:ncol,:pver)=strato_sad(:ncol,:pver)
+ else
+
+ call aero_model_surfarea( &
+ mmr, rm1, relhum, pmid, temp, strato_sad, sulfate, m, tropchemlev, dlat, &
+ het1_ndx, pbuf, ncol, sfc_array, dm_array, sad_trop, reff_trop )
+
+ endif
+ endif
+
+ level_loop : do k = 1,pver
+ tinv(:) = 1._r8 / temp(:ncol,k)
+ tp(:) = 300._r8 * tinv(:)
+ sqrt_t(:) = sqrt( temp(:ncol,k) )
+ sqrt_t_58(:) = sqrt( temp(:ncol,k) / 58.0_r8 )
+
+!-----------------------------------------------------------------
+! ... o + o2 + m --> o3 + m (JPL15-10)
+!-----------------------------------------------------------------
+ if( usr_O_O2_ndx > 0 ) then
+ rxt(:,k,usr_O_O2_ndx) = 6.e-34_r8 * tp(:)**2.4_r8
+ end if
+ if( usr_OA_O2_ndx > 0 ) then
+ rxt(:,k,usr_OA_O2_ndx) = 6.e-34_r8 * tp(:)**2.4_r8
+ end if
+
+!-----------------------------------------------------------------
+! ... o + o + m -> o2 + m
+!-----------------------------------------------------------------
+ if ( usr_O_O_ndx > 0 ) then
+ rxt(:,k,usr_O_O_ndx) = 2.76e-34_r8 * exp( 720.0_r8*tinv(:) )
+ end if
+
+!-----------------------------------------------------------------
+! ... cl2o2 + m -> 2*clo + m (JPL15-10)
+!-----------------------------------------------------------------
+ if ( usr_CL2O2_M_ndx > 0 ) then
+ if ( tag_CLO_CLO_M_ndx > 0 ) then
+ ko(:) = 2.16e-27_r8 * exp( 8537.0_r8* tinv(:) )
+ rxt(:,k,usr_CL2O2_M_ndx) = rxt(:,k,tag_CLO_CLO_M_ndx)/ko(:)
+ else
+ rxt(:,k,usr_CL2O2_M_ndx) = 0._r8
+ end if
+ end if
+
+!-----------------------------------------------------------------
+! ... so3 + 2*h2o --> h2so4 + h2o
+! Note: this reaction proceeds by the 2 intermediate steps below
+! so3 + h2o --> adduct
+! adduct + h2o --> h2so4 + h2o
+! (Lovejoy et al., JCP, pp. 19911-19916, 1996)
+! The first order rate constant used here is recommended by JPL 2011.
+! This rate involves the water vapor number density.
+!-----------------------------------------------------------------
+
+ if ( usr_SO3_H2O_ndx > 0 ) then
+ call comp_exp( exp_fac, 6540.0_r8*tinv(:), ncol )
+ if( h2o_ndx > 0 ) then
+ fc(:) = 8.5e-21_r8 * m(:,k) * h2ovmr(:,k) * exp_fac(:)
+ else
+ fc(:) = 8.5e-21_r8 * invariants(:,k,inv_h2o_ndx) * exp_fac(:)
+ end if
+ rxt(:,k,usr_SO3_H2O_ndx) = 1.0e-20_r8 * fc(:)
+ end if
+
+!-----------------------------------------------------------------
+! ... n2o5 + m --> no2 + no3 + m (JPL15-10)
+!-----------------------------------------------------------------
+ if( usr_N2O5_M_ndx > 0 ) then
+ if( tag_NO2_NO3_ndx > 0 ) then
+ call comp_exp( exp_fac, -10840.0_r8*tinv, ncol )
+ rxt(:,k,usr_N2O5_M_ndx) = rxt(:,k,tag_NO2_NO3_ndx) * 1.724138e26_r8 * exp_fac(:)
+ else
+ rxt(:,k,usr_N2O5_M_ndx) = 0._r8
+ end if
+ end if
+ if( usr_XNO2NO3_M_ndx > 0 ) then
+ if( tag_NO2_NO3_ndx > 0 ) then
+ call comp_exp( exp_fac, -10840.0_r8*tinv, ncol )
+ rxt(:,k,usr_XNO2NO3_M_ndx) = rxt(:,k,tag_NO2_NO3_ndx) *1.724138e26_r8 * exp_fac(:)
+ else
+ rxt(:,k,usr_XNO2NO3_M_ndx) = 0._r8
+ end if
+ end if
+ if( usr_NO2XNO3_M_ndx > 0 ) then
+ if( tag_NO2_NO3_ndx > 0 ) then
+ call comp_exp( exp_fac, -10840.0_r8*tinv, ncol )
+ rxt(:,k,usr_NO2XNO3_M_ndx) = rxt(:,k,tag_NO2_NO3_ndx) * 1.734138e26_r8 * exp_fac(:)
+ else
+ rxt(:,k,usr_NO2XNO3_M_ndx) = 0._r8
+ end if
+ end if
+
+!-----------------------------------------------------------------
+! set rates for:
+! ... hno3 + oh --> no3 + h2o
+! ho2no2 + m --> ho2 + no2 + m
+!-----------------------------------------------------------------
+ if( usr_HNO3_OH_ndx > 0 ) then
+ call comp_exp( exp_fac, 1335._r8*tinv, ncol )
+ ko(:) = m(:,k) * 6.5e-34_r8 * exp_fac(:)
+ call comp_exp( exp_fac, 2199._r8*tinv, ncol )
+ ko(:) = ko(:) / (1._r8 + ko(:)/(2.7e-17_r8*exp_fac(:)))
+ call comp_exp( exp_fac, 460._r8*tinv, ncol )
+ rxt(:,k,usr_HNO3_OH_ndx) = ko(:) + 2.4e-14_r8*exp_fac(:)
+ end if
+ if( usr_XHNO3_OH_ndx > 0 ) then
+ call comp_exp( exp_fac, 1335._r8*tinv, ncol )
+ ko(:) = m(:,k) * 6.5e-34_r8 * exp_fac(:)
+ call comp_exp( exp_fac, 2199._r8*tinv, ncol )
+ ko(:) = ko(:) / (1._r8 + ko(:)/(2.7e-17_r8*exp_fac(:)))
+ call comp_exp( exp_fac, 460._r8*tinv, ncol )
+ rxt(:,k,usr_XHNO3_OH_ndx) = ko(:) + 2.4e-14_r8*exp_fac(:)
+ end if
+ if( usr_HO2NO2_M_ndx > 0 ) then
+ if( tag_NO2_HO2_ndx > 0 ) then
+ call comp_exp( exp_fac, -10900._r8*tinv, ncol )
+ rxt(:,k,usr_HO2NO2_M_ndx) = rxt(:,k,tag_NO2_HO2_ndx) * exp_fac(:) / 2.1e-27_r8
+ else
+ rxt(:,k,usr_HO2NO2_M_ndx) = 0._r8
+ end if
+ end if
+ if( usr_XHO2NO2_M_ndx > 0 ) then
+ if( tag_NO2_HO2_ndx > 0 ) then
+ call comp_exp( exp_fac, -10900._r8*tinv, ncol )
+ rxt(:,k,usr_XHO2NO2_M_ndx) = rxt(:,k,tag_NO2_HO2_ndx) * exp_fac(:) / 2.1e-27_r8
+ else
+ rxt(:,k,usr_XHO2NO2_M_ndx) = 0._r8
+ end if
+ end if
+!-----------------------------------------------------------------
+! co + oh --> co2 + ho2 (combined branches - do not use with CO_OH_b)
+!-----------------------------------------------------------------
+ if( usr_CO_OH_a_ndx > 0 ) then
+ rxt(:,k,usr_CO_OH_a_ndx) = 1.5e-13_r8 * &
+ (1._r8 + 6.e-7_r8*boltz_cgs*m(:,k)*temp(:ncol,k))
+ end if
+!-----------------------------------------------------------------
+! ... co + oh --> co2 + h (second branch JPL15-10, with CO+OH+M)
+!-----------------------------------------------------------------
+ if( usr_CO_OH_b_ndx > 0 ) then
+ kinf(:) = 2.1e+09_r8 * (temp(:ncol,k)/ t0)**(6.1_r8)
+ ko (:) = 1.5e-13_r8
+
+ term1(:) = ko(:) / ( (kinf(:) / m(:,k)) )
+ term2(:) = ko(:) / (1._r8 + term1(:))
+
+ term1(:) = log10( term1(:) )
+ term1(:) = 1.0_r8 / (1.0_r8 + term1(:)*term1(:))
+
+ rxt(:ncol,k,usr_CO_OH_b_ndx) = term2(:) * (0.6_r8)**term1(:)
+ end if
+
+!-----------------------------------------------------------------
+! ... ho2 + ho2 --> h2o2
+! note: this rate involves the water vapor number density
+!-----------------------------------------------------------------
+ if( usr_HO2_HO2_ndx > 0 ) then
+
+ call comp_exp( exp_fac, 460._r8*tinv, ncol )
+ ko(:) = 3.0e-13_r8 * exp_fac(:)
+ call comp_exp( exp_fac, 920._r8*tinv, ncol )
+ kinf(:) = 2.1e-33_r8 * m(:,k) * exp_fac(:)
+ call comp_exp( exp_fac, 2200._r8*tinv, ncol )
+
+ if( h2o_ndx > 0 ) then
+ fc(:) = 1._r8 + 1.4e-21_r8 * m(:,k) * h2ovmr(:,k) * exp_fac(:)
+ else
+ fc(:) = 1._r8 + 1.4e-21_r8 * invariants(:,k,inv_h2o_ndx) * exp_fac(:)
+ end if
+ rxt(:,k,usr_HO2_HO2_ndx) = (ko(:) + kinf(:)) * fc(:)
+
+ end if
+
+!-----------------------------------------------------------------
+! ... mco3 + no2 -> mpan
+!-----------------------------------------------------------------
+ if( usr_MCO3_NO2_ndx > 0 ) then
+ rxt(:,k,usr_MCO3_NO2_ndx) = 1.1e-11_r8 * tp(:) / m(:,k)
+ end if
+ if( usr_MCO3_XNO2_ndx > 0 ) then
+ rxt(:,k,usr_MCO3_XNO2_ndx) = 1.1e-11_r8 * tp(:) / m(:,k)
+ end if
+
+!-----------------------------------------------------------------
+! ... pan + m --> ch3co3 + no2 + m (JPL15-10)
+!-----------------------------------------------------------------
+ call comp_exp( exp_fac, -14000._r8*tinv, ncol )
+ if( usr_PAN_M_ndx > 0 ) then
+ if( tag_CH3CO3_NO2_ndx > 0 ) then
+ rxt(:,k,usr_PAN_M_ndx) = rxt(:,k,tag_CH3CO3_NO2_ndx) * 1.111e28_r8 * exp_fac(:)
+ else
+ rxt(:,k,usr_PAN_M_ndx) = 0._r8
+ end if
+ end if
+ if( usr_XPAN_M_ndx > 0 ) then
+ if( tag_CH3CO3_NO2_ndx > 0 ) then
+ rxt(:,k,usr_XPAN_M_ndx) = rxt(:,k,tag_CH3CO3_NO2_ndx) * 1.111e28_r8 * exp_fac(:)
+ else
+ rxt(:,k,usr_XPAN_M_ndx) = 0._r8
+ end if
+ end if
+
+!-----------------------------------------------------------------
+! ... mpan + m --> mco3 + no2 + m (JPL15-10)
+!-----------------------------------------------------------------
+ if( usr_MPAN_M_ndx > 0 ) then
+ if( usr_MCO3_NO2_ndx > 0 ) then
+ rxt(:,k,usr_MPAN_M_ndx) = rxt(:,k,usr_MCO3_NO2_ndx) * 1.111e28_r8 * exp_fac(:)
+ else
+ rxt(:,k,usr_MPAN_M_ndx) = 0._r8
+ end if
+ end if
+ if( usr_XMPAN_M_ndx > 0 ) then
+ if( usr_MCO3_NO2_ndx > 0 ) then
+ rxt(:,k,usr_XMPAN_M_ndx) = rxt(:,k,usr_MCO3_NO2_ndx) * 1.111e28_r8 * exp_fac(:)
+ else
+ rxt(:,k,usr_XMPAN_M_ndx) = 0._r8
+ end if
+ end if
+
+!lke-TS1
+!-----------------------------------------------------------------
+! ... pbznit + m --> acbzo2 + no2 + m
+!-----------------------------------------------------------------
+ if( usr_PBZNIT_M_ndx > 0 ) then
+ if( tag_ACBZO2_NO2_ndx > 0 ) then
+ rxt(:,k,usr_PBZNIT_M_ndx) = rxt(:,k,tag_ACBZO2_NO2_ndx) * 1.111e28_r8 * exp_fac(:)
+ else
+ rxt(:,k,usr_PBZNIT_M_ndx) = 0._r8
+ end if
+ end if
+
+!-----------------------------------------------------------------
+! ... xooh + oh -> h2o + oh
+!-----------------------------------------------------------------
+ if( usr_XOOH_OH_ndx > 0 ) then
+ call comp_exp( exp_fac, 253._r8*tinv, ncol )
+ rxt(:,k,usr_XOOH_OH_ndx) = temp(:ncol,k)**2._r8 * 7.69e-17_r8 * exp_fac(:)
+ end if
+
+!-----------------------------------------------------------------
+! ... ch3coch3 + oh -> ro2 + h2o
+!-----------------------------------------------------------------
+ if( usr_CH3COCH3_OH_ndx > 0 ) then
+ call comp_exp( exp_fac, -2000._r8*tinv, ncol )
+ rxt(:,k,usr_CH3COCH3_OH_ndx) = 3.82e-11_r8 * exp_fac(:) + 1.33e-13_r8
+ end if
+
+!-----------------------------------------------------------------
+! ... DMS + OH --> .5 * SO2
+!-----------------------------------------------------------------
+ if( usr_DMS_OH_ndx > 0 ) then
+ call comp_exp( exp_fac, 7460._r8*tinv, ncol )
+ ko(:) = 1._r8 + 5.5e-31_r8 * exp_fac * m(:,k) * 0.21_r8
+ call comp_exp( exp_fac, 7810._r8*tinv, ncol )
+ rxt(:,k,usr_DMS_OH_ndx) = 1.7e-42_r8 * exp_fac * m(:,k) * 0.21_r8 / ko(:)
+ end if
+
+!-----------------------------------------------------------------
+! ... SO2 + OH --> SO4 (REFERENCE?? - not Liao)
+!-----------------------------------------------------------------
+ if( usr_SO2_OH_ndx > 0 ) then
+ fc(:) = 3.0e-31_r8 *(300._r8*tinv(:))**3.3_r8
+ ko(:) = fc(:)*m(:,k)/(1._r8 + fc(:)*m(:,k)/1.5e-12_r8)
+ rxt(:,k,usr_SO2_OH_ndx) = ko(:)*.6_r8**(1._r8 + (log10(fc(:)*m(:,k)/1.5e-12_r8))**2._r8)**(-1._r8)
+ end if
+!
+! reduced hydrocarbon scheme
+!
+ if ( usr_C2O3_NO2_ndx > 0 ) then
+ ko(:) = 2.6e-28_r8 * m(:,k)
+ kinf(:) = 1.2e-11_r8
+ rxt(:,k,usr_C2O3_NO2_ndx) = (ko/(1._r8+ko/kinf)) * 0.6_r8**(1._r8/(1._r8+(log10(ko/kinf))**2))
+ end if
+ if ( usr_C2O3_XNO2_ndx > 0 ) then
+ ko(:) = 2.6e-28_r8 * m(:,k)
+ kinf(:) = 1.2e-11_r8
+ rxt(:,k,usr_C2O3_XNO2_ndx) = (ko/(1._r8+ko/kinf)) * 0.6_r8**(1._r8/(1._r8+(log10(ko/kinf))**2))
+ end if
+ if ( usr_C2H4_OH_ndx > 0 ) then
+ ko(:) = 1.0e-28_r8 * m(:,k)
+ kinf(:) = 8.8e-12_r8
+ rxt(:,k,usr_C2H4_OH_ndx) = (ko/(1._r8+ko/kinf)) * 0.6_r8**(1._r8/(1._r8+(log(ko/kinf))**2))
+ end if
+ if ( usr_XO2N_HO2_ndx > 0 ) then
+ rxt(:,k,usr_XO2N_HO2_ndx) = rxt(:,k,tag_XO2N_NO_ndx)*rxt(:,k,tag_XO2_HO2_ndx)/(rxt(:,k,tag_XO2_NO_ndx)+1.e-36_r8)
+ end if
+
+!
+! hydrolysis reactions on wetted aerosols
+!
+ if( usr_NO2_aer_ndx > 0 .or. usr_NO3_aer_ndx > 0 .or. usr_N2O5_aer_ndx > 0 .or. usr_HO2_aer_ndx > 0 &
+ .or. usr_GLYOXAL_aer_ndx > 0 ) then
+
+ long_loop : do i = 1,ncol
+
+ sfc => sfc_array(i,k,:)
+ dm_aer => dm_array(i,k,:)
+
+ c_n2o5 = 1.40e3_r8 * sqrt_t(i) ! mean molecular speed of n2o5
+ c_no3 = 1.85e3_r8 * sqrt_t(i) ! mean molecular speed of no3
+ c_no2 = 2.15e3_r8 * sqrt_t(i) ! mean molecular speed of no2
+ c_ho2 = 2.53e3_r8 * sqrt_t(i) ! mean molecular speed of ho2
+ c_glyoxal = 1.455e4_r8 * sqrt_t_58(i) ! mean molecular speed of ho2
+ c_isopnita = 1.20e3_r8 * sqrt_t(i) ! mean molecular speed of isopnita
+ c_isopnitb = 1.20e3_r8 * sqrt_t(i) ! mean molecular speed of isopnitb
+ c_onitr = 1.20e3_r8 * sqrt_t(i) ! mean molecular speed of onitr
+ c_honitr = 1.26e3_r8 * sqrt_t(i) ! mean molecular speed of honitr
+ c_terpnit = 0.992e3_r8 * sqrt_t(i) ! mean molecular speed of terpnit
+ c_nterpooh = 0.957e3_r8 * sqrt_t(i) ! mean molecular speed of nterpooh
+ c_nc4cho = 1.21e3_r8 * sqrt_t(i) ! mean molecular speed of nc4cho
+ c_nc4ch2oh = 1.20e3_r8 * sqrt_t(i) ! mean molecular speed of nc4ch2oh
+
+ !-------------------------------------------------------------------------
+ ! Heterogeneous reaction rates for uptake of a gas on an aerosol:
+ ! rxt = sfc / ( (rad_aer/Dg_gas) + (4/(c_gas*gamma_gas)))
+ !-------------------------------------------------------------------------
+ !-------------------------------------------------------------------------
+ ! ... n2o5 -> 2 hno3 (on sulfate, nh4no3, oc2, soa)
+ !-------------------------------------------------------------------------
+ if( usr_N2O5_aer_ndx > 0 ) then
+ rxt(i,k,usr_N2O5_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_n2o5, gamma_n2o5 )
+ end if
+ if( usr_XNO2NO3_aer_ndx > 0 ) then
+ rxt(i,k,usr_XNO2NO3_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_n2o5, gamma_n2o5 )
+ end if
+ if( usr_NO2XNO3_aer_ndx > 0 ) then
+ rxt(i,k,usr_NO2XNO3_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_n2o5, gamma_n2o5 )
+ end if
+ !-------------------------------------------------------------------------
+ ! ... no3 -> hno3 (on sulfate, nh4no3, oc, soa)
+ !-------------------------------------------------------------------------
+ if( usr_NO3_aer_ndx > 0 ) then
+ rxt(i,k,usr_NO3_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_no3, gamma_no3 )
+ end if
+ if( usr_XNO3_aer_ndx > 0 ) then
+ rxt(i,k,usr_XNO3_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_no3, gamma_no3 )
+ end if
+ !-------------------------------------------------------------------------
+ ! ... no2 -> 0.5 * (ho+no+hno3) (on sulfate, nh4no3, oc2, soa)
+ !-------------------------------------------------------------------------
+ if( usr_NO2_aer_ndx > 0 ) then
+ rxt(i,k,usr_NO2_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_no2, gamma_no2 )
+ end if
+ if( usr_XNO2_aer_ndx > 0 ) then
+ rxt(i,k,usr_XNO2_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_no2, gamma_no2 )
+ end if
+
+ !-------------------------------------------------------------------------
+ ! ... ho2 -> 0.5 * h2o2 (on sulfate, nh4no3, oc2, soa)
+ !-------------------------------------------------------------------------
+ if( usr_HO2_aer_ndx > 0 ) then
+ rxt(i,k,usr_HO2_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_ho2, gamma_ho2 )
+ end if
+ !-------------------------------------------------------------------------
+ ! ... glyoxal -> soag1 (on sulfate, nh4no3, oc2, soa)
+ ! first order uptake, Fuchs and Sutugin, 1971, dCg = 1/4 * gamma * ! A * |v_mol| * Cg * dt
+ !-------------------------------------------------------------------------
+ if( usr_GLYOXAL_aer_ndx > 0 ) then
+ rxt(i,k,usr_GLYOXAL_aer_ndx) = hetrxtrate_gly( sfc, c_glyoxal, gamma_glyoxal )
+ end if
+ !-------------------------------------------------------------------------
+ ! ... ISOPNITA -> HNO3 (on sulfate, nh4no3, oc2, soa)
+ !-------------------------------------------------------------------------
+ if( usr_ISOPNITA_aer_ndx > 0 ) then
+ rxt(i,k,usr_ISOPNITA_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_isopnita, gamma_isopnita )
+ end if
+ !-------------------------------------------------------------------------
+ ! ... ISOPNITB -> HNO3 (on sulfate, nh4no3, oc2, soa)
+ !-------------------------------------------------------------------------
+ if( usr_ISOPNITB_aer_ndx > 0 ) then
+ rxt(i,k,usr_ISOPNITB_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_isopnitb, gamma_isopnitb )
+ end if
+ !-------------------------------------------------------------------------
+ ! ... ONITR -> HNO3 (on sulfate, nh4no3, oc2, soa)
+ !-------------------------------------------------------------------------
+ if( usr_ONITR_aer_ndx > 0 ) then
+ rxt(i,k,usr_ONITR_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_onitr, gamma_onitr )
+ end if
+ !-------------------------------------------------------------------------
+ ! ... HONITR -> HNO3 (on sulfate, nh4no3, oc2, soa)
+ !-------------------------------------------------------------------------
+ if( usr_HONITR_aer_ndx > 0 ) then
+ rxt(i,k,usr_HONITR_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_honitr, gamma_honitr )
+ end if
+ !-------------------------------------------------------------------------
+ ! ... TERPNIT -> HNO3 (on sulfate, nh4no3, oc2, soa)
+ !-------------------------------------------------------------------------
+ if( usr_TERPNIT_aer_ndx > 0 ) then
+ rxt(i,k,usr_TERPNIT_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_terpnit, gamma_terpnit )
+ end if
+ !-------------------------------------------------------------------------
+ ! ... NTERPOOH -> HNO3 (on sulfate, nh4no3, oc2, soa)
+ !-------------------------------------------------------------------------
+ if( usr_NTERPOOH_aer_ndx > 0 ) then
+ rxt(i,k,usr_NTERPOOH_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_nterpooh, gamma_nterpooh )
+ end if
+ !-------------------------------------------------------------------------
+ ! ... NC4CHO -> HNO3 (on sulfate, nh4no3, oc2, soa)
+ !-------------------------------------------------------------------------
+ if( usr_NC4CHO_aer_ndx > 0 ) then
+ rxt(i,k,usr_NC4CHO_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_nc4cho, gamma_nc4cho )
+ end if
+ !-------------------------------------------------------------------------
+ ! ... NC4CH2OH -> HNO3 (on sulfate, nh4no3, oc2, soa)
+ !-------------------------------------------------------------------------
+ if( usr_NC4CH2OH_aer_ndx > 0 ) then
+ rxt(i,k,usr_NC4CH2OH_aer_ndx) = hetrxtrate( sfc, dm_aer, dg, c_nc4ch2oh, gamma_nc4ch2oh )
+ end if
+
+ end do long_loop
+ end if
+
+ ! LLNL super fast chem reaction rates
+
+ !-----------------------------------------------------------------------
+ ! ... CO + OH --> CO2 + HO2
+ !-----------------------------------------------------------------------
+ if ( usr_oh_co_ndx > 0 ) then
+ ko(:) = 5.9e-33_r8 * tp(:)**1.4_r8
+ kinf(:) = 1.1e-12_r8 * (temp(:ncol,k) / 300._r8)**1.3_r8
+ ko_m(:) = ko(:) * m(:,k)
+ k0(:) = 1.5e-13_r8 * (temp(:ncol,k) / 300._r8)**0.6_r8
+ kinf_m(:) = (2.1e+09_r8 * (temp(:ncol,k) / 300._r8)**6.1_r8) / m(:,k)
+ rxt(:,k,usr_oh_co_ndx) = (ko_m(:)/(1._r8+(ko_m(:)/kinf(:)))) * &
+ 0.6_r8**(1._r8/(1._r8+(log10(ko_m(:)/kinf(:)))**2._r8)) + &
+ (k0(:)/(1._r8+(k0(:)/kinf_m(:)))) * &
+ 0.6_r8**(1._r8/(1._r8+(log10(k0(:)/kinf_m(:)))**2._r8))
+ endif
+ !-----------------------------------------------------------------------
+ ! ... NO2 + H2O --> 0.5 HONO + 0.5 HNO3
+ !-----------------------------------------------------------------------
+ if ( het_no2_h2o_ndx > 0 ) then
+ rxt(:,k,het_no2_h2o_ndx) = 4.0e-24_r8
+ endif
+ !-----------------------------------------------------------------------
+ ! ... DMS + OH --> 0.75 SO2 + 0.25 MSA
+ !-----------------------------------------------------------------------
+ if ( usr_oh_dms_ndx > 0 ) then
+ o2(:ncol) = invariants(:ncol,k,inv_o2_ndx)
+ rxt(:,k,usr_oh_dms_ndx) = 2.000e-10_r8 * exp(5820.0_r8 * tinv(:)) / &
+ ((2.000e29_r8 / o2(:)) + exp(6280.0_r8 * tinv(:)))
+ endif
+ if ( aq_so2_h2o2_ndx > 0 .or. aq_so2_o3_ndx > 0 ) then
+ lwc(:) = cwat(:ncol,k) * invariants(:ncol,k,inv_m_ndx) * mbar(:ncol,k) /avo !PJC convert kg/kg to g/cm3
+ !-----------------------------------------------------------------------
+ ! ... SO2 + H2O2 --> S(VI)
+ !-----------------------------------------------------------------------
+ if ( aq_so2_h2o2_ndx > 0 ) then
+ rxt(:,k,aq_so2_h2o2_ndx) = lwc(:) * 1.0e-03_r8 * avo * &
+ K_AQ * &
+
+ exp(ER_AQ * ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * &
+ HENRY298_SO2 * &
+ K298_SO2_HSO3 * &
+ HENRY298_H2O2 * &
+ exp(((H298_SO2 + H298_SO2_HSO3 + H298_H2O2) / R_CAL) * &
+ ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * &
+ (R_CONC * temp(:ncol,k))**2.0e+00_r8 / &
+
+ (1.0e+00_r8 + 13.0e+00_r8 * 10.0e+00_r8**(-pH))
+ endif
+ !-----------------------------------------------------------------------
+ ! ... SO2 + O3 --> S(VI)
+ !-----------------------------------------------------------------------
+ if (aq_so2_o3_ndx >0) then
+ rxt(:,k,aq_so2_o3_ndx) = lwc(:) * 1.0e-03_r8 * avo * &
+ HENRY298_SO2 * exp((H298_SO2 / R_CAL) * &
+ ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * &
+ (K0_AQ * exp(ER0_AQ * &
+ ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) + &
+ K298_SO2_HSO3 * exp((H298_SO2_HSO3 / R_CAL) * &
+ ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * &
+ (K1_AQ * exp(ER1_AQ * &
+ ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) / &
+ 10.0e+00_r8**(-pH) + K2_AQ * exp(ER2_AQ * &
+ ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * &
+ K298_HSO3_SO3 * exp((H298_HSO3_SO3 / R_CAL) * &
+ ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) / &
+ (10.0e+00_r8**(-pH))**2.0e+00_r8) ) * &
+ HENRY298_O3 * exp((H298_O3 / R_CAL) * &
+ ((1.0e+00_r8 / 298.0e+00_r8) - tinv(:))) * &
+ (R_CONC * temp(:ncol,k))**2.0e+00_r8
+ endif
+ endif
+
+ if ( has_d_chem ) then
+
+ call comp_exp( exp_fac, -600._r8 * tinv, ncol )
+ rxt(:,k,ean_ndx(1)) = 1.e-31_r8 * tp(:) * exp_fac(:)
+ rxt(:,k,ean_ndx(2)) = 9.1e-12_r8 * tp(:)**(-1.46_r8)
+ call comp_exp( exp_fac, -193._r8 * tinv, ncol )
+ rxt(:,k,ean_ndx(3)) = (4.e-30_r8 * exp_fac(:)) * 0.21_r8
+
+ rxt(:,k,rpe_ndx(1)) = 4.2e-6_r8 * tp(:)**0.5_r8
+ rxt(:,k,rpe_ndx(2)) = 6.3e-7_r8 * tp(:)**0.5_r8
+ rxt(:,k,rpe_ndx(3)) = 2.5e-6_r8 * tp(:)**0.1_r8
+ rxt(:,k,rpe_ndx(4)) = 2.48e-6_r8 * tp(:)**0.76_r8
+ rxt(:,k,rpe_ndx(5)) = 1.4e-6_r8 * tp(:)**0.4_r8
+
+ rxt(:,k,pir_ndx(1)) = 4.e-30_r8 * tp(:)**2.93_r8
+ rxt(:,k,pir_ndx(2)) = 4.6e-27_r8 * tp(:)**4._r8
+
+ call comp_exp( exp_fac, -15900._r8 * tinv, ncol )
+ rxt(:,k,pir_ndx(3)) = (2.5e-2_r8 * tp(:)**5._r8) * exp_fac(:)
+ rxt(:,k,pir_ndx(4)) = 2.3e-27_r8 * tp(:)**7.5_r8
+
+ call comp_exp( exp_fac, -10272._r8 * tinv, ncol )
+ rxt(:,k,pir_ndx(5)) = (2.6e-3_r8 * tp(:)**8.5_r8) * exp_fac(:)
+ rxt(:,k,pir_ndx(6)) = 3.6e-27_r8 * tp(:)**8.1_r8
+
+ call comp_exp( exp_fac, -9000._r8 * tinv, ncol )
+ rxt(:,k,pir_ndx(7)) = (1.5e-1_r8 * tp(:)**9.1_r8) * exp_fac(:)
+ rxt(:,k,pir_ndx(8)) = 4.6e-28_r8 * tp(:)**14._r8
+
+ call comp_exp( exp_fac, -6400._r8 * tinv, ncol )
+ rxt(:,k,pir_ndx(9)) = (1.7e-3_r8 * tp(:)**15._r8) * exp_fac(:)
+ rxt(:,k,pir_ndx(10)) = 1.35e-28_r8 * tp(:)**2.83_r8
+
+ rxt(:,k,pir_ndx(11)) = 1.e-27_r8 * (308._r8 * tinv(:))**4.7_r8
+ rxt(:,k,pir_ndx(12)) = rxt(:,k,pir_ndx(11))
+ rxt(:,k,pir_ndx(13)) = 1.4e-29_r8 * tp(:)**4._r8
+
+ call comp_exp( exp_fac, -3872._r8 * tinv, ncol )
+ rxt(:,k,pir_ndx(14)) = (3.4e-7_r8 * tp(:)**5._r8) * exp_fac(:)
+
+ rxt(:,k,pir_ndx(15)) = 3.0e-31_r8 * tp(:)**4.3_r8
+ call comp_exp( exp_fac, -2093._r8 * tinv, ncol )
+ rxt(:,k,pir_ndx(16)) = (1.5e-8_r8 * tp(:)**4.3_r8) * exp_fac(:)
+
+ rxt(:,k,edn_ndx(1)) = 3.1e-10_r8 * tp(:)**0.83_r8
+ call comp_exp( exp_fac, -4990._r8 * tinv, ncol )
+ rxt(:,k,edn_ndx(2)) = (1.9e-12_r8 * tp(:)**(-1.5_r8)) * exp_fac(:)
+
+ rxt(:,k,nir_ndx(1)) = 1.05e-12_r8 * tp(:)**2.15_r8
+ rxt(:,k,nir_ndx(2)) = 2.5e-11_r8 * tp(:)**0.79_r8
+ rxt(:,k,nir_ndx(3)) = 7.5e-11_r8 * tp(:)**0.79_r8
+ rxt(:,k,nir_ndx(4)) = rxt(:,k,nir_ndx(1))
+ rxt(:,k,nir_ndx(5)) = 1.3e-11_r8 * tp(:)**1.64_r8
+ rxt(:,k,nir_ndx(6)) = 3.3e-11_r8 * tp(:)**2.38_r8
+
+ call comp_exp( exp_fac, -7300_r8 * tinv, ncol )
+ rxt(:,k,nir_ndx(7)) = (1.0e-3_r8 * tp(:)) * exp_fac(:)
+ call comp_exp( exp_fac, -7050_r8 * tinv, ncol )
+ rxt(:,k,nir_ndx(8)) = (7.2e-4_r8 * tp(:)) * exp_fac(:)
+ call comp_exp( exp_fac, -6800_r8 * tinv, ncol )
+ rxt(:,k,nir_ndx(9)) = (6.5e-3_r8 * tp(:)) * exp_fac(:)
+ call comp_exp( exp_fac, -7600_r8 * tinv, ncol )
+ rxt(:,k,nir_ndx(10)) = (5.7e-4_r8 * tp(:)) * exp_fac(:)
+
+ call comp_exp( exp_fac, -7150_r8 * tinv, ncol )
+ rxt(:,k,nir_ndx(11)) = (1.5e-2_r8 * tp(:)) * exp_fac(:)
+
+ call comp_exp( exp_fac, -13130_r8 * tinv, ncol )
+ rxt(:,k,nir_ndx(12)) = (6.0e-3_r8 * tp(:)) * exp_fac(:)
+ rxt(:,k,nir_ndx(13)) = 5.22e-28_r8 * tp(:)**2.62_r8
+
+ rxt(:,k,iira_ndx(1)) = 6.0e-8_r8 * tp(:)**.5_r8
+ do i = 2,niira
+ rxt(:,k,iira_ndx(i)) = rxt(:,k,iira_ndx(i-1))
+ enddo
+
+ rxt(:,k,iirb_ndx(1)) = 1.25e-25_r8 * tp(:)**4._r8
+ do i = 2,niirb
+ rxt(:,k,iirb_ndx(i)) = rxt(:,k,iirb_ndx(i-1))
+ enddo
+
+ call comp_exp( exp_fac, -6600._r8 * tinv, ncol )
+ rxt(:,k,usr_clm_h2o_m_ndx) = 2.e-8_r8 * exp_fac(:)
+
+ call comp_exp( exp_fac, -11926._r8 * tinv, ncol )
+ rxt(:,k,usr_clm_hcl_m_ndx) = tinv(:) * exp_fac(:)
+
+ endif
+ end do level_loop
+
+!-----------------------------------------------------------------
+! ... the ionic rates
+!-----------------------------------------------------------------
+ if ( has_ion_rxts ) then
+ level_loop2 : do k = 1,pver
+ tp(:ncol) = (2._r8*tempi(:ncol,k) + temp(:ncol,k)) / ( 3._r8 * t0 )
+ tp(:) = max( min( tp(:),20._r8 ),1._r8 )
+ rxt(:,k,ion1_ndx) = 2.82e-11_r8 + tp(:)*(-7.74e-12_r8 + tp(:)*(1.073e-12_r8 &
+ + tp(:)*(-5.17e-14_r8 + 9.65e-16_r8*tp(:))))
+ tp(:ncol) = (.6363_r8*tempi(:ncol,k) + .3637_r8*temp(:ncol,k)) / t0
+ tp(:) = max( min( tp(:),trlim2 ),1._r8 )
+ rxt(:,k,ion2_ndx) = 1.533e-12_r8 + tp(:)*(-5.92e-13_r8 + tp(:)*8.6e-14_r8)
+ tp(:ncol) = 2._r8 * t0 /(tempi(:ncol,k) + temp(:ncol,k))
+ where( tp(:ncol) < trlim3 )
+ rxt(:,k,ion3_ndx) = 1.4e-10_r8 * tp(:)**.44_r8
+ rxt(:,k,ion11_ndx) = 1.e-11_r8 * tp(:)**.23_r8
+ elsewhere
+ rxt(:,k,ion3_ndx) = 5.2e-11_r8 / tp(:)**.2_r8
+ rxt(:,k,ion11_ndx) = 3.6e-12_r8 / tp(:)**.41_r8
+ end where
+ tp(:ncol) = t0 / tempe(:ncol,k)
+ rxt(:,k,elec1_ndx) = 4.e-7_r8 * tp(:)**.85_r8
+ rxt(:,k,elec3_ndx) = 1.8e-7_r8 * tp(:)**.39_r8
+ where( tp(:ncol) < 4._r8 )
+ rxt(:,k,elec2_ndx) = 2.7e-7_r8 * tp(:)**.7_r8
+ elsewhere
+ rxt(:,k,elec2_ndx) = 1.6e-7_r8 * tp(:)**.55_r8
+ end where
+ end do level_loop2
+ endif
+
+ ! quenching of O+(2P) and O+(2D) by e to produce O+
+ ! See TABLE 1 of Roble (1995)
+ ! drm 2015-07-27
+ if (elec4_ndx > 0 .and. elec5_ndx > 0 .and. elec6_ndx > 0) then
+ do k=1,pver
+ tp(:ncol) = sqrt(300._r8 / tempe(:ncol,k))
+ rxt(:,k,elec4_ndx) = 1.5e-7_r8 * tp(:)
+ rxt(:,k,elec5_ndx) = 4.0e-8_r8 * tp(:)
+ rxt(:,k,elec6_ndx) = 6.6e-8_r8 * tp(:)
+ end do
+ endif
+
+!-----------------------------------------------------------------
+! ... tropospheric "aerosol" rate constants
+!-----------------------------------------------------------------
+ if ( het1_ndx > 0 .AND. (.NOT. usr_N2O5_aer_ndx > 0) ) then
+ amas = 4._r8*pi*rm1**3*den/3._r8 ! each mean particle(r=0.1u) mass (g)
+ do k = 1,pver
+!-------------------------------------------------------------------------
+! ... estimate humidity effect on aerosols (from Shettle and Fenn, 1979)
+! xr is a factor of the increase aerosol radii with hum (hum=0., factor=1)
+!-------------------------------------------------------------------------
+ xr(:) = .999151_r8 + relhum(:ncol,k)*(1.90445_r8 + relhum(:ncol,k)*(-6.35204_r8 + relhum(:ncol,k)*5.32061_r8))
+!-------------------------------------------------------------------------
+! ... estimate sulfate particles surface area (cm2/cm3) in each grid
+!-------------------------------------------------------------------------
+ if ( carma_hetchem_feedback ) then
+ sur(:ncol) = strato_sad(:ncol,k)
+ else
+ sur(:) = sulfate(:,k)*m(:,k)/avo*wso4 & ! xform mixing ratio to g/cm3
+ / amas & ! xform g/cm3 to num particels/cm3
+ * fare & ! xform num particels/cm3 to cm2/cm3
+ * xr(:)*xr(:) ! humidity factor
+ endif
+!-----------------------------------------------------------------
+! ... compute the "aerosol" reaction rates
+!-----------------------------------------------------------------
+! k = gam * A * velo/4
+!
+! where velo = sqrt[ 8*bk*T/pi/(w/av) ]
+! bk = 1.381e-16
+! av = 6.02e23
+! w = 108 (n2o5) HO2(33) CH2O (30) NH3(15)
+!
+! so that velo = 1.40e3*sqrt(T) (n2o5) gama=0.1
+! so that velo = 2.53e3*sqrt(T) (HO2) gama>0.2
+! so that velo = 2.65e3*sqrt(T) (CH2O) gama>0.022
+! so that velo = 3.75e3*sqrt(T) (NH3) gama=0.4
+!--------------------------------------------------------
+!-----------------------------------------------------------------
+! ... use this n2o5 -> 2*hno3 only in tropopause
+!-----------------------------------------------------------------
+ rxt(:,k,het1_ndx) = rxt(:,k,het1_ndx) &
+ +.25_r8 * gam1 * sur(:) * 1.40e3_r8 * sqrt( temp(:ncol,k) )
+ end do
+ end if
+
+!lke++
+!-----------------------------------------------------------------
+! ... CO tags
+!-----------------------------------------------------------------
+ if( usr_CO_OH_b_ndx > 0 ) then
+ if( usr_COhc_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_COhc_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_COme_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_COme_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO01_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO01_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO02_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO02_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO03_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO03_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO04_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO04_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO05_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO05_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO06_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO06_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO07_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO07_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO08_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO08_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO09_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO09_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO10_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO10_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO11_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO11_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO12_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO12_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO13_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO13_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO14_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO14_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO15_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO15_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO16_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO16_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO17_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO17_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO18_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO18_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO19_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO19_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO20_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO20_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO21_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO21_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO22_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO22_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO23_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO23_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO24_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO24_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO25_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO25_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO26_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO26_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO27_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO27_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO28_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO28_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO29_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO29_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO30_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO30_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO31_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO31_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO32_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO32_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO33_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO33_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO34_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO34_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO35_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO35_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO36_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO36_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO37_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO37_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO38_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO38_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO39_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO39_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO40_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO40_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO41_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO41_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ if( usr_CO42_OH_ndx > 0 ) then
+ rxt(:ncol,:,usr_CO42_OH_ndx) = rxt(:ncol,:,usr_CO_OH_b_ndx)
+ end if
+ end if
+!lke--
+!
+! jfl : additional BAM removal reactions. Zero out below the tropopause
+!
+ do l=1,num_strat_tau
+!
+ if ( usr_strat_tau_ndx(l) > 0 ) then
+ do i=1,ncol
+ rxt(i,tropchemlev(i)+1:pver,usr_strat_tau_ndx(l)) = 0._r8
+ end do
+ end if
+!
+ end do
+!
+
+ deallocate( sfc_array, dm_array )
+
+ end subroutine usrrxt
+
+ subroutine usrrxt_hrates( rxt, tempn, tempi, tempe, &
+ h2ovmr, m, ncol, kbot )
+!-----------------------------------------------------------------
+! ... set the user specified reaction rates for heating
+!-----------------------------------------------------------------
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : rxntot
+ use ppgrid, only : pver, pcols
+
+ implicit none
+
+!-----------------------------------------------------------------
+! ... dummy arguments
+!-----------------------------------------------------------------
+ integer, intent(in) :: ncol ! number columns in chunk
+ integer, intent(in) :: kbot ! heating levels
+ real(r8), intent(in) :: tempn(pcols,pver) ! neutral temperature (K)
+ real(r8), intent(in) :: tempi(pcols,pver) ! ion temperature (K)
+ real(r8), intent(in) :: tempe(pcols,pver) ! electron temperature (K)
+ real(r8), intent(in) :: m(ncol,pver) ! total atm density (1/cm^3)
+ real(r8), intent(in) :: h2ovmr(ncol,pver) ! water vapor (vmr)
+ real(r8), intent(inout) :: rxt(ncol,pver,rxntot) ! gas phase rates
+
+!-----------------------------------------------------------------
+! ... local variables
+!-----------------------------------------------------------------
+
+ integer :: k
+ real(r8), dimension(ncol) :: &
+ tp, &
+ tinv, &
+ ko, &
+ kinf, &
+ fc
+
+!-----------------------------------------------------------------
+! ... o + o2 + m --> o3 + m
+!-----------------------------------------------------------------
+ do k = 1,kbot
+ tinv(:ncol) = 1._r8 / tempn(:ncol,k)
+ tp(:) = 300._r8 * tinv(:)
+ rxt(:,k,usr_O_O2_ndx) = 6.e-34_r8 * tp(:)**2.4_r8
+
+!-----------------------------------------------------------------
+! ... o + o + m -> o2 + m
+!-----------------------------------------------------------------
+ rxt(:,k,usr_O_O_ndx) = 2.76e-34_r8 * exp( 720.0_r8*tinv(:) )
+
+!-----------------------------------------------------------------
+! ... ho2 + ho2 --> h2o2
+! Note: this rate involves the water vapor number density
+!-----------------------------------------------------------------
+ ko(:) = 3.0e-13_r8 * exp( 460._r8*tinv(:) )
+ kinf(:) = 2.1e-33_r8 * m(:,k) * exp( 920._r8*tinv(:) )
+ fc(:) = 1._r8 + 1.4e-21_r8 * m(:,k) * h2ovmr(:,k) * exp( 2200._r8*tinv(:) )
+ rxt(:,k,usr_HO2_HO2_ndx) = (ko(:) + kinf(:)) * fc(:)
+
+ end do
+
+!-----------------------------------------------------------------
+! ... the ionic rates
+!-----------------------------------------------------------------
+ if ( has_ion_rxts ) then
+ level_loop2 : do k = 1,kbot
+ tp(:ncol) = (2._r8*tempi(:ncol,k) + tempn(:ncol,k)) / ( 3._r8 * t0 )
+ tp(:) = max( min( tp(:),20._r8 ),1._r8 )
+ rxt(:,k,ion1_ndx) = 2.82e-11_r8 + tp(:)*(-7.74e-12_r8 + tp(:)*(1.073e-12_r8 &
+ + tp(:)*(-5.17e-14_r8 + 9.65e-16_r8*tp(:))))
+ tp(:ncol) = (.6363_r8*tempi(:ncol,k) + .3637_r8*tempn(:ncol,k)) / t0
+ tp(:) = max( min( tp(:),trlim2 ),1._r8 )
+ rxt(:,k,ion2_ndx) = 1.533e-12_r8 + tp(:)*(-5.92e-13_r8 + tp(:)*8.6e-14_r8)
+ tp(:ncol) = 2._r8 * t0 /(tempi(:ncol,k) + tempn(:ncol,k))
+ where( tp(:ncol) < trlim3 )
+ rxt(:,k,ion3_ndx) = 1.4e-10_r8 * tp(:)**.44_r8
+ elsewhere
+ rxt(:,k,ion3_ndx) = 5.2e-11_r8 / tp(:)**.2_r8
+ endwhere
+ tp(:ncol) = t0 / tempe(:ncol,k)
+ rxt(:,k,elec1_ndx) = 4.e-7_r8 * tp(:)**.85_r8
+ rxt(:,k,elec3_ndx) = 1.8e-7_r8 * tp(:)**.39_r8
+ where( tp(:ncol) < 4._r8 )
+ rxt(:,k,elec2_ndx) = 2.7e-7_r8 * tp(:)**.7_r8
+ elsewhere
+ rxt(:,k,elec2_ndx) = 1.6e-7_r8 * tp(:)**.55_r8
+ endwhere
+ end do level_loop2
+ endif
+ end subroutine usrrxt_hrates
+
+!-------------------------------------------------------------------------
+!-------------------------------------------------------------------------
+ subroutine comp_exp( x, y, n )
+
+ implicit none
+
+ real(r8), intent(out) :: x(:)
+ real(r8), intent(in) :: y(:)
+ integer, intent(in) :: n
+
+#ifdef IBM
+ call vexp( x, y, n )
+#else
+ x(:n) = exp( y(:n) )
+#endif
+
+ end subroutine comp_exp
+
+ !-------------------------------------------------------------------------
+ ! Heterogeneous reaction rates for uptake of a gas on an aerosol:
+ !-------------------------------------------------------------------------
+ function hetrxtrate( sfc, dm_aer, dg_gas, c_gas, gamma_gas ) result(rate)
+
+ real(r8), intent(in) :: sfc(:)
+ real(r8), intent(in) :: dm_aer(:)
+ real(r8), intent(in) :: dg_gas
+ real(r8), intent(in) :: c_gas
+ real(r8), intent(in) :: gamma_gas
+ real(r8) :: rate
+
+ real(r8),allocatable :: rxt(:)
+ integer :: n, i
+
+ n = size(sfc)
+
+ allocate(rxt(n))
+ do i=1,n
+ rxt(i) = sfc(i) / (0.5_r8*dm_aer(i)/dg_gas + (4._r8/(c_gas*gamma_gas)))
+ enddo
+
+ rate = sum(rxt)
+
+ deallocate(rxt)
+
+ endfunction hetrxtrate
+
+ !-------------------------------------------------------------------------
+ ! Heterogeneous reaction rates for uptake of a glyoxal gas on an aerosol:
+ !-------------------------------------------------------------------------
+ function hetrxtrate_gly( sfc, c_gas, gamma_gas ) result(rate)
+
+ real(r8), intent(in) :: sfc(:)
+ real(r8), intent(in) :: c_gas
+ real(r8), intent(in) :: gamma_gas
+ real(r8) :: rate
+
+ real(r8),allocatable :: rxt(:)
+ integer :: n, i
+
+ n = size(sfc)
+
+ allocate(rxt(n))
+ do i=1,n
+ rxt(i) = 0.25_r8 * c_gas * sfc(i) * gamma_gas
+ enddo
+
+ rate = sum(rxt)
+
+ deallocate(rxt)
+
+ endfunction hetrxtrate_gly
+
+
+end module mo_usrrxt
diff --git a/src/chemistry/oslo_aero/modal_aero_data.F90 b/src/chemistry/oslo_aero/modal_aero_data.F90
new file mode 100644
index 0000000000..e62b884de7
--- /dev/null
+++ b/src/chemistry/oslo_aero/modal_aero_data.F90
@@ -0,0 +1,64 @@
+ module modal_aero_data
+
+!--------------------------------------------------------------
+! ... Basic aerosol mode parameters and arrays
+!--------------------------------------------------------------
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use constituents, only: pcnst
+ use radconstants, only: nswbands, nlwbands
+
+ implicit none
+ save
+
+ integer, parameter :: ntot_amode = 0
+
+ integer, private :: qqcw(pcnst)=-1 ! Remaps modal_aero indices into pbuf
+
+ contains
+
+ subroutine qqcw_set_ptr(index, iptr)
+ use cam_abortutils, only : endrun
+
+
+ integer, intent(in) :: index, iptr
+
+ if(index>0 .and. index <= pcnst ) then
+ qqcw(index)=iptr
+ else
+ call endrun('qqcw_set_ptr: attempting to set qqcw pointer already defined')
+ end if
+ end subroutine qqcw_set_ptr
+
+!--------------------------------------------------------------
+!--------------------------------------------------------------
+ function qqcw_get_field(pbuf, index, lchnk, errorhandle)
+ use cam_abortutils, only : endrun
+ use physics_buffer, only : physics_buffer_desc, pbuf_get_field
+
+ integer, intent(in) :: index, lchnk
+ real(r8), pointer :: qqcw_get_field(:,:)
+ logical, optional :: errorhandle
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ logical :: error
+
+ nullify(qqcw_get_field)
+ error = .false.
+ if (index>0 .and. index <= pcnst) then
+ if (qqcw(index)>0) then
+ call pbuf_get_field(pbuf, qqcw(index), qqcw_get_field)
+ else
+ error = .true.
+ endif
+ else
+ error = .true.
+ end if
+
+ if (error .and. .not. present(errorhandle)) then
+ call endrun('qqcw_get_field: attempt to access undefined qqcw')
+ end if
+
+ end function qqcw_get_field
+
+ end module modal_aero_data
+
diff --git a/src/chemistry/oslo_aero/modal_aero_deposition.F90 b/src/chemistry/oslo_aero/modal_aero_deposition.F90
new file mode 100644
index 0000000000..75b0263cf4
--- /dev/null
+++ b/src/chemistry/oslo_aero/modal_aero_deposition.F90
@@ -0,0 +1,215 @@
+module modal_aero_deposition
+
+!------------------------------------------------------------------------------------------------
+! Purpose:
+!
+! Partition the contributions from modal components of wet and dry
+! deposition at the surface into the fields passed to the coupler.
+!
+! *** N.B. *** Currently only a simple scheme for the 3-mode version
+! of MAM has been implemented.
+!
+! Revision history:
+! Feb 2009 M. Flanner, B. Eaton Original version for trop_mam3.
+! Jul 2011 F Vitt -- made avaliable to be used in a prescribed modal aerosol mode (no prognostic MAM)
+! Mar 2012 F Vitt -- made changes for to prevent abort when 7-mode aeroslol model is used
+! some of the needed consituents do not exist in 7-mode so bin_fluxes will be false
+! May 2014 F Vitt -- included contributions from MAM4 aerosols and added soa_a2 to the ocphiwet fluxes
+!------------------------------------------------------------------------------------------------
+
+use shr_kind_mod, only: r8 => shr_kind_r8
+use camsrfexch, only: cam_out_t
+use constituents, only: cnst_get_ind, pcnst
+use cam_abortutils, only: endrun
+use rad_constituents, only: rad_cnst_get_info
+use aerosoldef, only: l_bc_n,l_bc_ax,l_bc_ni,l_bc_a,l_bc_ai,l_bc_ac
+use aerosoldef, only: l_om_ni,l_om_ai,l_om_ac,l_dst_a2,l_dst_a3
+
+implicit none
+private
+save
+
+public :: &
+ modal_aero_deposition_init, &
+ set_srf_drydep, &
+ set_srf_wetdep
+
+! Private module data
+
+logical :: initialized = .false.
+integer :: bcphi_ndx( pcnst ) = -1
+integer :: bcpho_ndx( pcnst ) = -1
+integer :: ocphi_ndx( pcnst ) = -1
+integer :: ocpho_ndx( pcnst ) = -1
+integer :: crse_dust_ndx( pcnst ) = -1
+integer :: fine_dust_ndx( pcnst ) = -1
+integer :: bcphi_cnt = 0
+integer :: ocphi_cnt = 0
+integer :: bcpho_cnt = 0
+integer :: ocpho_cnt = 0
+integer :: crse_dust_cnt = 0
+integer :: fine_dust_cnt = 0
+
+!==============================================================================
+contains
+!==============================================================================
+
+subroutine modal_aero_deposition_init( bcphi_indices, bcpho_indices, ocphi_indices, &
+ ocpho_indices, fine_dust_indices, crse_dust_indices )
+
+ ! set aerosol indices for re-mapping surface deposition fluxes:
+ ! *_a1 = accumulation mode
+ ! *_a2 = aitken mode
+ ! *_a3 = coarse mode
+
+ ! can be initialized with user specified indices
+ ! if called from aerodep_flx module (for prescribed modal aerosol fluxes) then these indices are specified
+ integer, optional, intent(in) :: bcphi_indices(:) ! hydrophilic black carbon
+ integer, optional, intent(in) :: bcpho_indices(:) ! hydrophobic black carbon
+ integer, optional, intent(in) :: ocphi_indices(:) ! hydrophilic organic carbon
+ integer, optional, intent(in) :: ocpho_indices(:) ! hydrophobic organic carbon
+ integer, optional, intent(in) :: fine_dust_indices(:) ! fine dust
+ integer, optional, intent(in) :: crse_dust_indices(:) ! coarse dust
+
+ ! local vars
+ integer :: i, pcnt, scnt
+
+ character(len=16), parameter :: fine_dust_modes(2) = (/ 'accum ', 'fine_dust '/)
+ character(len=16), parameter :: crse_dust_modes(2) = (/ 'coarse ', 'coarse_dust '/)
+ character(len=16), parameter :: hydrophilic_carbon_modes(1) = (/'accum '/)
+ character(len=16), parameter :: hydrophobic_carbon_modes(3) = (/'aitken ', 'coarse ', 'primary_carbon '/)
+
+ ! if already initialized abort the run
+ if (initialized) then
+ call endrun('modal_aero_deposition is already initialized')
+ endif
+
+
+ initialized = .true.
+
+end subroutine modal_aero_deposition_init
+
+!==============================================================================
+subroutine set_srf_wetdep(aerdepwetis, aerdepwetcw, cam_out)
+
+! Set surface wet deposition fluxes passed to coupler.
+
+ ! Arguments:
+ real(r8), intent(in) :: aerdepwetis(:,:) ! aerosol wet deposition (interstitial)
+ real(r8), intent(in) :: aerdepwetcw(:,:) ! aerosol wet deposition (cloud water)
+ type(cam_out_t), intent(inout) :: cam_out ! cam export state
+
+ ! Local variables:
+ integer :: i, ispec, idx
+ integer :: ncol ! number of columns
+
+ real(r8) :: bcphiwet_sum, ocphiwet_sum
+ !----------------------------------------------------------------------------
+
+ if (.not.initialized) call endrun('set_srf_wetdep: modal_aero_deposition has not been initialized')
+
+ ncol = cam_out%ncol
+
+ cam_out%bcphiwet(:) = 0._r8
+ cam_out%ocphiwet(:) = 0._r8
+
+ ! derive cam_out variables from deposition fluxes
+ ! note: wet deposition fluxes are negative into surface,
+ ! dry deposition fluxes are positive into surface.
+ ! srf models want positive definite fluxes.
+ do i = 1, ncol
+
+ ! black carbon fluxes
+ ! djlo : added bc_n and bc_ax contribution
+ ! djlo : bc_ax is assumed not to exist in cloud water
+ cam_out%bcphiwet(i) = -(aerdepwetis(i,l_bc_ni)+aerdepwetcw(i,l_bc_ni)+ &
+ aerdepwetis(i,l_bc_ai)+aerdepwetcw(i,l_bc_ai)+ &
+ aerdepwetis(i,l_bc_a )+aerdepwetcw(i,l_bc_a )+ &
+ aerdepwetis(i,l_bc_ac)+aerdepwetcw(i,l_bc_ac)+ &
+ aerdepwetis(i,l_bc_n )+aerdepwetcw(i,l_bc_n )+ &
+ aerdepwetis(i,l_bc_ax))
+
+ ! organic carbon fluxes
+ cam_out%ocphiwet(i) = -(aerdepwetis(i,l_om_ni)+aerdepwetcw(i,l_om_ni)+ &
+ aerdepwetis(i,l_om_ai)+aerdepwetcw(i,l_om_ai)+ &
+ aerdepwetis(i,l_om_ac)+aerdepwetcw(i,l_om_ac))
+
+ ! dust fluxes
+ !
+ ! bulk bin1 (fine) dust deposition equals accumulation mode deposition:
+ cam_out%dstwet1(i) = -(aerdepwetis(i,l_dst_a2)+aerdepwetcw(i,l_dst_a2))
+
+ ! A. Simple: Assign all coarse-mode dust to bulk size bin 3:
+ cam_out%dstwet2(i) = 0._r8
+ cam_out%dstwet3(i) = -(aerdepwetis(i,l_dst_a3)+aerdepwetcw(i,l_dst_a3))
+ cam_out%dstwet4(i) = 0._r8
+
+ enddo
+
+end subroutine set_srf_wetdep
+
+!==============================================================================
+
+subroutine set_srf_drydep(aerdepdryis, aerdepdrycw, cam_out)
+
+! Set surface dry deposition fluxes passed to coupler.
+
+ ! Arguments:
+ real(r8), intent(in) :: aerdepdryis(:,:) ! aerosol dry deposition (interstitial)
+ real(r8), intent(in) :: aerdepdrycw(:,:) ! aerosol dry deposition (cloud water)
+ type(cam_out_t), intent(inout) :: cam_out ! cam export state
+
+ ! Local variables:
+ integer :: i, ispec, idx
+ integer :: ncol ! number of columns
+ real(r8):: bcphidry_sum, ocphidry_sum, ocphodry_sum
+ !----------------------------------------------------------------------------
+
+ if (.not.initialized) call endrun('set_srf_drydep: modal_aero_deposition has not been initialized')
+
+ ncol = cam_out%ncol
+
+ cam_out%bcphidry(:) = 0._r8
+ cam_out%bcphodry(:) = 0._r8
+ cam_out%ocphidry(:) = 0._r8
+ cam_out%ocphodry(:) = 0._r8
+
+ ! derive cam_out variables from deposition fluxes
+ ! note: wet deposition fluxes are negative into surface,
+ ! dry deposition fluxes are positive into surface.
+ ! srf models want positive definite fluxes.
+ do i = 1, ncol
+ ! black carbon fluxes
+ cam_out%bcphidry(i) = aerdepdryis(i,l_bc_ni)+aerdepdrycw(i,l_bc_ni)+ &
+ aerdepdryis(i,l_bc_ai)+aerdepdrycw(i,l_bc_ai)+ &
+ aerdepdryis(i,l_bc_a )+aerdepdrycw(i,l_bc_a )+ &
+ aerdepdryis(i,l_bc_ac)+aerdepdrycw(i,l_bc_ac)
+ cam_out%bcphodry(i) = aerdepdryis(i,l_bc_n )+aerdepdrycw(i,l_bc_n )+ &
+ aerdepdryis(i,l_bc_ax)+aerdepdrycw(i,l_bc_ax)
+
+ ! organic carbon fluxes
+ ! djlo : skipped the bc_a contribution (was about om !)
+ cam_out%ocphidry(i) = aerdepdryis(i,l_om_ni)+aerdepdrycw(i,l_om_ni)+ &
+ aerdepdryis(i,l_om_ai)+aerdepdrycw(i,l_om_ai)+ &
+ aerdepdryis(i,l_om_ac)+aerdepdrycw(i,l_om_ac)
+ cam_out%ocphidry(i) = 0._r8 !aerdepdryis(i,idx_pom1)+aerdepdryis(i,idx_soa1)+aerdepdrycw(i,idx_pom1)+aerdepdrycw(i,idx_soa1)
+ cam_out%ocphodry(i) = 0._r8 !aerdepdryis(i,idx_soa2)+aerdepdrycw(i,idx_soa2)
+
+ ! dust fluxes
+ !
+ ! bulk bin1 (fine) dust deposition equals accumulation mode deposition:
+ cam_out%dstdry1(i) = aerdepdryis(i,l_dst_a2)+aerdepdrycw(i,l_dst_a2)
+
+ ! Two options for partitioning deposition into bins 2-4:
+ ! A. Simple: Assign all coarse-mode dust to bulk size bin 3:
+ cam_out%dstdry2(i) = 0._r8
+ cam_out%dstdry3(i) = aerdepdryis(i,l_dst_a3)+aerdepdrycw(i,l_dst_a3)
+ cam_out%dstdry4(i) = 0._r8
+ enddo
+
+end subroutine set_srf_drydep
+
+
+!==============================================================================
+
+end module modal_aero_deposition
diff --git a/src/chemistry/oslo_aero/modalapp2d.F90 b/src/chemistry/oslo_aero/modalapp2d.F90
new file mode 100644
index 0000000000..31a21aa3e5
--- /dev/null
+++ b/src/chemistry/oslo_aero/modalapp2d.F90
@@ -0,0 +1,169 @@
+module modalapp2d
+ public
+ save
+contains
+
+ subroutine modalapp2d_sub(ncol,Nnatkbg,Ca,f_c,f_bc,f_aq,f_so4_cond,f_soa,Cam,fcm,fbcm,faqm,fso4condm,fsoam)
+
+! Calculation of the apportionment of internally mixed SO4, BC and OC
+! mass between the various background mineral and sea-salt modes. Separated
+! from pmxsub into a independent subroutine by Alf Kirkevåg on September
+! 12'th, 2005, and converted to 2D for use in parmix on September 15'th.
+! Modified for new aerosol schemes by Alf Kirkevaag in January 2006: Now
+! also Aitken-modes are subject to condensation of H2SO4, and both n and
+! Aitken modes may coagulate onto the mineral/sea-salt background aerosol.
+!SOA
+! May 2013: The SO4(Ait) mode now takes into account condensed SOA in addition
+! to H2SO4, but as long as SOA is not allowed to condense on more than one
+! mode, no changes are necessary here. NB: to allow SOA to condense also on
+! the BC(Ait) and/or other modes, change this code accordingly! Without any
+! changes, Cam(pcols,1) = condensed SO4 onto the SO4(ait) mode still.
+!SOA
+! Alf Grini, february 2014 : Added info about units,
+! used values calculated at initialization.
+! changed in-out variables to components of derived data types (modedefs)
+! defined in microphysics_oslo.F90, and corrected for mass balance error
+! for SO4 due to lumping of coagulate and condensate.
+
+
+ use ppgrid, only : pcols, pver
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ use commondefinitions
+ use aerosoldef
+ use const, only: smallNumber
+ use koagsub, only: normalizedCoagulationSink
+ use condtend, only: normalizedCondensationSink, COND_VAP_H2SO4, COND_VAP_ORG_SV
+
+ implicit none
+!
+! Input arguments
+!
+ integer , intent(in) :: ncol ! number of columns used
+ real(r8), intent(in) :: Nnatkbg(pcols,pver,nbmodes) ! aerosol background mode number concentration #/m3
+ real(r8), intent(in) :: Ca(pcols,pver) ! internally mixed mass, tot=SO4+OC+BC
+ real(r8), intent(in) :: f_c(pcols,pver) ! mass fraction (OC+BC)/tot
+ real(r8), intent(in) :: f_bc(pcols,pver) ! mass fraction BC/(OC+BC)
+ real(r8), intent(in) :: f_aq(pcols,pver) ! mass fraction SO4(aq)/SO4
+ real(r8), intent(in) :: f_soa(pcols,pver) ! mass fraction SOA/(POM+SOA)
+ real(r8), intent(in) :: f_so4_cond(pcols,pver) ! mass fraction SO4_COND/(COND+COAG)
+ !
+ ! Output arguments
+ !
+ real(r8), intent(out) :: Cam(pcols,pver,nbmodes) ! modal internal mass, tot=SO4+BC+OC
+ real(r8), intent(out) :: fcm(pcols,pver,nbmodes) ! modal mass fraction (OC+BC)/tot
+ real(r8), intent(out) :: fbcm(pcols,pver,nbmodes) ! modal mass fraction BC/(OC+BC)
+ real(r8), intent(out) :: faqm(pcols,pver,nbmodes) ! modal mass fraction SO4(aq)/SO4
+ real(r8), intent(out) :: fso4condm(pcols,pver,nbmodes) !modal mass fraction (SO4(cond)/SO4(cond+coag))
+ real(r8), intent(out) :: fsoam(pcols,pver,nbmodes)! modal mass fraction SOA / (POM+SOA)
+
+ !
+ ! Local variables
+ real(r8) condensationSinkSO4(pcols,pver,nbmodes) ![1/s] loss rate of cond. vap on any mode
+ real(r8) condensationSinkOA(pcols,pver,nbmodes) ![1/s] loss rate of cond. vap on any mode
+ real(r8) coagulationSink(pcols,pver,nbmodes) ![1/s] loss rate of BC through coagulation on any mode
+ real(r8) aquousPhaseSink(pcols,pver,nbmodes) ![-] fraction of particles available for aq. phase in any mode
+
+ real(r8) sumCondensationSinkSO4(pcols,pver) ![1/s] sum condensation sink to all modes
+ real(r8) sumCondensationSinkOA(pcols,pver) ![1/s] sum condensation sink to all modes
+ real(r8) sumCoagulationSink(pcols,pver) ![1/s] sum coagulation sink to all modes
+ real(r8) sumAquousPhaseSink(pcols,pver) ![1/s] sum aquous phase sink to all modes
+
+ real(r8) fcondkSO4(pcols,pver,nbmodes)
+ real(r8) fcondkOA(pcols,pver,nbmodes)
+ real(r8) fcoagk(pcols,pver,nbmodes)
+ real(r8) faqk(pcols,pver,nbmodes)
+
+ real(r8) cabck(pcols,pver,nbmodes) ![kg/m3] bc distributed to each mode
+ real(r8) caock(pcols,pver,nbmodes) ![kg/m3] pom coagulate distributed to each mode
+ real(r8) csoacondsk(pcols,pver,nbmodes)
+ real(r8) caqsk(pcols,pver,nbmodes) ![kg/m3] aq phase sulfate distributed to each mode
+ real(r8) cso4condsk(pcols,pver,nbmodes) ![kg/m3] non-aq sulfate condensate distributed to each mode
+ real(r8) cso4coagsk(pcols,pver,nbmodes) ![kg/m3] non-aq sulfate coagulate distributed to each mode
+ real(r8) cso4condcoagsk(pcols,pver,nbmodes) ![kg/m3] non-aq sulfate condensate distributed to each mode
+ real(r8) coccondcoagsk(pcols,pver,nbmodes) ![kg/m3] non-aq sulfate coagulate distributed to each mode
+
+ integer :: i !counter for modes
+ integer :: k !counter for levels
+
+ !Find the sink on any mode (0 is omitted here, WHY??, it does receive matter in koagsub/condtend!!))
+ !Should either remove it from there or add something to it here!
+ do i=1,nbmodes
+ do k=1,pver
+ condensationSinkSO4(:ncol,k,i) = normalizedCondensationSink(i,COND_VAP_H2SO4)*Nnatkbg(:ncol,k,i)
+ condensationSinkOA(:ncol,k,i) = normalizedCondensationSink(i,COND_VAP_ORG_SV)*Nnatkbg(:ncol,k,i)
+ coagulationSink(:ncol,k,i) = normalizedCoagulationSink(i,MODE_IDX_BC_NUC)*Nnatkbg(:ncol,k,i) !use a typical coagulator (BC_NUC)
+ aquousPhaseSink(:ncol,k,i) = numberFractionAvailableAqChem(i)*Nnatkbg(:ncol,k,i) !aq phase sink to this mode
+ end do
+ enddo
+
+ !Sum the sinks
+ sumCondensationSinkSO4(:,:) = 0.0_r8
+ sumCondensationSinkOA(:,:) = 0.0_r8
+ sumCoagulationSink(:,:) = 0.0_r8
+ sumAquousPhaseSink(:,:) = 0.0_r8
+ do i=1,nbmodes
+ do k=1,pver
+ sumCondensationSinkSO4(:ncol,k) = sumCondensationSinkSO4(:ncol,k) + condensationSinkSO4(:ncol,k,i)
+ sumCondensationSinkOA(:ncol,k) = sumCondensationSinkOA(:ncol,k) + condensationSinkOA(:ncol,k,i)
+ sumCoagulationSink(:ncol,k) = sumCoagulationSink(:ncol,k) + coagulationSink(:ncol,k,i)
+ sumAquousPhaseSink(:ncol,k) = sumAquousPhaseSink(:ncol,k) + aquousPhaseSink(:ncol,k,i)
+ end do
+ end do
+
+ ! And finally the contribution from each mode relative to the totals are calculated,
+ ! assuming that the apportionment of mass for the first iteration (in time) is representative
+ ! for the whole apportionment process (which is ok for small and moderate masses added):
+ do i=1,nbmodes
+ do k=1,pver
+ !Get the fraction of contribution per process per mode
+ fcondkSO4(:ncol,k,i)=condensationSinkSO4(:ncol,k,i)/(sumCondensationSinkSO4(:ncol,k)+1.e-100_r8) !fraction of condensation sink in this mode
+ fcondkOA(:ncol,k,i)=condensationSinkOA(:ncol,k,i)/(sumCondensationSinkOA(:ncol,k)+1.e-100_r8) !fraction of condensation sink in this mode
+ fcoagk(:ncol,k,i)=coagulationSink(:ncol,k,i)/(sumCoagulationSink(:ncol,k)+1.e-100_r8) !fraction of coagulation sink in this mode
+ faqk(:ncol,k,i)=aquousPhaseSink(:ncol,k,i)/(sumAquousPhaseSink(:ncol,k)+1.e-100_r8) !fraction of aquous phase sink in this mode
+
+ !BC coagulate to this mode [kg/m3]
+ cabck(:ncol,k,i)=fcoagk(:ncol,k,i)*f_c(:ncol,k)*f_bc(:ncol,k)*Ca(:ncol,k)
+
+ !OC coagulate to this mode [kg/m3]
+ caock(:ncol,k,i)=fcoagk(:ncol,k,i)*f_c(:ncol,k)*(1.0_r8-f_bc(:ncol,k))*(1.0_r8-f_soa(:ncol,k))*Ca(:ncol,k)
+
+ !SOA condensate to this mode [kg/m3]
+ csoacondsk(:ncol,k,i) = fcondkOA(:ncol,k,i)*f_c(:ncol,k)*(1.0_r8-f_bc(:ncol,k))*f_soa(:ncol,k)*Ca(:ncol,k)
+
+ !Aquous phase SO4 to this mode [kg/m3]
+ caqsk(:ncol,k,i)=faqk(:ncol,k,i)*f_aq(:ncol,k)*(1.0_r8-f_c(:ncol,k))*Ca(:ncol,k)
+
+ !so4 condensate
+ cso4condsk(:ncol,k,i)=fcondkSO4(:ncol,k,i)*(1.0_r8-f_aq(:ncol,k))*f_so4_cond(:ncol,k)*(1.0_r8-f_c(:ncol,k))*Ca(:ncol,k)
+
+ !soa coagulate
+ cso4coagsk(:ncol,k,i) = fcoagk(:ncol,k,i)*(1.0_r8-f_aq(:ncol,k))*(1.0_r8-f_so4_cond(:ncol,k))*(1.0_r8-f_c(:ncol,k))*Ca(:ncol,k) ![kg/m3] so4 coagulate
+ end do
+ enddo
+
+ !The tables take as input the combined coagulate and condensate (both POM and SOA)
+ !The activation needs them separately for mass balance!
+ cso4condcoagsk(:ncol,:,:) = cso4condsk(:ncol,:,:) + cso4coagsk(:ncol,:,:)
+ coccondcoagsk(:ncol,:,:) = caock(:ncol,:,:) + csoacondsk(:ncol,:,:)
+
+ do i=1,nbmodes
+ do k=1,pver
+ Cam(:ncol,k,i)= cabck(:ncol,k,i) & !BC
+ + coccondcoagsk(:ncol,k,i) & !OM
+ + caqsk(:ncol,k,i) + cso4condcoagsk(:ncol,k,i) + smallNumber!SO4 ==> !total process mode mass to mode i
+
+ fcm(:ncol,k,i)=(cabck(:ncol,k,i)+coccondcoagsk(:ncol,k,i))/(Cam(:ncol,k,i)+smallNumber) !fraction of mass being carbon (oc or bc)
+ fbcm(:ncol,k,i)=cabck(:ncol,k,i)/(cabck(:ncol,k,i)+coccondcoagsk(:ncol,k,i)+smallNumber) !fraction of carbon mass being bc
+ faqm(:ncol,k,i)=caqsk(:ncol,k,i)/(caqsk(:ncol,k,i)+cso4condcoagsk(:ncol,k,i)+smallNumber) !fraction of sulfate being aq phase
+
+ !Not needed for tables, but for mass balances in activation
+ fso4condm(:ncol,k,i) = cso4condsk(:ncol,k,i)/(cso4condcoagsk(:ncol,k,i) + smallNumber) !fraction of cond+coag which is coag
+ fsoam(:ncol,k,i) = csoacondsk(:ncol,k,i)/(coccondcoagsk(:ncol,k,i) + smallNumber) !fraction of OC which is SOA
+ end do
+ enddo
+
+ return
+end subroutine modalapp2d_sub
+
+end module modalapp2d
diff --git a/src/chemistry/oslo_aero/ndrop.F90 b/src/chemistry/oslo_aero/ndrop.F90
new file mode 100644
index 0000000000..2a372f946a
--- /dev/null
+++ b/src/chemistry/oslo_aero/ndrop.F90
@@ -0,0 +1,3143 @@
+module ndrop
+
+!---------------------------------------------------------------------------------
+! Purpose:
+! CAM Interface for droplet activation by modal aerosols
+!
+! ***N.B.*** This module is currently hardcoded to recognize only the modes that
+! affect the climate calculation. This is implemented by using list
+! index 0 in all the calls to rad_constituent interfaces.
+!---------------------------------------------------------------------------------
+
+use shr_kind_mod, only: r8 => shr_kind_r8
+use spmd_utils, only: masterproc
+use ppgrid, only: pcols, pver, pverp
+use physconst, only: pi, rhoh2o, mwh2o, r_universal, rh2o, &
+ gravit, latvap, cpair, epsilo, rair
+use constituents, only: pcnst, cnst_get_ind, cnst_name, cnst_spec_class_gas, cnst_species_class
+use physics_types, only: physics_state, physics_ptend, physics_ptend_init
+use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field
+
+use wv_saturation, only: qsat
+use phys_control, only: phys_getopts
+use ref_pres, only: top_lev => trop_cloud_top_lev
+use shr_spfn_mod, only: erf => shr_spfn_erf
+use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num, rad_cnst_get_aer_mmr, &
+ rad_cnst_get_aer_props, rad_cnst_get_mode_props, &
+ rad_cnst_get_mam_mmr_idx, rad_cnst_get_mode_num_idx
+use cam_history, only: addfld, add_default, horiz_only, fieldname_len, outfld
+use cam_abortutils, only: endrun
+use cam_logfile, only: iulog
+!++ MH_2015/09/09
+use phys_control, only: use_hetfrz_classnuc
+!-- MH_2015/09/09
+
+#ifdef OSLO_AERO
+!++oslo
+use aerosoldef
+use parmix_progncdnc
+use oslo_utils, only: calculateNumberMedianRadius
+!--oslo
+#endif
+
+
+implicit none
+private
+save
+
+public ndrop_init, dropmixnuc, activate_modal, loadaer
+
+#ifndef OSLO_AERO
+real(r8), allocatable :: alogsig(:) ! natl log of geometric standard dev of aerosol
+real(r8), allocatable :: exp45logsig(:)
+real(r8), allocatable, target :: f1(:) ! abdul-razzak functions of width
+real(r8), allocatable, target :: f2(:) ! abdul-razzak functions of width
+#endif
+
+real(r8) :: t0 ! reference temperature
+real(r8) :: aten
+real(r8) :: surften ! surface tension of water w/respect to air (N/m)
+real(r8) :: alog2, alog3, alogaten
+real(r8) :: third, twothird, sixth, zero
+real(r8) :: sq2, sqpi
+
+! CCN diagnostic fields
+!integer, parameter :: psat=6 ! number of supersaturations to calc ccn concentration
+!real(r8), parameter :: supersat(psat)= & ! supersaturation (%) to determine ccn concentration
+! (/ 0.02_r8, 0.05_r8, 0.1_r8, 0.2_r8, 0.5_r8, 1.0_r8 /)
+!character(len=8) :: ccn_name(psat)= &
+! (/'CCN1','CCN2','CCN3','CCN4','CCN5','CCN6'/)
+!akc6+
+integer, parameter :: psat=7 ! number of supersaturations to calc ccn concentration
+real(r8), parameter :: supersat(psat)= & ! supersaturation (%) to determine ccn concentration
+ (/ 0.02_r8, 0.05_r8, 0.1_r8, 0.15_r8, 0.2_r8, 0.5_r8, 1.0_r8 /)
+character(len=8) :: ccn_name(psat)= &
+ (/'CCN1','CCN2','CCN3','CCN4','CCN5','CCN6','CCN7'/)
+!akc6-
+
+! indices in state and pbuf structures
+integer :: numliq_idx = -1
+integer :: kvh_idx = -1
+
+! description of modal aerosols
+integer :: ntot_amode ! number of aerosol modes
+integer, allocatable :: nspec_amode(:) ! number of chemical species in each aerosol mode
+real(r8), allocatable :: sigmag_amode(:)! geometric standard deviation for each aerosol mode
+real(r8), allocatable :: dgnumlo_amode(:)
+real(r8), allocatable :: dgnumhi_amode(:)
+real(r8), allocatable :: voltonumblo_amode(:)
+real(r8), allocatable :: voltonumbhi_amode(:)
+
+logical :: history_aerosol ! Output the MAM aerosol tendencies
+character(len=fieldname_len), allocatable :: fieldname(:) ! names for drop nuc tendency output fields
+character(len=fieldname_len), allocatable :: fieldname_cw(:) ! names for drop nuc tendency output fields
+
+! local indexing for MAM
+integer, allocatable :: mam_idx(:,:) ! table for local indexing of modal aero number and mmr
+integer :: ncnst_tot ! total number of mode number conc + mode species
+
+! Indices for MAM species in the ptend%q array. Needed for prognostic aerosol case.
+integer, allocatable :: mam_cnst_idx(:,:)
+
+#ifdef OSLO_AERO
+logical :: tendencyCounted(pcnst) = .false. ! set flags true for constituents with non-zero tendencies
+integer :: n_aerosol_tracers
+integer :: aerosolTracerList(pcnst) !List where indexes 1...n_aerosol_tracers are the indexes in pcnst
+ !..something like (/ l_so4_a1, l_bc_a, .../)etc
+integer :: inverseAerosolTracerList(pcnst) !List where you can back the place in aerosolTracerList if you know the
+ !tracer index. So in the example above inverseAerosolTracerList(l_so4_a1) = 1
+#endif
+
+! ptr2d_t is used to create arrays of pointers to 2D fields
+type ptr2d_t
+ real(r8), pointer :: fld(:,:)
+end type ptr2d_t
+
+! modal aerosols
+logical :: prog_modal_aero ! true when modal aerosols are prognostic
+logical :: lq(pcnst) = .false. ! set flags true for constituents with non-zero tendencies
+ ! in the ptend object
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine ndrop_init
+
+ integer :: ii, l, lptr, m, mm
+ integer :: nspec_max ! max number of species in a mode
+ character(len=32) :: tmpname
+ character(len=32) :: tmpname_cw
+ character(len=128) :: long_name
+ character(len=8) :: unit
+ logical :: history_amwg ! output the variables used by the AMWG diag package
+#ifdef OSLO_AERO
+ character(len=10) :: modeString
+ character(len=20) :: varname
+#endif
+
+ !-------------------------------------------------------------------------------
+
+ ! get indices into state%q and pbuf structures
+ call cnst_get_ind('NUMLIQ', numliq_idx)
+
+ kvh_idx = pbuf_get_index('kvh')
+
+ zero = 0._r8
+ third = 1._r8/3._r8
+ twothird = 2._r8*third
+ sixth = 1._r8/6._r8
+ sq2 = sqrt(2._r8)
+ sqpi = sqrt(pi)
+
+ t0 = 273._r8
+ surften = 0.076_r8
+ aten = 2._r8*mwh2o*surften/(r_universal*t0*rhoh2o)
+ alogaten = log(aten)
+ alog2 = log(2._r8)
+ alog3 = log(3._r8)
+
+ ! get info about the modal aerosols
+ ! get ntot_amode
+#ifdef OSLO_AERO
+ ntot_amode = nmodes !from opttab
+#else
+ call rad_cnst_get_info(0, nmodes=ntot_amode)
+#endif
+ allocate( &
+ nspec_amode(ntot_amode), &
+ sigmag_amode(ntot_amode), &
+ dgnumlo_amode(ntot_amode), &
+ dgnumhi_amode(ntot_amode), &
+#ifndef OSLO_AERO
+ alogsig(ntot_amode), &
+ exp45logsig(ntot_amode), &
+ f1(ntot_amode), &
+ f2(ntot_amode), &
+#endif
+ voltonumblo_amode(ntot_amode), &
+ voltonumbhi_amode(ntot_amode) )
+
+#ifdef OSLO_AERO
+ do m = 1,ntot_amode
+ nspec_amode(m) = getNumberOfTracersInMode(m)
+ enddo
+#else
+ do m = 1, ntot_amode
+ ! use only if width of size distribution is prescribed
+
+ ! get mode info
+ call rad_cnst_get_info(0, m, nspec=nspec_amode(m))
+
+ ! get mode properties
+ call rad_cnst_get_mode_props(0, m, sigmag=sigmag_amode(m), &
+ dgnumhi=dgnumhi_amode(m), dgnumlo=dgnumlo_amode(m))
+
+ alogsig(m) = log(sigmag_amode(m))
+ exp45logsig(m) = exp(4.5_r8*alogsig(m)*alogsig(m))
+ f1(m) = 0.5_r8*exp(2.5_r8*alogsig(m)*alogsig(m))
+ f2(m) = 1._r8 + 0.25_r8*alogsig(m)
+
+ voltonumblo_amode(m) = 1._r8 / ( (pi/6._r8)* &
+ (dgnumlo_amode(m)**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) )
+ voltonumbhi_amode(m) = 1._r8 / ( (pi/6._r8)* &
+ (dgnumhi_amode(m)**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) )
+ end do
+#endif
+ ! Init the table for local indexing of mam number conc and mmr.
+ ! This table uses species index 0 for the number conc.
+
+ ! Find max number of species in all the modes, and the total
+ ! number of mode number concentrations + mode species
+ nspec_max = nspec_amode(1)
+ ncnst_tot = nspec_amode(1) + 1
+ do m = 2, ntot_amode
+ nspec_max = max(nspec_max, nspec_amode(m))
+ ncnst_tot = ncnst_tot + nspec_amode(m) + 1
+ end do
+
+ allocate( &
+ mam_idx(ntot_amode,0:nspec_max), &
+ mam_cnst_idx(ntot_amode,0:nspec_max), &
+ fieldname(ncnst_tot), &
+ fieldname_cw(ncnst_tot) )
+
+ ! Local indexing compresses the mode and number/mass indicies into one index.
+ ! This indexing is used by the pointer arrays used to reference state and pbuf
+ ! fields.
+ ii = 0
+ do m = 1, ntot_amode
+ do l = 0, nspec_amode(m)
+ ii = ii + 1
+ mam_idx(m,l) = ii
+ end do
+ end do
+
+ ! Add dropmixnuc tendencies for all modal aerosol species
+
+ call phys_getopts(history_amwg_out = history_amwg, &
+ history_aerosol_out = history_aerosol, &
+ prog_modal_aero_out=prog_modal_aero)
+
+#ifdef OSLO_AERO
+ prog_modal_aero = .TRUE.
+ n_aerosol_tracers = getNumberOfAerosolTracers()
+ call fillAerosolTracerList(aerosolTracerList)
+ call fillInverseAerosolTracerList(aerosolTracerList, inverseAerosolTracerList, n_aerosol_tracers)
+ do ii=1,n_aerosol_tracers
+ print*, "aerosolTracerList", ii, aerosolTracerList(ii), inverseAerosolTracerList(aerosolTracerList(ii))
+ end do
+#endif
+
+#ifdef OSLO_AERO
+ lq(:)=.FALSE. !Initialize
+
+ !Set up tendencies for tracers (output)
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr = getTracerIndex(m,l,.false.)
+
+ if(.NOT. lq(lptr))then
+ !add dropmixnuc tendencies
+ mm=mam_idx(m,l)
+ fieldname(mm)=trim(cnst_name(lptr))//"_mixnuc1"
+ fieldname_cw(mm)=trim(getCloudTracerName(lptr))//"_mixnuc1"
+
+ long_name = trim(fieldname(mm)) // ' dropmixnuc column tendency'
+ call addfld(trim(fieldname(mm)), horiz_only ,'A', "kg/m2/s",long_name)
+
+ long_name = trim(fieldname_cw(mm)) // ' dropmixnuc column tendency'
+ call addfld(trim(fieldname_cw(mm)), horiz_only, 'A', "kg/m2/s",long_name)
+
+ if (history_aerosol) then
+ call add_default(trim(fieldname(mm)), 1, ' ')
+ call add_default(trim(fieldname_cw(mm)),1,' ')
+ endif
+
+ !Do tendencies of this tracer
+ lq(lptr)=.TRUE.
+ endif
+ enddo
+ enddo
+ do m=1,ntot_amode
+ modeString=" "
+ write(modeString,"(I2)"),m
+ if(m .lt. 10) modeString="0"//adjustl(modeString)
+ varName = "NMR"//trim(modeString)
+ call addfld(varName, (/ 'lev' /),'A', 'm ', 'number median radius mode '//modeString)
+ if(history_aerosol)call add_default(varName, 1, ' ')
+ varName = "NCONC"//trim(modeString)
+ call addfld(varName, (/ 'lev' /),'A', '#/m3 ', 'number concentration mode '//modeString)
+ if(history_aerosol)call add_default(varName, 1, ' ')
+ varName = "VCONC"//trim(modeString)
+ call addfld(varName, (/ 'lev' /),'A', 'm3/m3 ','volume concentration mode '//modeString)
+ if(history_aerosol)call add_default(varName, 1, ' ')
+ varName = "SIGMA"//trim(modeString)
+ call addfld(varName, (/ 'lev' /),'A', '-','Std. dev. mode '//modeString)
+ if(history_aerosol)call add_default(varName, 1, ' ')
+ varName = "HYGRO"//trim(modeString)
+ call addfld(varName, (/ 'lev' /),'A','-','Hygroscopicity '//modeString)
+ if(history_aerosol)call add_default(varName, 1, ' ')
+ end do
+#else
+ do m = 1, ntot_amode
+ do l = 0, nspec_amode(m) ! loop over number + chem constituents
+
+ mm = mam_idx(m,l)
+
+ unit = 'kg/m2/s'
+ if (l == 0) then ! number
+ unit = '#/m2/s'
+ end if
+
+ if (l == 0) then ! number
+ call rad_cnst_get_info(0, m, num_name=tmpname, num_name_cw=tmpname_cw)
+ else
+ call rad_cnst_get_info(0, m, l, spec_name=tmpname, spec_name_cw=tmpname_cw)
+ end if
+
+ fieldname(mm) = trim(tmpname) // '_mixnuc1'
+ fieldname_cw(mm) = trim(tmpname_cw) // '_mixnuc1'
+
+ if (prog_modal_aero) then
+
+ ! To set tendencies in the ptend object need to get the constituent indices
+ ! for the prognostic species
+ if (l == 0) then ! number
+ call rad_cnst_get_mode_num_idx(m, lptr)
+ else
+ call rad_cnst_get_mam_mmr_idx(m, l, lptr)
+ end if
+ mam_cnst_idx(m,l) = lptr
+ lq(lptr) = .true.
+
+ ! Add tendency fields to the history only when prognostic MAM is enabled.
+ long_name = trim(tmpname) // ' dropmixnuc mixnuc column tendency'
+ call addfld(fieldname(mm), horiz_only, 'A', unit, long_name)
+
+ long_name = trim(tmpname_cw) // ' dropmixnuc mixnuc column tendency'
+ call addfld(fieldname_cw(mm), horiz_only, 'A', unit, long_name)
+
+ if (history_aerosol) then
+ call add_default(fieldname(mm), 1, ' ')
+ call add_default(fieldname_cw(mm), 1, ' ')
+ end if
+
+
+
+ end if
+
+ end do
+ end do
+
+#endif
+
+! call addfld('CCN1',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.02%')
+! call addfld('CCN2',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.05%')
+! call addfld('CCN3',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.1%')
+! call addfld('CCN4',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.2%')
+! call addfld('CCN5',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.5%')
+! call addfld('CCN6',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=1.0%')
+!akc6+
+ call addfld('CCN1',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.02%')
+ call addfld('CCN2',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.05%')
+ call addfld('CCN3',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.1%')
+ call addfld('CCN4',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.15%')
+ call addfld('CCN5',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.2%')
+ call addfld('CCN6',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.5%')
+ call addfld('CCN7',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=1.0%')
+!akc6-
+
+#ifdef OSLO_AERO
+ if(history_aerosol)then
+ do l = 1, psat
+ call add_default(ccn_name(l), 1, ' ')
+ enddo
+ end if
+#endif
+
+ call addfld('WTKE', (/ 'lev' /), 'A', 'm/s', 'Standard deviation of updraft velocity')
+ call addfld('NDROPMIX', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number mixing')
+ call addfld('NDROPSRC', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number source')
+ call addfld('NDROPSNK', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number loss by microphysics')
+ call addfld('NDROPCOL', horiz_only, 'A', '#/m2', 'Column droplet number')
+
+#ifndef OSLO_AERO
+
+ ! set the add_default fields
+ if (history_amwg) then
+ call add_default('CCN3', 1, ' ')
+ endif
+
+ if (history_aerosol .and. prog_modal_aero) then
+ do m = 1, ntot_amode
+ do l = 0, nspec_amode(m) ! loop over number + chem constituents
+ mm = mam_idx(m,l)
+ if (l == 0) then ! number
+ call rad_cnst_get_info(0, m, num_name=tmpname, num_name_cw=tmpname_cw)
+ else
+ call rad_cnst_get_info(0, m, l, spec_name=tmpname, spec_name_cw=tmpname_cw)
+ end if
+ fieldname(mm) = trim(tmpname) // '_mixnuc1'
+ fieldname_cw(mm) = trim(tmpname_cw) // '_mixnuc1'
+ end do
+ end do
+ endif
+
+#endif
+
+end subroutine ndrop_init
+
+!===============================================================================
+
+subroutine dropmixnuc( &
+ state, ptend, dtmicro, pbuf, wsub, & ! Input
+ cldn, cldo, cldliqf, &
+ !++ MH_2015/09/07
+ hasAerosol, &
+ CProcessModes, f_c, f_bc, f_aq, f_so4_cond, &
+ f_soa, &
+ cam, f_acm, f_bcm, f_aqm, f_so4_condm, &
+ f_soam, &
+ numberConcentration, volumeConcentration, &
+ hygroscopicity, lnsigma, &
+ !-- MH_2015/09/07
+ tendnd, & ! Output
+ !++ MH_2015/04/10
+ fn_in, &
+ from_spcam )
+ !-- MH_2015/04/10
+
+ ! vertical diffusion and nucleation of cloud droplets
+ ! assume cloud presence controlled by cloud fraction
+ ! doesn't distinguish between warm, cold clouds
+
+ ! arguments
+ type(physics_state), target, intent(in) :: state
+ type(physics_ptend), intent(out) :: ptend
+ real(r8), intent(in) :: dtmicro ! time step for microphysics (s)
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! arguments
+ real(r8), intent(in) :: wsub(pcols,pver) ! subgrid vertical velocity
+ real(r8), intent(in) :: cldn(pcols,pver) ! cloud fraction
+ real(r8), intent(in) :: cldo(pcols,pver) ! cloud fraction on previous time step
+ real(r8), intent(in) :: cldliqf(pcols,pver) ! liquid cloud fraction (liquid / (liquid + ice))
+ logical, intent(in),optional :: from_spcam ! value insignificant - if variable present, is called from spcam
+
+!++ MH_2015/09/07
+ logical, intent(in) :: hasAerosol(pcols, pver, nmodes)
+ real(r8), intent(in) :: CProcessModes(pcols,pver)
+ real(r8), intent(in) :: cam(pcols,pver,nbmodes)
+ real(r8), intent(in) :: f_c(pcols,pver)
+ real(r8), intent(in) :: f_aq(pcols,pver)
+ real(r8), intent(in) :: f_bc(pcols,pver)
+ real(r8), intent(in) :: f_so4_cond(pcols,pver)
+ real(r8), intent(in) :: f_soa(pcols,pver)
+ real(r8), intent(in) :: f_acm(pcols,pver, nbmodes)
+ real(r8), intent(in) :: f_bcm(pcols,pver, nbmodes)
+ real(r8), intent(in) :: f_aqm(pcols, pver, nbmodes)
+ real(r8), intent(in) :: f_so4_condm(pcols, pver, nbmodes) !Needed in "get component fraction
+ real(r8), intent(in) :: f_soam(pcols,pver,nbmodes)
+ real(r8), intent(in) :: numberConcentration(pcols,pver,0:nmodes) ![#/m3] number concentraiton
+ real(r8), intent(in) :: volumeConcentration(pcols,pver,nmodes) ![m3/m3] volume concentration
+ real(r8), intent(in) :: hygroscopicity(pcols,pver,nmodes) ![-] hygroscopicity
+ real(r8), intent(in) :: lnsigma(pcols,pver,nmodes) ![-] log(base e) sigma
+!-- MH_2015/09/07
+
+ ! output arguments
+ real(r8), intent(out) :: tendnd(pcols,pver) ! change in droplet number concentration (#/kg/s)
+
+ !--------------------Local storage-------------------------------------
+
+ integer :: lchnk ! chunk identifier
+ integer :: ncol ! number of columns
+
+ real(r8), pointer :: ncldwtr(:,:) ! droplet number concentration (#/kg)
+ real(r8), pointer :: temp(:,:) ! temperature (K)
+ real(r8), pointer :: omega(:,:) ! vertical velocity (Pa/s)
+ real(r8), pointer :: pmid(:,:) ! mid-level pressure (Pa)
+ real(r8), pointer :: pint(:,:) ! pressure at layer interfaces (Pa)
+ real(r8), pointer :: pdel(:,:) ! pressure thickess of layer (Pa)
+ real(r8), pointer :: rpdel(:,:) ! inverse of pressure thickess of layer (/Pa)
+ real(r8), pointer :: zm(:,:) ! geopotential height of level (m)
+
+ real(r8), pointer :: kvh(:,:) ! vertical diffusivity (m2/s)
+
+ type(ptr2d_t), allocatable :: raer(:) ! aerosol mass, number mixing ratios
+ type(ptr2d_t), allocatable :: qqcw(:)
+ real(r8) :: raertend(pver) ! tendency of aerosol mass, number mixing ratios
+ real(r8) :: qqcwtend(pver) ! tendency of cloudborne aerosol mass, number mixing ratios
+
+
+ real(r8), parameter :: zkmin = 0.01_r8, zkmax = 100._r8
+ real(r8), parameter :: wmixmin = 0.1_r8 ! minimum turbulence vertical velocity (m/s)
+ real(r8) :: sq2pi
+
+ integer :: i, k, l, m, mm, n
+ integer :: km1, kp1
+ integer :: nnew, nsav, ntemp
+ integer :: lptr
+ integer :: nsubmix, nsubmix_bnd
+ integer, save :: count_submix(100)
+ integer :: phase ! phase of aerosol
+
+ real(r8) :: arg
+ real(r8) :: dtinv
+ real(r8) :: dtmin, tinv, dtt
+ real(r8) :: lcldn(pcols,pver)
+ real(r8) :: lcldo(pcols,pver)
+
+ real(r8) :: zs(pver) ! inverse of distance between levels (m)
+ real(r8) :: qcld(pver) ! cloud droplet number mixing ratio (#/kg)
+ real(r8) :: qncld(pver) ! droplet number nucleated on cloud boundaries
+ real(r8) :: srcn(pver) ! droplet source rate (/s)
+ real(r8) :: cs(pcols,pver) ! air density (kg/m3)
+ real(r8) :: csbot(pver) ! air density at bottom (interface) of layer (kg/m3)
+ real(r8) :: csbot_cscen(pver) ! csbot(i)/cs(i,k)
+ real(r8) :: dz(pcols,pver) ! geometric thickness of layers (m)
+
+ real(r8) :: wtke(pcols,pver) ! turbulent vertical velocity at base of layer k (m/s)
+ real(r8) :: wtke_cen(pcols,pver) ! turbulent vertical velocity at center of layer k (m/s)
+ real(r8) :: wbar, wmix, wmin, wmax
+
+ real(r8) :: zn(pver) ! g/pdel (m2/g) for layer
+ real(r8) :: flxconv ! convergence of flux into lowest layer
+
+ real(r8) :: wdiab ! diabatic vertical velocity
+ real(r8) :: ekd(pver) ! diffusivity for droplets (m2/s)
+ real(r8) :: ekk(0:pver) ! density*diffusivity for droplets (kg/m3 m2/s)
+ real(r8) :: ekkp(pver) ! zn*zs*density*diffusivity
+ real(r8) :: ekkm(pver) ! zn*zs*density*diffusivity
+
+ real(r8) :: dum, dumc
+ real(r8) :: tmpa
+ real(r8) :: dact
+ real(r8) :: fluxntot ! (#/cm2/s)
+ real(r8) :: dtmix
+ real(r8) :: alogarg
+ real(r8) :: overlapp(pver), overlapm(pver) ! cloud overlap
+
+ real(r8) :: nsource(pcols,pver) ! droplet number source (#/kg/s)
+ real(r8) :: ndropmix(pcols,pver) ! droplet number mixing (#/kg/s)
+ real(r8) :: ndropcol(pcols) ! column droplet number (#/m2)
+ real(r8) :: cldo_tmp, cldn_tmp
+ real(r8) :: tau_cld_regenerate
+ real(r8) :: zeroaer(pver)
+ real(r8) :: taumix_internal_pver_inv ! 1/(internal mixing time scale for k=pver) (1/s)
+
+
+ real(r8), allocatable :: nact(:,:) ! fractional aero. number activation rate (/s)
+ real(r8), allocatable :: mact(:,:) ! fractional aero. mass activation rate (/s)
+
+ real(r8), allocatable :: raercol(:,:,:) ! single column of aerosol mass, number mixing ratios
+ real(r8), allocatable :: raercol_cw(:,:,:) ! same as raercol but for cloud-borne phase
+#ifdef OSLO_AERO
+ !to avoid excessive calls to boundary layer scheme
+ real(r8), allocatable :: raercol_tracer(:,:,:)
+ real(r8), allocatable :: raercol_cw_tracer(:,:,:)
+ real(r8), allocatable :: mact_tracer(:,:)
+ real(r8), allocatable :: mfullact_tracer(:,:)
+#endif
+
+ real(r8) :: na(pcols), va(pcols), hy(pcols)
+ real(r8), allocatable :: naermod(:) ! (1/m3)
+ real(r8), allocatable :: hygro(:) ! hygroscopicity of aerosol mode
+ real(r8), allocatable :: vaerosol(:) ! interstit+activated aerosol volume conc (cm3/cm3)
+
+ real(r8) :: source(pver)
+
+!++ MH_2015/04/10
+ real(r8), allocatable :: fn(:) ! activation fraction for aerosol number
+ real(r8), intent(out) :: fn_in(pcols,pver,0:nmodes)
+!-- MH_2015/04/10
+ real(r8), allocatable :: fm(:) ! activation fraction for aerosol mass
+
+ real(r8), allocatable :: fluxn(:) ! number activation fraction flux (cm/s)
+ real(r8), allocatable :: fluxm(:) ! mass activation fraction flux (cm/s)
+ real(r8) :: flux_fullact(pver) ! 100% activation fraction flux (cm/s)
+ ! note: activation fraction fluxes are defined as
+ ! fluxn = [flux of activated aero. number into cloud (#/cm2/s)]
+ ! / [aero. number conc. in updraft, just below cloudbase (#/cm3)]
+
+
+ real(r8), allocatable :: coltend(:,:) ! column tendency for diagnostic output
+ real(r8), allocatable :: coltend_cw(:,:) ! column tendency
+ real(r8) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat
+
+ !for gas species turbulent mixing
+ real(r8), pointer :: rgas(:, :, :)
+ real(r8), allocatable :: rgascol(:, :, :)
+ real(r8), allocatable :: coltendgas(:)
+ real(r8) :: zerogas(pver)
+ character*200 fieldnamegas
+
+ logical :: called_from_spcam
+ !-------------------------------------------------------------------------------
+#ifdef OSLO_AERO
+ real(r8) :: numberMedianRadius(pcols,pver,nmodes)
+ real(r8) :: sigma(pcols,pver,nmodes) ![-] sigma
+ real(r8) :: constituentFraction
+ !++ MH_2015/04/10
+ real(r8) :: volumeCore(pcols,pver,nmodes)
+ real(r8) :: volumeCoat(pcols,pver,nmodes)
+ !-- MH_2015/04/10
+ integer :: tracerIndex
+ integer :: cloudTracerIndex
+ integer :: kcomp
+ integer :: speciesMap(nmodes)
+ !++ MH_2015/04/10
+! real(r8) :: fn_tmp(pcols,pver,nmodes)
+ real(r8), allocatable :: fn_tmp(:), fm_tmp(:)
+ !-- MH_2015/04/10
+ real(r8), allocatable :: fluxn_tmp(:), fluxm_tmp(:)
+ real(r8) :: componentFraction
+ real(r8) :: componentFractionOK(pver,nmodes,pcnst)
+ real(r8) :: sumFraction
+ logical :: alert
+ real(r8), dimension(pver, pcnst) :: massBalance
+ real(r8), dimension(pver, pcnst) :: newMass
+ real(r8), dimension(pver,pcnst) :: newCloud, oldCloud, newAerosol, oldAerosol, deltaCloud
+ integer :: kCrit, lptr2
+ logical :: stopMe
+ integer :: iDebug=1, lDebug=15
+ real(r8) :: mixRatioToMass
+ real(r8),dimension(pcnst) :: debugSumFraction
+ real(r8), allocatable :: lnsigman(:)
+ character(len=2) :: modeString
+ character(len=20) :: varname
+#endif
+ integer :: numberOfModes
+!-------------------------------------------------------------------------------
+#undef EXTRATESTS
+#undef MASS_BALANCE_CHECK
+
+ sq2pi = sqrt(2._r8*pi)
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ ncldwtr => state%q(:,:,numliq_idx)
+ temp => state%t
+ omega => state%omega
+ pmid => state%pmid
+ pint => state%pint
+ pdel => state%pdel
+ rpdel => state%rpdel
+ zm => state%zm
+
+ call pbuf_get_field(pbuf, kvh_idx, kvh)
+
+ ! Create the liquid weighted cloud fractions that were passsed in
+ ! before. This doesn't seem like the best variable, since the cloud could
+ ! have liquid condensate, but the part of it that is changing could be the
+ ! ice portion; however, this is what was done before.
+ lcldo(:ncol,:) = cldo(:ncol,:) * cldliqf(:ncol,:)
+ lcldn(:ncol,:) = cldn(:ncol,:) * cldliqf(:ncol,:)
+
+
+ arg = 1.0_r8
+ if (abs(0.8427_r8 - erf(arg))/0.8427_r8 > 0.001_r8) then
+ write(iulog,*) 'erf(1.0) = ',ERF(arg)
+ call endrun('dropmixnuc: Error function error')
+ endif
+ arg = 0.0_r8
+ if (erf(arg) /= 0.0_r8) then
+ write(iulog,*) 'erf(0.0) = ',erf(arg)
+ write(iulog,*) 'dropmixnuc: Error function error'
+ call endrun('dropmixnuc: Error function error')
+ endif
+
+ dtinv = 1._r8/dtmicro
+
+ allocate( &
+ nact(pver,ntot_amode), &
+ mact(pver,ntot_amode), &
+ raer(ncnst_tot), &
+ qqcw(ncnst_tot), &
+ raercol(pver,ncnst_tot,2), &
+ raercol_cw(pver,ncnst_tot,2), &
+ coltend(pcols,ncnst_tot), &
+ coltend_cw(pcols,ncnst_tot), &
+ naermod(ntot_amode), &
+ hygro(ntot_amode), &
+#ifdef OSLO_AERO
+ lnsigman(ntot_amode), & !variable std. deviation (CAM-Oslo)
+ raercol_tracer(pver,n_aerosol_tracers,2), &
+ raercol_cw_tracer(pver,n_aerosol_tracers,2), &
+ mact_tracer(pver,n_aerosol_tracers), &
+ mfullact_tracer(pver,n_aerosol_tracers), &
+#endif
+ vaerosol(ntot_amode), &
+ fn(ntot_amode), &
+ fm(ntot_amode), &
+ fluxn(ntot_amode), &
+ fluxm(ntot_amode) )
+
+ ! Init pointers to mode number and specie mass mixing ratios in
+ ! intersitial and cloud borne phases.
+#ifdef OSLO_AERO
+ !Need a list of all aerosol species ==> store in raer (mm)
+ ! or qqcw for cloud-borne aerosols (?)
+ do m=1,nmodes !All aerosol modes
+
+ !NOTE: SEVERAL POINTERS POINT TO SAME FIELD, E.G. CONDENSATE WHICH IS IN SEVERAL MODES
+ do l = 1, nspec_amode(m)
+ tracerIndex = getTracerIndex(m,l,.false.) !Index in q
+ cloudTracerIndex = getCloudTracerIndex(m,l) !Index in phys-buffer
+ mm = mam_idx(m,l) !Index in raer/qqcw
+ raer(mm)%fld => state%q(:,:,tracerIndex) !NOTE: These are total fields (for example condensate)
+ call pbuf_get_field(pbuf, CloudTracerIndex, qqcw(mm)%fld) !NOTE: These are total fields (for example condensate)
+#ifdef EXTRATESTS
+! if(tracerIndex .eq. ldebug)then
+! do k=1,pver
+! print*,"pointer check",k,m,l,mm,tracerIndex, raer(mm)%fld(idebug,k), state%q(idebug,k,tracerIndex)
+! end do
+! endf
+#endif
+ enddo
+ enddo
+ allocate( &
+ fn_tmp(ntot_amode), &
+ fm_tmp(ntot_amode), &
+ fluxn_tmp(ntot_amode), &
+ fluxm_tmp(ntot_amode) )
+#else
+ do m = 1, ntot_amode
+ mm = mam_idx(m, 0)
+ call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, raer(mm)%fld)
+ call rad_cnst_get_mode_num(0, m, 'c', state, pbuf, qqcw(mm)%fld) ! cloud-borne aerosol
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m, l)
+ call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, raer(mm)%fld)
+ call rad_cnst_get_aer_mmr(0, m, l, 'c', state, pbuf, qqcw(mm)%fld) ! cloud-borne aerosol
+ end do
+ end do
+#endif
+
+ called_from_spcam = (present(from_spcam))
+
+ if (called_from_spcam) then
+ rgas => state%q
+ allocate(rgascol(pver, pcnst, 2))
+ allocate(coltendgas(pcols))
+ endif
+ wtke = 0._r8
+
+ if (prog_modal_aero) then
+ ! aerosol tendencies
+ call physics_ptend_init(ptend, state%psetcols, 'ndrop', lq=lq)
+ else
+ ! no aerosol tendencies
+ call physics_ptend_init(ptend, state%psetcols, 'ndrop')
+ end if
+
+#ifdef OSLO_AERO
+ !Improve this later by using only cloud points ?
+ do k = top_lev, pver
+ do i=1,ncol
+ cs(i,k) = pmid(i,k)/(rair*temp(i,k)) ! air density (kg/m3)
+ end do
+ end do
+
+ !Output this
+ call calculateNumberMedianRadius(numberConcentration, volumeConcentration, lnSigma, numberMedianRadius, ncol)
+ do n=1,nmodes
+ sigma(:ncol,:,n) = DEXP(lnSigma(:ncol,:,n))
+ modeString=" "
+ write(modeString,"(I2)"),n
+ if(n .lt. 10) modeString="0"//adjustl(modeString)
+ varName = "NMR"//trim(modeString)
+ call outfld(varName, numberMedianRadius(:,:,n), pcols, lchnk)
+ varName = "NCONC"//trim(modeString)
+ call outfld(varName, numberConcentration(:,:,n),pcols, lchnk)
+ varName = "VCONC"//trim(modeString)
+ call outfld(varName, volumeConcentration(:,:,n), pcols,lchnk)
+ varName = "SIGMA"//trim(modeString)
+ call outfld(varName, sigma(:,:,n), pcols,lchnk)
+ varName = "HYGRO"//trim(modeString)
+ call outfld(varName, hygroscopicity(:,:,n), pcols,lchnk)
+ end do
+
+ alert = .FALSE.
+ do k=top_lev,pver
+ mm = k - top_lev + 1
+ do m=1,nmodes
+ if(.NOT. alert .and. &
+ ANY(numberConcentration(:ncol,k,m) .lt. 0.0_r8 ))then
+ alert = .TRUE.
+ lptr = k
+ print*,"STRANGE numberconc", m, minval(numberConcentration(:,:,:))*1.e-6_r8, "#/cm3", k, mm
+ endif
+ enddo
+ enddo
+
+
+ if(alert)then
+ print*,"strange stuff here "
+ stop
+
+ !do m=1,nmodes
+ ! print*,"numberconc (after alert)", m, modedefs(1)%nnatk(m)*1.e-6_r8, "#/cm3" &
+ ! ,modedefs(1)%C(m)*1.0e9_r8, "ug/m3"
+
+ ! if(modedefs(1)%nnatk(m) > 1.e-30_r8)then
+ ! print*, "final weight per particle ",m, modedefs(1)%C(m)/modedefs(1)%nnatk(m)
+ ! endif
+ !end do
+ !stop
+ endif
+
+#endif
+
+ ! overall_main_i_loop
+ do i = 1, ncol
+
+#ifdef OSLO_AERO
+ coltend(i,:)=0.0_r8
+ coltend_cw(i,:) = 0.0_r8
+#endif
+
+ do k = top_lev, pver-1
+ zs(k) = 1._r8/(zm(i,k) - zm(i,k+1))
+ end do
+ zs(pver) = zs(pver-1)
+
+ ! load number nucleated into qcld on cloud boundaries
+
+ do k = top_lev, pver
+
+ qcld(k) = ncldwtr(i,k)
+ qncld(k) = 0._r8
+ srcn(k) = 0._r8
+ cs(i,k) = pmid(i,k)/(rair*temp(i,k)) ! air density (kg/m3)
+ dz(i,k) = 1._r8/(cs(i,k)*gravit*rpdel(i,k)) ! layer thickness in m
+
+ do m = 1, ntot_amode
+ nact(k,m) = 0._r8
+ mact(k,m) = 0._r8
+ end do
+
+ zn(k) = gravit*rpdel(i,k)
+
+ if (k < pver) then
+ ekd(k) = kvh(i,k+1)
+ ekd(k) = max(ekd(k), zkmin)
+ ekd(k) = min(ekd(k), zkmax)
+ csbot(k) = 2.0_r8*pint(i,k+1)/(rair*(temp(i,k) + temp(i,k+1)))
+ csbot_cscen(k) = csbot(k)/cs(i,k)
+ else
+ ekd(k) = 0._r8
+ csbot(k) = cs(i,k)
+ csbot_cscen(k) = 1.0_r8
+ end if
+
+ ! rce-comment - define wtke at layer centers for new-cloud activation
+ ! and at layer boundaries for old-cloud activation
+ !++ag
+ wtke_cen(i,k) = wsub(i,k)
+ wtke(i,k) = wsub(i,k)
+ !--ag
+ wtke_cen(i,k) = max(wtke_cen(i,k), wmixmin)
+ wtke(i,k) = max(wtke(i,k), wmixmin)
+
+ nsource(i,k) = 0._r8
+
+ end do ! k
+
+ nsav = 1
+ nnew = 2
+#ifdef OSLO_AERO
+
+ !get constituent fraction
+ componentFractionOK(:,:,:) = 0.0_r8
+ do k=top_lev, pver
+ do m = 1,ntot_amode
+ if(m .le. nbmodes)then
+ do l = 1, nspec_amode(m)
+ !calculate fraction of component "l" in mode "m" based on concentrations in clear air
+ componentFractionOK(k,m,getTracerIndex(m,l,.false.)) &
+ = getConstituentFraction(CProcessModes(i,k), f_c(i,k), f_bc(i,k), f_aq(i,k), f_so4_cond(i,k), f_soa(i,k) &
+ ,Cam(i,k,m), f_acm(i,k,m), f_bcm(i,k,m), f_aqm(i,k,m), f_so4_condm(i,k,m) , f_soam(i,k,m), getTracerIndex(m,l,.false.) )
+ end do
+ else
+ do l = 1, nspec_amode(m)
+ componentFractionOK(k,m,getTracerIndex(m,l,.false.)) = 1.0_r8
+ end do
+ endif
+ end do
+
+ !Loop over all tracers ==> check that sums to one
+ !for all tracers which exist in the oslo-modes
+ do l=1,pcnst
+ sumFraction = 0.0_r8
+ do m=1,ntot_amode
+ sumFraction = sumFraction + componentFractionOK(k,m,l)
+ end do
+ if(sumFraction .gt. 1.e-2_r8)then !Just scale what comes out if componentFraction is larger than 1%
+ do m=1,ntot_amode
+ componentFractionOK(k,m,l) = &
+ componentFractionOK(k,m,l)/sumFraction
+ end do
+ else !negative or zero fraction for this species
+ !distribute equal fraction to all receiver modes
+ sumFraction = 0.0_r8
+ do m=1,ntot_amode
+ do lptr=1,getNumberOfTracersInMode(m)
+ if(getTracerIndex(m,lptr,.FALSE.) .eq. l ) then
+ sumFraction = sumFraction + 1.0_r8
+ endif
+ end do ! tracers in mode
+ end do ! mode
+ do m=1,ntot_amode
+ componentFractionOK(k,m,l)=1.0_r8/max(1.e-30_r8, sumFraction)
+ end do !modes
+ endif
+ end do !tracers
+ end do !levels
+ !debug sum fraction for "i" done
+
+
+
+ debugSumFraction(:) = 0.0_r8 !sum of component lDebug in level k
+ do m = 1, nmodes ! Number of modes
+ !Get number concentration of this mode
+ mm =mam_idx(m,0)
+ do k= top_lev,pver
+ raercol(k,mm,nsav) = numberConcentration(i,k,m)/cs(i,k) !#/kg air
+ !In oslo model, number concentrations are diagnostics, so
+ !Approximate number concentration in each mode by total
+ !cloud number concentration scaled by how much is available of
+ !each mode
+ raercol_cw(k,mm,nsav) = ncldwtr(i,k)*numberConcentration(i,k,m)&
+ /max(1.e-30_r8, sum(numberConcentration(i,k,1:nmodes)))
+ enddo
+
+ !These are the mass mixing ratios
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l) !index of tracer (all unique)
+ raercol(:,mm,nsav) = 0.0_r8
+ raercol_cw(:,mm,nsav) = 0.0_r8
+ !Several of the fields (raer(mm)%fld point to the same
+ !field in q. To avoid double counting, we take into
+ !account the component fraction in the mode
+ do k=top_lev,pver
+ if(m .gt. nbmodes) then
+ componentFraction = 1.0_r8
+ else
+ componentFraction = componentFractionOK(k,m,getTracerIndex(m,l,.false.))
+ endif
+#ifdef EXTRATESTS
+ if(i .eq. iDebug .and. getTracerIndex(m,l,.false.) .eq. lDebug)then
+ !print*,"componentFraction", i,cnst_name(oslo_cnst_idx(m,l)),componentFraction
+ print*,"assigning cloud/aerosol", k,m,l,qqcw(mm)%fld(i,k), raer(mm)%fld(i,k) &
+ ,componentFraction
+ debugSumFraction(k) = debugSumFraction(k) + componentFraction
+ endif
+ if(componentFraction > 1.0_r8)then
+ print*, "wrong component fraction", componentFraction
+ stop
+ call endrun("wrong component fraction")
+ endif
+#endif
+ !Assign to the components used here i.e. distribute condensate/coagulate to modes
+ raercol_cw(k,mm,nsav) = qqcw(mm)%fld(i,k)*componentFraction
+ raercol(k,mm,nsav) = raer(mm)%fld(i,k)*componentFraction
+ enddo ! k (levels)
+ end do ! l (species)
+ end do ! m (modes)
+#ifdef EXTRATESTS
+ do k=top_lev,pver
+ if(i .eq. iDebug .and. (abs(debugSumFraction(k)-1.0_r8).gt.1.e-2_r8) .and. debugSumFraction(k).gt.1.e-6_r8)then
+ print*, "debugSumFraction", cnst_name(getTracerIndex(m,l,.false.)),i, k, debugSumFraction(k), abs(debugSumFraction(k)-1.0_r8)
+ componentFraction=0.0_r8
+ do m=1,nbmodes
+ componentFraction = componentFraction + cam(i,k,m)
+ print*, "MODECONC", m, cam(i,k,m), numberConcentration(i,k,m)
+ end do
+ print*, "CS, sumCAM", CProcessModes(i,k), sum(cam(i,k,1:nbmodes)), componentFraction
+ print*, "q (cond)", state%q(i,k,lDebug)*cs(i,k)!mass in q
+ print*, "q (aq) " ,state%q(i,k,l_so4_a2)*cs(i,k)
+ print*, "bulk fractions", f_so4_cond(i,k),f_c(i,k), f_bc(i,k), f_aq(i,k)
+ !print*, "other levels", debugSumFraction(:)
+ do m=1,nmodes
+ do l=1,nspec_amode(m)
+ if(getTracerIndex(m,l,.false.) == ldebug)then
+ if(m .gt. nbmodes)then
+ componentFraction = 1.0_r8
+ else
+ componentFraction = componentFractionOK(k,m,getTracerIndex(m,l,.false.))
+ endif
+ print*, "nmode, l,k, ", m,l,k , lDebug, componentFraction, cam(i,k,m), f_aqm(i,k,m), f_acm(i,k,m), f_so4_condm(i,k,m)
+ print*, "fraction2 ", cam(i,k,m), cam(i,k,m)/CProcessModes(i,k)*100.0_r8, " %"
+ endif
+ enddo
+ enddo
+ call endrun("wrong debugsumfraction")
+ endif !idebug/ldebug
+ enddo
+#endif
+ !END OSLO-STUFF, BELOW IS MAM 3
+#else
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ raercol_cw(:,mm,nsav) = 0.0_r8
+ raercol(:,mm,nsav) = 0.0_r8
+ raercol_cw(top_lev:pver,mm,nsav) = qqcw(mm)%fld(i,top_lev:pver)
+ raercol(top_lev:pver,mm,nsav) = raer(mm)%fld(i,top_lev:pver)
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ raercol_cw(top_lev:pver,mm,nsav) = qqcw(mm)%fld(i,top_lev:pver)
+ raercol(top_lev:pver,mm,nsav) = raer(mm)%fld(i,top_lev:pver)
+ end do
+ end do
+#endif
+
+
+ if (called_from_spcam) then
+ !
+ ! In the MMF model, turbulent mixing for tracer species are turned off.
+ ! So the turbulent for gas species mixing are added here.
+ ! (Previously, it had the turbulent mixing for aerosol species)
+ !
+ do m=1, pcnst
+ if (cnst_species_class(m) == cnst_spec_class_gas) rgascol(:,m,nsav) = rgas(i,:,m)
+ end do
+
+ endif
+
+ ! droplet nucleation/aerosol activation
+
+ ! tau_cld_regenerate = time scale for regeneration of cloudy air
+ ! by (horizontal) exchange with clear air
+ tau_cld_regenerate = 3600.0_r8 * 3.0_r8
+
+ if (called_from_spcam) then
+ ! when this is called in the MMF part, no cloud regeneration and decay.
+ ! set the time scale be very long so that no cloud regeneration.
+ tau_cld_regenerate = 3600.0_r8 * 24.0_r8 * 365.0_r8
+ endif
+
+
+ ! k-loop for growing/shrinking cloud calcs .............................
+ ! grow_shrink_main_k_loop: &
+ do k = top_lev, pver
+
+ ! This code was designed for liquid clouds, but the cloudbourne
+ ! aerosol can be either from liquid or ice clouds. For the ice clouds,
+ ! we do not do regeneration, but as cloud fraction decreases the
+ ! aerosols should be returned interstitial. The lack of a liquid cloud
+ ! should not mean that all of the aerosol is realease. Therefor a
+ ! section has been added for shrinking ice clouds and checks were added
+ ! to protect ice cloudbourne aerosols from being released when no
+ ! liquid cloud is present.
+
+ ! shrinking ice cloud ......................................................
+ cldo_tmp = cldo(i,k) * (1._r8 - cldliqf(i,k))
+ cldn_tmp = cldn(i,k) * (1._r8 - cldliqf(i,k))
+
+ if (cldn_tmp < cldo_tmp) then
+
+ ! convert activated aerosol to interstitial in decaying cloud
+
+ dumc = (cldn_tmp - cldo_tmp)/cldo_tmp * (1._r8 - cldliqf(i,k))
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ dact = raercol_cw(k,mm,nsav)*dumc
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ dact = raercol_cw(k,mm,nsav)*dumc
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+ end do
+ end do
+ end if
+
+ ! shrinking liquid cloud ......................................................
+ ! treat the reduction of cloud fraction from when cldn(i,k) < cldo(i,k)
+ ! and also dissipate the portion of the cloud that will be regenerated
+ cldo_tmp = lcldo(i,k)
+ cldn_tmp = lcldn(i,k) * exp( -dtmicro/tau_cld_regenerate )
+ ! alternate formulation
+ ! cldn_tmp = cldn(i,k) * max( 0.0_r8, (1.0_r8-dtmicro/tau_cld_regenerate) )
+
+ ! fraction is also provided.
+ if (cldn_tmp < cldo_tmp) then
+ ! droplet loss in decaying cloud
+ !++ sungsup
+ nsource(i,k) = nsource(i,k) + qcld(k)*(cldn_tmp - cldo_tmp)/cldo_tmp*cldliqf(i,k)*dtinv
+ qcld(k) = qcld(k)*(1._r8 + (cldn_tmp - cldo_tmp)/cldo_tmp)
+ !-- sungsup
+
+ ! convert activated aerosol to interstitial in decaying cloud
+
+ dumc = (cldn_tmp - cldo_tmp)/cldo_tmp * cldliqf(i,k)
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ dact = raercol_cw(k,mm,nsav)*dumc
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ dact = raercol_cw(k,mm,nsav)*dumc
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+#ifdef EXTRATESTS
+ if(i.eq. iDebug .and. getTracerIndex(m,l,.false.).eq.lDebug)then
+ print*,"decaying cloud", k, dact, cldn_tmp, cldo_tmp
+ endif
+#endif
+ end do
+ end do
+ end if
+
+ ! growing liquid cloud ......................................................
+ ! treat the increase of cloud fraction from when cldn(i,k) > cldo(i,k)
+ ! and also regenerate part of the cloud
+ cldo_tmp = cldn_tmp
+ cldn_tmp = lcldn(i,k)
+
+ if (cldn_tmp-cldo_tmp > 0.01_r8) then
+
+ ! rce-comment - use wtke at layer centers for new-cloud activation
+ wbar = wtke_cen(i,k)
+ wmix = 0._r8
+ wmin = 0._r8
+ wmax = 10._r8
+ wdiab = 0._r8
+
+ ! load aerosol properties, assuming external mixtures
+
+#ifdef OSLO_AERO
+ naermod(:) = 0.0_r8
+ vaerosol(:) = 0.0_r8
+ hygro(:) = 0.0_r8
+ lnsigman(:) = log(2.0_r8)
+
+ m=0
+ do kcomp = 1,nmodes
+ if(hasAerosol(i,k,kcomp) .eqv. .TRUE.)then
+ m = m + 1
+ naermod(m) = numberConcentration(i,k,kcomp)
+ vaerosol(m) = volumeConcentration(i,k,kcomp)
+ hygro(m) = hygroscopicity(i,k,kcomp)
+ lnsigman(m) = lnsigma(i,k,kcomp)
+ speciesMap(m) = kcomp
+ end if
+ end do
+ numberOfModes = m
+#else
+ numberOfModes = ntot_amode
+ phase = 1 ! interstitial
+ do m = 1, ntot_amode
+ call loadaer( &
+ state, pbuf, i, i, k, &
+ m, cs, phase, na, va, &
+ hy)
+ naermod(m) = na(i)
+ vaerosol(m) = va(i)
+ hygro(m) = hy(i)
+ end do
+#endif
+ !++ MH_2015/04/10
+ !Call the activation procedure
+ if(numberOfModes .gt. 0)then
+ if (use_hetfrz_classnuc) then
+ call activate_modal( &
+ wbar, wmix, wdiab, wmin, wmax, &
+ temp(i,k), cs(i,k), naermod, numberOfModes, &
+ vaerosol, hygro, fn_in(i,k,1:nmodes), fm, fluxn, &
+ fluxm,flux_fullact(k) &
+#ifdef OSLO_AERO
+ ,lnsigman &
+#endif
+ )
+ else
+ call activate_modal( &
+ wbar, wmix, wdiab, wmin, wmax, &
+ temp(i,k), cs(i,k), naermod, numberOfModes, &
+ vaerosol, hygro, fn, fm, fluxn, &
+ fluxm,flux_fullact(k) &
+#ifdef OSLO_AERO
+ ,lnsigman &
+#endif
+ )
+ end if
+ !-- MH_2015/04/10
+ endif
+
+ dumc = (cldn_tmp - cldo_tmp)
+#ifdef OSLO_AERO
+ if (use_hetfrz_classnuc) then
+ fn_tmp(:) = fn_in(i,k,1:nmodes)
+ else
+ fn_tmp(:) = fn(:)
+ end if
+ fm_tmp(:) = fm(:)
+ fluxn_tmp(:) = fluxn(:)
+ fluxm_tmp(:) = fluxm(:)
+ fn(:) = 0.0_r8
+ fn_in(i,k,:) = 0.0_r8
+ fm(:) = 0.0_r8
+ fluxn(:)=0.0_r8
+ fluxm(:)= 0.0_r8
+ do m = 1, numberOfModes !Number of coexisting modes to be used for activation
+ kcomp = speciesMap(m) !This is the CAM-oslo mode (modes 1-14 may be activated, mode 0 not)
+ if (use_hetfrz_classnuc) then
+ fn_in(i,k,kcomp) = fn_tmp(m)
+ else
+ fn(kcomp) = fn_tmp(m)
+ end if
+ fm(kcomp) = fm_tmp(m)
+ fluxn(kcomp) = fluxn_tmp(m)
+ fluxm(kcomp) = fluxm_tmp(m)
+ enddo
+#endif
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+#ifdef OSLO_AERO
+ if (use_hetfrz_classnuc) then
+ dact = dumc*fn_in(i,k,m)*numberConcentration(i,k,m)/cs(i,k) !#/kg_{air}
+ else
+ dact = dumc*fn(m)*numberConcentration(i,k,m)/cs(i,k) !#/kg_{air}
+ end if
+#else
+ if (use_hetfrz_classnuc) then
+ dact = dumc*fn_in(i,k,m)*raer(mm)%fld(i,k) ! interstitial only
+ else
+ dact = dumc*fn(m)*raer(mm)%fld(i,k) ! interstitial only
+ end if
+#endif
+ qcld(k) = qcld(k) + dact
+ nsource(i,k) = nsource(i,k) + dact*dtinv
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+ dum = dumc*fm(m)
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+#ifdef OSLO_AERO
+ if(m .gt. nbmodes)then
+ constituentFraction = 1.0_r8
+ else
+ constituentFraction = componentFractionOK(k,m,getTracerIndex(m,l,.false.) )
+ endif
+
+ dact = dum*raer(mm)%fld(i,k)*constituentFraction
+#else
+ dact = dum*raer(mm)%fld(i,k) ! interstitial only
+#endif
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+#ifdef EXTRATESTS
+ if(i.eq.iDebug .and. getTracerIndex(m,l,.false.).eq.lDebug)then
+ print*,"growing cloud (new/old)", k, raercol_cw(k,mm,nsav), raercol_cw(k,mm,nsav)-dact &
+ ,raercol(k,mm,nsav),raercol(k,mm,nsav)+dact,dact
+ endif
+#endif
+ enddo
+ enddo
+ endif ! cldn_tmp-cldo_tmp > 0.01_r8
+
+ enddo ! grow_shrink_main_k_loop
+ ! end of k-loop for growing/shrinking cloud calcs ......................
+
+ ! ......................................................................
+ ! start of k-loop for calc of old cloud activation tendencies ..........
+ !
+ ! rce-comment
+ ! changed this part of code to use current cloud fraction (cldn) exclusively
+ ! consider case of cldo(:)=0, cldn(k)=1, cldn(k+1)=0
+ ! previous code (which used cldo below here) would have no cloud-base activation
+ ! into layer k. however, activated particles in k mix out to k+1,
+ ! so they are incorrectly depleted with no replacement
+
+ ! old_cloud_main_k_loop
+ do k = top_lev, pver
+ kp1 = min0(k+1, pver)
+ taumix_internal_pver_inv = 0.0_r8
+
+ if (lcldn(i,k) > 0.01_r8) then
+
+ wdiab = 0._r8
+ wmix = 0._r8 ! single updraft
+ wbar = wtke(i,k) ! single updraft
+ if (k == pver) wbar = wtke_cen(i,k) ! single updraft
+ wmax = 10._r8
+ wmin = 0._r8
+
+ if (lcldn(i,k) - lcldn(i,kp1) > 0.01_r8 .or. k == pver) then
+
+ ! cloud base
+
+ ! ekd(k) = wtke(i,k)*dz(i,k)/sq2pi
+ ! rce-comments
+ ! first, should probably have 1/zs(k) here rather than dz(i,k) because
+ ! the turbulent flux is proportional to ekd(k)*zs(k),
+ ! while the dz(i,k) is used to get flux divergences
+ ! and mixing ratio tendency/change
+ ! second and more importantly, using a single updraft velocity here
+ ! means having monodisperse turbulent updraft and downdrafts.
+ ! The sq2pi factor assumes a normal draft spectrum.
+ ! The fluxn/fluxm from activate must be consistent with the
+ ! fluxes calculated in explmix.
+ ekd(k) = wbar/zs(k)
+
+ alogarg = max(1.e-20_r8, 1._r8/lcldn(i,k) - 1._r8)
+ wmin = wbar + wmix*0.25_r8*sq2pi*log(alogarg)
+ phase = 1 ! interstitial
+#ifdef OSLO_AERO
+ naermod(:) = 0.0_r8
+ vaerosol(:) = 0.0_r8
+ hygro(:) = 0.0_r8
+ lnsigman(:) = log(2.0_r8)
+
+ m=0
+ do kcomp = 1,nmodes
+ if(hasAerosol(i,kp1,kcomp) .eqv. .TRUE.)then
+ m = m + 1
+ naermod(m) = numberConcentration(i,kp1,kcomp)
+ vaerosol(m) = volumeConcentration(i,kp1,kcomp)
+ hygro(m) = hygroscopicity(i,kp1,kcomp)
+ lnsigman(m) = lnsigma(i,kp1,kcomp)
+ speciesMap(m) = kcomp
+ end if
+ end do
+ numberOfModes = m
+#else
+ numberOfModes = ntot_amode
+
+ do m = 1, ntot_amode
+ ! rce-comment - use kp1 here as old-cloud activation involves
+ ! aerosol from layer below
+ call loadaer( &
+ state, pbuf, i, i, kp1, &
+ m, cs, phase, na, va, &
+ hy)
+ naermod(m) = na(i)
+ vaerosol(m) = va(i)
+ hygro(m) = hy(i)
+ end do
+#endif
+ !++ MH_2015/04/10
+ if(numberOfModes .gt. 0)then
+ if (use_hetfrz_classnuc) then
+ call activate_modal( &
+ wbar, wmix, wdiab, wmin, wmax, &
+ temp(i,k), cs(i,k), naermod, numberOfModes , &
+ vaerosol, hygro, fn_in(i,k,:), fm, fluxn, &
+ fluxm, flux_fullact(k) &
+#ifdef OSLO_AERO
+ ,lnsigman &
+#endif
+ )
+ else
+ call activate_modal( &
+ wbar, wmix, wdiab, wmin, wmax, &
+ temp(i,k), cs(i,k), naermod, numberOfModes , &
+ vaerosol, hygro, fn, fm, fluxn, &
+ fluxm, flux_fullact(k) &
+#ifdef OSLO_AERO
+ ,lnsigman &
+#endif
+ )
+ end if
+ !-- MH_2015/04/10
+ endif
+
+ !Difference in cloud fraction this layer and above!
+ !we are here because there are more clouds above, and some
+ !aerosols go into that layer! ==> calculate additional cloud fraction
+ if (k < pver) then
+ dumc = lcldn(i,k) - lcldn(i,kp1)
+ else
+ dumc = lcldn(i,k)
+ endif
+
+#ifdef OSLO_AERO
+ if (use_hetfrz_classnuc) then
+ fn_tmp(:) = fn_in(i,k,1:nmodes)
+ else
+ fn_tmp(:) = fn(:)
+ end if
+ fm_tmp(:) = fm(:)
+ fluxn_tmp(:) = fluxn(:)
+ fluxm_tmp(:) = fluxm(:)
+ fn(:) = 0.0_r8
+ fn_in(i,k,:) = 0.0_r8
+ fm(:) = 0.0_r8
+ fluxn(:)=0.0_r8
+ fluxm(:)= 0.0_r8
+ do m = 1, numberOfModes !Number of coexisting modes to be used for activation
+ kcomp = speciesMap(m) !This is the CAM-oslo mode (modes 1-14 may be activated, mode 0 not)
+ if (use_hetfrz_classnuc) then
+ fn_in(i,k,kcomp) = fn_tmp(m)
+ else
+ fn(kcomp) = fn_tmp(m)
+ end if
+ fm(kcomp) = fm_tmp(m)
+ fluxn(kcomp) = fluxn_tmp(m)
+ fluxm(kcomp) = fluxm_tmp(m)
+ enddo
+#endif
+
+ fluxntot = 0.0_r8
+
+ ! rce-comment 1
+ ! flux of activated mass into layer k (in kg/m2/s)
+ ! = "actmassflux" = dumc*fluxm*raercol(kp1,lmass)*csbot(k)
+ ! source of activated mass (in kg/kg/s) = flux divergence
+ ! = actmassflux/(cs(i,k)*dz(i,k))
+ ! so need factor of csbot_cscen = csbot(k)/cs(i,k)
+ ! dum=1./(dz(i,k))
+ dum=csbot_cscen(k)/(dz(i,k))
+
+ ! rce-comment 2
+ ! code for k=pver was changed to use the following conceptual model
+ ! in k=pver, there can be no cloud-base activation unless one considers
+ ! a scenario such as the layer being partially cloudy,
+ ! with clear air at bottom and cloudy air at top
+ ! assume this scenario, and that the clear/cloudy portions mix with
+ ! a timescale taumix_internal = dz(i,pver)/wtke_cen(i,pver)
+ ! in the absence of other sources/sinks, qact (the activated particle
+ ! mixratio) attains a steady state value given by
+ ! qact_ss = fcloud*fact*qtot
+ ! where fcloud is cloud fraction, fact is activation fraction,
+ ! qtot=qact+qint, qint is interstitial particle mixratio
+ ! the activation rate (from mixing within the layer) can now be
+ ! written as
+ ! d(qact)/dt = (qact_ss - qact)/taumix_internal
+ ! = qtot*(fcloud*fact*wtke/dz) - qact*(wtke/dz)
+ ! note that (fcloud*fact*wtke/dz) is equal to the nact/mact
+ ! also, d(qact)/dt can be negative. in the code below
+ ! it is forced to be >= 0
+ !
+ ! steve --
+ ! you will likely want to change this. i did not really understand
+ ! what was previously being done in k=pver
+ ! in the cam3_5_3 code, wtke(i,pver) appears to be equal to the
+ ! droplet deposition velocity which is quite small
+ ! in the cam3_5_37 version, wtke is done differently and is much
+ ! larger in k=pver, so the activation is stronger there
+ !
+ if (k == pver) then
+ taumix_internal_pver_inv = flux_fullact(k)/dz(i,k)
+ end if
+
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ fluxn(m) = fluxn(m)*dumc
+ fluxm(m) = fluxm(m)*dumc
+ nact(k,m) = nact(k,m) + fluxn(m)*dum
+ mact(k,m) = mact(k,m) + fluxm(m)*dum
+ if (k < pver) then
+ ! note that kp1 is used here
+ fluxntot = fluxntot &
+ + fluxn(m)*raercol(kp1,mm,nsav)*cs(i,k)
+ else
+ tmpa = raercol(kp1,mm,nsav)*fluxn(m) &
+ + raercol_cw(kp1,mm,nsav)*(fluxn(m) &
+ - taumix_internal_pver_inv*dz(i,k))
+ fluxntot = fluxntot + max(0.0_r8, tmpa)*cs(i,k)
+ end if
+ end do
+ srcn(k) = srcn(k) + fluxntot/(cs(i,k)*dz(i,k))
+ nsource(i,k) = nsource(i,k) + fluxntot/(cs(i,k)*dz(i,k))
+#ifdef EXTRATESTS
+ if(fluxntot/(cs(i,k)*dz(i,k)) > 0.0_r8 )then
+ print*,"activated/available(from below)",i,k,m,fluxntot/(cs(i,k)*dz(i,k))
+ endif
+#endif
+ endif ! (cldn(i,k) - cldn(i,kp1) > 0.01 .or. k == pver)
+
+ else ! i.e: cldn(i,k) < 0.01_r8
+
+ ! no liquid cloud
+
+ nsource(i,k) = nsource(i,k) - qcld(k)*dtinv
+ qcld(k) = 0.0_r8
+
+ if (cldn(i,k) < 0.01_r8) then
+ ! no ice cloud either
+
+ ! convert activated aerosol to interstitial in decaying cloud
+
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) + raercol_cw(k,mm,nsav) ! cloud-borne aerosol
+ raercol_cw(k,mm,nsav) = 0._r8
+
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+#ifdef EXTRATESTS
+ if(i.eq.iDebug .and. getTracerIndex(m,l,.false.).eq.lDebug)then
+ print*,"no cloud", k, raercol(k,mm,nsav) , raercol_cw(k,mm,nsav)
+ endif
+#endif
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) + raercol_cw(k,mm,nsav) ! cloud-borne aerosol
+ raercol_cw(k,mm,nsav) = 0._r8
+ end do
+ end do
+ end if
+ end if
+
+ end do ! old_cloud_main_k_loop
+
+ ! switch nsav, nnew so that nnew is the updated aerosol
+ ntemp = nsav
+ nsav = nnew
+ nnew = ntemp
+
+ ! load new droplets in layers above, below clouds
+
+ dtmin = dtmicro
+ ekk(top_lev-1) = 0.0_r8
+ ekk(pver) = 0.0_r8
+ do k = top_lev, pver-1
+ ! rce-comment -- ekd(k) is eddy-diffusivity at k/k+1 interface
+ ! want ekk(k) = ekd(k) * (density at k/k+1 interface)
+ ! so use pint(i,k+1) as pint is 1:pverp
+ ! ekk(k)=ekd(k)*2.*pint(i,k)/(rair*(temp(i,k)+temp(i,k+1)))
+ ! ekk(k)=ekd(k)*2.*pint(i,k+1)/(rair*(temp(i,k)+temp(i,k+1)))
+ ekk(k) = ekd(k)*csbot(k)
+ end do
+
+ do k = top_lev, pver
+ km1 = max0(k-1, top_lev)
+ ekkp(k) = zn(k)*ekk(k)*zs(k)
+ ekkm(k) = zn(k)*ekk(k-1)*zs(km1)
+ tinv = ekkp(k) + ekkm(k)
+
+ ! rce-comment -- tinv is the sum of all first-order-loss-rates
+ ! for the layer. for most layers, the activation loss rate
+ ! (for interstitial particles) is accounted for by the loss by
+ ! turb-transfer to the layer above.
+ ! k=pver is special, and the loss rate for activation within
+ ! the layer must be added to tinv. if not, the time step
+ ! can be too big, and explmix can produce negative values.
+ ! the negative values are reset to zero, resulting in an
+ ! artificial source.
+ if (k == pver) tinv = tinv + taumix_internal_pver_inv
+
+ if (tinv .gt. 1.e-6_r8) then
+ dtt = 1._r8/tinv
+ dtmin = min(dtmin, dtt)
+ end if
+ end do
+
+ dtmix = 0.9_r8*dtmin
+ nsubmix = dtmicro/dtmix + 1
+ if (nsubmix > 100) then
+ nsubmix_bnd = 100
+ else
+ nsubmix_bnd = nsubmix
+ end if
+ count_submix(nsubmix_bnd) = count_submix(nsubmix_bnd) + 1
+ dtmix = dtmicro/nsubmix
+
+ do k = top_lev, pver
+ kp1 = min(k+1, pver)
+ km1 = max(k-1, top_lev)
+ ! maximum overlap assumption
+ if (cldn(i,kp1) > 1.e-10_r8) then
+ overlapp(k) = min(cldn(i,k)/cldn(i,kp1), 1._r8)
+ else
+ overlapp(k) = 1._r8
+ end if
+ if (cldn(i,km1) > 1.e-10_r8) then
+ overlapm(k) = min(cldn(i,k)/cldn(i,km1), 1._r8)
+ else
+ overlapm(k) = 1._r8
+ end if
+ end do
+
+
+ ! rce-comment
+ ! the activation source(k) = mact(k,m)*raercol(kp1,lmass)
+ ! should not exceed the rate of transfer of unactivated particles
+ ! from kp1 to k which = ekkp(k)*raercol(kp1,lmass)
+ ! however it might if things are not "just right" in subr activate
+ ! the following is a safety measure to avoid negatives in explmix
+ do k = top_lev, pver-1
+ do m = 1, ntot_amode
+ nact(k,m) = min( nact(k,m), ekkp(k) )
+ mact(k,m) = min( mact(k,m), ekkp(k) )
+ end do
+ end do
+
+!Don't need the mixing per mode in OSLO_AERO ==> only per tracer
+!Note that nsav/nnew is switched above, so operate on nnew here
+!nnew is the updated aerosol
+#ifdef OSLO_AERO
+ raercol_tracer(:,:,:) = 0.0_r8
+ raercol_cw_tracer(:,:,:) = 0.0_r8
+ mact_tracer(:,:) = 0.0_r8
+ mfullact_tracer(:,:) = 0.0_r8
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr = getTracerIndex(m,l,.FALSE.) !which tracer are we talking about
+ lptr2 = inverseAerosolTracerList(lptr) !which index is this in the list of aerosol-tracers
+ mm = mam_idx(m,l)
+ raercol_tracer(:,lptr2,nnew) = raercol_tracer(:,lptr2,nnew) &
+ + raercol(:,mm,nnew)
+
+ raercol_cw_tracer(:,lptr2,nnew) = raercol_cw_tracer(:,lptr2,nnew)&
+ + raercol_cw(:,mm,nnew)
+
+ mact_tracer(:,lptr2) = mact_tracer(:,lptr2) + mact(:,m)*raercol(:,mm,nnew)
+ mfullact_tracer(:,lptr2) = mfullact_tracer(:,lptr2) + raercol(:,mm,nnew)
+
+#ifdef EXTRATESTS
+ if(lptr.eq.lDebug .and. i.eq.iDebug)then
+ do k=pver,top_lev,-1
+ print*, "assigning to tracer space",lptr, raercol(k,mm,nnew) &
+ , raercol_tracer(k,lptr2,nnew) &
+ , raercol_cw(k,mm,nnew) &
+ , raercol_cw_tracer(k,lptr2,nnew)
+ end do
+ end if
+#endif
+ end do !l
+ end do !m
+
+ do lptr2=1,n_aerosol_tracers
+ mact_tracer(:,lptr2) = mact_tracer(:,lptr2) &
+ /(mfullact_tracer(:,lptr2) + smallNumber)
+ end do
+#endif OSLO_AERO
+
+ ! old_cloud_nsubmix_loop
+ do n = 1, nsubmix
+ qncld(:) = qcld(:)
+ ! switch nsav, nnew so that nsav is the updated aerosol
+ ntemp = nsav
+ nsav = nnew
+ nnew = ntemp
+ srcn(:) = 0.0_r8
+
+ !First mix cloud droplet number concentration
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+
+ ! update droplet source
+ ! rce-comment- activation source in layer k involves particles from k+1
+ ! srcn(:)=srcn(:)+nact(:,m)*(raercol(:,mm,nsav))
+ srcn(top_lev:pver-1) = srcn(top_lev:pver-1) + nact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav))
+
+ ! rce-comment- new formulation for k=pver
+ ! srcn( pver )=srcn( pver )+nact( pver ,m)*(raercol( pver,mm,nsav))
+ tmpa = raercol(pver,mm,nsav)*nact(pver,m) &
+ + raercol_cw(pver,mm,nsav)*(nact(pver,m) - taumix_internal_pver_inv)
+ srcn(pver) = srcn(pver) + max(0.0_r8,tmpa)
+ end do
+
+ !mixing of cloud droplets
+ call explmix( &
+ qcld, srcn, ekkp, ekkm, overlapp, &
+ overlapm, qncld, zero, zero, pver, &
+ dtmix, .false.)
+
+#ifdef OSLO_AERO
+ !Mix number concentrations consistently!!
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ ! rce-comment - activation source in layer k involves particles from k+1
+ ! source(:)= nact(:,m)*(raercol(:,mm,nsav))
+ source(top_lev:pver-1) = nact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav))
+ ! rce-comment - new formulation for k=pver
+ ! source( pver )= nact( pver, m)*(raercol( pver,mm,nsav))
+ tmpa = raercol(pver,mm,nsav)*nact(pver,m) &
+ + raercol_cw(pver,mm,nsav)*(nact(pver,m) - taumix_internal_pver_inv)
+ source(pver) = max(0.0_r8, tmpa)
+ flxconv = 0._r8
+
+ call explmix( &
+ raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, &
+ dtmix, .false.)
+
+ call explmix( &
+ raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol(:,mm,nsav), zero, flxconv, pver, &
+ dtmix, .true., raercol_cw(:,mm,nsav))
+ end do
+#endif
+
+#ifndef OSLO_AERO
+ ! rce-comment
+ ! the interstitial particle mixratio is different in clear/cloudy portions
+ ! of a layer, and generally higher in the clear portion. (we have/had
+ ! a method for diagnosing the the clear/cloudy mixratios.) the activation
+ ! source terms involve clear air (from below) moving into cloudy air (above).
+ ! in theory, the clear-portion mixratio should be used when calculating
+ ! source terms
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ ! rce-comment - activation source in layer k involves particles from k+1
+ ! source(:)= nact(:,m)*(raercol(:,mm,nsav))
+ source(top_lev:pver-1) = nact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav))
+ ! rce-comment - new formulation for k=pver
+ ! source( pver )= nact( pver, m)*(raercol( pver,mm,nsav))
+ tmpa = raercol(pver,mm,nsav)*nact(pver,m) &
+ + raercol_cw(pver,mm,nsav)*(nact(pver,m) - taumix_internal_pver_inv)
+ source(pver) = max(0.0_r8, tmpa)
+ flxconv = 0._r8
+
+ call explmix( &
+ raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, &
+ dtmix, .false.)
+
+ call explmix( &
+ raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol(:,mm,nsav), zero, flxconv, pver, &
+ dtmix, .true., raercol_cw(:,mm,nsav))
+
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ ! rce-comment - activation source in layer k involves particles from k+1
+ ! source(:)= mact(:,m)*(raercol(:,mm,nsav))
+ source(top_lev:pver-1) = mact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav))
+ ! rce-comment- new formulation for k=pver
+ ! source( pver )= mact( pver ,m)*(raercol( pver,mm,nsav))
+ tmpa = raercol(pver,mm,nsav)*mact(pver,m) &
+ + raercol_cw(pver,mm,nsav)*(mact(pver,m) - taumix_internal_pver_inv)
+ source(pver) = max(0.0_r8, tmpa)
+ flxconv = 0._r8
+
+ call explmix( &
+ raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, &
+ dtmix, .false.)
+
+ call explmix( &
+ raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol(:,mm,nsav), zero, flxconv, pver, &
+ dtmix, .true., raercol_cw(:,mm,nsav))
+
+ end do
+ end do
+#endif
+ if (called_from_spcam) then
+ !
+ ! turbulent mixing for gas species .
+ !
+ do m=1, pcnst
+ if (cnst_species_class(m) == cnst_spec_class_gas) then
+ flxconv = 0.0_r8
+ zerogas(:) = 0.0_r8
+ call explmix(rgascol(1,m,nnew),zerogas,ekkp,ekkm,overlapp,overlapm, &
+ rgascol(1,m,nsav),zero, flxconv, pver,dtmix,&
+ .true., zerogas)
+ end if
+ end do
+ endif
+
+#ifdef OSLO_AERO
+ do lptr2=1,n_aerosol_tracers
+ source(top_lev:pver-1) = mact_tracer(top_lev:pver-1,lptr2) &
+ *(raercol_tracer(top_lev+1:pver,lptr2,nsav))
+
+ tmpa = raercol_tracer(pver,lptr2,nsav)*mact_tracer(pver,lptr2) &
+ + raercol_cw_tracer(pver,lptr2,nsav)*(mact_tracer(pver,lptr2) - taumix_internal_pver_inv)
+
+ source(pver) = max(0.0_r8, tmpa)
+ flxconv = 0.0_r8
+
+ call explmix( &
+ raercol_cw_tracer(:,lptr2,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol_cw_tracer(:,lptr2,nsav), zero, zero, pver, &
+ dtmix, .false.)
+
+ call explmix( &
+ raercol_tracer(:,lptr2,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol_tracer(:,lptr2,nsav), zero, flxconv, pver, &
+ dtmix, .true., raercol_cw_tracer(:,lptr2,nsav))
+
+#ifdef EXTRATESTS
+ lptr = aerosolTracerList(lptr2)
+ if(i.eq.iDebug .and. lptr.eq.lDebug)then
+ print*, "bugeds for ",trim(cnst_name(lptr)), n, nsubmix
+ do k=pver,1,-1
+ print*, "source (aerosol/cloud) ",k, raercol_cw_tracer(k,lptr2,nnew),raercol_cw_tracer(k,lptr2,nsav) &
+ , raercol_tracer(k,lptr2,nnew),raercol_tracer(k,lptr2,nsav),source(k)
+ end do
+ if(m .le. nbmodes)then
+ print*, " ", mm, lptr, componentFractionOK(k,m,getTracerIndex(m,l,.false.))
+ endif
+ endif
+#endif
+ end do !Number of aerosol tracers
+ end do ! old_cloud_nsubmix_loop
+
+ !Set back to the original framework
+ !Could probably continue in tracer-space from here
+ !but return back to mixture for easier use of std. NCAR code
+ tendencyCounted(:)=.FALSE.
+ do m = 1, ntot_amode
+ do l=1,nspec_amode(m)
+ mm=mam_idx(m,l)
+ lptr = getTracerIndex(m,l,.FALSE.)
+ lptr2 = inverseAerosolTracerList(lptr)
+ !All the tracer-space contains sum of all
+ !modes ==> put in first available component
+ !and zero in others.
+ if(.not.tendencyCounted(lptr))then
+ raercol(:,mm,nnew) = raercol_tracer(:,lptr2,nnew)
+ raercol_cw(:,mm,nnew) = raercol_cw_tracer(:,lptr2,nnew)
+ tendencyCounted(lptr) = .TRUE.
+ else
+ raercol(:,mm,nnew) = 0.0_r8
+ raercol_cw(:,mm,nnew) = 0.0_r8
+ end if
+ end do
+ end do
+#endif
+ ! evaporate particles again if no cloud
+
+ do k = top_lev, pver
+ if (cldn(i,k) == 0._r8) then
+ ! no ice or liquid cloud
+ qcld(k)=0._r8
+
+ ! convert activated aerosol to interstitial in decaying cloud
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ raercol(k,mm,nnew) = raercol(k,mm,nnew) + raercol_cw(k,mm,nnew)
+ raercol_cw(k,mm,nnew) = 0._r8
+
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ raercol(k,mm,nnew) = raercol(k,mm,nnew) + raercol_cw(k,mm,nnew)
+ raercol_cw(k,mm,nnew) = 0._r8
+ end do
+ end do
+ end if
+ end do
+
+ ! droplet number
+
+ ndropcol(i) = 0._r8
+
+ !Initialize tendnd to zero in all layers since values are set in only top_lev,pver
+ !Without this the layers above top_lev would be un-initialized
+ tendnd(i,:) = 0.0_r8
+
+ do k = top_lev, pver
+ ndropmix(i,k) = (qcld(k) - ncldwtr(i,k))*dtinv - nsource(i,k)
+ tendnd(i,k) = (max(qcld(k), 1.e-6_r8) - ncldwtr(i,k))*dtinv
+ !print*, "tendnd",i,k, "new /old/tend", qcld(k), ncldwtr(i,k), tendnd(i,k)
+ ndropcol(i) = ndropcol(i) + ncldwtr(i,k)*pdel(i,k)
+ end do
+ ndropcol(i) = ndropcol(i)/gravit
+
+#ifdef EXTRATESTS
+ print*, "tendnd (#/kg/sec)", minval(tendnd(i,:)), maxval(tendnd(i,:))
+#endif
+
+ if (prog_modal_aero) then
+
+#ifdef OSLO_AERO
+
+#ifdef MASS_BALANCE_CHECK
+ !test for correct transfer between in-cloud / no-cloud..
+ newCloud(:,:) = 0.0_r8
+ oldCloud(:,:) = 0.0_r8
+ newAerosol(:,:) = 0.0_r8
+ oldAerosol(:,:) = 0.0_r8
+ deltaCloud(:,:) = 0.0_r8
+ !Check mass balances #2 (all new cloud droplet species are taken from aerosols or from layer below
+ do k=pver,1,-1
+ mixRatioToMass = cs(i,k)*dz(i,k)
+ !First sum up cloud tracer in this layer
+ tendencyCounted(:)=.FALSE.
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ mm = mam_idx(m,l)
+ lptr = getTracerIndex(m,l,.false.) !lptr occurs several times
+ newCloud(k, lptr) = newCloud(k, lptr) + raercol_cw(k, mm, nnew)*mixRatioToMass
+ newAerosol(k, lptr) = newAerosol(k, lptr) + raercol(k,mm,nnew)*mixRatioToMass
+ if(.NOT. tendencyCounted(lptr))then
+ oldAerosol(k, lptr) = raer(mm)%fld(i,k)*mixRatioToMass
+ oldCloud(k, lptr) = qqcw(mm)%fld(i,k)*mixRatioToMass
+ tendencyCounted(lptr)=.TRUE.
+ endif
+ enddo
+ enddo
+ enddo! k
+
+ k = pver
+ !Check imbalance in bottom layer
+
+ !Any change in cloud species is either from aerosol concentration or from change in layer below
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr = getTracerIndex(m,l,.false.)
+
+ !This is the mass which must go to layer above!
+ deltaCloud(k,lptr) = (oldAerosol(k,lptr) - newAerosol(k,lptr)) &!used to create cloud species
+ -(newCloud(k,lptr) - oldCloud(k,lptr)) !created cloud species
+ enddo
+ enddo
+
+ !if "deltaCloud" is positive in layer below it means that some aerosol species were sent up
+
+ !Move upwards
+ do k=pver-1,1,-1
+ kp1 = k + 1
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr = getTracerIndex(m,l,.false.)
+ deltaCloud(k,lptr) = (oldAerosol(k,lptr)-newAerosol(k,lptr)) & !used to create cloud species
+ - (newCloud(k,lptr) - oldCloud(k,lptr)) & !created cloud species
+ - 0.0_r8 ! deltaCloud(kp1,lptr) !species received from below
+ enddo
+ enddo
+ enddo !layers
+
+ stopMe = .FALSE.
+ tendencyCounted(:) = .FALSE.
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr= getTracerIndex(m,l,.false.)
+ if(abs(sum(deltaCloud(:,lptr))) > 1.e-8_r8 .and. (.NOT. tendencyCounted(lptr)))then
+ stopMe = .TRUE.
+ lptr2 = lptr
+ print*, "wrong mass budget",i,lptr,cnst_name(lptr), sum(deltaCloud(:,lptr))
+ endif
+ tendencyCounted(lptr) = .TRUE.
+ enddo
+ enddo
+ if(stopMe)then
+ print*,"error in species : ", cnst_name(lptr2)
+ do k=pver,1,-1
+ print*, "budgets new/old ",k, newCloud(k,lptr2),oldCloud(k,lptr2),newaerosol(k,lptr2),oldAerosol(k,lptr2), deltaCloud(k,lptr2)
+ enddo
+ call endrun ("wrong mass budget in column")
+ endif
+#endif
+#endif
+ raertend = 0._r8
+ qqcwtend = 0._r8
+
+
+#ifndef OSLO_AERO
+ do m = 1, ntot_amode
+ do l = 0, nspec_amode(m)
+
+ mm = mam_idx(m,l)
+ lptr = mam_cnst_idx(m,l)
+
+ raertend(top_lev:pver) = (raercol(top_lev:pver,mm,nnew) - raer(mm)%fld(i,top_lev:pver))*dtinv
+ qqcwtend(top_lev:pver) = (raercol_cw(top_lev:pver,mm,nnew) - qqcw(mm)%fld(i,top_lev:pver))*dtinv
+
+ coltend(i,mm) = sum( pdel(i,:)*raertend )/gravit
+ coltend_cw(i,mm) = sum( pdel(i,:)*qqcwtend )/gravit
+
+ ptend%q(i,:,lptr) = 0.0_r8
+ ptend%q(i,top_lev:pver,lptr) = raertend(top_lev:pver) ! set tendencies for interstitial aerosol
+ qqcw(mm)%fld(i,:) = 0.0_r8
+ qqcw(mm)%fld(i,top_lev:pver) = raercol_cw(top_lev:pver,mm,nnew) ! update cloud-borne aerosol
+ end do
+ end do
+#else
+ !OSLO AEROSOLS ...
+
+ coltend_cw(i,:)=0.0_r8
+ coltend(i,:) = 0.0_r8
+
+ !Need to initialize first because process modes arrive several times
+ tendencyCounted(:) = .FALSE.
+ do m=1,ntot_amode
+ do l = 1,getNumberOfTracersInMode(m)
+ lptr = getTracerIndex(m,l,.false.)
+ mm = mam_idx(m,l)
+
+ !column tendencies for output
+ if(.NOT. tendencyCounted(lptr))then
+ coltend_cw(i,lptr) = coltend_cw(i,lptr) &
+ + sum( pdel(i,top_lev:pver)*(raercol_cw(top_lev:pver,mm,nnew) & !New, splitted,
+ - qqcw(mm)%fld(i,top_lev:pver) ) )/gravit*dtinv !Old, total
+ tendencyCounted(lptr) = .TRUE.
+ else !Already subtracted total old value, just add new
+ coltend_cw(i,lptr) = coltend_cw(i,lptr) &
+ + sum(pdel(i,top_lev:pver)*raercol_cw(top_lev:pver,mm,nnew))/gravit*dtinv !total already subtracted
+ end if
+
+ ptend%q(i,:,lptr) = 0.0_r8 !Initialize tendencies
+ qqcw(mm)%fld(i,:) = 0.0_r8 !Throw out old concentrations before summing new ones
+ end do ! Tracers
+ end do ! Modes
+
+ !First, sum up all the tracer mass concentrations
+ do m = 1, ntot_amode
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l) !tracer indices for aerosol mass mixing ratios in raer-arrays
+ lptr = getTracerIndex(m,l,.false.) !index in q-array (1-pcnst)
+
+ !This is a bit tricky since in our scheme the tracers can arrive several times
+ !the same tracer can exist in several modes, e.g. condensate!!
+ !Here we sum this into "qqcw" and "ptend" so that they contain TOTAL of those tracers
+
+ !raercol and raercol_cw do not have totals, they have process-tracers splitted onto modes
+
+ !Tendency at this point is the sum (original value subtracted below)
+ ptend%q(i,top_lev:pver,lptr) = ptend%q(i,top_lev:pver,lptr) + raercol(top_lev:pver,mm,nnew)
+ !for cloud water concentrations, we don't get tendency , only new concentration
+ qqcw(mm)%fld(i,top_lev:pver) = qqcw(mm)%fld(i,top_lev:pver) + raercol_cw(top_lev:pver,mm,nnew)
+
+ end do
+ end do
+
+ !Need this check due to some tracers (e.g. condensate) several times
+ tendencyCounted(:) = .FALSE.
+
+ ! Recalculating cloud-borne aerosol number mixing ratios
+ do m=1,ntot_amode
+
+ !Now that all new aerosol masses are summed up, we subtract the original concentrations to obtain the tendencies
+ do l= 1,nspec_amode(m)
+ mm = mam_idx(m,l)
+ lptr = getTracerIndex(m,l,.false.)
+ if(.NOT. tendencyCounted(lptr)) then
+ ptend%q(i,top_lev:pver,lptr) = (ptend%q(i,top_lev:pver,lptr) - raer(mm)%fld(i,top_lev:pver))*dtinv
+ coltend(i,lptr) = sum(pdel(i,top_lev:pver)*ptend%q(i,top_lev:pver,lptr))/gravit !Save column tendency
+ tendencyCounted(lptr) = .TRUE.
+ endif
+ end do !species
+ end do !modes
+#endif
+
+#ifdef MASS_BALANCE_CHECK
+ !Check mass balances (all removed should be in tendencies)
+ massBalance(:,:) = 0.0_r8
+ newMass(:,:) = 0.0_r8
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ mm = mam_idx(m,l) !unique index, for example sulfate condendsate in "x mode" or sulf cond in "y mode"
+ lptr = getTracerIndex(m,l,.false.)
+ !add up all new values for this tracer
+ newMass(top_lev:pver,lptr) = newMass(top_lev:pver,lptr) + raercol(top_lev:pver, mm,nnew)
+ enddo
+ enddo
+ tendencyCounted(:)=.FALSE.
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ mm = mam_idx(m,l)
+ lptr = getTracerIndex(m,l,.false.)
+ if(.NOT. tendencyCounted(lptr))then
+ massBalance(top_lev:pver, lptr) = newMass(top_lev:pver,lptr) &
+ - raer(mm)%fld(i,top_lev:pver) & !previous value
+ - ptend%q(i,top_lev:pver,lptr)/dtinv !added during time step
+ tendencyCounted(lptr) = .TRUE.
+ endif
+ enddo
+ enddo
+ tendencyCounted(:) = .FALSE.
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr = getTracerIndex(m,l,.false.)
+ !Check for large deviation in mass balance for this tracer
+ if(.NOT. tendencyCounted(lptr) .and. &
+ (maxval(massBalance(:,lptr)) > 1.e-30_r8 .or. minval(massBalance(:,lptr)) < -1.0e-30_r8))then
+ tendencyCounted(lptr) = .TRUE.
+ print*, "massBalance error", i, lptr, maxVal(massBalance(:,lptr)), minVal(massBalance(:,lptr))
+ if(maxVal(massBalance(:,lptr)) > 1.e-30_r8)then
+ kCrit = maxLoc(massBalance(:,lptr),1)
+ else
+ kCrit = minLoc(massBalance(:,lptr),1)
+ endif
+ print*, "massBalance error loc", massBalance(kCrit, lptr), newMass(kCrit,lptr), raer(mm)%fld(i,kCrit)
+ !If mass balance error is larger than 1.e-10 times new or original value ==> stop
+ if(abs(massBalance(kCrit,lptr)) .gt. 1.e-10_r8*raer(mm)%fld(i,kCrit) &
+ .and. abs(massBalance(kCrit,lptr)).gt.1.e-10_r8*newMass(kCrit,lptr) )then
+ stop
+ endif
+ endif
+ enddo
+ enddo
+#endif
+
+
+ end if !prog_modal_aero
+
+ if (called_from_spcam) then
+ !
+ ! Gas tendency
+ !
+ do m=1, pcnst
+ if (cnst_species_class(m) == cnst_spec_class_gas) then
+ ptend%lq(m) = .true.
+ ptend%q(i, :, m) = (rgascol(:,m,nnew)-rgas(i,:,m)) * dtinv
+ end if
+ end do
+ endif
+
+ end do ! overall_main_i_loop
+
+#ifdef EXTRATESTS
+ !check reasonable values for ncldwtr!
+ do k=top_lev,pver
+ if(maxval(ncldwtr(:ncol,k)) .gt. 1.e20_r8)then
+ print*, "stopping (after dropmixnuc) wrong ncldwtr", maxloc(ncldwtr(:ncol,k))
+ do i=1,ncol
+ print*, "ncldwtr",i,k,ncldwtr(i,k)
+ enddo
+ call endrun("wrong ncldwtr (end of dropmixnuc)")
+ end if
+ end do !loop on layers
+#endif
+
+ ! end of main loop over i/longitude ....................................
+
+ call outfld('NDROPCOL', ndropcol, pcols, lchnk)
+ call outfld('NDROPSRC', nsource, pcols, lchnk)
+ call outfld('NDROPMIX', ndropmix, pcols, lchnk)
+ call outfld('WTKE ', wtke, pcols, lchnk)
+
+#ifndef OSLO_AERO
+ !fxm: Make this work with the oslo aerosols also!
+ call ccncalc(state, pbuf, cs, ccn)
+#else
+ if (history_aerosol) then
+ call ccncalc_oslo(state &
+ , pbuf &
+ , cs &
+!+tht
+ , hasAerosol &
+!-tht
+ , numberConcentration &
+ , volumeConcentration &
+ , hygroscopicity &
+ , lnSigma &
+ , ccn )
+ end if
+#endif
+ if(history_aerosol) then
+ do l = 1, psat
+ call outfld(ccn_name(l), ccn(1,1,l), pcols, lchnk)
+ enddo
+ end if
+#ifndef OSLO_AERO
+ ! do column tendencies
+ if (prog_modal_aero) then
+ do m = 1, ntot_amode
+ do l = 0, nspec_amode(m)
+ mm = mam_idx(m,l)
+ call outfld(fieldname(mm), coltend(:,mm), pcols, lchnk)
+ call outfld(fieldname_cw(mm), coltend_cw(:,mm), pcols, lchnk)
+ end do
+ end do
+ end if
+#endif
+
+ if(called_from_spcam) then
+ !
+ ! output column-integrated Gas tendency (this should be zero)
+ !
+ do m=1, pcnst
+ if (cnst_species_class(m) == cnst_spec_class_gas) then
+ do i=1, ncol
+ coltendgas(i) = sum( pdel(i,:)*ptend%q(i,:,m) )/gravit
+ end do
+ fieldnamegas = trim(cnst_name(m)) // '_mixnuc1sp'
+ call outfld( trim(fieldnamegas), coltendgas, pcols, lchnk)
+ end if
+ end do
+ deallocate(rgascol, coltendgas)
+ end if
+
+#ifdef OSLO_AERO
+ tendencyCounted(:)=.FALSE.
+ do m = 1, ntot_amode
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ lptr = getTracerIndex(m,l,.false.)
+ if(.NOT. tendencyCounted(lptr))then
+ call outfld(fieldname(mm), coltend(:,lptr), pcols,lchnk)
+ call outfld(fieldname_cw(mm), coltend_cw(:,lptr), pcols,lchnk)
+ tendencyCounted(lptr)=.TRUE.
+ endif
+ end do
+ end do
+#endif
+
+ deallocate( &
+ nact, &
+ mact, &
+ raer, &
+ qqcw, &
+ raercol, &
+ raercol_cw, &
+ coltend, &
+ coltend_cw, &
+ naermod, &
+ hygro, &
+#ifdef OSLO_AERO
+ lnsigman, & !Variable std. dev (CAM-Oslo)
+#endif
+ vaerosol, &
+ fn, &
+ fm, &
+ fluxn, &
+ fluxm )
+
+#ifdef OSLO_AERO
+ deallocate (fluxm_tmp)
+ deallocate (fluxn_tmp)
+ deallocate (fm_tmp)
+ deallocate (fn_tmp)
+ deallocate(raercol_tracer)
+ deallocate(raercol_cw_tracer)
+ deallocate(mact_tracer)
+ deallocate(mfullact_tracer)
+#endif
+
+
+end subroutine dropmixnuc
+
+!===============================================================================
+
+subroutine explmix( q, src, ekkp, ekkm, overlapp, overlapm, &
+ qold, surfrate, flxconv, pver, dt, is_unact, qactold )
+
+ ! explicit integration of droplet/aerosol mixing
+ ! with source due to activation/nucleation
+
+
+ integer, intent(in) :: pver ! number of levels
+ real(r8), intent(out) :: q(pver) ! mixing ratio to be updated
+ real(r8), intent(in) :: qold(pver) ! mixing ratio from previous time step
+ real(r8), intent(in) :: src(pver) ! source due to activation/nucleation (/s)
+ real(r8), intent(in) :: ekkp(pver) ! zn*zs*density*diffusivity (kg/m3 m2/s) at interface
+ ! below layer k (k,k+1 interface)
+ real(r8), intent(in) :: ekkm(pver) ! zn*zs*density*diffusivity (kg/m3 m2/s) at interface
+ ! above layer k (k,k+1 interface)
+ real(r8), intent(in) :: overlapp(pver) ! cloud overlap below
+ real(r8), intent(in) :: overlapm(pver) ! cloud overlap above
+ real(r8), intent(in) :: surfrate ! surface exchange rate (/s)
+ real(r8), intent(in) :: flxconv ! convergence of flux from surface
+ real(r8), intent(in) :: dt ! time step (s)
+ logical, intent(in) :: is_unact ! true if this is an unactivated species
+ real(r8), intent(in),optional :: qactold(pver)
+ ! mixing ratio of ACTIVATED species from previous step
+ ! *** this should only be present
+ ! if the current species is unactivated number/sfc/mass
+
+ integer k,kp1,km1
+
+ if ( is_unact ) then
+ ! the qactold*(1-overlap) terms are resuspension of activated material
+ do k=top_lev,pver
+ kp1=min(k+1,pver)
+ km1=max(k-1,top_lev)
+ q(k) = qold(k) + dt*( - src(k) + ekkp(k)*(qold(kp1) - qold(k) + &
+ qactold(kp1)*(1.0_r8-overlapp(k))) &
+ + ekkm(k)*(qold(km1) - qold(k) + &
+ qactold(km1)*(1.0_r8-overlapm(k))) )
+ ! force to non-negative
+ ! if(q(k)<-1.e-30)then
+ ! write(iulog,*)'q=',q(k),' in explmix'
+ q(k)=max(q(k),0._r8)
+ ! endif
+ end do
+
+ ! diffusion loss at base of lowest layer
+ q(pver)=q(pver)-surfrate*qold(pver)*dt+flxconv*dt
+ ! force to non-negative
+ ! if(q(pver)<-1.e-30)then
+ ! write(iulog,*)'q=',q(pver),' in explmix'
+ q(pver)=max(q(pver),0._r8)
+ ! endif
+ else
+ do k=top_lev,pver
+ kp1=min(k+1,pver)
+ km1=max(k-1,top_lev)
+ q(k) = qold(k) + dt*(src(k) + ekkp(k)*(overlapp(k)*qold(kp1)-qold(k)) + &
+ ekkm(k)*(overlapm(k)*qold(km1)-qold(k)) )
+ ! force to non-negative
+ ! if(q(k)<-1.e-30)then
+ ! write(iulog,*)'q=',q(k),' in explmix'
+ q(k)=max(q(k),0._r8)
+ ! endif
+ end do
+ ! diffusion loss at base of lowest layer
+ q(pver)=q(pver)-surfrate*qold(pver)*dt+flxconv*dt
+ ! force to non-negative
+ ! if(q(pver)<-1.e-30)then
+ ! write(iulog,*)'q=',q(pver),' in explmix'
+ q(pver)=max(q(pver),0._r8)
+
+ end if
+
+end subroutine explmix
+
+!===============================================================================
+
+subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, &
+ na, nmode, volume, hygro, &
+ fn, fm, fluxn, fluxm, flux_fullact, lnsigman )
+
+ ! calculates number, surface, and mass fraction of aerosols activated as CCN
+ ! calculates flux of cloud droplets, surface area, and aerosol mass into cloud
+ ! assumes an internal mixture within each of up to nmode multiple aerosol modes
+ ! a gaussiam spectrum of updrafts can be treated.
+
+ ! mks units
+
+ ! Abdul-Razzak and Ghan, A parameterization of aerosol activation.
+ ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844.
+
+
+ ! input
+
+ real(r8), intent(in) :: wbar ! grid cell mean vertical velocity (m/s)
+ real(r8), intent(in) :: sigw ! subgrid standard deviation of vertical vel (m/s)
+ real(r8), intent(in) :: wdiab ! diabatic vertical velocity (0 if adiabatic)
+ real(r8), intent(in) :: wminf ! minimum updraft velocity for integration (m/s)
+ real(r8), intent(in) :: wmaxf ! maximum updraft velocity for integration (m/s)
+ real(r8), intent(in) :: tair ! air temperature (K)
+ real(r8), intent(in) :: rhoair ! air density (kg/m3)
+ real(r8), intent(in) :: na(:) ! aerosol number concentration (/m3)
+ integer, intent(in) :: nmode ! number of aerosol modes
+ real(r8), intent(in) :: volume(:) ! aerosol volume concentration (m3/m3)
+ real(r8), intent(in) :: hygro(:) ! hygroscopicity of aerosol mode
+ real(r8), intent(in), optional :: lnsigman(:)
+
+ ! output
+
+ real(r8), intent(out) :: fn(:) ! number fraction of aerosols activated
+ real(r8), intent(out) :: fm(:) ! mass fraction of aerosols activated
+ real(r8), intent(out) :: fluxn(:) ! flux of activated aerosol number fraction into cloud (cm/s)
+ real(r8), intent(out) :: fluxm(:) ! flux of activated aerosol mass fraction into cloud (cm/s)
+ real(r8), intent(out) :: flux_fullact ! flux of activated aerosol fraction assuming 100% activation (cm/s)
+ ! rce-comment
+ ! used for consistency check -- this should match (ekd(k)*zs(k))
+ ! also, fluxm/flux_fullact gives fraction of aerosol mass flux
+ ! that is activated
+
+ ! local
+
+ integer, parameter:: nx=200
+ integer iquasisect_option, isectional
+ real(r8) integ,integf
+ real(r8), parameter :: p0 = 1013.25e2_r8 ! reference pressure (Pa)
+ real(r8) xmin(nmode),xmax(nmode) ! ln(r) at section interfaces
+ real(r8) volmin(nmode),volmax(nmode) ! volume at interfaces
+ real(r8) tmass ! total aerosol mass concentration (g/cm3)
+ real(r8) sign(nmode) ! geometric standard deviation of size distribution
+ real(r8) rm ! number mode radius of aerosol at max supersat (cm)
+ real(r8) pres ! pressure (Pa)
+ real(r8) path ! mean free path (m)
+ real(r8) diff ! diffusivity (m2/s)
+ real(r8) conduct ! thermal conductivity (Joule/m/sec/deg)
+ real(r8) diff0,conduct0
+ real(r8) es ! saturation vapor pressure
+ real(r8) qs ! water vapor saturation mixing ratio
+ real(r8) dqsdt ! change in qs with temperature
+ real(r8) dqsdp ! change in qs with pressure
+ real(r8) g ! thermodynamic function (m2/s)
+ real(r8) zeta(nmode), eta(nmode)
+ real(r8) lnsmax ! ln(smax)
+ real(r8) alpha
+ real(r8) gamma
+ real(r8) beta
+ real(r8) sqrtg
+ real(r8) :: amcube(nmode) ! cube of dry mode radius (m)
+ !++alfgr (ununsed) real(r8) :: smcrit(nmode) ! critical supersatuation for activation
+ real(r8) :: lnsm(nmode) ! ln(smcrit)
+ real(r8) smc(nmode) ! critical supersaturation for number mode radius
+ real(r8) sumflx_fullact
+ real(r8) sumflxn(nmode)
+ real(r8) sumflxm(nmode)
+ real(r8) sumfn(nmode)
+ real(r8) sumfm(nmode)
+ real(r8) fnold(nmode) ! number fraction activated
+ real(r8) fmold(nmode) ! mass fraction activated
+ real(r8) exp45logsig_var(nmode) !variable std. dev (CAM-Oslo)
+ real(r8), target :: f1_var(nmode), f2_var(nmode)
+ real(r8) wold,gold
+ real(r8) alogam
+ real(r8) rlo,rhi,xint1,xint2,xint3,xint4
+ real(r8) wmin,wmax,w,dw,dwmax,dwmin,wnuc,dwnew,wb
+ real(r8) dfmin,dfmax,fnew,fold,fnmin,fnbar,fsbar,fmbar
+ real(r8) alw,sqrtalw
+ real(r8) smax
+ real(r8) x,arg
+ real(r8) xmincoeff,xcut,volcut,surfcut
+ real(r8) z,z1,z2,wf1,wf2,zf1,zf2,gf1,gf2,gf
+ real(r8) etafactor1,etafactor2(nmode),etafactor2max
+ real(r8) grow
+ character(len=*), parameter :: subname='activate_modal'
+ integer m,n
+ ! numerical integration parameters
+ real(r8), parameter :: eps=0.3_r8,fmax=0.99_r8,sds=3._r8
+
+ real(r8), parameter :: namin=1.e6_r8 ! minimum aerosol number concentration (/m3)
+
+ integer ndist(nx) ! accumulates frequency distribution of integration bins required
+ data ndist/nx*0/
+ save ndist
+
+ fn(:)=0._r8
+ fm(:)=0._r8
+ fluxn(:)=0._r8
+ fluxm(:)=0._r8
+ flux_fullact=0._r8
+
+ if(nmode.eq.1.and.na(1).lt.1.e-20_r8)return
+
+ if(sigw.le.1.e-5_r8.and.wbar.le.0._r8)return
+
+ pres=rair*rhoair*tair
+ diff0=0.211e-4_r8*(p0/pres)*(tair/t0)**1.94_r8
+ conduct0=(5.69_r8+0.017_r8*(tair-t0))*4.186e2_r8*1.e-5_r8 ! convert to J/m/s/deg
+ call qsat(tair, pres, es, qs)
+ dqsdt=latvap/(rh2o*tair*tair)*qs
+ alpha=gravit*(latvap/(cpair*rh2o*tair*tair)-1._r8/(rair*tair))
+ gamma=(1.0_r8+latvap/cpair*dqsdt)/(rhoair*qs)
+ etafactor2max=1.e10_r8/(alpha*wmaxf)**1.5_r8 ! this should make eta big if na is very small.
+
+ grow = 1._r8/(rhoh2o/(diff0*rhoair*qs) &
+ + latvap*rhoh2o/(conduct0*tair)*(latvap/(rh2o*tair) - 1._r8))
+ sqrtg = sqrt(grow)
+ beta = 2._r8*pi*rhoh2o*grow*gamma
+
+ do m=1,nmode
+
+ if(volume(m).gt.1.e-39_r8.and.na(m).gt.1.e-39_r8)then
+ ! number mode radius (m)
+ ! write(iulog,*)'alogsig,volc,na=',alogsig(m),volc(m),na(m)
+#ifdef OSLO_AERO
+ if(present(lnsigman))then
+ exp45logsig_var(m) = exp(4.5_r8*lnsigman(m)*lnsigman(m))
+ amcube(m)=(3._r8*volume(m)/(4._r8*pi*exp45logsig_var(m)*na(m))) ! only if variable size dist
+ f1_var(m) = 0.5_r8*exp(2.5_r8*lnsigman(m)*lnsigman(m))
+ f2_var(m) = 1._r8 + 0.25_r8*lnsigman(m)
+ else
+ call endrun("Problem with variable std. dev")
+ endif
+#else
+ !Std cam
+ amcube(m)=(3._r8*volume(m)/(4._r8*pi*exp45logsig(m)*na(m))) ! only if variable size dist
+#endif
+ ! growth coefficent Abdul-Razzak & Ghan 1998 eqn 16
+ ! should depend on mean radius of mode to account for gas kinetic effects
+ ! see Fountoukis and Nenes, JGR2005 and Meskhidze et al., JGR2006
+ ! for approriate size to use for effective diffusivity.
+ etafactor2(m)=1._r8/(na(m)*beta*sqrtg)
+ if(hygro(m).gt.1.e-10_r8)then
+ smc(m)=2._r8*aten*sqrt(aten/(27._r8*hygro(m)*amcube(m))) ! only if variable size dist
+ else
+ smc(m)=100._r8
+ endif
+ ! write(iulog,*)'sm,hygro,amcube=',smcrit(m),hygro(m),amcube(m)
+ else
+ smc(m)=1._r8
+ etafactor2(m)=etafactor2max ! this should make eta big if na is very small.
+ endif
+ lnsm(m)=log(smc(m)) ! only if variable size dist
+ ! write(iulog,'(a,i4,4g12.2)')'m,na,amcube,hygro,sm,lnsm=', &
+ ! m,na(m),amcube(m),hygro(m),sm(m),lnsm(m)
+ enddo
+
+ if(sigw.gt.1.e-5_r8)then ! spectrum of updrafts
+
+ wmax=min(wmaxf,wbar+sds*sigw)
+ wmin=max(wminf,-wdiab)
+ wmin=max(wmin,wbar-sds*sigw)
+ w=wmin
+ dwmax=eps*sigw
+ dw=dwmax
+ dfmax=0.2_r8
+ dfmin=0.1_r8
+ if (wmax <= w) return
+ do m=1,nmode
+ sumflxn(m)=0._r8
+ sumfn(m)=0._r8
+ fnold(m)=0._r8
+ sumflxm(m)=0._r8
+ sumfm(m)=0._r8
+ fmold(m)=0._r8
+ enddo
+ sumflx_fullact=0._r8
+
+ fold=0._r8
+ wold=0._r8
+ gold=0._r8
+
+ dwmin = min( dwmax, 0.01_r8 )
+ do n = 1, nx
+
+100 wnuc=w+wdiab
+ ! write(iulog,*)'wnuc=',wnuc
+ alw=alpha*wnuc
+ sqrtalw=sqrt(alw)
+ etafactor1=alw*sqrtalw
+
+ do m=1,nmode
+ eta(m)=etafactor1*etafactor2(m)
+ zeta(m)=twothird*sqrtalw*aten/sqrtg
+ enddo
+
+ call maxsat(zeta,eta,nmode,smc,smax &
+#ifdef OSLO_AERO
+ ,f1_var, f2_var &
+#endif
+ )
+ ! write(iulog,*)'w,smax=',w,smax
+
+ lnsmax=log(smax)
+
+#ifdef OSLO_AERO
+ x=twothird*(lnsm(nmode)-lnsmax)/(sq2*lnsigman(nmode))
+#else
+ x=twothird*(lnsm(nmode)-lnsmax)/(sq2*alogsig(nmode))
+#endif
+ fnew=0.5_r8*(1._r8-erf(x))
+
+
+ dwnew = dw
+ if(fnew-fold.gt.dfmax.and.n.gt.1)then
+ ! reduce updraft increment for greater accuracy in integration
+ if (dw .gt. 1.01_r8*dwmin) then
+ dw=0.7_r8*dw
+ dw=max(dw,dwmin)
+ w=wold+dw
+ go to 100
+ else
+ dwnew = dwmin
+ endif
+ endif
+
+ if(fnew-fold.lt.dfmin)then
+ ! increase updraft increment to accelerate integration
+ dwnew=min(1.5_r8*dw,dwmax)
+ endif
+ fold=fnew
+
+ z=(w-wbar)/(sigw*sq2)
+ g=exp(-z*z)
+ fnmin=1._r8
+ xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3
+
+ do m=1,nmode
+ ! modal
+#ifdef OSLO_AERO
+ x=twothird*(lnsm(m)-lnsmax)/(sq2*lnsigman(m))
+#else
+ x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m))
+#endif
+ fn(m)=0.5_r8*(1._r8-erf(x))
+ fnmin=min(fn(m),fnmin)
+ ! integration is second order accurate
+ ! assumes linear variation of f*g with w
+ fnbar=(fn(m)*g+fnold(m)*gold)
+#ifdef OSLO_AERO
+ arg=x-1.5_r8*sq2*lnsigman(m)
+#else
+ arg=x-1.5_r8*sq2*alogsig(m)
+#endif
+ fm(m)=0.5_r8*(1._r8-erf(arg))
+ fmbar=(fm(m)*g+fmold(m)*gold)
+ wb=(w+wold)
+ if(w.gt.0._r8)then
+ sumflxn(m)=sumflxn(m)+sixth*(wb*fnbar &
+ +(fn(m)*g*w+fnold(m)*gold*wold))*dw
+ sumflxm(m)=sumflxm(m)+sixth*(wb*fmbar &
+ +(fm(m)*g*w+fmold(m)*gold*wold))*dw
+ endif
+ sumfn(m)=sumfn(m)+0.5_r8*fnbar*dw
+ ! write(iulog,'(a,9g10.2)')'lnsmax,lnsm(m),x,fn(m),fnold(m),g,gold,fnbar,dw=',lnsmax,lnsm(m),x,fn(m),fnold(m),g,gold,fnbar,dw
+ fnold(m)=fn(m)
+ sumfm(m)=sumfm(m)+0.5_r8*fmbar*dw
+ fmold(m)=fm(m)
+ enddo
+ ! same form as sumflxm but replace the fm with 1.0
+ sumflx_fullact = sumflx_fullact &
+ + sixth*(wb*(g+gold) + (g*w+gold*wold))*dw
+ ! sumg=sumg+0.5_r8*(g+gold)*dw
+ gold=g
+ wold=w
+ dw=dwnew
+ if (n > 1 .and. (w > wmax .or. fnmin > fmax)) exit
+ w=w+dw
+ if (n == nx) then
+ write(iulog,*)'do loop is too short in activate'
+ write(iulog,*)'wmin=',wmin,' w=',w,' wmax=',wmax,' dw=',dw
+ write(iulog,*)'wbar=',wbar,' sigw=',sigw,' wdiab=',wdiab
+ write(iulog,*)'wnuc=',wnuc
+ write(iulog,*)'na=',(na(m),m=1,nmode)
+ write(iulog,*)'fn=',(fn(m),m=1,nmode)
+ ! dump all subr parameters to allow testing with standalone code
+ ! (build a driver that will read input and call activate)
+ write(iulog,*)'wbar,sigw,wdiab,tair,rhoair,nmode='
+ write(iulog,*) wbar,sigw,wdiab,tair,rhoair,nmode
+ write(iulog,*)'na=',na
+ write(iulog,*)'volume=', (volume(m),m=1,nmode)
+ write(iulog,*)'hydro='
+ write(iulog,*) hygro
+ call endrun(subname)
+ end if
+
+ enddo
+
+ ndist(n)=ndist(n)+1
+ if(w.lt.wmaxf)then
+
+ ! contribution from all updrafts stronger than wmax
+ ! assuming constant f (close to fmax)
+ wnuc=w+wdiab
+
+ z1=(w-wbar)/(sigw*sq2)
+ z2=(wmaxf-wbar)/(sigw*sq2)
+ g=exp(-z1*z1)
+ integ=sigw*0.5_r8*sq2*sqpi*(erf(z2)-erf(z1))
+ ! consider only upward flow into cloud base when estimating flux
+ wf1=max(w,zero)
+ zf1=(wf1-wbar)/(sigw*sq2)
+ gf1=exp(-zf1*zf1)
+ wf2=max(wmaxf,zero)
+ zf2=(wf2-wbar)/(sigw*sq2)
+ gf2=exp(-zf2*zf2)
+ gf=(gf1-gf2)
+ integf=wbar*sigw*0.5_r8*sq2*sqpi*(erf(zf2)-erf(zf1))+sigw*sigw*gf
+
+ do m=1,nmode
+ sumflxn(m)=sumflxn(m)+integf*fn(m)
+ sumfn(m)=sumfn(m)+fn(m)*integ
+ sumflxm(m)=sumflxm(m)+integf*fm(m)
+ sumfm(m)=sumfm(m)+fm(m)*integ
+ enddo
+ ! same form as sumflxm but replace the fm with 1.0
+ sumflx_fullact = sumflx_fullact + integf
+ ! sumg=sumg+integ
+ endif
+
+
+ do m=1,nmode
+ fn(m)=sumfn(m)/(sq2*sqpi*sigw)
+ ! fn(m)=sumfn(m)/(sumg)
+ if(fn(m).gt.1.01_r8)then
+ write(iulog,*)'fn=',fn(m),' > 1 in activate'
+ write(iulog,*)'w,m,na,amcube=',w,m,na(m),amcube(m)
+ write(iulog,*)'integ,sumfn,sigw=',integ,sumfn(m),sigw
+ call endrun('activate')
+ endif
+ fluxn(m)=sumflxn(m)/(sq2*sqpi*sigw)
+ fm(m)=sumfm(m)/(sq2*sqpi*sigw)
+ ! fm(m)=sumfm(m)/(sumg)
+ if(fm(m).gt.1.01_r8)then
+ write(iulog,*)'fm=',fm(m),' > 1 in activate'
+ endif
+ fluxm(m)=sumflxm(m)/(sq2*sqpi*sigw)
+ enddo
+ ! same form as fluxm
+ flux_fullact = sumflx_fullact/(sq2*sqpi*sigw)
+
+ else
+
+ ! single updraft
+ wnuc=wbar+wdiab
+
+ if(wnuc.gt.0._r8)then
+
+ w=wbar
+ alw=alpha*wnuc
+ sqrtalw=sqrt(alw)
+ etafactor1=alw*sqrtalw
+
+ do m=1,nmode
+ eta(m)=etafactor1*etafactor2(m)
+ zeta(m)=twothird*sqrtalw*aten/sqrtg
+#ifdef OSLO_AERO
+ if(present(lnsigman))then
+ f1_var(m) = 0.5_r8*exp(2.5_r8*lnsigman(m)*lnsigman(m))
+ f2_var(m) = 1._r8 + 0.25_r8*lnsigman(m)
+ else
+ call endrun("Problem with variable std. dev single updraft")
+ endif
+#endif
+ enddo
+
+ call maxsat(zeta,eta,nmode,smc,smax &
+#ifdef OSLO_AERO
+ ,f1_var, f2_var &
+#endif
+ )
+
+ lnsmax=log(smax)
+ xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3
+
+
+ do m=1,nmode
+#ifdef OSLO_AERO
+ x=twothird*(lnsm(m)-lnsmax)/(sq2*lnsigman(m))
+#else
+ x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m))
+#endif
+ fn(m)=0.5_r8*(1._r8-erf(x))
+#ifdef OSLO_AERO
+ arg=x-1.5_r8*sq2*lnsigman(m)
+#else
+ arg=x-1.5_r8*sq2*alogsig(m)
+#endif
+ fm(m)=0.5_r8*(1._r8-erf(arg))
+ if(wbar.gt.0._r8)then
+ fluxn(m)=fn(m)*w
+ fluxm(m)=fm(m)*w
+ endif
+ enddo
+ flux_fullact = w
+ endif
+
+ endif
+
+end subroutine activate_modal
+
+!===============================================================================
+
+subroutine maxsat(zeta,eta,nmode,smc,smax, f1_in, f2_in)
+
+ ! calculates maximum supersaturation for multiple
+ ! competing aerosol modes.
+
+ ! Abdul-Razzak and Ghan, A parameterization of aerosol activation.
+ ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844.
+
+ integer, intent(in) :: nmode ! number of modes
+ real(r8), intent(in) :: smc(nmode) ! critical supersaturation for number mode radius
+ real(r8), intent(in) :: zeta(nmode)
+ real(r8), intent(in) :: eta(nmode)
+ real(r8), intent(in), optional, target :: f1_in(:)
+ real(r8), intent(in), optional, target :: f2_in(:)
+
+ real(r8), intent(out) :: smax ! maximum supersaturation
+ integer :: m ! mode index
+ real(r8) :: sum, g1, g2, g1sqrt, g2sqrt
+ real(r8), pointer :: f1_used(:), f2_used(:)
+
+#ifdef OSLO_AERO
+ f1_used => f1_in
+ f2_used => f2_in
+#else
+ f1_used => f1
+ f2_used => f2
+#endif
+
+
+ do m=1,nmode
+ if(zeta(m).gt.1.e5_r8*eta(m).or.smc(m)*smc(m).gt.1.e5_r8*eta(m))then
+ ! weak forcing. essentially none activated
+ smax=1.e-20_r8
+ else
+ ! significant activation of this mode. calc activation all modes.
+ exit
+ endif
+ ! No significant activation in any mode. Do nothing.
+ if (m == nmode) return
+
+ enddo
+
+ sum=0.0_r8
+ do m=1,nmode
+ if(eta(m).gt.1.e-20_r8)then
+ g1=zeta(m)/eta(m)
+ g1sqrt=sqrt(g1)
+ g1=g1sqrt*g1
+ g2=smc(m)/sqrt(eta(m)+3._r8*zeta(m))
+ g2sqrt=sqrt(g2)
+ g2=g2sqrt*g2
+ sum=sum+(f1_used(m)*g1+f2_used(m)*g2)/(smc(m)*smc(m))
+ else
+ sum=1.e20_r8
+ endif
+ enddo
+
+ smax=1._r8/sqrt(sum)
+
+end subroutine maxsat
+
+!===============================================================================
+
+#ifndef OSLO_AERO
+subroutine ccncalc(state, pbuf, cs, ccn)
+
+ ! calculates number concentration of aerosols activated as CCN at
+ ! supersaturation supersat.
+ ! assumes an internal mixture of a multiple externally-mixed aerosol modes
+ ! cgs units
+
+ ! Ghan et al., Atmos. Res., 1993, 198-221.
+
+ ! arguments
+
+ type(physics_state), target, intent(in) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+
+ real(r8), intent(in) :: cs(pcols,pver) ! air density (kg/m3)
+ real(r8), intent(out) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat (#/m3)
+
+ ! local
+
+ integer :: lchnk ! chunk index
+ integer :: ncol ! number of columns
+ real(r8), pointer :: tair(:,:) ! air temperature (K)
+
+ real(r8) naerosol(pcols) ! interstit+activated aerosol number conc (/m3)
+ real(r8) vaerosol(pcols) ! interstit+activated aerosol volume conc (m3/m3)
+
+ real(r8) amcube(pcols)
+ real(r8) super(psat) ! supersaturation
+ real(r8), allocatable :: amcubecoef(:)
+ real(r8), allocatable :: argfactor(:)
+ real(r8) :: surften ! surface tension of water w/respect to air (N/m)
+ real(r8) surften_coef
+ real(r8) a(pcols) ! surface tension parameter
+ real(r8) hygro(pcols) ! aerosol hygroscopicity
+ real(r8) sm(pcols) ! critical supersaturation at mode radius
+ real(r8) arg(pcols)
+ ! mathematical constants
+ real(r8) twothird,sq2
+ integer l,m,n,i,k
+ real(r8) log,cc
+ real(r8) smcoefcoef,smcoef(pcols)
+ integer phase ! phase of aerosol
+ !-------------------------------------------------------------------------------
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+ tair => state%t
+
+ allocate( &
+ amcubecoef(ntot_amode), &
+ argfactor(ntot_amode) )
+
+ super(:)=supersat(:)*0.01_r8
+ sq2=sqrt(2._r8)
+ twothird=2._r8/3._r8
+ surften=0.076_r8
+ surften_coef=2._r8*mwh2o*surften/(r_universal*rhoh2o)
+ smcoefcoef=2._r8/sqrt(27._r8)
+
+ do m=1,ntot_amode
+ amcubecoef(m)=3._r8/(4._r8*pi*exp45logsig(m))
+ argfactor(m)=twothird/(sq2*alogsig(m))
+ end do
+
+ ccn = 0._r8
+ do k=top_lev,pver
+
+ do i=1,ncol
+ a(i)=surften_coef/tair(i,k)
+ smcoef(i)=smcoefcoef*a(i)*sqrt(a(i))
+ end do
+
+ do m=1,ntot_amode
+
+ phase=3 ! interstitial+cloudborne
+
+ call loadaer( &
+ state, pbuf, 1, ncol, k, &
+ m, cs, phase, naerosol, vaerosol, &
+ hygro)
+
+ where(naerosol(:ncol)>1.e-3_r8)
+ amcube(:ncol)=amcubecoef(m)*vaerosol(:ncol)/naerosol(:ncol)
+ sm(:ncol)=smcoef(:ncol)/sqrt(hygro(:ncol)*amcube(:ncol)) ! critical supersaturation
+ elsewhere
+ sm(:ncol)=1._r8 ! value shouldn't matter much since naerosol is small
+ endwhere
+ do l=1,psat
+ do i=1,ncol
+ arg(i)=argfactor(m)*log(sm(i)/super(l))
+ ccn(i,k,l)=ccn(i,k,l)+naerosol(i)*0.5_r8*(1._r8-erf(arg(i)))
+ enddo
+ enddo
+ enddo
+ enddo
+ ccn(:ncol,:,:)=ccn(:ncol,:,:)*1.e-6_r8 ! convert from #/m3 to #/cm3
+
+ deallocate( &
+ amcubecoef, &
+ argfactor )
+
+end subroutine ccncalc
+
+#else
+
+subroutine ccncalc_oslo(state &
+ , pbuf &
+ , cs &
+!+tht
+ , hasAerosol &
+!-tht
+ , numberConcentration &
+ , volumeConcentration &
+ , hygroscopicity &
+ , lnSigma &
+ , ccn )
+
+ ! calculates number concentration of aerosols activated as CCN at
+ ! supersaturation supersat.
+ ! assumes an internal mixture of a multiple externally-mixed aerosol modes
+ ! cgs units
+
+ ! This was used in the BACCHUS-project where it was agreed that
+ ! CCN would not include cloud-borne aerosols. It is possible to
+ ! calculate cloud-borne aerosols, but it is complicated, and it was
+ ! not needed when this code was made.
+
+ ! arguments
+
+ type(physics_state), target, intent(in) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ real(r8), intent(in) :: cs(pcols,pver) ! air density (kg/m3)
+ real(r8), intent(out) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat (#/m3)
+!+tht
+ logical, intent(in) :: hasAerosol(pcols, pver, nmodes)
+!-tht
+!akc6 real(r8), intent(in) :: numberConcentration(pcols,pver, nmodes) ! interstit+activated aerosol number conc (/m3)
+ real(r8), intent(in) :: numberConcentration(pcols,pver,0:nmodes) ! interstit+activated aerosol number conc (/m3)
+!akc6-
+ real(r8), intent(in) :: volumeConcentration(pcols,pver,nmodes) ! interstit+activated aerosol volume conc (m3/m3)
+ real(r8), intent(in) :: hygroscopicity(pcols,pver,nmodes)
+ real(r8), intent(in) :: lnSigma(pcols,pver,nmodes)
+
+ ! local
+ integer :: lchnk ! chunk index
+ integer :: ncol ! number of columns
+ real(r8), pointer :: tair(:,:) ! air temperature (K)
+
+
+ real(r8) super(psat) ! supersaturation
+ real(r8) surften_coef !Coefficient in ARGI / ARGII
+ real(r8) amcube !number median radius qubed
+ real(r8) a ! surface tension parameter
+ real(r8) sm ! critical supersaturation at mode radius
+ real(r8) arg ! factor in eqn 15 ARGII
+ real(r8) argfactor !Coefficient in ARGI/ARGII
+ ! mathematical constants
+ real(r8), parameter:: twothird=2.0_r8/3.0_r8
+ real(r8), parameter:: sq2=sqrt(2.0_r8)
+ real(r8), parameter :: surften=0.076_r8 !surface tension of water (J/m2)
+ real(r8) exp45logsig_var
+ integer lsat,m,i,k
+ real(r8) smcoefcoef,smcoef
+ !-------------------------------------------------------------------------------
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+ tair => state%t
+
+ super(:)=supersat(:)*0.01_r8
+
+ !This is curvature effect (A) in ARGI
+ !eqn 5 in ARG1 (missing division by temperature, see below)
+ surften_coef=2._r8*mwh2o*surften/(r_universal*rhoh2o)
+
+ !This is part of eqn 9 in ARGII
+ !where A smcoefcoef is 2/3^(3/2)
+ smcoefcoef=2._r8/sqrt(27._r8)
+
+ ccn(:,:,:) = 0._r8
+
+ do m=1,nmodes
+ do k=top_lev,pver
+
+ do i=1,ncol
+
+!+tht
+ if (hasAerosol(i,k,m)) then
+!-tht
+ !Curvature-parameter "A" in ARGI (eqn 5)
+ a = surften_coef/tair(i,k)
+
+ !standard factor for transforming size distr
+ !volume ==> number (google psd.pdf by zender)
+ exp45logsig_var = &
+ exp(4.5_r8*lnsigma(i,k,m)*lnsigma(i,k,m))
+
+ !Numbe rmedian radius (power of three)
+ !By definition of lognormal distribution
+ amcube =(3._r8*volumeConcentration(i,k,m) &
+ /(4._r8*pi*exp45logsig_var*numberConcentration(i,k,m))) ! only if variable size dist
+
+
+ !This is part of eqn 9 in ARGII
+ !where A smcoefcoef is 2/3^(3/2)
+ smcoef = smcoefcoef * a * sqrt(a)
+
+ !This is finally solving eqn 9
+ !(solve for critical supersat of mode)
+ sm=smcoef &
+ / sqrt(hygroscopicity(i,k,m)*amcube) ! critical supersaturation
+
+ !Solve eqn 13 in ARGII
+ do lsat = 1,psat
+
+ !eqn 15 in ARGII
+ argfactor=twothird/(sq2*lnSigma(i,k,m))
+
+ !eqn 15 in ARGII
+ arg=argfactor*log(sm/super(lsat))
+
+ !eqn 13 i ARGII
+ ccn(i,k,lsat)=ccn(i,k,lsat) &
+ +numberConcentration(i,k,m)&
+ *0.5_r8*(1._r8-erf(arg))
+ end do
+!+tht
+ else
+ do lsat = 1, psat
+ ccn(i,k,lsat)=0._r8
+ enddo
+ endif
+!-tht
+ end do
+ end do
+ end do
+
+ ccn(:ncol,:,:)=ccn(:ncol,:,:)*1.e-6_r8 ! convert from #/m3 to #/cm3
+
+end subroutine ccncalc_oslo
+#endif
+
+!===============================================================================
+
+subroutine loadaer( &
+ state, pbuf, istart, istop, k, &
+ m, cs, phase, naerosol, &
+ vaerosol, hygro)
+
+ ! return aerosol number, volume concentrations, and bulk hygroscopicity
+
+ ! input arguments
+ type(physics_state), target, intent(in) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols)
+ integer, intent(in) :: istop ! stop column index
+ integer, intent(in) :: m ! mode index
+ integer, intent(in) :: k ! level index
+ real(r8), intent(in) :: cs(:,:) ! air density (kg/m3)
+ integer, intent(in) :: phase ! phase of aerosol: 1 for interstitial, 2 for cloud-borne, 3 for sum
+
+ ! output arguments
+ real(r8), intent(out) :: naerosol(:) ! number conc (1/m3)
+ real(r8), intent(out) :: vaerosol(:) ! volume conc (m3/m3)
+ real(r8), intent(out) :: hygro(:) ! bulk hygroscopicity of mode
+
+ ! internal
+ integer :: lchnk ! chunk identifier
+
+ real(r8), pointer :: raer(:,:) ! interstitial aerosol mass, number mixing ratios
+ real(r8), pointer :: qqcw(:,:) ! cloud-borne aerosol mass, number mixing ratios
+ real(r8) :: specdens, spechygro
+
+ real(r8) :: vol(pcols) ! aerosol volume mixing ratio
+ integer :: i, l
+ !-------------------------------------------------------------------------------
+
+ lchnk = state%lchnk
+
+ do i = istart, istop
+ vaerosol(i) = 0._r8
+ hygro(i) = 0._r8
+ end do
+
+ do l = 1, nspec_amode(m)
+
+ call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, raer)
+ call rad_cnst_get_aer_mmr(0, m, l, 'c', state, pbuf, qqcw)
+ call rad_cnst_get_aer_props(0, m, l, density_aer=specdens, hygro_aer=spechygro)
+
+ if (phase == 3) then
+ do i = istart, istop
+ vol(i) = max(raer(i,k) + qqcw(i,k), 0._r8)/specdens
+ end do
+ else if (phase == 2) then
+ do i = istart, istop
+ vol(i) = max(qqcw(i,k), 0._r8)/specdens
+ end do
+ else if (phase == 1) then
+ do i = istart, istop
+ vol(i) = max(raer(i,k), 0._r8)/specdens
+ end do
+ else
+ write(iulog,*)'phase=',phase,' in loadaer'
+ call endrun('phase error in loadaer')
+ end if
+
+ do i = istart, istop
+ vaerosol(i) = vaerosol(i) + vol(i)
+ hygro(i) = hygro(i) + vol(i)*spechygro
+ end do
+
+ end do
+
+ do i = istart, istop
+ if (vaerosol(i) > 1.0e-30_r8) then ! +++xl add 8/2/2007
+ hygro(i) = hygro(i)/(vaerosol(i))
+ vaerosol(i) = vaerosol(i)*cs(i,k)
+ else
+ hygro(i) = 0.0_r8
+ vaerosol(i) = 0.0_r8
+ end if
+ end do
+
+ ! aerosol number
+ call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, raer)
+ call rad_cnst_get_mode_num(0, m, 'c', state, pbuf, qqcw)
+ if (phase == 3) then
+ do i = istart, istop
+ naerosol(i) = (raer(i,k) + qqcw(i,k))*cs(i,k)
+ end do
+ else if (phase == 2) then
+ do i = istart, istop
+ naerosol(i) = qqcw(i,k)*cs(i,k)
+ end do
+ else
+ do i = istart, istop
+ naerosol(i) = raer(i,k)*cs(i,k)
+ end do
+ end if
+ ! adjust number so that dgnumlo < dgnum < dgnumhi
+ do i = istart, istop
+ naerosol(i) = max(naerosol(i), vaerosol(i)*voltonumbhi_amode(m))
+ naerosol(i) = min(naerosol(i), vaerosol(i)*voltonumblo_amode(m))
+ end do
+
+end subroutine loadaer
+
+!===============================================================================
+
+end module ndrop
+
+
+
+
diff --git a/src/chemistry/oslo_aero/ndrop.F90.fpe b/src/chemistry/oslo_aero/ndrop.F90.fpe
new file mode 100644
index 0000000000..bd90190fc4
--- /dev/null
+++ b/src/chemistry/oslo_aero/ndrop.F90.fpe
@@ -0,0 +1,3097 @@
+module ndrop
+
+!---------------------------------------------------------------------------------
+! Purpose:
+! CAM Interface for droplet activation by modal aerosols
+!
+! ***N.B.*** This module is currently hardcoded to recognize only the modes that
+! affect the climate calculation. This is implemented by using list
+! index 0 in all the calls to rad_constituent interfaces.
+!---------------------------------------------------------------------------------
+
+use shr_kind_mod, only: r8 => shr_kind_r8
+use spmd_utils, only: masterproc
+use ppgrid, only: pcols, pver, pverp
+use physconst, only: pi, rhoh2o, mwh2o, r_universal, rh2o, &
+ gravit, latvap, cpair, epsilo, rair
+use constituents, only: pcnst, cnst_get_ind, cnst_name, cnst_spec_class_gas, cnst_species_class
+use physics_types, only: physics_state, physics_ptend, physics_ptend_init
+use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field
+
+use wv_saturation, only: qsat
+use phys_control, only: phys_getopts
+use ref_pres, only: top_lev => trop_cloud_top_lev
+use shr_spfn_mod, only: erf => shr_spfn_erf
+use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num, rad_cnst_get_aer_mmr, &
+ rad_cnst_get_aer_props, rad_cnst_get_mode_props, &
+ rad_cnst_get_mam_mmr_idx, rad_cnst_get_mode_num_idx
+use cam_history, only: addfld, add_default, horiz_only, fieldname_len, outfld
+use cam_abortutils, only: endrun
+use cam_logfile, only: iulog
+!++ MH_2015/09/09
+use phys_control, only: use_hetfrz_classnuc
+!-- MH_2015/09/09
+
+#ifdef OSLO_AERO
+!++oslo
+use aerosoldef
+use parmix_progncdnc
+use oslo_utils, only: calculateNumberMedianRadius
+!--oslo
+#endif
+
+
+implicit none
+private
+save
+
+public ndrop_init, dropmixnuc, activate_modal, loadaer
+
+#ifndef OSLO_AERO
+real(r8), allocatable :: alogsig(:) ! natl log of geometric standard dev of aerosol
+real(r8), allocatable :: exp45logsig(:)
+real(r8), allocatable, target :: f1(:) ! abdul-razzak functions of width
+real(r8), allocatable, target :: f2(:) ! abdul-razzak functions of width
+#endif
+
+real(r8) :: t0 ! reference temperature
+real(r8) :: aten
+real(r8) :: surften ! surface tension of water w/respect to air (N/m)
+real(r8) :: alog2, alog3, alogaten
+real(r8) :: third, twothird, sixth, zero
+real(r8) :: sq2, sqpi
+
+! CCN diagnostic fields
+integer, parameter :: psat=6 ! number of supersaturations to calc ccn concentration
+real(r8), parameter :: supersat(psat)= & ! supersaturation (%) to determine ccn concentration
+ (/ 0.02_r8, 0.05_r8, 0.1_r8, 0.2_r8, 0.5_r8, 1.0_r8 /)
+character(len=8) :: ccn_name(psat)= &
+ (/'CCN1','CCN2','CCN3','CCN4','CCN5','CCN6'/)
+
+! indices in state and pbuf structures
+integer :: numliq_idx = -1
+integer :: kvh_idx = -1
+
+! description of modal aerosols
+integer :: ntot_amode ! number of aerosol modes
+integer, allocatable :: nspec_amode(:) ! number of chemical species in each aerosol mode
+real(r8), allocatable :: sigmag_amode(:)! geometric standard deviation for each aerosol mode
+real(r8), allocatable :: dgnumlo_amode(:)
+real(r8), allocatable :: dgnumhi_amode(:)
+real(r8), allocatable :: voltonumblo_amode(:)
+real(r8), allocatable :: voltonumbhi_amode(:)
+
+logical :: history_aerosol ! Output the MAM aerosol tendencies
+character(len=fieldname_len), allocatable :: fieldname(:) ! names for drop nuc tendency output fields
+character(len=fieldname_len), allocatable :: fieldname_cw(:) ! names for drop nuc tendency output fields
+
+! local indexing for MAM
+integer, allocatable :: mam_idx(:,:) ! table for local indexing of modal aero number and mmr
+integer :: ncnst_tot ! total number of mode number conc + mode species
+
+! Indices for MAM species in the ptend%q array. Needed for prognostic aerosol case.
+integer, allocatable :: mam_cnst_idx(:,:)
+
+#ifdef OSLO_AERO
+logical :: tendencyCounted(pcnst) = .false. ! set flags true for constituents with non-zero tendencies
+integer :: n_aerosol_tracers
+integer :: aerosolTracerList(pcnst) !List where indexes 1...n_aerosol_tracers are the indexes in pcnst
+ !..something like (/ l_so4_a1, l_bc_a, .../)etc
+integer :: inverseAerosolTracerList(pcnst) !List where you can back the place in aerosolTracerList if you know the
+ !tracer index. So in the example above inverseAerosolTracerList(l_so4_a1) = 1
+#endif
+
+! ptr2d_t is used to create arrays of pointers to 2D fields
+type ptr2d_t
+ real(r8), pointer :: fld(:,:)
+end type ptr2d_t
+
+! modal aerosols
+logical :: prog_modal_aero ! true when modal aerosols are prognostic
+logical :: lq(pcnst) = .false. ! set flags true for constituents with non-zero tendencies
+ ! in the ptend object
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine ndrop_init
+
+ integer :: ii, l, lptr, m, mm
+ integer :: nspec_max ! max number of species in a mode
+ character(len=32) :: tmpname
+ character(len=32) :: tmpname_cw
+ character(len=128) :: long_name
+ character(len=8) :: unit
+ logical :: history_amwg ! output the variables used by the AMWG diag package
+#ifdef OSLO_AERO
+ character(len=10) :: modeString
+ character(len=20) :: varname
+#endif
+
+ !-------------------------------------------------------------------------------
+
+ ! get indices into state%q and pbuf structures
+ call cnst_get_ind('NUMLIQ', numliq_idx)
+
+ kvh_idx = pbuf_get_index('kvh')
+
+ zero = 0._r8
+ third = 1._r8/3._r8
+ twothird = 2._r8*third
+ sixth = 1._r8/6._r8
+ sq2 = sqrt(2._r8)
+ sqpi = sqrt(pi)
+
+ t0 = 273._r8
+ surften = 0.076_r8
+ aten = 2._r8*mwh2o*surften/(r_universal*t0*rhoh2o)
+ alogaten = log(aten)
+ alog2 = log(2._r8)
+ alog3 = log(3._r8)
+
+ ! get info about the modal aerosols
+ ! get ntot_amode
+#ifdef OSLO_AERO
+ ntot_amode = nmodes !from opttab
+#else
+ call rad_cnst_get_info(0, nmodes=ntot_amode)
+#endif
+ allocate( &
+ nspec_amode(ntot_amode), &
+ sigmag_amode(ntot_amode), &
+ dgnumlo_amode(ntot_amode), &
+ dgnumhi_amode(ntot_amode), &
+#ifndef OSLO_AERO
+ alogsig(ntot_amode), &
+ exp45logsig(ntot_amode), &
+ f1(ntot_amode), &
+ f2(ntot_amode), &
+#endif
+ voltonumblo_amode(ntot_amode), &
+ voltonumbhi_amode(ntot_amode) )
+
+#ifdef OSLO_AERO
+ do m = 1,ntot_amode
+ nspec_amode(m) = getNumberOfTracersInMode(m)
+ enddo
+#else
+ do m = 1, ntot_amode
+ ! use only if width of size distribution is prescribed
+
+ ! get mode info
+ call rad_cnst_get_info(0, m, nspec=nspec_amode(m))
+
+ ! get mode properties
+ call rad_cnst_get_mode_props(0, m, sigmag=sigmag_amode(m), &
+ dgnumhi=dgnumhi_amode(m), dgnumlo=dgnumlo_amode(m))
+
+ alogsig(m) = log(sigmag_amode(m))
+ exp45logsig(m) = exp(4.5_r8*alogsig(m)*alogsig(m))
+ f1(m) = 0.5_r8*exp(2.5_r8*alogsig(m)*alogsig(m))
+ f2(m) = 1._r8 + 0.25_r8*alogsig(m)
+
+ voltonumblo_amode(m) = 1._r8 / ( (pi/6._r8)* &
+ (dgnumlo_amode(m)**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) )
+ voltonumbhi_amode(m) = 1._r8 / ( (pi/6._r8)* &
+ (dgnumhi_amode(m)**3._r8)*exp(4.5_r8*alogsig(m)**2._r8) )
+ end do
+#endif
+ ! Init the table for local indexing of mam number conc and mmr.
+ ! This table uses species index 0 for the number conc.
+
+ ! Find max number of species in all the modes, and the total
+ ! number of mode number concentrations + mode species
+ nspec_max = nspec_amode(1)
+ ncnst_tot = nspec_amode(1) + 1
+ do m = 2, ntot_amode
+ nspec_max = max(nspec_max, nspec_amode(m))
+ ncnst_tot = ncnst_tot + nspec_amode(m) + 1
+ end do
+
+ allocate( &
+ mam_idx(ntot_amode,0:nspec_max), &
+ mam_cnst_idx(ntot_amode,0:nspec_max), &
+ fieldname(ncnst_tot), &
+ fieldname_cw(ncnst_tot) )
+
+ ! Local indexing compresses the mode and number/mass indicies into one index.
+ ! This indexing is used by the pointer arrays used to reference state and pbuf
+ ! fields.
+ ii = 0
+ do m = 1, ntot_amode
+ do l = 0, nspec_amode(m)
+ ii = ii + 1
+ mam_idx(m,l) = ii
+ end do
+ end do
+
+ ! Add dropmixnuc tendencies for all modal aerosol species
+
+ call phys_getopts(history_amwg_out = history_amwg, &
+ history_aerosol_out = history_aerosol, &
+ prog_modal_aero_out=prog_modal_aero)
+
+#ifdef OSLO_AERO
+ prog_modal_aero = .TRUE.
+ n_aerosol_tracers = getNumberOfAerosolTracers()
+ call fillAerosolTracerList(aerosolTracerList)
+ call fillInverseAerosolTracerList(aerosolTracerList, inverseAerosolTracerList, n_aerosol_tracers)
+ do ii=1,n_aerosol_tracers
+ print*, "aerosolTracerList", ii, aerosolTracerList(ii), inverseAerosolTracerList(aerosolTracerList(ii))
+ end do
+#endif
+
+#ifdef OSLO_AERO
+ lq(:)=.FALSE. !Initialize
+
+ !Set up tendencies for tracers (output)
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr = getTracerIndex(m,l,.false.)
+
+ if(.NOT. lq(lptr))then
+ !add dropmixnuc tendencies
+ mm=mam_idx(m,l)
+ fieldname(mm)=trim(cnst_name(lptr))//"_mixnuc1"
+ fieldname_cw(mm)=trim(getCloudTracerName(lptr))//"_mixnuc1"
+
+ long_name = trim(fieldname(mm)) // ' dropmixnuc column tendency'
+ call addfld(trim(fieldname(mm)), horiz_only ,'A', "kg/m2/s",long_name)
+
+ long_name = trim(fieldname_cw(mm)) // ' dropmixnuc column tendency'
+ call addfld(trim(fieldname_cw(mm)), horiz_only, 'A', "kg/m2/s",long_name)
+
+ if (history_aerosol) then
+ call add_default(trim(fieldname(mm)), 1, ' ')
+ call add_default(trim(fieldname_cw(mm)),1,' ')
+ endif
+
+ !Do tendencies of this tracer
+ lq(lptr)=.TRUE.
+ endif
+ enddo
+ enddo
+ do m=1,ntot_amode
+ modeString=" "
+ write(modeString,"(I2)"),m
+ if(m .lt. 10) modeString="0"//adjustl(modeString)
+ varName = "NMR"//trim(modeString)
+ call addfld(varName, (/ 'lev' /),'A', 'm ', 'number median radius mode '//modeString)
+ if(history_aerosol)call add_default(varName, 1, ' ')
+ varName = "NCONC"//trim(modeString)
+ call addfld(varName, (/ 'lev' /),'A', '#/m3 ', 'number concentration mode '//modeString)
+ if(history_aerosol)call add_default(varName, 1, ' ')
+ varName = "VCONC"//trim(modeString)
+ call addfld(varName, (/ 'lev' /),'A', 'm3/m3 ','volume concentration mode '//modeString)
+ if(history_aerosol)call add_default(varName, 1, ' ')
+ varName = "SIGMA"//trim(modeString)
+ call addfld(varName, (/ 'lev' /),'A', '-','Std. dev. mode '//modeString)
+ if(history_aerosol)call add_default(varName, 1, ' ')
+ varName = "HYGRO"//trim(modeString)
+ call addfld(varName, (/ 'lev' /),'A','-','Hygroscopicity '//modeString)
+ if(history_aerosol)call add_default(varName, 1, ' ')
+ end do
+#else
+ do m = 1, ntot_amode
+ do l = 0, nspec_amode(m) ! loop over number + chem constituents
+
+ mm = mam_idx(m,l)
+
+ unit = 'kg/m2/s'
+ if (l == 0) then ! number
+ unit = '#/m2/s'
+ end if
+
+ if (l == 0) then ! number
+ call rad_cnst_get_info(0, m, num_name=tmpname, num_name_cw=tmpname_cw)
+ else
+ call rad_cnst_get_info(0, m, l, spec_name=tmpname, spec_name_cw=tmpname_cw)
+ end if
+
+ fieldname(mm) = trim(tmpname) // '_mixnuc1'
+ fieldname_cw(mm) = trim(tmpname_cw) // '_mixnuc1'
+
+ if (prog_modal_aero) then
+
+ ! To set tendencies in the ptend object need to get the constituent indices
+ ! for the prognostic species
+ if (l == 0) then ! number
+ call rad_cnst_get_mode_num_idx(m, lptr)
+ else
+ call rad_cnst_get_mam_mmr_idx(m, l, lptr)
+ end if
+ mam_cnst_idx(m,l) = lptr
+ lq(lptr) = .true.
+
+ ! Add tendency fields to the history only when prognostic MAM is enabled.
+ long_name = trim(tmpname) // ' dropmixnuc mixnuc column tendency'
+ call addfld(fieldname(mm), horiz_only, 'A', unit, long_name)
+
+ long_name = trim(tmpname_cw) // ' dropmixnuc mixnuc column tendency'
+ call addfld(fieldname_cw(mm), horiz_only, 'A', unit, long_name)
+
+ if (history_aerosol) then
+ call add_default(fieldname(mm), 1, ' ')
+ call add_default(fieldname_cw(mm), 1, ' ')
+ end if
+
+
+
+ end if
+
+ end do
+ end do
+
+#endif
+
+ call addfld('CCN1',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.02%')
+ call addfld('CCN2',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.05%')
+ call addfld('CCN3',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.1%')
+ call addfld('CCN4',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.2%')
+ call addfld('CCN5',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=0.5%')
+ call addfld('CCN6',(/ 'lev' /), 'A','#/cm3','CCN concentration at S=1.0%')
+
+#ifdef OSLO_AERO
+ if(history_aerosol)then
+ do l = 1, psat
+ call add_default(ccn_name(l), 1, ' ')
+ enddo
+ end if
+#endif
+
+ call addfld('WTKE', (/ 'lev' /), 'A', 'm/s', 'Standard deviation of updraft velocity')
+ call addfld('NDROPMIX', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number mixing')
+ call addfld('NDROPSRC', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number source')
+ call addfld('NDROPSNK', (/ 'lev' /), 'A', '#/kg/s', 'Droplet number loss by microphysics')
+ call addfld('NDROPCOL', horiz_only, 'A', '#/m2', 'Column droplet number')
+
+#ifndef OSLO_AERO
+
+ ! set the add_default fields
+ if (history_amwg) then
+ call add_default('CCN3', 1, ' ')
+ endif
+
+ if (history_aerosol .and. prog_modal_aero) then
+ do m = 1, ntot_amode
+ do l = 0, nspec_amode(m) ! loop over number + chem constituents
+ mm = mam_idx(m,l)
+ if (l == 0) then ! number
+ call rad_cnst_get_info(0, m, num_name=tmpname, num_name_cw=tmpname_cw)
+ else
+ call rad_cnst_get_info(0, m, l, spec_name=tmpname, spec_name_cw=tmpname_cw)
+ end if
+ fieldname(mm) = trim(tmpname) // '_mixnuc1'
+ fieldname_cw(mm) = trim(tmpname_cw) // '_mixnuc1'
+ end do
+ end do
+ endif
+
+#endif
+
+end subroutine ndrop_init
+
+!===============================================================================
+
+subroutine dropmixnuc( &
+ state, ptend, dtmicro, pbuf, wsub, & ! Input
+ cldn, cldo, cldliqf, &
+ !++ MH_2015/09/07
+ hasAerosol, &
+ CProcessModes, f_c, f_bc, f_aq, f_so4_cond, &
+ f_soa, &
+ cam, f_acm, f_bcm, f_aqm, f_so4_condm, &
+ f_soam, &
+ numberConcentration, volumeConcentration, &
+ hygroscopicity, lnsigma, &
+ !-- MH_2015/09/07
+ tendnd, & ! Output
+ !++ MH_2015/04/10
+ fn_in, &
+ from_spcam )
+ !-- MH_2015/04/10
+
+ ! vertical diffusion and nucleation of cloud droplets
+ ! assume cloud presence controlled by cloud fraction
+ ! doesn't distinguish between warm, cold clouds
+
+ ! arguments
+ type(physics_state), target, intent(in) :: state
+ type(physics_ptend), intent(out) :: ptend
+ real(r8), intent(in) :: dtmicro ! time step for microphysics (s)
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! arguments
+ real(r8), intent(in) :: wsub(pcols,pver) ! subgrid vertical velocity
+ real(r8), intent(in) :: cldn(pcols,pver) ! cloud fraction
+ real(r8), intent(in) :: cldo(pcols,pver) ! cloud fraction on previous time step
+ real(r8), intent(in) :: cldliqf(pcols,pver) ! liquid cloud fraction (liquid / (liquid + ice))
+ logical, intent(in),optional :: from_spcam ! value insignificant - if variable present, is called from spcam
+
+!++ MH_2015/09/07
+ logical, intent(in) :: hasAerosol(pcols, pver, nmodes)
+ real(r8), intent(in) :: CProcessModes(pcols,pver)
+ real(r8), intent(in) :: cam(pcols,pver,nbmodes)
+ real(r8), intent(in) :: f_c(pcols,pver)
+ real(r8), intent(in) :: f_aq(pcols,pver)
+ real(r8), intent(in) :: f_bc(pcols,pver)
+ real(r8), intent(in) :: f_so4_cond(pcols,pver)
+ real(r8), intent(in) :: f_soa(pcols,pver)
+ real(r8), intent(in) :: f_acm(pcols,pver, nbmodes)
+ real(r8), intent(in) :: f_bcm(pcols,pver, nbmodes)
+ real(r8), intent(in) :: f_aqm(pcols, pver, nbmodes)
+ real(r8), intent(in) :: f_so4_condm(pcols, pver, nbmodes) !Needed in "get component fraction
+ real(r8), intent(in) :: f_soam(pcols,pver,nbmodes)
+ real(r8), intent(in) :: numberConcentration(pcols,pver,0:nmodes) ![#/m3] number concentraiton
+ real(r8), intent(in) :: volumeConcentration(pcols,pver,nmodes) ![m3/m3] volume concentration
+ real(r8), intent(in) :: hygroscopicity(pcols,pver,nmodes) ![-] hygroscopicity
+ real(r8), intent(in) :: lnsigma(pcols,pver,nmodes) ![-] log(base e) sigma
+!-- MH_2015/09/07
+
+ ! output arguments
+ real(r8), intent(out) :: tendnd(pcols,pver) ! change in droplet number concentration (#/kg/s)
+
+ !--------------------Local storage-------------------------------------
+
+ integer :: lchnk ! chunk identifier
+ integer :: ncol ! number of columns
+
+ real(r8), pointer :: ncldwtr(:,:) ! droplet number concentration (#/kg)
+ real(r8), pointer :: temp(:,:) ! temperature (K)
+ real(r8), pointer :: omega(:,:) ! vertical velocity (Pa/s)
+ real(r8), pointer :: pmid(:,:) ! mid-level pressure (Pa)
+ real(r8), pointer :: pint(:,:) ! pressure at layer interfaces (Pa)
+ real(r8), pointer :: pdel(:,:) ! pressure thickess of layer (Pa)
+ real(r8), pointer :: rpdel(:,:) ! inverse of pressure thickess of layer (/Pa)
+ real(r8), pointer :: zm(:,:) ! geopotential height of level (m)
+
+ real(r8), pointer :: kvh(:,:) ! vertical diffusivity (m2/s)
+
+ type(ptr2d_t), allocatable :: raer(:) ! aerosol mass, number mixing ratios
+ type(ptr2d_t), allocatable :: qqcw(:)
+ real(r8) :: raertend(pver) ! tendency of aerosol mass, number mixing ratios
+ real(r8) :: qqcwtend(pver) ! tendency of cloudborne aerosol mass, number mixing ratios
+
+
+ real(r8), parameter :: zkmin = 0.01_r8, zkmax = 100._r8
+ real(r8), parameter :: wmixmin = 0.1_r8 ! minimum turbulence vertical velocity (m/s)
+ real(r8) :: sq2pi
+
+ integer :: i, k, l, m, mm, n
+ integer :: km1, kp1
+ integer :: nnew, nsav, ntemp
+ integer :: lptr
+ integer :: nsubmix, nsubmix_bnd
+ integer, save :: count_submix(100)
+ integer :: phase ! phase of aerosol
+
+ real(r8) :: arg
+ real(r8) :: dtinv
+ real(r8) :: dtmin, tinv, dtt
+ real(r8) :: lcldn(pcols,pver)
+ real(r8) :: lcldo(pcols,pver)
+
+ real(r8) :: zs(pver) ! inverse of distance between levels (m)
+ real(r8) :: qcld(pver) ! cloud droplet number mixing ratio (#/kg)
+ real(r8) :: qncld(pver) ! droplet number nucleated on cloud boundaries
+ real(r8) :: srcn(pver) ! droplet source rate (/s)
+ real(r8) :: cs(pcols,pver) ! air density (kg/m3)
+ real(r8) :: csbot(pver) ! air density at bottom (interface) of layer (kg/m3)
+ real(r8) :: csbot_cscen(pver) ! csbot(i)/cs(i,k)
+ real(r8) :: dz(pcols,pver) ! geometric thickness of layers (m)
+
+ real(r8) :: wtke(pcols,pver) ! turbulent vertical velocity at base of layer k (m/s)
+ real(r8) :: wtke_cen(pcols,pver) ! turbulent vertical velocity at center of layer k (m/s)
+ real(r8) :: wbar, wmix, wmin, wmax
+
+ real(r8) :: zn(pver) ! g/pdel (m2/g) for layer
+ real(r8) :: flxconv ! convergence of flux into lowest layer
+
+ real(r8) :: wdiab ! diabatic vertical velocity
+ real(r8) :: ekd(pver) ! diffusivity for droplets (m2/s)
+ real(r8) :: ekk(0:pver) ! density*diffusivity for droplets (kg/m3 m2/s)
+ real(r8) :: ekkp(pver) ! zn*zs*density*diffusivity
+ real(r8) :: ekkm(pver) ! zn*zs*density*diffusivity
+
+ real(r8) :: dum, dumc
+ real(r8) :: tmpa
+ real(r8) :: dact
+ real(r8) :: fluxntot ! (#/cm2/s)
+ real(r8) :: dtmix
+ real(r8) :: alogarg
+ real(r8) :: overlapp(pver), overlapm(pver) ! cloud overlap
+
+ real(r8) :: nsource(pcols,pver) ! droplet number source (#/kg/s)
+ real(r8) :: ndropmix(pcols,pver) ! droplet number mixing (#/kg/s)
+ real(r8) :: ndropcol(pcols) ! column droplet number (#/m2)
+ real(r8) :: cldo_tmp, cldn_tmp
+ real(r8) :: tau_cld_regenerate
+ real(r8) :: zeroaer(pver)
+ real(r8) :: taumix_internal_pver_inv ! 1/(internal mixing time scale for k=pver) (1/s)
+
+
+ real(r8), allocatable :: nact(:,:) ! fractional aero. number activation rate (/s)
+ real(r8), allocatable :: mact(:,:) ! fractional aero. mass activation rate (/s)
+
+ real(r8), allocatable :: raercol(:,:,:) ! single column of aerosol mass, number mixing ratios
+ real(r8), allocatable :: raercol_cw(:,:,:) ! same as raercol but for cloud-borne phase
+#ifdef OSLO_AERO
+ !to avoid excessive calls to boundary layer scheme
+ real(r8), allocatable :: raercol_tracer(:,:,:)
+ real(r8), allocatable :: raercol_cw_tracer(:,:,:)
+ real(r8), allocatable :: mact_tracer(:,:)
+ real(r8), allocatable :: mfullact_tracer(:,:)
+#endif
+
+ real(r8) :: na(pcols), va(pcols), hy(pcols)
+ real(r8), allocatable :: naermod(:) ! (1/m3)
+ real(r8), allocatable :: hygro(:) ! hygroscopicity of aerosol mode
+ real(r8), allocatable :: vaerosol(:) ! interstit+activated aerosol volume conc (cm3/cm3)
+
+ real(r8) :: source(pver)
+
+!++ MH_2015/04/10
+ real(r8), allocatable :: fn(:) ! activation fraction for aerosol number
+ real(r8), intent(out) :: fn_in(pcols,pver,0:nmodes)
+!-- MH_2015/04/10
+ real(r8), allocatable :: fm(:) ! activation fraction for aerosol mass
+
+ real(r8), allocatable :: fluxn(:) ! number activation fraction flux (cm/s)
+ real(r8), allocatable :: fluxm(:) ! mass activation fraction flux (cm/s)
+ real(r8) :: flux_fullact(pver) ! 100% activation fraction flux (cm/s)
+ ! note: activation fraction fluxes are defined as
+ ! fluxn = [flux of activated aero. number into cloud (#/cm2/s)]
+ ! / [aero. number conc. in updraft, just below cloudbase (#/cm3)]
+
+
+ real(r8), allocatable :: coltend(:,:) ! column tendency for diagnostic output
+ real(r8), allocatable :: coltend_cw(:,:) ! column tendency
+ real(r8) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat
+
+ !for gas species turbulent mixing
+ real(r8), pointer :: rgas(:, :, :)
+ real(r8), allocatable :: rgascol(:, :, :)
+ real(r8), allocatable :: coltendgas(:)
+ real(r8) :: zerogas(pver)
+ character*200 fieldnamegas
+
+ logical :: called_from_spcam
+ !-------------------------------------------------------------------------------
+#ifdef OSLO_AERO
+ real(r8) :: numberMedianRadius(pcols,pver,nmodes)
+ real(r8) :: sigma(pcols,pver,nmodes) ![-] sigma
+ real(r8) :: constituentFraction
+ !++ MH_2015/04/10
+ real(r8) :: volumeCore(pcols,pver,nmodes)
+ real(r8) :: volumeCoat(pcols,pver,nmodes)
+ !-- MH_2015/04/10
+ integer :: tracerIndex
+ integer :: cloudTracerIndex
+ integer :: kcomp
+ integer :: speciesMap(nmodes)
+ !++ MH_2015/04/10
+! real(r8) :: fn_tmp(pcols,pver,nmodes)
+ real(r8), allocatable :: fn_tmp(:), fm_tmp(:)
+ !-- MH_2015/04/10
+ real(r8), allocatable :: fluxn_tmp(:), fluxm_tmp(:)
+ real(r8) :: componentFraction
+ real(r8) :: componentFractionOK(pver,nmodes,pcnst)
+ real(r8) :: sumFraction
+ logical :: alert
+ real(r8), dimension(pver, pcnst) :: massBalance
+ real(r8), dimension(pver, pcnst) :: newMass
+ real(r8), dimension(pver,pcnst) :: newCloud, oldCloud, newAerosol, oldAerosol, deltaCloud
+ integer :: kCrit, lptr2
+ logical :: stopMe
+ integer :: iDebug=1, lDebug=15
+ real(r8) :: mixRatioToMass
+ real(r8),dimension(pcnst) :: debugSumFraction
+ real(r8), allocatable :: lnsigman(:)
+ character(len=2) :: modeString
+ character(len=20) :: varname
+#endif
+ integer :: numberOfModes
+!-------------------------------------------------------------------------------
+#undef EXTRATESTS
+#undef MASS_BALANCE_CHECK
+
+ sq2pi = sqrt(2._r8*pi)
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ ncldwtr => state%q(:,:,numliq_idx)
+ temp => state%t
+ omega => state%omega
+ pmid => state%pmid
+ pint => state%pint
+ pdel => state%pdel
+ rpdel => state%rpdel
+ zm => state%zm
+
+ call pbuf_get_field(pbuf, kvh_idx, kvh)
+
+ ! Create the liquid weighted cloud fractions that were passsed in
+ ! before. This doesn't seem like the best variable, since the cloud could
+ ! have liquid condensate, but the part of it that is changing could be the
+ ! ice portion; however, this is what was done before.
+ lcldo(:ncol,:) = cldo(:ncol,:) * cldliqf(:ncol,:)
+ lcldn(:ncol,:) = cldn(:ncol,:) * cldliqf(:ncol,:)
+
+
+ arg = 1.0_r8
+ if (abs(0.8427_r8 - erf(arg))/0.8427_r8 > 0.001_r8) then
+ write(iulog,*) 'erf(1.0) = ',ERF(arg)
+ call endrun('dropmixnuc: Error function error')
+ endif
+ arg = 0.0_r8
+ if (erf(arg) /= 0.0_r8) then
+ write(iulog,*) 'erf(0.0) = ',erf(arg)
+ write(iulog,*) 'dropmixnuc: Error function error'
+ call endrun('dropmixnuc: Error function error')
+ endif
+
+ dtinv = 1._r8/dtmicro
+
+ allocate( &
+ nact(pver,ntot_amode), &
+ mact(pver,ntot_amode), &
+ raer(ncnst_tot), &
+ qqcw(ncnst_tot), &
+ raercol(pver,ncnst_tot,2), &
+ raercol_cw(pver,ncnst_tot,2), &
+ coltend(pcols,ncnst_tot), &
+ coltend_cw(pcols,ncnst_tot), &
+ naermod(ntot_amode), &
+ hygro(ntot_amode), &
+#ifdef OSLO_AERO
+ lnsigman(ntot_amode), & !variable std. deviation (CAM-Oslo)
+ raercol_tracer(pver,n_aerosol_tracers,2), &
+ raercol_cw_tracer(pver,n_aerosol_tracers,2), &
+ mact_tracer(pver,n_aerosol_tracers), &
+ mfullact_tracer(pver,n_aerosol_tracers), &
+#endif
+ vaerosol(ntot_amode), &
+ fn(ntot_amode), &
+ fm(ntot_amode), &
+ fluxn(ntot_amode), &
+ fluxm(ntot_amode) )
+
+ ! Init pointers to mode number and specie mass mixing ratios in
+ ! intersitial and cloud borne phases.
+#ifdef OSLO_AERO
+ !Need a list of all aerosol species ==> store in raer (mm)
+ ! or qqcw for cloud-borne aerosols (?)
+ do m=1,nmodes !All aerosol modes
+
+ !NOTE: SEVERAL POINTERS POINT TO SAME FIELD, E.G. CONDENSATE WHICH IS IN SEVERAL MODES
+ do l = 1, nspec_amode(m)
+ tracerIndex = getTracerIndex(m,l,.false.) !Index in q
+ cloudTracerIndex = getCloudTracerIndex(m,l) !Index in phys-buffer
+ mm = mam_idx(m,l) !Index in raer/qqcw
+ raer(mm)%fld => state%q(:,:,tracerIndex) !NOTE: These are total fields (for example condensate)
+ call pbuf_get_field(pbuf, CloudTracerIndex, qqcw(mm)%fld) !NOTE: These are total fields (for example condensate)
+#ifdef EXTRATESTS
+! if(tracerIndex .eq. ldebug)then
+! do k=1,pver
+! print*,"pointer check",k,m,l,mm,tracerIndex, raer(mm)%fld(idebug,k), state%q(idebug,k,tracerIndex)
+! end do
+! endf
+#endif
+ enddo
+ enddo
+ allocate( &
+ fn_tmp(ntot_amode), &
+ fm_tmp(ntot_amode), &
+ fluxn_tmp(ntot_amode), &
+ fluxm_tmp(ntot_amode) )
+#else
+ do m = 1, ntot_amode
+ mm = mam_idx(m, 0)
+ call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, raer(mm)%fld)
+ call rad_cnst_get_mode_num(0, m, 'c', state, pbuf, qqcw(mm)%fld) ! cloud-borne aerosol
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m, l)
+ call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, raer(mm)%fld)
+ call rad_cnst_get_aer_mmr(0, m, l, 'c', state, pbuf, qqcw(mm)%fld) ! cloud-borne aerosol
+ end do
+ end do
+#endif
+
+ called_from_spcam = (present(from_spcam))
+
+ if (called_from_spcam) then
+ rgas => state%q
+ allocate(rgascol(pver, pcnst, 2))
+ allocate(coltendgas(pcols))
+ endif
+ wtke = 0._r8
+
+ if (prog_modal_aero) then
+ ! aerosol tendencies
+ call physics_ptend_init(ptend, state%psetcols, 'ndrop', lq=lq)
+ else
+ ! no aerosol tendencies
+ call physics_ptend_init(ptend, state%psetcols, 'ndrop')
+ end if
+
+#ifdef OSLO_AERO
+ !Improve this later by using only cloud points ?
+ do k = top_lev, pver
+ do i=1,ncol
+ cs(i,k) = pmid(i,k)/(rair*temp(i,k)) ! air density (kg/m3)
+ end do
+ end do
+
+ !Output this
+ call calculateNumberMedianRadius(numberConcentration, volumeConcentration, lnSigma, numberMedianRadius, ncol)
+ do n=1,nmodes
+ sigma(:ncol,:,n) = DEXP(lnSigma(:ncol,:,n))
+ modeString=" "
+ write(modeString,"(I2)"),n
+ if(n .lt. 10) modeString="0"//adjustl(modeString)
+ varName = "NMR"//trim(modeString)
+ call outfld(varName, numberMedianRadius(:,:,n), pcols, lchnk)
+ varName = "NCONC"//trim(modeString)
+ call outfld(varName, numberConcentration(:,:,n),pcols, lchnk)
+ varName = "VCONC"//trim(modeString)
+ call outfld(varName, volumeConcentration(:,:,n), pcols,lchnk)
+ varName = "SIGMA"//trim(modeString)
+ call outfld(varName, sigma(:,:,n), pcols,lchnk)
+ varName = "HYGRO"//trim(modeString)
+ call outfld(varName, hygroscopicity(:,:,n), pcols,lchnk)
+ end do
+
+ alert = .FALSE.
+ do k=top_lev,pver
+ mm = k - top_lev + 1
+ do m=1,nmodes
+ if(.NOT. alert .and. &
+!tht is zero an allowed value for numberConcentration??
+ ANY(numberConcentration(:ncol,k,m) .lt. 0.0_r8 ))then
+ alert = .TRUE.
+ lptr = k
+ print*,"STRANGE numberconc", m, minval(numberConcentration(:,:,:))*1.e-6_r8, "#/cm3", k, mm
+ endif
+ enddo
+ enddo
+
+
+ if(alert)then
+ print*,"strange stuff here "
+ stop
+
+ !do m=1,nmodes
+ ! print*,"numberconc (after alert)", m, modedefs(1)%nnatk(m)*1.e-6_r8, "#/cm3" &
+ ! ,modedefs(1)%C(m)*1.0e9_r8, "ug/m3"
+
+ ! if(modedefs(1)%nnatk(m) > 1.e-30_r8)then
+ ! print*, "final weight per particle ",m, modedefs(1)%C(m)/modedefs(1)%nnatk(m)
+ ! endif
+ !end do
+ !stop
+ endif
+
+#endif
+
+ ! overall_main_i_loop
+ do i = 1, ncol
+
+#ifdef OSLO_AERO
+ coltend(i,:)=0.0_r8
+ coltend_cw(i,:) = 0.0_r8
+#endif
+
+ do k = top_lev, pver-1
+ zs(k) = 1._r8/(zm(i,k) - zm(i,k+1))
+ end do
+ zs(pver) = zs(pver-1)
+
+ ! load number nucleated into qcld on cloud boundaries
+
+ do k = top_lev, pver
+
+ qcld(k) = ncldwtr(i,k)
+ qncld(k) = 0._r8
+ srcn(k) = 0._r8
+ cs(i,k) = pmid(i,k)/(rair*temp(i,k)) ! air density (kg/m3)
+ dz(i,k) = 1._r8/(cs(i,k)*gravit*rpdel(i,k)) ! layer thickness in m
+
+ do m = 1, ntot_amode
+ nact(k,m) = 0._r8
+ mact(k,m) = 0._r8
+ end do
+
+ zn(k) = gravit*rpdel(i,k)
+
+ if (k < pver) then
+ ekd(k) = kvh(i,k+1)
+ ekd(k) = max(ekd(k), zkmin)
+ ekd(k) = min(ekd(k), zkmax)
+ csbot(k) = 2.0_r8*pint(i,k+1)/(rair*(temp(i,k) + temp(i,k+1)))
+ csbot_cscen(k) = csbot(k)/cs(i,k)
+ else
+ ekd(k) = 0._r8
+ csbot(k) = cs(i,k)
+ csbot_cscen(k) = 1.0_r8
+ end if
+
+ ! rce-comment - define wtke at layer centers for new-cloud activation
+ ! and at layer boundaries for old-cloud activation
+ !++ag
+ wtke_cen(i,k) = wsub(i,k)
+ wtke(i,k) = wsub(i,k)
+ !--ag
+ wtke_cen(i,k) = max(wtke_cen(i,k), wmixmin)
+ wtke(i,k) = max(wtke(i,k), wmixmin)
+
+ nsource(i,k) = 0._r8
+
+ end do ! k
+
+ nsav = 1
+ nnew = 2
+#ifdef OSLO_AERO
+
+ !get constituent fraction
+ componentFractionOK(:,:,:) = 0.0_r8
+ do k=top_lev, pver
+ do m = 1,ntot_amode
+ if(m .le. nbmodes)then
+ do l = 1, nspec_amode(m)
+ !calculate fraction of component "l" in mode "m" based on concentrations in clear air
+ componentFractionOK(k,m,getTracerIndex(m,l,.false.)) &
+ = getConstituentFraction(CProcessModes(i,k), f_c(i,k), f_bc(i,k), f_aq(i,k), f_so4_cond(i,k), f_soa(i,k) &
+ ,Cam(i,k,m), f_acm(i,k,m), f_bcm(i,k,m), f_aqm(i,k,m), f_so4_condm(i,k,m) , f_soam(i,k,m), getTracerIndex(m,l,.false.) )
+ end do
+ else
+ do l = 1, nspec_amode(m)
+ componentFractionOK(k,m,getTracerIndex(m,l,.false.)) = 1.0_r8
+ end do
+ endif
+ end do
+
+ !Loop over all tracers ==> check that sums to one
+ !for all tracers which exist in the oslo-modes
+ do l=1,pcnst
+ sumFraction = 0.0_r8
+ do m=1,ntot_amode
+ sumFraction = sumFraction + componentFractionOK(k,m,l)
+ end do
+ if(sumFraction .gt. 1.e-2_r8)then !Just scale what comes out if componentFraction is larger than 1%
+ do m=1,ntot_amode
+ componentFractionOK(k,m,l) = &
+ componentFractionOK(k,m,l)/sumFraction
+ end do
+ else !negative or zero fraction for this species
+ !distribute equal fraction to all receiver modes
+ sumFraction = 0.0_r8
+ do m=1,ntot_amode
+ do lptr=1,getNumberOfTracersInMode(m)
+ if(getTracerIndex(m,lptr,.FALSE.) .eq. l ) then
+ sumFraction = sumFraction + 1.0_r8
+ endif
+ end do ! tracers in mode
+ end do ! mode
+ do m=1,ntot_amode
+ componentFractionOK(k,m,l)=1.0_r8/max(1.e-30_r8, sumFraction)
+ end do !modes
+ endif
+ end do !tracers
+ end do !levels
+ !debug sum fraction for "i" done
+
+
+
+ debugSumFraction(:) = 0.0_r8 !sum of component lDebug in level k
+ do m = 1, nmodes ! Number of modes
+ !Get number concentration of this mode
+ mm =mam_idx(m,0)
+ do k= top_lev,pver
+ raercol(k,mm,nsav) = numberConcentration(i,k,m)/cs(i,k) !#/kg air
+ !In oslo model, number concentrations are diagnostics, so
+ !Approximate number concentration in each mode by total
+ !cloud number concentration scaled by how much is available of
+ !each mode
+ raercol_cw(k,mm,nsav) = ncldwtr(i,k)*numberConcentration(i,k,m)&
+ /max(1.e-30_r8, sum(numberConcentration(i,k,1:nmodes)))
+ enddo
+
+ !These are the mass mixing ratios
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l) !index of tracer (all unique)
+ raercol(:,mm,nsav) = 0.0_r8
+ raercol_cw(:,mm,nsav) = 0.0_r8
+ !Several of the fields (raer(mm)%fld point to the same
+ !field in q. To avoid double counting, we take into
+ !account the component fraction in the mode
+ do k=top_lev,pver
+ if(m .gt. nbmodes) then
+ componentFraction = 1.0_r8
+ else
+ componentFraction = componentFractionOK(k,m,getTracerIndex(m,l,.false.))
+ endif
+#ifdef EXTRATESTS
+ if(i .eq. iDebug .and. getTracerIndex(m,l,.false.) .eq. lDebug)then
+ !print*,"componentFraction", i,cnst_name(oslo_cnst_idx(m,l)),componentFraction
+ print*,"assigning cloud/aerosol", k,m,l,qqcw(mm)%fld(i,k), raer(mm)%fld(i,k) &
+ ,componentFraction
+ debugSumFraction(k) = debugSumFraction(k) + componentFraction
+ endif
+ if(componentFraction > 1.0_r8)then
+ print*, "wrong component fraction", componentFraction
+ stop
+ call endrun("wrong component fraction")
+ endif
+#endif
+ !Assign to the components used here i.e. distribute condensate/coagulate to modes
+ raercol_cw(k,mm,nsav) = qqcw(mm)%fld(i,k)*componentFraction
+ raercol(k,mm,nsav) = raer(mm)%fld(i,k)*componentFraction
+ enddo ! k (levels)
+ end do ! l (species)
+ end do ! m (modes)
+#ifdef EXTRATESTS
+ do k=top_lev,pver
+ if(i .eq. iDebug .and. (abs(debugSumFraction(k)-1.0_r8).gt.1.e-2_r8) .and. debugSumFraction(k).gt.1.e-6_r8)then
+ print*, "debugSumFraction", cnst_name(getTracerIndex(m,l,.false.)),i, k, debugSumFraction(k), abs(debugSumFraction(k)-1.0_r8)
+ componentFraction=0.0_r8
+ do m=1,nbmodes
+ componentFraction = componentFraction + cam(i,k,m)
+ print*, "MODECONC", m, cam(i,k,m), numberConcentration(i,k,m)
+ end do
+ print*, "CS, sumCAM", CProcessModes(i,k), sum(cam(i,k,1:nbmodes)), componentFraction
+ print*, "q (cond)", state%q(i,k,lDebug)*cs(i,k)!mass in q
+ print*, "q (aq) " ,state%q(i,k,l_so4_a2)*cs(i,k)
+ print*, "bulk fractions", f_so4_cond(i,k),f_c(i,k), f_bc(i,k), f_aq(i,k)
+ !print*, "other levels", debugSumFraction(:)
+ do m=1,nmodes
+ do l=1,nspec_amode(m)
+ if(getTracerIndex(m,l,.false.) == ldebug)then
+ if(m .gt. nbmodes)then
+ componentFraction = 1.0_r8
+ else
+ componentFraction = componentFractionOK(k,m,getTracerIndex(m,l,.false.))
+ endif
+ print*, "nmode, l,k, ", m,l,k , lDebug, componentFraction, cam(i,k,m), f_aqm(i,k,m), f_acm(i,k,m), f_so4_condm(i,k,m)
+ print*, "fraction2 ", cam(i,k,m), cam(i,k,m)/CProcessModes(i,k)*100.0_r8, " %"
+ endif
+ enddo
+ enddo
+ call endrun("wrong debugsumfraction")
+ endif !idebug/ldebug
+ enddo
+#endif
+ !END OSLO-STUFF, BELOW IS MAM 3
+#else
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ raercol_cw(:,mm,nsav) = 0.0_r8
+ raercol(:,mm,nsav) = 0.0_r8
+ raercol_cw(top_lev:pver,mm,nsav) = qqcw(mm)%fld(i,top_lev:pver)
+ raercol(top_lev:pver,mm,nsav) = raer(mm)%fld(i,top_lev:pver)
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ raercol_cw(top_lev:pver,mm,nsav) = qqcw(mm)%fld(i,top_lev:pver)
+ raercol(top_lev:pver,mm,nsav) = raer(mm)%fld(i,top_lev:pver)
+ end do
+ end do
+#endif
+
+
+ if (called_from_spcam) then
+ !
+ ! In the MMF model, turbulent mixing for tracer species are turned off.
+ ! So the turbulent for gas species mixing are added here.
+ ! (Previously, it had the turbulent mixing for aerosol species)
+ !
+ do m=1, pcnst
+ if (cnst_species_class(m) == cnst_spec_class_gas) rgascol(:,m,nsav) = rgas(i,:,m)
+ end do
+
+ endif
+
+ ! droplet nucleation/aerosol activation
+
+ ! tau_cld_regenerate = time scale for regeneration of cloudy air
+ ! by (horizontal) exchange with clear air
+ tau_cld_regenerate = 3600.0_r8 * 3.0_r8
+
+ if (called_from_spcam) then
+ ! when this is called in the MMF part, no cloud regeneration and decay.
+ ! set the time scale be very long so that no cloud regeneration.
+ tau_cld_regenerate = 3600.0_r8 * 24.0_r8 * 365.0_r8
+ endif
+
+
+ ! k-loop for growing/shrinking cloud calcs .............................
+ ! grow_shrink_main_k_loop: &
+ do k = top_lev, pver
+
+ ! This code was designed for liquid clouds, but the cloudbourne
+ ! aerosol can be either from liquid or ice clouds. For the ice clouds,
+ ! we do not do regeneration, but as cloud fraction decreases the
+ ! aerosols should be returned interstitial. The lack of a liquid cloud
+ ! should not mean that all of the aerosol is realease. Therefor a
+ ! section has been added for shrinking ice clouds and checks were added
+ ! to protect ice cloudbourne aerosols from being released when no
+ ! liquid cloud is present.
+
+ ! shrinking ice cloud ......................................................
+ cldo_tmp = cldo(i,k) * (1._r8 - cldliqf(i,k))
+ cldn_tmp = cldn(i,k) * (1._r8 - cldliqf(i,k))
+
+ if (cldn_tmp < cldo_tmp) then
+
+ ! convert activated aerosol to interstitial in decaying cloud
+
+ dumc = (cldn_tmp - cldo_tmp)/cldo_tmp * (1._r8 - cldliqf(i,k))
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ dact = raercol_cw(k,mm,nsav)*dumc
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ dact = raercol_cw(k,mm,nsav)*dumc
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+ end do
+ end do
+ end if
+
+ ! shrinking liquid cloud ......................................................
+ ! treat the reduction of cloud fraction from when cldn(i,k) < cldo(i,k)
+ ! and also dissipate the portion of the cloud that will be regenerated
+ cldo_tmp = lcldo(i,k)
+ cldn_tmp = lcldn(i,k) * exp( -dtmicro/tau_cld_regenerate )
+ ! alternate formulation
+ ! cldn_tmp = cldn(i,k) * max( 0.0_r8, (1.0_r8-dtmicro/tau_cld_regenerate) )
+
+ ! fraction is also provided.
+ if (cldn_tmp < cldo_tmp) then
+ ! droplet loss in decaying cloud
+ !++ sungsup
+ nsource(i,k) = nsource(i,k) + qcld(k)*(cldn_tmp - cldo_tmp)/cldo_tmp*cldliqf(i,k)*dtinv
+ qcld(k) = qcld(k)*(1._r8 + (cldn_tmp - cldo_tmp)/cldo_tmp)
+ !-- sungsup
+
+ ! convert activated aerosol to interstitial in decaying cloud
+
+ dumc = (cldn_tmp - cldo_tmp)/cldo_tmp * cldliqf(i,k)
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ dact = raercol_cw(k,mm,nsav)*dumc
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ dact = raercol_cw(k,mm,nsav)*dumc
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+#ifdef EXTRATESTS
+ if(i.eq. iDebug .and. getTracerIndex(m,l,.false.).eq.lDebug)then
+ print*,"decaying cloud", k, dact, cldn_tmp, cldo_tmp
+ endif
+#endif
+ end do
+ end do
+ end if
+
+ ! growing liquid cloud ......................................................
+ ! treat the increase of cloud fraction from when cldn(i,k) > cldo(i,k)
+ ! and also regenerate part of the cloud
+ cldo_tmp = cldn_tmp
+ cldn_tmp = lcldn(i,k)
+
+ if (cldn_tmp-cldo_tmp > 0.01_r8) then
+
+ ! rce-comment - use wtke at layer centers for new-cloud activation
+ wbar = wtke_cen(i,k)
+ wmix = 0._r8
+ wmin = 0._r8
+ wmax = 10._r8
+ wdiab = 0._r8
+
+ ! load aerosol properties, assuming external mixtures
+
+#ifdef OSLO_AERO
+ naermod(:) = 0.0_r8
+ vaerosol(:) = 0.0_r8
+ hygro(:) = 0.0_r8
+ lnsigman(:) = log(2.0_r8)
+
+ m=0
+ do kcomp = 1,nmodes
+ if(hasAerosol(i,k,kcomp) .eqv. .TRUE.)then
+ m = m + 1
+ naermod(m) = numberConcentration(i,k,kcomp)
+ vaerosol(m) = volumeConcentration(i,k,kcomp)
+ hygro(m) = hygroscopicity(i,k,kcomp)
+ lnsigman(m) = lnsigma(i,k,kcomp)
+ speciesMap(m) = kcomp
+ end if
+ end do
+ numberOfModes = m
+#else
+ numberOfModes = ntot_amode
+ phase = 1 ! interstitial
+ do m = 1, ntot_amode
+ call loadaer( &
+ state, pbuf, i, i, k, &
+ m, cs, phase, na, va, &
+ hy)
+ naermod(m) = na(i)
+ vaerosol(m) = va(i)
+ hygro(m) = hy(i)
+ end do
+#endif
+ !++ MH_2015/04/10
+ !Call the activation procedure
+ if(numberOfModes .gt. 0)then
+ if (use_hetfrz_classnuc) then
+ call activate_modal( &
+ wbar, wmix, wdiab, wmin, wmax, &
+ temp(i,k), cs(i,k), naermod, numberOfModes, &
+ vaerosol, hygro, fn_in(i,k,1:nmodes), fm, fluxn, &
+ fluxm,flux_fullact(k) &
+#ifdef OSLO_AERO
+ ,lnsigman &
+#endif
+ )
+ else
+ call activate_modal( &
+ wbar, wmix, wdiab, wmin, wmax, &
+ temp(i,k), cs(i,k), naermod, numberOfModes, &
+ vaerosol, hygro, fn, fm, fluxn, &
+ fluxm,flux_fullact(k) &
+#ifdef OSLO_AERO
+ ,lnsigman &
+#endif
+ )
+ end if
+ !-- MH_2015/04/10
+ endif
+
+ dumc = (cldn_tmp - cldo_tmp)
+#ifdef OSLO_AERO
+ if (use_hetfrz_classnuc) then
+ fn_tmp(:) = fn_in(i,k,1:nmodes)
+ else
+ fn_tmp(:) = fn(:)
+ end if
+ fm_tmp(:) = fm(:)
+ fluxn_tmp(:) = fluxn(:)
+ fluxm_tmp(:) = fluxm(:)
+ fn(:) = 0.0_r8
+ fn_in(i,k,:) = 0.0_r8
+ fm(:) = 0.0_r8
+ fluxn(:)=0.0_r8
+ fluxm(:)= 0.0_r8
+ do m = 1, numberOfModes !Number of coexisting modes to be used for activation
+ kcomp = speciesMap(m) !This is the CAM-oslo mode (modes 1-14 may be activated, mode 0 not)
+ if (use_hetfrz_classnuc) then
+ fn_in(i,k,kcomp) = fn_tmp(m)
+ else
+ fn(kcomp) = fn_tmp(m)
+ end if
+ fm(kcomp) = fm_tmp(m)
+ fluxn(kcomp) = fluxn_tmp(m)
+ fluxm(kcomp) = fluxm_tmp(m)
+ enddo
+#endif
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+#ifdef OSLO_AERO
+ if (use_hetfrz_classnuc) then
+ dact = dumc*fn_in(i,k,m)*numberConcentration(i,k,m)/cs(i,k) !#/kg_{air}
+ else
+ dact = dumc*fn(m)*numberConcentration(i,k,m)/cs(i,k) !#/kg_{air}
+ end if
+#else
+ if (use_hetfrz_classnuc) then
+ dact = dumc*fn_in(i,k,m)*raer(mm)%fld(i,k) ! interstitial only
+ else
+ dact = dumc*fn(m)*raer(mm)%fld(i,k) ! interstitial only
+ end if
+#endif
+ qcld(k) = qcld(k) + dact
+ nsource(i,k) = nsource(i,k) + dact*dtinv
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+ dum = dumc*fm(m)
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+#ifdef OSLO_AERO
+ if(m .gt. nbmodes)then
+ constituentFraction = 1.0_r8
+ else
+ constituentFraction = componentFractionOK(k,m,getTracerIndex(m,l,.false.) )
+ endif
+
+ dact = dum*raer(mm)%fld(i,k)*constituentFraction
+#else
+ dact = dum*raer(mm)%fld(i,k) ! interstitial only
+#endif
+ raercol_cw(k,mm,nsav) = raercol_cw(k,mm,nsav) + dact ! cloud-borne aerosol
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) - dact
+#ifdef EXTRATESTS
+ if(i.eq.iDebug .and. getTracerIndex(m,l,.false.).eq.lDebug)then
+ print*,"growing cloud (new/old)", k, raercol_cw(k,mm,nsav), raercol_cw(k,mm,nsav)-dact &
+ ,raercol(k,mm,nsav),raercol(k,mm,nsav)+dact,dact
+ endif
+#endif
+ enddo
+ enddo
+ endif ! cldn_tmp-cldo_tmp > 0.01_r8
+
+ enddo ! grow_shrink_main_k_loop
+ ! end of k-loop for growing/shrinking cloud calcs ......................
+
+ ! ......................................................................
+ ! start of k-loop for calc of old cloud activation tendencies ..........
+ !
+ ! rce-comment
+ ! changed this part of code to use current cloud fraction (cldn) exclusively
+ ! consider case of cldo(:)=0, cldn(k)=1, cldn(k+1)=0
+ ! previous code (which used cldo below here) would have no cloud-base activation
+ ! into layer k. however, activated particles in k mix out to k+1,
+ ! so they are incorrectly depleted with no replacement
+
+ ! old_cloud_main_k_loop
+ do k = top_lev, pver
+ kp1 = min0(k+1, pver)
+ taumix_internal_pver_inv = 0.0_r8
+
+ if (lcldn(i,k) > 0.01_r8) then
+
+ wdiab = 0._r8
+ wmix = 0._r8 ! single updraft
+ wbar = wtke(i,k) ! single updraft
+ if (k == pver) wbar = wtke_cen(i,k) ! single updraft
+ wmax = 10._r8
+ wmin = 0._r8
+
+ if (lcldn(i,k) - lcldn(i,kp1) > 0.01_r8 .or. k == pver) then
+
+ ! cloud base
+
+ ! ekd(k) = wtke(i,k)*dz(i,k)/sq2pi
+ ! rce-comments
+ ! first, should probably have 1/zs(k) here rather than dz(i,k) because
+ ! the turbulent flux is proportional to ekd(k)*zs(k),
+ ! while the dz(i,k) is used to get flux divergences
+ ! and mixing ratio tendency/change
+ ! second and more importantly, using a single updraft velocity here
+ ! means having monodisperse turbulent updraft and downdrafts.
+ ! The sq2pi factor assumes a normal draft spectrum.
+ ! The fluxn/fluxm from activate must be consistent with the
+ ! fluxes calculated in explmix.
+ ekd(k) = wbar/zs(k)
+
+ alogarg = max(1.e-20_r8, 1._r8/lcldn(i,k) - 1._r8)
+ wmin = wbar + wmix*0.25_r8*sq2pi*log(alogarg)
+ phase = 1 ! interstitial
+#ifdef OSLO_AERO
+ naermod(:) = 0.0_r8
+ vaerosol(:) = 0.0_r8
+ hygro(:) = 0.0_r8
+ lnsigman(:) = log(2.0_r8)
+
+ m=0
+ do kcomp = 1,nmodes
+ if(hasAerosol(i,kp1,kcomp) .eqv. .TRUE.)then
+ m = m + 1
+ naermod(m) = numberConcentration(i,kp1,kcomp)
+ vaerosol(m) = volumeConcentration(i,kp1,kcomp)
+ hygro(m) = hygroscopicity(i,kp1,kcomp)
+ lnsigman(m) = lnsigma(i,kp1,kcomp)
+ speciesMap(m) = kcomp
+ end if
+ end do
+ numberOfModes = m
+#else
+ numberOfModes = ntot_amode
+
+ do m = 1, ntot_amode
+ ! rce-comment - use kp1 here as old-cloud activation involves
+ ! aerosol from layer below
+ call loadaer( &
+ state, pbuf, i, i, kp1, &
+ m, cs, phase, na, va, &
+ hy)
+ naermod(m) = na(i)
+ vaerosol(m) = va(i)
+ hygro(m) = hy(i)
+ end do
+#endif
+ !++ MH_2015/04/10
+ if(numberOfModes .gt. 0)then
+ if (use_hetfrz_classnuc) then
+ call activate_modal( &
+ wbar, wmix, wdiab, wmin, wmax, &
+ temp(i,k), cs(i,k), naermod, numberOfModes , &
+ vaerosol, hygro, fn_in(i,k,:), fm, fluxn, &
+ fluxm, flux_fullact(k) &
+#ifdef OSLO_AERO
+ ,lnsigman &
+#endif
+ )
+ else
+ call activate_modal( &
+ wbar, wmix, wdiab, wmin, wmax, &
+ temp(i,k), cs(i,k), naermod, numberOfModes , &
+ vaerosol, hygro, fn, fm, fluxn, &
+ fluxm, flux_fullact(k) &
+#ifdef OSLO_AERO
+ ,lnsigman &
+#endif
+ )
+ end if
+ !-- MH_2015/04/10
+ endif
+
+ !Difference in cloud fraction this layer and above!
+ !we are here because there are more clouds above, and some
+ !aerosols go into that layer! ==> calculate additional cloud fraction
+ if (k < pver) then
+ dumc = lcldn(i,k) - lcldn(i,kp1)
+ else
+ dumc = lcldn(i,k)
+ endif
+
+#ifdef OSLO_AERO
+ if (use_hetfrz_classnuc) then
+ fn_tmp(:) = fn_in(i,k,1:nmodes)
+ else
+ fn_tmp(:) = fn(:)
+ end if
+ fm_tmp(:) = fm(:)
+ fluxn_tmp(:) = fluxn(:)
+ fluxm_tmp(:) = fluxm(:)
+ fn(:) = 0.0_r8
+ fn_in(i,k,:) = 0.0_r8
+ fm(:) = 0.0_r8
+ fluxn(:)=0.0_r8
+ fluxm(:)= 0.0_r8
+ do m = 1, numberOfModes !Number of coexisting modes to be used for activation
+ kcomp = speciesMap(m) !This is the CAM-oslo mode (modes 1-14 may be activated, mode 0 not)
+ if (use_hetfrz_classnuc) then
+ fn_in(i,k,kcomp) = fn_tmp(m)
+ else
+ fn(kcomp) = fn_tmp(m)
+ end if
+ fm(kcomp) = fm_tmp(m)
+ fluxn(kcomp) = fluxn_tmp(m)
+ fluxm(kcomp) = fluxm_tmp(m)
+ enddo
+#endif
+
+ fluxntot = 0.0_r8
+
+ ! rce-comment 1
+ ! flux of activated mass into layer k (in kg/m2/s)
+ ! = "actmassflux" = dumc*fluxm*raercol(kp1,lmass)*csbot(k)
+ ! source of activated mass (in kg/kg/s) = flux divergence
+ ! = actmassflux/(cs(i,k)*dz(i,k))
+ ! so need factor of csbot_cscen = csbot(k)/cs(i,k)
+ ! dum=1./(dz(i,k))
+ dum=csbot_cscen(k)/(dz(i,k))
+
+ ! rce-comment 2
+ ! code for k=pver was changed to use the following conceptual model
+ ! in k=pver, there can be no cloud-base activation unless one considers
+ ! a scenario such as the layer being partially cloudy,
+ ! with clear air at bottom and cloudy air at top
+ ! assume this scenario, and that the clear/cloudy portions mix with
+ ! a timescale taumix_internal = dz(i,pver)/wtke_cen(i,pver)
+ ! in the absence of other sources/sinks, qact (the activated particle
+ ! mixratio) attains a steady state value given by
+ ! qact_ss = fcloud*fact*qtot
+ ! where fcloud is cloud fraction, fact is activation fraction,
+ ! qtot=qact+qint, qint is interstitial particle mixratio
+ ! the activation rate (from mixing within the layer) can now be
+ ! written as
+ ! d(qact)/dt = (qact_ss - qact)/taumix_internal
+ ! = qtot*(fcloud*fact*wtke/dz) - qact*(wtke/dz)
+ ! note that (fcloud*fact*wtke/dz) is equal to the nact/mact
+ ! also, d(qact)/dt can be negative. in the code below
+ ! it is forced to be >= 0
+ !
+ ! steve --
+ ! you will likely want to change this. i did not really understand
+ ! what was previously being done in k=pver
+ ! in the cam3_5_3 code, wtke(i,pver) appears to be equal to the
+ ! droplet deposition velocity which is quite small
+ ! in the cam3_5_37 version, wtke is done differently and is much
+ ! larger in k=pver, so the activation is stronger there
+ !
+ if (k == pver) then
+ taumix_internal_pver_inv = flux_fullact(k)/dz(i,k)
+ end if
+
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ fluxn(m) = fluxn(m)*dumc
+ fluxm(m) = fluxm(m)*dumc
+ nact(k,m) = nact(k,m) + fluxn(m)*dum
+ mact(k,m) = mact(k,m) + fluxm(m)*dum
+ if (k < pver) then
+ ! note that kp1 is used here
+ fluxntot = fluxntot &
+ + fluxn(m)*raercol(kp1,mm,nsav)*cs(i,k)
+ else
+ tmpa = raercol(kp1,mm,nsav)*fluxn(m) &
+ + raercol_cw(kp1,mm,nsav)*(fluxn(m) &
+ - taumix_internal_pver_inv*dz(i,k))
+ fluxntot = fluxntot + max(0.0_r8, tmpa)*cs(i,k)
+ end if
+ end do
+ srcn(k) = srcn(k) + fluxntot/(cs(i,k)*dz(i,k))
+ nsource(i,k) = nsource(i,k) + fluxntot/(cs(i,k)*dz(i,k))
+#ifdef EXTRATESTS
+ if(fluxntot/(cs(i,k)*dz(i,k)) > 0.0_r8 )then
+ print*,"activated/available(from below)",i,k,m,fluxntot/(cs(i,k)*dz(i,k))
+ endif
+#endif
+ endif ! (cldn(i,k) - cldn(i,kp1) > 0.01 .or. k == pver)
+
+ else ! i.e: cldn(i,k) < 0.01_r8
+
+ ! no liquid cloud
+
+ nsource(i,k) = nsource(i,k) - qcld(k)*dtinv
+ qcld(k) = 0.0_r8
+
+ if (cldn(i,k) < 0.01_r8) then
+ ! no ice cloud either
+
+ ! convert activated aerosol to interstitial in decaying cloud
+
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) + raercol_cw(k,mm,nsav) ! cloud-borne aerosol
+ raercol_cw(k,mm,nsav) = 0._r8
+
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+#ifdef EXTRATESTS
+ if(i.eq.iDebug .and. getTracerIndex(m,l,.false.).eq.lDebug)then
+ print*,"no cloud", k, raercol(k,mm,nsav) , raercol_cw(k,mm,nsav)
+ endif
+#endif
+ raercol(k,mm,nsav) = raercol(k,mm,nsav) + raercol_cw(k,mm,nsav) ! cloud-borne aerosol
+ raercol_cw(k,mm,nsav) = 0._r8
+ end do
+ end do
+ end if
+ end if
+
+ end do ! old_cloud_main_k_loop
+
+ ! switch nsav, nnew so that nnew is the updated aerosol
+ ntemp = nsav
+ nsav = nnew
+ nnew = ntemp
+
+ ! load new droplets in layers above, below clouds
+
+ dtmin = dtmicro
+ ekk(top_lev-1) = 0.0_r8
+ ekk(pver) = 0.0_r8
+ do k = top_lev, pver-1
+ ! rce-comment -- ekd(k) is eddy-diffusivity at k/k+1 interface
+ ! want ekk(k) = ekd(k) * (density at k/k+1 interface)
+ ! so use pint(i,k+1) as pint is 1:pverp
+ ! ekk(k)=ekd(k)*2.*pint(i,k)/(rair*(temp(i,k)+temp(i,k+1)))
+ ! ekk(k)=ekd(k)*2.*pint(i,k+1)/(rair*(temp(i,k)+temp(i,k+1)))
+ ekk(k) = ekd(k)*csbot(k)
+ end do
+
+ do k = top_lev, pver
+ km1 = max0(k-1, top_lev)
+ ekkp(k) = zn(k)*ekk(k)*zs(k)
+ ekkm(k) = zn(k)*ekk(k-1)*zs(km1)
+ tinv = ekkp(k) + ekkm(k)
+
+ ! rce-comment -- tinv is the sum of all first-order-loss-rates
+ ! for the layer. for most layers, the activation loss rate
+ ! (for interstitial particles) is accounted for by the loss by
+ ! turb-transfer to the layer above.
+ ! k=pver is special, and the loss rate for activation within
+ ! the layer must be added to tinv. if not, the time step
+ ! can be too big, and explmix can produce negative values.
+ ! the negative values are reset to zero, resulting in an
+ ! artificial source.
+ if (k == pver) tinv = tinv + taumix_internal_pver_inv
+
+ if (tinv .gt. 1.e-6_r8) then
+ dtt = 1._r8/tinv
+ dtmin = min(dtmin, dtt)
+ end if
+ end do
+
+ dtmix = 0.9_r8*dtmin
+ nsubmix = dtmicro/dtmix + 1
+ if (nsubmix > 100) then
+ nsubmix_bnd = 100
+ else
+ nsubmix_bnd = nsubmix
+ end if
+ count_submix(nsubmix_bnd) = count_submix(nsubmix_bnd) + 1
+ dtmix = dtmicro/nsubmix
+
+ do k = top_lev, pver
+ kp1 = min(k+1, pver)
+ km1 = max(k-1, top_lev)
+ ! maximum overlap assumption
+ if (cldn(i,kp1) > 1.e-10_r8) then
+ overlapp(k) = min(cldn(i,k)/cldn(i,kp1), 1._r8)
+ else
+ overlapp(k) = 1._r8
+ end if
+ if (cldn(i,km1) > 1.e-10_r8) then
+ overlapm(k) = min(cldn(i,k)/cldn(i,km1), 1._r8)
+ else
+ overlapm(k) = 1._r8
+ end if
+ end do
+
+
+ ! rce-comment
+ ! the activation source(k) = mact(k,m)*raercol(kp1,lmass)
+ ! should not exceed the rate of transfer of unactivated particles
+ ! from kp1 to k which = ekkp(k)*raercol(kp1,lmass)
+ ! however it might if things are not "just right" in subr activate
+ ! the following is a safety measure to avoid negatives in explmix
+ do k = top_lev, pver-1
+ do m = 1, ntot_amode
+ nact(k,m) = min( nact(k,m), ekkp(k) )
+ mact(k,m) = min( mact(k,m), ekkp(k) )
+ end do
+ end do
+
+!Don't need the mixing per mode in OSLO_AERO ==> only per tracer
+!Note that nsav/nnew is switched above, so operate on nnew here
+!nnew is the updated aerosol
+#ifdef OSLO_AERO
+ raercol_tracer(:,:,:) = 0.0_r8
+ raercol_cw_tracer(:,:,:) = 0.0_r8
+ mact_tracer(:,:) = 0.0_r8
+ mfullact_tracer(:,:) = 0.0_r8
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr = getTracerIndex(m,l,.FALSE.) !which tracer are we talking about
+ lptr2 = inverseAerosolTracerList(lptr) !which index is this in the list of aerosol-tracers
+ mm = mam_idx(m,l)
+ raercol_tracer(:,lptr2,nnew) = raercol_tracer(:,lptr2,nnew) &
+ + raercol(:,mm,nnew)
+
+ raercol_cw_tracer(:,lptr2,nnew) = raercol_cw_tracer(:,lptr2,nnew)&
+ + raercol_cw(:,mm,nnew)
+
+ mact_tracer(:,lptr2) = mact_tracer(:,lptr2) + mact(:,m)*raercol(:,mm,nnew)
+ mfullact_tracer(:,lptr2) = mfullact_tracer(:,lptr2) + raercol(:,mm,nnew)
+
+#ifdef EXTRATESTS
+ if(lptr.eq.lDebug .and. i.eq.iDebug)then
+ do k=pver,top_lev,-1
+ print*, "assigning to tracer space",lptr, raercol(k,mm,nnew) &
+ , raercol_tracer(k,lptr2,nnew) &
+ , raercol_cw(k,mm,nnew) &
+ , raercol_cw_tracer(k,lptr2,nnew)
+ end do
+ end if
+#endif
+ end do !l
+ end do !m
+
+ do lptr2=1,n_aerosol_tracers
+ mact_tracer(:,lptr2) = mact_tracer(:,lptr2) &
+ /(mfullact_tracer(:,lptr2) + smallNumber)
+ end do
+#endif OSLO_AERO
+
+ ! old_cloud_nsubmix_loop
+ do n = 1, nsubmix
+ qncld(:) = qcld(:)
+ ! switch nsav, nnew so that nsav is the updated aerosol
+ ntemp = nsav
+ nsav = nnew
+ nnew = ntemp
+ srcn(:) = 0.0_r8
+
+ !First mix cloud droplet number concentration
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+
+ ! update droplet source
+ ! rce-comment- activation source in layer k involves particles from k+1
+ ! srcn(:)=srcn(:)+nact(:,m)*(raercol(:,mm,nsav))
+ srcn(top_lev:pver-1) = srcn(top_lev:pver-1) + nact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav))
+
+ ! rce-comment- new formulation for k=pver
+ ! srcn( pver )=srcn( pver )+nact( pver ,m)*(raercol( pver,mm,nsav))
+ tmpa = raercol(pver,mm,nsav)*nact(pver,m) &
+ + raercol_cw(pver,mm,nsav)*(nact(pver,m) - taumix_internal_pver_inv)
+ srcn(pver) = srcn(pver) + max(0.0_r8,tmpa)
+ end do
+
+ !mixing of cloud droplets
+ call explmix( &
+ qcld, srcn, ekkp, ekkm, overlapp, &
+ overlapm, qncld, zero, zero, pver, &
+ dtmix, .false.)
+
+#ifdef OSLO_AERO
+ !Mix number concentrations consistently!!
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ ! rce-comment - activation source in layer k involves particles from k+1
+ ! source(:)= nact(:,m)*(raercol(:,mm,nsav))
+ source(top_lev:pver-1) = nact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav))
+ ! rce-comment - new formulation for k=pver
+ ! source( pver )= nact( pver, m)*(raercol( pver,mm,nsav))
+ tmpa = raercol(pver,mm,nsav)*nact(pver,m) &
+ + raercol_cw(pver,mm,nsav)*(nact(pver,m) - taumix_internal_pver_inv)
+ source(pver) = max(0.0_r8, tmpa)
+ flxconv = 0._r8
+
+ call explmix( &
+ raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, &
+ dtmix, .false.)
+
+ call explmix( &
+ raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol(:,mm,nsav), zero, flxconv, pver, &
+ dtmix, .true., raercol_cw(:,mm,nsav))
+ end do
+#endif
+
+#ifndef OSLO_AERO
+ ! rce-comment
+ ! the interstitial particle mixratio is different in clear/cloudy portions
+ ! of a layer, and generally higher in the clear portion. (we have/had
+ ! a method for diagnosing the the clear/cloudy mixratios.) the activation
+ ! source terms involve clear air (from below) moving into cloudy air (above).
+ ! in theory, the clear-portion mixratio should be used when calculating
+ ! source terms
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ ! rce-comment - activation source in layer k involves particles from k+1
+ ! source(:)= nact(:,m)*(raercol(:,mm,nsav))
+ source(top_lev:pver-1) = nact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav))
+ ! rce-comment - new formulation for k=pver
+ ! source( pver )= nact( pver, m)*(raercol( pver,mm,nsav))
+ tmpa = raercol(pver,mm,nsav)*nact(pver,m) &
+ + raercol_cw(pver,mm,nsav)*(nact(pver,m) - taumix_internal_pver_inv)
+ source(pver) = max(0.0_r8, tmpa)
+ flxconv = 0._r8
+
+ call explmix( &
+ raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, &
+ dtmix, .false.)
+
+ call explmix( &
+ raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol(:,mm,nsav), zero, flxconv, pver, &
+ dtmix, .true., raercol_cw(:,mm,nsav))
+
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ ! rce-comment - activation source in layer k involves particles from k+1
+ ! source(:)= mact(:,m)*(raercol(:,mm,nsav))
+ source(top_lev:pver-1) = mact(top_lev:pver-1,m)*(raercol(top_lev+1:pver,mm,nsav))
+ ! rce-comment- new formulation for k=pver
+ ! source( pver )= mact( pver ,m)*(raercol( pver,mm,nsav))
+ tmpa = raercol(pver,mm,nsav)*mact(pver,m) &
+ + raercol_cw(pver,mm,nsav)*(mact(pver,m) - taumix_internal_pver_inv)
+ source(pver) = max(0.0_r8, tmpa)
+ flxconv = 0._r8
+
+ call explmix( &
+ raercol_cw(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol_cw(:,mm,nsav), zero, zero, pver, &
+ dtmix, .false.)
+
+ call explmix( &
+ raercol(:,mm,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol(:,mm,nsav), zero, flxconv, pver, &
+ dtmix, .true., raercol_cw(:,mm,nsav))
+
+ end do
+ end do
+#endif
+ if (called_from_spcam) then
+ !
+ ! turbulent mixing for gas species .
+ !
+ do m=1, pcnst
+ if (cnst_species_class(m) == cnst_spec_class_gas) then
+ flxconv = 0.0_r8
+ zerogas(:) = 0.0_r8
+ call explmix(rgascol(1,m,nnew),zerogas,ekkp,ekkm,overlapp,overlapm, &
+ rgascol(1,m,nsav),zero, flxconv, pver,dtmix,&
+ .true., zerogas)
+ end if
+ end do
+ endif
+
+#ifdef OSLO_AERO
+ do lptr2=1,n_aerosol_tracers
+ source(top_lev:pver-1) = mact_tracer(top_lev:pver-1,lptr2) &
+ *(raercol_tracer(top_lev+1:pver,lptr2,nsav))
+
+ tmpa = raercol_tracer(pver,lptr2,nsav)*mact_tracer(pver,lptr2) &
+ + raercol_cw_tracer(pver,lptr2,nsav)*(mact_tracer(pver,lptr2) - taumix_internal_pver_inv)
+
+ source(pver) = max(0.0_r8, tmpa)
+ flxconv = 0.0_r8
+
+ call explmix( &
+ raercol_cw_tracer(:,lptr2,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol_cw_tracer(:,lptr2,nsav), zero, zero, pver, &
+ dtmix, .false.)
+
+ call explmix( &
+ raercol_tracer(:,lptr2,nnew), source, ekkp, ekkm, overlapp, &
+ overlapm, raercol_tracer(:,lptr2,nsav), zero, flxconv, pver, &
+ dtmix, .true., raercol_cw_tracer(:,lptr2,nsav))
+
+#ifdef EXTRATESTS
+ lptr = aerosolTracerList(lptr2)
+ if(i.eq.iDebug .and. lptr.eq.lDebug)then
+ print*, "bugeds for ",trim(cnst_name(lptr)), n, nsubmix
+ do k=pver,1,-1
+ print*, "source (aerosol/cloud) ",k, raercol_cw_tracer(k,lptr2,nnew),raercol_cw_tracer(k,lptr2,nsav) &
+ , raercol_tracer(k,lptr2,nnew),raercol_tracer(k,lptr2,nsav),source(k)
+ end do
+ if(m .le. nbmodes)then
+ print*, " ", mm, lptr, componentFractionOK(k,m,getTracerIndex(m,l,.false.))
+ endif
+ endif
+#endif
+ end do !Number of aerosol tracers
+ end do ! old_cloud_nsubmix_loop
+
+ !Set back to the original framework
+ !Could probably continue in tracer-space from here
+ !but return back to mixture for easier use of std. NCAR code
+ tendencyCounted(:)=.FALSE.
+ do m = 1, ntot_amode
+ do l=1,nspec_amode(m)
+ mm=mam_idx(m,l)
+ lptr = getTracerIndex(m,l,.FALSE.)
+ lptr2 = inverseAerosolTracerList(lptr)
+ !All the tracer-space contains sum of all
+ !modes ==> put in first available component
+ !and zero in others.
+ if(.not.tendencyCounted(lptr))then
+ raercol(:,mm,nnew) = raercol_tracer(:,lptr2,nnew)
+ raercol_cw(:,mm,nnew) = raercol_cw_tracer(:,lptr2,nnew)
+ tendencyCounted(lptr) = .TRUE.
+ else
+ raercol(:,mm,nnew) = 0.0_r8
+ raercol_cw(:,mm,nnew) = 0.0_r8
+ end if
+ end do
+ end do
+#endif
+ ! evaporate particles again if no cloud
+
+ do k = top_lev, pver
+ if (cldn(i,k) == 0._r8) then
+ ! no ice or liquid cloud
+ qcld(k)=0._r8
+
+ ! convert activated aerosol to interstitial in decaying cloud
+ do m = 1, ntot_amode
+ mm = mam_idx(m,0)
+ raercol(k,mm,nnew) = raercol(k,mm,nnew) + raercol_cw(k,mm,nnew)
+ raercol_cw(k,mm,nnew) = 0._r8
+
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ raercol(k,mm,nnew) = raercol(k,mm,nnew) + raercol_cw(k,mm,nnew)
+ raercol_cw(k,mm,nnew) = 0._r8
+ end do
+ end do
+ end if
+ end do
+
+ ! droplet number
+
+ ndropcol(i) = 0._r8
+
+ !Initialize tendnd to zero in all layers since values are set in only top_lev,pver
+ !Without this the layers above top_lev would be un-initialized
+ tendnd(i,:) = 0.0_r8
+
+ do k = top_lev, pver
+ ndropmix(i,k) = (qcld(k) - ncldwtr(i,k))*dtinv - nsource(i,k)
+ tendnd(i,k) = (max(qcld(k), 1.e-6_r8) - ncldwtr(i,k))*dtinv
+ !print*, "tendnd",i,k, "new /old/tend", qcld(k), ncldwtr(i,k), tendnd(i,k)
+ ndropcol(i) = ndropcol(i) + ncldwtr(i,k)*pdel(i,k)
+ end do
+ ndropcol(i) = ndropcol(i)/gravit
+
+#ifdef EXTRATESTS
+ print*, "tendnd (#/kg/sec)", minval(tendnd(i,:)), maxval(tendnd(i,:))
+#endif
+
+ if (prog_modal_aero) then
+
+#ifdef OSLO_AERO
+
+#ifdef MASS_BALANCE_CHECK
+ !test for correct transfer between in-cloud / no-cloud..
+ newCloud(:,:) = 0.0_r8
+ oldCloud(:,:) = 0.0_r8
+ newAerosol(:,:) = 0.0_r8
+ oldAerosol(:,:) = 0.0_r8
+ deltaCloud(:,:) = 0.0_r8
+ !Check mass balances #2 (all new cloud droplet species are taken from aerosols or from layer below
+ do k=pver,1,-1
+ mixRatioToMass = cs(i,k)*dz(i,k)
+ !First sum up cloud tracer in this layer
+ tendencyCounted(:)=.FALSE.
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ mm = mam_idx(m,l)
+ lptr = getTracerIndex(m,l,.false.) !lptr occurs several times
+ newCloud(k, lptr) = newCloud(k, lptr) + raercol_cw(k, mm, nnew)*mixRatioToMass
+ newAerosol(k, lptr) = newAerosol(k, lptr) + raercol(k,mm,nnew)*mixRatioToMass
+ if(.NOT. tendencyCounted(lptr))then
+ oldAerosol(k, lptr) = raer(mm)%fld(i,k)*mixRatioToMass
+ oldCloud(k, lptr) = qqcw(mm)%fld(i,k)*mixRatioToMass
+ tendencyCounted(lptr)=.TRUE.
+ endif
+ enddo
+ enddo
+ enddo! k
+
+ k = pver
+ !Check imbalance in bottom layer
+
+ !Any change in cloud species is either from aerosol concentration or from change in layer below
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr = getTracerIndex(m,l,.false.)
+
+ !This is the mass which must go to layer above!
+ deltaCloud(k,lptr) = (oldAerosol(k,lptr) - newAerosol(k,lptr)) &!used to create cloud species
+ -(newCloud(k,lptr) - oldCloud(k,lptr)) !created cloud species
+ enddo
+ enddo
+
+ !if "deltaCloud" is positive in layer below it means that some aerosol species were sent up
+
+ !Move upwards
+ do k=pver-1,1,-1
+ kp1 = k + 1
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr = getTracerIndex(m,l,.false.)
+ deltaCloud(k,lptr) = (oldAerosol(k,lptr)-newAerosol(k,lptr)) & !used to create cloud species
+ - (newCloud(k,lptr) - oldCloud(k,lptr)) & !created cloud species
+ - 0.0_r8 ! deltaCloud(kp1,lptr) !species received from below
+ enddo
+ enddo
+ enddo !layers
+
+ stopMe = .FALSE.
+ tendencyCounted(:) = .FALSE.
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr= getTracerIndex(m,l,.false.)
+ if(abs(sum(deltaCloud(:,lptr))) > 1.e-8_r8 .and. (.NOT. tendencyCounted(lptr)))then
+ stopMe = .TRUE.
+ lptr2 = lptr
+ print*, "wrong mass budget",i,lptr,cnst_name(lptr), sum(deltaCloud(:,lptr))
+ endif
+ tendencyCounted(lptr) = .TRUE.
+ enddo
+ enddo
+ if(stopMe)then
+ print*,"error in species : ", cnst_name(lptr2)
+ do k=pver,1,-1
+ print*, "budgets new/old ",k, newCloud(k,lptr2),oldCloud(k,lptr2),newaerosol(k,lptr2),oldAerosol(k,lptr2), deltaCloud(k,lptr2)
+ enddo
+ call endrun ("wrong mass budget in column")
+ endif
+#endif
+#endif
+ raertend = 0._r8
+ qqcwtend = 0._r8
+
+
+#ifndef OSLO_AERO
+ do m = 1, ntot_amode
+ do l = 0, nspec_amode(m)
+
+ mm = mam_idx(m,l)
+ lptr = mam_cnst_idx(m,l)
+
+ raertend(top_lev:pver) = (raercol(top_lev:pver,mm,nnew) - raer(mm)%fld(i,top_lev:pver))*dtinv
+ qqcwtend(top_lev:pver) = (raercol_cw(top_lev:pver,mm,nnew) - qqcw(mm)%fld(i,top_lev:pver))*dtinv
+
+ coltend(i,mm) = sum( pdel(i,:)*raertend )/gravit
+ coltend_cw(i,mm) = sum( pdel(i,:)*qqcwtend )/gravit
+
+ ptend%q(i,:,lptr) = 0.0_r8
+ ptend%q(i,top_lev:pver,lptr) = raertend(top_lev:pver) ! set tendencies for interstitial aerosol
+ qqcw(mm)%fld(i,:) = 0.0_r8
+ qqcw(mm)%fld(i,top_lev:pver) = raercol_cw(top_lev:pver,mm,nnew) ! update cloud-borne aerosol
+ end do
+ end do
+#else
+ !OSLO AEROSOLS ...
+
+ coltend_cw(i,:)=0.0_r8
+ coltend(i,:) = 0.0_r8
+
+ !Need to initialize first because process modes arrive several times
+ tendencyCounted(:) = .FALSE.
+ do m=1,ntot_amode
+ do l = 1,getNumberOfTracersInMode(m)
+ lptr = getTracerIndex(m,l,.false.)
+ mm = mam_idx(m,l)
+
+ !column tendencies for output
+ if(.NOT. tendencyCounted(lptr))then
+ coltend_cw(i,lptr) = coltend_cw(i,lptr) &
+ + sum( pdel(i,top_lev:pver)*(raercol_cw(top_lev:pver,mm,nnew) & !New, splitted,
+ - qqcw(mm)%fld(i,top_lev:pver) ) )/gravit*dtinv !Old, total
+ tendencyCounted(lptr) = .TRUE.
+ else !Already subtracted total old value, just add new
+ coltend_cw(i,lptr) = coltend_cw(i,lptr) &
+ + sum(pdel(i,top_lev:pver)*raercol_cw(top_lev:pver,mm,nnew))/gravit*dtinv !total already subtracted
+ end if
+
+ ptend%q(i,:,lptr) = 0.0_r8 !Initialize tendencies
+ qqcw(mm)%fld(i,:) = 0.0_r8 !Throw out old concentrations before summing new ones
+ end do ! Tracers
+ end do ! Modes
+
+ !First, sum up all the tracer mass concentrations
+ do m = 1, ntot_amode
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l) !tracer indices for aerosol mass mixing ratios in raer-arrays
+ lptr = getTracerIndex(m,l,.false.) !index in q-array (1-pcnst)
+
+ !This is a bit tricky since in our scheme the tracers can arrive several times
+ !the same tracer can exist in several modes, e.g. condensate!!
+ !Here we sum this into "qqcw" and "ptend" so that they contain TOTAL of those tracers
+
+ !raercol and raercol_cw do not have totals, they have process-tracers splitted onto modes
+
+ !Tendency at this point is the sum (original value subtracted below)
+ ptend%q(i,top_lev:pver,lptr) = ptend%q(i,top_lev:pver,lptr) + raercol(top_lev:pver,mm,nnew)
+ !for cloud water concentrations, we don't get tendency , only new concentration
+ qqcw(mm)%fld(i,top_lev:pver) = qqcw(mm)%fld(i,top_lev:pver) + raercol_cw(top_lev:pver,mm,nnew)
+
+ end do
+ end do
+
+ !Need this check due to some tracers (e.g. condensate) several times
+ tendencyCounted(:) = .FALSE.
+
+ ! Recalculating cloud-borne aerosol number mixing ratios
+ do m=1,ntot_amode
+
+ !Now that all new aerosol masses are summed up, we subtract the original concentrations to obtain the tendencies
+ do l= 1,nspec_amode(m)
+ mm = mam_idx(m,l)
+ lptr = getTracerIndex(m,l,.false.)
+ if(.NOT. tendencyCounted(lptr)) then
+ ptend%q(i,top_lev:pver,lptr) = (ptend%q(i,top_lev:pver,lptr) - raer(mm)%fld(i,top_lev:pver))*dtinv
+ coltend(i,lptr) = sum(pdel(i,top_lev:pver)*ptend%q(i,top_lev:pver,lptr))/gravit !Save column tendency
+ tendencyCounted(lptr) = .TRUE.
+ endif
+ end do !species
+ end do !modes
+#endif
+
+#ifdef MASS_BALANCE_CHECK
+ !Check mass balances (all removed should be in tendencies)
+ massBalance(:,:) = 0.0_r8
+ newMass(:,:) = 0.0_r8
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ mm = mam_idx(m,l) !unique index, for example sulfate condendsate in "x mode" or sulf cond in "y mode"
+ lptr = getTracerIndex(m,l,.false.)
+ !add up all new values for this tracer
+ newMass(top_lev:pver,lptr) = newMass(top_lev:pver,lptr) + raercol(top_lev:pver, mm,nnew)
+ enddo
+ enddo
+ tendencyCounted(:)=.FALSE.
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ mm = mam_idx(m,l)
+ lptr = getTracerIndex(m,l,.false.)
+ if(.NOT. tendencyCounted(lptr))then
+ massBalance(top_lev:pver, lptr) = newMass(top_lev:pver,lptr) &
+ - raer(mm)%fld(i,top_lev:pver) & !previous value
+ - ptend%q(i,top_lev:pver,lptr)/dtinv !added during time step
+ tendencyCounted(lptr) = .TRUE.
+ endif
+ enddo
+ enddo
+ tendencyCounted(:) = .FALSE.
+ do m=1,ntot_amode
+ do l=1,nspec_amode(m)
+ lptr = getTracerIndex(m,l,.false.)
+ !Check for large deviation in mass balance for this tracer
+ if(.NOT. tendencyCounted(lptr) .and. &
+ (maxval(massBalance(:,lptr)) > 1.e-30_r8 .or. minval(massBalance(:,lptr)) < -1.0e-30_r8))then
+ tendencyCounted(lptr) = .TRUE.
+ print*, "massBalance error", i, lptr, maxVal(massBalance(:,lptr)), minVal(massBalance(:,lptr))
+ if(maxVal(massBalance(:,lptr)) > 1.e-30_r8)then
+ kCrit = maxLoc(massBalance(:,lptr),1)
+ else
+ kCrit = minLoc(massBalance(:,lptr),1)
+ endif
+ print*, "massBalance error loc", massBalance(kCrit, lptr), newMass(kCrit,lptr), raer(mm)%fld(i,kCrit)
+ !If mass balance error is larger than 1.e-10 times new or original value ==> stop
+ if(abs(massBalance(kCrit,lptr)) .gt. 1.e-10_r8*raer(mm)%fld(i,kCrit) &
+ .and. abs(massBalance(kCrit,lptr)).gt.1.e-10_r8*newMass(kCrit,lptr) )then
+ stop
+ endif
+ endif
+ enddo
+ enddo
+#endif
+
+
+ end if !prog_modal_aero
+
+ if (called_from_spcam) then
+ !
+ ! Gas tendency
+ !
+ do m=1, pcnst
+ if (cnst_species_class(m) == cnst_spec_class_gas) then
+ ptend%lq(m) = .true.
+ ptend%q(i, :, m) = (rgascol(:,m,nnew)-rgas(i,:,m)) * dtinv
+ end if
+ end do
+ endif
+
+ end do ! overall_main_i_loop
+
+#ifdef EXTRATESTS
+ !check reasonable values for ncldwtr!
+ do k=top_lev,pver
+ if(maxval(ncldwtr(:ncol,k)) .gt. 1.e20_r8)then
+ print*, "stopping (after dropmixnuc) wrong ncldwtr", maxloc(ncldwtr(:ncol,k))
+ do i=1,ncol
+ print*, "ncldwtr",i,k,ncldwtr(i,k)
+ enddo
+ call endrun("wrong ncldwtr (end of dropmixnuc)")
+ end if
+ end do !loop on layers
+#endif
+
+ ! end of main loop over i/longitude ....................................
+
+ call outfld('NDROPCOL', ndropcol, pcols, lchnk)
+ call outfld('NDROPSRC', nsource, pcols, lchnk)
+ call outfld('NDROPMIX', ndropmix, pcols, lchnk)
+ call outfld('WTKE ', wtke, pcols, lchnk)
+
+#ifndef OSLO_AERO
+ !fxm: Make this work with the oslo aerosols also!
+ call ccncalc(state, pbuf, cs, ccn)
+#else
+ call ccncalc_oslo(state &
+ , pbuf &
+ , cs &
+ , numberConcentration &
+ , volumeConcentration &
+ , hygroscopicity &
+ , lnSigma &
+ , ccn )
+#endif
+ do l = 1, psat
+ call outfld(ccn_name(l), ccn(1,1,l), pcols, lchnk)
+ enddo
+
+#ifndef OSLO_AERO
+ ! do column tendencies
+ if (prog_modal_aero) then
+ do m = 1, ntot_amode
+ do l = 0, nspec_amode(m)
+ mm = mam_idx(m,l)
+ call outfld(fieldname(mm), coltend(:,mm), pcols, lchnk)
+ call outfld(fieldname_cw(mm), coltend_cw(:,mm), pcols, lchnk)
+ end do
+ end do
+ end if
+#endif
+
+ if(called_from_spcam) then
+ !
+ ! output column-integrated Gas tendency (this should be zero)
+ !
+ do m=1, pcnst
+ if (cnst_species_class(m) == cnst_spec_class_gas) then
+ do i=1, ncol
+ coltendgas(i) = sum( pdel(i,:)*ptend%q(i,:,m) )/gravit
+ end do
+ fieldnamegas = trim(cnst_name(m)) // '_mixnuc1sp'
+ call outfld( trim(fieldnamegas), coltendgas, pcols, lchnk)
+ end if
+ end do
+ deallocate(rgascol, coltendgas)
+ end if
+
+#ifdef OSLO_AERO
+ tendencyCounted(:)=.FALSE.
+ do m = 1, ntot_amode
+ do l = 1, nspec_amode(m)
+ mm = mam_idx(m,l)
+ lptr = getTracerIndex(m,l,.false.)
+ if(.NOT. tendencyCounted(lptr))then
+ call outfld(fieldname(mm), coltend(:,lptr), pcols,lchnk)
+ call outfld(fieldname_cw(mm), coltend_cw(:,lptr), pcols,lchnk)
+ tendencyCounted(lptr)=.TRUE.
+ endif
+ end do
+ end do
+#endif
+
+ deallocate( &
+ nact, &
+ mact, &
+ raer, &
+ qqcw, &
+ raercol, &
+ raercol_cw, &
+ coltend, &
+ coltend_cw, &
+ naermod, &
+ hygro, &
+#ifdef OSLO_AERO
+ lnsigman, & !Variable std. dev (CAM-Oslo)
+#endif
+ vaerosol, &
+ fn, &
+ fm, &
+ fluxn, &
+ fluxm )
+
+#ifdef OSLO_AERO
+ deallocate (fluxm_tmp)
+ deallocate (fluxn_tmp)
+ deallocate (fm_tmp)
+ deallocate (fn_tmp)
+ deallocate(raercol_tracer)
+ deallocate(raercol_cw_tracer)
+ deallocate(mact_tracer)
+ deallocate(mfullact_tracer)
+#endif
+
+
+end subroutine dropmixnuc
+
+!===============================================================================
+
+subroutine explmix( q, src, ekkp, ekkm, overlapp, overlapm, &
+ qold, surfrate, flxconv, pver, dt, is_unact, qactold )
+
+ ! explicit integration of droplet/aerosol mixing
+ ! with source due to activation/nucleation
+
+
+ integer, intent(in) :: pver ! number of levels
+ real(r8), intent(out) :: q(pver) ! mixing ratio to be updated
+ real(r8), intent(in) :: qold(pver) ! mixing ratio from previous time step
+ real(r8), intent(in) :: src(pver) ! source due to activation/nucleation (/s)
+ real(r8), intent(in) :: ekkp(pver) ! zn*zs*density*diffusivity (kg/m3 m2/s) at interface
+ ! below layer k (k,k+1 interface)
+ real(r8), intent(in) :: ekkm(pver) ! zn*zs*density*diffusivity (kg/m3 m2/s) at interface
+ ! above layer k (k,k+1 interface)
+ real(r8), intent(in) :: overlapp(pver) ! cloud overlap below
+ real(r8), intent(in) :: overlapm(pver) ! cloud overlap above
+ real(r8), intent(in) :: surfrate ! surface exchange rate (/s)
+ real(r8), intent(in) :: flxconv ! convergence of flux from surface
+ real(r8), intent(in) :: dt ! time step (s)
+ logical, intent(in) :: is_unact ! true if this is an unactivated species
+ real(r8), intent(in),optional :: qactold(pver)
+ ! mixing ratio of ACTIVATED species from previous step
+ ! *** this should only be present
+ ! if the current species is unactivated number/sfc/mass
+
+ integer k,kp1,km1
+
+ if ( is_unact ) then
+ ! the qactold*(1-overlap) terms are resuspension of activated material
+ do k=top_lev,pver
+ kp1=min(k+1,pver)
+ km1=max(k-1,top_lev)
+ q(k) = qold(k) + dt*( - src(k) + ekkp(k)*(qold(kp1) - qold(k) + &
+ qactold(kp1)*(1.0_r8-overlapp(k))) &
+ + ekkm(k)*(qold(km1) - qold(k) + &
+ qactold(km1)*(1.0_r8-overlapm(k))) )
+ ! force to non-negative
+ ! if(q(k)<-1.e-30)then
+ ! write(iulog,*)'q=',q(k),' in explmix'
+ q(k)=max(q(k),0._r8)
+ ! endif
+ end do
+
+ ! diffusion loss at base of lowest layer
+ q(pver)=q(pver)-surfrate*qold(pver)*dt+flxconv*dt
+ ! force to non-negative
+ ! if(q(pver)<-1.e-30)then
+ ! write(iulog,*)'q=',q(pver),' in explmix'
+ q(pver)=max(q(pver),0._r8)
+ ! endif
+ else
+ do k=top_lev,pver
+ kp1=min(k+1,pver)
+ km1=max(k-1,top_lev)
+ q(k) = qold(k) + dt*(src(k) + ekkp(k)*(overlapp(k)*qold(kp1)-qold(k)) + &
+ ekkm(k)*(overlapm(k)*qold(km1)-qold(k)) )
+ ! force to non-negative
+ ! if(q(k)<-1.e-30)then
+ ! write(iulog,*)'q=',q(k),' in explmix'
+ q(k)=max(q(k),0._r8)
+ ! endif
+ end do
+ ! diffusion loss at base of lowest layer
+ q(pver)=q(pver)-surfrate*qold(pver)*dt+flxconv*dt
+ ! force to non-negative
+ ! if(q(pver)<-1.e-30)then
+ ! write(iulog,*)'q=',q(pver),' in explmix'
+ q(pver)=max(q(pver),0._r8)
+
+ end if
+
+end subroutine explmix
+
+!===============================================================================
+
+subroutine activate_modal(wbar, sigw, wdiab, wminf, wmaxf, tair, rhoair, &
+ na, nmode, volume, hygro, &
+ fn, fm, fluxn, fluxm, flux_fullact, lnsigman )
+
+ ! calculates number, surface, and mass fraction of aerosols activated as CCN
+ ! calculates flux of cloud droplets, surface area, and aerosol mass into cloud
+ ! assumes an internal mixture within each of up to nmode multiple aerosol modes
+ ! a gaussiam spectrum of updrafts can be treated.
+
+ ! mks units
+
+ ! Abdul-Razzak and Ghan, A parameterization of aerosol activation.
+ ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844.
+
+
+ ! input
+
+ real(r8), intent(in) :: wbar ! grid cell mean vertical velocity (m/s)
+ real(r8), intent(in) :: sigw ! subgrid standard deviation of vertical vel (m/s)
+ real(r8), intent(in) :: wdiab ! diabatic vertical velocity (0 if adiabatic)
+ real(r8), intent(in) :: wminf ! minimum updraft velocity for integration (m/s)
+ real(r8), intent(in) :: wmaxf ! maximum updraft velocity for integration (m/s)
+ real(r8), intent(in) :: tair ! air temperature (K)
+ real(r8), intent(in) :: rhoair ! air density (kg/m3)
+ real(r8), intent(in) :: na(:) ! aerosol number concentration (/m3)
+ integer, intent(in) :: nmode ! number of aerosol modes
+ real(r8), intent(in) :: volume(:) ! aerosol volume concentration (m3/m3)
+ real(r8), intent(in) :: hygro(:) ! hygroscopicity of aerosol mode
+ real(r8), intent(in), optional :: lnsigman(:)
+
+ ! output
+
+ real(r8), intent(out) :: fn(:) ! number fraction of aerosols activated
+ real(r8), intent(out) :: fm(:) ! mass fraction of aerosols activated
+ real(r8), intent(out) :: fluxn(:) ! flux of activated aerosol number fraction into cloud (cm/s)
+ real(r8), intent(out) :: fluxm(:) ! flux of activated aerosol mass fraction into cloud (cm/s)
+ real(r8), intent(out) :: flux_fullact ! flux of activated aerosol fraction assuming 100% activation (cm/s)
+ ! rce-comment
+ ! used for consistency check -- this should match (ekd(k)*zs(k))
+ ! also, fluxm/flux_fullact gives fraction of aerosol mass flux
+ ! that is activated
+
+ ! local
+
+ integer, parameter:: nx=200
+ integer iquasisect_option, isectional
+ real(r8) integ,integf
+ real(r8), parameter :: p0 = 1013.25e2_r8 ! reference pressure (Pa)
+ real(r8) xmin(nmode),xmax(nmode) ! ln(r) at section interfaces
+ real(r8) volmin(nmode),volmax(nmode) ! volume at interfaces
+ real(r8) tmass ! total aerosol mass concentration (g/cm3)
+ real(r8) sign(nmode) ! geometric standard deviation of size distribution
+ real(r8) rm ! number mode radius of aerosol at max supersat (cm)
+ real(r8) pres ! pressure (Pa)
+ real(r8) path ! mean free path (m)
+ real(r8) diff ! diffusivity (m2/s)
+ real(r8) conduct ! thermal conductivity (Joule/m/sec/deg)
+ real(r8) diff0,conduct0
+ real(r8) es ! saturation vapor pressure
+ real(r8) qs ! water vapor saturation mixing ratio
+ real(r8) dqsdt ! change in qs with temperature
+ real(r8) dqsdp ! change in qs with pressure
+ real(r8) g ! thermodynamic function (m2/s)
+ real(r8) zeta(nmode), eta(nmode)
+ real(r8) lnsmax ! ln(smax)
+ real(r8) alpha
+ real(r8) gamma
+ real(r8) beta
+ real(r8) sqrtg
+ real(r8) :: amcube(nmode) ! cube of dry mode radius (m)
+ !++alfgr (ununsed) real(r8) :: smcrit(nmode) ! critical supersatuation for activation
+ real(r8) :: lnsm(nmode) ! ln(smcrit)
+ real(r8) smc(nmode) ! critical supersaturation for number mode radius
+ real(r8) sumflx_fullact
+ real(r8) sumflxn(nmode)
+ real(r8) sumflxm(nmode)
+ real(r8) sumfn(nmode)
+ real(r8) sumfm(nmode)
+ real(r8) fnold(nmode) ! number fraction activated
+ real(r8) fmold(nmode) ! mass fraction activated
+ real(r8) exp45logsig_var(nmode) !variable std. dev (CAM-Oslo)
+ real(r8), target :: f1_var(nmode), f2_var(nmode)
+ real(r8) wold,gold
+ real(r8) alogam
+ real(r8) rlo,rhi,xint1,xint2,xint3,xint4
+ real(r8) wmin,wmax,w,dw,dwmax,dwmin,wnuc,dwnew,wb
+ real(r8) dfmin,dfmax,fnew,fold,fnmin,fnbar,fsbar,fmbar
+ real(r8) alw,sqrtalw
+ real(r8) smax
+ real(r8) x,arg
+ real(r8) xmincoeff,xcut,volcut,surfcut
+ real(r8) z,z1,z2,wf1,wf2,zf1,zf2,gf1,gf2,gf
+ real(r8) etafactor1,etafactor2(nmode),etafactor2max
+ real(r8) grow
+ character(len=*), parameter :: subname='activate_modal'
+ integer m,n
+ ! numerical integration parameters
+ real(r8), parameter :: eps=0.3_r8,fmax=0.99_r8,sds=3._r8
+
+ real(r8), parameter :: namin=1.e6_r8 ! minimum aerosol number concentration (/m3)
+
+ integer ndist(nx) ! accumulates frequency distribution of integration bins required
+ data ndist/nx*0/
+ save ndist
+
+ fn(:)=0._r8
+ fm(:)=0._r8
+ fluxn(:)=0._r8
+ fluxm(:)=0._r8
+ flux_fullact=0._r8
+
+ if(nmode.eq.1.and.na(1).lt.1.e-20_r8)return
+
+ if(sigw.le.1.e-5_r8.and.wbar.le.0._r8)return
+
+ pres=rair*rhoair*tair
+ diff0=0.211e-4_r8*(p0/pres)*(tair/t0)**1.94_r8
+ conduct0=(5.69_r8+0.017_r8*(tair-t0))*4.186e2_r8*1.e-5_r8 ! convert to J/m/s/deg
+ call qsat(tair, pres, es, qs)
+ dqsdt=latvap/(rh2o*tair*tair)*qs
+ alpha=gravit*(latvap/(cpair*rh2o*tair*tair)-1._r8/(rair*tair))
+ gamma=(1.0_r8+latvap/cpair*dqsdt)/(rhoair*qs)
+ etafactor2max=1.e10_r8/(alpha*wmaxf)**1.5_r8 ! this should make eta big if na is very small.
+
+ grow = 1._r8/(rhoh2o/(diff0*rhoair*qs) &
+ + latvap*rhoh2o/(conduct0*tair)*(latvap/(rh2o*tair) - 1._r8))
+ sqrtg = sqrt(grow)
+ beta = 2._r8*pi*rhoh2o*grow*gamma
+
+ do m=1,nmode
+
+ if(volume(m).gt.1.e-39_r8.and.na(m).gt.1.e-39_r8)then
+ ! number mode radius (m)
+ ! write(iulog,*)'alogsig,volc,na=',alogsig(m),volc(m),na(m)
+#ifdef OSLO_AERO
+ if(present(lnsigman))then
+ exp45logsig_var(m) = exp(4.5_r8*lnsigman(m)*lnsigman(m))
+ amcube(m)=(3._r8*volume(m)/(4._r8*pi*exp45logsig_var(m)*na(m))) ! only if variable size dist
+ f1_var(m) = 0.5_r8*exp(2.5_r8*lnsigman(m)*lnsigman(m))
+ f2_var(m) = 1._r8 + 0.25_r8*lnsigman(m)
+ else
+ call endrun("Problem with variable std. dev")
+ endif
+#else
+ !Std cam
+ amcube(m)=(3._r8*volume(m)/(4._r8*pi*exp45logsig(m)*na(m))) ! only if variable size dist
+#endif
+ ! growth coefficent Abdul-Razzak & Ghan 1998 eqn 16
+ ! should depend on mean radius of mode to account for gas kinetic effects
+ ! see Fountoukis and Nenes, JGR2005 and Meskhidze et al., JGR2006
+ ! for approriate size to use for effective diffusivity.
+ etafactor2(m)=1._r8/(na(m)*beta*sqrtg)
+ if(hygro(m).gt.1.e-10_r8)then
+ smc(m)=2._r8*aten*sqrt(aten/(27._r8*hygro(m)*amcube(m))) ! only if variable size dist
+ else
+ smc(m)=100._r8
+ endif
+ ! write(iulog,*)'sm,hygro,amcube=',smcrit(m),hygro(m),amcube(m)
+ else
+ smc(m)=1._r8
+ etafactor2(m)=etafactor2max ! this should make eta big if na is very small.
+ endif
+ lnsm(m)=log(smc(m)) ! only if variable size dist
+ ! write(iulog,'(a,i4,4g12.2)')'m,na,amcube,hygro,sm,lnsm=', &
+ ! m,na(m),amcube(m),hygro(m),sm(m),lnsm(m)
+ enddo
+
+ if(sigw.gt.1.e-5_r8)then ! spectrum of updrafts
+
+ wmax=min(wmaxf,wbar+sds*sigw)
+ wmin=max(wminf,-wdiab)
+ wmin=max(wmin,wbar-sds*sigw)
+ w=wmin
+ dwmax=eps*sigw
+ dw=dwmax
+ dfmax=0.2_r8
+ dfmin=0.1_r8
+ if (wmax <= w) return
+ do m=1,nmode
+ sumflxn(m)=0._r8
+ sumfn(m)=0._r8
+ fnold(m)=0._r8
+ sumflxm(m)=0._r8
+ sumfm(m)=0._r8
+ fmold(m)=0._r8
+ enddo
+ sumflx_fullact=0._r8
+
+ fold=0._r8
+ wold=0._r8
+ gold=0._r8
+
+ dwmin = min( dwmax, 0.01_r8 )
+ do n = 1, nx
+
+100 wnuc=w+wdiab
+ ! write(iulog,*)'wnuc=',wnuc
+ alw=alpha*wnuc
+ sqrtalw=sqrt(alw)
+ etafactor1=alw*sqrtalw
+
+ do m=1,nmode
+ eta(m)=etafactor1*etafactor2(m)
+ zeta(m)=twothird*sqrtalw*aten/sqrtg
+ enddo
+
+ call maxsat(zeta,eta,nmode,smc,smax &
+#ifdef OSLO_AERO
+ ,f1_var, f2_var &
+#endif
+ )
+ ! write(iulog,*)'w,smax=',w,smax
+
+ lnsmax=log(smax)
+
+#ifdef OSLO_AERO
+ x=twothird*(lnsm(nmode)-lnsmax)/(sq2*lnsigman(nmode))
+#else
+ x=twothird*(lnsm(nmode)-lnsmax)/(sq2*alogsig(nmode))
+#endif
+ fnew=0.5_r8*(1._r8-erf(x))
+
+
+ dwnew = dw
+ if(fnew-fold.gt.dfmax.and.n.gt.1)then
+ ! reduce updraft increment for greater accuracy in integration
+ if (dw .gt. 1.01_r8*dwmin) then
+ dw=0.7_r8*dw
+ dw=max(dw,dwmin)
+ w=wold+dw
+ go to 100
+ else
+ dwnew = dwmin
+ endif
+ endif
+
+ if(fnew-fold.lt.dfmin)then
+ ! increase updraft increment to accelerate integration
+ dwnew=min(1.5_r8*dw,dwmax)
+ endif
+ fold=fnew
+
+ z=(w-wbar)/(sigw*sq2)
+ g=exp(-z*z)
+ fnmin=1._r8
+ xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3
+
+ do m=1,nmode
+ ! modal
+#ifdef OSLO_AERO
+ x=twothird*(lnsm(m)-lnsmax)/(sq2*lnsigman(m))
+#else
+ x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m))
+#endif
+ fn(m)=0.5_r8*(1._r8-erf(x))
+ fnmin=min(fn(m),fnmin)
+ ! integration is second order accurate
+ ! assumes linear variation of f*g with w
+ fnbar=(fn(m)*g+fnold(m)*gold)
+#ifdef OSLO_AERO
+ arg=x-1.5_r8*sq2*lnsigman(m)
+#else
+ arg=x-1.5_r8*sq2*alogsig(m)
+#endif
+ fm(m)=0.5_r8*(1._r8-erf(arg))
+ fmbar=(fm(m)*g+fmold(m)*gold)
+ wb=(w+wold)
+ if(w.gt.0._r8)then
+ sumflxn(m)=sumflxn(m)+sixth*(wb*fnbar &
+ +(fn(m)*g*w+fnold(m)*gold*wold))*dw
+ sumflxm(m)=sumflxm(m)+sixth*(wb*fmbar &
+ +(fm(m)*g*w+fmold(m)*gold*wold))*dw
+ endif
+ sumfn(m)=sumfn(m)+0.5_r8*fnbar*dw
+ ! write(iulog,'(a,9g10.2)')'lnsmax,lnsm(m),x,fn(m),fnold(m),g,gold,fnbar,dw=',lnsmax,lnsm(m),x,fn(m),fnold(m),g,gold,fnbar,dw
+ fnold(m)=fn(m)
+ sumfm(m)=sumfm(m)+0.5_r8*fmbar*dw
+ fmold(m)=fm(m)
+ enddo
+ ! same form as sumflxm but replace the fm with 1.0
+ sumflx_fullact = sumflx_fullact &
+ + sixth*(wb*(g+gold) + (g*w+gold*wold))*dw
+ ! sumg=sumg+0.5_r8*(g+gold)*dw
+ gold=g
+ wold=w
+ dw=dwnew
+ if (n > 1 .and. (w > wmax .or. fnmin > fmax)) exit
+ w=w+dw
+ if (n == nx) then
+ write(iulog,*)'do loop is too short in activate'
+ write(iulog,*)'wmin=',wmin,' w=',w,' wmax=',wmax,' dw=',dw
+ write(iulog,*)'wbar=',wbar,' sigw=',sigw,' wdiab=',wdiab
+ write(iulog,*)'wnuc=',wnuc
+ write(iulog,*)'na=',(na(m),m=1,nmode)
+ write(iulog,*)'fn=',(fn(m),m=1,nmode)
+ ! dump all subr parameters to allow testing with standalone code
+ ! (build a driver that will read input and call activate)
+ write(iulog,*)'wbar,sigw,wdiab,tair,rhoair,nmode='
+ write(iulog,*) wbar,sigw,wdiab,tair,rhoair,nmode
+ write(iulog,*)'na=',na
+ write(iulog,*)'volume=', (volume(m),m=1,nmode)
+ write(iulog,*)'hydro='
+ write(iulog,*) hygro
+ call endrun(subname)
+ end if
+
+ enddo
+
+ ndist(n)=ndist(n)+1
+ if(w.lt.wmaxf)then
+
+ ! contribution from all updrafts stronger than wmax
+ ! assuming constant f (close to fmax)
+ wnuc=w+wdiab
+
+ z1=(w-wbar)/(sigw*sq2)
+ z2=(wmaxf-wbar)/(sigw*sq2)
+ g=exp(-z1*z1)
+ integ=sigw*0.5_r8*sq2*sqpi*(erf(z2)-erf(z1))
+ ! consider only upward flow into cloud base when estimating flux
+ wf1=max(w,zero)
+ zf1=(wf1-wbar)/(sigw*sq2)
+ gf1=exp(-zf1*zf1)
+ wf2=max(wmaxf,zero)
+ zf2=(wf2-wbar)/(sigw*sq2)
+ gf2=exp(-zf2*zf2)
+ gf=(gf1-gf2)
+ integf=wbar*sigw*0.5_r8*sq2*sqpi*(erf(zf2)-erf(zf1))+sigw*sigw*gf
+
+ do m=1,nmode
+ sumflxn(m)=sumflxn(m)+integf*fn(m)
+ sumfn(m)=sumfn(m)+fn(m)*integ
+ sumflxm(m)=sumflxm(m)+integf*fm(m)
+ sumfm(m)=sumfm(m)+fm(m)*integ
+ enddo
+ ! same form as sumflxm but replace the fm with 1.0
+ sumflx_fullact = sumflx_fullact + integf
+ ! sumg=sumg+integ
+ endif
+
+
+ do m=1,nmode
+ fn(m)=sumfn(m)/(sq2*sqpi*sigw)
+ ! fn(m)=sumfn(m)/(sumg)
+ if(fn(m).gt.1.01_r8)then
+ write(iulog,*)'fn=',fn(m),' > 1 in activate'
+ write(iulog,*)'w,m,na,amcube=',w,m,na(m),amcube(m)
+ write(iulog,*)'integ,sumfn,sigw=',integ,sumfn(m),sigw
+ call endrun('activate')
+ endif
+ fluxn(m)=sumflxn(m)/(sq2*sqpi*sigw)
+ fm(m)=sumfm(m)/(sq2*sqpi*sigw)
+ ! fm(m)=sumfm(m)/(sumg)
+ if(fm(m).gt.1.01_r8)then
+ write(iulog,*)'fm=',fm(m),' > 1 in activate'
+ endif
+ fluxm(m)=sumflxm(m)/(sq2*sqpi*sigw)
+ enddo
+ ! same form as fluxm
+ flux_fullact = sumflx_fullact/(sq2*sqpi*sigw)
+
+ else
+
+ ! single updraft
+ wnuc=wbar+wdiab
+
+ if(wnuc.gt.0._r8)then
+
+ w=wbar
+ alw=alpha*wnuc
+ sqrtalw=sqrt(alw)
+ etafactor1=alw*sqrtalw
+
+ do m=1,nmode
+ eta(m)=etafactor1*etafactor2(m)
+ zeta(m)=twothird*sqrtalw*aten/sqrtg
+ enddo
+
+ call maxsat(zeta,eta,nmode,smc,smax &
+#ifdef OSLO_AERO
+ ,f1_var, f2_var &
+#endif
+ )
+
+ lnsmax=log(smax)
+ xmincoeff=alogaten-twothird*(lnsmax-alog2)-alog3
+
+
+ do m=1,nmode
+#ifdef OSLO_AERO
+ x=twothird*(lnsm(m)-lnsmax)/(sq2*lnsigman(m))
+#else
+ x=twothird*(lnsm(m)-lnsmax)/(sq2*alogsig(m))
+#endif
+ fn(m)=0.5_r8*(1._r8-erf(x))
+#ifdef OSLO_AERO
+ arg=x-1.5_r8*sq2*lnsigman(m)
+#else
+ arg=x-1.5_r8*sq2*alogsig(m)
+#endif
+ fm(m)=0.5_r8*(1._r8-erf(arg))
+ if(wbar.gt.0._r8)then
+ fluxn(m)=fn(m)*w
+ fluxm(m)=fm(m)*w
+ endif
+ enddo
+ flux_fullact = w
+ endif
+
+ endif
+
+end subroutine activate_modal
+
+!===============================================================================
+
+subroutine maxsat(zeta,eta,nmode,smc,smax, f1_in, f2_in)
+
+ ! calculates maximum supersaturation for multiple
+ ! competing aerosol modes.
+
+ ! Abdul-Razzak and Ghan, A parameterization of aerosol activation.
+ ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844.
+
+ integer, intent(in) :: nmode ! number of modes
+ real(r8), intent(in) :: smc(nmode) ! critical supersaturation for number mode radius
+ real(r8), intent(in) :: zeta(nmode)
+ real(r8), intent(in) :: eta(nmode)
+ real(r8), intent(in), optional, target :: f1_in(:)
+ real(r8), intent(in), optional, target :: f2_in(:)
+
+ real(r8), intent(out) :: smax ! maximum supersaturation
+ integer :: m ! mode index
+ real(r8) :: sum, g1, g2, g1sqrt, g2sqrt
+ real(r8), pointer :: f1_used(:), f2_used(:)
+
+#ifdef OSLO_AERO
+ f1_used => f1_in
+ f2_used => f2_in
+#else
+ f1_used => f1
+ f2_used => f2
+#endif
+
+
+ do m=1,nmode
+ if(zeta(m).gt.1.e5_r8*eta(m).or.smc(m)*smc(m).gt.1.e5_r8*eta(m))then
+ ! weak forcing. essentially none activated
+ smax=1.e-20_r8
+ else
+ ! significant activation of this mode. calc activation all modes.
+ exit
+ endif
+ ! No significant activation in any mode. Do nothing.
+ if (m == nmode) return
+
+ enddo
+
+ sum=0.0_r8
+ do m=1,nmode
+ if(eta(m).gt.1.e-20_r8)then
+ g1=zeta(m)/eta(m)
+ g1sqrt=sqrt(g1)
+ g1=g1sqrt*g1
+ g2=smc(m)/sqrt(eta(m)+3._r8*zeta(m))
+ g2sqrt=sqrt(g2)
+ g2=g2sqrt*g2
+ sum=sum+(f1_used(m)*g1+f2_used(m)*g2)/(smc(m)*smc(m))
+ else
+ sum=1.e20_r8
+ endif
+ enddo
+
+ smax=1._r8/sqrt(sum)
+
+end subroutine maxsat
+
+!===============================================================================
+
+#ifndef OSLO_AERO
+subroutine ccncalc(state, pbuf, cs, ccn)
+
+ ! calculates number concentration of aerosols activated as CCN at
+ ! supersaturation supersat.
+ ! assumes an internal mixture of a multiple externally-mixed aerosol modes
+ ! cgs units
+
+ ! Ghan et al., Atmos. Res., 1993, 198-221.
+
+ ! arguments
+
+ type(physics_state), target, intent(in) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+
+ real(r8), intent(in) :: cs(pcols,pver) ! air density (kg/m3)
+ real(r8), intent(out) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat (#/m3)
+
+ ! local
+
+ integer :: lchnk ! chunk index
+ integer :: ncol ! number of columns
+ real(r8), pointer :: tair(:,:) ! air temperature (K)
+
+ real(r8) naerosol(pcols) ! interstit+activated aerosol number conc (/m3)
+ real(r8) vaerosol(pcols) ! interstit+activated aerosol volume conc (m3/m3)
+
+ real(r8) amcube(pcols)
+ real(r8) super(psat) ! supersaturation
+ real(r8), allocatable :: amcubecoef(:)
+ real(r8), allocatable :: argfactor(:)
+ real(r8) :: surften ! surface tension of water w/respect to air (N/m)
+ real(r8) surften_coef
+ real(r8) a(pcols) ! surface tension parameter
+ real(r8) hygro(pcols) ! aerosol hygroscopicity
+ real(r8) sm(pcols) ! critical supersaturation at mode radius
+ real(r8) arg(pcols)
+ ! mathematical constants
+ real(r8) twothird,sq2
+ integer l,m,n,i,k
+ real(r8) log,cc
+ real(r8) smcoefcoef,smcoef(pcols)
+ integer phase ! phase of aerosol
+ !-------------------------------------------------------------------------------
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+ tair => state%t
+
+ allocate( &
+ amcubecoef(ntot_amode), &
+ argfactor(ntot_amode) )
+
+ super(:)=supersat(:)*0.01_r8
+ sq2=sqrt(2._r8)
+ twothird=2._r8/3._r8
+ surften=0.076_r8
+ surften_coef=2._r8*mwh2o*surften/(r_universal*rhoh2o)
+ smcoefcoef=2._r8/sqrt(27._r8)
+
+ do m=1,ntot_amode
+ amcubecoef(m)=3._r8/(4._r8*pi*exp45logsig(m))
+ argfactor(m)=twothird/(sq2*alogsig(m))
+ end do
+
+ ccn = 0._r8
+ do k=top_lev,pver
+
+ do i=1,ncol
+ a(i)=surften_coef/tair(i,k)
+ smcoef(i)=smcoefcoef*a(i)*sqrt(a(i))
+ end do
+
+ do m=1,ntot_amode
+
+ phase=3 ! interstitial+cloudborne
+
+ call loadaer( &
+ state, pbuf, 1, ncol, k, &
+ m, cs, phase, naerosol, vaerosol, &
+ hygro)
+
+ where(naerosol(:ncol)>1.e-3_r8)
+ amcube(:ncol)=amcubecoef(m)*vaerosol(:ncol)/naerosol(:ncol)
+ sm(:ncol)=smcoef(:ncol)/sqrt(hygro(:ncol)*amcube(:ncol)) ! critical supersaturation
+ elsewhere
+ sm(:ncol)=1._r8 ! value shouldn't matter much since naerosol is small
+ endwhere
+ do l=1,psat
+ do i=1,ncol
+ arg(i)=argfactor(m)*log(sm(i)/super(l))
+ ccn(i,k,l)=ccn(i,k,l)+naerosol(i)*0.5_r8*(1._r8-erf(arg(i)))
+ enddo
+ enddo
+ enddo
+ enddo
+ ccn(:ncol,:,:)=ccn(:ncol,:,:)*1.e-6_r8 ! convert from #/m3 to #/cm3
+
+ deallocate( &
+ amcubecoef, &
+ argfactor )
+
+end subroutine ccncalc
+
+#else
+
+subroutine ccncalc_oslo(state &
+ , pbuf &
+ , cs &
+ , numberConcentration &
+ , volumeConcentration &
+ , hygroscopicity &
+ , lnSigma &
+ , ccn )
+
+ ! calculates number concentration of aerosols activated as CCN at
+ ! supersaturation supersat.
+ ! assumes an internal mixture of a multiple externally-mixed aerosol modes
+ ! cgs units
+
+ ! This was used in the BACCHUS-project where it was agreed that
+ ! CCN would not include cloud-borne aerosols. It is possible to
+ ! calculate cloud-borne aerosols, but it is complicated, and it was
+ ! not needed when this code was made.
+
+ ! arguments
+
+ type(physics_state), target, intent(in) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ real(r8), intent(in) :: cs(pcols,pver) ! air density (kg/m3)
+ real(r8), intent(out) :: ccn(pcols,pver,psat) ! number conc of aerosols activated at supersat (#/m3)
+ real(r8), intent(in) :: numberConcentration(pcols,pver, nmodes) ! interstit+activated aerosol number conc (/m3)
+ real(r8), intent(in) :: volumeConcentration(pcols,pver,nmodes) ! interstit+activated aerosol volume conc (m3/m3)
+ real(r8), intent(in) :: hygroscopicity(pcols,pver,nmodes)
+ real(r8), intent(in) :: lnSigma(pcols,pver,nmodes)
+
+ ! local
+ integer :: lchnk ! chunk index
+ integer :: ncol ! number of columns
+ real(r8), pointer :: tair(:,:) ! air temperature (K)
+
+
+ real(r8) super(psat) ! supersaturation
+ real(r8) surften_coef !Coefficient in ARGI / ARGII
+ real(r8) amcube !number median radius qubed
+ real(r8) a ! surface tension parameter
+ real(r8) sm ! critical supersaturation at mode radius
+ real(r8) arg ! factor in eqn 15 ARGII
+ real(r8) argfactor !Coefficient in ARGI/ARGII
+ ! mathematical constants
+ real(r8), parameter:: twothird=2.0_r8/3.0_r8
+ real(r8), parameter:: sq2=sqrt(2.0_r8)
+ real(r8), parameter :: surften=0.076_r8 !surface tension of water (J/m2)
+ real(r8) exp45logsig_var
+ integer lsat,m,i,k
+ real(r8) smcoefcoef,smcoef
+ !-------------------------------------------------------------------------------
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+ tair => state%t
+
+ super(:)=supersat(:)*0.01_r8
+
+ !This is curvature effect (A) in ARGI
+ !eqn 5 in ARG1 (missing division by temperature, see below)
+ surften_coef=2._r8*mwh2o*surften/(r_universal*rhoh2o)
+
+ !This is part of eqn 9 in ARGII
+ !where A smcoefcoef is 2/3^(3/2)
+ smcoefcoef=2._r8/sqrt(27._r8)
+
+ ccn(:,:,:) = 0._r8
+
+ do m=1,nmodes
+ do k=top_lev,pver
+
+ do i=1,ncol
+
+ !Curvature-parameter "A" in ARGI (eqn 5)
+ a = surften_coef/tair(i,k)
+
+ !standard factor for transforming size distr
+ !volume ==> number (google psd.pdf by zender)
+ exp45logsig_var = &
+ exp(4.5_r8*lnsigma(i,k,m)*lnsigma(i,k,m))
+
+ !Numbe rmedian radius (power of three)
+ !By definition of lognormal distribution
+ amcube =(3._r8*volumeConcentration(i,k,m) &
+!tht is zero an allowed value for numberConcentration??
+ /(4._r8*pi*exp45logsig_var*numberConcentration(i,k,m))) ! only if variable size dist
+
+
+ !This is part of eqn 9 in ARGII
+ !where A smcoefcoef is 2/3^(3/2)
+ smcoef = smcoefcoef * a * sqrt(a)
+
+ !This is finally solving eqn 9
+ !(solve for critical supersat of mode)
+ sm=smcoef &
+ / sqrt(hygroscopicity(i,k,m)*amcube) ! critical supersaturation
+
+ !Solve eqn 13 in ARGII
+ do lsat = 1,psat
+
+ !eqn 15 in ARGII
+ argfactor=twothird/(sq2*lnSigma(i,k,m))
+
+ !eqn 15 in ARGII
+ arg=argfactor*log(sm/super(lsat))
+
+ !eqn 13 i ARGII
+ ccn(i,k,lsat)=ccn(i,k,lsat) &
+ +numberConcentration(i,k,m)&
+ *0.5_r8*(1._r8-erf(arg))
+ end do
+ end do
+ end do
+ end do
+
+ ccn(:ncol,:,:)=ccn(:ncol,:,:)*1.e-6_r8 ! convert from #/m3 to #/cm3
+
+end subroutine ccncalc_oslo
+#endif
+
+!===============================================================================
+
+subroutine loadaer( &
+ state, pbuf, istart, istop, k, &
+ m, cs, phase, naerosol, &
+ vaerosol, hygro)
+
+ ! return aerosol number, volume concentrations, and bulk hygroscopicity
+
+ ! input arguments
+ type(physics_state), target, intent(in) :: state
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ integer, intent(in) :: istart ! start column index (1 <= istart <= istop <= pcols)
+ integer, intent(in) :: istop ! stop column index
+ integer, intent(in) :: m ! mode index
+ integer, intent(in) :: k ! level index
+ real(r8), intent(in) :: cs(:,:) ! air density (kg/m3)
+ integer, intent(in) :: phase ! phase of aerosol: 1 for interstitial, 2 for cloud-borne, 3 for sum
+
+ ! output arguments
+ real(r8), intent(out) :: naerosol(:) ! number conc (1/m3)
+ real(r8), intent(out) :: vaerosol(:) ! volume conc (m3/m3)
+ real(r8), intent(out) :: hygro(:) ! bulk hygroscopicity of mode
+
+ ! internal
+ integer :: lchnk ! chunk identifier
+
+ real(r8), pointer :: raer(:,:) ! interstitial aerosol mass, number mixing ratios
+ real(r8), pointer :: qqcw(:,:) ! cloud-borne aerosol mass, number mixing ratios
+ real(r8) :: specdens, spechygro
+
+ real(r8) :: vol(pcols) ! aerosol volume mixing ratio
+ integer :: i, l
+ !-------------------------------------------------------------------------------
+
+ lchnk = state%lchnk
+
+ do i = istart, istop
+ vaerosol(i) = 0._r8
+ hygro(i) = 0._r8
+ end do
+
+ do l = 1, nspec_amode(m)
+
+ call rad_cnst_get_aer_mmr(0, m, l, 'a', state, pbuf, raer)
+ call rad_cnst_get_aer_mmr(0, m, l, 'c', state, pbuf, qqcw)
+ call rad_cnst_get_aer_props(0, m, l, density_aer=specdens, hygro_aer=spechygro)
+
+ if (phase == 3) then
+ do i = istart, istop
+ vol(i) = max(raer(i,k) + qqcw(i,k), 0._r8)/specdens
+ end do
+ else if (phase == 2) then
+ do i = istart, istop
+ vol(i) = max(qqcw(i,k), 0._r8)/specdens
+ end do
+ else if (phase == 1) then
+ do i = istart, istop
+ vol(i) = max(raer(i,k), 0._r8)/specdens
+ end do
+ else
+ write(iulog,*)'phase=',phase,' in loadaer'
+ call endrun('phase error in loadaer')
+ end if
+
+ do i = istart, istop
+ vaerosol(i) = vaerosol(i) + vol(i)
+ hygro(i) = hygro(i) + vol(i)*spechygro
+ end do
+
+ end do
+
+ do i = istart, istop
+ if (vaerosol(i) > 1.0e-30_r8) then ! +++xl add 8/2/2007
+ hygro(i) = hygro(i)/(vaerosol(i))
+ vaerosol(i) = vaerosol(i)*cs(i,k)
+ else
+ hygro(i) = 0.0_r8
+ vaerosol(i) = 0.0_r8
+ end if
+ end do
+
+ ! aerosol number
+ call rad_cnst_get_mode_num(0, m, 'a', state, pbuf, raer)
+ call rad_cnst_get_mode_num(0, m, 'c', state, pbuf, qqcw)
+ if (phase == 3) then
+ do i = istart, istop
+ naerosol(i) = (raer(i,k) + qqcw(i,k))*cs(i,k)
+ end do
+ else if (phase == 2) then
+ do i = istart, istop
+ naerosol(i) = qqcw(i,k)*cs(i,k)
+ end do
+ else
+ do i = istart, istop
+ naerosol(i) = raer(i,k)*cs(i,k)
+ end do
+ end if
+ ! adjust number so that dgnumlo < dgnum < dgnumhi
+ do i = istart, istop
+ naerosol(i) = max(naerosol(i), vaerosol(i)*voltonumbhi_amode(m))
+ naerosol(i) = min(naerosol(i), vaerosol(i)*voltonumblo_amode(m))
+ end do
+
+end subroutine loadaer
+
+!===============================================================================
+
+end module ndrop
+
+
+
+
diff --git a/src/chemistry/oslo_aero/nucleate_ice_oslo.F90 b/src/chemistry/oslo_aero/nucleate_ice_oslo.F90
new file mode 100644
index 0000000000..e6b6696e6d
--- /dev/null
+++ b/src/chemistry/oslo_aero/nucleate_ice_oslo.F90
@@ -0,0 +1,629 @@
+module nucleate_ice_oslo
+
+!---------------------------------------------------------------------------------
+!
+! CAM Interfaces for nucleate_ice module.
+!
+! B. Eaton - Sept 2014
+!---------------------------------------------------------------------------------
+
+use shr_kind_mod, only: r8=>shr_kind_r8
+use spmd_utils, only: masterproc
+use ppgrid, only: pcols, pver
+use physconst, only: pi, rair, tmelt
+use constituents, only: pcnst, cnst_get_ind
+use physics_types, only: physics_state, physics_ptend, physics_ptend_init
+use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field
+use phys_control, only: use_hetfrz_classnuc
+use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_old_tim_idx, &
+ pbuf_get_index, pbuf_get_field
+use cam_history, only: addfld, add_default, outfld
+
+use ref_pres, only: top_lev => trop_cloud_top_lev
+use wv_saturation, only: qsat_water, svp_water, svp_ice
+use shr_spfn_mod, only: erf => shr_spfn_erf
+
+use cam_logfile, only: iulog
+use cam_abortutils, only: endrun
+
+use nucleate_ice, only: nucleati_init, nucleati
+
+use aerosoldef, only: l_dst_a2, l_dst_a3, &
+ MODE_IDX_DST_A2, MODE_IDX_DST_A3, &
+ rhopart
+use modal_aero_data, only: qqcw_get_field
+use const , only: volumeToNumber
+
+implicit none
+private
+save
+
+public :: &
+ nucleate_ice_oslo_readnl, &
+ nucleate_ice_oslo_register, &
+ nucleate_ice_oslo_init, &
+ nucleate_ice_oslo_calc
+
+
+! Namelist variables
+logical, public, protected :: use_preexisting_ice = .false.
+logical :: hist_preexisting_ice = .false.
+logical :: nucleate_ice_incloud = .false.
+logical :: nucleate_ice_use_troplev = .false.
+real(r8) :: nucleate_ice_subgrid = -1._r8
+real(r8) :: nucleate_ice_subgrid_strat = -1._r8
+real(r8) :: nucleate_ice_strat = 0.0_r8
+
+! Vars set via init method.
+real(r8) :: mincld ! minimum allowed cloud fraction
+real(r8) :: bulk_scale ! prescribed aerosol bulk sulfur scale factor
+
+! constituent indices
+integer :: &
+ cldliq_idx = -1, &
+ cldice_idx = -1, &
+ numice_idx = -1
+
+integer :: &
+ naai_idx, &
+ naai_hom_idx
+
+integer :: &
+ ast_idx = -1, &
+ dgnum_idx = -1
+
+integer :: &
+ qsatfac_idx
+! modal aerosols
+logical :: clim_modal_aero = .TRUE.
+logical :: lq(pcnst) = .false. ! set flags true for constituents with non-zero tendencies
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine nucleate_ice_oslo_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use spmd_utils, only: mpicom, masterprocid, mpi_logical, mpi_real8
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'nucleate_ice_cam_readnl'
+
+ namelist /nucleate_ice_nl/ use_preexisting_ice, hist_preexisting_ice, &
+ nucleate_ice_subgrid, nucleate_ice_subgrid_strat, nucleate_ice_strat, &
+ nucleate_ice_incloud, nucleate_ice_use_troplev
+
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'nucleate_ice_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, nucleate_ice_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+
+ end if
+
+ ! Broadcast namelist variables
+ call mpi_bcast(use_preexisting_ice, 1, mpi_logical,masterprocid, mpicom, ierr)
+ call mpi_bcast(hist_preexisting_ice, 1, mpi_logical,masterprocid, mpicom, ierr)
+ call mpi_bcast(nucleate_ice_subgrid, 1, mpi_real8, masterprocid, mpicom, ierr)
+ call mpi_bcast(nucleate_ice_subgrid_strat, 1, mpi_real8, masterprocid, mpicom, ierr)
+ call mpi_bcast(nucleate_ice_strat, 1, mpi_real8, masterprocid, mpicom, ierr)
+ call mpi_bcast(nucleate_ice_incloud, 1, mpi_logical,masterprocid, mpicom, ierr)
+ call mpi_bcast(nucleate_ice_use_troplev, 1, mpi_logical,masterprocid, mpicom, ierr)
+
+end subroutine nucleate_ice_oslo_readnl
+
+!================================================================================================
+
+subroutine nucleate_ice_oslo_register()
+
+ call pbuf_add_field('NAAI', 'physpkg', dtype_r8, (/pcols,pver/), naai_idx)
+ call pbuf_add_field('NAAI_HOM', 'physpkg', dtype_r8, (/pcols,pver/), naai_hom_idx)
+
+end subroutine nucleate_ice_oslo_register
+
+!================================================================================================
+
+subroutine nucleate_ice_oslo_init(mincld_in, bulk_scale_in)
+ use phys_control, only: phys_getopts
+
+ real(r8), intent(in) :: mincld_in
+ real(r8), intent(in) :: bulk_scale_in
+
+ ! local variables
+ integer :: iaer
+ integer :: ierr
+ integer :: m, n, nspec
+
+ character(len=32) :: str32
+ character(len=*), parameter :: routine = 'nucleate_ice_cam_init'
+ logical :: history_cesm_forcing
+ !--------------------------------------------------------------------------------------------
+ call phys_getopts(history_cesm_forcing_out = history_cesm_forcing)
+
+ mincld = mincld_in
+ bulk_scale = bulk_scale_in
+
+ if( masterproc ) then
+ write(iulog,*) 'nucleate_ice parameters:'
+ write(iulog,*) ' mincld = ', mincld_in
+ write(iulog,*) ' bulk_scale = ', bulk_scale_in
+ write(iulog,*) ' use_preexisiting_ice = ', use_preexisting_ice
+ write(iulog,*) ' hist_preexisiting_ice = ', hist_preexisting_ice
+ write(iulog,*) ' nucleate_ice_subgrid = ', nucleate_ice_subgrid
+ write(iulog,*) ' nucleate_ice_subgrid_strat = ', nucleate_ice_subgrid_strat
+ write(iulog,*) ' nucleate_ice_strat = ', nucleate_ice_strat
+ write(iulog,*) ' nucleate_ice_incloud = ', nucleate_ice_incloud
+ write(iulog,*) ' nucleate_ice_use_troplev = ', nucleate_ice_use_troplev
+ end if
+
+ call cnst_get_ind('CLDLIQ', cldliq_idx)
+ call cnst_get_ind('CLDICE', cldice_idx)
+ call cnst_get_ind('NUMICE', numice_idx)
+ qsatfac_idx = pbuf_get_index('QSATFAC', ierr)
+
+ if (((nucleate_ice_subgrid .eq. -1._r8) .or. (nucleate_ice_subgrid_strat .eq. -1._r8)) .and. (qsatfac_idx .eq. -1)) then
+ call endrun(routine//': ERROR qsatfac is required when subgrid = -1 or subgrid_strat = -1')
+ end if
+
+ call addfld('NIHF', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to homogenous freezing')
+ call addfld('NIDEP', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to deposition nucleation')
+ call addfld('NIIMM', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to immersion freezing')
+ call addfld('NIMEY', (/ 'lev' /), 'A', '1/m3', 'Activated Ice Number Concentation due to meyers deposition')
+
+ call addfld('NIREGM',(/ 'lev' /), 'A', 'C', 'Ice Nucleation Temperature Threshold for Regime')
+ call addfld('NISUBGRID',(/ 'lev' /), 'A', '', 'Ice Nucleation subgrid saturation factor')
+ call addfld('NITROP_PD',(/ 'lev' /), 'A', '', 'Chemical Tropopause probability')
+ if ( history_cesm_forcing ) then
+ call add_default('NITROP_PD',8,' ')
+ endif
+
+ if (use_preexisting_ice) then
+ call addfld('fhom', (/ 'lev' /), 'A','fraction', 'Fraction of cirrus where homogeneous freezing occur' )
+ call addfld ('WICE', (/ 'lev' /), 'A','m/s','Vertical velocity Reduction caused by preexisting ice' )
+ call addfld ('WEFF', (/ 'lev' /), 'A','m/s','Effective Vertical velocity for ice nucleation' )
+ call addfld ('INnso4', (/ 'lev' /), 'A','1/m3','Number Concentation so4 (in) to ice_nucleation')
+ call addfld ('INnbc', (/ 'lev' /), 'A','1/m3','Number Concentation bc (in) to ice_nucleation')
+ call addfld ('INndust', (/ 'lev' /), 'A','1/m3','Number Concentation dust (in) ice_nucleation')
+ call addfld ('INondust', (/ 'lev' /), 'A','1/m3','Number Concentation dust (out) from ice_nucleation')
+ call addfld ('INhet', (/ 'lev' /), 'A','1/m3', &
+ 'contribution for in-cloud ice number density increase by het nucleation in ice cloud')
+ call addfld ('INhom', (/ 'lev' /), 'A','1/m3', &
+ 'contribution for in-cloud ice number density increase by hom nucleation in ice cloud')
+ call addfld ('INFrehom', (/ 'lev' /), 'A','frequency','hom IN frequency ice cloud')
+ call addfld ('INFreIN', (/ 'lev' /), 'A','frequency','frequency of ice nucleation occur')
+
+ if (hist_preexisting_ice) then
+ call add_default ('WSUBI ', 1, ' ') ! addfld/outfld calls are in microp_aero
+
+ call add_default ('fhom ', 1, ' ')
+ call add_default ('WICE ', 1, ' ')
+ call add_default ('WEFF ', 1, ' ')
+ call add_default ('INnso4 ', 1, ' ')
+ call add_default ('INnbc ', 1, ' ')
+ call add_default ('INndust ', 1, ' ')
+ call add_default ('INhet ', 1, ' ')
+ call add_default ('INhom ', 1, ' ')
+ call add_default ('INFrehom', 1, ' ')
+ call add_default ('INFreIN ', 1, ' ')
+ end if
+ end if
+
+
+ lq(l_dst_a2) = .TRUE.
+ lq(l_dst_a3) = .TRUE.
+
+ call nucleati_init(use_preexisting_ice, use_hetfrz_classnuc, nucleate_ice_incloud, iulog, pi, &
+ mincld)
+
+ ! get indices for fields in the physics buffer
+ ast_idx = pbuf_get_index('AST')
+
+end subroutine nucleate_ice_oslo_init
+
+!================================================================================================
+
+subroutine nucleate_ice_oslo_calc( &
+ state, wsubi, pbuf, dtime, ptend &
+ , numberConcentration)
+
+ use aerosoldef, only : MODE_IDX_DST_A2, MODE_IDX_DST_A3 &
+ , MODE_IDX_SO4_AC,MODE_IDX_OMBC_INTMIX_COAT_AIT
+ use commondefinitions, only: nmodes
+
+ use tropopause, only: tropopause_findChemTrop
+
+ ! arguments
+ real(r8), intent(in) :: numberConcentration(pcols,pver,0:nmodes)
+ type(physics_state), target, intent(in) :: state
+ real(r8), intent(in) :: wsubi(:,:)
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ real(r8), intent(in) :: dtime
+ type(physics_ptend), intent(out) :: ptend
+
+ ! local workspace
+
+ ! naai and naai_hom are the outputs shared with the microphysics
+ real(r8), pointer :: naai(:,:) ! number of activated aerosol for ice nucleation
+ real(r8), pointer :: naai_hom(:,:) ! number of activated aerosol for ice nucleation (homogeneous freezing only)
+
+ integer :: lchnk, ncol
+ integer :: itim_old
+ integer :: i, k, m
+
+ real(r8), pointer :: t(:,:) ! input temperature (K)
+ real(r8), pointer :: qn(:,:) ! input water vapor mixing ratio (kg/kg)
+ real(r8), pointer :: qc(:,:) ! cloud water mixing ratio (kg/kg)
+ real(r8), pointer :: qi(:,:) ! cloud ice mixing ratio (kg/kg)
+ real(r8), pointer :: ni(:,:) ! cloud ice number conc (1/kg)
+ real(r8), pointer :: pmid(:,:) ! pressure at layer midpoints (pa)
+
+ real(r8), pointer :: cld_dst_a2(:,:) ! mmr cld dst a2
+ real(r8), pointer :: cld_dst_a3(:,:) ! mass m.r. of coarse dust
+
+ real(r8), pointer :: ast(:,:)
+ real(r8) :: icecldf(pcols,pver) ! ice cloud fraction
+ real(r8), pointer :: qsatfac(:,:) ! Subgrid cloud water saturation scaling factor.
+
+ real(r8) :: rho(pcols,pver) ! air density (kg m-3)
+
+ real(r8), allocatable :: naer2(:,:,:) ! bulk aerosol number concentration (1/m3)
+ real(r8), allocatable :: maerosol(:,:,:) ! bulk aerosol mass conc (kg/m3)
+
+ real(r8) :: qs(pcols) ! liquid-ice weighted sat mixing rat (kg/kg)
+ real(r8) :: es(pcols) ! liquid-ice weighted sat vapor press (pa)
+ real(r8) :: gammas(pcols) ! parameter for cond/evap of cloud water
+ integer :: troplev(pcols) ! tropopause level
+
+ real(r8) :: relhum(pcols,pver) ! relative humidity
+ real(r8) :: icldm(pcols,pver) ! ice cloud fraction
+
+ real(r8) :: so4_num ! so4 aerosol number (#/cm^3)
+ real(r8) :: soot_num ! soot (hydrophilic) aerosol number (#/cm^3)
+ real(r8) :: dst1_num,dst2_num,dst3_num,dst4_num ! dust aerosol number (#/cm^3)
+ real(r8) :: dst_num ! total dust aerosol number (#/cm^3)
+ real(r8) :: wght
+ real(r8) :: dmc
+ real(r8) :: ssmc
+ real(r8) :: oso4_num
+ real(r8) :: odst_num
+ real(r8) :: osoot_num
+ real(r8) :: dso4_num ! tuning factor for increased so4
+ real(r8) :: ramp ! ---------- " ----------------
+ real(r8) :: dust_coarse_fraction ! fraction of dust in coarse (a3) mode
+ real(r8) :: masslost ! [kg/kg] tmp variable for mass lost
+ real(r8) :: numberFromSmallDustMode ! [#/cm3] number of dust activated from small mode
+
+ real(r8) :: subgrid(pcols,pver)
+ real(r8) :: trop_pd(pcols,pver)
+
+ ! For pre-existing ice
+ real(r8) :: fhom(pcols,pver) ! how much fraction of cloud can reach Shom
+ real(r8) :: wice(pcols,pver) ! diagnosed Vertical velocity Reduction caused by preexisting ice (m/s), at Shom
+ real(r8) :: weff(pcols,pver) ! effective Vertical velocity for ice nucleation (m/s); weff=wsubi-wice
+ real(r8) :: INnso4(pcols,pver) ! #/m3, so4 aerosol number used for ice nucleation
+ real(r8) :: INnbc(pcols,pver) ! #/m3, bc aerosol number used for ice nucleation
+ real(r8) :: INndust(pcols,pver) ! #/m3, dust aerosol number used for ice nucleation
+ real(r8) :: INondust(pcols,pver) ! #/m3, dust aerosol number used for ice nucleation
+ real(r8) :: INhet(pcols,pver) ! #/m3, ice number from het freezing
+ real(r8) :: INhom(pcols,pver) ! #/m3, ice number from hom freezing
+ real(r8) :: INFrehom(pcols,pver) ! hom freezing occurence frequency. 1 occur, 0 not occur.
+ real(r8) :: INFreIN(pcols,pver) ! ice nucleation occerence frequency. 1 occur, 0 not occur.
+
+ ! history output for ice nucleation
+ real(r8) :: nihf(pcols,pver) !output number conc of ice nuclei due to heterogenous freezing (1/m3)
+ real(r8) :: niimm(pcols,pver) !output number conc of ice nuclei due to immersion freezing (hetero nuc) (1/m3)
+ real(r8) :: nidep(pcols,pver) !output number conc of ice nuclei due to deoposion nucleation (hetero nuc) (1/m3)
+ real(r8) :: nimey(pcols,pver) !output number conc of ice nuclei due to meyers deposition (1/m3)
+ real(r8) :: regm(pcols,pver) !output temperature thershold for nucleation regime
+
+ real(r8) :: so4_num_ac
+ real(r8) :: so4_num_cr
+
+ !-------------------------------------------------------------------------------
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+ t => state%t
+ qn => state%q(:,:,1)
+ qc => state%q(:,:,cldliq_idx)
+ qi => state%q(:,:,cldice_idx)
+ ni => state%q(:,:,numice_idx)
+ pmid => state%pmid
+
+ do k = top_lev, pver
+ do i = 1, ncol
+ rho(i,k) = pmid(i,k)/(rair*t(i,k))
+ end do
+ end do
+
+ call physics_ptend_init(ptend, state%psetcols, 'nucleatei', lq=lq)
+
+ cld_dst_a2 => qqcw_get_field(pbuf, l_dst_a2, lchnk, .true.)
+ cld_dst_a3 => qqcw_get_field(pbuf, l_dst_a2, lchnk, .true.)
+
+ itim_old = pbuf_old_tim_idx()
+ call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+
+ icecldf(:ncol,:pver) = ast(:ncol,:pver)
+
+ ! naai and naai_hom are the outputs from this parameterization
+ call pbuf_get_field(pbuf, naai_idx, naai)
+ call pbuf_get_field(pbuf, naai_hom_idx, naai_hom)
+ naai(1:ncol,1:pver) = 0._r8
+ naai_hom(1:ncol,1:pver) = 0._r8
+
+ ! Use the same criteria that is used in chemistry and in CLUBB (for cloud fraction)
+ ! to determine whether to use tropospheric or stratospheric settings. Include the
+ ! tropopause level so that the cold point tropopause will use the stratospheric values.
+ call tropopause_findChemTrop(state, troplev)
+
+ if ((nucleate_ice_subgrid .eq. -1._r8) .or. (nucleate_ice_subgrid_strat .eq. -1._r8)) then
+ call pbuf_get_field(pbuf, qsatfac_idx, qsatfac)
+ end if
+
+ trop_pd(:,:) = 0._r8
+
+ do k = top_lev, pver
+ do i = 1, ncol
+ trop_pd(i, troplev(i)) = 1._r8
+
+ if (k <= troplev(i)) then
+ if (nucleate_ice_subgrid_strat .eq. -1._r8) then
+ subgrid(i, k) = 1._r8 / qsatfac(i, k)
+ else
+ subgrid(i, k) = nucleate_ice_subgrid_strat
+ end if
+ else
+ if (nucleate_ice_subgrid .eq. -1._r8) then
+ subgrid(i, k) = 1._r8 / qsatfac(i, k)
+ else
+ subgrid(i, k) = nucleate_ice_subgrid
+ end if
+ end if
+ end do
+ end do
+
+
+ ! initialize history output fields for ice nucleation
+ nihf(1:ncol,1:pver) = 0._r8
+ niimm(1:ncol,1:pver) = 0._r8
+ nidep(1:ncol,1:pver) = 0._r8
+ nimey(1:ncol,1:pver) = 0._r8
+
+ if (use_preexisting_ice) then
+ fhom(:,:) = 0.0_r8
+ wice(:,:) = 0.0_r8
+ weff(:,:) = 0.0_r8
+ INnso4(:,:) = 0.0_r8
+ INnbc(:,:) = 0.0_r8
+ INndust(:,:) = 0.0_r8
+ INondust(:,:) = 0.0_r8
+ INhet(:,:) = 0.0_r8
+ INhom(:,:) = 0.0_r8
+ INFrehom(:,:) = 0.0_r8
+ INFreIN(:,:) = 0.0_r8
+ endif
+
+ do k = top_lev, pver
+
+ ! Get humidity and saturation vapor pressures
+ call qsat_water(t(:ncol,k), pmid(:ncol,k), &
+ es(:ncol), qs(:ncol), gam=gammas(:ncol))
+
+ do i = 1, ncol
+
+ relhum(i,k) = qn(i,k)/qs(i)
+
+ ! get cloud fraction, check for minimum
+ icldm(i,k) = max(icecldf(i,k), mincld)
+
+ end do
+ end do
+
+
+ do k = top_lev, pver
+ do i = 1, ncol
+
+ if (t(i,k) < tmelt - 5._r8) then
+
+ ! compute aerosol number for so4, soot, and dust with units #/cm^3
+ so4_num = 0._r8
+ soot_num = 0._r8
+ dst1_num = 0._r8
+ dst2_num = 0._r8
+ dst3_num = 0._r8
+ dst4_num = 0._r8
+ dst_num = 0._r8
+
+ if (clim_modal_aero) then
+ !For modal aerosols, assume for the upper troposphere:
+ ! soot = accumulation mode
+ ! sulfate = aiken mode
+ ! dust = coarse mode
+ ! since modal has internal mixtures.
+ soot_num = numberConcentration(i,k,MODE_IDX_OMBC_INTMIX_COAT_AIT)*1.0e-6_r8
+
+ dst_num = (numberConcentration(i,k,MODE_IDX_DST_A2) &
+ + numberConcentration(i,k,MODE_IDX_DST_A3))*1.0e-6_r8
+ !Oslo aerosols have two modes.. Need mode-fractions
+ dust_coarse_fraction = numberConcentration(i,k,MODE_IDX_DST_A3)*1.e-6_r8 / (dst_num+1.e-100_r8)
+
+
+ so4_num = (numberConcentration(i,k,MODE_IDX_SO4_AC))*1.0e-6_r8
+
+ end if !clim modal aero
+ ! *** Turn off soot nucleation ***
+ soot_num = 0.0_r8
+
+ call nucleati( &
+ wsubi(i,k), t(i,k), pmid(i,k), relhum(i,k), icldm(i,k), &
+ qc(i,k), qi(i,k), ni(i,k), rho(i,k), &
+ so4_num, dst_num, soot_num, subgrid(i,k), &
+ naai(i,k), nihf(i,k), niimm(i,k), nidep(i,k), nimey(i,k), &
+ wice(i,k), weff(i,k), fhom(i,k), regm(i,k), &
+ oso4_num, odst_num, osoot_num)
+
+ ! Move aerosol used for nucleation from interstial to cloudborne,
+ ! otherwise the same coarse mode aerosols will be available again
+ ! in the next timestep and will supress homogeneous freezing.
+ if (use_preexisting_ice) then
+
+ numberFromSmallDustMode = 0.0_r8
+
+ !Assume the coarse aerosols were activated first
+ !so only remove small ones if more than large ones are activated
+ if(odst_num .gt. dst_num*dust_coarse_fraction)then
+
+ !A2-mode
+ numberFromSmallDustMode = odst_num - dst_num*dust_coarse_fraction
+
+ masslost = (odst_num & !all removed
+ - dst_num*dust_coarse_fraction) & !fraction to coarse mode
+ / volumeToNumber(MODE_IDX_DST_A2) &
+ * rhopart(l_dst_a2) &
+ /rho(i,k)*1e6_r8
+
+ ptend%q(i,k,l_dst_a2) = -masslost*icldm(i,k)/ dtime
+ cld_dst_a2(i,k) = cld_dst_a2(i,k) + masslost*icldm(i,k)
+
+ end if
+
+ ! Coarse mode (is always lost)
+ masslost = (odst_num - numberFromSmallDustMode) &
+ / volumeToNumber(MODE_IDX_DST_A3) &
+ * rhopart(l_dst_a3) &
+ / rho(i,k)*1e6_r8
+
+ ptend%q(i,k,l_dst_a3) = -masslost * icldm(i,k) / dtime
+ cld_dst_a3(i,k) = cld_dst_a3(i,k) + masslost*icldm(i,k)
+
+ end if
+
+ !Oslo aerosols do not have explicit treatment of coarse sulfate
+ so4_num_cr = 0.0_r8
+
+ ! Liu&Penner does not generate enough nucleation in the polar winter
+ ! stratosphere, which affects surface area density, dehydration and
+ ! ozone chemistry. Part of this is that there are a larger number of
+ ! particles in the accumulation mode than in the Aitken mode. In volcanic
+ ! periods, the coarse mode may also be important. As a short
+ ! term work around, include the accumulation and coarse mode particles
+ ! and assume a larger fraction of the sulfates nucleate in the polar
+ ! stratosphere.
+ !
+ ! Do not include the tropopause level, as stratospheric aerosols
+ ! only exist above the tropopause level.
+ !
+ ! NOTE: This may still not represent the proper particles that
+ ! participate in nucleation, because it doesn't include STS and NAT
+ ! particles. It may not represent the proper saturation threshold for
+ ! nucleation, and wsubi from CLUBB is probably not representative of
+ ! wave driven varaibility in the polar stratosphere.
+ if (nucleate_ice_use_troplev) then
+ if ((k < troplev(i)) .and. (nucleate_ice_strat > 0._r8)) then
+ if (oso4_num > 0._r8) then
+ so4_num_ac = so4_num*rho(i,k)*1.0e-6_r8 !This is maximum sulfate which can activate
+ !! NCAR/MAM4-version
+ !!!so4_num_ac = num_accum(i,k)*rho(i,k)*1.0e-6_r8
+ !! NCAR/MAM4-version
+ dso4_num = max(0._r8, (nucleate_ice_strat * (so4_num_cr + so4_num_ac)) - oso4_num) * 1e6_r8 / rho(i,k)
+ naai(i,k) = naai(i,k) + dso4_num
+ nihf(i,k) = nihf(i,k) + dso4_num
+ end if
+ end if
+ else
+
+ ! This maintains backwards compatibility with the previous version.
+ if (pmid(i,k) <= 12500._r8 .and. pmid(i,k) > 100._r8 .and. abs(state%lat(i)) >= 60._r8 * pi / 180._r8) then
+ ramp = 1._r8 - min(1._r8, max(0._r8, (pmid(i,k) - 10000._r8) / 2500._r8))
+
+ if (oso4_num > 0._r8) then
+ dso4_num = (max(oso4_num, ramp * nucleate_ice_strat * so4_num) - oso4_num) * 1e6_r8 / rho(i,k)
+ naai(i,k) = naai(i,k) + dso4_num
+ nihf(i,k) = nihf(i,k) + dso4_num
+ end if
+ end if
+ end if
+
+ naai_hom(i,k) = nihf(i,k)
+
+ ! output activated ice (convert from #/kg -> #/m3)
+ nihf(i,k) = nihf(i,k) *rho(i,k)
+ niimm(i,k) = niimm(i,k)*rho(i,k)
+ nidep(i,k) = nidep(i,k)*rho(i,k)
+ nimey(i,k) = nimey(i,k)*rho(i,k)
+
+ if (use_preexisting_ice) then
+ INnso4(i,k) =so4_num*1e6_r8 ! (convert from #/cm3 -> #/m3)
+ INnbc(i,k) =soot_num*1e6_r8
+ INndust(i,k)=dst_num*1e6_r8
+ INondust(i,k)=odst_num*1e6_r8
+ INFreIN(i,k)=1.0_r8 ! 1,ice nucleation occur
+ INhet(i,k) = (niimm(i,k) + nidep(i,k)) ! #/m3, nimey not in cirrus
+ INhom(i,k) = nihf(i,k) ! #/m3
+ if (INhom(i,k).gt.1e3_r8) then ! > 1/L
+ INFrehom(i,k)=1.0_r8 ! 1, hom freezing occur
+ endif
+
+ ! exclude no ice nucleaton
+ if ((INFrehom(i,k) < 0.5_r8) .and. (INhet(i,k) < 1.0_r8)) then
+ INnso4(i,k) =0.0_r8
+ INnbc(i,k) =0.0_r8
+ INndust(i,k)=0.0_r8
+ INondust(i,k)=0.0_r8
+ INFreIN(i,k)=0.0_r8
+ INhet(i,k) = 0.0_r8
+ INhom(i,k) = 0.0_r8
+ INFrehom(i,k)=0.0_r8
+ wice(i,k) = 0.0_r8
+ weff(i,k) = 0.0_r8
+ fhom(i,k) = 0.0_r8
+ endif
+ end if
+
+ end if
+ end do
+ end do
+
+
+ call outfld('NIHF', nihf, pcols, lchnk)
+ call outfld('NIIMM', niimm, pcols, lchnk)
+ call outfld('NIDEP', nidep, pcols, lchnk)
+ call outfld('NIMEY', nimey, pcols, lchnk)
+ call outfld('NIREGM', regm, pcols, lchnk)
+ call outfld('NISUBGRID', subgrid, pcols, lchnk)
+ call outfld('NITROP_PD', trop_pd, pcols, lchnk)
+
+ if (use_preexisting_ice) then
+ call outfld( 'fhom' , fhom, pcols, lchnk)
+ call outfld( 'WICE' , wice, pcols, lchnk)
+ call outfld( 'WEFF' , weff, pcols, lchnk)
+ call outfld('INnso4 ',INnso4 , pcols,lchnk)
+ call outfld('INnbc ',INnbc , pcols,lchnk)
+ call outfld('INndust ',INndust, pcols,lchnk)
+ call outfld('INondust ',INondust, pcols,lchnk)
+ call outfld('INhet ',INhet , pcols,lchnk)
+ call outfld('INhom ',INhom , pcols,lchnk)
+ call outfld('INFrehom',INFrehom,pcols,lchnk)
+ call outfld('INFreIN ',INFreIN, pcols,lchnk)
+ end if
+
+end subroutine nucleate_ice_oslo_calc
+
+!================================================================================================
+
+end module nucleate_ice_oslo
diff --git a/src/chemistry/oslo_aero/oslo_aerosols_intr.F90 b/src/chemistry/oslo_aero/oslo_aerosols_intr.F90
new file mode 100644
index 0000000000..47197dc06c
--- /dev/null
+++ b/src/chemistry/oslo_aero/oslo_aerosols_intr.F90
@@ -0,0 +1,1167 @@
+module oslo_aerosols_intr
+
+ use aerosoldef
+ use commondefinitions
+ use modal_aero_data, only: qqcw_get_field
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use constituents, only: pcnst, cnst_name, cnst_get_ind
+ use ppgrid, only: pcols, pver, pverp
+ use phys_control, only: phys_getopts
+ use cam_abortutils, only: endrun
+ use cam_logfile, only: iulog
+ use perf_mod, only: t_startf, t_stopf
+ use camsrfexch, only: cam_in_t, cam_out_t
+ use aerodep_flx, only: aerodep_flx_prescribed
+ use physics_types, only: physics_state, physics_ptend, physics_ptend_init
+ use physics_buffer, only: physics_buffer_desc
+ use physics_buffer, only: pbuf_get_field, pbuf_get_index, pbuf_set_field
+ use physconst, only: gravit, rair, rhoh2o
+ use spmd_utils, only: masterproc
+ use infnan, only: nan, assignment(=)
+
+ use cam_history, only: outfld, fieldname_len
+ use chem_mods, only: gas_pcnst, adv_mass
+ use mo_tracname, only: solsym
+
+ use ref_pres, only: top_lev => clim_modal_aero_top_lev
+
+ use modal_aero_wateruptake, only: modal_strat_sulfate
+ use mo_setsox, only: setsox, has_sox
+
+ implicit none
+
+ private ! Make default type private to the module
+
+ save
+
+ !
+ ! Public interfaces
+ !
+
+ public :: oslo_aero_wet_intr ! interface to wet deposition
+ public :: sol_facti_cloud_borne
+ public :: oslo_aero_dry_intr ! interface to dry deposition
+ public :: oslo_aero_initialize
+
+ logical :: inv_o3, inv_oh, inv_no3, inv_ho2
+ integer, pointer :: id_so2, id_so4, id_dms, id_o3, id_h2o2, id_oh, id_no3, id_ho2
+ integer, target :: spc_ids(8)
+
+ integer :: fracis_idx = 0
+ integer :: prain_idx = 0
+ integer :: rprddp_idx = 0
+ integer :: rprdsh_idx = 0
+ integer :: nevapr_shcu_idx = 0
+ integer :: nevapr_dpcu_idx = 0
+ real(r8) :: sol_facti_cloud_borne
+
+! variables for table lookup of aerosol impaction/interception scavenging rates
+ integer, parameter :: nimptblgrow_mind=-7, nimptblgrow_maxd=12
+ real(r8) dlndg_nimptblgrow
+ real(r8) scavimptblnum(nimptblgrow_mind:nimptblgrow_maxd, nmodes)
+ real(r8) scavimptblvol(nimptblgrow_mind:nimptblgrow_maxd, nmodes)
+
+
+ integer :: ndrydep = 0
+ integer,allocatable :: drydep_indices(:)
+ integer :: nwetdep = 0
+ integer,allocatable :: wetdep_indices(:)
+ logical :: drydep_lq(pcnst)
+ logical :: wetdep_lq(pcnst)
+
+ logical :: convproc_do_aer = .FALSE.
+
+contains
+
+ !===============================================================================
+ subroutine oslo_aero_initialize(pbuf2d )
+ use cam_history, only : addfld, add_default, horiz_only
+ use mo_chem_utls, only : get_inv_ndx
+ use gas_wetdep_opts, only : gas_wetdep_list, gas_wetdep_cnt
+ use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk
+ use ppgrid, only: pcols, pver, begchunk, endchunk
+ use time_manager, only: is_first_step
+ use modal_aero_data, only: qqcw_get_field
+
+ implicit none
+
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+ integer :: m
+ integer :: l
+
+ integer :: i
+ integer :: lchnk
+ integer :: tracerIndex
+ integer :: astat, id
+ real(r8), pointer :: qqcw(:,:)
+
+ logical :: history_aerosol ! Output the MAM aerosol tendencies
+ character(len=2) :: unit_basename='kg' ! Units 'kg' or '1'
+ character(len=100) :: aName ! tracer name
+ logical :: is_in_output(pcnst)
+ !-----------------------------------------------------------------------
+
+ fracis_idx = pbuf_get_index('FRACIS')
+ prain_idx = pbuf_get_index('PRAIN')
+ rprddp_idx = pbuf_get_index('RPRDDP')
+ rprdsh_idx = pbuf_get_index('RPRDSH')
+ nevapr_shcu_idx = pbuf_get_index('NEVAPR_SHCU')
+
+ call phys_getopts( history_aerosol_out = history_aerosol )
+
+ is_in_output(:)=.false.
+ drydep_lq(:)=.false.
+ wetdep_lq(:)=.false.
+
+ !Mode 0 is not subject to wet deposition? (check noresm1 code..)
+ do m=0,nmodes
+ do l=1,getNumberOfTracersInMode(m)
+
+ tracerIndex = getTracerIndex(m,l,.false.)
+
+ drydep_lq(tracerIndex)=.true.
+ wetdep_lq(tracerIndex)=.true.
+
+ if(is_in_output(tracerIndex))then
+ cycle
+ endif
+
+ aName = cnst_name(tracerIndex)
+
+ print*, m,l,tracerIndex, trim(aName)
+
+ call addfld (trim(aName)//'SFWET',horiz_only, 'A', unit_basename//'/m2/s', &
+ 'Wet deposition flux at surface')
+ call addfld (trim(aName)//'SFSIC',horiz_only, 'A', unit_basename//'/m2/s ', &
+ 'Wet deposition flux (incloud, convective) at surface')
+ call addfld (trim(aName)//'SFSIS',horiz_only, 'A', unit_basename//'/m2/s ', &
+ 'Wet deposition flux (incloud, stratiform) at surface')
+ call addfld (trim(aName)//'SFSBC',horiz_only, 'A', unit_basename//'/m2/s ', &
+ 'Wet deposition flux (belowcloud, convective) at surface')
+ call addfld (trim(aName)//'SFSBS',horiz_only, 'A', unit_basename//'/m2/s ', &
+ 'Wet deposition flux (belowcloud, stratiform) at surface')
+ call addfld (trim(aName)//'WET',(/'lev'/), 'A', unit_basename//'/kg/s ','wet deposition tendency')
+ call addfld (trim(aName)//'SIC',(/'lev'/), 'A', unit_basename//'/kg/s ', &
+ trim(aName)//' ic wet deposition')
+ call addfld (trim(aName)//'SIS',(/'lev'/), 'A', unit_basename//'/kg/s ', &
+ trim(aName)//' is wet deposition')
+ call addfld (trim(aName)//'SBC',(/'lev'/), 'A', unit_basename//'/kg/s ', &
+ trim(aName)//' bc wet deposition')
+ call addfld (trim(aName)//'SBS',(/'lev'/), 'A', unit_basename//'/kg/s ', &
+ trim(aName)//' bs wet deposition')
+
+ !Extra wd ouptut
+ if ( history_aerosol ) then
+ call add_default (trim(aName)//'SFWET', 1, ' ')
+ call add_default (trim(aName)//'SFSIC', 1, ' ')
+ call add_default (trim(aName)//'SFSIS', 1, ' ')
+ call add_default (trim(aName)//'SFSBC', 1, ' ')
+ call add_default (trim(aName)//'SFSBS', 1, ' ')
+ endif
+
+ !ddep output
+ call addfld (trim(aName)//'DDF',horiz_only, 'A', unit_basename//'/m2/s ', &
+ trim(aName)//' dry deposition flux at bottom (grav + turb)')
+ call addfld (trim(aName)//'TBF',horiz_only, 'A' ,unit_basename//'/m2/s', &
+ trim(aName)//' turbulent dry deposition flux')
+ call addfld (trim(aName)//'GVF',horiz_only, 'A', unit_basename//'/m2/s ', &
+ trim(aName)//' gravitational dry deposition flux')
+ call addfld (trim(aName)//'DTQ',(/'lev'/), 'A', unit_basename//'/kg/s ', &
+ trim(aName)//' dry deposition')
+ call addfld (trim(aName)//'DDV',(/'lev'/), 'A', 'm/s', &
+ trim(aName)//' deposition velocity')
+
+ !extra drydep output
+ if ( history_aerosol ) then
+ call add_default (trim(aName)//'DDF', 1, ' ')
+ call add_default (trim(aName)//'TBF', 1, ' ')
+ call add_default (trim(aName)//'GVF', 1, ' ')
+ !call add_default (trim(aName)//'DDV', 1, ' ')
+ endif
+
+ !some tracers are not in cloud water
+ if(getCloudTracerIndexDirect(tracerIndex) .lt. 0)then
+ cycle
+ endif
+
+ aName = trim(getCloudTracerName(tracerIndex))
+ !Cloud water fields (from mo_chm_diags.F90)
+ call addfld (trim(aName)//'SFWET', horiz_only, 'A', unit_basename//'/m2/s', &
+ trim(aName)//' wet deposition flux at surface')
+ call addfld (trim(aName)//'SFSIC', horiz_only, 'A',unit_basename//'/m2/s ', &
+ trim(aName)//' wet deposition flux (incloud, convective) at surface')
+ call addfld (trim(aName)//'SFSIS', horiz_only, 'A', unit_basename//'/m2/s ', &
+ trim(aName)//' wet deposition flux (incloud, stratiform) at surface')
+ call addfld (trim(aName)//'SFSBC', horiz_only, 'A', unit_basename//'/m2/s ' , &
+ trim(aName)//' wet deposition flux (belowcloud, convective) at surface')
+ call addfld (trim(aName)//'SFSBS', horiz_only, 'A', unit_basename//'/m2/s ' , &
+ trim(aName)//' wet deposition flux (belowcloud, stratiform) at surface')
+ !dry deposition
+ call addfld (trim(aName)//'DDF', horiz_only, 'A', unit_basename//'/m2/s ', &
+ trim(aName)//' dry deposition flux at bottom (grav + turb)')
+ call addfld (trim(aName)//'TBF', horiz_only, 'A', unit_basename//'/m2/s ', &
+ trim(aName)//' turbulent dry deposition flux')
+ call addfld (trim(aName)//'GVF', horiz_only, 'A', unit_basename//'/m2/s ', &
+ trim(aName)//' gravitational dry deposition flux')
+
+ is_in_output(tracerIndex) = .true.
+
+ end do !tracers
+ enddo !modes
+
+ !initialize cloud concentrations
+
+ if (is_first_step()) then
+ ! initialize cloud bourne constituents in physics buffer
+
+ do i = 1, pcnst
+ do lchnk = begchunk, endchunk
+ qqcw => qqcw_get_field(pbuf_get_chunk(pbuf2d,lchnk), i, lchnk, .true.)
+ if (associated(qqcw)) then
+ qqcw = 1.e-38_r8
+ end if
+ end do
+ end do
+ end if
+
+ end subroutine oslo_aero_initialize
+
+ subroutine oslo_aero_dry_intr ( state, pbuf, obklen, ustar, cam_in, dt, cam_out, ptend &
+ , dgncur_awet, wetdens, dgncur_awet_processmode &
+ , wetdens_processmode, cflx &
+ )
+
+ !===============================================================================
+ use cam_history, only: outfld
+ use ppgrid, only: pverp
+ use physics_types, only: physics_state, physics_ptend
+ use camsrfexch, only: cam_out_t
+ use physconst, only: gravit, rair, rhoh2o
+ use drydep_mod, only: setdvel, d3ddflux, calcram
+ use dust_sediment_mod, only: dust_sediment_tend, dust_sediment_vel
+ use modal_aero_deposition, only: set_srf_drydep
+ use physics_buffer, only : physics_buffer_desc
+
+ !-----------------------------------------------------------------------
+ implicit none
+ !-----------------------------------------------------------------------
+ !
+ ! Arguments:
+ type(physics_state), intent(in) :: state ! Physics state variables
+ real(r8), intent(in) :: obklen(:)
+ real(r8), intent(in) :: ustar(:) ! sfc fric vel
+ type(cam_in_t), target, intent(in) :: cam_in ! import state
+ real(r8), intent(in) :: dt ! time step
+ type(cam_out_t), intent(inout) :: cam_out ! export state
+ type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ !
+ real(r8), intent(in) :: dgncur_awet(pcols,pver,0:nmodes)
+ real(r8), intent(in) :: wetdens(pcols,pver,0:nmodes)
+ real(r8), intent(in) :: dgncur_awet_processmode(pcols, pver, numberOfProcessModeTracers)
+ real(r8), intent(in) :: wetdens_processmode(pcols, pver, numberOfProcessModeTracers)
+ real(r8), intent(in) :: cflx(pcols,pcnst) !Surface fluxes
+
+ ! local vars
+ real(r8), pointer :: landfrac(:) ! land fraction
+ real(r8), pointer :: icefrac(:) ! ice fraction
+ real(r8), pointer :: ocnfrac(:) ! ocean fraction
+ real(r8), pointer :: fvin(:) !
+ real(r8), pointer :: ram1in(:) ! for dry dep velocities from land model for progseasalts
+
+ real(r8) :: fv(pcols) ! for dry dep velocities, from land modified over ocean & ice
+ real(r8) :: ram1(pcols) ! for dry dep velocities, from land modified over ocean & ice
+
+ integer :: lchnk ! chunk identifier
+ integer :: ncol ! number of atmospheric columns
+ integer :: jvlc ! index for last dimension of vlc_xxx arrays
+ integer :: lphase ! index for interstitial / cloudborne aerosol
+ integer :: lspec ! index for aerosol number / chem-mass / water-mass
+ integer :: m ! aerosol mode index
+ integer :: mm ! tracer index
+ integer :: i
+
+ real(r8) :: tvs(pcols,pver)
+ real(r8) :: rho(pcols,pver) ! air density in kg/m3
+ real(r8) :: sflx(pcols) ! deposition flux
+ real(r8):: dep_trb(pcols) !kg/m2/s
+ real(r8):: dep_grv(pcols) !kg/m2/s (total of grav and trb)
+ real(r8) :: pvmzaer(pcols,pverp) ! sedimentation velocity in Pa
+ real(r8) :: dqdt_tmp(pcols,pver) ! temporary array to hold tendency for 1 species
+
+ real(r8) :: rad_drop(pcols,pver)
+ real(r8) :: dens_drop(pcols,pver)
+ real(r8) :: sg_drop(pcols,pver)
+ real(r8) :: rad_aer(pcols,pver)
+ real(r8) :: dens_aer(pcols,pver)
+ real(r8) :: sg_aer(pcols,pver)
+
+ real(r8) :: vlc_dry(pcols,pver,4) ! dep velocity
+ real(r8) :: vlc_grv(pcols,pver,4) ! dep velocity
+ real(r8):: vlc_trb(pcols,4) ! dep velocity
+ real(r8) :: aerdepdryis(pcols,pcnst) ! aerosol dry deposition (interstitial)
+ real(r8) :: aerdepdrycw(pcols,pcnst) ! aerosol dry deposition (cloud water)
+ real(r8), pointer :: fldcw(:,:)
+
+ !++oslo aerosols
+ real(r8) :: interfaceTendToLowestLayer(pcols)
+ real(r8) :: deltaH(pcols)
+ real(r8) :: massLostDD(pcols)
+ real(r8) :: MMRNew(pcols)
+ real(r8) :: lossRate(pcols)
+ real(r8) :: totalProd(pcols)
+ real(r8) :: fallFromAbove(pcols)
+
+ real(r8) :: logSigma
+ logical :: is_done(pcnst,2)
+ !-----------------------------------------------------------------------
+
+ landfrac => cam_in%landfrac(:)
+ icefrac => cam_in%icefrac(:)
+ ocnfrac => cam_in%ocnfrac(:)
+ fvin => cam_in%fv(:)
+ ram1in => cam_in%ram1(:)
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+ aerdepdryis(:,:)=0._r8
+ aerdepdrycw(:,:)=0._r8
+ ! calc ram and fv over ocean and sea ice ...
+ call calcram( ncol,landfrac,icefrac,ocnfrac,obklen,&
+ ustar,ram1in,ram1,state%t(:,pver),state%pmid(:,pver),&
+ state%pdel(:,pver),fvin,fv)
+
+ call outfld( 'airFV', fv(:), pcols, lchnk )
+ call outfld( 'RAM1', ram1(:), pcols, lchnk )
+
+ ! note that tendencies are not only in sfc layer (because of sedimentation)
+ ! and that ptend is updated within each subroutine for different species
+
+ call physics_ptend_init(ptend, state%psetcols, 'aero_model_drydep', lq=drydep_lq)
+
+ tvs(:ncol,:) = state%t(:ncol,:)!*(1+state%q(:ncol,k)
+ rho(:ncol,:)= state%pmid(:ncol,:)/(rair*state%t(:ncol,:))
+
+
+ is_done(:,:) = .false.
+
+!
+! calc settling/deposition velocities for cloud droplets (and cloud-borne aerosols)
+!
+! *** mean drop radius should eventually be computed from ndrop and qcldwtr
+ rad_drop(:,:) = 5.0e-6_r8
+ dens_drop(:,:) = rhoh2o
+ sg_drop(:,:) = 1.46_r8
+ !jvlc = 3
+ !call modal_aero_depvel_part( ncol,state%t(:,:), state%pmid(:,:), ram1, fv, &
+ ! vlc_dry(:,:,jvlc), vlc_trb(:,jvlc), vlc_grv(:,:,jvlc), &
+ ! rad_drop(:,:), dens_drop(:,:), sg_drop(:,:), 0, lchnk)
+ jvlc = 4
+ call modal_aero_depvel_part( ncol,state%t(:,:), state%pmid(:,:), ram1, fv, &
+ vlc_dry(:,:,jvlc), vlc_trb(:,jvlc), vlc_grv(:,:,jvlc), &
+ rad_drop(:,:), dens_drop(:,:), sg_drop(:,:), 3, lchnk)
+
+
+
+ !At this point we really need to distribute the lifecycle-tracers over
+ !the actual modes (maybe according to surface available of background tracers?)
+
+ !in mam3, jvlc = 1 means number-concentration
+ !in oslo_aero, jvlc = 1 means process-modes
+ !The following logic is based on that process-mode tracers
+ !always follow AFTER the actual tracers!!
+
+ do m = 0, nmodes ! main loop over aerosol modes
+
+ do lphase = 1, 2 ! loop over interstitial / cloud-borne forms
+
+ if (lphase == 1) then ! interstial aerosol - calc settling/dep velocities of mode
+
+ logSigma = log(lifeCycleSigma(m))
+
+ ! rad_aer = volume mean wet radius (m)
+ ! dgncur_awet = geometric mean wet diameter for number distribution (m)
+ if(top_lev.gt.1) then
+ rad_aer(1:ncol,:top_lev-1) = 0._r8
+ end if
+ rad_aer(1:ncol,top_lev:) = 0.5_r8*dgncur_awet(1:ncol,top_lev:,m) &
+ *exp(1.5_r8*(logSigma))
+
+ ! dens_aer(1:ncol,:) = wet density (kg/m3)
+ if(top_lev.gt.1)then
+ dens_aer(1:ncol,:top_lev-1) = 0._r8
+ end if
+ dens_aer(1:ncol,top_lev:) = wetdens(1:ncol,top_lev:,m)
+ sg_aer(1:ncol,:) = lifecycleSigma(m)
+
+ jvlc = 2
+ call modal_aero_depvel_part( ncol, state%t(:,:), state%pmid(:,:), ram1, fv, &
+ vlc_dry(:,:,jvlc), vlc_trb(:,jvlc), vlc_grv(:,:,jvlc), &
+ rad_aer(:,:), dens_aer(:,:), sg_aer(:,:), 3, lchnk)
+
+! if(m .eq. MODE_IDX_SS_A3)then
+! do i=1,ncol
+! print*, "rad_aer", rad_aer(i,pver)*1.e6, ' um ', vlc_dry(i,pver,jvlc)*1.e2, " cm/s"
+! end do
+! end if
+ end if
+
+ do lspec = 1, getNumberOfTracersInMode(m) ! loop over number + constituents
+
+ mm = getTracerIndex(m,lspec,.false.)
+ if(is_done(mm,lphase) .eqv. .true. )then
+ cycle
+ endif
+ is_done(mm,lphase)=.true.
+
+ if (lphase == 1) then
+ jvlc = 2 !mass in clean air tracers
+
+ !Process tracers have their own velocity based on fixed size / density
+ !Calculate the velocity to use for this specie..
+ if ( is_process_mode(mm, .false.) ) then
+ jvlc = 1
+ logSigma = log(processModeSigma(processModeMap(mm)))
+ if(top_lev.gt.1)then
+ rad_aer(1:ncol, top_lev-1) = 0.0_r8
+ end if
+ rad_aer(1:ncol,top_lev:) = 0.5_r8*dgncur_awet_processmode(1:ncol,top_lev:,processModeMap(mm)) &
+ *exp(1.5_r8*(logSigma))
+ call modal_aero_depvel_part( ncol, state%t(:,:), state%pmid(:,:), ram1, fv, &
+ vlc_dry(:,:,jvlc), vlc_trb(:,jvlc), vlc_grv(:,:,jvlc), &
+ rad_aer(:,:), dens_aer(:,:), sg_aer(:,:), 3, lchnk)
+ endif
+
+ else
+ jvlc = 4 !mass in cloud tracers
+ endif
+
+ if (mm <= 0) cycle
+
+! if (lphase == 1) then
+ if ((lphase == 1) .and. (lspec <= getNumberOfTracersInMode(m))) then
+ ptend%lq(mm) = .TRUE.
+
+ ! use pvprogseasalts instead (means making the top level 0)
+ pvmzaer(:ncol,1)=0._r8
+ pvmzaer(:ncol,2:pverp) = vlc_dry(:ncol,:,jvlc)
+
+ call outfld( trim(cnst_name(mm))//'DDV', pvmzaer(:,2:pverp), pcols, lchnk )
+
+ if(.true.) then ! use phil's method
+ ! convert from meters/sec to pascals/sec
+ ! pvprogseasalts(:,1) is assumed zero, use density from layer above in conversion
+ pvmzaer(:ncol,2:pverp) = pvmzaer(:ncol,2:pverp) * rho(:ncol,:)*gravit
+
+ ! calculate the tendencies and sfc fluxes from the above velocities
+ call dust_sediment_tend( &
+ ncol, dt, state%pint(:,:), state%pmid, state%pdel, state%t , &
+ state%q(:,:,mm), pvmzaer, ptend%q(:,:,mm), sflx, interfaceTendToLowestLayer )
+ else !use charlie's method
+ call d3ddflux( ncol, vlc_dry(:,:,jvlc), state%q(:,:,mm), state%pmid, &
+ state%pdel, tvs, sflx, ptend%q(:,:,mm), dt )
+ endif
+
+ !write(iulog,*)"starting ddep proc", mm, pcnst
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ !%%%%%% FIX FOR SHORT DRYDEP LIFE-TIMES
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ !Some tracers have short lifetime with respect to dry dep:
+ !Solve implicitly for eqn for emission and dry dep in lowest layer
+ deltaH(:ncol)=state%pdel(:ncol,pver)/rho(:ncol,pver)/gravit ![m] height of layer
+ !print*, "deltaH", deltaH(:ncol)
+ lossRate(:ncol) = vlc_dry(:ncol,pver,jvlc)/deltaH(:ncol) ![1/s] loss rate out of layer
+ !print*, "lossRate", lossRate(:ncol)
+ !print*, "interfaceFluxesToLowestLayer", interfaceFluxToLowestLayer(:ncol)
+
+ !OBS OBS OBS DIRTY FIX but need approx 2-3 weeks for proper solution
+ !special treatment of BC_AX because BC_AX is not treated with
+ !boundary mixing in activation (is by definition not activated!)
+ !Therefor emissions are already added in "normal" boundary layer
+ !mixing routine..
+ !The proper fix to this is to skip the special treatment of BC_AX
+ !and skip the index "0" for that mixture alltogether!
+ if(mm .eq. l_bc_ax) then
+ totalProd(:ncol) = interfaceTendToLowestLayer(:ncol)
+ else
+ totalProd(:ncol) = cflx(:ncol,mm)*gravit/state%pdel(:ncol,pver) + interfaceTendToLowestLayer(:ncol)
+ end if
+
+ !Do solution
+ where(lossRate(:ncol)*dt .gt. 1.e-2_r8)
+ MMRNew(:ncol) = state%q(:ncol,pver,mm)*exp(-lossRate(:ncol)*dt) &
+ + totalProd(:ncol)/lossRate(:ncol)*(1.0_r8 - exp(-lossRate(:ncol)*dt))
+ elsewhere
+ MMRNew(:ncol) = state%q(:ncol,pver,mm) &
+ + totalProd(:ncol)*dt &
+ - state%q(:ncol,pver,mm)*lossRate(:ncol)*dt
+ end where
+
+ !C0 + Pdt -massLostDD = CNew ==>
+ massLostDD(:ncol) = state%q(:ncol,pver,mm) - MMRNew(:ncol) + totalProd(:ncol)*dt
+ !Overwrite tendency in lowest layer to include emissions
+ !They are then not included in vertical diffusion!!
+ ptend%q(:ncol,pver,mm) = (MMRNew(:ncol)-state%q(:ncol,pver,mm))/dt
+ sflx(:ncol) = massLostDD(:ncol)*state%pdel(:ncol,pver) / gravit / dt
+ !write(iulog,*)"done ddep"
+ !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ ! apportion dry deposition into turb and gravitational settling for tapes
+ dep_trb = 0._r8
+ dep_grv = 0._r8
+ do i=1,ncol
+ if (vlc_dry(i,pver,jvlc) /= 0._r8) then
+ dep_trb(i)=sflx(i)*vlc_trb(i,jvlc)/vlc_dry(i,pver,jvlc)
+ dep_grv(i)=sflx(i)*vlc_grv(i,pver,jvlc)/vlc_dry(i,pver,jvlc)
+ endif
+ enddo
+
+ call outfld( trim(cnst_name(mm))//'DDF', sflx, pcols, lchnk)
+ call outfld( trim(cnst_name(mm))//'TBF', dep_trb, pcols, lchnk )
+ call outfld( trim(cnst_name(mm))//'GVF', dep_grv, pcols, lchnk )
+ call outfld( trim(cnst_name(mm))//'DTQ', ptend%q(:,:,mm), pcols, lchnk)
+ aerdepdryis(:ncol,mm) = sflx(:ncol)
+
+ else ! lphase == 2
+
+ !Pick up the cloud tracers (oslo)
+ fldcw => qqcw_get_field(pbuf, mm,lchnk,.true.)
+ if( .not. associated(fldcw))then
+ cycle
+ end if
+
+ ! use pvprogseasalts instead (means making the top level 0)
+ pvmzaer(:ncol,1)=0._r8
+ pvmzaer(:ncol,2:pverp) = vlc_dry(:ncol,:,jvlc)
+
+
+ if(.true.) then ! use phil's method
+ ! convert from meters/sec to pascals/sec
+ ! pvprogseasalts(:,1) is assumed zero, use density from layer above in conversion
+ pvmzaer(:ncol,2:pverp) = pvmzaer(:ncol,2:pverp) * rho(:ncol,:)*gravit
+
+ ! calculate the tendencies and sfc fluxes from the above velocities
+ call dust_sediment_tend( &
+ ncol, dt, state%pint(:,:), state%pmid, state%pdel, state%t , &
+ fldcw(:,:), pvmzaer, dqdt_tmp(:,:), sflx )
+ else !use charlie's method
+ call d3ddflux( ncol, vlc_dry(:,:,jvlc), fldcw(:,:), state%pmid, &
+ state%pdel, tvs, sflx, dqdt_tmp(:,:), dt )
+ endif
+
+ ! apportion dry deposition into turb and gravitational settling for tapes
+ dep_trb = 0._r8
+ dep_grv = 0._r8
+ do i=1,ncol
+ if (vlc_dry(i,pver,jvlc) /= 0._r8) then
+ dep_trb(i)=sflx(i)*vlc_trb(i,jvlc)/vlc_dry(i,pver,jvlc)
+ dep_grv(i)=sflx(i)*vlc_grv(i,pver,jvlc)/vlc_dry(i,pver,jvlc)
+ end if
+ enddo
+
+ fldcw(1:ncol,:) = fldcw(1:ncol,:) + dqdt_tmp(1:ncol,:) * dt
+
+ call outfld( trim(getCloudTracerName(mm))//'DDF', sflx, pcols, lchnk)
+ call outfld( trim(getCloudTracerName(mm))//'TBF', dep_trb, pcols, lchnk )
+ call outfld( trim(getCloudTracerName(mm))//'GVF', dep_grv, pcols, lchnk )
+ aerdepdrycw(:ncol,mm) = sflx(:ncol)
+
+ endif
+
+ enddo ! lspec = 0, nspec_amode(m)+1
+ enddo ! lphase = 1, 2
+ enddo ! m = 1, ntot_amode
+
+ ! if the user has specified prescribed aerosol dep fluxes then
+ ! do not set cam_out dep fluxes according to the prognostic aerosols
+ if (.not.aerodep_flx_prescribed()) then
+ call set_srf_drydep(aerdepdryis, aerdepdrycw, cam_out)
+ endif
+
+ return
+ end subroutine oslo_aero_dry_intr
+ !===============================================================================
+ subroutine oslo_aero_wet_intr ( state, dt, dlf, cam_out, ptend, pbuf)
+
+
+ !-----------------------------------------------------------------------
+ !-----------------------------------------------------------------------
+ use cam_history, only: outfld
+ use physics_types, only: physics_state, physics_ptend
+ use camsrfexch, only: cam_out_t
+ use wetdep, only: wetdepa_v2, wetdep_inputs_set, wetdep_inputs_t
+ use physconst, only: gravit
+ use constituents, only: cnst_mw
+ use physconst, only: mwdry ! molecular weight dry air ~ kg/kmole
+ use physconst, only: boltz ! J/K/molecule
+ use tracer_cnst, only: get_cnst_data
+ use modal_aero_deposition, only: set_srf_wetdep
+ use physics_buffer, only : physics_buffer_desc
+
+ type(physics_state), intent(in) :: state ! Physics state variables
+ real(r8), intent(in) :: dt ! time step
+ real(r8), intent(in) :: dlf(:,:) ! shallow+deep convective detrainment [kg/kg/s]
+ type(cam_out_t), intent(inout) :: cam_out ! export state
+ type(physics_ptend), intent(out) :: ptend ! indivdual parameterization tendencies
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+
+ !
+ ! Local variables
+ !
+ integer :: m ! tracer index
+ integer :: lchnk ! chunk identifier
+ integer :: ncol ! number of atmospheric columns
+ real(r8) :: iscavt(pcols, pver)
+ integer :: mm
+
+ real(r8) :: icscavt(pcols, pver)
+ real(r8) :: isscavt(pcols, pver)
+ real(r8) :: bcscavt(pcols, pver)
+ real(r8) :: bsscavt(pcols, pver)
+ real(r8) :: sol_factb, sol_facti
+ real(r8) :: sol_factic(pcols,pver)
+ real(r8) :: sflx(pcols) ! deposition flux
+ integer :: i,k
+ real(r8) :: scavcoef(pcols,pver) ! Dana and Hales coefficient (/mm) (0.1)
+ 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) :: f_act_conv(pcols,pver) ! prescribed aerosol activation fraction for convective cloud ! rce 2010/05/01
+ real(r8) :: f_act_conv_coarse(pcols,pver) ! similar but for coarse mode ! rce 2010/05/02
+ real(r8) :: f_act_conv_coarse_dust, f_act_conv_coarse_nacl ! rce 2010/05/02
+ real(r8) :: fracis_cw(pcols,pver)
+ !real(r8) :: hygro_sum_old(pcols,pver) ! before removal [sum of (mass*hydro/dens)]
+ !real(r8) :: hygro_sum_del(pcols,pver) ! removal change to [sum of (mass*hydro/dens)]
+ !real(r8) :: hygro_sum_old_ik, hygro_sum_new_ik
+ real(r8) :: prec(pcols) ! precipitation rate
+ real(r8) :: q_tmp(pcols,pver) ! temporary array to hold "most current" mixing ratio for 1 species
+ real(r8) :: qqcw_tmp(pcols,pver) ! temporary array to hold qqcw ! rce 2010/05/01
+ real(r8) :: scavcoefnv(pcols,pver,0:2) ! Dana and Hales coefficient (/mm) for
+ ! cloud-borne num & vol (0),
+ ! interstitial num (1), interstitial vol (2)
+ real(r8) :: tmpa, tmpb
+ real(r8) :: tmpdust, tmpnacl
+ real(r8) :: water_old, water_new ! temporary old/new aerosol water mix-rat
+ logical :: isprx(pcols,pver) ! true if precipation
+ real(r8) :: aerdepwetis(pcols,pcnst) ! aerosol wet deposition (interstitial)
+ real(r8) :: aerdepwetcw(pcols,pcnst) ! aerosol wet deposition (cloud water)
+
+ real(r8), pointer :: rprddp(:,:) ! rain production, deep convection
+ real(r8), pointer :: rprdsh(:,:) ! rain production, shallow convection
+ real(r8), pointer :: evapcdp(:,:) ! Evaporation rate of deep convective precipitation >=0.
+ real(r8), pointer :: evapcsh(:,:) ! Evaporation rate of shallow convective precipitation >=0.
+
+ real(r8) :: rprddpsum(pcols)
+ real(r8) :: rprdshsum(pcols)
+ real(r8) :: evapcdpsum(pcols)
+ real(r8) :: evapcshsum(pcols)
+
+ real(r8) :: tmp_resudp, tmp_resush
+
+ real(r8) :: sflxec(pcols), sflxecdp(pcols) ! deposition flux
+ real(r8) :: sflxic(pcols), sflxicdp(pcols) ! deposition flux
+ real(r8) :: sflxbc(pcols), sflxbcdp(pcols) ! deposition flux
+ real(r8) :: rcscavt(pcols, pver)
+ real(r8) :: rsscavt(pcols, pver)
+ real(r8) :: qqcw_in(pcols,pver), qqcw_sav(pcols,pver,pcnst) ! temporary array to hold qqcw for the current mode
+ real(r8), pointer :: fldcw(:,:)
+
+ logical :: is_done(pcnst,2)
+ real(r8),target :: zeroAerosolConcentration(pcols,pver)
+
+ real(r8), pointer :: fracis(:,:,:) ! fraction of transported species that are insoluble
+
+ type(wetdep_inputs_t) :: dep_inputs
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ call physics_ptend_init(ptend, state%psetcols, 'aero_model_wetdep', lq=wetdep_lq)
+
+ is_done(:,:) = .false.
+
+
+ zeroAerosolConcentration(:,:)=0.0_r8
+
+ ! Wet deposition of mozart aerosol species.
+ ptend%name = ptend%name//'+mz_aero_wetdep'
+
+ call wetdep_inputs_set( state, pbuf, dep_inputs )
+ call pbuf_get_field(pbuf, fracis_idx, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) )
+
+ prec(:ncol)=0._r8
+ do k=1,pver
+ where (prec(:ncol) >= 1.e-7_r8)
+ isprx(:ncol,k) = .true.
+ elsewhere
+ isprx(:ncol,k) = .false.
+ endwhere
+ prec(:ncol) = prec(:ncol) + (dep_inputs%prain(:ncol,k) + dep_inputs%cmfdqr(:ncol,k) - dep_inputs%evapr(:ncol,k)) &
+ *state%pdel(:ncol,k)/gravit
+ end do
+
+
+! calculate the mass-weighted sol_factic for coarse mode species
+! sol_factic_coarse(:,:) = 0.30_r8 ! tuned 1/4
+ f_act_conv_coarse(:,:) = 0.60_r8 ! rce 2010/05/02
+ f_act_conv_coarse_dust = 0.40_r8 ! rce 2010/05/02
+ f_act_conv_coarse_nacl = 0.80_r8 ! rce 2010/05/02
+ !++ag
+ f_act_conv_coarse(:,:) = 0.5_r8
+ !--ag
+
+ scavcoefnv(:,:,0) = 0.0_r8 ! below-cloud scavcoef = 0.0 for cloud-borne species
+
+ do m = 0, nmodes ! main loop over aerosol modes
+
+ do lphase = 1, 2 ! loop over interstitial (1) and cloud-borne (2) forms
+
+ ! sol_factb and sol_facti values
+ ! sol_factb - currently this is basically a tuning factor
+ ! sol_facti & sol_factic - currently has a physical basis, and reflects activation fraction
+ !
+ ! 2008-mar-07 rce - sol_factb (interstitial) changed from 0.3 to 0.1
+ ! - sol_factic (interstitial, dust modes) changed from 1.0 to 0.5
+ ! - sol_factic (cloud-borne, pcarb modes) no need to set it to 0.0
+ ! because the cloud-borne pcarbon == 0 (no activation)
+ !
+ ! rce 2010/05/02
+ ! prior to this date, sol_factic was used for convective in-cloud wet removal,
+ ! and its value reflected a combination of an activation fraction (which varied between modes)
+ ! and a tuning factor
+ ! from this date forward, two parameters are used for convective in-cloud wet removal
+ ! f_act_conv is the activation fraction
+ ! note that "non-activation" of aerosol in air entrained into updrafts should
+ ! be included here
+ ! eventually we might use the activate routine (with w ~= 1 m/s) to calculate
+ ! this, but there is still the entrainment issue
+ ! sol_factic is strictly a tuning factor
+ !
+ if (lphase == 1) then ! interstial aerosol
+ !hygro_sum_old(:,:) = 0.0_r8
+ !hygro_sum_del(:,:) = 0.0_r8
+ !call modal_aero_bcscavcoef_get( m, ncol, isprx, dgncur_awet, &
+ ! scavcoefnv(:,:,1), scavcoefnv(:,:,2) )
+
+ scavcoefnv(:,:,1) = 0.1_r8 !Used by MAM for number concentration
+
+ sol_factb = 0.1_r8 ! all below-cloud scav ON (0.1 "tuning factor")
+! sol_factb = 0.03_r8 ! all below-cloud scav ON (0.1 "tuning factor") ! tuned 1/6
+
+ sol_facti = 0.0_r8 ! strat in-cloud scav totally OFF for institial
+
+ sol_factic = 0.4_r8 ! xl 2010/05/20
+
+ !fxm: simplified relative to MAM
+ f_act_conv = 0.8 !ag: Introduce tuning per component later
+
+
+ else ! cloud-borne aerosol (borne by stratiform cloud drops)
+
+ !++ag
+ !default 100 % is scavenged by cloud -borne
+ sol_facti_cloud_borne = 1.0_r8
+ !--ag
+
+ sol_factb = 0.0_r8 ! all below-cloud scav OFF (anything cloud-borne is located "in-cloud")
+ sol_facti = sol_facti_cloud_borne ! strat in-cloud scav cloud-borne tuning factor
+ sol_factic = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean
+ ! that conv precip collects strat droplets)
+ f_act_conv = 0.0_r8 ! conv in-cloud scav OFF (having this on would mean
+
+ end if
+ if (convproc_do_aer .and. lphase == 1) then
+ ! if modal aero convproc is turned on for aerosols, then
+ ! turn off the convective in-cloud removal for interstitial aerosols
+ ! (but leave the below-cloud on, as convproc only does in-cloud)
+ ! and turn off the outfld SFWET, SFSIC, SFSID, SFSEC, and SFSED calls
+ ! for (stratiform)-cloudborne aerosols, convective wet removal
+ ! (all forms) is zero, so no action is needed
+ sol_factic = 0.0_r8
+ endif
+
+
+ do lspec = 1,getNumberOfTracersInMode(m) ! loop over number + chem constituents + water
+
+
+ mm = getTracerIndex(m,lspec,.false.)
+ if(is_done(mm,lphase) .eqv. .true. )then
+ cycle
+ endif
+ is_done(mm,lphase)=.true.
+
+ if (lphase == 1) then
+ jnv = 2
+ !Set correct below cloud scaveing coefficients
+ !Hard-coded values per mode in NorESM
+ if(is_process_mode(mm,.FALSE.))then
+ scavcoefnv(:,:,jnv) = belowCloudScavengingCoefficientProcessModes(processModeMap(mm))
+ else
+ scavcoefnv(:,:,jnv) = belowCloudScavengingCoefficient(m)
+ end if
+ else
+ jnv = 0 !==> below cloud scavenging coefficients are zero (see above)
+ endif
+
+
+
+ if ((lphase == 1) .and. (lspec <= getNumberOfTracersInMode(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) then
+ !Feed in the saved cloudborne mixing ratios from phase 2
+ qqcw_in(:,:) = qqcw_sav(:,:,mm)
+ !Not implemented for oslo aerosols
+ else
+ fldcw => qqcw_get_field(pbuf, mm,lchnk, .TRUE.)
+ if(.not. associated(fldcw))then
+ qqcw_in(:,:) = zeroAerosolConcentration(:,:)
+ else
+ qqcw_in(:,:) = fldcw(:,:)
+ end if
+ endif
+
+ call wetdepa_v2( state%pmid, state%q(:,:,1), state%pdel, &
+ dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, &
+ dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, &
+ dep_inputs%evapr, dep_inputs%totcond, q_tmp, dt, &
+ dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, &
+ dlf, fracis(:,:,mm), sol_factb, ncol, &
+ scavcoefnv(:,:,jnv), &
+ is_strat_cloudborne=.false., &
+ qqcw=qqcw_in(:,:), &
+ f_act_conv=f_act_conv, &
+ icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, &
+ convproc_do_aer=.false., rcscavt=rcscavt, rsscavt=rsscavt, &
+ sol_facti_in=sol_facti, sol_factic_in=sol_factic )
+
+ ptend%q(1:ncol,:,mm) = ptend%q(1:ncol,:,mm) + dqdt_tmp(1:ncol,:)
+
+ call outfld( trim(cnst_name(mm))//'WET', dqdt_tmp(:,:), pcols, lchnk)
+ call outfld( trim(cnst_name(mm))//'SIC', icscavt, pcols, lchnk)
+ call outfld( trim(cnst_name(mm))//'SIS', isscavt, pcols, lchnk)
+ call outfld( trim(cnst_name(mm))//'SBC', bcscavt, pcols, lchnk)
+ call outfld( trim(cnst_name(mm))//'SBS', bsscavt, pcols, lchnk)
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ if (.not.convproc_do_aer) call outfld( trim(cnst_name(mm))//'SFWET', sflx, pcols, lchnk)
+ aerdepwetis(:ncol,mm) = sflx(:ncol)
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ if (.not.convproc_do_aer) call outfld( trim(cnst_name(mm))//'SFSIC', sflx, pcols, lchnk)
+ if (convproc_do_aer) sflxic = sflx
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(cnst_name(mm))//'SFSIS', sflx, pcols, lchnk)
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(cnst_name(mm))//'SFSBC', sflx, pcols, lchnk)
+ if (convproc_do_aer)sflxbc = sflx
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(cnst_name(mm))//'SFSBS', sflx, pcols, lchnk)
+
+
+
+
+ else ! lphase == 2
+ dqdt_tmp(:,:) = 0.0_r8
+ qqcw_tmp(:,:) = 0.0_r8 ! rce 2010/05/01
+
+ if (convproc_do_aer) then
+ fldcw => qqcw_get_field(pbuf,mm,lchnk)
+ qqcw_sav(1:ncol,:,mm) = fldcw(1:ncol,:)
+ !This option yet not implemented for OSLO_AERO
+ else
+ fldcw => qqcw_get_field(pbuf, mm,lchnk, .TRUE.)
+ if(.not. associated(fldcw))then
+ cycle
+ end if
+ endif
+
+ call wetdepa_v2(state%pmid, state%q(:,:,1), state%pdel, &
+ dep_inputs%cldt, dep_inputs%cldcu, dep_inputs%cmfdqr, &
+ dep_inputs%evapc, dep_inputs%conicw, dep_inputs%prain, dep_inputs%qme, &
+ dep_inputs%evapr, dep_inputs%totcond, fldcw, dt, &
+ dqdt_tmp, iscavt, dep_inputs%cldvcu, dep_inputs%cldvst, &
+ dlf, fracis_cw, sol_factb, ncol, &
+ scavcoefnv(:,:,jnv), &
+ is_strat_cloudborne=.true., &
+ icscavt=icscavt, isscavt=isscavt, bcscavt=bcscavt, bsscavt=bsscavt, &
+ convproc_do_aer=.false., rcscavt=rcscavt, rsscavt=rsscavt, &
+ sol_facti_in=sol_facti, sol_factic_in=sol_factic )
+
+ fldcw(1:ncol,:) = fldcw(1:ncol,:) + dqdt_tmp(1:ncol,:) * dt
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+dqdt_tmp(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(getCloudTracerName(mm))//'SFWET', sflx, pcols, lchnk)
+ aerdepwetcw(:ncol,mm) = sflx(:ncol)
+
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+icscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(getCloudTracerName(mm))//'SFSIC', sflx, pcols, lchnk)
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+isscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(getCloudTracerName(mm))//'SFSIS', sflx, pcols, lchnk)
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+bcscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(getCloudTracerName(mm))//'SFSBC', sflx, pcols, lchnk)
+ sflx(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ sflx(i)=sflx(i)+bsscavt(i,k)*state%pdel(i,k)/gravit
+ enddo
+ enddo
+ call outfld( trim(getCloudTracerName(mm))//'SFSBS', sflx, pcols, lchnk)
+
+ endif
+
+ enddo ! lspec = 0, nspec_amode(m)+1
+ enddo ! lphase = 1, 2
+ enddo ! m = 1, ntot_amode
+
+ ! if the user has specified prescribed aerosol dep fluxes then
+ ! do not set cam_out dep fluxes according to the prognostic aerosols
+ if (.not. aerodep_flx_prescribed()) then
+ call set_srf_wetdep(aerdepwetis, aerdepwetcw, cam_out)
+ endif
+
+ return
+
+ end subroutine oslo_aero_wet_intr
+
+
+
+ !===============================================================================
+ subroutine modal_aero_depvel_part( ncol, t, pmid, ram1, fv, vlc_dry, vlc_trb, vlc_grv, &
+ radius_part, density_part, sig_part, moment, lchnk )
+
+! calculates surface deposition velocity of particles
+! L. Zhang, S. Gong, J. Padro, and L. Barrie
+! A size-seggregated particle dry deposition scheme for an atmospheric aerosol module
+! Atmospheric Environment, 35, 549-560, 2001.
+!
+! Authors: X. Liu
+
+ !
+ ! !USES
+ !
+ use physconst, only: pi,boltz, gravit, rair
+ use mo_drydep, only: n_land_type, fraction_landuse
+
+ ! !ARGUMENTS:
+ !
+ implicit none
+ !
+ real(r8), intent(in) :: t(pcols,pver) !atm temperature (K)
+ real(r8), intent(in) :: pmid(pcols,pver) !atm pressure (Pa)
+ real(r8), intent(in) :: fv(pcols) !friction velocity (m/s)
+ real(r8), intent(in) :: ram1(pcols) !aerodynamical resistance (s/m)
+ real(r8), intent(in) :: radius_part(pcols,pver) ! mean (volume/number) particle radius (m)
+ real(r8), intent(in) :: density_part(pcols,pver) ! density of particle material (kg/m3)
+ real(r8), intent(in) :: sig_part(pcols,pver) ! geometric standard deviation of particles
+ integer, intent(in) :: moment ! moment of size distribution (0 for number, 2 for surface area, 3 for volume)
+ integer, intent(in) :: ncol
+ integer, intent(in) :: lchnk
+
+ real(r8), intent(out) :: vlc_trb(pcols) !Turbulent deposn velocity (m/s)
+ real(r8), intent(out) :: vlc_grv(pcols,pver) !grav deposn velocity (m/s)
+ real(r8), intent(out) :: vlc_dry(pcols,pver) !dry deposn velocity (m/s)
+ !------------------------------------------------------------------------
+
+ !------------------------------------------------------------------------
+ ! Local Variables
+ integer :: m,i,k,ix !indices
+ real(r8) :: rho !atm density (kg/m**3)
+ real(r8) :: vsc_dyn_atm(pcols,pver) ![kg m-1 s-1] Dynamic viscosity of air
+ real(r8) :: vsc_knm_atm(pcols,pver) ![m2 s-1] Kinematic viscosity of atmosphere
+ real(r8) :: shm_nbr ![frc] Schmidt number
+ real(r8) :: stk_nbr ![frc] Stokes number
+ real(r8) :: mfp_atm(pcols,pver) ![m] Mean free path of air
+ real(r8) :: dff_aer ![m2 s-1] Brownian diffusivity of particle
+ real(r8) :: slp_crc(pcols,pver) ![frc] Slip correction factor
+ real(r8) :: rss_trb ![s m-1] Resistance to turbulent deposition
+ real(r8) :: rss_lmn ![s m-1] Quasi-laminar layer resistance
+ real(r8) :: brownian ! collection efficiency for Browning diffusion
+ real(r8) :: impaction ! collection efficiency for impaction
+ real(r8) :: interception ! collection efficiency for interception
+ real(r8) :: stickfrac ! fraction of particles sticking to surface
+ real(r8) :: radius_moment(pcols,pver) ! median radius (m) for moment
+ real(r8) :: lnsig ! ln(sig_part)
+ real(r8) :: dispersion ! accounts for influence of size dist dispersion on bulk settling velocity
+ ! assuming radius_part is number mode radius * exp(1.5 ln(sigma))
+
+ integer :: lt
+ real(r8) :: lnd_frc
+ real(r8) :: wrk1, wrk2, wrk3
+
+ ! constants
+ real(r8) gamma(11) ! exponent of schmidt number
+! data gamma/0.54d+00, 0.56d+00, 0.57d+00, 0.54d+00, 0.54d+00, &
+! 0.56d+00, 0.54d+00, 0.54d+00, 0.54d+00, 0.56d+00, &
+! 0.50d+00/
+ data gamma/0.56e+00_r8, 0.54e+00_r8, 0.54e+00_r8, 0.56e+00_r8, 0.56e+00_r8, &
+ 0.56e+00_r8, 0.50e+00_r8, 0.54e+00_r8, 0.54e+00_r8, 0.54e+00_r8, &
+ 0.54e+00_r8/
+ save gamma
+
+ real(r8) alpha(11) ! parameter for impaction
+! data alpha/50.00d+00, 0.95d+00, 0.80d+00, 1.20d+00, 1.30d+00, &
+! 0.80d+00, 50.00d+00, 50.00d+00, 2.00d+00, 1.50d+00, &
+! 100.00d+00/
+ data alpha/1.50e+00_r8, 1.20e+00_r8, 1.20e+00_r8, 0.80e+00_r8, 1.00e+00_r8, &
+ 0.80e+00_r8, 100.00e+00_r8, 50.00e+00_r8, 2.00e+00_r8, 1.20e+00_r8, &
+ 50.00e+00_r8/
+ save alpha
+
+ real(r8) radius_collector(11) ! radius (m) of surface collectors
+! data radius_collector/-1.00d+00, 5.10d-03, 3.50d-03, 3.20d-03, 10.00d-03, &
+! 5.00d-03, -1.00d+00, -1.00d+00, 10.00d-03, 10.00d-03, &
+! -1.00d+00/
+ data radius_collector/10.00e-03_r8, 3.50e-03_r8, 3.50e-03_r8, 5.10e-03_r8, 2.00e-03_r8, &
+ 5.00e-03_r8, -1.00e+00_r8, -1.00e+00_r8, 10.00e-03_r8, 3.50e-03_r8, &
+ -1.00e+00_r8/
+ save radius_collector
+
+ integer :: iwet(11) ! flag for wet surface = 1, otherwise = -1
+! data iwet/1, -1, -1, -1, -1, &
+! -1, -1, -1, 1, -1, &
+! 1/
+ data iwet/-1, -1, -1, -1, -1, &
+ -1, 1, -1, 1, -1, &
+ -1/
+ save iwet
+
+
+ !------------------------------------------------------------------------
+
+ if(top_lev.gt.1) then
+ vlc_grv(:ncol,:top_lev-1) = 0._r8
+ vlc_dry(:ncol,:top_lev-1) = 0._r8
+ endif
+
+ do k=top_lev,pver
+ do i=1,ncol
+
+ lnsig = log(sig_part(i,k))
+! use a maximum radius of 50 microns when calculating deposition velocity
+ radius_moment(i,k) = min(50.0e-6_r8,radius_part(i,k))* &
+ exp((float(moment)-1.5_r8)*lnsig*lnsig)
+ dispersion = exp(2._r8*lnsig*lnsig)
+
+ rho=pmid(i,k)/rair/t(i,k)
+
+ ! Quasi-laminar layer resistance: call rss_lmn_get
+ ! Size-independent thermokinetic properties
+ vsc_dyn_atm(i,k) = 1.72e-5_r8 * ((t(i,k)/273.0_r8)**1.5_r8) * 393.0_r8 / &
+ (t(i,k)+120.0_r8) ![kg m-1 s-1] RoY94 p. 102
+ mfp_atm(i,k) = 2.0_r8 * vsc_dyn_atm(i,k) / & ![m] SeP97 p. 455
+ (pmid(i,k)*sqrt(8.0_r8/(pi*rair*t(i,k))))
+ vsc_knm_atm(i,k) = vsc_dyn_atm(i,k) / rho ![m2 s-1] Kinematic viscosity of air
+
+ slp_crc(i,k) = 1.0_r8 + mfp_atm(i,k) * &
+ (1.257_r8+0.4_r8*exp(-1.1_r8*radius_moment(i,k)/(mfp_atm(i,k)))) / &
+ radius_moment(i,k) ![frc] Slip correction factor SeP97 p. 464
+ vlc_grv(i,k) = (4.0_r8/18.0_r8) * radius_moment(i,k)*radius_moment(i,k)*density_part(i,k)* &
+ gravit*slp_crc(i,k) / vsc_dyn_atm(i,k) ![m s-1] Stokes' settling velocity SeP97 p. 466
+ vlc_grv(i,k) = vlc_grv(i,k) * dispersion
+
+ vlc_dry(i,k)=vlc_grv(i,k)
+ enddo
+ enddo
+ k=pver ! only look at bottom level for next part
+ do i=1,ncol
+ dff_aer = boltz * t(i,k) * slp_crc(i,k) / & ![m2 s-1]
+ (6.0_r8*pi*vsc_dyn_atm(i,k)*radius_moment(i,k)) !SeP97 p.474
+ shm_nbr = vsc_knm_atm(i,k) / dff_aer ![frc] SeP97 p.972
+
+ wrk2 = 0._r8
+ wrk3 = 0._r8
+ do lt = 1,n_land_type
+ lnd_frc = fraction_landuse(i,lt,lchnk)
+ if ( lnd_frc /= 0._r8 ) then
+ brownian = shm_nbr**(-gamma(lt))
+ if (radius_collector(lt) > 0.0_r8) then
+! vegetated surface
+ stk_nbr = vlc_grv(i,k) * fv(i) / (gravit*radius_collector(lt))
+ interception = 2.0_r8*(radius_moment(i,k)/radius_collector(lt))**2.0_r8
+ else
+! non-vegetated surface
+ stk_nbr = vlc_grv(i,k) * fv(i) * fv(i) / (gravit*vsc_knm_atm(i,k)) ![frc] SeP97 p.965
+ interception = 0.0_r8
+ endif
+ impaction = (stk_nbr/(alpha(lt)+stk_nbr))**2.0_r8
+
+ if (iwet(lt) > 0) then
+ stickfrac = 1.0_r8
+ else
+ stickfrac = exp(-sqrt(stk_nbr))
+ if (stickfrac < 1.0e-10_r8) stickfrac = 1.0e-10_r8
+ endif
+ rss_lmn = 1.0_r8 / (3.0_r8 * fv(i) * stickfrac * (brownian+interception+impaction))
+ rss_trb = ram1(i) + rss_lmn + ram1(i)*rss_lmn*vlc_grv(i,k)
+
+ wrk1 = 1.0_r8 / rss_trb
+ wrk2 = wrk2 + lnd_frc*( wrk1 )
+ wrk3 = wrk3 + lnd_frc*( wrk1 + vlc_grv(i,k) )
+ endif
+ enddo ! n_land_type
+ vlc_trb(i) = wrk2
+ vlc_dry(i,k) = wrk3
+ enddo !ncol
+
+ return
+ end subroutine modal_aero_depvel_part
+
+ !===============================================================================
+
+
+
+end module oslo_aerosols_intr
diff --git a/src/chemistry/oslo_aero/oslo_ocean_intr.F90 b/src/chemistry/oslo_aero/oslo_ocean_intr.F90
new file mode 100644
index 0000000000..c934313700
--- /dev/null
+++ b/src/chemistry/oslo_aero/oslo_ocean_intr.F90
@@ -0,0 +1,429 @@
+!-------------------------------------------------------------------
+! Marine DMS and POM emissions module
+! Documentation: Implementation of interactive DMS and marine organic
+! emission schemes in NorESM2, Lewinschal, 2015
+! Manages reading and interpolation of ocean tracer concentrations from file
+! and calculates DMS and marine POM emissions.
+! Parameterisations available:
+! Nightingale et al. Global biogeochemical cycles 2000 (DMS)
+! Nilsson, unpublished (POM)
+! O'Dowd et al. GRL 2008 (POM)
+! Based on prescribed_volcaero created by Francis Vitt and mo_srf_emissions
+!-------------------------------------------------------------------
+module oslo_ocean_intr
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use cam_abortutils, only : endrun
+ use spmd_utils, only : masterproc
+ use tracer_data, only : trfld, trfile
+ use cam_logfile, only : iulog
+ use ppgrid, only : pcols, pver,pverp
+ use camsrfexch, only : cam_in_t !, cam_out_t ?
+
+ implicit none
+
+
+
+! new type for ocean species
+
+ type :: oceanspc
+! integer :: spc_ndx ! could be added for selective reading
+ character(len=16) :: species(1) ! Species name
+! character(len=8) :: units ! could be added for units check
+ type(trfld), pointer :: fields(:) ! where the data ends up fields%data
+ type(trfile) :: file
+ end type oceanspc
+
+
+!-------------------------------------------------------------------------------------
+
+
+
+! List of subroutines that can be accesed from outside module
+
+ public :: oslo_ocean_getnl ! should this be public. Only used locally...
+ public :: oslo_ocean_init ! initializing, reading file
+ public :: oslo_ocean_time ! time interpolation
+ public :: oslo_dms_emis_intr ! calculate dms surface emissions
+ public :: oslo_dms_inq ! logical function which tells mo_srf_emis what to do
+ public :: oslo_opom_emis_intr ! calculate opom surface emissions
+ public :: oslo_opom_inq ! logical function which tells oslo_salt what to do
+
+
+
+ private
+ save
+
+ type(oceanspc), allocatable :: oceanspcs(:)
+
+
+
+
+
+! These variables are settable via the namelist (with longer names)
+! For reading concentration file
+ character(len=16) :: dmsl_fld_name = 'dms' !not set from namelist, hard coded, name of nc var
+ character(len=16) :: dmsk_fld_name = 'dms_Kettle' !not set from namelist, hard coded, name of nc var
+ character(len=16) :: opomo_fld_name = 'chlor_a' !not set from namelist, hard coded, name of nc var
+ character(len=16) :: opomn_fld_name = 'poc' !not set from namelist, hard coded, name of nc var
+ character(len=256) :: filename = '' !will be collected from NAMELIST
+ character(len=256) :: filelist = '' !not needed?
+ character(len=256) :: datapath = '' !will be collected from NAMELIST
+ character(len=32) :: dms_data_type = 'CYCLICAL' !will be collected from NAMELIST
+ character(len=32) :: opom_data_type= 'CYCLICAL' !will be collected from NAMELIST
+ logical :: rmv_file = .false. !delete file when finished with it
+ integer :: dms_cycle_yr = 0 !will be collected from NAMELIST
+ integer :: opom_cycle_yr = 0 !will be collected from NAMELIST
+ integer :: fixed_ymd = 0 !running one date only?
+ integer :: fixed_tod = 0 !running one time of day only?
+
+ character(len=20) :: dms_source = 'emission_file' !will be collected from NAMELIST
+ character(len=20) :: opom_source = 'no_file' !will be collected from NAMELIST
+ integer :: n_ocean_species !Number of variables read from ocean file
+ integer :: pndx_fdms !DMS surface flux physics index
+
+contains
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+subroutine oslo_ocean_getnl()
+! Read namelist variables. For oslo namelist variables this is done through oslo_getopts
+
+ use oslo_control, only: oslo_getopts
+
+ implicit none
+
+ ! declaration of variables collected from namelist
+ character(len=256) :: in_filename
+ character(len=256) :: in_datapath
+ character(len=20) :: in_dms_data_source
+ character(len=32) :: in_dms_data_type
+ integer :: in_dms_cycle_yr
+ character(len=20) :: in_opom_data_source
+ character(len=32) :: in_opom_data_type
+ integer :: in_opom_cycle_yr
+
+
+ ! Initialize namelist variables from local module variables.
+ in_filename = filename
+ in_datapath = datapath
+ in_dms_data_type = dms_data_type
+ in_dms_cycle_yr = dms_cycle_yr
+ in_dms_data_source = dms_source
+ in_opom_data_type = opom_data_type
+ in_opom_cycle_yr = opom_cycle_yr
+ in_opom_data_source = opom_source
+
+ ! Read namelist.
+ call oslo_getopts(dms_source_out = in_dms_data_source, &
+ dms_source_type_out = in_dms_data_type, &
+ dms_cycle_year_out = in_dms_cycle_yr, &
+ opom_source_out = in_opom_data_source, &
+ opom_source_type_out= in_opom_data_type, &
+ opom_cycle_year_out = in_opom_cycle_yr, &
+ ocean_filename_out = in_filename, &
+ ocean_filepath_out = in_datapath)
+
+
+ ! Update module variables with user settings.
+ filename = in_filename
+ datapath = in_datapath
+ dms_data_type = in_dms_data_type
+ dms_cycle_yr = in_dms_cycle_yr
+ dms_source = in_dms_data_source
+ opom_data_type= in_opom_data_type
+ opom_cycle_yr = in_opom_cycle_yr
+ opom_source = in_opom_data_source
+
+ ! Write new value set from namelist to log
+! write(iulog,*)"test pom namelist 2: " // trim(opom_source)
+
+endsubroutine oslo_ocean_getnl
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+subroutine oslo_ocean_init()
+! no in parameters all information is local
+
+ use tracer_data, only : trcdata_init
+ use constituents, only : cnst_get_ind
+ use cam_history, only : addfld, add_default, horiz_only
+
+ implicit none
+
+ integer :: astat
+ integer :: m
+ integer :: cycle_yr(2)
+ character(len=32) :: data_type(2)
+ character(len=16) :: emis_species(2)
+
+ ! Collect and save namelist information in module
+ call oslo_ocean_getnl()
+
+ !get physics index for dms surface flux. Index for cflx
+ call cnst_get_ind('DMS', pndx_fdms, abort=.true.)
+
+! write(iulog,*)"test dms p index: " ,pndx_fdms
+
+ if (dms_source=='lana')then
+ emis_species(1) = dmsl_fld_name
+ else
+ emis_species(1) = dmsk_fld_name
+ endif
+ if (opom_source=='odowd')then
+ emis_species(2) = opomo_fld_name
+ else
+ emis_species(2) = opomn_fld_name
+ endif
+ cycle_yr(1)= dms_cycle_yr
+ cycle_yr(2)= opom_cycle_yr
+ data_type(1) = dms_data_type
+ data_type(2) = opom_data_type
+ n_ocean_species = 2
+
+ if (masterproc) write(iulog,*) 'oslo_dms_inti: n_ocean_species = ',n_ocean_species
+
+ allocate( oceanspcs(n_ocean_species), stat=astat )
+ if( astat/= 0 ) then
+ write(iulog,*) 'oslo_dms_inti: failed to allocate oceanspcs array; error = ',astat
+ call endrun
+ end if
+
+
+ !-----------------------------------------------------------------------
+ ! ... setup the oceanspcs type array
+ !-----------------------------------------------------------------------
+! Add support for selective reading with saved units etc.?
+ do m=1,n_ocean_species ! one for now... start with dms
+! oceanspcs(m)%spc_ndx = emis_indexes(m) ! physics index
+! oceanspcs(m)%units = 'nmol/L'
+ oceanspcs(m)%species = emis_species(m) ! nc var name
+
+ enddo
+
+ do m=1,n_ocean_species
+
+ ! Ocean concentrations are not stored in pbuf
+ allocate(oceanspcs(m)%file%in_pbuf(1))
+ oceanspcs(m)%file%in_pbuf(:) = .false.
+
+ call trcdata_init( oceanspcs(m)%species, &
+ filename, filelist, datapath, &
+ oceanspcs(m)%fields, &
+ oceanspcs(m)%file, &
+ rmv_file, cycle_yr(m), fixed_ymd, fixed_tod, data_type(m) )
+
+ enddo
+! write(iulog,*) 'oslo_ocean_init: read file '
+
+ call addfld( 'odms', horiz_only, 'A', 'nmol/L', 'DMS upper ocean concentration' )
+
+ call add_default('odms', 1, ' ')
+
+endsubroutine oslo_ocean_init
+!------------------------------------------------------------------------------------------
+!------------------------------------------------------------------------------------------
+subroutine oslo_ocean_time(state, pbuf2d)
+
+ use physics_types, only : physics_state
+ use ppgrid, only : begchunk, endchunk
+ use tracer_data, only : advance_trcdata
+ use physics_buffer, only : physics_buffer_desc
+
+ implicit none
+
+ type(physics_state), intent(in) :: state(begchunk:endchunk)
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ !-----------------------------------------------------------------------
+ ! ... local variables
+ !-----------------------------------------------------------------------
+ integer :: m
+
+ do m = 1,n_ocean_species
+
+ call advance_trcdata( oceanspcs(m)%fields, oceanspcs(m)%file, state, pbuf2d )
+ end do
+
+
+endsubroutine oslo_ocean_time
+
+!------------------------------------------------------------------------------------------
+!------------------------------------------------------------------------------------------
+
+subroutine oslo_dms_emis_intr(state, cam_in)
+
+ use physics_types, only: physics_state
+ use constituents, only: cnst_mw !molecular weight for physics constituents
+ use cam_history, only: outfld
+
+ type(physics_state), intent(in) :: state ! Physics state variables
+ type(cam_in_t), target, intent(inout) :: cam_in ! import state
+
+
+ real(r8), dimension(pcols) :: u10m ![m/s]
+ real(r8), pointer :: ocnfrc(:) ![frc] ocean fraction
+ real(r8), pointer :: icefrc(:) ![frc] ice fraction
+ integer :: ncol ![nbr] number of columns in use
+ integer :: lchnk ! chunk index
+
+ real(r8) :: rk600(pcols) ! ocean/atmos. DMS exchange factor [cm/hr]
+ real(r8) :: flux(pcols) ! Local flux array: DMS emission rate [kg m-2 s-1]
+ real(r8) :: odms(pcols) ! Ocean dms concentration [nmol/L] from file
+ real(r8) :: open_ocn(pcols) ! Open Ocean
+
+ real(r8), dimension(pcols):: t,scdms,kwdms
+
+ real(r8), parameter :: z0= 0.0001_r8 ![m] roughness length over ocean
+ real(r8), parameter :: Xconvxa= 6.97e-07 ! Wanninkhof's a=0.251 converted to ms-1/(ms-1)^2
+
+ logical, parameter :: method_oslo =.false.
+ logical, parameter :: method_hamocc=.true.
+
+ !pointers to land model variables
+ ocnfrc => cam_in%ocnfrac
+ icefrc => cam_in%icefrac
+ ncol = state%ncol
+ lchnk = state%lchnk
+
+ ! IF CONCENTRATION FILE
+ if (dms_source=='lana' .or. dms_source=='kettle') then
+
+ ! collect dms data from file
+ flux(:) = 0._r8
+ odms(:) = 0._r8
+ odms(:ncol) = oceanspcs(1)%fields(1)%data(:ncol,1,lchnk)
+
+ ! open ocean
+ open_ocn(:ncol) = ocnfrc(:ncol) * (1._r8-icefrc(:ncol))
+ !start with midpoint wind speed
+ u10m(:ncol)=sqrt(state%u(:ncol,pver)**2+state%v(:ncol,pver)**2)
+
+ if (method_oslo) then
+ ! move the winds to 10m high from the midpoint of the gridbox:
+ u10m (:ncol) = u10m(:ncol)*log(10._r8/z0)/log(state%zm(:ncol,pver)/z0)
+ rk600(:ncol) = (0.222_r8*(u10m(:ncol)*u10m(:ncol))) + (0.333_r8*u10m(:ncol)) ! [cm/hr]
+ flux (:ncol) = 2.778e-15*cnst_mw(pndx_fdms)*rk600(:ncol)*open_ocn(:ncol)*odms(:ncol) ! [kg m-2 s-1]
+ else if (method_hamocc) then
+ t(:ncol)=cam_in%sst(:ncol)-273.15_r8
+ u10m (:ncol) = u10m(:ncol)*log(10._r8/z0)/log(state%zm(:ncol,pver)/z0)
+ scdms(:ncol) = 2855.7+ (-177.63 + (6.0438 + (-0.11645 + 0.00094743*t(:ncol))*t(:ncol))*t(:ncol))*t(:ncol)
+ kwdms(:ncol) = open_ocn(:ncol) * Xconvxa *u10m(:ncol)**2*(660./scdms(:ncol))**0.5
+ flux (:ncol) = 62.13*kwdms(:ncol)*1e-9*odms(:ncol)
+ endif
+ cam_in%cflx(:ncol, pndx_fdms ) = flux(:ncol)
+
+ call outfld('odms', odms(:ncol), ncol, lchnk)
+
+ ! IF OCEAN FLUX
+ elseif(dms_source=='ocean_flux') then
+ cam_in%cflx(:ncol, pndx_fdms) = cam_in%fdms(:ncol)
+ endif
+
+ ! IF EMISSION FILE
+ ! return without changing cflx
+ ! return?
+
+endsubroutine oslo_dms_emis_intr
+!------------------------------------------------------------------------------------------
+!------------------------------------------------------------------------------------------
+
+subroutine oslo_opom_emis_intr(em_ss1,em_ss2,em_ss3,open_ocn,ncol,lchnk, opomem_out)
+
+
+
+ integer , intent(in) :: ncol ![nbr] number of columns in use
+ integer , intent(in) :: lchnk !current chunk
+ real(r8), intent(in) :: em_ss1(pcols) !sea salt emission mode a1
+ real(r8), intent(in) :: em_ss2(pcols) !sea salt emission mode a2
+ real(r8), intent(in) :: em_ss3(pcols) !sea salt emission mode a3
+ real(r8), intent(in) :: open_ocn(pcols) !open ocean
+ real(r8), intent(out) :: opomem_out(pcols) !ocean POM emission rate [kg m-2 s-1]
+! integer :: lchnk ! chunk index
+
+ real(r8) :: flux(ncol) ! Local flux array: ocean POM emission rate [kg m-2 s-1]
+
+ ! Variables for Nilsson parameterisation
+ real(r8) :: opoc(ncol) ! Ocean POC concentration [mg m-3]
+! real(r8), parameter :: c_n = 0.000288657_r8 ! OM tuning constant (NorESM1 value)
+ real(r8), parameter :: c_n = 0.000507456_r8 ! OM tuning constant (Tuned for NorESM2)
+ real(r8), parameter :: c_a1 = 2.06_r8 ! OM fraction in a1 mode
+ real(r8), parameter :: c_a2 = 0.355_r8 ! OM fraction in a2 mode
+ real(r8), parameter :: c_a3 = 0.0623_r8 ! OM fraction in a3 mode
+
+ ! Variables for O'Dowd parameterisation
+ real(r8) :: omFrac(ncol) ! OM fraction of total seaspray mass
+ real(r8) :: ochlor(ncol) ! Ocean chlorophyll concentration [nmol/L]
+ real(r8),parameter :: c_o = 0.5238_r8 ! Arbritraty scaling factor to make the emissions match Spracklen.
+ ! Not consistent with the parameterisation of O'Dowd. Set to 1
+ ! for original parameterisation.
+
+
+
+
+ ! Nilsson parameterisation
+ if (opom_source=='nilsson') then
+
+ ! collect POC data from file
+ flux(:) = 0._r8
+ opoc(:) = 0._r8
+
+ opoc(:ncol) = oceanspcs(2)%fields(1)%data(:ncol,1,lchnk)
+
+ flux(:ncol) = c_n*open_ocn(:ncol)*opoc(:ncol)* &
+ (c_a1*em_ss1(:ncol)+c_a2*em_ss2(:ncol)+c_a3*em_ss3(:ncol))
+
+ opomem_out(:ncol) = flux(:ncol)
+
+
+ ! O'Dowd parameterisation
+ elseif (opom_source=='odowd') then
+
+ ! collect dms data from file
+ flux(:) = 0._r8
+ ochlor(:) = 0._r8
+
+ ochlor(:ncol) = oceanspcs(2)%fields(1)%data(:ncol,1,lchnk)
+ ! OM fraction saturates at 90% according to O'Dowd 2008
+ omFrac(:ncol) = min(0.01_r8*(43.5_r8 * ochlor(:ncol) + 13.805_r8),0.76_r8)
+ omFrac(:ncol) = omFrac(:ncol) / (1._r8 - omFrac(:ncol))
+ flux(:ncol) = c_o*omFrac(:ncol) * em_ss1(:ncol)
+ opomem_out(:ncol) = flux(:ncol)
+ endif
+
+ ! return?
+
+endsubroutine oslo_opom_emis_intr
+!------------------------------------------------------------------------------------------
+!------------------------------------------------------------------------------------------
+
+logical function oslo_dms_inq()
+ implicit none
+
+ if (dms_source=='emission_file') then
+ oslo_dms_inq = .true.
+ else
+ oslo_dms_inq = .false.
+ endif
+ return
+
+end function oslo_dms_inq
+
+
+!------------------------------------------------------------------------------------------
+!------------------------------------------------------------------------------------------
+
+logical function oslo_opom_inq()
+ implicit none
+
+ if (opom_source=='nilsson' .or. opom_source=='odowd') then
+ oslo_opom_inq = .true.
+ else
+ oslo_opom_inq = .false.
+ endif
+ return
+
+end function oslo_opom_inq
+
+!------------------------------------------------------------------------------------------
+!------------------------------------------------------------------------------------------
+
+end module oslo_ocean_intr
diff --git a/src/chemistry/oslo_aero/oslo_utils.F90 b/src/chemistry/oslo_aero/oslo_utils.F90
new file mode 100644
index 0000000000..592f0eb6e5
--- /dev/null
+++ b/src/chemistry/oslo_aero/oslo_utils.F90
@@ -0,0 +1,179 @@
+module oslo_utils
+
+ use ppgrid, only : pcols, pver
+ use shr_kind_mod, only: r8 => shr_kind_r8
+! use commondefinitions, only: nmodes, nbmodes
+ use commondefinitions
+! use aerosoldef, only: nmodes, getDryDensity, &
+! getNumberOfBackgroundTracersInMode &
+! ,getTracerIndex, originalNumberMedianRadius
+ use aerosoldef, only: getDryDensity, &
+ getNumberOfBackgroundTracersInMode &
+ ,getTracerIndex
+ use const, only : volumeToNumber, rbinMidPoint, rbinEdge, nBinsTab
+ use physconst, only : pi
+ use constituents, only: pcnst
+
+contains
+
+ subroutine calculateNumberConcentration(ncol, q, rho_air, numberConcentration)
+ implicit none
+ integer, intent(in) :: ncol !number of columns used
+ real(r8), intent(in) :: q(pcols,pver,pcnst) ![kg/kg] mass mixing ratios
+ real(r8), intent(in) :: rho_air(pcols,pver) ![kg/m3] air density
+ real(r8), intent(out) :: numberConcentration(pcols,pver,0:nmodes) ![#/m3] number concentration
+
+ integer :: m, l, mm, k
+
+ numberConcentration(:,:,:) = 0.0_r8
+
+ do m = 0, nmodes
+
+ do l=1,getNumberOfBackgroundTracersInMode(m)
+ mm = getTracerIndex(m,l,.false.)
+
+ do k=1,pver
+ numberConcentration(:ncol,k,m) = numberConcentration(:ncol,k,m) &
+ + ( q(:ncol,k,mm) / getDryDensity(m,l)) !Volume of this tracer
+ end do
+
+ end do
+ end do
+
+ !until now, the variable "numberConcentration" actually contained "volume mixing ratio"
+ !the next couple of lines fixes this!
+ do m= 0, nmodes
+ do k=1,pver
+ numberConcentration(:ncol,k,m) = numberConcentration(:ncol,k,m) * rho_air(:ncol,k) * volumeToNumber(m)
+ end do
+ end do
+
+ return
+
+ end subroutine calculateNumberConcentration
+
+
+ !Note the "nmodes" here
+ subroutine calculateNumberMedianRadius(numberConcentration &
+ , volumeConcentration &
+ , lnSigma &
+ , numberMedianRadius &
+ , ncol )
+
+ implicit none
+ real(r8), intent(in) :: numberConcentration(pcols,pver,0:nmodes) ![#/m3] number concentration
+ real(r8), intent(in) :: volumeConcentration(pcols,pver,nmodes) ![kg/kg] mass mixing ratios
+ real(r8), intent(in) :: lnSigma(pcols,pver,nmodes) ![kg/m3] air density
+ integer, intent(in) :: ncol !number of columns used
+
+ real(r8), intent(out) :: numberMedianRadius(pcols,pver,nmodes) ![m]
+
+ real(r8), parameter :: aThird = 1.0_r8/3.0_r8
+
+ integer :: n,k
+
+ do n=1,nmodes
+ do k=1,pver
+ where(volumeConcentration(:ncol,k,n) .gt. 1.e-20_r8)
+ numberMedianRadius(:ncol, k, n) = 0.5_r8 & !diameter ==> radius
+ * (volumeConcentration(:ncol,k,n) & !conversion formula
+ * 6.0_r8/pi/numberConcentration(:ncol,k,n) &
+ *DEXP(-4.5_r8*lnsigma(:ncol,k,n)*lnsigma(:ncol,k,n)))**aThird
+ elsewhere
+ numberMedianRadius(:ncol,k,n) = originalNumberMedianRadius(n)
+ end where
+ end do
+ end do
+
+ end subroutine calculateNumberMedianRadius
+
+
+ function calculateEquivalentDensityOfFractalMode( emissionDensity & ![kg/m3] density at point of emission
+ , emissionRadius & ![kg/m3] radius at point of emission
+ , fractalDimension & ![kg/m3] fractal dimension of mode
+ , modeNumberMedianRadius & ![m] number median radius of mode
+ , modeStandardDeviation & ![m] standard deviation of mode
+ ) result (equivalentDensityOfFractal)
+
+ !Purpose: output equivalent density of a fractal mode
+ implicit none
+ real(r8), intent(in) :: emissionDensity
+ real(r8), intent(in) :: emissionRadius
+ real(r8), intent(in) :: fractalDimension
+ real(r8), intent(in) :: modeNumberMedianRadius
+ real(r8), intent(in) :: modeStandardDeviation
+
+ real(r8) :: sumVolume
+ real(r8) :: sumMass
+ real(r8) :: dN, dNdLogR, dLogR
+ real(r8) :: densityBin
+ integer :: i
+
+ !output
+ real(r8) :: equivalentDensityOfFractal
+
+ sumVolume = 0.0_r8
+ sumMass = 0.0_r8
+ do i=1, nbinsTab
+ dLogR = log(rBinEdge(i+1)/rBinEdge(i))
+ dNdLogR = calculatedNdLogR(rBinMidPoint(i), modeNumberMedianRadius, modeStandardDeviation)
+
+ !Equivalent density (decreases with size since larger particles are long
+ !"hair like" threads..)
+ if(rBinMidPoint(i) < emissionRadius)then
+ densityBin = emissionDensity
+ else
+ densityBin = emissionDensity*(emissionRadius/rBinMidPoint(i))**(3.0 - fractalDimension)
+ endif
+
+ !number concentration in this bin
+ dN = dNdLogR * dLogR
+
+ !sum up volume and mass (factor of 4*pi/3 omitted since in both numerator and nominator)
+ sumVolume = sumVolume + dN * (rBinMidPoint(i)**3)
+ sumMass = sumMass + dN * densityBin * (rBinMidPoint(i)**3)
+
+ end do
+
+ !Equivalent density is mass by volume
+ equivalentDensityOfFractal = sumMass / sumVolume
+
+ end function calculateEquivalentDensityOfFractalMode
+
+
+
+ function calculatedNdLogR(actualRadius, numberMedianRadius, sigma) result (dNdLogR)
+ implicit none
+ real(r8), intent(in) :: actualRadius
+ real(r8), intent(in) :: numberMedianRadius
+ real(r8), intent(in) :: sigma
+
+ real(r8) :: logSigma
+ real(r8) :: dNdLogR
+
+ logSigma = log(sigma)
+
+ !This is the formula for the lognormal distribution
+ dNdLogR = 1.0_r8/(sqrt(2.0_r8*pi)*log(sigma)) &
+ * DEXP(-0.5_r8*(log(actualRadius/numberMedianRadius))**2/(logSigma**2))
+
+ return
+ end function calculatedNdLogR
+
+ !http://en.wikipedia.org/wiki/Log-normal_distribution#Cumulative_distribution_function
+ function calculateLognormalCDF(actualRadius, numberMedianRadius, sigma) result(CDF)
+ implicit none
+ real(r8), intent(in) :: actualRadius
+ real(r8), intent(in) :: numberMedianRadius
+ real(r8), intent(in) :: sigma
+
+ real(r8) :: argument
+ real(r8) :: CDF
+
+ argument = -1.0_r8*(log(actualRadius/numberMedianRadius) / log(sigma) / sqrt(2.0_r8))
+ CDF = 0.5_r8 * erfc(argument)
+ return
+ end function calculateLognormalCDF
+
+
+end module oslo_utils
diff --git a/src/chemistry/oslo_aero/oxi_diurnal_var.F90 b/src/chemistry/oslo_aero/oxi_diurnal_var.F90
new file mode 100644
index 0000000000..3820a8bb2a
--- /dev/null
+++ b/src/chemistry/oslo_aero/oxi_diurnal_var.F90
@@ -0,0 +1,537 @@
+module oxi_diurnal_var
+
+use chem_mods, only : nfs
+use physconst, only : pi
+use mo_chem_utls, only : get_inv_ndx
+use ppgrid, only : pcols, pver
+use phys_grid, only: get_rlat_all_p, get_rlon_all_p
+use shr_kind_mod, only: r8 => shr_kind_r8
+implicit none
+private
+save
+
+
+public :: &
+ set_diurnal_invariants
+
+private :: &
+ sunrisesetxx , srisesetxx
+
+
+ integer, pointer :: id_oh,id_no3,id_ho2
+ logical :: inv_oh,inv_ho2,inv_no3
+
+contains
+
+
+ subroutine set_diurnal_invariants(invariants,dtc,ncol,lchnk,inv_oh,inv_ho2,id_oh,id_ho2, inv_no3, id_no3) !++IH: added ,inv_no3, id_no3
+
+ use chem_mods, only : nfs
+ use time_manager, only : get_curr_date
+
+
+ real(r8), intent(in) :: dtc ! Time step
+ integer, intent(in) :: ncol
+ integer, intent(in) :: lchnk ! chunk id
+ logical, intent(in) :: inv_oh, inv_ho2, inv_no3 !++IH: added inv_no3
+ integer, intent(in) :: id_oh, id_ho2, id_no3 !++IH: added id_no3
+ real(r8), intent(inout) :: invariants(ncol,pver,nfs)
+
+
+
+
+ integer :: i ! column index
+ integer :: k ! height index
+ integer :: iriseset ! sunrise/set flag
+ integer :: day, mon, yr, jyr ! date stuff
+ integer :: j ! working var
+ integer :: ncsec ! time stuff
+
+ real(r8) :: deglat, deglon ! lat and long (degrees)
+ real(r8) :: solardec ! solar declination (degrees)
+ real(r8) :: sum ! working vars
+ real(r8) :: trise, tset ! sunrise and set times (h then d)
+ real(r8) :: tlight ! amount of daylight (d)
+ real(r8) :: trisej, tsetj ! working vars
+ real(r8) :: t1, t2, ta, tb ! working vars
+ real(r8) :: rlats(pcols), rlons(pcols) ! latitude & longitude (radians)
+ real(r8) :: fdiurn_oxid
+ real(r8) :: fdiurn_no3oxid !++IH
+
+
+
+ call get_curr_date(yr, mon, day, ncsec)
+ call get_rlat_all_p( lchnk, ncol, rlats )
+ call get_rlon_all_p( lchnk, ncol, rlons )
+
+! jyr = mod( yr, 100 ) + 1900
+! if (jyr < 1950) jyr = jyr + 100
+! if (jyr > 2049) jyr = jyr - 100
+ jyr=2000
+! Assume the daily cycle to follow year 2000. The subroutine is
+! at any rate only valid between 1950 and 2050, so important years e.g. 1850
+! is out of boundary
+
+
+ do i=1,ncol
+
+ fdiurn_oxid=1._r8
+ fdiurn_no3oxid=1._r8 !++IH
+
+ deglat = rlats(i)*180._r8/pi
+ deglat = max( -89.9999_r8, min( +89.9999_r8, deglat ) )
+ deglon = rlons(i)*180._r8/pi
+
+! get sunrise and sunset times in UTC hours
+ call sunrisesetxx( deglon, deglat, jyr, mon, day, &
+ iriseset, trise, tset, solardec )
+
+! convert rise/set times to days
+! compute tlight = amount of daylight
+! handle case of all day or night
+ if (iriseset > 0) then
+ trise = trise/24._r8
+ tset = tset/24._r8
+ tlight = tset - trise
+ if (tlight < 0._r8) then
+ tset = tset + 1.0_r8
+ tlight = tlight + 1._r8
+ end if
+ else
+ trise = 0._r8
+ if (abs(deglat+solardec) .ge. 90._r8) then
+ tset = 1._r8
+ else
+ tset = 0._r8
+ end if
+ tlight = tset - trise !length of light period in a day
+ end if
+
+! if all day or all night (or very close to it), set fdiurn = 1.0
+! Also in periods with all night, we put the mean value for all night steps
+ if ((tlight .ge. 0.99_r8) .or. (tlight .le. 0.01_r8)) then
+ fdiurn_oxid = 1._r8
+ fdiurn_no3oxid = 1._r8 !++IH
+! otherwise determine overlap between current timestep and daylight times
+! to account for all overlap possibilities, need to try this
+! with rise/set times shifted by +/- 1 day
+ else !==> There is diurnal cycle
+ t1 = ncsec/86400._r8 !start of timestep (days)
+ t2 = t1 + dtc/86400._r8 !end of timestep (days)
+ sum = 0._r8
+ do j = -1, 1
+ trisej = trise + dfloat(j) !one day before sunrise, sunrise, one day after runrise
+ tsetj = trisej + tlight !time of sunset given "j"
+ ta = max( t1, trisej ) !start or sunrise (if later)
+ tb = min( t2, tsetj ) !end of step or sunset (if earlier)
+ sum = sum + max( tb-ta, 0._r8 )
+
+ end do
+
+ !sum is length of timestep (in days) which has light
+ !"sum"/(t1-t2) is fraction of timestep which has light
+ !"tlight is fraction of day which has light
+ !So if fraction of dt is higher than avg fraction during day ==> increase oxidants
+ ! if fraction of dt is lower than avg fraction during day ==> decrease oxidants
+
+ !++IH
+ if (inv_oh .or. inv_ho2) then
+ !--IH
+ fdiurn_oxid = max(1.0e-3_r8, sum/(t2-t1)/tlight)
+ !++IH
+ end if
+ if (inv_no3) then
+ fdiurn_no3oxid = max(1.0e-3_r8, (1._r8 - (sum/(t2-t1))) / (1._r8 - tlight))
+ ! (1._r8 - (sum/(t2-t1))) is the fraction of timestep WITHOUT light
+ ! (1._r8 - tlight) is the fraction of day WITHOUT light
+ end if
+ !--IH
+ end if
+
+ if (inv_oh) then
+ do k=1,pver
+ invariants(i,k,id_oh)=invariants(i,k,id_oh)*fdiurn_oxid
+ end do
+ end if
+
+ if (inv_ho2) then
+ do k=1,pver
+ invariants(i,k,id_ho2)=invariants(i,k,id_ho2)*fdiurn_oxid
+ end do
+ end if
+
+ !++IH
+ if (inv_no3) then
+ do k=1,pver
+ invariants(i,k,id_no3)=invariants(i,k,id_no3)*fdiurn_no3oxid
+ end do
+ end if
+ !--IH
+
+ end do ! i= 1,ncol
+ end subroutine set_diurnal_invariants
+
+
+!--------------------------------------------------------------------
+ subroutine sunrisesetxx( xlong, ylat, iyear, imonth, iday, &
+ iflag, trise, tset, solardec )
+!
+! provides interface to subr srisesetxx without use of common blocks
+!
+! input parameters
+! xlong - longitude in degrees (east longitudes are positive)
+! ylat - latitude in degrees (north latitudes are positive)
+! iyear - year
+! imonth - month
+! iday - day
+! output parameters
+! iflag - status flag
+! +1 - OK and there is a sunrise and sunset
+! 0 - OK but no sunrise or sunset
+! -1 = input parameters (date or position) are bad
+! trise - time of sunrise in UT hours
+! tset - time of sunset in UT hours
+! solardec - apparent solar declination in degrees
+!
+! written 17-aug-93 by r.c.easter
+! Rewritten into fortran 90 by Ø Seland
+
+
+
+
+! arguments
+
+
+ real(r8) ,intent(in) :: xlong
+ real(r8) ,intent(in) :: ylat
+ integer ,intent(in) :: iyear
+ integer ,intent(in) :: imonth
+ integer ,intent(in) :: iday
+ integer ,intent(out) :: iflag
+ real(r8) ,intent(out) :: trise
+ real(r8) ,intent(out) :: tset
+ real(r8) ,intent(out) :: solardec
+! local
+ real(r8) sunrise, sunset, ap_dec
+ real(r8) :: xlongb
+ integer :: iriseset,i
+
+! need xlong between -180 and +180
+ xlongb = xlong
+! do 1000 i = 1, 10
+ if (xlongb .lt. -180.) then
+ xlongb = xlongb + 360._r8
+ else if (xlongb .gt. 180._r8) then
+ xlongb = xlongb - 360._r8
+! else
+! goto 1050
+ end if
+!1000 continue
+!1050 continue
+
+ call srisesetxx( iyear, imonth, iday, ylat, xlongb, &
+ iriseset,sunrise, sunset, ap_dec)
+
+ iflag = iriseset
+ if (iflag .eq. 0) then
+ iflag = 1
+ if (abs(sunrise+100_r8) .le. 0.01_r8) iflag = 0
+ end if
+ trise = sunrise
+ tset = sunset
+ solardec = ap_dec
+
+ end subroutine sunrisesetxx
+
+
+
+!c***************************************************************************
+ subroutine srisesetxx(iyear, month, iday, rlat, rlong, &
+ iriseset,sunrise, sunset,ap_dec)
+
+
+ integer ,intent(in) :: iyear
+ integer ,intent(in) :: month
+ integer ,intent(in) :: iday
+ real(r8) ,intent(in) :: rlat
+ real(r8) ,intent(in) :: rlong
+ integer ,intent(out) :: iriseset
+ real(r8) ,intent(out) :: sunrise
+ real(r8) ,intent(out) :: sunset
+ real(r8) ,intent(out) :: ap_dec
+
+
+!local
+ integer :: jday
+
+ integer ,dimension(12) :: iimonth,iimonthleap
+ logical :: leapyr
+
+!c math definitions.
+! real(r8),parameter :: twopi = 6.2831853071795864_r8
+ real(r8),parameter :: twopi = 2._r8*pi
+ real(r8), parameter :: deg_rad = 0.017453292519943295_r8
+ real(r8), parameter :: rad_deg = 57.295779513082323_r8
+! local variables
+
+ real(r8) :: mean_anomaly, mean_longitude, mean_obliquity
+ real(r8) :: year
+
+ real(r8) :: delta_years,delta_days,days_j2000
+ real(r8) :: cent_j2000,f_mean_anomaly,f_mean_longitude
+ real(r8) :: ecliptic_long,f_ap_ra, ap_ra,f_gmst0h
+ real(r8) :: gmst0h,rlat_r,tan_lat,tan_dec,tangterm
+ real(r8) :: timeterm
+
+ data iimonth /0,31,59,90,120,151,181,212,243,273,304,334/
+ data iimonthleap /0,31,60,91,121,152,182,213,244,274,305,335/
+ leapyr = .false.
+
+!! common / sundataxx_cmn / jday, iriseset,
+! + sunrise, sunset, rloc_timehrs, ap_dec
+!c--------------------------------------------------------------------------
+!c "sunriseset.c" contains the integer function sunriseset() for calculating
+!c the rising and setting times of the Sun as seen from a place on Earth on a
+!c specific date.
+!c
+!c Version 1.0 - April 6, 1992.
+!c (This code was adapted from "solarpos.c" Version 3.1.)
+!c
+!c sunriseset() employs the low precision formulas for the Sun's coordinates
+!c given in the "Astronomical Almanac" of 1990 to compute the Sun's apparent
+!c right ascension, apparent declination, and Greenwich mean sidereal time at
+!c 0 hours Universal Time, and then the rising and setting times of the Sun.
+!c The "Astronomical Almanac" (A. A.) states a precision of 0.01 degree for the
+!c apparent coordinates between the years 1950 and 2050.
+!c
+!c The following assumptions and simplifications are made:
+!c -> diurnal parallax is ignored, resulting in 0 to 9 arc seconds error in
+!c apparent position.
+!c -> diurnal aberration is also ignored, resulting in 0 to 0.02 second error
+!c in right ascension and 0 to 0.3 arc second error in declination.
+!c -> geodetic site coordinates are used, without correction for polar motion
+!c (maximum amplitude of 0.3 arc second) and local gravity anomalies.
+!c -> the formulas ignore atmospheric refraction, semi-diameter, and changes
+!c in right ascension and declination over the course of a day; the
+!c accuracies of sunrise and sunset are about 2 and 7 minutes for latitude
+!c and longitude of 0 degrees, but accuracy degrades significantly for high
+!c latitudes.
+!c
+!c
+!c The necessary input parameters are:
+!c -> the UT date, specified in one of three ways:
+!c 1) year, month, day.fraction
+!c 2) year, daynumber.fraction
+!c 3) days.fraction elapsed since January 0, 1900.
+!c Note: in GChM application, only specification #1 is currently valid
+!c -> site geodetic (geographic) latitude and longitude.
+!c
+!c Refer to the function declaration for the parameter type specifications and
+!c formats.
+!c
+!c sunriseset() returns -1 if an input parameter is out of bounds, or 0 if
+!c values were written to the locations specified by the output parameters.
+!c Sunrise and sunset times are in UT hours; if there is no sunrise or sunset
+!c the values are -1.0.
+!c
+!c Author: Nels Larson
+!c Pacific Northwest Lab.
+!c P.O. Box 999
+!c Richland, WA 99352
+!c U.S.A.
+!c
+!c--------------------------------------------------------------------------
+!c modifications for gchm application by eg chapman
+!c 1. translated from c language to fortran
+!c 2. input date must be in year, month, day.fraction format; other input
+!c code eliminated.
+!c 3. added indicator iriseset. when equal to -1, indicates location
+!c or date is out of range.
+!c
+!c---------------------------------------------------------------------------
+
+!c-------------------------------------------------------------------------
+!c explanation of terms taken from c code
+!c int iyear, Four digit year (Gregorian calendar).
+!c [1950 through 2049; 0 if using days_1900]
+!c month; Month number.
+!c [1 through 12; 0 if using daynumber for day]
+!c
+!c day, /* Calendar day.fraction, or daynumber.fraction.
+!c * [If month is NOT 0:
+!c
+!c * 0 through 32; 31st @ 18:10:00 UT = 31.75694
+!c * If month IS 0:
+!c * 0 through 367; 366 @ 18:10:00 UT = 366.75694] */
+!c days_1900, /* Days since 1900 January 0 @ 00:00:00 UT.
+!c * [18262.0 (1950/01/00) through 54788.0 (2049/12/32);
+!c
+!c * 1990/01/01 @ 18:10:00 UT = 32873.75694;
+!c * 0.0 o.k. if using {year, month, day} or
+!c * {year, daynumber}] */
+!c rlat Observation site geographic latitude.
+!c [degrees.fraction, North positive]
+!c rlong Observation site geographic longitude.
+!c [degrees.fraction, East positive]
+!c *ap_ra, /* Apparent solar right ascension.
+!c * [hours; 0.0 <= *ap_ra < 24.0] */
+!c *ap_dec, /* Apparent solar declination.
+!c * [degrees; -90.0 <= *ap_dec <= 90.0] */
+!c
+!c *sunrise, /* Time of sunrise.
+!c [UT hours.fraction; -1.0 if no sunrise or sunset] */
+!c *sunset; /* Time of sunset.
+!c [UT hours.fraction; -1.0 if no sunset or sunrise] */
+!c int daynum(); /* Computes a sequential daynumber during a year. */
+!c int daynumber, /* Sequential daynumber during a year. */
+!c delta_days, /* Whole days since 2000 January 0. */
+!c delta_years; /* Whole years since 2000. */
+!c double cent_J2000, /* Julian centuries since epoch J2000.0 at 0h UT. */
+!c days_J2000, /* Days since epoch J2000.0. */
+!c ecliptic_long, /* Solar ecliptic longitude. */
+!c
+!c gmst0h, /* Greenwich mean sidereal time at 0 hours UT. */
+!c integral, /* Integral portion of double precision number. */
+!c mean_anomaly, /* Earth mean anomaly. */
+!c mean_longitude, /* Solar mean longitude. */
+!c mean_obliquity, /* Mean obliquity of the ecliptic. */
+!c tan_dec, /* Tangent of apparent declination. */
+!c tan_lat, /* Tangent of latitude. */
+!c
+!c tangterm, /* Tangent term of Sun rise/set equation. */
+!c timeterm; /* Time term of Sun rise/set equation. */
+!c----------------------------------------------------------------------
+ iriseset = 0
+!c check latitude, longitude, dates for proper range before calculating dates.
+ if (((rlat .lt. -90._r8) .or. (rlat .gt. 90._r8)) .or. &
+ ((rlong .lt. -180._r8) .or. (rlong .gt. 180._r8))) then
+ iriseset = -1
+ return
+ end if
+
+! Year assumed to be betweeen 1950 and 2049. As the model is outside these
+! boundary in many cases. year 2000 is assumed for this version of the
+! model
+
+
+! if (iyear .lt. 1950 .or. iyear .gt. 2049) then
+! iriseset = -1
+! return
+! end if
+! if (((month .lt. 1) .or. (month .gt. 12)) .or. &
+! ((iday .lt. 0) .or. (iday .gt. 32))) then
+! iriseset = -1
+! return
+! end if
+!c determine julian day number
+
+
+
+!c there is no year 0 in the Gregorian calendar and the leap year cycle
+!c changes for earlier years.
+! if (iyear .lt. 1) then
+! iriseset = -1
+! return
+! end if
+!c leap years are divisible by 4, except for centurial years not divisible
+!c by 400.
+
+
+! year = real (iyear)
+! if ((amod(year,4.) .eq. 0.0) .and. (amod(year,100.) .ne. 0.0)) &
+! leapyr = 1
+! if(amod(year,400.) .eq. 0.0) leapyr = 1
+ jday = iimonth(month) + iday
+! if ((leapyr .eq. 1) .and. (month .gt. 2)) jday = jday + 1
+
+!
+
+!The
+!c construct Julian centuries since J2000 at 0 hours UT of date,
+!c days.fraction since J2000, and UT hours.
+ delta_years = iyear - 2000._r8
+!c delta_days is days from 2000/01/00 (1900's are negative).
+ delta_days = delta_years * 365._r8 + delta_years / 4._r8 + jday
+ if (iyear .gt. 2000) delta_days = delta_days + 1._r8
+!c J2000 is 2000/01/01.5
+ days_j2000 = delta_days - 1.5_r8
+ cent_j2000 = days_j2000 / 36525._r8
+!c compute solar position parameters.
+!c A. A. 1990, C24.
+ f_mean_anomaly = (357.528_r8 + 0.9856003_r8 * days_j2000)
+ f_mean_longitude = (280.460_r8 + 0.9856474_r8 * days_j2000)
+!c put mean_anomaly and mean_longitude in the range 0 -> 2 pi.
+ mean_anomaly = (f_mean_anomaly / 360._r8 - int(f_mean_anomaly &
+ /360._r8)) * twopi
+ mean_longitude = (f_mean_longitude /360. - int( &
+ f_mean_longitude/360._r8)) * twopi
+ mean_obliquity = (23.439_r8 - 4.0e-7_r8 * days_j2000) * deg_rad
+ ecliptic_long = ((1.915_r8 * sin(mean_anomaly)) + &
+ (0.020_r8 * sin(2.0 * mean_anomaly))) * deg_rad + &
+ mean_longitude
+! tangent of ecliptic_long separated into sine and cosine parts for ap_ra.
+ f_ap_ra = atan2(cos(mean_obliquity) * sin(ecliptic_long), &
+ cos(ecliptic_long))
+! change range of ap_ra from -pi -> pi to 0 -> 2 pi.
+ if (f_ap_ra .lt. 0.0) f_ap_ra = f_ap_ra + twopi
+! put ap_ra in the range 0 -> 24 hours.
+ ap_ra = (f_ap_ra / twopi - int(f_ap_ra /twopi)) * 24._r8
+ ap_dec = asin(sin(mean_obliquity) * sin(ecliptic_long))
+! calculate local mean sidereal time.
+! A. A. 1990, B6-B7.
+! horner's method of polynomial exponent expansion used for gmst0h.
+ f_gmst0h = 24110.54841_r8 + cent_j2000 * (8640184.812866_r8 &
+ +cent_j2000 * (0.093104_r8 - cent_j2000 * 6.2e-6_r8))
+! convert gmst0h from seconds to hours and put in the range 0 -> 24.
+! 24 hours = 86400 seconds
+ gmst0h = (f_gmst0h / 86400._r8 - int(f_gmst0h / 86400._r8)) * 24._r8
+ if (gmst0h .lt. 0._r8) gmst0h = gmst0h + 24._r8
+!c convert latitude to radians.
+ rlat_r = rlat * deg_rad
+!c avoid tangent overflow at +-90 degrees.
+!c 1.57079615 radians is equal to 89.99999 degrees.
+ if (abs(rlat_r) .lt. 1.57079615_r8) then
+ tan_lat = tan(rlat_r)
+ else
+ tan_lat = 6.0e6_r8
+ end if
+ if (abs(ap_dec) .lt. 1.57079615_r8) then
+ tan_dec = tan(ap_dec)
+ else
+ tan_dec = 6.0e6_r8
+ end if
+!c compute UTs of sunrise and sunset.
+!c A. A. 1990, A12.
+ tangterm = tan_lat * tan_dec
+ if (abs(tangterm) .gt. 1.0_r8) then
+ sunrise = -100._r8
+ sunset = -100._r8
+ else
+!c compute angle of tangterm and convert to hours.
+ tangterm = acos(-tangterm) / twopi * 24._r8
+ timeterm = ap_ra - rlong / 15._r8 - gmst0h
+ sunrise = timeterm - tangterm
+ sunset = timeterm + tangterm
+!c put sunrise and sunset in the range 0 to 24 hours.
+!cec inserted following statement since in some latitudes timeterm
+!cec minus tangterm is less than -25
+ if (sunrise .le. -24._r8) sunrise = sunrise + 48._r8
+ if (sunrise .lt. 0._r8) sunrise = sunrise + 24._r8
+ if (sunrise .ge. 24._r8) sunrise = sunrise - 24._r8
+ if (sunset .lt. 0._r8) sunset = sunset + 24._r8
+ if (sunset .ge. 24._r8) sunset = sunset - 24._r8
+!c mean sidereal day is 0.99727 mean solar days.
+ sunrise = sunrise * 0.99727_r8
+ sunset = sunset * 0.99727_r8
+ end if
+!c convert ap_dec to degrees.
+ ap_dec = ap_dec * rad_deg
+ return
+ end subroutine srisesetxx
+
+
+end module oxi_diurnal_var
+
+
+
+
diff --git a/src/chemistry/oslo_aero/parmix_progncdnc.F90 b/src/chemistry/oslo_aero/parmix_progncdnc.F90
new file mode 100644
index 0000000000..aa9296ded0
--- /dev/null
+++ b/src/chemistry/oslo_aero/parmix_progncdnc.F90
@@ -0,0 +1,925 @@
+module parmix_progncdnc
+
+ use const, only : volumeToNumber,smallNumber
+ use modalapp2d
+ use physconst, only: density_water =>rhoh2o, molecularWeightWater=>mwh2o
+ use ppgrid, only : pcols, pver
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use commondefinitions
+ use aerosoldef
+ use physconst, only: pi
+ use constituents, only: pcnst, cnst_name
+ use intlog1to3, only: intlog1to3_sub
+ use intlog4, only: intlog4_sub
+ use intlog5to10, only: intlog5to10_sub
+ use constituents, only: cnst_name
+
+ implicit none
+ public
+ save
+
+ !Size of molecule-layer which defines when particles are coated
+ real(r8), parameter :: coatingLimit = 2.e-9_r8 ![m]
+ !The fraction of soluble material required in a components before it
+ !will add to any coating
+ real(r8), parameter :: solubleMassFractionCoatingLimit=0.50_r8
+
+ real(r8), parameter :: aThird = 1.0_r8/3.0_r8
+ real(r8), parameter :: ln10 = log(10.0_r8)
+
+contains
+
+ !Calculate concentrations of aerosol modes based on lifecycle species
+ !Create an array of "mode_definition_t" which holds the aerosol concentrations
+ subroutine parmix_progncdnc_sub( &
+ ncol & !I [nbr] number of columns used
+ ,mmr & !I [kg/kg] mass mixing ratio of tracers
+ ,rho_air & !I [kg/m3] air density
+ ,CProcessModes &
+ ,f_c &
+ ,f_bc &
+ ,f_aq &
+ ,f_so4_cond &
+ ,f_soa &
+ ,cam &
+ ,f_acm & !O [frc] carbon fraction in mode
+ ,f_bcm & !O [frc] fraction of c being bc
+ ,f_aqm & !O [frc] fraction of sulfate being aquous
+ ,f_so4_condm & !O [frc] fraction of non-aquous SO4 being condensate
+ ,f_soam &
+ ,numberConcentration & !O [#/m3] number concentration
+ ,volumeConcentration & !O [m3/m3] volume concentration
+ ,hygroscopicity & !O [mol/mol]
+ ,lnsigma & !O [-] log sigma
+ ,hasAerosol & !I [t/f] do we have this type of aerosol here?
+!++ MH_2015/04/10
+ ,volumeCore &
+ ,volumeCoat &
+!-- MH_2015/04/10
+ )
+
+ implicit none
+
+ !input
+ integer, intent(in) :: ncol !Number of columns used in chunk
+ real(r8), intent(in) :: mmr(pcols,pver,pcnst)
+ real(r8), intent(in) :: rho_air(pcols,pver)
+
+ !output
+ logical, intent(out) :: hasAerosol(pcols, pver, nmodes)
+ real(r8), intent(out) :: f_acm(pcols,pver, nbmodes)
+ real(r8), intent(out) :: f_bcm(pcols,pver, nbmodes)
+ real(r8), intent(out) :: f_aqm(pcols, pver, nbmodes)
+ real(r8), intent(out) :: f_so4_condm(pcols, pver, nbmodes) !Needed in "get component fraction"
+ real(r8), intent(out) :: f_soam(pcols, pver, nbmodes) !Needed in "get component fraction"
+ real(r8), intent(out) :: numberConcentration(pcols,pver,0:nmodes) ![#/m3] number concentraiton
+ real(r8), intent(out) :: volumeConcentration(pcols,pver,nmodes) ![m3/m3] volume concentration
+ real(r8), intent(out) :: hygroscopicity(pcols,pver,nmodes) ![mol_{aer}/mol_{water}] hygroscopicity
+ real(r8), intent(out) :: lnsigma(pcols,pver,nmodes) ![-] log(base e) sigma
+ real(r8),intent(out) :: CProcessModes(pcols,pver)
+ real(r8),intent(out) :: cam(pcols,pver,nbmodes)
+ real(r8),intent(out) :: f_c(pcols, pver)
+ real(r8),intent(out) :: f_aq(pcols,pver)
+ real(r8),intent(out) :: f_bc(pcols,pver)
+ real(r8),intent(out) :: f_so4_cond(pcols,pver)
+ real(r8),intent(out) :: f_soa(pcols,pver)
+!++ MH_2015/04/10
+ real(r8), intent(out) :: volumeCore(pcols,pver,nmodes)
+ real(r8), intent(out) :: volumeCoat(pcols,pver,nmodes)
+!-- MH_2015/04/10
+
+ real(r8) :: f_aitbc(pcols,pver) ! [-] bc fraction in the coated bc-oc mode
+ real(r8) :: f_nbc(pcols,pver) ! [-] mass fraction of bc in uncoated bc/oc mode
+ real(r8) :: f_soana(pcols,pver) ! [-]
+
+ !Get mass, number concentration and the total add-ons (previous convaer)
+ call calculateBulkProperties( &
+ ncol & !I
+ , mmr & !I
+ , rho_air & !I
+ , numberConcentration & !O
+ , CProcessModes & !O
+ , f_c & !O
+ , f_bc & !O
+ , f_aq & !O
+ , f_so4_cond & !O
+ , f_soa & !O
+ , f_aitbc & !O
+ , f_nbc & !O
+ , f_soana & !O
+ )
+
+ !Find the points where we have aerosol (number concentration)
+ call getAerosolMask(ncol, numberConcentration, hasAerosol)
+
+ !Findn out how much is added per size-mode (modalapp)
+ call partitionMass( ncol &
+ ,numberConcentration &
+ ,CProcessModes & !I [kg/m3] total added mass
+ ,f_c & !I [frc] fraction of added mass being c
+ ,f_bc & !I [frc]Â fraction of c being bc
+ ,f_aq & !I [frc]Â fraction of SO4 being aq
+ ,f_so4_cond & !I [frc] fraction of SO4 coag+cond being cond
+ ,f_soa & !I [frc] fraction of OM being SOA
+ ,cam & !O [kg/m3] added mass distributed to modes
+ ,f_acm & !O [frc] as f_c per mode
+ ,f_bcm & !O [frc] as f_bc per mode
+ ,f_aqm & !O [frc] as f_aq per mode
+ ,f_so4_condm & !O [frc] as f_so4_cond per mode
+ ,f_soam & !O [frc]
+ )
+
+ !Calculate they hygroscopicity (previously in cldwat_par.F90)
+ call calculateHygroscopicity( ncol &
+ ,mmr &
+ ,numberConcentration &
+ ,rho_air &
+ ,Cam &
+ ,f_acm &
+ ,f_bcm &
+ ,f_aqm &
+ ,hasAerosol &
+ ,hygroscopicity &
+ ,volumeConcentration &
+!++ MH_2015/04/10
+ ,volumeCore &
+ ,volumeCoat &
+!-- MH_2015/04/10
+ )
+
+ !Do the interpolation to new modes
+ call doLognormalInterpolation(ncol &
+ ,numberConcentration &
+ ,hasAerosol &
+ ,cam &
+ ,volumeConcentration &
+ ,f_c &
+ ,f_acm &
+ ,f_bcm &
+ ,f_aqm &
+ ,f_aitbc & !I [frc] bc fraction in int mix bc/oc mode
+ ,lnSigma &
+ )
+
+ end subroutine parmix_progncdnc_sub
+
+ !******************************************************************
+ !purpose: Create bulk properties (dependent on tracers, not size modes)
+ subroutine calculateBulkProperties( &
+ ncol &
+ ,qm & !I [kg/kg] transported tracers
+ ,rho_air & !I [kg/m3] air density
+ ,numberConcentration & !O [#/m3] aerosol number concentration
+ ,CProcessModes & !O [kg/m3] total added material
+ ,f_c & !O [-] fraction of aerosol which is carbon
+ ,f_bc & !O [-] fraction of carbon which is bc
+ ,f_aq & !O [-] fraction of sulfate which is aq.
+ ,f_so4_cond & !O [-] fraction of non-aq so4 which is condensate
+ ,f_soa & !O [-] fraction of OM which is SOA
+ ,f_aitbc & !O [-] fraction of bc in the background tracer mode
+ ,f_nbc & !O [-] fraction of bc in the background tracer mode 14
+ ,f_soana & !O [-] fraction of soa in background int-mix mode (1)
+ )
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use aerosoldef
+ use oslo_utils, only : calculateNumberConcentration
+ use const, only : smallNumber
+
+ implicit none
+
+ integer, intent(in) :: ncol ! [nbr] number of columns used
+ real(r8), intent(in) :: rho_air(pcols,pver) ! [kg/m3] air density
+ real(r8), intent(in) :: qm(pcols,pver,pcnst) ! [kg/kg] mmr for transported tracers
+
+ real(r8), intent(out) :: numberConcentration(pcols,pver,0:nmodes) ! [#/m3]
+
+ real(r8), intent(out) :: f_c(pcols,pver) ![-] mass fraction of process mode being c
+ real(r8), intent(out) :: f_bc(pcols,pver) ![-] mass fraction of c being bc
+ real(r8), intent(out) :: f_aq(pcols,pver) ![-] mass fraction of s being aq phase
+ real(r8), intent(out) :: f_so4_cond(pcols,pver) ![-] mass fraction of non-aq s being condensate
+ real(r8), intent(out) :: f_soa(pcols,pver) ![-] mass fraction of OM being SOA
+ real(r8), intent(out) :: f_aitbc(pcols,pver) ![-] mass fraction of bc in bc/oc mixed, coated mode
+ real(r8), intent(out) :: f_nbc(pcols,pver) ![-] mass fraction of bc in bc/oc mixed, un-coated mode
+ real(r8), intent(out) :: f_soana(pcols,pver) ![-] mass fraction of soa in background in int mix ait mode (1)
+ !Local variables
+ real(r8) :: totalProcessModes(pcols,pver) ! [kg/kg] Int. mixed (cond./coag./aq.) SO4+BC+OC concentration
+ real(r8) :: CProcessModes(pcols,pver) ! [kg/m3] Int. mixed (cond./coag./aq.) SO4+BC+OC concentration
+
+ integer :: k !counter for layers
+
+ !Total number concentration per mode
+ call calculateNumberConcentration(ncol, qm, rho_air, numberConcentration)
+
+ do k=1,pver
+
+ !Total coagulated bc and oc and SO4 (condensate, wet phase and coagulated) (kg/kg)
+ !internally mixed with background modes
+ totalProcessModes(:ncol,k) = qm(:ncol,k,l_bc_ac) + qm(:ncol,k,l_om_ac) &
+ + qm(:ncol,k,l_so4_a1) + qm(:ncol,k,l_so4_a2) + qm(:ncol,k,l_so4_ac) + qm(:ncol,k,l_soa_a1)
+
+ CProcessModes(:ncol,k) = rho_air(:ncol,k)*totalProcessModes(:ncol,k) !==> kg/m3
+
+ !fraction of process-mode being carbonaceous
+ f_c(:ncol,k) = min((qm(:ncol,k,l_bc_ac)+qm(:ncol,k,l_om_ac)+qm(:ncol,k,l_soa_a1) )&
+ /(totalProcessModes(:ncol,k)+smallNumber), 1.0_r8)
+
+ !fraction of "c" being bc (total is oc and bc)
+ f_bc(:ncol,k) = min(qm(:ncol,k,l_bc_ac)/(qm(:ncol,k,l_bc_ac)+qm(:ncol,k,l_om_ac)+qm(:ncol,k,l_soa_a1)+smallNumber), 1.0_r8)
+
+ !fraction of non-aqeous phase sulphate being condensate
+ f_so4_cond(:ncol,k) = min(qm(:ncol,k,l_so4_a1)/(qm(:ncol,k,l_so4_a1)+qm(:ncol,k,l_so4_ac)+smallNumber), 1.0_r8)
+
+ !fraction of sulphate being aquous phase (total is condensate + aqeous phase + coagulate)
+ f_aq(:ncol,k) = min(qm(:ncol,k,l_so4_a2) &
+ /(qm(:ncol,k,l_so4_a1)+qm(:ncol,k,l_so4_a2)+qm(:ncol,k,l_so4_ac)+smallNumber),1.0_r8)
+
+ !fraction of bc in the sulfate-coated bc/oc mode (total background is bc and oc)
+ f_aitbc(:ncol,k) = min(qm(:ncol,k,l_bc_ai) / (qm(:ncol,k,l_bc_ai) + qm(:ncol,k,l_om_ai) + smallNumber), 1.0_r8)
+
+ !fraction of bc in the un-coated bc/oc (total is bc and oc)
+ f_nbc(:ncol,k) = min(qm(:ncol,k,l_bc_ni) / (qm(:ncol,k,l_bc_ni) + qm(:ncol,k,l_om_ni) + smallNumber),1.0_r8)
+
+ !fraction of OM process-mode which is SOA
+ f_soa(:ncol,k) = min(qm(:ncol,k,l_soa_a1) / (qm(:ncol,k,l_om_ac) + qm(:ncol,k,l_soa_a1) + smallNumber), 1.0_r8)
+
+ !fraction of "background" int-mix (mode 1) which is SOA
+ f_soana(:ncol,k) = min(qm(:ncol,k,l_soa_na) / (qm(:ncol,k,l_soa_na) + qm(:ncol,k,l_so4_na) + smallNumber), 1.0_r8 )
+
+ end do !k
+
+ return
+ end subroutine calculateBulkProperties
+
+ !********************************************************************************
+ subroutine partitionMass( ncol & !I [nbr] number of columns used
+ ,Nnatk & !IÂ [#/m3] number concentration
+ ,CProcessModes & !I [kg/m3] total added mass
+ ,f_c & !I [frc] fraction of added mass being c
+ ,f_bc & !I [frc]Â fraction of c being bc
+ ,f_aq & !I [frc]Â fraction of SO4 being aq
+ ,f_so4_cond & !I [frc] fraction of SO4 coag+cond being cond
+ ,f_soa & !I [frc] fraction of OM being SOA
+ ,cam & !O [kg/m3] added mass distributed to modes
+ ,f_acm & !O [frc] as f_c per mode
+ ,f_bcm & !O [frc] as f_bc per mode
+ ,f_aqm & !O [frc] as f_aq per mode
+ ,f_so4_condm & !O [frc] fraction of non aq sulfate being coagulate
+ ,f_soam & !OÂ [frc] fraction of OC being SOA
+ )
+
+ implicit none
+
+ integer, intent(in) :: ncol
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes)
+ real(r8), intent(in) :: CProcessModes(pcols,pver)
+ real(r8), intent(in) :: f_c(pcols,pver)
+ real(r8), intent(in) :: f_bc(pcols,pver)
+ real(r8), intent(in) :: f_aq(pcols,pver)
+ real(r8), intent(in) :: f_so4_cond(pcols,pver)
+ real(r8), intent(in) :: f_soa(pcols,pver)
+ real(r8), intent(out) :: f_aqm(pcols,pver,nbmodes)
+ real(r8), intent(out) :: f_acm(pcols,pver,nbmodes)
+ real(r8), intent(out) :: f_bcm(pcols,pver,nbmodes)
+ real(r8), intent(out) :: f_so4_condm(pcols,pver,nbmodes)
+ real(r8), intent(out) :: f_soam(pcols,pver,nbmodes)
+ real(r8), intent(out) :: cam(pcols, pver, nbmodes)
+
+ !Budget of condensate SO4
+ integer :: i
+
+ !++test
+ integer :: k,l,lptr,m,m1,kcomp
+ real(r8) :: total
+ real(r8) :: fraction(pcols,pver,pcnst) !ak: oversized, but only for test use
+ !--test
+#undef EXTRATESTS
+
+
+ call modalapp2d_sub(ncol &
+ ,Nnatk(1,1,1) & !I [#/m3] Total number concentration (skip mode 0)
+ ,CProcessModes & !I [kg/m3] Total process mode mass concentration
+ ,f_c & !IÂ [frc] fraction of process mode mass being oc or bc
+ ,f_bc & !I [frc] fraction of coagulate mass being bc
+ ,f_aq & !I [frc] fraction of process mode sulfate mass being aq
+ ,f_so4_cond &
+ ,f_soa &
+ ,cam & !O [kg/m3] Process mode mass distributed to each mode
+ ,f_acm & !O [frc]Â as f_c, for each mode
+ ,f_bcm & !O [frc] as f_bc, for each mode
+ ,f_aqm & !O [frc]Â as f_aq, for each mode
+ ,f_so4_condm & !O [frc]
+ ,f_soam &
+ )
+
+#ifdef EXTRATESTS
+ !++testing
+ fraction(:,:,:)=0.0_r8
+ do m=1,nbmodes
+ do l = 1, getNumberOfTracersInMode(m)
+ lptr = getTracerIndex(m,l,.false.)
+ do k=1,pver
+ do i=1,ncol
+ fraction(i,k,lptr) = fraction(i,k,lptr) &
+ + getConstituentFraction(CProcessModes(i,k), f_c(i,k), f_bc(i,k), f_aq(i,k), f_so4_cond(i,k), f_soa(i,k) &
+ ,Cam(i,k,m), f_acm(i,k,m), f_bcm(i,k,m), f_aqm(i,k,m), f_so4_condm(i,k,m),f_soam(i,k,m), lptr )
+ end do
+ end do
+ enddo
+ enddo
+
+ !testing that the mass fractions summed over all modes and species = 1 (or 0 if not present).
+ do m1=1,pcnst
+ do k=1, pver
+ do i=1,ncol
+ !Check if "fraction" differs from one (accept 0.01 error), only check for concentrations > 1.e-30 kg/m3
+ if((abs(fraction(i,k,m1)-1.0_r8) .gt. 1.e-2) .and. (fraction(i,k,m1).gt.0.0_r8) .and. (CProcessModes(i,k) .gt. 1.e-30_r8) )then
+ if( ( m1 .eq. l_so4_a1 .and. (1.0_r8-f_c(i,k))*(1.0_r8-f_aq(i,k))*f_so4_cond(i,k) .gt. 1.0e-4_r8).or. &
+ ( m1 .eq. l_so4_a2 .and. (1.0_r8-f_c(i,k))*f_aq(i,k) .gt. 1.0e-4_r8).or. &
+ ( m1 .eq. l_so4_ac .and. (1.0_r8-f_c(i,k))*(1.0_r8-f_aq(i,k))*(1.0_r8-f_so4_cond(i,k)) .gt. 1.0e-4_r8).or. &
+ ( m1 .eq. l_bc_ac .and. f_c(i,k)*f_bc(i,k) .gt. 1.0e-4_r8).or. &
+ ( m1 .eq. l_om_ac .and. f_c(i,k)*(1.0_r8-f_bc(i,k))*(1.0_r8 - f_soa(i,k)) .gt. 1.0e-4_r8) .or. &
+ ( m1 .eq. l_soa_a1 .and. f_c(i,k)*(1.0_r8-f_bc(i,k))*f_soa(i,k) .gt. 1.0e-4_r8) &
+ )then
+
+ print*," "
+ print*,"fraction error ", m1, fraction(i,k,m1), cnst_name(m1)
+ print*, "Cprocessmodes", CProcessModes(i,k), f_c(i,k), f_bc(i,k), f_aq(i,k), f_so4_cond(i,k), f_soa(i,k)
+ do l=1,nbmodes
+ print*, "mode, cam", l, cam(i,k,l),nnatk(i,k,l)
+ enddo
+ print*,"ca, sum(cam)", CProcessModes(i,k), sum(cam(i,k,:))
+ print*,"sulfate fraction", (1.0_r8 - f_c(i,k))
+ print*,"carbon fraction", f_c(i,k)
+ print*,"non aq sulf fraction", (1.0_r8 - f_aq(i,k))*(1.0_r8 - f_c(i,k))
+ !There is something wrong with tracer lptr
+ do m=1,nmodes
+ do l =1,getNumberOfTracersInMode(m)
+ lptr = getTracerIndex(m,l,.false.)
+ if(lptr .eq. m1)then !This is the tracer with problems
+ print*, "lptr, fraction ", m,l,lptr, &
+ getConstituentFraction(CProcessModes(i,k), f_c(i,k), f_bc(i,k), f_aq(i,k), f_so4_cond(i,k), f_soa(i,k) &
+ ,Cam(i,k,m), f_acm(i,k,m), f_bcm(i,k,m), f_aqm(i,k,m), f_so4_condm(i,k,m) , f_soam(i,k,m), lptr,.TRUE. ) &
+ , NNatk(i,k,m),cam(i,k,m),numberFractionAvailableAqChem(m)
+
+ endif
+ enddo
+ enddo
+ do m=1,nbmodes
+ print*,"sulfate / c, aq ", m, (1.0_r8-f_acm(i,k,m)), f_acm(i,k,m)&
+ ,f_aqm(i,k,m), f_so4_condm(i,k,m), f_so4_condm(i,k,m), f_soam(i,k,m)
+ enddo
+
+ stop !stop on error
+ endif !if tracer has error
+ endif !if budget is wrong
+ enddo
+ enddo
+ enddo
+
+
+ !Check total carbon
+ do k=1,pver
+ do i=1,ncol
+ total=0.0_r8
+ do kcomp=1,nbmodes
+ total = total + cam(i,k,kcomp)*f_acm(i,k,kcomp)
+ enddo
+ if( ABS(total - CProcessModes(i,k)*f_c(i,k)) .gt. 1.e-2_r8*CProcessModes(i,k) )then
+ if(abs(total) > 1.e-25)then
+ print*,"CProcessModes", CProcessModes(i,k), total, abs(total - CProcessModes(i,k)*f_c(i,k))
+ do kcomp=1,nbmodes
+ print*,"fcm,cam,fc,ctot", f_acm(i,k,kcomp), cam(i,k,kcomp), f_c(i,k), CProcessModes(i,k)
+ enddo
+ stop
+ endif
+ endif
+ end do
+ end do
+
+ !--testing
+#endif
+ !EXTRATESTS
+
+ end subroutine partitionMass
+
+ !*************************************************************
+ !Find out where we have aerosols
+ subroutine getAerosolMask(ncol,numberConcentration, hasAerosol)
+ implicit none
+
+ integer, intent(in) :: ncol !number of columns used
+ real(r8), intent(in) :: numberConcentration(pcols, pver, 0:nmodes)
+ logical, intent(out) :: hasAerosol(pcols, pver, nmodes)
+ integer :: k !counter for levels
+ integer :: m !counter for modes
+
+ do m=1,nmodes
+ do k=1,pver
+ where(numberConcentration(:ncol,k,m) .gt. smallNumber)
+ hasAerosol(:ncol,k,m)= .true.
+ elsewhere
+ hasAerosol(:ncol,k,m) = .false.
+ end where
+ end do !levels
+ end do !modes
+ end subroutine
+ !*************************************************************
+
+
+ !**************************************************************
+ subroutine calculateHygroscopicity( ncol &
+ ,mmr &
+ ,numberConcentration &
+ ,rho_air &
+ ,Cam &
+ ,f_acm &
+ ,f_bcm &
+ ,f_aqm &
+ ,hasAerosol &
+ ,hygroscopicity &
+ ,volumeConcentration &
+!++ MH_2015/04/10
+ ,volumeCore &
+ ,volumeCoat &
+!-- MH_2015/04/10
+ )
+
+ !All theory in this subroutine is from
+ !Abdul-Razzak and S. Ghan:
+ !A parameterization of aerosol activation 2. Multiple aerosol types, JGR, vol 105, noD5, pp 6837
+ !http://onlinelibrary.wiley.com/doi/10.1029/1999JD901161/abstract
+ implicit none
+
+ !INPUT
+ integer, intent(in) :: ncol
+ real(r8), intent(in) :: mmr(pcols,pver,pcnst) !I [kg/kg] mass mixing ratios
+ real(r8), intent(in) :: numberConcentration(pcols,pver,0:nmodes)!I [#/m3] number concentrations
+ real(r8), intent(in) :: rho_air(pcols,pver) !I [kg/m3] air density
+ real(r8), intent(in) :: Cam(pcols, pver, nbmodes) !I [kg/m3] total added mass during microphysics
+ real(r8), intent(in) :: f_acm(pcols,pver,nbmodes) !I [-] fraction of added mass which is carbon
+ real(r8), intent(in) :: f_aqm(pcols,pver,nbmodes) !I [-] fraction of sulfate which is aq. phase
+ real(r8), intent(in) :: f_bcm(pcols,pver,nbmodes) !I [-] fraction of C which is bc
+ logical, intent(in) :: hasAerosol(pcols,pver,nmodes) !I [t/f] do we have aerosols
+
+ !OUTPUT
+ real(r8), intent(out) :: hygroscopicity(pcols,pver,nmodes)
+ real(r8), intent(out) :: volumeConcentration(pcols,pver,nmodes)
+
+ !Local variables
+ real(r8) :: hygroscopicityAvg(pcols,pver)
+ real(r8) :: hygroscopicityCoat(pcols,pver)
+ real(r8) :: massConcentrationTracerInMode(pcols,pver)
+ !++ MH_2015/04/10
+ real(r8), intent(out) :: volumeCore(pcols,pver,nmodes) ![m3]
+ real(r8), intent(out) :: volumeCoat(pcols,pver,nmodes) ![m3]
+ !-- MH_2015/04/10
+ real(r8) :: averageRadiusCore(pcols,pver) ![m]
+ real(r8) :: averageRadiusTotal(pcols,pver) ![m]
+ integer :: kcomp !counter for modes
+ integer :: l !counter for components
+ integer :: tracerIndex
+
+ integer :: k !counter for levels
+
+ integer :: i
+
+
+ !initialize
+ hygroscopicity(:,:,:) = 0.0_r8
+ volumeConcentration(:,:,:)=0.0_r8
+
+ do kcomp=1,nmodes
+
+ !Don't do anything if no tracers in mode
+ if(getNumberOfBackgroundTracersInMode(kcomp) .lt. 1)then
+ volumeCore(:,:,kcomp)=smallNumber
+ volumeCoat(:,:,kcomp)=smallNumber
+ volumeConcentration(:,:,kcomp)=smallNumber
+ hygroscopicity(:,:,kcomp) = smallNumber
+ cycle
+ end if
+
+ hygroscopicityAvg(:,:) = 0.0_r8
+ hygroscopicityCoat(:,:) = 0.0_r8
+ volumeCore(:,:,kcomp) = 0.0_r8
+ volumeCoat(:,:,kcomp) = 0.0_r8
+
+ !Loop over tracers in mode
+ do l=1,getNumberOfBackgroundTracersInMode(kcomp)
+
+ tracerIndex = getTracerIndex(kcomp,l,.false.) !get index in physcis space
+
+ do k=1,pver
+ massConcentrationTracerInMode(:ncol,k) = mmr(:ncol,k,tracerIndex)*rho_air(:ncol,k)
+ end do
+
+ call addModeHygroscopicity( ncol &
+ , hasAerosol(:,:,kcomp) & !true if any concentration in this point
+ , massConcentrationTracerInMode &
+ , volumeCore(:,:,kcomp) &
+ , volumeCoat(:,:,kcomp) &
+ , hygroscopicityAvg &
+ , hygroscopicityCoat &
+ , tracerIndex &
+ )
+ end do !background tracers in mode (l)
+
+ !The background modes can have tracer mass added to them
+ if(kcomp .le. nbmodes)then
+
+ !added aquous sulfate
+ if(isTracerInMode(kcomp,l_so4_a2))then
+
+ do k=1,pver
+ massConcentrationTracerInMode(:ncol,k) = Cam(:ncol,k,kcomp)*(1.0_r8 - f_acm(:ncol,k,kcomp))*f_aqm(:ncol,k,kcomp)
+ end do
+
+ call addModeHygroscopicity( ncol &
+ , hasAerosol(:,:,kcomp) & !true if any concentration in this point
+ , massConcentrationTracerInMode &
+ , volumeCore(:,:,kcomp) &
+ , volumeCoat(:,:,kcomp) &
+ , hygroscopicityAvg &
+ , hygroscopicityCoat &
+ , l_so4_a2 &
+ )
+ endif
+
+ !added condensate/coagulate
+ !All modes which have coagulate have also condensate, so it is
+ !ok to check for condensate and add the combined mass..
+ if(isTracerInMode(kcomp,l_so4_a1))then
+
+ do k=1,pver
+ massConcentrationTracerInMode(:ncol,k) = Cam(:ncol,k,kcomp)*(1.0_r8 - f_acm(:ncol,k,kcomp))*(1.0_r8 - f_aqm(:ncol,k,kcomp))
+ end do
+
+ call addModeHygroscopicity( ncol &
+ , hasAerosol(:,:,kcomp) & !true if any concentration in this point
+ , massConcentrationTracerInMode &
+ , volumeCore(:,:,kcomp) &
+ , volumeCoat(:,:,kcomp) &
+ , hygroscopicityAvg &
+ , hygroscopicityCoat &
+ , l_so4_a1 &
+ )
+ endif
+ !Added bc
+ if(isTracerInMode(kcomp,l_bc_ac))then
+
+ do k=1,pver
+ massConcentrationTracerInMode(:ncol,k) = Cam(:ncol,k,kcomp)*f_acm(:ncol,k,kcomp)*f_bcm(:ncol,k,kcomp)
+ end do
+
+ call addModeHygroscopicity( ncol &
+ , hasAerosol(:,:,kcomp) & !true if any concentration in this point
+ , massConcentrationTracerInMode &
+ , volumeCore(:,:,kcomp) &
+ , volumeCoat(:,:,kcomp) &
+ , hygroscopicityAvg &
+ , hygroscopicityCoat &
+ , l_bc_ac &
+ )
+ endif
+
+ !Added oc (both POM and SOA), then both have the same
+ !properties, so add combined mass here.
+ !All modes which have condensate also has coagulate, so OK to check
+ !for condensate and distribute the sum..
+ if(isTracerInMode(kcomp,l_soa_a1))then
+
+ do k=1,pver
+ massConcentrationTracerInMode(:ncol,k) = Cam(:ncol,k,kcomp)*f_acm(:ncol,k,kcomp)*(1.0_r8 -f_bcm(:ncol,k,kcomp))
+ end do
+
+ call addModeHygroscopicity( ncol &
+ , hasAerosol(:,:,kcomp) & !true if any concentration in this point
+ , massConcentrationTracerInMode &
+ , volumeCore(:,:,kcomp) &
+ , volumeCoat(:,:,kcomp) &
+ , hygroscopicityAvg &
+ , hygroscopicityCoat &
+ , l_om_ac &
+ )
+ endif
+ end if
+
+ !Note: NCAR definitions of molecular weights are kg/kmol. This is used
+ !inside "addModeHygroscopicity" and here as in molecularWeightWater. SI units are kg/mol, but
+ !the error cancels out since eqn 4 has Mw_water/Mw_tracer
+
+ do k=1,pver
+
+ !Finally, when the sums are calculated, Apply finally eqn 4 here!!
+
+ where (hasAerosol(:ncol,k,kcomp))
+ where(VolumeCoat(:ncol,k,kcomp) .gt. 1.e-30_r8)
+ !If there is enough soluble material, a coating will be formed: In that case, the
+ !volume of the aerosol in question is only the volume of the coating!
+ hygroscopicityCoat(:ncol,k) = molecularWeightWater*hygroscopicityCoat(:ncol,k) &
+ & /( density_water * volumeCoat(:ncol,k,kcomp)) !Note use of volume Coating here
+ elsewhere
+ hygroscopicityCoat(:ncol,k) = 1.e-30_r8
+ endwhere
+ !mode total volume:
+ volumeConcentration(:ncol,k,kcomp) = volumeCore(:ncol,k,kcomp) + volumeCoat(:ncol,k,kcomp)
+
+ !hygroscopicity of mixture (Note use of total volume to get average hygroscopicity)
+ hygroscopicityAvg(:ncol,k) = molecularWeightWater*hygroscopicityAvg(:ncol,k) &
+ & /(density_water * volumeConcentration(:ncol,k,kcomp))
+
+
+ !Average size of insoluble core (average radius)
+ averageRadiusCore(:ncol,k) = 0.5_r8*( (volumeCore(:ncol,k,kcomp)) / numberConcentration(:ncol,k,kcomp) * (6.0_r8/pi))**athird
+
+ !Average size of total aerosol (average radius)
+ averageRadiusTotal(:ncol,k) = 0.5_r8*((volumeConcentration(:ncol,k,kcomp)) / numberConcentration(:ncol,k,kcomp)*(6.0_r8/pi))**athird
+
+ !do i=1,ncol
+ ! if(numberConcentration(i,k,kcomp) .gt. 1.e6 .and. kcomp.eq.6 )then
+ ! print*, "hygro_check",kcomp,numberConcentration(i,k,kcomp), averageRadiusTotal(i,k)*1.e6, averageRadiusCore(i,k)*1.e6 &
+ ! , hygroscopicityCoat(i,k), hygroscopicityAvg(i,k), (averageRadiusTotal(i,k)-averageRadiusCore(i,k))*1.e9
+ ! endif
+ !end do
+
+ !use one or the other hygroscopicity based on coating
+ where ( averageRadiusTotal(:ncol,k) - averageRadiusCore(:ncol,k) .gt. coatingLimit )
+ hygroscopicity(:ncol,k,kcomp) = hygroscopicityCoat(:ncol,k)
+ elsewhere
+ hygroscopicity(:ncol,k,kcomp) = hygroscopicityAvg(:ncol,k)
+ endwhere
+ elsewhere ! No aerosol
+ hygroscopicity(:ncol,k,kcomp) = 1.e-10_r8
+ end where
+
+ end do !levels
+
+ end do !kcomp /modes
+
+ end subroutine calculateHygroscopicity
+
+ !**************************************************************************************
+ subroutine addModeHygroscopicity ( ncol & ![nbr] number of columns used
+ , hasAerosol & ![bool] do we have any aerosol here?
+ , massConcentrationTracerInMode & ![kg/m3] mass concentration of aerosol in a mode
+ , volumeCore & ![m3/m3] volume concentration we are adding
+ , volumeCoat & ![m3/m3] volume concentration we are adding
+ , hygroscopicityAvg & ![mol_{aerosol}/mol_{tracer} hygroscopicity
+ , hygroscopicityCoat & ![mol_{aerosol}/mol_{tracer} hygroscopicity coating
+ , tracerIndex & ![idx] which tracer are we talking about (physics space)
+ )
+
+ implicit none
+
+ integer, intent(in) :: ncol
+ real(r8), intent(in) :: massConcentrationTracerInMode(pcols,pver) ![kg/m3] mass concentration in
+ logical, intent(in) :: hasAerosol(pcols,pver) ![bool] true if we have any aerosol here
+ integer, intent(in) :: tracerIndex !in physics space
+
+ real(r8), intent(inout) :: volumeCore(pcols, pver) !O [m3/m3] volume of insoluble core
+ real(r8), intent(inout) :: volumeCoat(pcols, pver) !O [m3/m3] volume of total aerosol
+ real(r8), intent(inout) :: hygroscopicityAvg(pcols, pver) !O [-] average hygroscopicity
+ real(r8), intent(inout) :: hygroscopicityCoat(pcols, pver) !O [-] average hygroscopicity
+
+ real(r8) :: massFractionInCoating
+
+ integer :: k !counter for levels
+
+ !Only tracers more soluble than 20% can add to the coating volume
+ if(solubleMassFraction(tracerIndex) .gt. solubleMassFractionCoatingLimit)then
+ massFractionInCoating = 1.0_r8 !all volume goes to coating
+ else
+ massFractionInCoating = 0.0_r8 !zero volume goes to coating
+ endif
+
+ do k=1,pver
+
+ where(hasAerosol(:ncol,k) .eqv. .true.)
+
+ volumeCore(:ncol,k) = volumeCore(:ncol,k) &
+ + massConcentrationTracerInMode(:ncol,k)/rhopart(tracerIndex)*(1.0_r8 - massFractionInCoating)
+
+ volumeCoat(:ncol,k) = volumeCoat(:ncol,k) + massConcentrationTracerInMode(:ncol,k)/rhopart(tracerIndex)*massFractionInCoating
+
+ !sum up numerator in eqn 4 in Abdul-Razzak et al (average hygrocopicity)
+ !Note that molecular weight is that of the AEROSOL TYPE
+ !This is because of some conflict with mozart which needs molecular weight of OC tracers to be 12 when reading emissions
+ !So molecular weight is duplicated, and the molecular weight of the TYPE is used here!
+ hygroscopicityAvg(:ncol,k) = hygroscopicityAvg(:ncol,k) + &
+ massConcentrationTracerInMode(:ncol,k)*numberOfIons(tracerIndex)*osmoticCoefficient(tracerIndex) &
+ *solubleMassFraction(tracerIndex)/aerosol_type_molecular_weight(aerosolType(tracerIndex))
+
+ !Contribution to hygroscopicity of coating (only if goes to coating)
+ !sum up numerator in eqn 4 in Abdul-Razzak et al (average hygrocopicity)
+ !Note that molecular weight is that of the AEROSOL TYPE
+ !This is because of some conflict with mozart which needs molecular weight of OC tracers to be 12 when reading emissions
+ !So molecular weight is duplicated, and the molecular weight of the TYPE is used here!
+ hygroscopicityCoat(:ncol,k) = hygroscopicityCoat(:ncol,k) + &
+ massConcentrationTracerInMode(:ncol,k)*numberOfIons(tracerIndex)*osmoticCoefficient(tracerIndex) &
+ *solubleMassFraction(tracerIndex)/aerosol_type_molecular_weight(aerosolType(tracerIndex)) &
+ *massFractionInCoating !Only add to this if mass goes to coating
+
+ elsewhere
+ hygroscopicityAvg(:ncol,k) = 1.0e-10_r8
+ hygroscopicityCoat(:ncol,k)= 1.0e-10_r8
+ end where
+
+ end do
+
+ end subroutine addModeHygroscopicity
+
+ !****************************************************************
+
+ subroutine doLognormalInterpolation(ncol &
+ ,numberConcentration &
+ ,hasAerosol &
+ ,cam &
+ ,volumeConcentration &
+ ,f_c &
+ ,f_acm &
+ ,f_bcm &
+ ,f_aqm &
+ ,f_aitbc &
+ ,lnSigma &
+ )
+
+ implicit none
+
+ !input
+ integer, intent(in) :: ncol
+ real(r8), intent(in) :: volumeConcentration(pcols,pver,nmodes)
+ logical, intent(in) :: hasAerosol(pcols,pver,nmodes)
+ real(r8), intent(in) :: cam(pcols,pver,nbmodes) ![kg/m3] total added mass per mode
+ real(r8), intent(in) :: f_c(pcols,pver) ![frc] fraction of carbon in total add-on
+ real(r8), intent(in) :: f_acm(pcols,pver,nbmodes) ![frc] fraction of carbon per mode (in add-on)
+ real(r8), intent(in) :: f_bcm(pcols,pver,nbmodes) ![frc] fraction of bc in carbon per mode
+ real(r8), intent(in) :: f_aqm(pcols,pver,nbmodes) ![frc] fraction of aq in sulfate added
+ real(r8), intent(in) :: f_aitbc(pcols,pver) ![frc] fraction of bc in coated bc/oc mode
+
+ !output
+ real(r8), intent(inout) :: numberConcentration(pcols,pver,0:nmodes) ![#/m3] number concentration
+ real(r8), intent(out) :: lnsigma(pcols,pver,nmodes) ![-] log (base e) of std. dev
+
+
+ !work arrays
+ real(r8) :: nconccm3(pcols,pver)
+ real(r8) :: camUg(pcols,pver)
+ real(r8) :: log10sig(pcols,pver) ![-] logarithm (base 10) of look up tables
+ real(r8), dimension(pcols,pver,nbmodes) :: cxs ![ug/m3] NOTE NON-SI UNITS non-allocated mass
+ !real(r8), dimension(pcols,pver) :: cxstot ![kg/m3] non allocated mass
+ integer, dimension(pcols) :: ind ![idx] index in mapping (not really used)
+ real(r8), dimension(pcols,pver) :: radius_tmp ![m] radius in look up tables
+ real(r8) :: f_ocm(pcols,pver,4) ! [-] fraction of added mass which is either SOA condensate or OC coagulate
+ integer :: iloop
+ integer :: kcomp
+ integer :: i
+ integer :: k
+
+
+ !total mass not allocated to any mode
+ !this is non-zero if the look-up table can not cope with all the add-on mass
+ !cxstot(:,:) = 0.0_r8
+
+ !Remove this later!
+ do i=1,ncol
+ ind(i)=i
+ end do
+
+! calculate fraction of added mass which is either SOA condensate or OC coagulate,
+! which in AeroTab are both treated as condensate for kcomp=1-4
+ do kcomp=1,4
+ do k=1,pver
+ do i=1,ncol
+ f_ocm(i,k,kcomp) = f_acm(i,k,kcomp)*(1.0_r8-f_bcm(i,k,kcomp))
+ enddo
+ enddo
+ enddo
+
+ do iloop=1,1 ! loop over i>1 for testing CPU use in intlog*
+
+ !Go through all "background" size-modes (kcomp=1-10)
+ do kcomp=1,nbmodes
+
+ camUg(:,:) = cam(:,:,kcomp)*1.e9_r8
+ nConccm3(:,:) = 1e-6_r8*numberConcentration(:,:,kcomp)
+
+ !Calculate growth from knowing added process specific internally mixed mass to each background mode
+ !(level sent but not needed, and kcomp not needed for intlog4_sub)
+
+ if( kcomp .ge. MODE_IDX_SO4SOA_AIT .and. kcomp .le. MODE_IDX_BC_AIT)then ! kcomp=1,2
+
+ do k=1,pver
+ call intlog1to3_sub( &
+ ncol & !I number of points
+ , ind & !I [idx] mappoing of points to use
+ , kcomp & !I [idx] mode index
+ , camUg(:,k) & !I [ug/m3] mass concentration
+ , nConccm3(:,k) & !I [#/cm3] number concentration
+ , f_ocm(:,k,kcomp) & !I [frc] mass fraction which is SOA cond. or OC coag.
+ , cxs(:,k,kcomp) & !O [ug/m3] mass which did not fit the table
+ , log10sig(:,k) & !O [-]sigma, is later thrown away begause of volume balance
+ , radius_tmp(:,k) & !O [m] Number median radius
+ )
+
+ end do !loop on levels
+
+ else if(kcomp .eq. MODE_IDX_OMBC_INTMIX_COAT_AIT)then ! kcomp=4
+
+ do k=1,pver
+ call intlog4_sub( &
+ ncol & !I number of points
+ , ind & !I [idx] mappoing of points to use
+ , kcomp & !I [idx] mode index
+ , camUg(:,k) & !I [ug/m3] mass concentration
+ , nConccm3(:,k) & !I [#/cm3] number concentration
+ , f_ocm(:,k,kcomp) & !I [frc] mass fraction which is SOA cond. or OC coag.
+ , f_aqm(:,k,kcomp) & !I [frc] fraction of sulfate which is aquous
+ , cxs(:,k,kcomp) & !O [ug/m3] mass which did not fit the table
+ , log10sig(:,k) & !O [-]sigma, is later thrown away begause of volume balance
+ , radius_tmp(:,k) & !O [m] Number median radius
+ )
+ end do
+
+ else if (kcomp .ge. MODE_IDX_SO4_AC .and. kcomp .le. MODE_IDX_SS_A3)then ! kcomp=5-10
+
+ do k=1,pver
+ call intlog5to10_sub( &
+ ncol & !I [nbr] number of points used
+ , ind & !I [mapping] (not used)
+ , kcomp & !I [mode index]
+ , camUg(:,k) & !I [ug/m3] mass concentration
+ , nConccm3(:,k) & !I [#/cm3] number concentration
+ , f_acm(:,k,kcomp) & !I [frc] fraction of aerosol which is carbon
+ , f_bcm(:,k,kcomp) & !I [frc] fraction of carbon which is bc
+ , f_aqm(:,k,kcomp) & !I [frc] fraction of sulfate which is aquous
+ , cxs(:,k,kcomp) & !O [ug/m3] mass which did not fit the table (not given to any mode)
+ , log10sig(:,k) & !O logarithm (base 10) sigma, is later thrown away begause of volume balance
+ , radius_tmp(:,k) & !O [m] Number median radius
+ )
+ end do ! k
+
+ endif
+
+ !initialize
+ lnsigma(:,:,kcomp) = log(2.0_r8)
+
+ !The whole point of the interpolation routines is to get the new sigma ==> so trust the sigma
+
+ !This means that in order to conserve the volume (which is known), we have to throw away
+ !the number concentration. Should create a diagnostic or a warning if number concenration is very different
+ !from the original number concentration since in principal, the number concentration is
+ !also conserved!
+ do k=1,pver
+ !Don't change number concentration unless "hasAerosol" is true
+ where(hasAerosol(:ncol,k,kcomp))
+
+ lnsigma(:ncol,k,kcomp) = ln10*log10sig(:ncol,k)
+
+ numberConcentration(:ncol,k,kcomp) = volumeConcentration(:ncol,k,kcomp)*6.0_r8/pi &
+ /(2.0_r8*radius_tmp(:ncol,k))**3 &
+ *DEXP(-4.5_r8*lnsigma(:ncol,k,kcomp)*lnsigma(:ncol,k,kcomp))
+
+ !==> Now we have a set of n, vol, sigma which is consistent and gives back whatever the
+ !lookup tables told us! If the look up tables were conserving volume we didn't have to do
+ !the step just above!!
+
+ !Sum up all mass which was not added to any mode (mass exceeding the max limit in the look-up tables)
+ !cxstot(:ncol,k) = cxstot(:ncol,k) + cxs(:ncol,k,kcomp)*1.e-9_r8 ! ug/m3 ==> kg/m3
+
+ end where
+ end do
+
+ end do !kcomp
+
+ !The modes which do not have any added aerosol:
+ do kcomp=nbmodes+1,nmodes
+ do k=1,pver
+ lnsigma(:ncol,k,kcomp) = log(originalSigma(kcomp))
+ end do
+ end do
+
+ !AK (fxm): "unactivated" code below...
+ !Excessive internally mixed process mass added to the background modes (exceeding the max limit in the look-up tables)
+ !is instead added to / lumped with the externally mixed non-background modes (kcomp=11,12,14)
+ !numberConcentration(:,:,MODE_IDX_SO4_NUC) = numberConcentration(:,:,MODE_IDX_SO4_NUC) &
+ ! + (volumeToNumber(MODE_IDX_SO4_NUC) & !excess sulfate mass is moved to this mode
+ ! *RESHAPE(cxstot,(/pcols,pver/)) &
+ ! *(1.0_r8-f_c(:,:))/rhopart(l_so4_n))
+
+ !numberConcentration(:,:,MODE_IDX_BC_NUC) = numberConcentration(:,:,MODE_IDX_BC_NUC) &
+ ! + (volumeToNumber(MODE_IDX_BC_NUC) & !excess carbon mass is moved to this mode
+ ! * RESHAPE(cxstot,(/pcols,pver/)) &
+ ! * f_c(:,:)/rhopart(l_bc_n))
+
+ !SKIP LUMPING OF OC-MODE TO MODE MODE_IDX_LUMPED ORGANICS SINCE THIS WILL MESS UP THE HASAEROSOL-MASK!
+ ! modedefs(i)%Nnatk(MODE_IDX_LUMPED_ORGANICS) = efact_omn & !excess OM mass is moved to this mode (originally kcomp=13)
+ ! * (modedefs(i)%Nnatk(MODE_IDX_LUMPED_ORGANICS) + cxstot(i)*modedefs(i)%f_c*(1.0_r8-modedefs(i)%f_bc))
+
+
+ enddo ! iloop
+
+
+ end subroutine doLognormalInterpolation
+
+end module parmix_progncdnc
diff --git a/src/chemistry/oslo_aero/seasalt_model.F90 b/src/chemistry/oslo_aero/seasalt_model.F90
new file mode 100644
index 0000000000..0bb52f3ec8
--- /dev/null
+++ b/src/chemistry/oslo_aero/seasalt_model.F90
@@ -0,0 +1,219 @@
+module seasalt_model
+
+use constituents, only: cnst_name
+use aerosoldef, only: l_ss_a1, l_ss_a2, l_ss_a3,l_om_ni &
+ , MODE_IDX_SS_A1, MODE_IDX_SS_A2, MODE_IDX_SS_A3 &
+ , rhopart
+use const, only: volumeToNumber
+use shr_kind_mod, only: r8 => shr_kind_r8, cl => shr_kind_cl
+use spmd_utils, only: masterproc
+use camsrfexch, only: cam_in_t, cam_out_t
+use ppgrid, only: pcols, pver,pverp
+use constituents, only: pcnst, cnst_add, cnst_name, cnst_get_ind
+use aerodep_flx, only: aerodep_flx_prescribed
+use cam_abortutils, only: endrun
+use cam_logfile, only: iulog
+use oslo_ocean_intr, only: oslo_opom_emis_intr, oslo_opom_inq
+
+implicit none
+private
+save
+
+ !Add Spracklen OC source related to sea salt, Spracklen says about 5.5 sub-micron Tg(C) per year (page 3)
+ !Total sea salt emissions are about 8000 Tg/year, take into account OM/OC-factor of about 1.4
+ !==> scale factor of approx 7.7/8000
+ !Note: The emissions are not REALLY related to sea salt,
+ !but this is as close as we get with the current version
+ !GRL Volume 35, Issue 12, 28 June 2008, http://onlinelibrary.wiley.com/doi/10.1029/2008GL033359/abstract
+ real(r8), parameter :: seasaltToSpracklenOM = 7.7_r8/8000_r8
+
+ !After discussions with Alf K, it is better to scale with only smallest SS-mode since POM is small
+ !and assume same production mechanism. Nudged 1 degree simulations give 2.52 Tg/yr of SS_A1, so
+ !to obtain 7.7, we need to scale them by 7.7 / 2.52 ==> 3.03
+!cak real(r8), parameter :: seasaltToSpracklenOM2 = 3.03_r8
+ !updated value for Salter et al. sea-salt treatment, which gives global annual SS_A1 emissions of
+ !2.663 instead of 0.153 ng m-2 s-1 (i.e. ca 17 times more than the old sea-salt treatment):
+ real(r8), parameter :: seasaltToSpracklenOM2 = 3.03_r8*0.153_r8/2.663_r8
+!cak
+
+ integer, parameter :: numberOfSaltModes = 3
+ character(len=6), public, dimension(10) :: seasalt_names
+ integer, parameter, public :: seasalt_nbin = numberOfSaltModes !just because this is needed by mo_photo.F90
+
+ !Numbers in table below are from Kirkevåg et al (2013) http://www.geosci-model-dev.net/6/207/2013/gmd-6-207-2013.html
+ !Based on Struthers et al 2011 (http://www.atmos-chem-phys.net/11/3459/2011/acp-11-3459-2011.html)
+ !which are again modified from Maartensson , JGR, vol 108. no D9, 4297, 2003
+ !
+ !Note that using the numbers from the Kirkevag paper will give 20% too small mass emissions of sea salt globally!!
+ !The number of significant digits there should have been larger! We are here using the numbers as received from the swedes.
+ !
+ !THESE ARE THE NUMBERS RECEIVED FROM THE SWEDES, THEY ARE UN-DOCUMENTED (SEE EMISSIONS.F90 of NORESM1)
+ !***************************************************************************************************
+! real(r8), dimension(numberOfSaltModes), parameter :: coeffA = (/0.0_r8 , 0.0_r8 , 3.0608e3_r8 /)
+! real(r8), dimension(numberOfSaltModes), parameter :: coeffB = (/-3.3551e6_r8, 1.1768e5_r8 , -1.6675e6_r8 /)
+! real(r8), dimension(numberOfSaltModes), parameter :: coeffC = (/1.0554e9_r8 , -1.1369e7_r8, 2.2879e8_r8 /)
+
+ !FOR INFO: THESE ARE THE NUMBERS FROM THE PAPER WHICH GIVE TOO LOW EMISSIONS!!
+ !*******************************************************************************************************
+ !real(r8), dimension(numberOfSaltModes), parameter :: coeffA = (/0.0_r8, 0.0_r8, 3.06e3_r8 /)
+ !real(r8), dimension(numberOfSaltModes), parameter :: coeffB = (/-3.36e6_r8, 1.18e5_r8, -1.67e6_r8 /)
+ !real(r8), dimension(numberOfSaltModes), parameter :: coeffC = (/1.05e9_r8, -1.14e7_r8, 2.29e8_r8 /)
+
+ !New numbers are based on Salter et al. (2105): www.atmos-chem-phys-discuss.net/15/13783/2015/doi:10.5194/acpd-15-13783-2015
+ !Values from Table 1 in Salter et al. (2015):
+ !*******************************************************************************************************
+ real(r8), dimension(numberOfSaltModes), parameter :: coeffA = (/-5.2168e5_r8, 0.0_r8, 0.0_r8 /)
+ real(r8), dimension(numberOfSaltModes), parameter :: coeffB = (/ 3.31725e7_r8, 7.374e5_r8, 1.4210e4_r8 /)
+ real(r8), dimension(numberOfSaltModes), parameter :: coeffC = (/-6.95275e8_r8,-2.4803e7_r8, 1.4662e7_r8 /)
+ real(r8), dimension(numberOfSaltModes), parameter :: coeffD = (/ 1.0684e10_r8, 7.7373e8_r8, 1.7075e8_r8 /)
+
+ real(r8), parameter :: z0= 0.0001_r8 ![m] roughness length over ocean
+
+
+ integer, dimension(numberOfSaltModes) :: modeMap ! [idx] which modes are we modifying
+ integer, dimension(numberOfSaltModes) :: tracerMap ! [idx] which tracers are we modifying
+
+ real(r8), dimension(pcols), save, public :: OMOceanSource ![kg/m2/s] new OM ocean source
+ real(r8), dimension(pcols), save, public :: spracklenOMOceanSource ![kg/m2/s] spracklen ocean source
+ !real(r8), dimension(pcols), save, public :: spracklenOMOceanSource2 ![kg/m2/s] spracklen ocean source
+ real(r8), dimension(pcols) :: onOMOceanSource ![kg/m2/s] OM source from Nilsson/O'Dowd
+ logical, parameter, public :: seasalt_active = .TRUE.
+
+public oslo_salt_emis_intr
+public seasalt_init
+
+!===============================================================================
+contains
+!===============================================================================
+
+ subroutine seasalt_init()
+
+ implicit none
+
+ integer :: i
+
+ modeMap(1) = MODE_IDX_SS_A1
+ modeMap(2) = MODE_IDX_SS_A2
+ modeMap(3) = MODE_IDX_SS_A3
+
+ tracerMap(1) = l_ss_a1
+ tracerMap(2) = l_ss_a2
+ tracerMap(3) = l_ss_a3
+
+ seasalt_names(:)=" "
+ do i=1,numberOfSaltModes
+ seasalt_names(i) = cnst_name(tracerMap(i))
+ end do
+
+ spracklenOMOceanSource(:) = 0.0_r8
+ end subroutine seasalt_init
+
+subroutine oslo_salt_emis_intr(state, cam_in)
+
+ !-----------------------------------------------------------------------
+ ! Purpose:
+ ! Interface to emission of sea salt
+ !-----------------------------------------------------------------------
+ use cam_history, only: outfld
+ use physics_types, only: physics_state
+
+ ! Arguments:
+
+ type(physics_state), intent(in) :: state ! Physics state variables
+ type(cam_in_t), target, intent(inout) :: cam_in ! import state
+
+ real(r8), dimension(pcols) :: whiteCapAreaFraction ![fraction]
+ real(r8), dimension(pcols) :: open_ocean ![fraction]
+ real(r8), dimension(pcols,numberOfSaltModes) :: numberFlux ![#/m2/sec]
+ real(r8), dimension(pcols) :: u10m ![m/s]
+ real(r8), dimension(pcols) :: totalSaltEmis ![kg/m2/s]
+ real(r8), pointer :: sst(:) ![frc] sea surface temperature
+ real(r8), pointer :: ocnfrc(:) ![frc] ocean fraction
+ real(r8), pointer :: icefrc(:) ![frc] ice fraction
+ integer :: n ![] counter for modes
+ integer :: ncol ![nbr] number of columns in use
+ integer :: lchnk ! chunk index
+
+
+ !number of columns in use
+ ncol = state%ncol
+ lchnk = state%lchnk
+
+ !pointers to land model variables
+ ocnfrc => cam_in%ocnfrac
+ icefrc => cam_in%icefrac
+ sst => cam_in%sst
+
+ !start with midpoint wind speed
+ u10m(:ncol)=sqrt(state%u(:ncol,pver)**2+state%v(:ncol,pver)**2)
+
+ ! move the winds to 10m high from the midpoint of the gridbox:
+ u10m(:ncol)=u10m(:ncol)*log(10._r8/z0)/log(state%zm(:ncol,pver)/z0)
+
+! !whitecap area (eqn 1 in Struthers et al., 2011)
+! whitecapAreaFraction(:ncol) = (3.84_r8*10.0_r8**(-6.0_r8))*(u10m(:ncol)**3.41_r8)
+
+ ! New whitecap area fraction / air entrainment flux from eqn. 6 in Salter et al. (2015)
+ ! JCA & MS Using Hanson & Phillips 99 air entrainment vs. wind speed
+ ! (Note the uncertainty in the factor 2, written as 2 pluss/minus 1 in Eq. 6 -> possible tuning factor)
+!aktst+ whitecapAreaFraction(:ncol) = (2.0_r8*10.0_r8**(-8.0_r8))*(u10m(:ncol)**3.41_r8)
+ whitecapAreaFraction(:ncol) = (2.0_r8*10.0_r8**(-8.0_r8))*(u10m(:ncol)**3.74_r8)
+!aktst-
+
+ whitecapAreaFraction(:ncol) = ocnfrc(:ncol) * (1._r8-icefrc(:ncol)) * whitecapAreaFraction(:ncol)
+ open_ocean(:ncol) = ocnfrc(:ncol) * (1._r8-icefrc(:ncol))
+
+ do n=1,numberOfSaltModes
+
+! !eqn 1 in Kirkevag et al. (2013)
+! numberFlux(:ncol,n) = whitecapAreaFraction(:ncol)* &
+! ( &
+! coeffA(n)*sst(:ncol)*sst(:ncol) &
+! + coeffB(n)*sst(:ncol) &
+! + coeffC(n) &
+! )
+ !Eqn. 9 in Salter et al. (2015)
+ numberFlux(:ncol,n) = whitecapAreaFraction(:ncol)* &
+ ( coeffA(n)*(sst(:ncol)-273.15_r8)*(sst(:ncol)-273.15_r8)*(sst(:ncol)-273.15_r8) &
+ + coeffB(n)*(sst(:ncol)-273.15_r8)*(sst(:ncol)-273.15_r8) &
+ + coeffC(n)*(sst(:ncol)-273.15_r8) &
+ + coeffD(n) )
+ end do
+
+
+ do n=1,numberOfSaltModes
+ cam_in%cflx(:ncol, tracerMap(n)) = numberFlux(:ncol,n) & !#/m2/sec
+ / volumeToNumber(modeMap(n)) & !==> m3/m2/sec
+ * rhopart(tracerMap(n)) !==> kg/m2/sec
+ end do
+
+ !totalSaltEmis(:ncol)=0.0_r8
+ !do n=1,numberOfSaltModes
+ ! totalSaltEmis(:ncol) = totalSaltEmis(:ncol) + cam_in%cflx(:ncol,tracerMap(n))
+ !end do
+ !spracklenOMOceanSource(:ncol) = seasaltToSpracklenOM * totalSaltEmis(:ncol)
+
+ !The above code scales to total seasalt emisisons. This scales to mode 1
+ !so assuming that submicron OM is proportional to smallest sea salt mode
+ spracklenOMOceanSource(:ncol) = cam_in%cflx(:ncol, tracerMap(1))*seasaltToSpracklenOM2
+
+ !do i=1,ncol
+ ! if(ocnfrc(i).gt.0.999_r8 .and. icefrc(i).lt.0.000001_r8 .and. u10m(i).gt.5 .and. sst(i).gt. 284.0_r8)then
+ ! print*, "u,sst, s1, s2", u10m(i), sst(i), spracklenOMOceanSource(i), spracklenOMOCeanSource2(i)
+ ! end if
+ !end do
+
+ if (oslo_opom_inq())then
+ call oslo_opom_emis_intr(cam_in%cflx(:ncol, tracerMap(1)), &
+ cam_in%cflx(:ncol, tracerMap(2)), &
+ cam_in%cflx(:ncol, tracerMap(3)), &
+ open_ocean ,ncol,lchnk, onOMOceanSource )
+ OMOceanSource(:ncol) = onOMOceanSource(:ncol)
+ else
+ OMOceanSource(:ncol) = spracklenOMOceanSource(:ncol)
+ endif
+
+ return
+ end subroutine oslo_salt_emis_intr
+
+end module seasalt_model
diff --git a/src/chemistry/oslo_aero/sox_cldaero_mod.F90 b/src/chemistry/oslo_aero/sox_cldaero_mod.F90
new file mode 100644
index 0000000000..d4224ec750
--- /dev/null
+++ b/src/chemistry/oslo_aero/sox_cldaero_mod.F90
@@ -0,0 +1,386 @@
+!----------------------------------------------------------------------------------
+! Modal aerosol implementation
+!----------------------------------------------------------------------------------
+module sox_cldaero_mod
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use cam_abortutils, only : endrun
+ use ppgrid, only : pcols, pver
+ use mo_chem_utls, only : get_spc_ndx
+ use aerosoldef, only: l_so4_a2, chemistryIndex
+ use cldaero_mod, only : cldaero_conc_t, cldaero_allocate, cldaero_deallocate
+ use chem_mods, only : adv_mass
+ use physconst, only : gravit
+ use phys_control, only : phys_getopts
+ use cldaero_mod, only : cldaero_uptakerate
+ use chem_mods, only : gas_pcnst
+
+ implicit none
+ private
+
+ public :: sox_cldaero_init
+ public :: sox_cldaero_create_obj
+ public :: sox_cldaero_update
+ public :: sox_cldaero_destroy_obj
+
+ integer :: id_msa, id_h2so4, id_so2, id_h2o2, id_nh3
+ integer :: id_so4_1a
+
+ real(r8), parameter :: small_value = 1.e-20_r8
+
+contains
+
+!----------------------------------------------------------------------------------
+!----------------------------------------------------------------------------------
+
+ subroutine sox_cldaero_init
+
+ integer :: l, m
+ logical :: history_aerosol ! Output the MAM aerosol tendencies
+
+ id_msa = get_spc_ndx( 'MSA' )
+ id_h2so4 = get_spc_ndx( 'H2SO4' )
+ id_so2 = get_spc_ndx( 'SO2' )
+ id_h2o2 = get_spc_ndx( 'H2O2' )
+ id_nh3 = get_spc_ndx( 'NH3' )
+
+ id_so4_1a = chemistryIndex(l_so4_a2)
+
+ if (id_h2so4<1 .or. id_so2<1 .or. id_h2o2<1) then
+ call endrun('sox_cldaero_init:MAM mech does not include necessary species' &
+ //' -- should not invoke sox_cldaero_mod ')
+ endif
+
+ call phys_getopts( history_aerosol_out = history_aerosol )
+ !
+ ! add to history
+ !
+
+ end subroutine sox_cldaero_init
+
+!----------------------------------------------------------------------------------
+!----------------------------------------------------------------------------------
+ function sox_cldaero_create_obj(cldfrc, qcw, lwc, cfact, ncol, loffset) result( conc_obj )
+
+ real(r8), intent(in) :: cldfrc(:,:)
+ real(r8), intent(in) :: qcw(:,:,:)
+ real(r8), intent(in) :: lwc(:,:)
+ real(r8), intent(in) :: cfact(:,:)
+ integer, intent(in) :: ncol
+ integer, intent(in) :: loffset
+
+ type(cldaero_conc_t), pointer :: conc_obj
+
+
+ integer :: l,n
+ integer :: i,k
+
+
+ conc_obj => cldaero_allocate()
+
+ do k = 1,pver
+ do i = 1,ncol
+ if( cldfrc(i,k) >0._r8) then
+ conc_obj%xlwc(i,k) = lwc(i,k) *cfact(i,k) ! cloud water L(water)/L(air)
+ conc_obj%xlwc(i,k) = conc_obj%xlwc(i,k) / cldfrc(i,k) ! liquid water in the cloudy fraction of cell
+ else
+ conc_obj%xlwc(i,k) = 0._r8
+ endif
+ enddo
+ enddo
+
+ conc_obj%no3c(:,:) = 0._r8
+
+
+ !Set concenctration of cloud so4
+ conc_obj%so4c(:ncol,:) &
+ = qcw(:ncol,:,id_so4_1a)
+
+
+ ! for oslo aerosols,
+ ! current version does not have nh3/nh4 tracers
+ ! so so4 is assumed to be nh4hso4
+ ! the partial neutralization of so4 is handled by using a
+ ! -1 charge (instead of -2) in the electro-neutrality equation
+ conc_obj%nh4c(:ncol,:) = 0._r8
+
+ ! with 3-mode, assume so4 is nh4hso4, and so half-neutralized
+ conc_obj%so4_fact = 1._r8
+
+
+
+ end function sox_cldaero_create_obj
+
+!----------------------------------------------------------------------------------
+! Update the mixing ratios
+!----------------------------------------------------------------------------------
+ subroutine sox_cldaero_update( &
+ ncol, lchnk, loffset, dtime, mbar, pdel, press, tfld, cldnum, cldfrc, cfact, xlwc, &
+ delso4_hprxn, xh2so4, xso4, xso4_init, nh3g, hno3g, xnh3, xhno3, xnh4c, xno3c, xmsa, xso2, xh2o2, qcw, qin, &
+ aqso4, aqh2so4, aqso4_h2o2, aqso4_o3, aqso4_h2o2_3d, aqso4_o3_3d)
+
+ ! args
+
+ integer, intent(in) :: ncol
+ integer, intent(in) :: lchnk ! chunk id
+ integer, intent(in) :: loffset
+
+ real(r8), intent(in) :: dtime ! time step (sec)
+
+ real(r8), intent(in) :: mbar(:,:) ! mean wet atmospheric mass ( amu )
+ real(r8), intent(in) :: pdel(:,:)
+ real(r8), intent(in) :: press(:,:)
+ real(r8), intent(in) :: tfld(:,:)
+
+ real(r8), intent(in) :: cldnum(:,:)
+ real(r8), intent(in) :: cldfrc(:,:)
+ real(r8), intent(in) :: cfact(:,:)
+ real(r8), intent(in) :: xlwc(:,:)
+
+ real(r8), intent(in) :: delso4_hprxn(:,:)
+ real(r8), intent(in) :: xh2so4(:,:)
+ real(r8), intent(in) :: xso4(:,:)
+ real(r8), intent(in) :: xso4_init(:,:)
+ real(r8), intent(in) :: nh3g(:,:)
+ real(r8), intent(in) :: hno3g(:,:)
+ real(r8), intent(in) :: xnh3(:,:)
+ real(r8), intent(in) :: xhno3(:,:)
+ real(r8), intent(in) :: xnh4c(:,:)
+ real(r8), intent(in) :: xmsa(:,:)
+ real(r8), intent(in) :: xso2(:,:)
+ real(r8), intent(in) :: xh2o2(:,:)
+ real(r8), intent(in) :: xno3c(:,:)
+
+ real(r8), intent(inout) :: qcw(:,:,:) ! cloud-borne aerosol (vmr)
+ real(r8), intent(inout) :: qin(:,:,:) ! xported species ( vmr )
+
+ real(r8), intent(out) :: aqso4(:,:) ! aqueous phase chemistry
+ real(r8), intent(out) :: aqh2so4(:,:) ! aqueous phase chemistry
+ real(r8), intent(out) :: aqso4_h2o2(:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2)
+ real(r8), intent(out) :: aqso4_o3(:) ! SO4 aqueous phase chemistry due to O3 (kg/m2)
+ real(r8), intent(out), optional :: aqso4_h2o2_3d(:,:) ! SO4 aqueous phase chemistry due to H2O2 (kg/m2)
+ real(r8), intent(out), optional :: aqso4_o3_3d(:,:) ! SO4 aqueous phase chemistry due to O3 (kg/m2)
+
+
+ ! local vars ...
+
+ real(r8) :: dqdt_aqso4(ncol,pver,gas_pcnst), &
+ dqdt_aqh2so4(ncol,pver,gas_pcnst), &
+ dqdt_aqhprxn(ncol,pver), dqdt_aqo3rxn(ncol,pver), &
+ sflx(1:ncol)
+
+ real(r8) :: delso4_o3rxn, &
+ dso4dt_aqrxn, dso4dt_hprxn, &
+ dso4dt_gasuptk, dmsadt_gasuptk, &
+ dmsadt_gasuptk_tomsa, dmsadt_gasuptk_toso4, &
+ dqdt_aq, dqdt_wr, dqdt
+
+ real(r8) :: fwetrem, sumf, uptkrate
+ real(r8) :: delnh3, delnh4
+
+ integer :: l, n, m
+ integer :: ntot_msa_c
+
+ integer :: i,k
+ real(r8) :: xl
+
+ ! make sure dqdt is zero initially, for budgets
+ dqdt_aqso4(:,:,:) = 0.0_r8
+ dqdt_aqh2so4(:,:,:) = 0.0_r8
+ dqdt_aqhprxn(:,:) = 0.0_r8
+ dqdt_aqo3rxn(:,:) = 0.0_r8
+
+ lev_loop: do k = 1,pver
+ col_loop: do i = 1,ncol
+ cloud: if (cldfrc(i,k) >= 1.0e-5_r8) then
+ xl = xlwc(i,k) ! / cldfrc(i,k)
+
+ IF (XL .ge. 1.e-8_r8) THEN !! WHEN CLOUD IS PRESENTED
+
+ delso4_o3rxn = xso4(i,k) - xso4_init(i,k)
+
+ if (id_nh3>0) then
+ delnh3 = nh3g(i,k) - xnh3(i,k)
+ delnh4 = - delnh3
+ endif
+
+ !In the case of OSLO-AEROSOLS,
+ !set no MSA in cloud droplets
+ ntot_msa_c = 0
+ ! average uptake rate over dtime
+ uptkrate = cldaero_uptakerate( xl, cldnum(i,k), cfact(i,k), cldfrc(i,k), tfld(i,k), press(i,k) )
+ ! average uptake rate over dtime
+ uptkrate = (1.0_r8 - exp(-min(100._r8,dtime*uptkrate))) / dtime
+
+ ! dso4dt_gasuptk = so4_c tendency from h2so4 gas uptake (mol/mol/s)
+ ! dmsadt_gasuptk = msa_c tendency from msa gas uptake (mol/mol/s)
+ dso4dt_gasuptk = xh2so4(i,k) * uptkrate
+ if (id_msa > 0) then
+ dmsadt_gasuptk = xmsa(i,k) * uptkrate
+ else
+ dmsadt_gasuptk = 0.0_r8
+ end if
+
+! if no modes have msa aerosol, then "rename" scavenged msa gas to so4
+ dmsadt_gasuptk_toso4 = 0.0_r8
+ dmsadt_gasuptk_tomsa = dmsadt_gasuptk
+ if (ntot_msa_c == 0) then
+ dmsadt_gasuptk_tomsa = 0.0_r8
+ dmsadt_gasuptk_toso4 = dmsadt_gasuptk
+ end if
+
+!-----------------------------------------------------------------------
+! now compute TMR tendencies
+! this includes the above aqueous so2 chemistry AND
+! the uptake of highly soluble aerosol precursor gases (h2so4, msa, ...)
+! AND the wetremoval of dissolved, unreacted so2 and h2o2
+
+ dso4dt_aqrxn = (delso4_o3rxn + delso4_hprxn(i,k)) / dtime
+ dso4dt_hprxn = delso4_hprxn(i,k) / dtime
+
+! fwetrem = fraction of in-cloud-water material that is wet removed
+! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*clwlrat(i,k)))) )
+ fwetrem = 0.0_r8 ! don't have so4 & msa wet removal here
+
+ !Update so4 in cloud water
+ l = id_so4_1a !We only have one aq-phase tracer in CAM_OSLO
+
+ dqdt_aqso4(i,k,l) = dso4dt_aqrxn*cldfrc(i,k)
+ dqdt_aqh2so4(i,k,l) = &
+ (dso4dt_gasuptk + dmsadt_gasuptk_toso4)*cldfrc(i,k)
+ dqdt_aq = dqdt_aqso4(i,k,l) + dqdt_aqh2so4(i,k,l)
+ dqdt_wr = -fwetrem*dqdt_aq !wet removal set to zero above
+ dqdt= dqdt_aq + dqdt_wr
+ qcw(i,k,l) = qcw(i,k,l) + dqdt*dtime
+
+ !Additional updates for MSA??
+! For gas species, tendency includes
+! reactive uptake to cloud water that essentially transforms the gas to
+! a different species. Wet removal associated with this is applied
+! to the "new" species (e.g., so4_c) rather than to the gas.
+! wet removal of the unreacted gas that is dissolved in cloud water.
+! Need to multiply both these parts by cldfrc
+
+! h2so4 (g) & msa (g)
+ qin(i,k,id_h2so4) = qin(i,k,id_h2so4) - dso4dt_gasuptk * dtime * cldfrc(i,k)
+ if (id_msa > 0) qin(i,k,id_msa) = qin(i,k,id_msa) - dmsadt_gasuptk * dtime * cldfrc(i,k)
+
+
+ ! so2 -- the first order loss rate for so2 is frso2_c*clwlrat(i,k)
+ ! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*frso2_c*clwlrat(i,k)))) )
+ fwetrem = 0.0_r8 ! don't include so2 wet removal here
+
+ dqdt_wr = -fwetrem*xso2(i,k)/dtime*cldfrc(i,k)
+ dqdt_aq = -dso4dt_aqrxn*cldfrc(i,k)
+ dqdt = dqdt_aq + dqdt_wr
+ qin(i,k,id_so2) = qin(i,k,id_so2) + dqdt * dtime
+
+! h2o2 -- the first order loss rate for h2o2 is frh2o2_c*clwlrat(i,k)
+! fwetrem = max( 0.0_r8, (1.0_r8-exp(-min(100._r8,dtime*frh2o2_c*clwlrat(i,k)))) )
+ fwetrem = 0.0_r8 ! don't include h2o2 wet removal here
+
+ dqdt_wr = -fwetrem*xh2o2(i,k)/dtime*cldfrc(i,k)
+ dqdt_aq = -dso4dt_hprxn*cldfrc(i,k)
+ dqdt = dqdt_aq + dqdt_wr
+ qin(i,k,id_h2o2) = qin(i,k,id_h2o2) + dqdt * dtime
+
+ ! NH3
+ if (id_nh3>0) then
+ dqdt_aq = delnh3/dtime*cldfrc(i,k)
+ dqdt = dqdt_aq
+ qin(i,k,id_nh3) = qin(i,k,id_nh3) + dqdt * dtime
+ endif
+
+ ! for SO4 from H2O2/O3 budgets
+ dqdt_aqhprxn(i,k) = dso4dt_hprxn*cldfrc(i,k)
+ dqdt_aqo3rxn(i,k) = (dso4dt_aqrxn - dso4dt_hprxn)*cldfrc(i,k)
+
+ ENDIF !! WHEN CLOUD IS PRESENTED
+
+ endif cloud
+ enddo col_loop
+ enddo lev_loop
+
+ !==============================================================
+ ! ... Update the mixing ratios
+ !==============================================================
+ do k = 1,pver
+
+ qcw(:,k,id_so4_1a) = MAX( qcw(:,k,id_so4_1a), small_value )
+
+ qin(:,k,id_so2) = MAX( qin(:,k,id_so2), small_value )
+
+ if ( id_nh3 > 0 ) then
+ qin(:,k,id_nh3) = MAX( qin(:,k,id_nh3), small_value )
+ endif
+
+ end do
+
+ ! diagnostics
+
+ l = id_so4_1a !Index of the a2-tracer in cloud water
+ n = 1 !Only distribute to one "mode"
+ aqso4(:,n)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ aqso4(i,n)=aqso4(i,n)+dqdt_aqso4(i,k,l)*adv_mass(l)/mbar(i,k) &
+ *pdel(i,k)/gravit ! kg/m2/s
+ enddo
+ enddo
+
+ aqh2so4(:,n)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ aqh2so4(:,n)=aqh2so4(:,n)+dqdt_aqh2so4(i,k,l)*adv_mass(l)/mbar(i,k) &
+ *pdel(i,k)/gravit ! kg/m2/s
+ enddo
+ enddo
+
+ aqso4_h2o2(:) = 0._r8
+ do k=1,pver
+ do i=1,ncol
+ aqso4_h2o2(i)=aqso4_h2o2(i)+dqdt_aqhprxn(i,k)*adv_mass(l)/mbar(i,k) &
+ *pdel(i,k)/gravit ! kg SO4 /m2/s
+ enddo
+ enddo
+
+ if (present(aqso4_h2o2_3d)) then
+ aqso4_h2o2_3d(:,:) = 0._r8
+ do k=1,pver
+ do i=1,ncol
+ aqso4_h2o2_3d(i,k)=dqdt_aqhprxn(i,k)*adv_mass(l)/mbar(i,k) &
+ *pdel(i,k)/gravit ! kg SO4 /m2/s
+ enddo
+ enddo
+ end if
+
+ aqso4_o3(:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ aqso4_o3(i)=aqso4_o3(i)+dqdt_aqo3rxn(i,k)*adv_mass(l)/mbar(i,k) &
+ *pdel(i,k)/gravit ! kg SO4 /m2/s
+ enddo
+ enddo
+
+ if (present(aqso4_o3_3d)) then
+ aqso4_o3_3d(:,:)=0._r8
+ do k=1,pver
+ do i=1,ncol
+ aqso4_o3_3d(i,k)=dqdt_aqo3rxn(i,k)*adv_mass(l)/mbar(i,k) &
+ *pdel(i,k)/gravit ! kg SO4 /m2/s
+ enddo
+ enddo
+ end if
+
+ end subroutine sox_cldaero_update
+
+ !----------------------------------------------------------------------------------
+ !----------------------------------------------------------------------------------
+ subroutine sox_cldaero_destroy_obj( conc_obj )
+ type(cldaero_conc_t), pointer :: conc_obj
+
+ call cldaero_deallocate( conc_obj )
+
+ end subroutine sox_cldaero_destroy_obj
+
+end module sox_cldaero_mod
diff --git a/src/chemistry/oslo_aero/vertical_diffusion.F90 b/src/chemistry/oslo_aero/vertical_diffusion.F90
new file mode 100644
index 0000000000..ad433bb680
--- /dev/null
+++ b/src/chemistry/oslo_aero/vertical_diffusion.F90
@@ -0,0 +1,1561 @@
+module vertical_diffusion
+
+!----------------------------------------------------------------------------------------------------- !
+! Module to compute vertical diffusion of momentum, moisture, trace constituents !
+! and static energy. Separate modules compute !
+! 1. stresses associated with turbulent flow over orography !
+! ( turbulent mountain stress ) !
+! 2. eddy diffusivities, including nonlocal tranport terms !
+! 3. molecular diffusivities !
+! Lastly, a implicit diffusion solver is called, and tendencies retrieved by !
+! differencing the diffused and initial states. !
+! !
+! Calling sequence: !
+! !
+! vertical_diffusion_init Initializes vertical diffustion constants and modules !
+! init_molec_diff Initializes molecular diffusivity module !
+! init_eddy_diff Initializes eddy diffusivity module (includes PBL) !
+! init_tms Initializes turbulent mountain stress module !
+! init_vdiff Initializes diffusion solver module !
+! vertical_diffusion_ts_init Time step initialization (only used for upper boundary condition) !
+! vertical_diffusion_tend Computes vertical diffusion tendencies !
+! compute_tms Computes turbulent mountain stresses !
+! compute_eddy_diff Computes eddy diffusivities and countergradient terms !
+! compute_vdiff Solves vertical diffusion equations, including molecular diffusivities !
+! !
+!----------------------------------------------------------------------------------------------------- !
+! Some notes on refactoring changes made in 2015, which were not quite finished. !
+! !
+! - eddy_diff_tend should really only have state, pbuf, and cam_in as inputs. The process of !
+! removing these arguments, and referring to pbuf fields instead, is not complete. !
+! !
+! - compute_vdiff was intended to be split up into three components: !
+! !
+! 1. Diffusion of winds and heat ("U", "V", and "S" in the fieldlist object). !
+! !
+! 2. Turbulent diffusion of a single constituent !
+! !
+! 3. Molecular diffusion of a single constituent !
+! !
+! This reorganization would allow the three resulting functions to each use a simpler interface !
+! than the current combined version, and possibly also remove the need to use the fieldlist !
+! object at all. !
+! !
+! - The conditionals controlled by "do_pbl_diags" are somewhat scattered. It might be better to !
+! pull out these diagnostic calculations and outfld calls into separate functions. !
+! !
+!---------------------------Code history-------------------------------------------------------------- !
+! J. Rosinski : Jun. 1992 !
+! J. McCaa : Sep. 2004 !
+! S. Park : Aug. 2006, Dec. 2008. Jan. 2010 !
+!----------------------------------------------------------------------------------------------------- !
+
+use shr_kind_mod, only : r8 => shr_kind_r8, i4=> shr_kind_i4
+use ppgrid, only : pcols, pver, pverp
+use constituents, only : pcnst
+use diffusion_solver, only : vdiff_selector
+use cam_abortutils, only : endrun
+use error_messages, only : handle_errmsg
+use physconst, only : &
+ cpair , & ! Specific heat of dry air
+ gravit , & ! Acceleration due to gravity
+ rair , & ! Gas constant for dry air
+ zvir , & ! rh2o/rair - 1
+ latvap , & ! Latent heat of vaporization
+ latice , & ! Latent heat of fusion
+ karman , & ! von Karman constant
+ mwdry , & ! Molecular weight of dry air
+ avogad ! Avogadro's number
+use cam_history, only : fieldname_len
+use perf_mod
+use cam_logfile, only : iulog
+use ref_pres, only : do_molec_diff, nbot_molec
+use phys_control, only : phys_getopts
+use time_manager, only : is_first_step
+
+#ifdef OSLO_AERO
+ use aerosoldef, only: getNumberOfAerosolTracers, fillAerosolTracerList
+#endif
+
+implicit none
+private
+save
+
+! ----------------- !
+! Public interfaces !
+! ----------------- !
+
+public vd_readnl
+public vd_register ! Register multi-time-level variables with physics buffer
+public vertical_diffusion_init ! Initialization
+public vertical_diffusion_ts_init ! Time step initialization (only used for upper boundary condition)
+public vertical_diffusion_tend ! Full vertical diffusion routine
+
+! ------------ !
+! Private data !
+! ------------ !
+
+character(len=16) :: eddy_scheme ! Default set in phys_control.F90, use namelist to change
+! 'HB' = Holtslag and Boville (default)
+! 'HBR' = Holtslag and Boville and Rash
+! 'diag_TKE' = Bretherton and Park ( UW Moist Turbulence Scheme )
+logical, parameter :: wstarent = .true. ! Use wstar (.true.) or TKE (.false.) entrainment closure
+! ( when 'diag_TKE' scheme is selected )
+logical :: do_pseudocon_diff = .false. ! If .true., do pseudo-conservative variables diffusion
+
+character(len=16) :: shallow_scheme ! Shallow convection scheme
+
+type(vdiff_selector) :: fieldlist_wet ! Logical switches for moist mixing ratio diffusion
+type(vdiff_selector) :: fieldlist_dry ! Logical switches for dry mixing ratio diffusion
+type(vdiff_selector) :: fieldlist_molec ! Logical switches for molecular diffusion
+integer :: tke_idx, kvh_idx, kvm_idx ! TKE and eddy diffusivity indices for fields in the physics buffer
+integer :: kvt_idx ! Index for kinematic molecular conductivity
+integer :: turbtype_idx, smaw_idx ! Turbulence type and instability functions
+integer :: tauresx_idx, tauresy_idx ! Redisual stress for implicit surface stress
+
+character(len=fieldname_len) :: vdiffnam(pcnst) ! Names of vertical diffusion tendencies
+integer :: ixcldice, ixcldliq ! Constituent indices for cloud liquid and ice water
+integer :: ixnumice, ixnumliq
+
+integer :: pblh_idx, tpert_idx, qpert_idx
+
+! pbuf fields for unicon
+integer :: qtl_flx_idx = -1 ! for use in cloud macrophysics when UNICON is on
+integer :: qti_flx_idx = -1 ! for use in cloud macrophysics when UNICON is on
+
+! pbuf fields for tms
+integer :: ksrftms_idx = -1
+integer :: tautmsx_idx = -1
+integer :: tautmsy_idx = -1
+
+! pbuf fields for blj (Beljaars)
+integer :: dragblj_idx = -1
+integer :: taubljx_idx = -1
+integer :: taubljy_idx = -1
+
+logical :: diff_cnsrv_mass_check ! do mass conservation check
+logical :: do_iss ! switch for implicit turbulent surface stress
+logical :: prog_modal_aero = .false. ! set true if prognostic modal aerosols are present
+integer :: pmam_ncnst = 0 ! number of prognostic modal aerosol constituents
+integer, allocatable :: pmam_cnst_idx(:) ! constituent indices of prognostic modal aerosols
+
+logical :: do_pbl_diags = .false.
+logical :: waccmx_mode = .false.
+
+contains
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+subroutine vd_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use spmd_utils, only: masterproc, masterprocid, mpi_logical, mpicom
+ use shr_log_mod, only: errMsg => shr_log_errMsg
+ use trb_mtn_stress_cam, only: trb_mtn_stress_readnl
+ use beljaars_drag_cam, only: beljaars_drag_readnl
+ use eddy_diff_cam, only: eddy_diff_readnl
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'vd_readnl'
+
+ namelist /vert_diff_nl/ diff_cnsrv_mass_check, do_iss
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'vert_diff_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, vert_diff_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+ end if
+
+ call mpi_bcast(diff_cnsrv_mass_check, 1, mpi_logical, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error")
+ call mpi_bcast(do_iss, 1, mpi_logical, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error")
+
+ ! Get eddy_scheme setting from phys_control.
+ call phys_getopts( eddy_scheme_out = eddy_scheme, &
+ shallow_scheme_out = shallow_scheme )
+
+ ! TMS reads its own namelist.
+ call trb_mtn_stress_readnl(nlfile)
+
+ ! Beljaars reads its own namelist.
+ call beljaars_drag_readnl(nlfile)
+
+ if (eddy_scheme == 'diag_TKE' .or. eddy_scheme == 'SPCAM_m2005' ) call eddy_diff_readnl(nlfile)
+
+end subroutine vd_readnl
+
+! =============================================================================== !
+! !
+! =============================================================================== !
+
+subroutine vd_register()
+
+ !------------------------------------------------ !
+ ! Register physics buffer fields and constituents !
+ !------------------------------------------------ !
+
+ use physics_buffer, only : pbuf_add_field, dtype_r8, dtype_i4
+ use trb_mtn_stress_cam, only : trb_mtn_stress_register
+ use beljaars_drag_cam, only : beljaars_drag_register
+ use eddy_diff_cam, only : eddy_diff_register
+
+ ! Add fields to physics buffer
+
+ ! kvt is used by gw_drag. only needs physpkg scope.
+ call pbuf_add_field('kvt', 'physpkg', dtype_r8, (/pcols,pverp/), kvt_idx)
+
+
+ if (eddy_scheme /= 'CLUBB_SGS') then
+ call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx)
+ end if
+
+ call pbuf_add_field('kvm', 'global', dtype_r8, (/pcols, pverp/), kvm_idx )
+ call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx)
+ call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx)
+ call pbuf_add_field('turbtype', 'global', dtype_i4, (/pcols, pverp/), turbtype_idx)
+ call pbuf_add_field('smaw', 'global', dtype_r8, (/pcols, pverp/), smaw_idx)
+
+ call pbuf_add_field('tauresx', 'global', dtype_r8, (/pcols/), tauresx_idx)
+ call pbuf_add_field('tauresy', 'global', dtype_r8, (/pcols/), tauresy_idx)
+
+ call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols/), tpert_idx)
+ call pbuf_add_field('qpert', 'global', dtype_r8, (/pcols,pcnst/), qpert_idx)
+
+ if (trim(shallow_scheme) == 'UNICON') then
+ call pbuf_add_field('qtl_flx', 'global', dtype_r8, (/pcols, pverp/), qtl_flx_idx)
+ call pbuf_add_field('qti_flx', 'global', dtype_r8, (/pcols, pverp/), qti_flx_idx)
+ end if
+
+ ! diag_TKE fields
+ if (eddy_scheme == 'diag_TKE' .or. eddy_scheme == 'SPCAM_m2005') then
+ call eddy_diff_register()
+ end if
+
+ ! TMS fields
+ call trb_mtn_stress_register()
+
+ ! Beljaars fields
+ call beljaars_drag_register()
+
+end subroutine vd_register
+
+! =============================================================================== !
+! !
+! =============================================================================== !
+
+subroutine vertical_diffusion_init(pbuf2d)
+
+ !------------------------------------------------------------------!
+ ! Initialization of time independent fields for vertical diffusion !
+ ! Calls initialization routines for subsidiary modules !
+ !----------------------------------------------------------------- !
+
+ use cam_history, only : addfld, add_default, horiz_only
+ use cam_history, only : register_vector_field
+ use eddy_diff_cam, only : eddy_diff_init
+ use hb_diff, only : init_hb_diff
+ use molec_diff, only : init_molec_diff
+ use diffusion_solver, only : init_vdiff, new_fieldlist_vdiff, vdiff_select
+ use constituents, only : cnst_get_ind, cnst_get_type_byind, cnst_name, cnst_get_molec_byind
+ use spmd_utils, only : masterproc
+ use ref_pres, only : press_lim_idx, pref_mid
+ use physics_buffer, only : pbuf_set_field, pbuf_get_index, physics_buffer_desc
+ use rad_constituents, only : rad_cnst_get_info, rad_cnst_get_mode_num_idx, &
+ rad_cnst_get_mam_mmr_idx
+ use trb_mtn_stress_cam,only : trb_mtn_stress_init
+ use beljaars_drag_cam, only : beljaars_drag_init
+ use upper_bc, only : ubc_init
+ use phys_control, only : waccmx_is, fv_am_correction
+
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+ character(128) :: errstring ! Error status for init_vdiff
+ integer :: ntop_eddy ! Top interface level to which eddy vertical diffusion is applied ( = 1 )
+ integer :: nbot_eddy ! Bottom interface level to which eddy vertical diffusion is applied ( = pver )
+ integer :: k ! Vertical loop index
+
+ real(r8), parameter :: ntop_eddy_pres = 1.e-5_r8 ! Pressure below which eddy diffusion is not done in WACCM-X. (Pa)
+
+ integer :: im, l, m, nmodes, nspec
+
+ logical :: history_amwg ! output the variables used by the AMWG diag package
+ logical :: history_eddy ! output the eddy variables
+ logical :: history_budget ! Output tendencies and state variables for CAM4 T, qv, ql, qi
+ integer :: history_budget_histfile_num ! output history file number for budget fields
+ logical :: history_waccm ! output variables of interest for WACCM runs
+
+ ! ----------------------------------------------------------------- !
+
+ if (masterproc) then
+ write(iulog,*)'Initializing vertical diffusion (vertical_diffusion_init)'
+ end if
+
+ ! Check to see if WACCM-X is on (currently we don't care whether the
+ ! ionosphere is on or not, since this neutral diffusion code is the
+ ! same either way).
+ waccmx_mode = waccmx_is('ionosphere') .or. waccmx_is('neutral')
+
+ ! ----------------------------------------------------------------- !
+ ! Get indices of cloud liquid and ice within the constituents array !
+ ! ----------------------------------------------------------------- !
+
+ call cnst_get_ind( 'CLDLIQ', ixcldliq )
+ call cnst_get_ind( 'CLDICE', ixcldice )
+ ! These are optional; with the CAM4 microphysics, there are no number
+ ! constituents.
+ call cnst_get_ind( 'NUMLIQ', ixnumliq, abort=.false. )
+ call cnst_get_ind( 'NUMICE', ixnumice, abort=.false. )
+
+ ! prog_modal_aero determines whether prognostic modal aerosols are present in the run.
+ call phys_getopts(prog_modal_aero_out=prog_modal_aero)
+#ifdef OSLO_AERO
+ prog_modal_aero = .TRUE.
+#endif
+ if (prog_modal_aero) then
+
+ ! Get the constituent indices of the number and mass mixing ratios of the modal
+ ! aerosols.
+ !
+ ! N.B. - This implementation assumes that the prognostic modal aerosols are
+ ! impacting the climate calculation (i.e., can get info from list 0).
+ !
+#ifndef OSLO_AERO
+ !NOTE THAT THIS BREAKS THE CONCEPT OF KEEPEING MAM-AEROSOLS OUT OF
+ !DIFFUSION, BUT IF YOU ARE USING MAM, YOU SHOULD NOT BEE HERE ANYWAY!!
+ ! First need total number of mam constituents
+ call rad_cnst_get_info(0, nmodes=nmodes)
+ do m = 1, nmodes
+ call rad_cnst_get_info(0, m, nspec=nspec)
+ pmam_ncnst = pmam_ncnst + 1 + nspec
+ end do
+
+ allocate(pmam_cnst_idx(pmam_ncnst))
+
+ ! Get the constituent indicies
+ im = 1
+ do m = 1, nmodes
+ call rad_cnst_get_mode_num_idx(m, pmam_cnst_idx(im))
+ im = im + 1
+ call rad_cnst_get_info(0, m, nspec=nspec)
+ do l = 1, nspec
+ call rad_cnst_get_mam_mmr_idx(m, l, pmam_cnst_idx(im))
+ im = im + 1
+ end do
+ end do
+#else if (defined OSLO_AERO)
+ pmam_ncnst = getNumberOfAerosolTracers()
+ allocate(pmam_cnst_idx(pmam_ncnst))
+ call fillAerosolTracerList(pmam_cnst_idx)
+#endif
+ end if
+
+ ! Initialize upper boundary condition module
+
+ call ubc_init()
+
+ ! ---------------------------------------------------------------------------------------- !
+ ! Initialize molecular diffusivity module !
+ ! Note that computing molecular diffusivities is a trivial expense, but constituent !
+ ! diffusivities depend on their molecular weights. Decomposing the diffusion matrix !
+ ! for each constituent is a needless expense unless the diffusivity is significant. !
+ ! ---------------------------------------------------------------------------------------- !
+
+ !----------------------------------------------------------------------------------------
+ ! Initialize molecular diffusion and get top and bottom molecular diffusion limits
+ !----------------------------------------------------------------------------------------
+
+ if( do_molec_diff ) then
+ call init_molec_diff( r8, pcnst, mwdry, avogad, &
+ errstring)
+
+ call handle_errmsg(errstring, subname="init_molec_diff")
+
+ call addfld( 'TTPXMLC', horiz_only, 'A', 'K/S', 'Top interf. temp. flux: molec. viscosity' )
+ if( masterproc ) write(iulog,fmt='(a,i3,5x,a,i3)') 'NBOT_MOLEC =', nbot_molec
+ end if
+
+ ! ---------------------------------- !
+ ! Initialize eddy diffusivity module !
+ ! ---------------------------------- !
+
+ ! ntop_eddy must be 1 or <= nbot_molec
+ ! Currently, it is always 1 except for WACCM-X.
+ if ( waccmx_mode ) then
+ ntop_eddy = press_lim_idx(ntop_eddy_pres, top=.true.)
+ else
+ ntop_eddy = 1
+ end if
+ nbot_eddy = pver
+
+ if (masterproc) write(iulog, fmt='(a,i3,5x,a,i3)') 'NTOP_EDDY =', ntop_eddy, 'NBOT_EDDY =', nbot_eddy
+
+ select case ( eddy_scheme )
+ case ( 'diag_TKE', 'SPCAM_m2005' )
+ if( masterproc ) write(iulog,*) &
+ 'vertical_diffusion_init: eddy_diffusivity scheme: UW Moist Turbulence Scheme by Bretherton and Park'
+ call eddy_diff_init(pbuf2d, ntop_eddy, nbot_eddy)
+ case ( 'HB', 'HBR', 'SPCAM_sam1mom')
+ if( masterproc ) write(iulog,*) 'vertical_diffusion_init: eddy_diffusivity scheme: Holtslag and Boville'
+ call init_hb_diff(gravit, cpair, ntop_eddy, nbot_eddy, pref_mid, &
+ karman, eddy_scheme)
+ call addfld('HB_ri', (/ 'lev' /), 'A', 'no', 'Richardson Number (HB Scheme), I' )
+ case ( 'CLUBB_SGS' )
+ do_pbl_diags = .true.
+ end select
+
+ ! ------------------------------------------- !
+ ! Initialize turbulent mountain stress module !
+ ! ------------------------------------------- !
+
+ call trb_mtn_stress_init()
+
+ ! ----------------------------------- !
+ ! Initialize Beljaars SGO drag module !
+ ! ----------------------------------- !
+
+ call beljaars_drag_init()
+
+ ! ---------------------------------- !
+ ! Initialize diffusion solver module !
+ ! ---------------------------------- !
+
+ call init_vdiff(r8, iulog, rair, cpair, gravit, do_iss, fv_am_correction, errstring)
+ call handle_errmsg(errstring, subname="init_vdiff")
+
+ ! Use fieldlist_wet to select the fields which will be diffused using moist mixing ratios ( all by default )
+ ! Use fieldlist_dry to select the fields which will be diffused using dry mixing ratios.
+
+ fieldlist_wet = new_fieldlist_vdiff( pcnst)
+ fieldlist_dry = new_fieldlist_vdiff( pcnst)
+ fieldlist_molec = new_fieldlist_vdiff( pcnst)
+
+ if( vdiff_select( fieldlist_wet, 'u' ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 'u' ) )
+ if( vdiff_select( fieldlist_wet, 'v' ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 'v' ) )
+ if( vdiff_select( fieldlist_wet, 's' ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 's' ) )
+
+ constit_loop: do k = 1, pcnst
+
+ if (prog_modal_aero) then
+ ! Do not diffuse droplet number - treated in dropmixnuc
+ if (k == ixnumliq) cycle constit_loop
+ ! Don't diffuse modal aerosol - treated in dropmixnuc
+ do m = 1, pmam_ncnst
+ if (k == pmam_cnst_idx(m)) cycle constit_loop
+ enddo
+ end if
+
+ if( cnst_get_type_byind(k) .eq. 'wet' ) then
+ if( vdiff_select( fieldlist_wet, 'q', k ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 'q', k ) )
+ else
+ if( vdiff_select( fieldlist_dry, 'q', k ) .ne. '' ) call endrun( vdiff_select( fieldlist_dry, 'q', k ) )
+ endif
+
+ ! ----------------------------------------------- !
+ ! Select constituents for molecular diffusion !
+ ! ----------------------------------------------- !
+ if ( cnst_get_molec_byind(k) .eq. 'minor' ) then
+ if( vdiff_select(fieldlist_molec,'q',k) .ne. '' ) call endrun( vdiff_select( fieldlist_molec,'q',k ) )
+ endif
+
+ end do constit_loop
+
+ ! ------------------------ !
+ ! Diagnostic output fields !
+ ! ------------------------ !
+
+ do k = 1, pcnst
+ vdiffnam(k) = 'VD'//cnst_name(k)
+ if( k == 1 ) vdiffnam(k) = 'VD01' !**** compatibility with old code ****
+ call addfld( vdiffnam(k), (/ 'lev' /), 'A', 'kg/kg/s', 'Vertical diffusion of '//cnst_name(k) )
+ end do
+
+ if (.not. do_pbl_diags) then
+ call addfld( 'PBLH' , horiz_only , 'A', 'm' , 'PBL height' )
+ call addfld( 'QT' , (/ 'lev' /) , 'A', 'kg/kg' , 'Total water mixing ratio' )
+ call addfld( 'SL' , (/ 'lev' /) , 'A', 'J/kg' , 'Liquid water static energy' )
+ call addfld( 'SLV' , (/ 'lev' /) , 'A', 'J/kg' , 'Liq wat virtual static energy' )
+ call addfld( 'SLFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Liquid static energy flux' )
+ call addfld( 'QTFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Total water flux' )
+ call addfld( 'TKE' , (/ 'ilev' /) , 'A', 'm2/s2' , 'Turbulent Kinetic Energy' )
+ call addfld( 'TPERT' , horiz_only , 'A', 'K' , 'Perturbation temperature (eddies in PBL)' )
+ call addfld( 'QPERT' , horiz_only , 'A', 'kg/kg' , 'Perturbation specific humidity (eddies in PBL)' )
+
+ call addfld( 'UFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Zonal momentum flux' )
+ call addfld( 'VFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Meridional momentm flux' )
+ call register_vector_field('UFLX', 'VFLX')
+ end if
+
+ call addfld( 'USTAR' , horiz_only , 'A', 'm/s' , 'Surface friction velocity' )
+ call addfld( 'KVH' , (/ 'ilev' /) , 'A', 'm2/s' , 'Vertical diffusion diffusivities (heat/moisture)' )
+ call addfld( 'KVM' , (/ 'ilev' /) , 'A', 'm2/s' , 'Vertical diffusion diffusivities (momentum)' )
+ call addfld( 'KVT' , (/ 'ilev' /) , 'A', 'm2/s' , 'Vertical diffusion kinematic molecular conductivity')
+ call addfld( 'CGS' , (/ 'ilev' /) , 'A', 's/m2' , 'Counter-gradient coeff on surface kinematic fluxes' )
+ call addfld( 'DTVKE' , (/ 'lev' /) , 'A', 'K/s' , 'dT/dt vertical diffusion KE dissipation' )
+ call addfld( 'DTV' , (/ 'lev' /) , 'A', 'K/s' , 'T vertical diffusion' )
+ call addfld( 'DUV' , (/ 'lev' /) , 'A', 'm/s2' , 'U vertical diffusion' )
+ call addfld( 'DVV' , (/ 'lev' /) , 'A', 'm/s2' , 'V vertical diffusion' )
+
+ ! ---------------------------------------------------------------------------- !
+ ! Below ( with '_PBL') are for detailed analysis of UW Moist Turbulence Scheme !
+ ! ---------------------------------------------------------------------------- !
+
+ if (.not. do_pbl_diags) then
+
+ call addfld( 'qt_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qt_prePBL' )
+ call addfld( 'sl_pre_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'sl_prePBL' )
+ call addfld( 'slv_pre_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'slv_prePBL' )
+ call addfld( 'u_pre_PBL', (/ 'lev' /) , 'A', 'm/s' , 'u_prePBL' )
+ call addfld( 'v_pre_PBL', (/ 'lev' /) , 'A', 'm/s' , 'v_prePBL' )
+ call addfld( 'qv_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qv_prePBL' )
+ call addfld( 'ql_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'ql_prePBL' )
+ call addfld( 'qi_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qi_prePBL' )
+ call addfld( 't_pre_PBL', (/ 'lev' /) , 'A', 'K' , 't_prePBL' )
+ call addfld( 'rh_pre_PBL', (/ 'lev' /) , 'A', '%' , 'rh_prePBL' )
+
+ call addfld( 'qt_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qt_afterPBL' )
+ call addfld( 'sl_aft_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'sl_afterPBL' )
+ call addfld( 'slv_aft_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'slv_afterPBL' )
+ call addfld( 'u_aft_PBL', (/ 'lev' /) , 'A', 'm/s' , 'u_afterPBL' )
+ call addfld( 'v_aft_PBL', (/ 'lev' /) , 'A', 'm/s' , 'v_afterPBL' )
+ call addfld( 'qv_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qv_afterPBL' )
+ call addfld( 'ql_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'ql_afterPBL' )
+ call addfld( 'qi_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qi_afterPBL' )
+ call addfld( 't_aft_PBL', (/ 'lev' /) , 'A', 'K' , 't_afterPBL' )
+ call addfld( 'rh_aft_PBL', (/ 'lev' /) , 'A', '%' , 'rh_afterPBL' )
+
+ call addfld( 'slflx_PBL', (/ 'ilev' /) , 'A', 'J/m2/s' , 'sl flux by PBL' )
+ call addfld( 'qtflx_PBL', (/ 'ilev' /) , 'A', 'kg/m2/s', 'qt flux by PBL' )
+ call addfld( 'uflx_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'u flux by PBL' )
+ call addfld( 'vflx_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'v flux by PBL' )
+
+ call addfld( 'slflx_cg_PBL', (/ 'ilev' /) , 'A', 'J/m2/s' , 'sl_cg flux by PBL' )
+ call addfld( 'qtflx_cg_PBL', (/ 'ilev' /) , 'A', 'kg/m2/s', 'qt_cg flux by PBL' )
+ call addfld( 'uflx_cg_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'u_cg flux by PBL' )
+ call addfld( 'vflx_cg_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'v_cg flux by PBL' )
+
+ call addfld( 'qtten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'qt tendency by PBL' )
+ call addfld( 'slten_PBL', (/ 'lev' /) , 'A', 'J/kg/s' , 'sl tendency by PBL' )
+ call addfld( 'uten_PBL', (/ 'lev' /) , 'A', 'm/s2' , 'u tendency by PBL' )
+ call addfld( 'vten_PBL', (/ 'lev' /) , 'A', 'm/s2' , 'v tendency by PBL' )
+ call addfld( 'qvten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'qv tendency by PBL' )
+ call addfld( 'qlten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'ql tendency by PBL' )
+ call addfld( 'qiten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'qi tendency by PBL' )
+ call addfld( 'tten_PBL', (/ 'lev' /) , 'A', 'K/s' , 'T tendency by PBL' )
+ call addfld( 'rhten_PBL', (/ 'lev' /) , 'A', '%/s' , 'RH tendency by PBL' )
+
+ end if
+
+ call addfld ('ustar',horiz_only, 'A', ' ',' ')
+ call addfld ('obklen',horiz_only, 'A', ' ',' ')
+
+ ! ----------------------------
+ ! determine default variables
+ ! ----------------------------
+
+ call phys_getopts( history_amwg_out = history_amwg, &
+ history_eddy_out = history_eddy, &
+ history_budget_out = history_budget, &
+ history_budget_histfile_num_out = history_budget_histfile_num, &
+ history_waccm_out = history_waccm)
+
+ if (history_amwg) then
+ call add_default( vdiffnam(1), 1, ' ' )
+ call add_default( 'DTV' , 1, ' ' )
+ if (.not. do_pbl_diags) then
+ call add_default( 'PBLH' , 1, ' ' )
+ end if
+ endif
+
+ if (history_eddy) then
+ call add_default( 'UFLX ', 1, ' ' )
+ call add_default( 'VFLX ', 1, ' ' )
+ endif
+
+ if( history_budget ) then
+ call add_default( vdiffnam(ixcldliq), history_budget_histfile_num, ' ' )
+ call add_default( vdiffnam(ixcldice), history_budget_histfile_num, ' ' )
+!AL
+ call add_default( vdiffnam(ixnumliq), history_budget_histfile_num, ' ' )
+ call add_default( vdiffnam(ixnumice), history_budget_histfile_num, ' ' )
+!AL
+ if( history_budget_histfile_num > 1 ) then
+ call add_default( vdiffnam(1), history_budget_histfile_num, ' ' )
+ call add_default( 'DTV' , history_budget_histfile_num, ' ' )
+ end if
+ end if
+
+ if ( history_waccm ) then
+ if (do_molec_diff) then
+ call add_default ( 'TTPXMLC', 1, ' ' )
+ end if
+ call add_default( 'DUV' , 1, ' ' )
+ call add_default( 'DVV' , 1, ' ' )
+ end if
+ ! ----------------------------
+
+
+ ksrftms_idx = pbuf_get_index('ksrftms')
+ tautmsx_idx = pbuf_get_index('tautmsx')
+ tautmsy_idx = pbuf_get_index('tautmsy')
+
+ dragblj_idx = pbuf_get_index('dragblj')
+ taubljx_idx = pbuf_get_index('taubljx')
+ taubljy_idx = pbuf_get_index('taubljy')
+
+ if (eddy_scheme == 'CLUBB_SGS') then
+ kvh_idx = pbuf_get_index('kvh')
+ end if
+
+ ! Initialization of some pbuf fields
+ if (is_first_step()) then
+ ! Initialization of pbuf fields tke, kvh, kvm are done in phys_inidat
+ call pbuf_set_field(pbuf2d, turbtype_idx, 0 )
+ call pbuf_set_field(pbuf2d, smaw_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, tauresx_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, tauresy_idx, 0.0_r8)
+ if (trim(shallow_scheme) == 'UNICON') then
+ call pbuf_set_field(pbuf2d, qtl_flx_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, qti_flx_idx, 0.0_r8)
+ end if
+ end if
+
+end subroutine vertical_diffusion_init
+
+! =============================================================================== !
+! !
+! =============================================================================== !
+
+subroutine vertical_diffusion_ts_init( pbuf2d, state )
+
+ !-------------------------------------------------------------- !
+ ! Timestep dependent setting, !
+ ! At present only invokes upper bc code !
+ !-------------------------------------------------------------- !
+ use upper_bc, only : ubc_timestep_init
+ use physics_types , only : physics_state
+ use ppgrid , only : begchunk, endchunk
+
+ use physics_buffer, only : physics_buffer_desc
+
+ type(physics_state), intent(in) :: state(begchunk:endchunk)
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ call ubc_timestep_init( pbuf2d, state)
+
+end subroutine vertical_diffusion_ts_init
+
+! =============================================================================== !
+! !
+! =============================================================================== !
+
+subroutine vertical_diffusion_tend( &
+ ztodt , state , cam_in, &
+ ustar , obklen , ptend , &
+ cldn , pbuf)
+ !---------------------------------------------------- !
+ ! This is an interface routine for vertical diffusion !
+ !---------------------------------------------------- !
+ use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_set_field
+ use physics_types, only : physics_state, physics_ptend, physics_ptend_init
+ use camsrfexch, only : cam_in_t
+ use cam_history, only : outfld
+
+ use trb_mtn_stress_cam, only : trb_mtn_stress_tend
+ use beljaars_drag_cam, only : beljaars_drag_tend
+ use eddy_diff_cam, only : eddy_diff_tend
+ use hb_diff, only : compute_hb_diff
+ use wv_saturation, only : qsat
+ use molec_diff, only : compute_molec_diff, vd_lu_qdecomp
+ use constituents, only : qmincg, qmin
+ use diffusion_solver, only : compute_vdiff, any, operator(.not.)
+ use physconst, only : cpairv, rairv !Needed for calculation of upward H flux
+ use time_manager, only : get_nstep
+ use constituents, only : cnst_get_type_byind, cnst_name, &
+ cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx
+ use physconst, only : pi
+ use pbl_utils, only : virtem, calc_obklen, calc_ustar
+ use upper_bc, only : ubc_get_vals
+ use coords_1d, only : Coords1D
+
+ ! --------------- !
+ ! Input Arguments !
+ ! --------------- !
+
+ type(physics_state), intent(in) :: state ! Physics state variables
+ type(cam_in_t), intent(in) :: cam_in ! Surface inputs
+
+ real(r8), intent(in) :: ztodt ! 2 delta-t [ s ]
+ real(r8), intent(in) :: cldn(pcols,pver) ! New stratus fraction [ fraction ]
+
+ ! ---------------------- !
+ ! Input-Output Arguments !
+ ! ---------------------- !
+
+ type(physics_ptend), intent(out) :: ptend ! Individual parameterization tendencies
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! ---------------- !
+ ! Output Arguments !
+ ! ---------------- !
+
+ real(r8), intent(out) :: ustar(pcols) ! Surface friction velocity [ m/s ]
+ real(r8), intent(out) :: obklen(pcols) ! Obukhov length [ m ]
+
+ ! --------------- !
+ ! Local Variables !
+ ! --------------- !
+
+ character(128) :: errstring ! Error status for compute_vdiff
+
+ integer :: lchnk ! Chunk identifier
+ integer :: ncol ! Number of atmospheric columns
+ integer :: i, k, l, m ! column, level, constituent indices
+
+ real(r8) :: dtk(pcols,pver) ! T tendency from KE dissipation
+ real(r8), pointer :: tke(:,:) ! Turbulent kinetic energy [ m2/s2 ]
+ integer(i4),pointer :: turbtype(:,:) ! Turbulent interface types [ no unit ]
+ real(r8), pointer :: smaw(:,:) ! Normalized Galperin instability function
+ ! ( 0<= <=4.964 and 1 at neutral )
+
+ real(r8), pointer :: qtl_flx(:,:) ! overbar(w'qtl') where qtl = qv + ql
+ real(r8), pointer :: qti_flx(:,:) ! overbar(w'qti') where qti = qv + qi
+
+ real(r8) :: cgs(pcols,pverp) ! Counter-gradient star [ cg/flux ]
+ real(r8) :: cgh(pcols,pverp) ! Counter-gradient term for heat
+ real(r8) :: rztodt ! 1./ztodt [ 1/s ]
+ real(r8), pointer :: ksrftms(:) ! Turbulent mountain stress surface drag coefficient [ kg/s/m2 ]
+ real(r8), pointer :: tautmsx(:) ! U component of turbulent mountain stress [ N/m2 ]
+ real(r8), pointer :: tautmsy(:) ! V component of turbulent mountain stress [ N/m2 ]
+ real(r8) :: tautotx(pcols) ! U component of total surface stress [ N/m2 ]
+ real(r8) :: tautoty(pcols) ! V component of total surface stress [ N/m2 ]
+
+ real(r8), pointer :: dragblj(:,:) ! Beljaars SGO form drag profile [ 1/s ]
+ real(r8), pointer :: taubljx(:) ! U component of turbulent mountain stress [ N/m2 ]
+ real(r8), pointer :: taubljy(:) ! V component of turbulent mountain stress [ N/m2 ]
+
+ real(r8), pointer :: kvh_in(:,:) ! kvh from previous timestep [ m2/s ]
+ real(r8), pointer :: kvm_in(:,:) ! kvm from previous timestep [ m2/s ]
+ real(r8), pointer :: kvt(:,:) ! Molecular kinematic conductivity for temperature [ ]
+ real(r8) :: kvq(pcols,pverp) ! Eddy diffusivity for constituents [ m2/s ]
+ real(r8) :: kvh(pcols,pverp) ! Eddy diffusivity for heat [ m2/s ]
+ real(r8) :: kvm(pcols,pverp) ! Eddy diffusivity for momentum [ m2/s ]
+ real(r8) :: kvm_temp(pcols,pverp) ! Dummy eddy diffusivity for momentum (unused) [ m2/s ]
+ real(r8) :: dtk_temp(pcols,pverp) ! Unused output from second compute_vdiff call
+ real(r8) :: tautmsx_temp(pcols) ! Unused output from second compute_vdiff call
+ real(r8) :: tautmsy_temp(pcols) ! Unused output from second compute_vdiff call
+ real(r8) :: topflx_temp(pcols) ! Unused output from second compute_vdiff call
+ real(r8) :: sprod(pcols,pverp) ! Shear production of tke [ m2/s3 ]
+ real(r8) :: sfi(pcols,pverp) ! Saturation fraction at interfaces [ fraction ]
+ real(r8) :: sl(pcols,pver)
+ real(r8) :: qt(pcols,pver)
+ real(r8) :: slv(pcols,pver)
+ real(r8) :: sl_prePBL(pcols,pver)
+ real(r8) :: qt_prePBL(pcols,pver)
+ real(r8) :: slv_prePBL(pcols,pver)
+ real(r8) :: slten(pcols,pver)
+ real(r8) :: qtten(pcols,pver)
+ real(r8) :: slflx(pcols,pverp)
+ real(r8) :: qtflx(pcols,pverp)
+ real(r8) :: uflx(pcols,pverp)
+ real(r8) :: vflx(pcols,pverp)
+ real(r8) :: slflx_cg(pcols,pverp)
+ real(r8) :: qtflx_cg(pcols,pverp)
+ real(r8) :: uflx_cg(pcols,pverp)
+ real(r8) :: vflx_cg(pcols,pverp)
+ real(r8) :: th(pcols,pver) ! Potential temperature
+ real(r8) :: topflx(pcols) ! Molecular heat flux at top interface
+ real(r8) :: rhoair
+
+ real(r8) :: ri(pcols,pver) ! richardson number (HB output)
+
+ ! for obklen calculation outside HB
+ real(r8) :: thvs(pcols) ! Virtual potential temperature at surface
+ real(r8) :: rrho(pcols) ! Reciprocal of density at surface
+ real(r8) :: khfs(pcols) ! sfc kinematic heat flux [mK/s]
+ real(r8) :: kqfs(pcols) ! sfc kinematic water vapor flux [m/s]
+ real(r8) :: kbfs(pcols) ! sfc kinematic buoyancy flux [m^2/s^3]
+
+ real(r8) :: ftem(pcols,pver) ! Saturation vapor pressure before PBL
+ real(r8) :: ftem_prePBL(pcols,pver) ! Saturation vapor pressure before PBL
+ real(r8) :: ftem_aftPBL(pcols,pver) ! Saturation vapor pressure after PBL
+ real(r8) :: tem2(pcols,pver) ! Saturation specific humidity and RH
+ real(r8) :: t_aftPBL(pcols,pver) ! Temperature after PBL diffusion
+ real(r8) :: tten(pcols,pver) ! Temperature tendency by PBL diffusion
+ real(r8) :: rhten(pcols,pver) ! RH tendency by PBL diffusion
+ real(r8) :: qv_aft_PBL(pcols,pver) ! qv after PBL diffusion
+ real(r8) :: ql_aft_PBL(pcols,pver) ! ql after PBL diffusion
+ real(r8) :: qi_aft_PBL(pcols,pver) ! qi after PBL diffusion
+ real(r8) :: s_aft_PBL(pcols,pver) ! s after PBL diffusion
+ real(r8) :: u_aft_PBL(pcols,pver) ! u after PBL diffusion
+ real(r8) :: v_aft_PBL(pcols,pver) ! v after PBL diffusion
+ real(r8) :: qv_pro(pcols,pver)
+ real(r8) :: ql_pro(pcols,pver)
+ real(r8) :: qi_pro(pcols,pver)
+ real(r8) :: s_pro(pcols,pver)
+ real(r8) :: t_pro(pcols,pver)
+ real(r8), pointer :: tauresx(:) ! Residual stress to be added in vdiff to correct
+ real(r8), pointer :: tauresy(:) ! for turb stress mismatch between sfc and atm accumulated.
+
+ ! Interpolated interface values.
+ real(r8) :: tint(pcols,pver+1) ! Temperature [ K ]
+ real(r8) :: rairi(pcols,pver+1) ! Gas constant [ J/K/kg ]
+ real(r8) :: rhoi(pcols,pver+1) ! Density of air [ kg/m^3 ]
+ real(r8) :: rhoi_dry(pcols,pver+1) ! Density of air based on dry air pressure [ kg/m^3 ]
+
+ ! Upper boundary conditions
+ real(r8) :: ubc_t(pcols) ! Temperature [ K ]
+ real(r8) :: ubc_mmr(pcols,pcnst) ! Mixing ratios [ kg/kg ]
+ real(r8) :: ubc_flux(pcols,pcnst) ! Constituent upper boundary flux (kg/s/m^2)
+
+ ! Pressure coordinates used by the solver.
+ type(Coords1D) :: p
+ type(Coords1D) :: p_dry
+
+ real(r8), pointer :: tpert(:)
+ real(r8), pointer :: qpert(:)
+ real(r8), pointer :: pblh(:)
+
+ real(r8) :: tmp1(pcols) ! Temporary storage
+
+ integer :: nstep
+ real(r8) :: sum1, sum2, sum3, pdelx
+ real(r8) :: sflx
+
+ ! Copy state so we can pass to intent(inout) routines that return
+ ! new state instead of a tendency.
+ real(r8) :: s_tmp(pcols,pver)
+ real(r8) :: u_tmp(pcols,pver)
+ real(r8) :: v_tmp(pcols,pver)
+ real(r8) :: q_tmp(pcols,pver,pcnst)
+
+ ! kq_fac*sqrt(T)*m_d/rho for molecular diffusivity
+ real(r8) :: kq_scal(pcols,pver+1)
+ ! composition dependent mw_fac on interface level
+ real(r8) :: mw_fac(pcols,pver+1,pcnst)
+
+ ! Dry static energy top boundary condition.
+ real(r8) :: dse_top(pcols)
+
+ ! Copies of flux arrays used to zero out any parts that are applied
+ ! elsewhere (e.g. by CLUBB).
+ real(r8) :: taux(pcols)
+ real(r8) :: tauy(pcols)
+ real(r8) :: shflux(pcols)
+ real(r8) :: cflux(pcols,pcnst)
+
+ logical :: lq(pcnst)
+
+ ! ----------------------- !
+ ! Main Computation Begins !
+ ! ----------------------- !
+
+ rztodt = 1._r8 / ztodt
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ call pbuf_get_field(pbuf, tauresx_idx, tauresx)
+ call pbuf_get_field(pbuf, tauresy_idx, tauresy)
+ call pbuf_get_field(pbuf, tpert_idx, tpert)
+ call pbuf_get_field(pbuf, qpert_idx, qpert)
+ call pbuf_get_field(pbuf, pblh_idx, pblh)
+ call pbuf_get_field(pbuf, turbtype_idx, turbtype)
+
+ ! Interpolate temperature to interfaces.
+ do k = 2, pver
+ do i = 1, ncol
+ tint(i,k) = 0.5_r8 * ( state%t(i,k) + state%t(i,k-1) )
+ end do
+ end do
+ tint(:ncol,pver+1) = state%t(:ncol,pver)
+
+ ! Get upper boundary values
+ call ubc_get_vals( state%lchnk, ncol, state%pint, state%zi, state%t, state%q, state%omega, state%phis, &
+ ubc_t, ubc_mmr, ubc_flux )
+
+ ! Always have a fixed upper boundary T if molecular diffusion is active. Why ?
+ ! For WACCM-X, set ubc temperature to extrapolate from next two lower interface level temperatures
+ if (do_molec_diff) then
+ if (waccmx_mode) then
+ tint(:ncol,1) = 1.5_r8*tint(:ncol,2)-.5_r8*tint(:ncol,3)
+ else
+ tint (:ncol,1) = ubc_t(:ncol)
+ endif
+ else
+ tint(:ncol,1) = state%t(:ncol,1)
+ end if
+
+ ! Set up pressure coordinates for solver calls.
+ p = Coords1D(state%pint(:ncol,:))
+ p_dry = Coords1D(state%pintdry(:ncol,:))
+
+ !------------------------------------------------------------------------
+ ! Check to see if constituent dependent gas constant needed (WACCM-X)
+ !------------------------------------------------------------------------
+ if (waccmx_mode) then
+ rairi(:ncol,1) = rairv(:ncol,1,lchnk)
+ do k = 2, pver
+ do i = 1, ncol
+ rairi(i,k) = 0.5_r8 * (rairv(i,k,lchnk)+rairv(i,k-1,lchnk))
+ end do
+ end do
+ rairi(:ncol,pver+1) = rairv(:ncol,pver,lchnk)
+ else
+ rairi(:ncol,:pver+1) = rair
+ endif
+
+ ! Compute rho at interfaces.
+ do k = 1, pver+1
+ do i = 1, ncol
+ rhoi(i,k) = p%ifc(i,k) / (rairi(i,k)*tint(i,k))
+ end do
+ end do
+
+ ! Compute rho_dry at interfaces.
+ do k = 1, pver+1
+ do i = 1, ncol
+ rhoi_dry(i,k) = p_dry%ifc(i,k) / (rairi(i,k)*tint(i,k))
+ end do
+ end do
+
+ ! ---------------------------------------- !
+ ! Computation of turbulent mountain stress !
+ ! ---------------------------------------- !
+
+ ! Consistent with the computation of 'normal' drag coefficient, we are using
+ ! the raw input (u,v) to compute 'ksrftms', not the provisionally-marched 'u,v'
+ ! within the iteration loop of the PBL scheme.
+
+ call trb_mtn_stress_tend(state, pbuf, cam_in)
+
+ call pbuf_get_field(pbuf, ksrftms_idx, ksrftms)
+ call pbuf_get_field(pbuf, tautmsx_idx, tautmsx)
+ call pbuf_get_field(pbuf, tautmsy_idx, tautmsy)
+
+ tautotx(:ncol) = cam_in%wsx(:ncol) + tautmsx(:ncol)
+ tautoty(:ncol) = cam_in%wsy(:ncol) + tautmsy(:ncol)
+
+ ! ------------------------------------- !
+ ! Computation of Beljaars SGO form drag !
+ ! ------------------------------------- !
+
+ call beljaars_drag_tend(state, pbuf, cam_in)
+
+ call pbuf_get_field(pbuf, dragblj_idx, dragblj)
+ call pbuf_get_field(pbuf, taubljx_idx, taubljx)
+ call pbuf_get_field(pbuf, taubljy_idx, taubljy)
+
+ ! Add Beljaars integrated drag
+
+ tautotx(:ncol) = tautotx(:ncol) + taubljx(:ncol)
+ tautoty(:ncol) = tautoty(:ncol) + taubljy(:ncol)
+
+ !----------------------------------------------------------------------- !
+ ! Computation of eddy diffusivities - Select appropriate PBL scheme !
+ !----------------------------------------------------------------------- !
+ call pbuf_get_field(pbuf, kvm_idx, kvm_in)
+ call pbuf_get_field(pbuf, kvh_idx, kvh_in)
+ call pbuf_get_field(pbuf, smaw_idx, smaw)
+ call pbuf_get_field(pbuf, tke_idx, tke)
+
+ ! Get potential temperature.
+ th(:ncol,:pver) = state%t(:ncol,:pver) * state%exner(:ncol,:pver)
+
+ select case (eddy_scheme)
+ case ( 'diag_TKE', 'SPCAM_m2005' )
+
+ call eddy_diff_tend(state, pbuf, cam_in, &
+ ztodt, p, tint, rhoi, cldn, wstarent, &
+ kvm_in, kvh_in, ksrftms, dragblj, tauresx, tauresy, &
+ rrho, ustar, pblh, kvm, kvh, kvq, cgh, cgs, tpert, qpert, &
+ tke, sprod, sfi, turbtype, smaw)
+
+ ! The diag_TKE scheme does not calculate the Monin-Obukhov length, which is used in dry deposition calculations.
+ ! Use the routines from pbl_utils to accomplish this. Assumes ustar and rrho have been set.
+ call virtem(ncol, th(:ncol,pver),state%q(:ncol,pver,1), thvs(:ncol))
+ call calc_obklen(ncol, th(:ncol,pver), thvs(:ncol), cam_in%cflx(:ncol,1), &
+ cam_in%shf(:ncol), rrho(:ncol), ustar(:ncol), &
+ khfs(:ncol), kqfs(:ncol), kbfs(:ncol), obklen(:ncol))
+
+
+ case ( 'HB', 'HBR', 'SPCAM_sam1mom' )
+
+ ! Modification : We may need to use 'taux' instead of 'tautotx' here, for
+ ! consistency with the previous HB scheme.
+
+ call compute_hb_diff( lchnk , ncol , &
+ th , state%t , state%q , state%zm , state%zi, &
+ state%pmid, state%u , state%v , tautotx , tautoty , &
+ cam_in%shf, cam_in%cflx(:,1), obklen , ustar , pblh , &
+ kvm , kvh , kvq , cgh , cgs , &
+ tpert , qpert , cldn , cam_in%ocnfrac , tke , &
+ ri , &
+ eddy_scheme )
+
+ call outfld( 'HB_ri', ri, pcols, lchnk )
+
+ case ( 'CLUBB_SGS' )
+
+ ! CLUBB has only a bare-bones placeholder here. If using CLUBB, the
+ ! PBL diffusion will happen before coupling, so vertical_diffusion
+ ! is only handling other things, e.g. some boundary conditions, tms,
+ ! and molecular diffusion.
+
+ call virtem(ncol, th(:ncol,pver),state%q(:ncol,pver,1), thvs(:ncol))
+
+ call calc_ustar( ncol, state%t(:ncol,pver), state%pmid(:ncol,pver), &
+ cam_in%wsx(:ncol), cam_in%wsy(:ncol), rrho(:ncol), ustar(:ncol))
+ ! Use actual qflux, not lhf/latvap as was done previously
+ call calc_obklen( ncol, th(:ncol,pver), thvs(:ncol), cam_in%cflx(:ncol,1), &
+ cam_in%shf(:ncol), rrho(:ncol), ustar(:ncol), &
+ khfs(:ncol), kqfs(:ncol), kbfs(:ncol), obklen(:ncol))
+
+ ! These tendencies all applied elsewhere.
+ kvm = 0._r8
+ kvh = 0._r8
+ kvq = 0._r8
+
+ ! Not defined since PBL is not actually running here.
+ cgh = 0._r8
+ cgs = 0._r8
+
+ end select
+
+ call outfld( 'ustar', ustar(:), pcols, lchnk )
+ call outfld( 'obklen', obklen(:), pcols, lchnk )
+
+ ! kvh (in pbuf) is used by other physics parameterizations, and as an initial guess in compute_eddy_diff
+ ! on the next timestep. It is not updated by the compute_vdiff call below.
+ call pbuf_set_field(pbuf, kvh_idx, kvh)
+
+ ! kvm (in pbuf) is only used as an initial guess in compute_eddy_diff on the next timestep.
+ ! The contributions for molecular diffusion made to kvm by the call to compute_vdiff below
+ ! are not included in the pbuf as these are not needed in the initial guess by compute_eddy_diff.
+ call pbuf_set_field(pbuf, kvm_idx, kvm)
+
+ !------------------------------------ !
+ ! Application of diffusivities !
+ !------------------------------------ !
+
+ ! Set arrays from input state.
+ q_tmp(:ncol,:,:) = state%q(:ncol,:,:)
+ s_tmp(:ncol,:) = state%s(:ncol,:)
+ u_tmp(:ncol,:) = state%u(:ncol,:)
+ v_tmp(:ncol,:) = state%v(:ncol,:)
+
+ !------------------------------------------------------ !
+ ! Write profile output before applying diffusion scheme !
+ !------------------------------------------------------ !
+
+ if (.not. do_pbl_diags) then
+ sl_prePBL(:ncol,:pver) = s_tmp(:ncol,:) - latvap * q_tmp(:ncol,:,ixcldliq) &
+ - ( latvap + latice) * q_tmp(:ncol,:,ixcldice)
+ qt_prePBL(:ncol,:pver) = q_tmp(:ncol,:,1) + q_tmp(:ncol,:,ixcldliq) &
+ + q_tmp(:ncol,:,ixcldice)
+ slv_prePBL(:ncol,:pver) = sl_prePBL(:ncol,:pver) * ( 1._r8 + zvir*qt_prePBL(:ncol,:pver) )
+
+ call qsat(state%t(:ncol,:), state%pmid(:ncol,:), &
+ tem2(:ncol,:), ftem(:ncol,:))
+ ftem_prePBL(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8
+
+ call outfld( 'qt_pre_PBL ', qt_prePBL, pcols, lchnk )
+ call outfld( 'sl_pre_PBL ', sl_prePBL, pcols, lchnk )
+ call outfld( 'slv_pre_PBL ', slv_prePBL, pcols, lchnk )
+ call outfld( 'u_pre_PBL ', state%u, pcols, lchnk )
+ call outfld( 'v_pre_PBL ', state%v, pcols, lchnk )
+ call outfld( 'qv_pre_PBL ', state%q(:ncol,:,1), pcols, lchnk )
+ call outfld( 'ql_pre_PBL ', state%q(:ncol,:,ixcldliq), pcols, lchnk )
+ call outfld( 'qi_pre_PBL ', state%q(:ncol,:,ixcldice), pcols, lchnk )
+ call outfld( 't_pre_PBL ', state%t, pcols, lchnk )
+ call outfld( 'rh_pre_PBL ', ftem_prePBL, pcols, lchnk )
+
+ end if
+
+ ! --------------------------------------------------------------------------------- !
+ ! Call the diffusivity solver and solve diffusion equation !
+ ! The final two arguments are optional function references to !
+ ! constituent-independent and constituent-dependent moleculuar diffusivity routines !
+ ! --------------------------------------------------------------------------------- !
+
+ ! Modification : We may need to output 'tautotx_im,tautoty_im' from below 'compute_vdiff' and
+ ! separately print out as diagnostic output, because these are different from
+ ! the explicit 'tautotx, tautoty' computed above.
+ ! Note that the output 'tauresx,tauresy' from below subroutines are fully implicit ones.
+
+ call pbuf_get_field(pbuf, kvt_idx, kvt)
+
+ if (do_molec_diff .and. .not. waccmx_mode) then
+ ! Top boundary condition for dry static energy
+ dse_top(:ncol) = cpairv(:ncol,1,lchnk) * tint(:ncol,1) + &
+ gravit * state%zi(:ncol,1)
+ else
+ dse_top(:ncol) = 0._r8
+ end if
+
+ select case (eddy_scheme)
+ case ('CLUBB_SGS')
+ ! CLUBB applies some fluxes itself, but we still want constituent
+ ! fluxes applied here (except water vapor).
+ taux = 0._r8
+ tauy = 0._r8
+ shflux = 0._r8
+ cflux(:,1) = 0._r8
+ cflux(:,2:) = cam_in%cflx(:,2:)
+ case default
+ taux = cam_in%wsx
+ tauy = cam_in%wsy
+ shflux = cam_in%shf
+ cflux = cam_in%cflx
+ end select
+
+ if( any(fieldlist_wet) ) then
+
+ if (do_molec_diff) then
+ call compute_molec_diff(state%lchnk, pcols, pver, pcnst, ncol, &
+ kvm, kvt, tint, rhoi, kq_scal, cnst_mw, &
+ mw_fac, nbot_molec)
+ end if
+
+ call compute_vdiff( state%lchnk , &
+ pcols , pver , pcnst , ncol , tint , &
+ p , state%t , rhoi, ztodt , taux , &
+ tauy , shflux , cflux , &
+ kvh , kvm , kvq , cgs , cgh , &
+ state%zi , ksrftms , dragblj , &
+ qmincg , fieldlist_wet , fieldlist_molec,&
+ u_tmp , v_tmp , q_tmp , s_tmp , &
+ tautmsx , tautmsy , dtk , topflx , errstring , &
+ tauresx , tauresy , 1 , cpairv(:,:,state%lchnk), dse_top, &
+ do_molec_diff, waccmx_mode, &
+ vd_lu_qdecomp, &
+ ubc_mmr, ubc_flux, kvt, state%pmid, &
+ cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx, nbot_molec, &
+ kq_scal, mw_fac)
+
+ call handle_errmsg(errstring, subname="compute_vdiff", &
+ extra_msg="Error in fieldlist_wet call from vertical_diffusion.")
+
+ end if
+
+ if( any( fieldlist_dry ) ) then
+
+ if( do_molec_diff ) then
+ ! kvm is unused in the output here (since it was assigned
+ ! above), so we use a temp kvm for the inout argument, and
+ ! ignore the value output by compute_molec_diff.
+ kvm_temp = kvm
+ call compute_molec_diff(state%lchnk, pcols, pver, pcnst, ncol, &
+ kvm_temp, kvt, tint, rhoi_dry, kq_scal, cnst_mw, &
+ mw_fac, nbot_molec)
+ end if
+
+ call compute_vdiff( state%lchnk , &
+ pcols , pver , pcnst , ncol , tint , &
+ p_dry , state%t , rhoi_dry, ztodt , taux , &
+ tauy , shflux , cflux , &
+ kvh , kvm , kvq , cgs , cgh , &
+ state%zi , ksrftms , dragblj , &
+ qmincg , fieldlist_dry , fieldlist_molec,&
+ u_tmp , v_tmp , q_tmp , s_tmp , &
+ tautmsx_temp , tautmsy_temp , dtk_temp , topflx_temp , errstring , &
+ tauresx , tauresy , 1 , cpairv(:,:,state%lchnk), dse_top, &
+ do_molec_diff , waccmx_mode, &
+ vd_lu_qdecomp, &
+ ubc_mmr, ubc_flux, kvt, state%pmiddry, &
+ cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx, nbot_molec, &
+ kq_scal, mw_fac)
+
+ call handle_errmsg(errstring, subname="compute_vdiff", &
+ extra_msg="Error in fieldlist_dry call from vertical_diffusion.")
+
+ end if
+
+ if (prog_modal_aero) then
+
+ ! Modal aerosol species not diffused, so just add the explicit surface fluxes to the
+ ! lowest layer
+
+!Oslo aero adds emissions together with dry deposition
+#ifndef OSLO_AERO
+ tmp1(:ncol) = ztodt * gravit * state%rpdel(:ncol,pver)
+ do m = 1, pmam_ncnst
+ l = pmam_cnst_idx(m)
+ q_tmp(:ncol,pver,l) = q_tmp(:ncol,pver,l) + tmp1(:ncol) * cam_in%cflx(:ncol,l)
+ enddo
+#endif
+ end if
+
+ ! -------------------------------------------------------- !
+ ! Diagnostics and output writing after applying PBL scheme !
+ ! -------------------------------------------------------- !
+
+ if (.not. do_pbl_diags) then
+
+ sl(:ncol,:pver) = s_tmp(:ncol,:) - latvap * q_tmp(:ncol,:,ixcldliq) &
+ - ( latvap + latice) * q_tmp(:ncol,:,ixcldice)
+ qt(:ncol,:pver) = q_tmp(:ncol,:,1) + q_tmp(:ncol,:,ixcldliq) &
+ + q_tmp(:ncol,:,ixcldice)
+ slv(:ncol,:pver) = sl(:ncol,:pver) * ( 1._r8 + zvir*qt(:ncol,:pver) )
+
+ slflx(:ncol,1) = 0._r8
+ qtflx(:ncol,1) = 0._r8
+ uflx(:ncol,1) = 0._r8
+ vflx(:ncol,1) = 0._r8
+
+ slflx_cg(:ncol,1) = 0._r8
+ qtflx_cg(:ncol,1) = 0._r8
+ uflx_cg(:ncol,1) = 0._r8
+ vflx_cg(:ncol,1) = 0._r8
+
+ do k = 2, pver
+ do i = 1, ncol
+ rhoair = state%pint(i,k) / ( rair * ( ( 0.5_r8*(slv(i,k)+slv(i,k-1)) - gravit*state%zi(i,k))/cpair ) )
+ slflx(i,k) = kvh(i,k) * &
+ ( - rhoair*(sl(i,k-1)-sl(i,k))/(state%zm(i,k-1)-state%zm(i,k)) &
+ + cgh(i,k) )
+ qtflx(i,k) = kvh(i,k) * &
+ ( - rhoair*(qt(i,k-1)-qt(i,k))/(state%zm(i,k-1)-state%zm(i,k)) &
+ + rhoair*(cam_in%cflx(i,1)+cam_in%cflx(i,ixcldliq)+cam_in%cflx(i,ixcldice))*cgs(i,k) )
+ uflx(i,k) = kvm(i,k) * &
+ ( - rhoair*(u_tmp(i,k-1)-u_tmp(i,k))/(state%zm(i,k-1)-state%zm(i,k)))
+ vflx(i,k) = kvm(i,k) * &
+ ( - rhoair*(v_tmp(i,k-1)-v_tmp(i,k))/(state%zm(i,k-1)-state%zm(i,k)))
+ slflx_cg(i,k) = kvh(i,k) * cgh(i,k)
+ qtflx_cg(i,k) = kvh(i,k) * rhoair * ( cam_in%cflx(i,1) + &
+ cam_in%cflx(i,ixcldliq) + cam_in%cflx(i,ixcldice) ) * cgs(i,k)
+ uflx_cg(i,k) = 0._r8
+ vflx_cg(i,k) = 0._r8
+ end do
+ end do
+
+ ! Modification : I should check whether slflx(:ncol,pverp) is correctly computed.
+ ! Note also that 'tautotx' is explicit total stress, different from
+ ! the ones that have been actually added into the atmosphere.
+
+ slflx(:ncol,pverp) = cam_in%shf(:ncol)
+ qtflx(:ncol,pverp) = cam_in%cflx(:ncol,1)
+ uflx(:ncol,pverp) = tautotx(:ncol)
+ vflx(:ncol,pverp) = tautoty(:ncol)
+
+ slflx_cg(:ncol,pverp) = 0._r8
+ qtflx_cg(:ncol,pverp) = 0._r8
+ uflx_cg(:ncol,pverp) = 0._r8
+ vflx_cg(:ncol,pverp) = 0._r8
+
+ if (trim(shallow_scheme) == 'UNICON') then
+ call pbuf_get_field(pbuf, qtl_flx_idx, qtl_flx)
+ call pbuf_get_field(pbuf, qti_flx_idx, qti_flx)
+ qtl_flx(:ncol,1) = 0._r8
+ qti_flx(:ncol,1) = 0._r8
+ do k = 2, pver
+ do i = 1, ncol
+ ! For use in the cloud macrophysics
+ ! Note that density is not added here. Also, only consider local transport term.
+ qtl_flx(i,k) = - kvh(i,k)*(q_tmp(i,k-1,1)-q_tmp(i,k,1)+q_tmp(i,k-1,ixcldliq)-q_tmp(i,k,ixcldliq))/&
+ (state%zm(i,k-1)-state%zm(i,k))
+ qti_flx(i,k) = - kvh(i,k)*(q_tmp(i,k-1,1)-q_tmp(i,k,1)+q_tmp(i,k-1,ixcldice)-q_tmp(i,k,ixcldice))/&
+ (state%zm(i,k-1)-state%zm(i,k))
+ end do
+ end do
+ do i = 1, ncol
+ rhoair = state%pint(i,pverp)/(rair*((slv(i,pver)-gravit*state%zi(i,pverp))/cpair))
+ qtl_flx(i,pverp) = cam_in%cflx(i,1)/rhoair
+ qti_flx(i,pverp) = cam_in%cflx(i,1)/rhoair
+ end do
+ end if
+
+ end if
+
+ ! --------------------------------------------------------------- !
+ ! Convert the new profiles into vertical diffusion tendencies. !
+ ! Convert KE dissipative heat change into "temperature" tendency. !
+ ! --------------------------------------------------------------- !
+
+ ! All variables are modified by vertical diffusion
+
+ lq(:) = .TRUE.
+ call physics_ptend_init(ptend,state%psetcols, "vertical diffusion", &
+ ls=.true., lu=.true., lv=.true., lq=lq)
+
+ ptend%s(:ncol,:) = ( s_tmp(:ncol,:) - state%s(:ncol,:) ) * rztodt
+ ptend%u(:ncol,:) = ( u_tmp(:ncol,:) - state%u(:ncol,:) ) * rztodt
+ ptend%v(:ncol,:) = ( v_tmp(:ncol,:) - state%v(:ncol,:) ) * rztodt
+ ptend%q(:ncol,:pver,:) = ( q_tmp(:ncol,:pver,:) - state%q(:ncol,:pver,:) ) * rztodt
+ if (.not. do_pbl_diags) then
+ slten(:ncol,:) = ( sl(:ncol,:) - sl_prePBL(:ncol,:) ) * rztodt
+ qtten(:ncol,:) = ( qt(:ncol,:) - qt_prePBL(:ncol,:) ) * rztodt
+ end if
+
+ ! ------------------------------------------------------------ !
+ ! In order to perform 'pseudo-conservative variable diffusion' !
+ ! perform the following two stages: !
+ ! !
+ ! I. Re-set (1) 'qvten' by 'qtten', and 'qlten = qiten = 0' !
+ ! (2) 'sten' by 'slten', and !
+ ! (3) 'qlten = qiten = 0' !
+ ! !
+ ! II. Apply 'positive_moisture' !
+ ! !
+ ! ------------------------------------------------------------ !
+
+ if( (eddy_scheme .eq. 'diag_TKE' .or. eddy_scheme .eq. 'SPCAM_m2005') .and. do_pseudocon_diff ) then
+
+ ptend%q(:ncol,:pver,1) = qtten(:ncol,:pver)
+ ptend%s(:ncol,:pver) = slten(:ncol,:pver)
+ ptend%q(:ncol,:pver,ixcldliq) = 0._r8
+ ptend%q(:ncol,:pver,ixcldice) = 0._r8
+ if (ixnumliq > 0) ptend%q(:ncol,:pver,ixnumliq) = 0._r8
+ if (ixnumice > 0) ptend%q(:ncol,:pver,ixnumice) = 0._r8
+
+ do i = 1, ncol
+ do k = 1, pver
+ qv_pro(i,k) = state%q(i,k,1) + ptend%q(i,k,1) * ztodt
+ ql_pro(i,k) = state%q(i,k,ixcldliq) + ptend%q(i,k,ixcldliq) * ztodt
+ qi_pro(i,k) = state%q(i,k,ixcldice) + ptend%q(i,k,ixcldice) * ztodt
+ s_pro(i,k) = state%s(i,k) + ptend%s(i,k) * ztodt
+ t_pro(i,k) = state%t(i,k) + (1._r8/cpair)*ptend%s(i,k) * ztodt
+ end do
+ end do
+
+ call positive_moisture( cpair, latvap, latvap+latice, ncol, pver, ztodt, qmin(1), qmin(ixcldliq), qmin(ixcldice), &
+ state%pdel(:ncol,pver:1:-1), qv_pro(:ncol,pver:1:-1), ql_pro(:ncol,pver:1:-1), &
+ qi_pro(:ncol,pver:1:-1), t_pro(:ncol,pver:1:-1), s_pro(:ncol,pver:1:-1), &
+ ptend%q(:ncol,pver:1:-1,1), ptend%q(:ncol,pver:1:-1,ixcldliq), &
+ ptend%q(:ncol,pver:1:-1,ixcldice), ptend%s(:ncol,pver:1:-1) )
+
+ end if
+
+ ! ----------------------------------------------------------------- !
+ ! Re-calculate diagnostic output variables after vertical diffusion !
+ ! ----------------------------------------------------------------- !
+
+ if (.not. do_pbl_diags) then
+
+ qv_aft_PBL(:ncol,:pver) = state%q(:ncol,:pver,1) + ptend%q(:ncol,:pver,1) * ztodt
+ ql_aft_PBL(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + ptend%q(:ncol,:pver,ixcldliq) * ztodt
+ qi_aft_PBL(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + ptend%q(:ncol,:pver,ixcldice) * ztodt
+ s_aft_PBL(:ncol,:pver) = state%s(:ncol,:pver) + ptend%s(:ncol,:pver) * ztodt
+ t_aftPBL(:ncol,:pver) = ( s_aft_PBL(:ncol,:pver) - gravit*state%zm(:ncol,:pver) ) / cpair
+
+ u_aft_PBL(:ncol,:pver) = state%u(:ncol,:pver) + ptend%u(:ncol,:pver) * ztodt
+ v_aft_PBL(:ncol,:pver) = state%v(:ncol,:pver) + ptend%v(:ncol,:pver) * ztodt
+
+ call qsat(t_aftPBL(:ncol,:pver), state%pmid(:ncol,:pver), &
+ tem2(:ncol,:pver), ftem(:ncol,:pver))
+ ftem_aftPBL(:ncol,:pver) = qv_aft_PBL(:ncol,:pver) / ftem(:ncol,:pver) * 100._r8
+
+ tten(:ncol,:pver) = ( t_aftPBL(:ncol,:pver) - state%t(:ncol,:pver) ) * rztodt
+ rhten(:ncol,:pver) = ( ftem_aftPBL(:ncol,:pver) - ftem_prePBL(:ncol,:pver) ) * rztodt
+
+ end if
+
+ ! -------------------------------------------------------------- !
+ ! mass conservation check.........
+ ! -------------------------------------------------------------- !
+ if (diff_cnsrv_mass_check) then
+
+ ! Conservation check
+ do m = 1, pcnst
+ fixed_ubc: if ((.not.cnst_fixed_ubc(m)).and.(.not.cnst_fixed_ubflx(m))) then
+ col_loop: do i = 1, ncol
+ sum1 = 0._r8
+ sum2 = 0._r8
+ sum3 = 0._r8
+ do k = 1, pver
+ if(cnst_get_type_byind(m).eq.'wet') then
+ pdelx = state%pdel(i,k)
+ else
+ pdelx = state%pdeldry(i,k)
+ endif
+ sum1 = sum1 + state%q(i,k,m)*pdelx/gravit ! total column
+ sum2 = sum2 +(state%q(i,k,m)+ptend%q(i,k,m)*ztodt)*pdelx/ gravit ! total column after tendancy is applied
+ sum3 = sum3 +( ptend%q(i,k,m)*ztodt)*pdelx/ gravit ! rate of change in column
+ enddo
+ sum1 = sum1 + (cam_in%cflx(i,m) * ztodt) ! add in surface flux (kg/m2)
+ sflx = (cam_in%cflx(i,m) * ztodt)
+ if (sum1>1.e-36_r8) then
+ if( abs((sum2-sum1)/sum1) .gt. 1.e-12_r8 ) then
+ nstep = get_nstep()
+ write(iulog,'(a,a8,a,I4,2f8.3,5e25.16)') &
+ 'MASSCHECK vert diff : nstep,lon,lat,mass1,mass2,sum3,sflx,rel-diff : ', &
+ trim(cnst_name(m)), ' : ', nstep, state%lon(i)*180._r8/pi, state%lat(i)*180._r8/pi, &
+ sum1, sum2, sum3, sflx, abs(sum2-sum1)/sum1
+ call endrun('vertical_diffusion_tend : mass not conserved' )
+ endif
+ endif
+ enddo col_loop
+ endif fixed_ubc
+ enddo
+ endif
+
+ ! -------------------------------------------------------------- !
+ ! Writing state variables after PBL scheme for detailed analysis !
+ ! -------------------------------------------------------------- !
+
+ if (.not. do_pbl_diags) then
+
+ call outfld( 'sl_aft_PBL' , sl, pcols, lchnk )
+ call outfld( 'qt_aft_PBL' , qt, pcols, lchnk )
+ call outfld( 'slv_aft_PBL' , slv, pcols, lchnk )
+ call outfld( 'u_aft_PBL' , u_aft_PBL, pcols, lchnk )
+ call outfld( 'v_aft_PBL' , v_aft_PBL, pcols, lchnk )
+ call outfld( 'qv_aft_PBL' , qv_aft_PBL, pcols, lchnk )
+ call outfld( 'ql_aft_PBL' , ql_aft_PBL, pcols, lchnk )
+ call outfld( 'qi_aft_PBL' , qi_aft_PBL, pcols, lchnk )
+ call outfld( 't_aft_PBL ' , t_aftPBL, pcols, lchnk )
+ call outfld( 'rh_aft_PBL' , ftem_aftPBL, pcols, lchnk )
+ call outfld( 'slflx_PBL' , slflx, pcols, lchnk )
+ call outfld( 'qtflx_PBL' , qtflx, pcols, lchnk )
+ call outfld( 'uflx_PBL' , uflx, pcols, lchnk )
+ call outfld( 'vflx_PBL' , vflx, pcols, lchnk )
+ call outfld( 'slflx_cg_PBL' , slflx_cg, pcols, lchnk )
+ call outfld( 'qtflx_cg_PBL' , qtflx_cg, pcols, lchnk )
+ call outfld( 'uflx_cg_PBL' , uflx_cg, pcols, lchnk )
+ call outfld( 'vflx_cg_PBL' , vflx_cg, pcols, lchnk )
+ call outfld( 'slten_PBL' , slten, pcols, lchnk )
+ call outfld( 'qtten_PBL' , qtten, pcols, lchnk )
+ call outfld( 'uten_PBL' , ptend%u(:ncol,:), pcols, lchnk )
+ call outfld( 'vten_PBL' , ptend%v(:ncol,:), pcols, lchnk )
+ call outfld( 'qvten_PBL' , ptend%q(:ncol,:,1), pcols, lchnk )
+ call outfld( 'qlten_PBL' , ptend%q(:ncol,:,ixcldliq), pcols, lchnk )
+ call outfld( 'qiten_PBL' , ptend%q(:ncol,:,ixcldice), pcols, lchnk )
+ call outfld( 'tten_PBL' , tten, pcols, lchnk )
+ call outfld( 'rhten_PBL' , rhten, pcols, lchnk )
+
+ end if
+
+ ! ------------------------------------------- !
+ ! Writing the other standard output variables !
+ ! ------------------------------------------- !
+
+ if (.not. do_pbl_diags) then
+ call outfld( 'QT' , qt, pcols, lchnk )
+ call outfld( 'SL' , sl, pcols, lchnk )
+ call outfld( 'SLV' , slv, pcols, lchnk )
+ call outfld( 'SLFLX' , slflx, pcols, lchnk )
+ call outfld( 'QTFLX' , qtflx, pcols, lchnk )
+ call outfld( 'UFLX' , uflx, pcols, lchnk )
+ call outfld( 'VFLX' , vflx, pcols, lchnk )
+ call outfld( 'TKE' , tke, pcols, lchnk )
+
+ call outfld( 'PBLH' , pblh, pcols, lchnk )
+ call outfld( 'TPERT' , tpert, pcols, lchnk )
+ call outfld( 'QPERT' , qpert, pcols, lchnk )
+ end if
+ call outfld( 'USTAR' , ustar, pcols, lchnk )
+ call outfld( 'KVH' , kvh, pcols, lchnk )
+ call outfld( 'KVT' , kvt, pcols, lchnk )
+ call outfld( 'KVM' , kvm, pcols, lchnk )
+ call outfld( 'CGS' , cgs, pcols, lchnk )
+ dtk(:ncol,:) = dtk(:ncol,:) / cpair ! Normalize heating for history
+ call outfld( 'DTVKE' , dtk, pcols, lchnk )
+ dtk(:ncol,:) = ptend%s(:ncol,:) / cpair ! Normalize heating for history using dtk
+ call outfld( 'DTV' , dtk, pcols, lchnk )
+ call outfld( 'DUV' , ptend%u, pcols, lchnk )
+ call outfld( 'DVV' , ptend%v, pcols, lchnk )
+ do m = 1, pcnst
+ call outfld( vdiffnam(m) , ptend%q(1,1,m), pcols, lchnk )
+ end do
+ if( do_molec_diff ) then
+ call outfld( 'TTPXMLC' , topflx, pcols, lchnk )
+ end if
+
+ call p%finalize()
+ call p_dry%finalize()
+
+end subroutine vertical_diffusion_tend
+
+! =============================================================================== !
+! !
+! =============================================================================== !
+
+subroutine positive_moisture( cp, xlv, xls, ncol, mkx, dt, qvmin, qlmin, qimin, &
+ dp, qv, ql, qi, t, s, qvten, qlten, qiten, sten )
+ ! ------------------------------------------------------------------------------- !
+ ! If any 'ql < qlmin, qi < qimin, qv < qvmin' are developed in any layer, !
+ ! force them to be larger than minimum value by (1) condensating water vapor !
+ ! into liquid or ice, and (2) by transporting water vapor from the very lower !
+ ! layer. '2._r8' is multiplied to the minimum values for safety. !
+ ! Update final state variables and tendencies associated with this correction. !
+ ! If any condensation happens, update (s,t) too. !
+ ! Note that (qv,ql,qi,t,s) are final state variables after applying corresponding !
+ ! input tendencies. !
+ ! Be careful the order of k : '1': near-surface layer, 'mkx' : top layer !
+ ! ------------------------------------------------------------------------------- !
+ implicit none
+ integer, intent(in) :: ncol, mkx
+ real(r8), intent(in) :: cp, xlv, xls
+ real(r8), intent(in) :: dt, qvmin, qlmin, qimin
+ real(r8), intent(in) :: dp(ncol,mkx)
+ real(r8), intent(inout) :: qv(ncol,mkx), ql(ncol,mkx), qi(ncol,mkx), t(ncol,mkx), s(ncol,mkx)
+ real(r8), intent(inout) :: qvten(ncol,mkx), qlten(ncol,mkx), qiten(ncol,mkx), sten(ncol,mkx)
+ integer i, k
+ real(r8) dql, dqi, dqv, sum, aa, dum
+
+ ! Modification : I should check whether this is exactly same as the one used in
+ ! shallow convection and cloud macrophysics.
+
+ do i = 1, ncol
+ do k = mkx, 1, -1 ! From the top to the 1st (lowest) layer from the surface
+ dql = max(0._r8,1._r8*qlmin-ql(i,k))
+ dqi = max(0._r8,1._r8*qimin-qi(i,k))
+ qlten(i,k) = qlten(i,k) + dql/dt
+ qiten(i,k) = qiten(i,k) + dqi/dt
+ qvten(i,k) = qvten(i,k) - (dql+dqi)/dt
+ sten(i,k) = sten(i,k) + xlv * (dql/dt) + xls * (dqi/dt)
+ ql(i,k) = ql(i,k) + dql
+ qi(i,k) = qi(i,k) + dqi
+ qv(i,k) = qv(i,k) - dql - dqi
+ s(i,k) = s(i,k) + xlv * dql + xls * dqi
+ t(i,k) = t(i,k) + (xlv * dql + xls * dqi)/cp
+ dqv = max(0._r8,1._r8*qvmin-qv(i,k))
+ qvten(i,k) = qvten(i,k) + dqv/dt
+ qv(i,k) = qv(i,k) + dqv
+ if( k .ne. 1 ) then
+ qv(i,k-1) = qv(i,k-1) - dqv*dp(i,k)/dp(i,k-1)
+ qvten(i,k-1) = qvten(i,k-1) - dqv*dp(i,k)/dp(i,k-1)/dt
+ endif
+ qv(i,k) = max(qv(i,k),qvmin)
+ ql(i,k) = max(ql(i,k),qlmin)
+ qi(i,k) = max(qi(i,k),qimin)
+ end do
+ ! Extra moisture used to satisfy 'qv(i,1)=qvmin' is proportionally
+ ! extracted from all the layers that has 'qv > 2*qvmin'. This fully
+ ! preserves column moisture.
+ if( dqv .gt. 1.e-20_r8 ) then
+ sum = 0._r8
+ do k = 1, mkx
+ if( qv(i,k) .gt. 2._r8*qvmin ) sum = sum + qv(i,k)*dp(i,k)
+ enddo
+ aa = dqv*dp(i,1)/max(1.e-20_r8,sum)
+ if( aa .lt. 0.5_r8 ) then
+ do k = 1, mkx
+ if( qv(i,k) .gt. 2._r8*qvmin ) then
+ dum = aa*qv(i,k)
+ qv(i,k) = qv(i,k) - dum
+ qvten(i,k) = qvten(i,k) - dum/dt
+ endif
+ enddo
+ else
+ write(iulog,*) 'Full positive_moisture is impossible in vertical_diffusion'
+ endif
+ endif
+ end do
+ return
+
+end subroutine positive_moisture
+
+end module vertical_diffusion
diff --git a/src/chemistry/oslo_aero/zm_microphysics.F90 b/src/chemistry/oslo_aero/zm_microphysics.F90
new file mode 100644
index 0000000000..e95caafe7d
--- /dev/null
+++ b/src/chemistry/oslo_aero/zm_microphysics.F90
@@ -0,0 +1,2445 @@
+module zm_microphysics
+
+!---------------------------------------------------------------------------------
+! Purpose:
+! CAM Interface for cumulus microphysics
+!
+! Author: Xialiang Song and Guang Jun Zhang, June 2010
+!---------------------------------------------------------------------------------
+
+use shr_kind_mod, only: r8=>shr_kind_r8
+use spmd_utils, only: masterproc
+use ppgrid, only: pcols, pver, pverp
+use physconst, only: gravit, rair, tmelt, cpair, rh2o, r_universal, mwh2o, rhoh2o
+use physconst, only: latvap, latice
+!use activate_drop_mam, only: actdrop_mam_calc
+use ndrop, only: activate_modal
+use ndrop_bam, only: ndrop_bam_run
+use nucleate_ice, only: nucleati
+use shr_spfn_mod, only: erf => shr_spfn_erf
+use shr_spfn_mod, only: gamma => shr_spfn_gamma
+use wv_saturation, only: svp_water, svp_ice
+use cam_logfile, only: iulog
+use cam_abortutils, only: endrun
+use micro_mg_utils, only:ice_autoconversion, snow_self_aggregation, accrete_cloud_water_snow, &
+ secondary_ice_production, accrete_rain_snow, heterogeneous_rain_freezing, &
+ accrete_cloud_water_rain, self_collection_rain, accrete_cloud_ice_snow
+
+implicit none
+private
+save
+
+public :: &
+ zm_mphyi, &
+ zm_mphy, &
+ zm_conv_t,&
+ zm_aero_t
+
+! Private module data
+
+! constants remaped
+real(r8) :: g ! gravity
+real(r8) :: mw ! molecular weight of water
+real(r8) :: r ! Dry air Gas constant
+real(r8) :: rv ! water vapor gas contstant
+real(r8) :: rr ! universal gas constant
+real(r8) :: cpp ! specific heat of dry air
+real(r8) :: rhow ! density of liquid water
+real(r8) :: xlf ! latent heat of freezing
+
+!from 'microconstants'
+real(r8) :: rhosn ! bulk density snow
+real(r8) :: rhoi ! bulk density ice
+
+real(r8) :: ac,bc,as,bs,ai,bi,ar,br !fall speed parameters
+real(r8) :: ci,di !ice mass-diameter relation parameters
+real(r8) :: cs,ds !snow mass-diameter relation parameters
+real(r8) :: cr,dr !drop mass-diameter relation parameters
+real(r8) :: Eii !collection efficiency aggregation of ice
+real(r8) :: Ecc !collection efficiency
+real(r8) :: Ecr !collection efficiency cloud droplets/rain
+real(r8) :: DCS !autoconversion size threshold
+real(r8) :: bimm,aimm !immersion freezing
+real(r8) :: rhosu !typical 850mn air density
+real(r8) :: mi0 ! new crystal mass
+real(r8) :: rin ! radius of contact nuclei
+real(r8) :: pi ! pi
+
+! contact freezing due to dust
+! dust number mean radius (m), Zender et al JGR 2003 assuming number mode radius of 0.6 micron, sigma=2
+real(r8), parameter :: rn_dst1 = 0.258e-6_r8
+real(r8), parameter :: rn_dst2 = 0.717e-6_r8
+real(r8), parameter :: rn_dst3 = 1.576e-6_r8
+real(r8), parameter :: rn_dst4 = 3.026e-6_r8
+
+! smallest mixing ratio considered in microphysics
+real(r8), parameter :: qsmall = 1.e-18_r8
+
+
+type, public :: ptr2d
+ real(r8), pointer :: val(:,:)
+end type ptr2d
+
+! Aerosols
+type :: zm_aero_t
+
+ ! Aerosol treatment
+ character(len=5) :: scheme ! either 'bulk' or 'modal'
+
+ ! Bulk aerosols
+ integer :: nbulk = 0 ! number of bulk aerosols affecting climate
+ integer :: idxsul = -1 ! index in aerosol list for sulfate
+ integer :: idxdst1 = -1 ! index in aerosol list for dust1
+ integer :: idxdst2 = -1 ! index in aerosol list for dust2
+ integer :: idxdst3 = -1 ! index in aerosol list for dust3
+ integer :: idxdst4 = -1 ! index in aerosol list for dust4
+ integer :: idxbcphi = -1 ! index in aerosol list for Soot (BCPHI)
+
+ real(r8), allocatable :: num_to_mass_aer(:) ! conversion of mmr to number conc for bulk aerosols
+ type(ptr2d), allocatable :: mmr_bulk(:) ! array of pointers to bulk aerosol mmr
+ real(r8), allocatable :: mmrg_bulk(:,:,:) ! gathered bulk aerosol mmr
+
+ ! Modal aerosols
+ integer :: nmodes = 0 ! number of modes
+ integer, allocatable :: nspec(:) ! number of species in each mode
+ type(ptr2d), allocatable :: num_a(:) ! number mixing ratio of modes (interstitial phase)
+ type(ptr2d), allocatable :: mmr_a(:,:) ! species mmr in each mode (interstitial phase)
+ real(r8), allocatable :: numg_a(:,:,:) ! gathered number mixing ratio of modes (interstitial phase)
+ real(r8), allocatable :: mmrg_a(:,:,:,:) ! gathered species mmr in each mode (interstitial phase)
+ real(r8), allocatable :: voltonumblo(:) ! volume to number conversion (lower bound) for each mode
+ real(r8), allocatable :: voltonumbhi(:) ! volume to number conversion (upper bound) for each mode
+ real(r8), allocatable :: specdens(:,:) ! density of modal species
+ real(r8), allocatable :: spechygro(:,:) ! hygroscopicity of modal species
+
+ integer :: mode_accum_idx = -1 ! index of accumulation mode
+ integer :: mode_aitken_idx = -1 ! index of aitken mode
+ integer :: mode_coarse_idx = -1 ! index of coarse mode
+ integer :: coarse_dust_idx = -1 ! index of dust in coarse mode
+ integer :: coarse_nacl_idx = -1 ! index of nacl in coarse mode
+
+ type(ptr2d), allocatable :: dgnum(:) ! mode dry radius
+ real(r8), allocatable :: dgnumg(:,:,:) ! gathered mode dry radius
+
+ real(r8) :: sigmag_aitken
+
+end type zm_aero_t
+
+type :: zm_conv_t
+
+ real(r8), allocatable :: qi(:,:) ! wg grid slice of cloud ice.
+ real(r8), allocatable :: qliq(:,:) ! convective cloud liquid water.
+ real(r8), allocatable :: qice(:,:) ! convective cloud ice.
+ real(r8), allocatable :: wu(:,:) ! vertical velocity
+ real(r8), allocatable :: sprd(:,:) ! rate of production of snow at that layer
+ real(r8), allocatable :: qrain(:,:) ! convective rain water.
+ real(r8), allocatable :: qsnow(:,:) ! convective snow.
+ real(r8), allocatable :: qnl(:,:) ! convective cloud liquid water num concen.
+ real(r8), allocatable :: qni(:,:) ! convective cloud ice num concen.
+ real(r8), allocatable :: qnr(:,:) ! convective rain water num concen.
+ real(r8), allocatable :: qns(:,:) ! convective snow num concen.
+ real(r8), allocatable :: frz(:,:) ! heating rate due to freezing
+ real(r8), allocatable :: autolm(:,:) !mass tendency due to autoconversion of droplets to rain
+ real(r8), allocatable :: accrlm(:,:) !mass tendency due to accretion of droplets by rain
+ real(r8), allocatable :: bergnm(:,:) !mass tendency due to Bergeron process
+ real(r8), allocatable :: fhtimm(:,:) !mass tendency due to immersion freezing
+ real(r8), allocatable :: fhtctm(:,:) !mass tendency due to contact freezing
+ real(r8), allocatable :: fhmlm (:,:) !mass tendency due to homogeneous freezing
+ real(r8), allocatable :: hmpim (:,:) !mass tendency due to HM process
+ real(r8), allocatable :: accslm(:,:) !mass tendency due to accretion of droplets by snow
+ real(r8), allocatable :: dlfm (:,:) !mass tendency due to detrainment of droplet
+ real(r8), allocatable :: autoln(:,:) !num tendency due to autoconversion of droplets to rain
+ real(r8), allocatable :: accrln(:,:) !num tendency due to accretion of droplets by rain
+ real(r8), allocatable :: bergnn(:,:) !num tendency due to Bergeron process
+ real(r8), allocatable :: fhtimn(:,:) !num tendency due to immersion freezing
+ real(r8), allocatable :: fhtctn(:,:) !num tendency due to contact freezing
+ real(r8), allocatable :: fhmln (:,:) !num tendency due to homogeneous freezing
+ real(r8), allocatable :: accsln(:,:) !num tendency due to accretion of droplets by snow
+ real(r8), allocatable :: activn(:,:) !num tendency due to droplets activation
+ real(r8), allocatable :: dlfn (:,:) !num tendency due to detrainment of droplet
+ real(r8), allocatable :: autoim(:,:) !mass tendency due to autoconversion of cloud ice to snow
+ real(r8), allocatable :: accsim(:,:) !mass tendency due to accretion of cloud ice by snow
+ real(r8), allocatable :: difm (:,:) !mass tendency due to detrainment of cloud ice
+ real(r8), allocatable :: nuclin(:,:) !num tendency due to ice nucleation
+ real(r8), allocatable :: autoin(:,:) !num tendency due to autoconversion of cloud ice to snow
+ real(r8), allocatable :: accsin(:,:) !num tendency due to accretion of cloud ice by snow
+ real(r8), allocatable :: hmpin (:,:) !num tendency due to HM process
+ real(r8), allocatable :: difn (:,:) !num tendency due to detrainment of cloud ice
+ real(r8), allocatable :: cmel (:,:) !mass tendency due to condensation
+ real(r8), allocatable :: cmei (:,:) !mass tendency due to deposition
+ real(r8), allocatable :: trspcm(:,:) !LWC tendency due to convective transport
+ real(r8), allocatable :: trspcn(:,:) !droplet num tendency due to convective transport
+ real(r8), allocatable :: trspim(:,:) !IWC tendency due to convective transport
+ real(r8), allocatable :: trspin(:,:) !ice crystal num tendency due to convective transport
+ real(r8), allocatable :: dcape(:) ! CAPE change due to freezing heating
+ real(r8), allocatable :: lambdadpcu(:,:)! slope of cloud liquid size distr
+ real(r8), allocatable :: mudpcu(:,:) ! width parameter of droplet size distr
+ real(r8), allocatable :: di(:,:)
+ real(r8), allocatable :: dnl(:,:)
+ real(r8), allocatable :: dni(:,:)
+ real(r8), allocatable :: qide(:,:) ! cloud ice mixing ratio for detrainment (kg/kg)
+ real(r8), allocatable :: qncde(:,:) ! cloud water number concentration for detrainment (1/kg)
+ real(r8), allocatable :: qnide(:,:) ! cloud ice number concentration for detrainment (1/kg)
+
+
+end type zm_conv_t
+
+real(r8), parameter :: dcon = 25.e-6_r8
+real(r8), parameter :: mucon = 5.3_r8
+real(r8), parameter :: lambdadpcu = (mucon + 1._r8)/dcon
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine zm_mphyi
+
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! initialize constants for the cumulus microphysics
+! called from zm_conv_init() in zm_conv_intr.F90
+!
+! Author: Xialiang Song, June 2010
+!
+!-----------------------------------------------------------------------
+
+!NOTE:
+! latent heats should probably be fixed with temperature
+! for energy conservation with the rest of the model
+! (this looks like a +/- 3 or 4% effect, but will mess up energy balance)
+
+ xlf = latice ! latent heat freezing
+
+! from microconstants
+
+! parameters below from Reisner et al. (1998)
+! density parameters (kg/m3)
+
+ rhosn = 100._r8 ! bulk density snow
+ rhoi = 500._r8 ! bulk density ice
+ rhow = 1000._r8 ! bulk density liquid
+
+! fall speed parameters, V = aD^b
+! V is in m/s
+
+! droplets
+ ac = 3.e7_r8
+ bc = 2._r8
+
+! snow
+ as = 11.72_r8
+ bs = 0.41_r8
+
+! cloud ice
+ ai = 700._r8
+ bi = 1._r8
+
+! rain
+ ar = 841.99667_r8
+ br = 0.8_r8
+
+! particle mass-diameter relationship
+! currently we assume spherical particles for cloud ice/snow
+! m = cD^d
+
+ pi= 3.14159265358979323846_r8
+
+! cloud ice mass-diameter relationship
+
+ ci = rhoi*pi/6._r8
+ di = 3._r8
+
+! snow mass-diameter relationship
+
+ cs = rhosn*pi/6._r8
+ ds = 3._r8
+
+! drop mass-diameter relationship
+
+ cr = rhow*pi/6._r8
+ dr = 3._r8
+
+! collection efficiency, aggregation of cloud ice and snow
+
+ Eii = 0.1_r8
+
+! collection efficiency, accretion of cloud water by rain
+
+ Ecr = 1.0_r8
+
+! autoconversion size threshold for cloud ice to snow (m)
+
+ Dcs = 150.e-6_r8
+! immersion freezing parameters, bigg 1953
+
+ bimm = 100._r8
+ aimm = 0.66_r8
+
+! typical air density at 850 mb
+
+ rhosu = 85000._r8/(rair * tmelt)
+
+! mass of new crystal due to aerosol freezing and growth (kg)
+
+ mi0 = 4._r8/3._r8*pi*rhoi*(10.e-6_r8)*(10.e-6_r8)*(10.e-6_r8)
+
+! radius of contact nuclei aerosol (m)
+
+ rin = 0.1e-6_r8
+
+end subroutine zm_mphyi
+
+!===============================================================================
+
+subroutine zm_mphy(su, qu, mu, du, eu, cmel, cmei, zf, pm, te, qe, &
+ eps0, jb, jt, jlcl, msg, il2g, grav, cp, rd, aero, gamhat, &
+ qc, qi, nc, ni, qcde, qide, ncde, nide, rprd, sprd, frz, &
+ wu, qr, qni, nr, ns, autolm, accrlm, bergnm, fhtimm, fhtctm, &
+ fhmlm, hmpim, accslm, dlfm, autoln, accrln, bergnn, fhtimn, fhtctn, &
+ fhmln, accsln, activn, dlfn, autoim, accsim, difm, nuclin, autoin, &
+ accsin, hmpin, difn, trspcm, trspcn, trspim, trspin, lamc, pgam )
+
+
+! Purpose:
+! microphysic parameterization for Zhang-McFarlane convection scheme
+! called from cldprp() in zm_conv.F90
+!
+! Author: Xialiang Song, June 2010
+
+ use time_manager, only: get_step_size
+
+! variable declarations
+
+ implicit none
+
+! input variables
+ real(r8), intent(in) :: su(pcols,pver) ! normalized dry stat energy of updraft
+ real(r8), intent(in) :: qu(pcols,pver) ! spec hum of updraft
+ real(r8), intent(in) :: mu(pcols,pver) ! updraft mass flux
+ real(r8), intent(in) :: du(pcols,pver) ! detrainement rate of updraft
+ real(r8), intent(in) :: eu(pcols,pver) ! entrainment rate of updraft
+ real(r8), intent(in) :: cmel(pcols,pver) ! condensation rate of updraft
+ real(r8), intent(in) :: cmei(pcols,pver) ! condensation rate of updraft
+ real(r8), intent(in) :: zf(pcols,pverp) ! height of interfaces
+ real(r8), intent(in) :: pm(pcols,pver) ! pressure of env
+ real(r8), intent(in) :: te(pcols,pver) ! temp of env
+ real(r8), intent(in) :: qe(pcols,pver) ! spec. humidity of env
+ real(r8), intent(in) :: eps0(pcols)
+ real(r8), intent(in) :: gamhat(pcols,pver) ! gamma=L/cp(dq*/dT) at interface
+
+ integer, intent(in) :: jb(pcols) ! updraft base level
+ integer, intent(in) :: jt(pcols) ! updraft plume top
+ integer, intent(in) :: jlcl(pcols) ! updraft lifting cond level
+ integer, intent(in) :: msg ! missing moisture vals
+ integer, intent(in) :: il2g ! number of columns in gathered arrays
+
+ type(zm_aero_t), intent(in) :: aero ! aerosol object
+
+ real(r8) grav ! gravity
+ real(r8) cp ! heat capacity of dry air
+ real(r8) rd ! gas constant for dry air
+
+! output variables
+ real(r8), intent(out) :: qc(pcols,pver) ! cloud water mixing ratio (kg/kg)
+ real(r8), intent(out) :: qi(pcols,pver) ! cloud ice mixing ratio (kg/kg)
+ real(r8), intent(out) :: nc(pcols,pver) ! cloud water number conc (1/kg)
+ real(r8), intent(out) :: ni(pcols,pver) ! cloud ice number conc (1/kg)
+ real(r8), intent(out) :: qcde(pcols,pver) ! cloud water mixing ratio for detrainment(kg/kg)
+ real(r8), intent(out) :: qide(pcols,pver) ! cloud ice mixing ratio for detrainment (kg/kg)
+ real(r8), intent(out) :: ncde(pcols,pver) ! cloud water number conc for detrainment (1/kg)
+ real(r8), intent(out) :: nide(pcols,pver) ! cloud ice number conc for detrainment (1/kg)
+ real(r8), intent(out) :: wu(pcols,pver)
+ real(r8), intent(out) :: qni(pcols,pver) ! snow mixing ratio
+ real(r8), intent(out) :: qr(pcols,pver) ! rain mixing ratio
+ real(r8), intent(out) :: ns(pcols,pver) ! snow number conc
+ real(r8), intent(out) :: nr(pcols,pver) ! rain number conc
+ real(r8), intent(out) :: rprd(pcols,pver) ! rate of production of precip at that layer
+ real(r8), intent(out) :: sprd(pcols,pver) ! rate of production of snow at that layer
+ real(r8), intent(out) :: frz(pcols,pver) ! rate of freezing
+
+
+ real(r8), intent(inout) :: lamc(pcols,pver) ! slope of cloud liquid size distr
+ real(r8), intent(inout) :: pgam(pcols,pver) ! spectral width parameter of droplet size distr
+
+! tendency for output
+ real(r8),intent(out) :: autolm(pcols,pver) !mass tendency due to autoconversion of droplets to rain
+ real(r8),intent(out) :: accrlm(pcols,pver) !mass tendency due to accretion of droplets by rain
+ real(r8),intent(out) :: bergnm(pcols,pver) !mass tendency due to Bergeron process
+ real(r8),intent(out) :: fhtimm(pcols,pver) !mass tendency due to immersion freezing
+ real(r8),intent(out) :: fhtctm(pcols,pver) !mass tendency due to contact freezing
+ real(r8),intent(out) :: fhmlm (pcols,pver) !mass tendency due to homogeneous freezing
+ real(r8),intent(out) :: hmpim (pcols,pver) !mass tendency due to HM process
+ real(r8),intent(out) :: accslm(pcols,pver) !mass tendency due to accretion of droplets by snow
+ real(r8),intent(out) :: dlfm (pcols,pver) !mass tendency due to detrainment of droplet
+ real(r8),intent(out) :: trspcm(pcols,pver) !mass tendency of droplets due to convective transport
+
+ real(r8),intent(out) :: autoln(pcols,pver) !num tendency due to autoconversion of droplets to rain
+ real(r8),intent(out) :: accrln(pcols,pver) !num tendency due to accretion of droplets by rain
+ real(r8),intent(out) :: bergnn(pcols,pver) !num tendency due to Bergeron process
+ real(r8),intent(out) :: fhtimn(pcols,pver) !num tendency due to immersion freezing
+ real(r8),intent(out) :: fhtctn(pcols,pver) !num tendency due to contact freezing
+ real(r8),intent(out) :: fhmln (pcols,pver) !num tendency due to homogeneous freezing
+ real(r8),intent(out) :: accsln(pcols,pver) !num tendency due to accretion of droplets by snow
+ real(r8),intent(out) :: activn(pcols,pver) !num tendency due to droplets activation
+ real(r8),intent(out) :: dlfn (pcols,pver) !num tendency due to detrainment of droplet
+ real(r8),intent(out) :: trspcn(pcols,pver) !num tendency of droplets due to convective transport
+
+ real(r8),intent(out) :: autoim(pcols,pver) !mass tendency due to autoconversion of cloud ice to snow
+ real(r8),intent(out) :: accsim(pcols,pver) !mass tendency due to accretion of cloud ice by snow
+ real(r8),intent(out) :: difm (pcols,pver) !mass tendency due to detrainment of cloud ice
+ real(r8),intent(out) :: trspim(pcols,pver) !mass tendency of ice crystal due to convective transport
+
+ real(r8),intent(out) :: nuclin(pcols,pver) !num tendency due to ice nucleation
+ real(r8),intent(out) :: autoin(pcols,pver) !num tendency due to autoconversion of cloud ice to snow
+ real(r8),intent(out) :: accsin(pcols,pver) !num tendency due to accretion of cloud ice by snow
+ real(r8),intent(out) :: hmpin (pcols,pver) !num tendency due to HM process
+ real(r8),intent(out) :: difn (pcols,pver) !num tendency due to detrainment of cloud ice
+ real(r8),intent(out) :: trspin(pcols,pver) !num tendency of ice crystal due to convective transport
+
+!................................................................................
+! local workspace
+! all units mks unless otherwise stated
+ real(r8) :: deltat ! time step (s)
+ real(r8) :: omsm ! number near unity for round-off issues
+ real(r8) :: dum ! temporary dummy variable
+ real(r8) :: dum1 ! temporary dummy variable
+ real(r8) :: dum2 ! temporary dummy variable
+
+ real(r8) :: q(pcols,pver) ! water vapor mixing ratio (kg/kg)
+ real(r8) :: t(pcols,pver) ! temperature (K)
+ real(r8) :: rho(pcols,pver) ! air density (kg m-3)
+ real(r8) :: dz(pcols,pver) ! height difference across model vertical level
+
+ real(r8) :: qcic(pcols,pver) ! in-cloud cloud liquid mixing ratio
+ real(r8) :: qiic(pcols,pver) ! in-cloud cloud ice mixing ratio
+ real(r8) :: qniic(pcols,pver) ! in-precip snow mixing ratio
+ real(r8) :: qric(pcols,pver) ! in-precip rain mixing ratio
+ real(r8) :: ncic(pcols,pver) ! in-cloud droplet number conc
+ real(r8) :: niic(pcols,pver) ! in-cloud cloud ice number conc
+ real(r8) :: nsic(pcols,pver) ! in-precip snow number conc
+ real(r8) :: nric(pcols,pver) ! in-precip rain number conc
+
+ real(r8) :: lami(pver) ! slope of cloud ice size distr
+ real(r8) :: n0i(pver) ! intercept of cloud ice size distr
+ real(r8) :: n0c(pver) ! intercept of cloud liquid size distr
+ real(r8) :: lams(pver) ! slope of snow size distr
+ real(r8) :: n0s(pver) ! intercept of snow size distr
+ real(r8) :: lamr(pver) ! slope of rain size distr
+ real(r8) :: n0r(pver) ! intercept of rain size distr
+ real(r8) :: cdist1(pver) ! size distr parameter to calculate droplet freezing
+ real(r8) :: lammax ! maximum allowed slope of size distr
+ real(r8) :: lammin ! minimum allowed slope of size distr
+
+ real(r8) :: mnuccc(pver) ! mixing ratio tendency due to freezing of cloud water
+ real(r8) :: nnuccc(pver) ! number conc tendency due to freezing of cloud water
+ real(r8) :: mnucct(pver) ! mixing ratio tendency due to contact freezing of cloud water
+ real(r8) :: nnucct(pver) ! number conc tendency due to contact freezing of cloud water
+ real(r8) :: msacwi(pver) ! mixing ratio tendency due to HM ice multiplication
+ real(r8) :: nsacwi(pver) ! number conc tendency due to HM ice multiplication
+ real(r8) :: prf(pver) ! mixing ratio tendency due to fallout of rain
+ real(r8) :: psf(pver) ! mixing ratio tendency due to fallout of snow
+ real(r8) :: pnrf(pver) ! number conc tendency due to fallout of rain
+ real(r8) :: pnsf(pver) ! number conc tendency due to fallout of snow
+ real(r8) :: prc(pver) ! mixing ratio tendency due to autoconversion of cloud droplets
+ real(r8) :: nprc(pver) ! number conc tendency due to autoconversion of cloud droplets
+ real(r8) :: nprc1(pver) ! qr tendency due to autoconversion of cloud droplets
+ real(r8) :: nsagg(pver) ! ns tendency due to self-aggregation of snow
+ real(r8) :: dc0 ! mean size droplet size distr
+ real(r8) :: ds0 ! mean size snow size distr (area weighted)
+ real(r8) :: eci ! collection efficiency for riming of snow by droplets
+ real(r8) :: dv(pcols,pver) ! diffusivity of water vapor in air
+ real(r8) :: mua(pcols,pver) ! viscocity of air
+ real(r8) :: psacws(pver) ! mixing rat tendency due to collection of droplets by snow
+ real(r8) :: npsacws(pver) ! number conc tendency due to collection of droplets by snow
+ real(r8) :: pracs(pver) ! mixing rat tendency due to collection of rain by snow
+ real(r8) :: npracs(pver) ! number conc tendency due to collection of rain by snow
+ real(r8) :: mnuccr(pver) ! mixing rat tendency due to freezing of rain
+ real(r8) :: nnuccr(pver) ! number conc tendency due to freezing of rain
+ real(r8) :: pra(pver) ! mixing rat tendnency due to accretion of droplets by rain
+ real(r8) :: npra(pver) ! nc tendnency due to accretion of droplets by rain
+ real(r8) :: nragg(pver) ! nr tendency due to self-collection of rain
+ real(r8) :: prci(pver) ! mixing rat tendency due to autoconversion of cloud ice to snow
+ real(r8) :: nprci(pver) ! number conc tendency due to autoconversion of cloud ice to snow
+ real(r8) :: prai(pver) ! mixing rat tendency due to accretion of cloud ice by snow
+ real(r8) :: nprai(pver) ! number conc tendency due to accretion of cloud ice by snow
+ real(r8) :: prb(pver) ! rain mixing rat tendency due to Bergeron process
+ real(r8) :: nprb(pver) ! number conc tendency due to Bergeron process
+ real(r8) :: fhmrm (pcols,pver) !mass tendency due to homogeneous freezing of rain
+
+! fall speed
+ real(r8) :: arn(pcols,pver) ! air density corrected rain fallspeed parameter
+ real(r8) :: asn(pcols,pver) ! air density corrected snow fallspeed parameter
+ real(r8) :: acn(pcols,pver) ! air density corrected cloud droplet fallspeed parameter
+ real(r8) :: ain(pcols,pver) ! air density corrected cloud ice fallspeed parameter
+ real(r8) :: uns(pver) ! number-weighted snow fallspeed
+ real(r8) :: ums(pver) ! mass-weighted snow fallspeed
+ real(r8) :: unr(pver) ! number-weighted rain fallspeed
+ real(r8) :: umr(pver) ! mass-weighted rain fallspeed
+
+! conservation check
+ real(r8) :: qce ! dummy qc for conservation check
+ real(r8) :: qie ! dummy qi for conservation check
+ real(r8) :: nce ! dummy nc for conservation check
+ real(r8) :: nie ! dummy ni for conservation check
+ real(r8) :: qre ! dummy qr for conservation check
+ real(r8) :: nre ! dummy nr for conservation check
+ real(r8) :: qnie ! dummy qni for conservation check
+ real(r8) :: nse ! dummy ns for conservation check
+ real(r8) :: ratio ! parameter for conservation check
+
+! sum of source/sink terms for cloud hydrometeor
+ real(r8) :: qctend(pcols,pver) ! microphysical tendency qc (1/s)
+ real(r8) :: qitend(pcols,pver) ! microphysical tendency qi (1/s)
+ real(r8) :: nctend(pcols,pver) ! microphysical tendency nc (1/(kg*s))
+ real(r8) :: nitend(pcols,pver) ! microphysical tendency ni (1/(kg*s))
+ real(r8) :: qnitend(pcols,pver) ! snow mixing ratio source/sink term
+ real(r8) :: nstend(pcols,pver) ! snow number concentration source/sink term
+ real(r8) :: qrtend(pcols,pver) ! rain mixing ratio source/sink term
+ real(r8) :: nrtend(pcols,pver) ! rain number concentration source/sink term
+
+! terms for Bergeron process
+ real(r8) :: bergtsf !bergeron timescale to remove all liquid
+ real(r8) :: plevap ! cloud liquid water evaporation rate
+
+! variables for droplet activation by modal aerosols
+ real(r8) :: wmix, wmin, wmax, wdiab
+ real(r8) :: vol, nlsrc
+ real(r8), allocatable :: vaerosol(:), hygro(:), naermod(:)
+ real(r8), allocatable :: fn(:) ! number fraction of aerosols activated
+ real(r8), allocatable :: fm(:) ! mass fraction of aerosols activated
+ real(r8), allocatable :: fluxn(:) ! flux of activated aerosol number fraction into cloud (cm/s)
+ real(r8), allocatable :: fluxm(:) ! flux of activated aerosol mass fraction into cloud (cm/s)
+ real(r8) :: flux_fullact ! flux of activated aerosol fraction assuming 100% activation (cm/s)
+ real(r8) :: dmc
+ real(r8) :: ssmc
+ real(r8) :: dgnum_aitken
+
+! bulk aerosol variables
+ real(r8), allocatable :: naer2(:,:,:) ! new aerosol number concentration (/m3)
+ real(r8), allocatable :: naer2h(:,:,:) ! new aerosol number concentration (/m3)
+ real(r8), allocatable :: maerosol(:) ! aerosol mass conc (kg/m3)
+ real(r8) :: so4_num
+ real(r8) :: soot_num
+ real(r8) :: dst1_num
+ real(r8) :: dst2_num
+ real(r8) :: dst3_num
+ real(r8) :: dst4_num
+ real(r8) :: dst_num
+
+! droplet activation
+ logical :: in_cloud ! true when above cloud base layer (k > jb)
+ real(r8) :: smax_f ! droplet and rain size distr factor used in the
+ ! in-cloud smax calculation
+ real(r8) :: dum2l(pcols,pver) ! number conc of CCN (1/kg)
+ real(r8) :: npccn(pver) ! droplet activation rate
+ real(r8) :: ncmax
+ real(r8) :: mtimec ! factor to account for droplet activation timescale
+
+! ice nucleation
+ real(r8) :: dum2i(pcols,pver) ! number conc of ice nuclei available (1/kg)
+ real(r8) :: qs(pcols,pver) ! liquid-ice weighted sat mixing rat (kg/kg)
+ real(r8) :: es(pcols,pver) ! sat vapor press (pa) over water
+ real(r8) :: relhum(pcols,pver) ! relative humidity
+ real(r8) :: esi(pcols,pver) ! sat vapor press (pa) over ice
+ real(r8) :: nnuccd(pver) ! ice nucleation rate from deposition/cond.-freezing
+ real(r8) :: mnuccd(pver) ! mass tendency from ice nucleation
+ real(r8) :: mtime ! factor to account for ice nucleation timescale
+
+! output for ice nucleation
+ real(r8) :: nimey(pcols,pver) !number conc of ice nuclei due to meyers deposition (1/m3)
+ real(r8) :: nihf(pcols,pver) !number conc of ice nuclei due to heterogenous freezing (1/m3)
+ real(r8) :: nidep(pcols,pver) !number conc of ice nuclei due to deoposion nucleation (hetero nuc) (1/m3)
+ real(r8) :: niimm(pcols,pver) !number conc of ice nuclei due to immersion freezing (hetero nuc) (1/m3)
+
+ real(r8) :: wpice, weff, fhom ! unused dummies
+
+! loop array variables
+ integer i,k, n, l
+ integer ii,kk, m
+
+! loop variables for iteration solution
+ integer iter,it,ltrue(pcols)
+
+! used in contact freezing via dust particles
+ real(r8) tcnt, viscosity, mfp
+ real(r8) slip1, slip2, slip3, slip4
+ real(r8) dfaer1, dfaer2, dfaer3, dfaer4
+ real(r8) nacon1,nacon2,nacon3,nacon4
+
+! used in immersion freezing via soot
+ real(r8) ttend(pver)
+ real(r8) naimm
+ real(r8) :: ntaer(pcols,pver)
+ real(r8) :: ntaerh(pcols,pver)
+
+! used in homogeneous freezing
+ real(r8) :: fholm (pcols,pver) !mass tendency due to homogeneous freezing
+ real(r8) :: fholn (pcols,pver) !number conc tendency due to homogeneous freezing
+
+! used in secondary ice production
+ real(r8) ni_secp
+
+! used in vertical velocity calculation
+ real(r8) th(pcols,pver)
+ real(r8) qh(pcols,pver)
+ real(r8) zkine(pcols,pver)
+ real(r8) zbuo(pcols,pver)
+ real(r8) zfacbuo, cwdrag, cwifrac, retv, zbuoc
+ real(r8) zbc, zbe, zdkbuo, zdken
+ real(r8) arcf(pcols,pver)
+ real(r8) p(pcols,pver)
+ real(r8) ph(pcols,pver)
+
+! used in vertical integreation
+ logical qcimp(pver) ! true to solve qc with implicit formula
+ logical ncimp(pver) ! true to solve nc with implicit formula
+ logical qiimp(pver) ! true to solve qi with implicit formula
+ logical niimp(pver) ! true to solve ni with implicit formula
+
+! tendency due to adjustment
+ real(r8) :: ncadj(pcols,pver) !droplet num tendency due to adjustment
+ real(r8) :: niadj(pcols,pver) !ice crystal num tendency due to adjustment
+ real(r8) :: ncorg, niorg, total
+
+ real(r8) :: rhoh(pcols,pver) ! air density (kg m-3) at interface
+ real(r8) :: rhom(pcols,pver) ! air density (kg m-3) at mid-level
+ real(r8) :: tu(pcols,pver) ! temperature in updraft (K)
+
+ integer kqi(pcols),kqc(pcols)
+ logical lcbase(pcols), libase(pcols)
+
+ real(r8) :: nai_bcphi, nai_dst1, nai_dst2, nai_dst3, nai_dst4
+
+ real(r8) flxrm, mvtrm, flxrn, mvtrn, flxsm, mvtsm, flxsn, mvtsn
+ integer nlr, nls
+
+ real(r8) rmean, beta6, beta66, r6, r6c
+ real(r8) temp1, temp2, temp3, temp4 ! variable to store output which is not required by this routine
+
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+! initialization
+!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ if (aero%scheme == 'modal') then
+
+ allocate(vaerosol(aero%nmodes), hygro(aero%nmodes), naermod(aero%nmodes), &
+ fn(aero%nmodes), fm(aero%nmodes), fluxn(aero%nmodes), fluxm(aero%nmodes))
+
+ else if (aero%scheme == 'bulk') then
+
+ allocate( &
+ naer2(pcols,pver,aero%nbulk), &
+ naer2h(pcols,pver,aero%nbulk), &
+ maerosol(aero%nbulk))
+
+ end if
+
+ deltat= get_step_size() !for FV dynamical core
+
+ ! parameters for scheme
+ omsm=0.99999_r8
+ zfacbuo = 0.5_r8/(1._r8+0.5_r8)
+ cwdrag = 1.875_r8*0.506_r8
+ cwifrac = 0.5_r8
+ retv = 0.608_r8
+ bergtsf = 1800._r8
+
+ ! initialize multi-level fields
+ do i=1,il2g
+ do k=1,pver
+ q(i,k) = qu(i,k)
+ tu(i,k)= su(i,k) - grav/cp*zf(i,k)
+ t(i,k) = su(i,k) - grav/cp*zf(i,k)
+ p(i,k) = 100._r8*pm(i,k)
+ wu(i,k) = 0._r8
+ zkine(i,k)= 0._r8
+ arcf(i,k) = 0._r8
+ zbuo(i,k) = 0._r8
+ nc(i,k) = 0._r8
+ ni(i,k) = 0._r8
+ qc(i,k) = 0._r8
+ qi(i,k) = 0._r8
+ ncde(i,k) = 0._r8
+ nide(i,k) = 0._r8
+ qcde(i,k) = 0._r8
+ qide(i,k) = 0._r8
+ rprd(i,k) = 0._r8
+ sprd(i,k) = 0._r8
+ frz(i,k) = 0._r8
+ qcic(i,k) = 0._r8
+ qiic(i,k) = 0._r8
+ ncic(i,k) = 0._r8
+ niic(i,k) = 0._r8
+ qr(i,k) = 0._r8
+ qni(i,k) = 0._r8
+ nr(i,k) = 0._r8
+ ns(i,k) = 0._r8
+ qric(i,k) = 0._r8
+ qniic(i,k) = 0._r8
+ nric(i,k) = 0._r8
+ nsic(i,k) = 0._r8
+ nimey(i,k) = 0._r8
+ nihf(i,k) = 0._r8
+ nidep(i,k) = 0._r8
+ niimm(i,k) = 0._r8
+ fhmrm(i,k) = 0._r8
+
+ autolm(i,k) = 0._r8
+ accrlm(i,k) = 0._r8
+ bergnm(i,k) = 0._r8
+ fhtimm(i,k) = 0._r8
+ fhtctm(i,k) = 0._r8
+ fhmlm (i,k) = 0._r8
+ fholm (i,k) = 0._r8
+ hmpim (i,k) = 0._r8
+ accslm(i,k) = 0._r8
+ dlfm (i,k) = 0._r8
+
+ autoln(i,k) = 0._r8
+ accrln(i,k) = 0._r8
+ bergnn(i,k) = 0._r8
+ fhtimn(i,k) = 0._r8
+ fhtctn(i,k) = 0._r8
+ fhmln (i,k) = 0._r8
+ fholn (i,k) = 0._r8
+ accsln(i,k) = 0._r8
+ activn(i,k) = 0._r8
+ dlfn (i,k) = 0._r8
+
+ autoim(i,k) = 0._r8
+ accsim(i,k) = 0._r8
+ difm (i,k) = 0._r8
+
+ nuclin(i,k) = 0._r8
+ autoin(i,k) = 0._r8
+ accsin(i,k) = 0._r8
+ hmpin (i,k) = 0._r8
+ difn (i,k) = 0._r8
+
+ trspcm(i,k) = 0._r8
+ trspcn(i,k) = 0._r8
+ trspim(i,k) = 0._r8
+ trspin(i,k) = 0._r8
+
+ ncadj (i,k) = 0._r8
+ niadj (i,k) = 0._r8
+ end do
+ end do
+
+ ! initialize time-varying parameters
+ do k=1,pver
+ do i=1,il2g
+ if (k .eq.1) then
+ rhoh(i,k) = p(i,k)/(t(i,k)*rd)
+ rhom(i,k) = p(i,k)/(t(i,k)*rd)
+ th (i,k) = te(i,k)
+ qh (i,k) = qe(i,k)
+ dz (i,k) = zf(i,k) - zf(i,k+1)
+ ph(i,k) = p(i,k)
+ else
+ rhoh(i,k) = 0.5_r8*(p(i,k)+p(i,k-1))/(t(i,k)*rd)
+ if (k .eq. pver) then
+ rhom(i,k) = p(i,k)/(rd*t(i,k))
+ else
+ rhom(i,k) = 2.0_r8*p(i,k)/(rd*(t(i,k)+t(i,k+1)))
+ end if
+ th (i,k) = 0.5_r8*(te(i,k)+te(i,k-1))
+ qh (i,k) = 0.5_r8*(qe(i,k)+qe(i,k-1))
+ dz(i,k) = zf(i,k-1) - zf(i,k)
+ ph(i,k) = 0.5_r8*(p(i,k) + p(i,k-1))
+ end if
+ dv(i,k) = 8.794E-5_r8*t(i,k)**1.81_r8/ph(i,k)
+ mua(i,k) = 1.496E-6_r8*t(i,k)**1.5_r8/ &
+ (t(i,k)+120._r8)
+
+ rho(i,k) = rhoh(i,k)
+
+ ! air density adjustment for fallspeed parameters
+ ! add air density correction factor to the power of
+ ! 0.54 following Heymsfield and Bansemer 2006
+
+ arn(i,k)=ar*(rhosu/rho(i,k))**0.54_r8
+ asn(i,k)=as*(rhosu/rho(i,k))**0.54_r8
+ acn(i,k)=ac*(rhosu/rho(i,k))**0.54_r8
+ ain(i,k)=ai*(rhosu/rho(i,k))**0.54_r8
+
+ end do
+ end do
+
+ if (aero%scheme == 'modal') then
+
+ wmix = 0._r8
+ wmin = 0._r8
+ wmax = 10._r8
+ wdiab = 0._r8
+
+ do k=1,pver
+ do i=1,il2g
+ dum2l(i,k)=0._r8
+ dum2i(i,k)=0._r8
+ ntaer(i,k) = 0.0_r8
+ ntaerh(i,k) = 0.0_r8
+ do m = 1, aero%nmodes
+ ntaer(i,k) = ntaer(i,k) + aero%numg_a(i,k,m)*rhom(i,k)
+ enddo
+ end do
+ end do
+
+ else if (aero%scheme == 'bulk') then
+
+ ! initialize aerosol number
+ do k=1,pver
+ do i=1,il2g
+ naer2(i,k,:)=0._r8
+ naer2h(i,k,:)=0._r8
+ dum2l(i,k)=0._r8
+ dum2i(i,k)=0._r8
+ end do
+ end do
+
+ do k=1,pver
+ do i=1,il2g
+ ntaer(i,k) = 0.0_r8
+ ntaerh(i,k) = 0.0_r8
+ do m = 1, aero%nbulk
+ maerosol(m) = aero%mmrg_bulk(i,k,m)*rhom(i,k)
+
+ ! set number nucleated for sulfate based on Lohmann et al. 2000 (JGR) Eq.2
+ ! Na=340.*(massSO4)^0.58 where Na=cm-3 and massSO4=ug/m3
+ ! convert units to Na [m-3] and SO4 [kgm-3]
+ ! Na(m-3)= 1.e6 cm3 m-3 Na(cm-3)=340. *(massSO4[kg/m3]*1.e9ug/kg)^0.58
+ ! or Na(m-3)= 1.e6* 340.*(1.e9ug/kg)^0.58 * (massSO4[kg/m3])^0.58
+
+ if (m .eq. aero%idxsul) then
+ naer2(i,k,m)= 5.64259e13_r8 * maerosol(m)**0.58_r8
+ else
+ naer2(i,k,m)=maerosol(m)*aero%num_to_mass_aer(m)
+ end if
+ ntaer(i,k) = ntaer(i,k) + naer2(i,k,m)
+ end do
+ end do
+ end do
+
+ end if
+
+ do i=1,il2g
+ ltrue(i)=0
+ do k=1,pver
+ if (qc(i,k).ge.qsmall.or.qi(i,k).ge.qsmall.or.cmel(i,k).ge.qsmall.or.cmei(i,k).ge.qsmall) ltrue(i)=1
+ end do
+ end do
+
+ ! skip microphysical calculations if no cloud water
+ do i=1,il2g
+ if (ltrue(i).eq.0) then
+ do k=1,pver
+ qctend(i,k)=0._r8
+ qitend(i,k)=0._r8
+ qnitend(i,k)=0._r8
+ qrtend(i,k)=0._r8
+ nctend(i,k)=0._r8
+ nitend(i,k)=0._r8
+ nrtend(i,k)=0._r8
+ nstend(i,k)=0._r8
+ qniic(i,k)=0._r8
+ qric(i,k)=0._r8
+ nsic(i,k)=0._r8
+ nric(i,k)=0._r8
+ qni(i,k)=0._r8
+ qr(i,k)=0._r8
+ ns(i,k)=0._r8
+ nr(i,k)=0._r8
+ qc(i,k) = 0._r8
+ qi(i,k) = 0._r8
+ nc(i,k) = 0._r8
+ ni(i,k) = 0._r8
+ qcde(i,k) = 0._r8
+ qide(i,k) = 0._r8
+ ncde(i,k) = 0._r8
+ nide(i,k) = 0._r8
+ rprd(i,k) = 0._r8
+ sprd(i,k) = 0._r8
+ frz(i,k) = 0._r8
+ end do
+ goto 300
+ end if
+
+ kqc(i) = 1
+ kqi(i) = 1
+ lcbase(i) = .true.
+ libase(i) = .true.
+
+ ! assign number of steps for iteration
+ ! use 2 steps following Song and Zhang, 2011, J. Clim.
+ iter = 2
+
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+ ! iteration
+ !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+
+ do it=1,iter
+
+ ! initialize sub-step microphysical tendencies
+ do k=1,pver
+ qctend(i,k)=0._r8
+ qitend(i,k)=0._r8
+ qnitend(i,k)=0._r8
+ qrtend(i,k)=0._r8
+ nctend(i,k)=0._r8
+ nitend(i,k)=0._r8
+ nrtend(i,k)=0._r8
+ nstend(i,k)=0._r8
+ rprd(i,k) = 0._r8
+ sprd(i,k) = 0._r8
+ frz(i,k) = 0._r8
+ qniic(i,k)=0._r8
+ qric(i,k)=0._r8
+ nsic(i,k)=0._r8
+ nric(i,k)=0._r8
+ qiic(i,k)=0._r8
+ qcic(i,k)=0._r8
+ niic(i,k)=0._r8
+ ncic(i,k)=0._r8
+ qcimp(k) = .false.
+ ncimp(k) = .false.
+ qiimp(k) = .false.
+ niimp(k) = .false.
+ dum2l(i,k)=0._r8
+ dum2i(i,k)=0._r8
+ autolm(i,k) = 0._r8
+ accrlm(i,k) = 0._r8
+ bergnm(i,k) = 0._r8
+ fhtimm(i,k) = 0._r8
+ fhtctm(i,k) = 0._r8
+ fhmlm (i,k) = 0._r8
+ fholm (i,k) = 0._r8
+ hmpim (i,k) = 0._r8
+ accslm(i,k) = 0._r8
+ dlfm (i,k) = 0._r8
+
+ autoln(i,k) = 0._r8
+ accrln(i,k) = 0._r8
+ bergnn(i,k) = 0._r8
+ fhtimn(i,k) = 0._r8
+ fhtctn(i,k) = 0._r8
+ fhmln (i,k) = 0._r8
+ fholn (i,k) = 0._r8
+ accsln(i,k) = 0._r8
+ activn(i,k) = 0._r8
+ dlfn (i,k) = 0._r8
+ ncadj (i,k) = 0._r8
+
+ autoim(i,k) = 0._r8
+ accsim(i,k) = 0._r8
+ difm (i,k) = 0._r8
+
+ nuclin(i,k) = 0._r8
+ autoin(i,k) = 0._r8
+ accsin(i,k) = 0._r8
+ hmpin (i,k) = 0._r8
+ difn (i,k) = 0._r8
+ niadj (i,k) = 0._r8
+
+ trspcm(i,k) = 0._r8
+ trspcn(i,k) = 0._r8
+ trspim(i,k) = 0._r8
+ trspin(i,k) = 0._r8
+
+ fhmrm (i,k) = 0._r8
+ end do
+
+ do k = pver,msg+2,-1
+
+ if (k > jt(i) .and. k <= jb(i) .and. eps0(i) > 0._r8 &
+ .and.mu(i,k).gt.0._r8 .and. mu(i,k-1).gt.0._r8) then
+
+ ! initialize precip fallspeeds to zero
+ if (it.eq.1) then
+ ums(k)=0._r8
+ uns(k)=0._r8
+ umr(k)=0._r8
+ unr(k)=0._r8
+ prf(k)=0._r8
+ pnrf(k)=0._r8
+ psf(k) =0._r8
+ pnsf(k) = 0._r8
+ end if
+ ttend(k)=0._r8
+ nnuccd(k)=0._r8
+ npccn(k)=0._r8
+
+ !************************************************************************************
+ ! obtain values of cloud water/ice mixing ratios and number concentrations in updraft
+ ! for microphysical process calculations
+ ! units are kg/kg for mixing ratio, 1/kg for number conc
+ !************************************************************************************
+
+
+ if (it.eq.1) then
+ qcic(i,k) = qc(i,k)
+ qiic(i,k) = qi(i,k)
+ ncic(i,k) = nc(i,k)
+ niic(i,k) = ni(i,k)
+ qniic(i,k)= qni(i,k)
+ qric(i,k) = qr(i,k)
+ nsic(i,k) = ns(i,k)
+ nric(i,k) = nr(i,k)
+ else
+ if (k.le.kqc(i)) then
+ qcic(i,k) = qc(i,k)
+ ncic(i,k) = nc(i,k)
+
+ ! consider rain falling from above
+ flxrm = 0._r8
+ mvtrm = 0._r8
+ flxrn = 0._r8
+ mvtrn = 0._r8
+ nlr = 0
+
+ do kk= k,jt(i)+3,-1
+ if (qr(i,kk-1) .gt. 0._r8) then
+ nlr = nlr + 1
+ flxrm = flxrm + umr(kk-1)*qr(i,kk-1)*arcf(i,kk-1)
+ flxrn = flxrn + unr(kk-1)*nr(i,kk-1)*arcf(i,kk-1)
+ mvtrm = mvtrm + umr(kk-1)*arcf(i,kk-1)
+ mvtrn = mvtrn + unr(kk-1)*arcf(i,kk-1)
+ end if
+ end do
+ if (mvtrm.gt.0) then
+ qric(i,k) = (qr(i,k)*mu(i,k)+flxrm)/(mu(i,k)+mvtrm)
+ else
+ qric(i,k) = qr(i,k)
+ end if
+ if (mvtrn.gt.0) then
+ nric(i,k) = (nr(i,k)*mu(i,k)+flxrn)/(mu(i,k)+mvtrn)
+ else
+ nric(i,k) = nr(i,k)
+ end if
+
+ end if
+ if (k.eq.kqc(i)) then
+ qcic(i,k) = qc(i,k-1)
+ ncic(i,k) = nc(i,k-1)
+ end if
+ if(k.le.kqi(i)) then
+ qiic(i,k) = qi(i,k)
+ niic(i,k) = ni(i,k)
+! consider snow falling from above
+ flxsm = 0._r8
+ mvtsm = 0._r8
+ flxsn = 0._r8
+ mvtsn = 0._r8
+ nls = 0
+
+ do kk= k,jt(i)+3,-1
+ if (qni(i,kk-1) .gt. 0._r8) then
+ nls = nls + 1
+ flxsm = flxsm + ums(kk-1)*qni(i,kk-1)*arcf(i,kk-1)
+ mvtsm = mvtsm + ums(kk-1)*arcf(i,kk-1)
+ flxsn = flxsn + uns(kk-1)*ns(i,kk-1)*arcf(i,kk-1)
+ mvtsn = mvtsn + uns(kk-1)*arcf(i,kk-1)
+ end if
+ end do
+
+ if (mvtsm.gt.0) then
+ qniic(i,k) = (qni(i,k)*mu(i,k)+flxsm)/(mu(i,k)+mvtsm)
+ else
+ qniic(i,k) = qni(i,k)
+ end if
+ if (mvtsn.gt.0) then
+ nsic(i,k) = (ns(i,k)*mu(i,k)+flxsn)/(mu(i,k)+mvtsn)
+ else
+ nsic(i,k) = ns(i,k)
+ end if
+ end if
+ if(k.eq.kqi(i)) then
+ qiic(i,k) = qi(i,k-1)
+ niic(i,k) = ni(i,k-1)
+ end if
+ end if
+
+ !**********************************************************************
+ ! boundary condition for cloud liquid water and cloud ice
+ !***********************************************************************
+
+ ! boundary condition for provisional cloud water
+ if (cmel(i,k-1).gt.qsmall .and. lcbase(i) .and. it.eq.1 ) then
+ kqc(i) = k
+ lcbase(i) = .false.
+ qcic(i,k) = dz(i,k)*cmel(i,k-1)/(mu(i,k-1)+dz(i,k)*du(i,k-1))
+ ncic(i,k) = qcic(i,k)/(4._r8/3._r8*pi*10.e-6_r8**3*rhow)
+ end if
+
+ ! boundary condition for provisional cloud ice
+ if (qiic(i,k).gt.qsmall .and. libase(i) .and. it.eq.1 ) then
+ kqi(i) = k
+ libase(i) = .false.
+ else if ( cmei(i,k-1).gt.qsmall .and. &
+ cmei(i,k).lt.qsmall .and. k.le.jb(i) .and. libase(i) .and. it.eq.1 ) then
+ kqi(i)=k
+ libase(i) = .false.
+ qiic(i,k) = dz(i,k)*cmei(i,k-1)/(mu(i,k-1)+dz(i,k)*du(i,k-1))
+ niic(i,k) = qiic(i,k)/(4._r8/3._r8*pi*25.e-6_r8**3*rhoi)
+ end if
+
+ !***************************************************************************
+ ! get size distribution parameters based on in-cloud cloud water/ice
+ ! these calculations also ensure consistency between number and mixing ratio
+ !***************************************************************************
+ ! cloud ice
+ if (qiic(i,k).ge.qsmall) then
+
+ ! add upper limit to in-cloud number concentration to prevent numerical error
+ niic(i,k)=min(niic(i,k),qiic(i,k)*1.e20_r8)
+ lami(k) = (gamma(1._r8+di)*ci* &
+ niic(i,k)/qiic(i,k))**(1._r8/di)
+ n0i(k) = niic(i,k)*lami(k)
+
+ ! check for slope
+ lammax = 1._r8/10.e-6_r8
+ lammin = 1._r8/(2._r8*dcs)
+
+ ! adjust vars
+ if (lami(k).lt.lammin) then
+ lami(k) = lammin
+ n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*gamma(1._r8+di))
+ niic(i,k) = n0i(k)/lami(k)
+ else if (lami(k).gt.lammax) then
+ lami(k) = lammax
+ n0i(k) = lami(k)**(di+1._r8)*qiic(i,k)/(ci*gamma(1._r8+di))
+ niic(i,k) = n0i(k)/lami(k)
+ end if
+ else
+ lami(k) = 0._r8
+ n0i(k) = 0._r8
+ end if
+
+ ! cloud water
+ if (qcic(i,k).ge.qsmall) then
+
+ ! add upper limit to in-cloud number concentration to prevent numerical error
+ ncic(i,k)=min(ncic(i,k),qcic(i,k)*1.e20_r8)
+
+ ! get pgam from fit to observations of martin et al. 1994
+
+ pgam(i,k)=0.0005714_r8*(ncic(i,k)/1.e6_r8/rho(i,k))+0.2714_r8
+ pgam(i,k)=1._r8/(pgam(i,k)**2)-1._r8
+ pgam(i,k)=max(pgam(i,k),2._r8)
+ pgam(i,k)=min(pgam(i,k),15._r8)
+
+ ! calculate lamc
+ lamc(i,k) = (pi/6._r8*rhow*ncic(i,k)*gamma(pgam(i,k)+4._r8)/ &
+ (qcic(i,k)*gamma(pgam(i,k)+1._r8)))**(1._r8/3._r8)
+
+ ! lammin, 50 micron diameter max mean size
+ lammin = (pgam(i,k)+1._r8)/40.e-6_r8
+ lammax = (pgam(i,k)+1._r8)/1.e-6_r8
+
+ if (lamc(i,k).lt.lammin) then
+ lamc(i,k) = lammin
+ ncic(i,k) = 6._r8*lamc(i,k)**3*qcic(i,k)* &
+ gamma(pgam(i,k)+1._r8)/ &
+ (pi*rhow*gamma(pgam(i,k)+4._r8))
+ else if (lamc(i,k).gt.lammax) then
+ lamc(i,k) = lammax
+ ncic(i,k) = 6._r8*lamc(i,k)**3*qcic(i,k)* &
+ gamma(pgam(i,k)+1._r8)/ &
+ (pi*rhow*gamma(pgam(i,k)+4._r8))
+ end if
+
+ ! parameter to calculate droplet freezing
+
+ cdist1(k) = ncic(i,k)/gamma(pgam(i,k)+1._r8)
+ else
+ lamc(i,k) = 0._r8
+ cdist1(k) = 0._r8
+ end if
+
+ ! boundary condition for cloud liquid water
+ if ( kqc(i) .eq. k ) then
+ qc(i,k) = 0._r8
+ nc(i,k) = 0._r8
+ end if
+
+ ! boundary condition for cloud ice
+ if (kqi(i).eq.k ) then
+ qi(i,k) = 0._r8
+ ni(i,k) = 0._r8
+ end if
+
+ !**************************************************************************
+ ! begin micropysical process calculations
+ !**************************************************************************
+
+ !.................................................................
+ ! autoconversion of cloud liquid water to rain
+ ! formula from Khrouditnov and Kogan (2000)
+ ! minimum qc of 1 x 10^-8 prevents floating point error
+
+ if (qcic(i,k).ge.1.e-8_r8) then
+
+ ! nprc is increase in rain number conc due to autoconversion
+ ! nprc1 is decrease in cloud droplet conc due to autoconversion
+ ! Khrouditnov and Kogan (2000)
+! prc(k) = 1350._r8*qcic(i,k)**2.47_r8* &
+! (ncic(i,k)/1.e6_r8*rho(i,k))**(-1.79_r8)
+
+ ! Liu and Daum(2004)(modified), Wood(2005)
+ rmean = 1.e6_r8*((qcic(i,k)/ncic(i,k))/(4._r8/3._r8*pi*rhow))**(1._r8/3._r8)
+
+ if (rmean .ge. 15._r8) then
+
+ beta6 = (1._r8+3._r8/rmean)**(1._r8/3._r8)
+ beta66 = (1._r8+3._r8/rmean)**2._r8
+ r6 = beta6*rmean
+ r6c = 7.5_r8/(r6**0.5_r8*(qcic(i,k)*rho(i,k))**(1._r8/6._r8))
+ prc(k) = 1.3e9_r8*beta66*(qcic(i,k)*rho(i,k))**3._r8/ &
+ (ncic(i,k)*rho(i,k))*max(0._r8,r6-r6c)/rho(i,k)
+
+ nprc1(k) = prc(k)/(qcic(i,k)/ncic(i,k))
+ nprc(k) = nprc1(k)*0.5_r8
+ else
+ prc(k)=0._r8
+ nprc(k)=0._r8
+ nprc1(k)=0._r8
+ end if
+ else
+ prc(k)=0._r8
+ nprc(k)=0._r8
+ nprc1(k)=0._r8
+ end if
+
+ ! provisional rain mixing ratio and number concentration (qric and nric)
+ ! at boundary are estimated via autoconversion
+
+ if (k.eq.kqc(i) .and. it.eq.1) then
+ qric(i,k) = prc(k)*dz(i,k)/0.55_r8
+ nric(i,k) = nprc(k)*dz(i,k)/0.55_r8
+ qr(i,k) = 0.0_r8
+ nr(i,k) = 0.0_r8
+ end if
+
+ !.......................................................................
+ ! Autoconversion of cloud ice to snow
+ ! similar to Ferrier (1994)
+
+ call ice_autoconversion(t(i,k), qiic(i,k), lami(k), n0i(k), dcs, prci(k), nprci(k), 1)
+
+ ! provisional snow mixing ratio and number concentration (qniic and nsic)
+ ! at boundary are estimated via autoconversion
+
+ if (k.eq.kqi(i) .and. it.eq.1) then
+ qniic(i,k)= prci(k)*dz(i,k)*0.25_r8
+ nsic(i,k)= nprci(k)*dz(i,k)*0.25_r8
+ qni(i,k)= 0.0_r8
+ ns(i,k)= 0.0_r8
+ end if
+
+ ! if precip mix ratio is zero so should number concentration
+ if (qniic(i,k).lt.qsmall) then
+ qniic(i,k)=0._r8
+ nsic(i,k)=0._r8
+ end if
+ if (qric(i,k).lt.qsmall) then
+ qric(i,k)=0._r8
+ nric(i,k)=0._r8
+ end if
+
+ ! make sure number concentration is a positive number to avoid
+ ! taking root of negative later
+ nric(i,k)=max(nric(i,k),0._r8)
+ nsic(i,k)=max(nsic(i,k),0._r8)
+
+ !**********************************************************************
+ ! get size distribution parameters for precip
+ !**********************************************************************
+ ! rain
+
+ if (qric(i,k).ge.qsmall) then
+ lamr(k) = (pi*rhow*nric(i,k)/qric(i,k))**(1._r8/3._r8)
+ n0r(k) = nric(i,k)*lamr(k)
+
+ ! check for slope
+ lammax = 1._r8/150.e-6_r8
+ lammin = 1._r8/3000.e-6_r8
+
+ ! adjust vars
+ if (lamr(k).lt.lammin) then
+ lamr(k) = lammin
+ n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow)
+ nric(i,k) = n0r(k)/lamr(k)
+ else if (lamr(k).gt.lammax) then
+ lamr(k) = lammax
+ n0r(k) = lamr(k)**4*qric(i,k)/(pi*rhow)
+ nric(i,k) = n0r(k)/lamr(k)
+ end if
+
+ ! provisional rain number and mass weighted mean fallspeed (m/s)
+ ! Eq.18 of Morrison and Gettelman, 2008, J. Climate
+ unr(k) = min(arn(i,k)*gamma(1._r8+br)/lamr(k)**br,10._r8)
+ umr(k) = min(arn(i,k)*gamma(4._r8+br)/(6._r8*lamr(k)**br),10._r8)
+ else
+ lamr(k) = 0._r8
+ n0r(k) = 0._r8
+ umr(k) = 0._r8
+ unr(k) = 0._r8
+ end if
+
+ !......................................................................
+ ! snow
+ if (qniic(i,k).ge.qsmall) then
+ lams(k) = (gamma(1._r8+ds)*cs*nsic(i,k)/ &
+ qniic(i,k))**(1._r8/ds)
+ n0s(k) = nsic(i,k)*lams(k)
+
+ ! check for slope
+ lammax = 1._r8/10.e-6_r8
+ lammin = 1._r8/2000.e-6_r8
+
+ ! adjust vars
+ if (lams(k).lt.lammin) then
+ lams(k) = lammin
+ n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*gamma(1._r8+ds))
+ nsic(i,k) = n0s(k)/lams(k)
+ else if (lams(k).gt.lammax) then
+ lams(k) = lammax
+ n0s(k) = lams(k)**(ds+1._r8)*qniic(i,k)/(cs*gamma(1._r8+ds))
+ nsic(i,k) = n0s(k)/lams(k)
+ end if
+
+ ! provisional snow number and mass weighted mean fallspeed (m/s)
+ ums(k) = min(asn(i,k)*gamma(4._r8+bs)/(6._r8*lams(k)**bs),3.6_r8)
+ uns(k) = min(asn(i,k)*gamma(1._r8+bs)/lams(k)**bs,3.6_r8)
+ else
+ lams(k) = 0._r8
+ n0s(k) = 0._r8
+ ums(k) = 0._r8
+ uns(k) = 0._r8
+ end if
+
+ !.......................................................................
+ ! snow self-aggregation from passarelli, 1978, used by Reisner(1998,Eq.A.35)
+ ! this is hard-wired for bs = 0.4 for now
+ ! ignore self-collection of cloud ice
+
+ call snow_self_aggregation(t(i,k), rho(i,k), asn(i,k), rhosn, qniic(i,k), nsic(i,k), nsagg(k), 1)
+
+ !.......................................................................
+ ! accretion of cloud droplets onto snow/graupel
+ ! here use continuous collection equation with
+ ! simple gravitational collection kernel
+ ! ignore collisions between droplets/cloud ice
+
+ ! ignore collision of snow with droplets above freezing
+
+ call accrete_cloud_water_snow(t(i,k), rho(i,k), asn(i,k), uns(k), mua(i,k), &
+ qcic(i,k), ncic(i,k), qniic(i,k), pgam(i,k), lamc(i,k), lams(k), n0s(k), &
+ psacws(k), npsacws(k), 1)
+
+ ! secondary ice production due to accretion of droplets by snow
+ ! (Hallet-Mossop process) (from Cotton et al., 1986)
+
+ call secondary_ice_production(t(i,k), psacws(k), msacwi(k), nsacwi(k), 1)
+
+ !.......................................................................
+ ! accretion of rain water by snow
+ ! formula from ikawa and saito, 1991, used by reisner et al., 1998
+
+ call accrete_rain_snow(t(i,k), rho(i,k), umr(k), ums(k), unr(k), uns(k), qric(i,k), &
+ qniic(i,k), lamr(k), n0r(k), lams(k), n0s(k), pracs(k), npracs(k), 1 )
+
+ !.......................................................................
+ ! heterogeneous freezing of rain drops
+ ! follows from Bigg (1953)
+
+ call heterogeneous_rain_freezing(t(i,k), qric(i,k), nric(i,k), lamr(k), mnuccr(k), nnuccr(k), 1)
+
+ !.......................................................................
+ ! accretion of cloud liquid water by rain
+ ! formula from Khrouditnov and Kogan (2000)
+ ! gravitational collection kernel, droplet fall speed neglected
+
+ call accrete_cloud_water_rain(.true., qric(i,k), qcic(i,k), ncic(i,k), [1._r8], [0._r8], pra(k), npra(k), 1)
+
+ !.......................................................................
+ ! Self-collection of rain drops
+ ! from Beheng(1994)
+
+ call self_collection_rain(rho(i,k), qric(i,k), nric(i,k), nragg(k), 1)
+
+ !.......................................................................
+ ! Accretion of cloud ice by snow
+ ! For this calculation, it is assumed that the Vs >> Vi
+ ! and Ds >> Di for continuous collection
+
+ call accrete_cloud_ice_snow(t(i,k), rho(i,k), asn(i,k), qiic(i,k), niic(i,k), &
+ qniic(i,k), lams(k), n0s(k), prai(k), nprai(k), 1)
+
+ !.......................................................................
+ ! fallout term
+ prf(k) = -umr(k)*qric(i,k)/dz(i,k)
+ pnrf(k) = -unr(k)*nric(i,k)/dz(i,k)
+ psf(k) = -ums(k)*qniic(i,k)/dz(i,k)
+ pnsf(k) = -uns(k)*nsic(i,k)/dz(i,k)
+
+ !........................................................................
+ ! calculate vertical velocity in cumulus updraft
+
+ if (k.eq.jb(i)) then
+ zkine(i,jb(i)) = 0.5_r8
+ wu (i,jb(i)) = 1._r8
+ zbuo (i,jb(i)) = (tu(i,jb(i))*(1._r8+retv*qu(i,jb(i)))- &
+ th(i,jb(i))*(1._r8+retv*qh(i,jb(i))))/ &
+ (th(i,jb(i))*(1._r8+retv*qh(i,jb(i))))
+ else
+ if (.true.) then
+ ! ECMWF formula
+ zbc = tu(i,k)*(1._r8+retv*qu(i,k)-qr(i,k)-qni(i,k)-qi(i,k)-qc(i,k))
+ zbe = th(i,k)*(1._r8+retv*qh(i,k))
+ zbuo(i,k) = (zbc-zbe)/zbe
+ zbuoc= (zbuo(i,k)+zbuo(i,k+1))*0.5_r8
+ zdkbuo = dz(i,k+1)*grav*zfacbuo*zbuoc
+ zdken = min(.99_r8,(1._r8+cwdrag)*max(du(i,k),eu(i,k))*dz(i,k+1)/ &
+ max(1.e-10_r8,mu(i,k+1)))
+ zkine(i,k) = (zkine(i,k+1)*(1._r8-zdken)+zdkbuo)/ &
+ (1._r8+zdken)
+ else
+ ! Gregory formula
+ zbc = tu(i,k)*(1._r8+retv*qu(i,k))
+ zbe = th(i,k)*(1._r8+retv*qh(i,k))
+ zbuo(i,k) = (zbc-zbe)/zbe-qr(i,k)-qni(i,k)-qi(i,k)-qc(i,k)
+ zbuoc= (zbuo(i,k)+zbuo(i,k+1))*0.5_r8
+ zdkbuo = dz(i,k+1)*grav*zbuoc*(1.0_r8-0.25_r8)/6._r8
+ zdken = du(i,k)*dz(i,k+1)/max(1.e-10_r8,mu(i,k+1))
+ zkine(i,k) = (zkine(i,k+1)*(1._r8-zdken)+zdkbuo)/ &
+ (1._r8+zdken)
+ end if
+ wu(i,k) = min(15._r8,sqrt(2._r8*max(0.1_r8,zkine(i,k) )))
+ end if
+
+ arcf(i,k)= mu(i,k)/wu(i,k)
+
+ !............................................................................
+ ! droplet activation
+ ! calculate potential for droplet activation if cloud water is present
+ ! formulation from Abdul-Razzak and Ghan (2000) and Abdul-Razzak et al. (1998), AR98
+
+ if (aero%scheme == 'bulk') then
+ naer2h(i,k,:) = 0.5_r8*(naer2(i,k,:) + naer2(i,k-1,:))
+ end if
+
+ ntaerh(i,k) = 0.5_r8*(ntaer(i,k) + ntaer(i,k-1))
+
+ if (qcic(i,k).ge.qsmall ) then
+
+ if (aero%scheme == 'modal') then
+
+ nlsrc = 0._r8
+
+ do m = 1, aero%nmodes
+ vaerosol(m) = 0._r8
+ hygro(m) = 0._r8
+ do l = 1, aero%nspec(m)
+ vol = max(0.5_r8*(aero%mmrg_a(i,k,l,m)+aero%mmrg_a(i,k-1,l,m)) , 0._r8)/aero%specdens(l,m)
+ vaerosol(m) = vaerosol(m) + vol
+ hygro(m) = hygro(m) + vol*aero%spechygro(l,m)
+ end do
+ if (vaerosol(m) > 1.0e-30_r8) then
+ hygro(m) = hygro(m)/(vaerosol(m))
+ vaerosol(m) = vaerosol(m)*rho(i,k)
+ else
+ hygro(m) = 0.0_r8
+ vaerosol(m) = 0.0_r8
+ endif
+ naermod(m) = 0.5_r8*(aero%numg_a(i,k,m)+aero%numg_a(i,k-1,m))*rho(i,k)
+ naermod(m) = max(naermod(m), vaerosol(m)*aero%voltonumbhi(m))
+ naermod(m) = min(naermod(m), vaerosol(m)*aero%voltonumblo(m))
+ end do
+
+ in_cloud = (k < jb(i))
+ smax_f = 0.0_r8
+ if (in_cloud) then
+ if ( qcic(i,k).ge.qsmall ) &
+ smax_f = ncic(i,k)/lamc(i,k) * gamma(2.0_r8 + pgam(i,k))/gamma(1.0_r8 + pgam(i,k))
+ if ( qric(i,k).ge.qsmall) smax_f = smax_f + nric(i,k)/lamr(k)
+
+ end if
+
+! call activate_modal( &
+! wu(i,k), wmix, wdiab, wmin, wmax, &
+! t(i,k), rho(i,k), naermod, aero%nmodes, vaerosol, &
+! hygro, fn, fm, &
+! fluxn, fluxm, flux_fullact, in_cloud_in=in_cloud, smax_f=smax_f)
+
+ do m = 1, aero%nmodes
+ nlsrc = nlsrc + fn(m)*naermod(m) ! number nucleated
+ end do
+
+ if (nlsrc .ne. nlsrc) then
+ write(iulog,*) "nlsrc=",nlsrc,"wu(i,k)=",wu(i,k)
+ write(iulog,*) "fn(m)=",fn,"naermod(m)=",naermod,"aero%specdens(l,m)=",aero%specdens
+ write(iulog,*) "vaerosol(m)=",vaerosol,"aero%voltonumbhi(m)=",aero%voltonumbhi
+ write(iulog,*) "aero%voltonumblo(m)=",aero%voltonumblo,"k=",k,"i=",i
+ write(iulog,*) "aero%numg_a(i,k,m)=",aero%numg_a(i,k,:),"rho(i,k)=",rho(i,k)
+ write(iulog,*) "aero%mmrg_a(i,k,l,m)=",aero%mmrg_a(i,k,:,:)
+ end if
+
+ dum2l(i,k) = nlsrc
+
+ else if (aero%scheme == 'bulk') then
+
+ call ndrop_bam_run( &
+ wu(i,k), t(i,k), rho(i,k), naer2h(i,k,:), aero%nbulk, &
+ aero%nbulk, maerosol, dum2)
+
+ dum2l(i,k) = dum2
+
+ end if
+
+ else
+ dum2l(i,k) = 0._r8
+ end if
+
+ ! get droplet activation rate
+ if (qcic(i,k).ge.qsmall .and. t(i,k).gt.238.15_r8 .and. k.gt.jt(i)+2 ) then
+
+ ! assume aerosols already activated are equal number of existing droplets for simplicity
+ if (k.eq.kqc(i)) then
+ npccn(k) = dum2l(i,k)/deltat
+ else
+ npccn(k) = (dum2l(i,k)-ncic(i,k))/deltat
+ end if
+
+ ! make sure number activated > 0
+ npccn(k) = max(0._r8,npccn(k))
+ ncmax = dum2l(i,k)
+ else
+ npccn(k)=0._r8
+ ncmax = 0._r8
+ end if
+
+ !..............................................................................
+ !ice nucleation
+ es(i,k) = svp_water(t(i,k)) ! over water in mixed clouds
+ esi(i,k) = svp_ice(t(i,k)) ! over ice
+ qs(i,k) = 0.622_r8*es(i,k)/(ph(i,k) - (1.0_r8-0.622_r8)*es(i,k))
+ qs(i,k) = min(1.0_r8,qs(i,k))
+ if (qs(i,k) < 0.0_r8) qs(i,k) = 1.0_r8
+
+ relhum(i,k)= 1.0_r8
+
+ if (t(i,k).lt.tmelt ) then
+
+ ! compute aerosol number for so4, soot, and dust with units #/cm^3
+ so4_num = 0._r8
+ soot_num = 0._r8
+ dst1_num = 0._r8
+ dst2_num = 0._r8
+ dst3_num = 0._r8
+ dst4_num = 0._r8
+
+ if (aero%scheme == 'modal') then
+
+ !For modal aerosols, assume for the upper troposphere:
+ ! soot = accumulation mode
+ ! sulfate = aiken mode
+ ! dust = coarse mode
+ ! since modal has internal mixtures.
+ soot_num = 0.5_r8*(aero%numg_a(i,k-1,aero%mode_accum_idx) &
+ +aero%numg_a(i,k,aero%mode_accum_idx))*rho(i,k)*1.0e-6_r8
+ dmc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_dust_idx,aero%mode_coarse_idx) &
+ +aero%mmrg_a(i,k,aero%coarse_dust_idx,aero%mode_coarse_idx))
+ ssmc = 0.5_r8*(aero%mmrg_a(i,k-1,aero%coarse_nacl_idx,aero%mode_coarse_idx) &
+ +aero%mmrg_a(i,k,aero%coarse_nacl_idx,aero%mode_coarse_idx))
+ if (dmc > 0._r8) then
+ dst_num = dmc/(ssmc + dmc) *(aero%numg_a(i,k-1,aero%mode_coarse_idx) &
+ + aero%numg_a(i,k,aero%mode_coarse_idx))*0.5_r8*rho(i,k)*1.0e-6_r8
+ else
+ dst_num = 0.0_r8
+ end if
+ dgnum_aitken = 0.5_r8*(aero%dgnumg(i,k,aero%mode_aitken_idx)+ &
+ aero%dgnumg(i,k-1,aero%mode_aitken_idx))
+ if (dgnum_aitken > 0._r8) then
+ ! only allow so4 with D>0.1 um in ice nucleation
+ so4_num = 0.5_r8*(aero%numg_a(i,k-1,aero%mode_aitken_idx)+ &
+ aero%numg_a(i,k,aero%mode_aitken_idx))*rho(i,k)*1.0e-6_r8 &
+ * (0.5_r8 - 0.5_r8*erf(log(0.1e-6_r8/dgnum_aitken)/ &
+ (2._r8**0.5_r8*log(aero%sigmag_aitken))))
+ else
+ so4_num = 0.0_r8
+ end if
+ so4_num = max(0.0_r8, so4_num)
+
+ else if (aero%scheme == 'bulk') then
+
+ if (aero%idxsul > 0) then
+ so4_num = naer2h(i,k,aero%idxsul)/25._r8 *1.0e-6_r8
+ end if
+ if (aero%idxbcphi > 0) then
+ soot_num = naer2h(i,k,aero%idxbcphi)/25._r8 *1.0e-6_r8
+ end if
+ if (aero%idxdst1 > 0) then
+ dst1_num = naer2h(i,k,aero%idxdst1)/25._r8 *1.0e-6_r8
+ end if
+ if (aero%idxdst2 > 0) then
+ dst2_num = naer2h(i,k,aero%idxdst2)/25._r8 *1.0e-6_r8
+ end if
+ if (aero%idxdst3 > 0) then
+ dst3_num = naer2h(i,k,aero%idxdst3)/25._r8 *1.0e-6_r8
+ end if
+ if (aero%idxdst4 > 0) then
+ dst4_num = naer2h(i,k,aero%idxdst4)/25._r8 *1.0e-6_r8
+ end if
+ dst_num = dst1_num + dst2_num + dst3_num + dst4_num
+
+ end if
+
+ ! *** Turn off soot nucleation ***
+ soot_num = 0.0_r8
+
+ ! Liu et al.,J. climate, 2007
+ if ( wu(i,k) .lt. 4.0_r8) then
+ call nucleati( &
+ wu(i,k), t(i,k), ph(i,k), relhum(i,k), 1.0_r8, qcic(i,k), &
+ 1.0e-20_r8, 0.0_r8, rho(i,k), so4_num, dst_num, soot_num, 1.0_r8, &
+ dum2i(i,k), nihf(i,k), niimm(i,k), nidep(i,k), nimey(i,k), &
+ wpice, weff, fhom, temp1, temp2, temp3, temp4, .true. )
+ end if
+ nihf(i,k)=nihf(i,k)*rho(i,k) ! convert from #/kg -> #/m3)
+ niimm(i,k)=niimm(i,k)*rho(i,k)
+ nidep(i,k)=nidep(i,k)*rho(i,k)
+ nimey(i,k)=nimey(i,k)*rho(i,k)
+
+ if (.false.) then
+ ! cooper curve (factor of 1000 is to convert from L-1 to m-3)
+ !dum2i(i,k)=0.005_r8*exp(0.304_r8*(273.15_r8-t(i,k)))*1000._r8
+
+ ! put limit on number of nucleated crystals, set to number at T=-30 C
+ ! cooper (limit to value at -35 C)
+ !dum2i(i,k)=min(dum2i(i,k),208.9e3_r8)/rho(i,k) ! convert from m-3 to kg-1
+ end if
+
+ else
+ dum2i(i,k)=0._r8
+ end if
+
+ ! ice nucleation if activated nuclei exist at t<0C
+
+ if (dum2i(i,k).gt.0._r8.and.t(i,k).lt.tmelt.and. &
+ relhum(i,k)*es(i,k)/esi(i,k).gt. 1.05_r8 .and. k.gt.jt(i)+1) then
+
+ if (k.eq.kqi(i)) then
+ nnuccd(k)=dum2i(i,k)/deltat
+ else
+ nnuccd(k)=(dum2i(i,k)-niic(i,k))/deltat
+ end if
+ nnuccd(k)=max(nnuccd(k),0._r8)
+
+ !Calc mass of new particles using new crystal mass...
+ !also this will be multiplied by mtime as nnuccd is...
+
+ mnuccd(k) = nnuccd(k) * mi0
+ else
+ nnuccd(k)=0._r8
+ mnuccd(k) = 0._r8
+ end if
+
+ !................................................................................
+ ! Bergeron process
+ ! If 0C< T <-40C and both ice and liquid exist
+
+ if (t(i,k).le.273.15_r8 .and. t(i,k).gt.233.15_r8 .and. &
+ qiic(i,k).gt.0.5e-6_r8 .and. qcic(i,k).gt. qsmall) then
+ plevap = qcic(i,k)/bergtsf
+ prb(k) = max(0._r8,plevap)
+ nprb(k) = prb(k)/(qcic(i,k)/ncic(i,k))
+ else
+ prb(k)=0._r8
+ nprb(k)=0._r8
+ end if
+
+ !................................................................................
+ ! heterogeneous freezing of cloud water (-5C < T < -35C)
+
+ if (qcic(i,k).ge.qsmall .and.ncic(i,k).gt.0._r8 .and. ntaerh(i,k).gt.0._r8 .and. &
+ t(i,k).le.268.15_r8 .and. t(i,k).gt.238.15_r8 ) then
+
+ if (aero%scheme == 'bulk') then
+ ! immersion freezing (Diehl and Wurzler, 2004)
+ ttend(k) = -grav*wu(i,k)/cp/(1.0_r8+gamhat(i,k))
+
+ nai_bcphi = 0.0_r8
+ nai_dst1 = 0.0_r8
+ nai_dst2 = 0.0_r8
+ nai_dst3 = 0.0_r8
+ nai_dst4 = 0.0_r8
+
+ if (aero%idxbcphi > 0) nai_bcphi = naer2h(i,k,aero%idxbcphi)
+ if (aero%idxdst1 > 0) nai_dst1 = naer2h(i,k,aero%idxdst1)
+ if (aero%idxdst2 > 0) nai_dst2 = naer2h(i,k,aero%idxdst2)
+ if (aero%idxdst3 > 0) nai_dst3 = naer2h(i,k,aero%idxdst3)
+ if (aero%idxdst4 > 0) nai_dst4 = naer2h(i,k,aero%idxdst4)
+
+ naimm = (0.00291_r8*nai_bcphi + 32.3_r8*(nai_dst1 + nai_dst2 + &
+ nai_dst3 + nai_dst4))/ntaerh(i,k) !m-3
+ if (ttend(k) .lt. 0._r8) then
+ nnuccc(k) = -naimm*exp(273.15_r8-t(i,k))*ttend(k)*qcic(i,k)/rhow ! kg-1s-1
+ mnuccc(k) = nnuccc(k)*qcic(i,k)/ncic(i,k)
+ end if
+ else
+ if (.false.) then
+ ! immersion freezing (Diehl and Wurzler, 2004)
+ ttend(k) = -grav*wu(i,k)/cp/(1.0_r8+gamhat(i,k))
+ naimm = (0.00291_r8*soot_num + 32.3_r8*dst_num )*1.0e6_r8/ntaerh(i,k) !m-3
+ if (ttend(k) .lt. 0._r8) then
+ nnuccc(k) = -naimm*exp(273.15_r8-t(i,k))*ttend(k)*qcic(i,k)/rhow ! kg-1s-1
+ mnuccc(k) = nnuccc(k)*qcic(i,k)/ncic(i,k)
+ end if
+ else
+ ! immersion freezing (Bigg, 1953)
+ mnuccc(k) = pi*pi/36._r8*rhow* &
+ cdist1(k)*gamma(7._r8+pgam(i,k))* &
+ bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/ &
+ lamc(i,k)**3/lamc(i,k)**3
+
+ nnuccc(k) = pi/6._r8*cdist1(k)*gamma(pgam(i,k)+4._r8) &
+ *bimm*(exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamc(i,k)**3
+ end if
+ end if
+
+ ! contact freezing (Young, 1974) with hooks into simulated dust
+
+ tcnt=(270.16_r8-t(i,k))**1.3_r8
+ viscosity=1.8e-5_r8*(t(i,k)/298.0_r8)**0.85_r8 ! Viscosity (kg/m/s)
+ mfp=2.0_r8*viscosity/(ph(i,k) & ! Mean free path (m)
+ *sqrt(8.0_r8*28.96e-3_r8/(pi*8.314409_r8*t(i,k))))
+
+ slip1=1.0_r8+(mfp/rn_dst1)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst1/mfp))))! Slip correction factor
+ slip2=1.0_r8+(mfp/rn_dst2)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst2/mfp))))
+ slip3=1.0_r8+(mfp/rn_dst3)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst3/mfp))))
+ slip4=1.0_r8+(mfp/rn_dst4)*(1.257_r8+(0.4_r8*Exp(-(1.1_r8*rn_dst4/mfp))))
+
+ dfaer1=1.381e-23_r8*t(i,k)*slip1/(6._r8*pi*viscosity*rn_dst1) ! aerosol diffusivity (m2/s)
+ dfaer2=1.381e-23_r8*t(i,k)*slip2/(6._r8*pi*viscosity*rn_dst2)
+ dfaer3=1.381e-23_r8*t(i,k)*slip3/(6._r8*pi*viscosity*rn_dst3)
+ dfaer4=1.381e-23_r8*t(i,k)*slip4/(6._r8*pi*viscosity*rn_dst4)
+
+ nacon1=0.0_r8
+ nacon2=0.0_r8
+ nacon3=0.0_r8
+ nacon4=0.0_r8
+
+ if (aero%scheme == 'modal') then
+
+ ! For modal aerosols:
+ ! use size '3' for dust coarse mode...
+ ! scale by dust fraction in coarse mode
+
+ dmc = 0.5_r8*(aero%mmrg_a(i,k,aero%coarse_dust_idx,aero%mode_coarse_idx) &
+ +aero%mmrg_a(i,k-1,aero%coarse_dust_idx,aero%mode_coarse_idx))
+ ssmc = 0.5_r8*(aero%mmrg_a(i,k,aero%coarse_nacl_idx,aero%mode_coarse_idx) &
+ +aero%mmrg_a(i,k-1,aero%coarse_nacl_idx,aero%mode_coarse_idx))
+ if (dmc > 0.0_r8) then
+ nacon3 = dmc/(ssmc + dmc) * (aero%numg_a(i,k,aero%mode_coarse_idx) &
+ + aero%numg_a(i,k-1,aero%mode_coarse_idx))*0.5_r8*rho(i,k)
+ end if
+
+ else if (aero%scheme == 'bulk') then
+
+ if (aero%idxdst1.gt.0) then
+ nacon1=naer2h(i,k,aero%idxdst1)*tcnt *0.0_r8
+ endif
+ if (aero%idxdst2.gt.0) then
+ nacon2=naer2h(i,k,aero%idxdst2)*tcnt ! 1/m3
+ endif
+ if (aero%idxdst3.gt.0) then
+ nacon3=naer2h(i,k,aero%idxdst3)*tcnt
+ endif
+ if (aero%idxdst4.gt.0) then
+ nacon4=naer2h(i,k,aero%idxdst4)*tcnt
+ endif
+ end if
+
+ mnucct(k) = (dfaer1*nacon1+dfaer2*nacon2+dfaer3*nacon3+dfaer4*nacon4)*pi*pi/3._r8*rhow* &
+ cdist1(k)*gamma(pgam(i,k)+5._r8)/lamc(i,k)**4
+
+ nnucct(k) = (dfaer1*nacon1+dfaer2*nacon2+dfaer3*nacon3+dfaer4*nacon4)*2._r8*pi* &
+ cdist1(k)*gamma(pgam(i,k)+2._r8)/lamc(i,k)
+
+ ! if (nnuccc(k).gt.nnuccd(k)) then
+ ! dum=nnuccd(k)/nnuccc(k)
+ ! scale mixing ratio of droplet freezing with limit
+ ! mnuccc(k)=mnuccc(k)*dum
+ ! nnuccc(k)=nnuccd(k)
+ ! end if
+
+ else
+ mnuccc(k) = 0._r8
+ nnuccc(k) = 0._r8
+ mnucct(k) = 0._r8
+ nnucct(k) = 0._r8
+ end if
+
+ ! freeze cloud liquid water homogeneously at -40 C
+ if (t(i,k) < 233.15_r8 .and. qc(i,k) > 0._r8) then
+
+ ! make sure freezing rain doesn't increase temperature above
+ ! threshold
+ dum = xlf/cp*qc(i,k)
+ if (t(i,k)+dum.gt.233.15_r8) then
+ dum = -(t(i,k)-233.15_r8)*cp/xlf
+ dum = dum/qc(i,k)
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+ fholm(i,k) = mu(i,k)*dum*qc(i,k)
+ fholn(i,k) = mu(i,k)*dum*nc(i,k)
+ end if
+
+
+ !****************************************************************************************
+ ! conservation to ensure no negative values of cloud water/precipitation
+ ! in case microphysical process rates are large
+ ! note: for check on conservation, processes are multiplied by omsm
+ ! to prevent problems due to round off error
+
+ ! since activation/nucleation processes are fast, need to take into account
+ ! factor mtime = mixing timescale in cloud / model time step
+ ! for now mixing timescale is assumed to be 15 min
+ !*****************************************************************************************
+
+ mtime=deltat/900._r8
+ mtimec=deltat/900._r8
+
+ ! conservation of qc
+ ! ice mass production from ice nucleation(deposition/cond.-freezing), mnuccd,
+ ! is considered as a part of cmei.
+
+ qce = mu(i,k)*qc(i,k)-fholm(i,k) +dz(i,k)*cmel(i,k-1)
+ dum = arcf(i,k)*(pra(k)+prc(k)+prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)+ &
+ psacws(k))*dz(i,k)
+ if( qce.lt.0._r8) then
+ qcimp(k) = .true.
+ prc(k) = 0._r8
+ pra(k) = 0._r8
+ prb(k) = 0._r8
+ mnuccc(k) = 0._r8
+ mnucct(k) = 0._r8
+ msacwi(k) = 0._r8
+ psacws(k) = 0._r8
+ else if (dum.gt.qce) then
+ ratio = qce/dum*omsm
+ prc(k) = prc(k)*ratio
+ pra(k) = pra(k)*ratio
+ prb(k) = prb(k)*ratio
+ mnuccc(k) = mnuccc(k)*ratio
+ mnucct(k) = mnucct(k)*ratio
+ msacwi(k) = msacwi(k)*ratio
+ psacws(k) = psacws(k)*ratio
+ end if
+
+ ! conservation of nc
+ nce = mu(i,k)*nc(i,k)-fholn(i,k) + (arcf(i,k)*npccn(k)*mtimec)*dz(i,k)
+ dum = arcf(i,k)*dz(i,k)*(nprc1(k)+npra(k)+nnuccc(k)+nnucct(k)+ &
+ npsacws(k)+ nprb(k) )
+ if (nce.lt.0._r8) then
+ ncimp(k) = .true.
+ nprc1(k) = 0._r8
+ npra(k) = 0._r8
+ nnuccc(k) = 0._r8
+ nnucct(k) = 0._r8
+ npsacws(k) = 0._r8
+ nprb(k) = 0._r8
+ else if (dum.gt.nce) then
+ ratio = nce/dum*omsm
+ nprc1(k) = nprc1(k)*ratio
+ npra(k) = npra(k)*ratio
+ nnuccc(k) = nnuccc(k)*ratio
+ nnucct(k) = nnucct(k)*ratio
+ npsacws(k) = npsacws(k)*ratio
+ nprb(k) = nprb(k)*ratio
+ end if
+
+ ! conservation of qi
+ qie = mu(i,k)*qi(i,k)+fholm(i,k) +dz(i,k)*(cmei(i,k-1) + &
+ ( mnuccc(k)+mnucct(k)+msacwi(k)+prb(k))*arcf(i,k) )
+ dum = arcf(i,k)*(prci(k)+ prai(k))*dz(i,k)
+ if (qie.lt.0._r8) then
+ qiimp(k) = .true.
+ prci(k) = 0._r8
+ prai(k) = 0._r8
+ else if (dum.gt.qie) then
+ ratio = qie/dum*omsm
+ prci(k) = prci(k)*ratio
+ prai(k) = prai(k)*ratio
+ end if
+
+ ! conservation of ni
+ nie = mu(i,k)*ni(i,k)+fholn(i,k) +dz(i,k)*(nnuccd(k)*mtime*arcf(i,k) &
+ +(nnuccc(k)+ nnucct(k))*arcf(i,k) )
+ dum = arcf(i,k)*dz(i,k)*(-nsacwi(k)+nprci(k)+ nprai(k))
+ if( nie.lt.0._r8) then
+ niimp(k) = .true.
+ nsacwi(k)= 0._r8
+ nprci(k) = 0._r8
+ nprai(k) = 0._r8
+ else if (dum.gt.nie) then
+ ratio = nie/dum*omsm
+ nsacwi(k)= nsacwi(k)*ratio
+ nprci(k) = nprci(k)*ratio
+ nprai(k) = nprai(k)*ratio
+ end if
+
+ ! conservation of qr
+
+ qre = mu(i,k)*qr(i,k)+dz(i,k)*(pra(k)+prc(k))*arcf(i,k)
+ dum = arcf(i,k)*dz(i,k)*(pracs(k)+ mnuccr(k)-prf(k))
+ if (qre.lt.0._r8) then
+ prf(k) = 0._r8
+ pracs(k) = 0._r8
+ mnuccr(k) = 0._r8
+ else if (dum.gt.qre) then
+ ratio = qre/dum*omsm
+ prf(k) = prf(k)*ratio
+ pracs(k) = pracs(k)*ratio
+ mnuccr(k) = mnuccr(k)*ratio
+ end if
+
+ ! conservation of nr
+ nre = mu(i,k)*nr(i,k) + nprc(k)*arcf(i,k)*dz(i,k)
+ dum = arcf(i,k)*dz(i,k)*(npracs(k)+nnuccr(k) &
+ -nragg(k)-pnrf(k))
+ if(nre.lt.0._r8) then
+ npracs(k)= 0._r8
+ nnuccr(k)= 0._r8
+ nragg(k) = 0._r8
+ pnrf(k) = 0._r8
+ else if (dum.gt.nre) then
+ ratio = nre/dum*omsm
+ npracs(k)= npracs(k)*ratio
+ nnuccr(k)= nnuccr(k)*ratio
+ nragg(k) = nragg(k)*ratio
+ pnrf(k) = pnrf(k)*ratio
+ end if
+
+ ! conservation of qni
+
+ qnie = mu(i,k)*qni(i,k)+dz(i,k)*( (prai(k)+psacws(k)+prci(k)+ &
+ pracs(k)+mnuccr(k))*arcf(i,k) )
+ dum = arcf(i,k)*dz(i,k)*(-psf(k))
+
+ if(qnie.lt.0._r8) then
+ psf(k) = 0._r8
+ else if (dum.gt.qnie) then
+ ratio = qnie/dum*omsm
+ psf(k) = psf(k)*ratio
+ end if
+
+ ! conservation of ns
+ nse = mu(i,k)*ns(i,k)+dz(i,k)*(nprci(k)+nnuccr(k))*arcf(i,k)
+ dum = arcf(i,k)*dz(i,k)*(-nsagg(k)-pnsf(k))
+ if (nse.lt.0._r8) then
+ nsagg(k) = 0._r8
+ pnsf(k) = 0._r8
+ else if (dum.gt.nse) then
+ ratio = nse/dum*omsm
+ nsagg(k) = nsagg(k)*ratio
+ pnsf(k) = pnsf(k)*ratio
+ end if
+
+ !*****************************************************************************
+ ! get tendencies due to microphysical conversion processes
+ !*****************************************************************************
+
+ if (k.le.kqc(i)) then
+ qctend(i,k) = (-pra(k)-prc(k)-prb(k)-mnuccc(k)-mnucct(k)-msacwi(k)- &
+ psacws(k))
+
+ qitend(i,k) = (prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)-prci(k)- prai(k))
+
+ qrtend(i,k) = (pra(k)+prc(k))+(-pracs(k)- mnuccr(k))
+
+ qnitend(i,k) = (prai(k)+psacws(k)+prci(k))+(pracs(k)+mnuccr(k))
+
+ ! multiply activation/nucleation by mtime to account for fast timescale
+
+ nctend(i,k) = npccn(k)*mtimec+(-nnuccc(k)-nnucct(k)-npsacws(k) &
+ -npra(k)-nprc1(k)-nprb(k))
+
+ nitend(i,k) = nnuccd(k)*mtime+(nnuccc(k)+ nnucct(k)+nsacwi(k)-nprci(k)- &
+ nprai(k))
+
+ nstend(i,k) = nsagg(k)+nnuccr(k) + nprci(k)
+
+ nrtend(i,k) = nprc(k)+(-npracs(k)-nnuccr(k) +nragg(k))
+
+ ! for output
+ ! cloud liquid water-------------
+
+ autolm(i,k-1) = -prc(k)*arcf(i,k)
+ accrlm(i,k-1) = -pra(k)*arcf(i,k)
+ bergnm(i,k-1) = -prb(k)*arcf(i,k)
+ fhtimm(i,k-1) = -mnuccc(k)*arcf(i,k)
+ fhtctm(i,k-1) = -mnucct(k)*arcf(i,k)
+ hmpim (i,k-1) = -msacwi(k)*arcf(i,k)
+ accslm(i,k-1) = -psacws(k)*arcf(i,k)
+ fhmlm(i,k-1) = -fholm(i,k)/dz(i,k)
+
+ autoln(i,k-1) = -nprc1(k)*arcf(i,k)
+ accrln(i,k-1) = -npra(k)*arcf(i,k)
+ bergnn(i,k-1) = -nprb(k)*arcf(i,k)
+ fhtimn(i,k-1) = -nnuccc(k)*arcf(i,k)
+ fhtctn(i,k-1) = -nnucct(k)*arcf(i,k)
+ accsln(i,k-1) = -npsacws(k)*arcf(i,k)
+ activn(i,k-1) = npccn(k)*mtimec*arcf(i,k)
+ fhmln(i,k-1) = -fholn(i,k)/dz(i,k)
+
+ !cloud ice------------------------
+
+ autoim(i,k-1) = -prci(k)*arcf(i,k)
+ accsim(i,k-1) = -prai(k)*arcf(i,k)
+
+ nuclin(i,k-1) = nnuccd(k)*mtime*arcf(i,k)
+ autoin(i,k-1) = -nprci(k)*arcf(i,k)
+ accsin(i,k-1) = -nprai(k)*arcf(i,k)
+ hmpin (i,k-1) = nsacwi(k)*arcf(i,k)
+
+ else
+ qctend(i,k) = 0._r8
+ qitend(i,k) = 0._r8
+ qrtend(i,k) = 0._r8
+ qnitend(i,k) = 0._r8
+ nctend(i,k) = 0._r8
+ nitend(i,k) = 0._r8
+ nstend(i,k) = 0._r8
+ nrtend(i,k) = 0._r8
+ end if
+
+ !********************************************************************************
+ ! vertical integration
+ !********************************************************************************
+ ! snow
+ if ( k.le.kqi(i) ) then
+ qni(i,k-1) = 1._r8/mu(i,k-1)* &
+ (mu(i,k)*qni(i,k)+dz(i,k)*(qnitend(i,k)+psf(k))*arcf(i,k) )
+
+ ns(i,k-1) = 1._r8/mu(i,k-1)* &
+ (mu(i,k)*ns(i,k)+dz(i,k)*(nstend(i,k)+pnsf(k))*arcf(i,k) )
+
+ else
+ qni(i,k-1)=0._r8
+ ns(i,k-1)=0._r8
+ end if
+
+ if (qni(i,k-1).le.0._r8) then
+ qni(i,k-1)=0._r8
+ ns(i,k-1)=0._r8
+ end if
+
+ ! rain
+ if (k.le.kqc(i) ) then
+ qr(i,k-1) = 1._r8/mu(i,k-1)* &
+ (mu(i,k)*qr(i,k)+dz(i,k)*(qrtend(i,k)+prf(k))*arcf(i,k) )
+
+ nr(i,k-1) = 1._r8/mu(i,k-1)* &
+ (mu(i,k)*nr(i,k)+dz(i,k)*(nrtend(i,k)+pnrf(k))*arcf(i,k) )
+
+ else
+ qr(i,k-1)=0._r8
+ nr(i,k-1)=0._r8
+ end if
+
+ if( qr(i,k-1) .le. 0._r8) then
+ qr(i,k-1)=0._r8
+ nr(i,k-1)=0._r8
+ end if
+
+ ! freeze rain homogeneously at -40 C
+
+ if (t(i,k-1) < 233.15_r8 .and. qr(i,k-1) > 0._r8) then
+
+ ! make sure freezing rain doesn't increase temperature above threshold
+ dum = xlf/cp*qr(i,k-1)
+ if (t(i,k-1)+dum.gt.233.15_r8) then
+ dum = -(t(i,k-1)-233.15_r8)*cp/xlf
+ dum = dum/qr(i,k-1)
+ dum = max(0._r8,dum)
+ dum = min(1._r8,dum)
+ else
+ dum = 1._r8
+ end if
+ qni(i,k-1)=qni(i,k-1)+dum*qr(i,k-1)
+ ns(i,k-1)=ns(i,k-1)+dum*nr(i,k-1)
+ qr(i,k-1)=(1._r8-dum)*qr(i,k-1)
+ nr(i,k-1)=(1._r8-dum)*nr(i,k-1)
+ fhmrm(i,k-1) = -mu(i,k-1)*dum*qr(i,k-1)/dz(i,k)
+ end if
+
+
+ ! cloud water
+ if ( k.le.kqc(i) ) then
+ qc(i,k-1) = (mu(i,k)*qc(i,k)-fholm(i,k)+dz(i,k)*qctend(i,k)*arcf(i,k) &
+ +dz(i,k)*cmel(i,k-1) )/(mu(i,k-1)+dz(i,k)*du(i,k-1))
+
+ qcde(i,k) = qc(i,k-1)
+
+ nc(i,k-1) = (mu(i,k)*nc(i,k) -fholn(i,k) +dz(i,k)*nctend(i,k)*arcf(i,k) ) &
+ /(mu(i,k-1)+dz(i,k)*du(i,k-1))
+
+ ncde(i,k) = nc(i,k-1)
+ else
+ qc(i,k-1)=0._r8
+ nc(i,k-1)=0._r8
+ end if
+
+ if (qc(i,k-1).lt.0._r8) write(iulog,*) "negative qc(i,k-1)=",qc(i,k-1)
+ dlfm(i,k-1) = -du(i,k-1)*qcde(i,k)
+ dlfn(i,k-1) = -du(i,k-1)*ncde(i,k)
+
+ if (qc(i,k-1).le. 0._r8) then
+ qc(i,k-1)=0._r8
+ nc(i,k-1)=0._r8
+ end if
+
+ if (nc(i,k-1).lt. 0._r8) then
+ write(iulog,*) "nc(i,k-1)=",nc(i,k-1),"k-1=",k-1,"arcf(i,k)=",arcf(i,k)
+ write(iulog,*) "mu(i,k-1)=",mu(i,k-1),"mu(i,k)=",mu(i,k),"nc(i,k)=",ni(i,k)
+ write(iulog,*) "dz(i,k)=",dz(i,k),"du(i,k-1)=",du(i,k-1),"nctend(i,k)=",nctend(i,k)
+ write(iulog,*) "eu(i,k-1)=",eu(i,k-1)
+ end if
+
+ ! cloud ice
+ if( k.le.kqi(i)) then
+ qi(i,k-1) = (mu(i,k)*qi(i,k)+fholm(i,k) +dz(i,k)*qitend(i,k)*arcf(i,k) &
+ +dz(i,k)*cmei(i,k-1) )/(mu(i,k-1)+dz(i,k)*du(i,k-1))
+
+ qide(i,k) = qi(i,k-1)
+
+ ni(i,k-1) = (mu(i,k)*ni(i,k)+fholn(i,k)+dz(i,k)*nitend(i,k)*arcf(i,k) ) &
+ /(mu(i,k-1)+dz(i,k)*du(i,k-1))
+
+ nide(i,k) = ni(i,k-1)
+ else
+ qi(i,k-1)=0._r8
+ ni(i,k-1)=0._r8
+ end if
+
+ if (qi(i,k-1).lt.0._r8) write(iulog,*) "negative qi(i,k-1)=",qi(i,k-1)
+ difm(i,k-1) = -du(i,k-1)*qide(i,k)
+ difn(i,k-1) = -du(i,k-1)*nide(i,k)
+
+ if (qi(i,k-1).le. 0._r8) then
+ qi(i,k-1)=0._r8
+ ni(i,k-1)=0._r8
+ end if
+
+
+ if (ni(i,k-1).lt. 0._r8) then
+ write(iulog,*) "ni(i,k-1)=",ni(i,k-1),"k-1=",k-1,"arcf(i,k)=",arcf(i,k)
+ write(iulog,*) "mu(i,k-1)=",mu(i,k-1),"mu(i,k)=",mu(i,k),"ni(i,k)=",ni(i,k)
+ write(iulog,*) "dz(i,k)=",dz(i,k),"du(i,k-1)=",du(i,k-1),"nitend(i,k)=",nitend(i,k)
+ write(iulog,*) "eu(i,k-1)=",eu(i,k-1)
+ end if
+
+
+ frz(i,k-1) = cmei(i,k-1) + arcf(i,k)*(prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)+ &
+ pracs(k)+mnuccr(k)+psacws(k) )-fhmlm(i,k-1)-fhmrm(i,k-1)
+
+
+ !******************************************************************************
+ ! get size distribution parameters based on in-cloud cloud water/ice
+ ! these calculations also ensure consistency between number and mixing ratio
+
+ ! following equation(2,3,4) of Morrison and Gettelman, 2008, J. Climate.
+ ! Gamma(n)= (n-1)!
+ ! lamc <-> lambda for cloud liquid water
+ ! pgam <-> meu for cloud liquid water
+ ! meu=0 for ice,rain and snow
+ !*******************************************************************************
+
+ ! cloud ice
+ niorg = ni(i,k-1)
+ if (qi(i,k-1).ge.qsmall) then
+
+ ! add upper limit to in-cloud number concentration to prevent numerical error
+ ni(i,k-1)=min(ni(i,k-1),qi(i,k-1)*1.e20_r8)
+ ! ni should be non-negative
+ ! ni(i,k-1) = max(ni(i,k-1), 0._r8)
+ if (ni(i,k-1).lt. 0._r8) write(iulog,*) "ni(i,k-1)=",ni(i,k-1)
+
+ lami(k-1) = (gamma(1._r8+di)*ci* &
+ ni(i,k-1)/qi(i,k-1))**(1._r8/di)
+ n0i(k-1) = ni(i,k-1)*lami(k-1)
+
+ ! check for slope
+ lammax = 1._r8/10.e-6_r8
+ lammin = 1._r8/(2._r8*dcs)
+
+ ! adjust vars
+ if (lami(k-1).lt.lammin) then
+ lami(k-1) = lammin
+ n0i(k-1) = lami(k-1)**(di+1._r8)*qi(i,k-1)/(ci*gamma(1._r8+di))
+ ni(i,k-1) = n0i(k-1)/lami(k-1)
+ else if (lami(k-1).gt.lammax) then
+ lami(k-1) = lammax
+ n0i(k-1) = lami(k-1)**(di+1._r8)*qi(i,k-1)/(ci*gamma(1._r8+di))
+ ni(i,k-1) = n0i(k-1)/lami(k-1)
+ end if
+ else
+ lami(k-1) = 0._r8
+ n0i(k-1) = 0._r8
+ end if
+
+ nide(i,k) = ni(i,k-1)
+ difn(i,k-1) = -du(i,k-1)*nide(i,k)
+
+ niadj(i,k-1)= (ni(i,k-1)- niorg)*mu(i,k-1)/dz(i,k)
+
+ if (niadj(i,k-1) .lt. 0._r8) then
+ total = nuclin(i,k-1)-fhtimn(i,k-1)-fhtctn(i,k-1)-fhmln(i,k-1)+ hmpin (i,k-1)
+ if (total .ne. 0._r8) then
+ nuclin(i,k-1) = nuclin(i,k-1) + nuclin(i,k-1)*niadj(i,k-1)/total
+ fhtimn(i,k-1) = fhtimn(i,k-1) + fhtimn(i,k-1)*niadj(i,k-1)/total
+ fhtctn(i,k-1) = fhtctn(i,k-1) + fhtctn(i,k-1)*niadj(i,k-1)/total
+ fhmln (i,k-1) = fhmln (i,k-1) + fhmln (i,k-1)*niadj(i,k-1)/total
+ hmpin (i,k-1) = hmpin (i,k-1) + hmpin (i,k-1)*niadj(i,k-1)/total
+ else
+ total = 5._r8
+ nuclin(i,k-1) = nuclin(i,k-1) + niadj(i,k-1)/total
+ fhtimn(i,k-1) = fhtimn(i,k-1) + niadj(i,k-1)/total
+ fhtctn(i,k-1) = fhtctn(i,k-1) + niadj(i,k-1)/total
+ fhmln (i,k-1) = fhmln (i,k-1) + niadj(i,k-1)/total
+ hmpin (i,k-1) = hmpin (i,k-1) + niadj(i,k-1)/total
+ end if
+ else if (niadj(i,k-1) .gt. 0._r8) then
+ total = autoin(i,k-1)+accsin(i,k-1)
+ if (total .ne. 0._r8) then
+ autoin(i,k-1) = autoin(i,k-1) + autoin(i,k-1)*niadj(i,k-1)/total
+ accsin(i,k-1) = accsin(i,k-1) + accsin(i,k-1)*niadj(i,k-1)/total
+ else
+ total = 2._r8
+ autoin(i,k-1) = autoin(i,k-1) + niadj(i,k-1)/total
+ accsin(i,k-1) = accsin(i,k-1) + niadj(i,k-1)/total
+ end if
+ end if
+
+ !................................................................................
+ !cloud water
+ ncorg = nc(i,k-1)
+ if (qc(i,k-1).ge.qsmall) then
+
+ ! add upper limit to in-cloud number concentration to prevent numerical error
+ nc(i,k-1)=min(nc(i,k-1),qc(i,k-1)*1.e20_r8)
+ ! and make sure it's non-negative
+ ! nc(i,k-1) = max(nc(i,k-1), 0._r8)
+ if (nc(i,k-1).lt. 0._r8) write(iulog,*) "nc(i,k-1)=",nc(i,k-1)
+
+ ! get pgam from fit to observations of martin et al. 1994
+
+ pgam(i,k-1)=0.0005714_r8*(nc(i,k-1)/1.e6_r8/rho(i,k-1))+0.2714_r8
+ pgam(i,k-1)=1._r8/(pgam(i,k-1)**2)-1._r8
+ pgam(i,k-1)=max(pgam(i,k-1),2._r8)
+ pgam(i,k-1)=min(pgam(i,k-1),15._r8)
+ ! calculate lamc
+
+ lamc(i,k-1) = (pi/6._r8*rhow*nc(i,k-1)*gamma(pgam(i,k-1)+4._r8)/ &
+ (qc(i,k-1)*gamma(pgam(i,k-1)+1._r8)))**(1._r8/3._r8)
+
+ ! lammin, 50 micron diameter max mean size
+ lammin = (pgam(i,k-1)+1._r8)/40.e-6_r8
+ lammax = (pgam(i,k-1)+1._r8)/1.e-6_r8
+
+ if (lamc(i,k-1).lt.lammin) then
+ lamc(i,k-1) = lammin
+ nc(i,k-1) = 6._r8*lamc(i,k-1)**3*qc(i,k-1)* &
+ gamma(pgam(i,k-1)+1._r8)/ &
+ (pi*rhow*gamma(pgam(i,k-1)+4._r8))
+ else if (lamc(i,k-1).gt.lammax) then
+ lamc(i,k-1) = lammax
+ nc(i,k-1) = 6._r8*lamc(i,k-1)**3*qc(i,k-1)* &
+ gamma(pgam(i,k-1)+1._r8)/ &
+ (pi*rhow*gamma(pgam(i,k-1)+4._r8))
+ end if
+
+ ! parameter to calculate droplet freezing
+
+ cdist1(k-1) = nc(i,k-1)/gamma(pgam(i,k-1)+1._r8)
+ else
+ lamc(i,k-1) = 0._r8
+ cdist1(k-1) = 0._r8
+ end if
+
+ ncde(i,k) = nc(i,k-1)
+ dlfn(i,k-1) = -du(i,k-1)*ncde(i,k)
+
+ ncadj(i,k-1) = (nc(i,k-1)- ncorg)*mu(i,k-1)/dz(i,k)
+ if (ncadj(i,k-1) .lt. 0._r8) then
+ activn(i,k-1) = activn(i,k-1) + ncadj(i,k-1)
+ else if (ncadj(i,k-1) .gt. 0._r8) then
+ total = autoln(i,k-1)+accrln(i,k-1)+bergnn(i,k-1)+accsln(i,k-1)
+ if (total .ne. 0._r8) then
+ autoln(i,k-1) = autoln(i,k-1) + autoln(i,k-1)*ncadj(i,k-1)/total
+ accrln(i,k-1) = accrln(i,k-1) + accrln(i,k-1)*ncadj(i,k-1)/total
+ bergnn(i,k-1) = bergnn(i,k-1) + bergnn(i,k-1)*ncadj(i,k-1)/total
+ accsln(i,k-1) = accsln(i,k-1) + accsln(i,k-1)*ncadj(i,k-1)/total
+ else
+ total = 4._r8
+ autoln(i,k-1) = autoln(i,k-1) + ncadj(i,k-1)/total
+ accrln(i,k-1) = accrln(i,k-1) + ncadj(i,k-1)/total
+ bergnn(i,k-1) = bergnn(i,k-1) + ncadj(i,k-1)/total
+ accsln(i,k-1) = accsln(i,k-1) + ncadj(i,k-1)/total
+ end if
+ end if
+
+ trspcm(i,k-1) = (mu(i,k)*qc(i,k) - mu(i,k-1)*qc(i,k-1))/dz(i,k)
+ trspcn(i,k-1) = (mu(i,k)*nc(i,k) - mu(i,k-1)*nc(i,k-1))/dz(i,k)
+ trspim(i,k-1) = (mu(i,k)*qi(i,k) - mu(i,k-1)*qi(i,k-1))/dz(i,k)
+ trspin(i,k-1) = (mu(i,k)*ni(i,k) - mu(i,k-1)*ni(i,k-1))/dz(i,k)
+
+ if (k-1 .eq. jt(i)+1) then
+ trspcm(i,k-2) = mu(i,k-1)*qc(i,k-1)/dz(i,k-1)
+ trspcn(i,k-2) = mu(i,k-1)*nc(i,k-1)/dz(i,k-1)
+ trspim(i,k-2) = mu(i,k-1)*qi(i,k-1)/dz(i,k-1)
+ trspin(i,k-2) = mu(i,k-1)*ni(i,k-1)/dz(i,k-1)
+ qcde(i,k-1) = qc(i,k-1)
+ ncde(i,k-1) = nc(i,k-1)
+ qide(i,k-1) = qi(i,k-1)
+ nide(i,k-1) = ni(i,k-1)
+ dlfm (i,k-2) = -du(i,k-2)*qcde(i,k-1)
+ dlfn (i,k-2) = -du(i,k-2)*ncde(i,k-1)
+ difm (i,k-2) = -du(i,k-2)*qide(i,k-1)
+ difn (i,k-2) = -du(i,k-2)*nide(i,k-1)
+ end if
+
+
+ !.......................................................................
+ ! get size distribution parameters for precip
+ !......................................................................
+ ! rain
+ if (qr(i,k-1).ge.qsmall) then
+
+ lamr(k-1) = (pi*rhow*nr(i,k-1)/qr(i,k-1))**(1._r8/3._r8)
+ n0r(k-1) = nr(i,k-1)*lamr(k-1)
+
+ ! check for slope
+ lammax = 1._r8/150.e-6_r8
+ lammin = 1._r8/3000.e-6_r8
+ ! adjust vars
+ if (lamr(k-1).lt.lammin) then
+ lamr(k-1) = lammin
+ n0r(k-1) = lamr(k-1)**4*qr(i,k-1)/(pi*rhow)
+ nr(i,k-1) = n0r(k-1)/lamr(k-1)
+ else if (lamr(k-1).gt.lammax) then
+ lamr(k-1) = lammax
+ n0r(k-1) = lamr(k-1)**4*qr(i,k-1)/(pi*rhow)
+ nr(i,k-1) = n0r(k-1)/lamr(k-1)
+ end if
+
+ unr(k-1) = min(arn(i,k-1)*gamma(1._r8+br)/lamr(k-1)**br,10._r8)
+ umr(k-1) = min(arn(i,k-1)*gamma(4._r8+br)/(6._r8*lamr(k-1)**br),10._r8)
+ else
+ lamr(k-1) = 0._r8
+ n0r(k-1) = 0._r8
+ umr(k-1) = 0._r8
+ unr(k-1) = 0._r8
+ end if
+
+ !......................................................................
+ ! snow
+ if (qni(i,k-1).ge.qsmall) then
+ lams(k-1) = (gamma(1._r8+ds)*cs*ns(i,k-1)/ &
+ qni(i,k-1))**(1._r8/ds)
+ n0s(k-1) = ns(i,k-1)*lams(k-1)
+
+ ! check for slope
+ lammax = 1._r8/10.e-6_r8
+ lammin = 1._r8/2000.e-6_r8
+
+ ! adjust vars
+ if (lams(k-1).lt.lammin) then
+ lams(k-1) = lammin
+ n0s(k-1) = lams(k-1)**(ds+1._r8)*qni(i,k-1)/(cs*gamma(1._r8+ds))
+ ns(i,k-1) = n0s(k-1)/lams(k-1)
+ else if (lams(k-1).gt.lammax) then
+ lams(k-1) = lammax
+ n0s(k-1) = lams(k-1)**(ds+1._r8)*qni(i,k-1)/(cs*gamma(1._r8+ds))
+ ns(i,k-1) = n0s(k-1)/lams(k-1)
+ end if
+ ums(k-1) = min(asn(i,k-1)*gamma(4._r8+bs)/(6._r8*lams(k-1)**bs),3.6_r8)
+ uns(k-1) = min(asn(i,k-1)*gamma(1._r8+bs)/lams(k-1)**bs,3.6_r8)
+ else
+ lams(k-1) = 0._r8
+ n0s(k-1) = 0._r8
+ ums(k-1) = 0._r8
+ uns(k-1) = 0._r8
+ end if
+
+ rprd(i,k-1)= (qnitend(i,k) + qrtend(i,k))*arcf(i,k)
+ sprd(i,k-1)= qnitend(i,k) *arcf(i,k) -fhmrm(i,k-1)
+
+ end if ! k (No products) rate = ** User defined ** ( 1)
+
+ Reactions
+ usr_HO2_HO2 ( 1) HO2 + HO2 -> H2O2 rate = ** User defined ** ( 2)
+ ( 2) H2O2 + OH -> H2O + HO2 rate = 2.90E-12*exp( -160./t) ( 3)
+ ( 3) DMS + OH -> SO2 rate = 9.60E-12*exp( -234./t) ( 4)
+ ( 4) DMS + NO3 -> SO2 + {HNO3} rate = 1.90E-13*exp( 520./t) ( 5)
+ ( 5) SO2 + OH + M -> H2SO4 + M troe : ko=3.00E-31*(300/t)**3.30 ( 6)
+ ki=1.50E-12
+ f=0.60
+ usr_DMS_OH ( 6) DMS + OH -> .75*SO2 + .5*HO2 + 0.029*SOA_LV + 0.114*SOA_SV rate = ** User defined ** ( 7)
+ ( 7) monoterp + O3 -> .15*SOA_LV rate = 8.05E-16*exp( -640./t) ( 8)
+ ( 8) monoterp + OH -> .15*SOA_SV rate = 1.20E-11*exp( 440./t) ( 9)
+ ( 9) monoterp + NO3 -> .15*SOA_SV rate = 1.20E-12*exp( 490./t) ( 10)
+ ( 10) isoprene + O3 -> .05*SOA_SV rate = 1.03E-14*exp( -1995./t) ( 11)
+ ( 11) isoprene + OH -> .05*SOA_SV rate = 2.70E-11*exp( 390./t) ( 12)
+ ( 12) isoprene + NO3 -> .05*SOA_SV rate = 3.15E-12*exp( -450./t) ( 13)
+
+Heterogeneous loss species
+
+Extraneous prod/loss species
+ ( 1) SO2 (dataset)
+ ( 2) BC_NI (dataset)
+ ( 3) BC_AX (dataset)
+ ( 4) BC_N (dataset)
+ ( 5) OM_NI (dataset)
+ ( 6) SO4_PR (dataset)
+ ( 7) H2O (dataset)
+
+
+ Equation Report
+
+ d(SO2)/dt = r3*OH*DMS + r4*NO3*DMS + .75*r6*OH*DMS
+ - r5*OH*M*SO2
+ d(H2SO4)/dt = r5*OH*M*SO2
+ d(DMS)/dt = - r3*OH*DMS - r4*NO3*DMS - r6*OH*DMS
+ d(H2O2)/dt = r1
+ - j1*H2O2 - r2*OH*H2O2
+ d(SO4_NA)/dt = 0
+ d(SO4_A1)/dt = 0
+ d(SO4_A2)/dt = 0
+ d(SO4_AC)/dt = 0
+ d(SO4_PR)/dt = 0
+ d(BC_N)/dt = 0
+ d(BC_AX)/dt = 0
+ d(BC_NI)/dt = 0
+ d(BC_A)/dt = 0
+ d(BC_AI)/dt = 0
+ d(BC_AC)/dt = 0
+ d(OM_NI)/dt = 0
+ d(OM_AI)/dt = 0
+ d(OM_AC)/dt = 0
+ d(DST_A2)/dt = 0
+ d(DST_A3)/dt = 0
+ d(SS_A1)/dt = 0
+ d(SS_A2)/dt = 0
+ d(SS_A3)/dt = 0
+ d(SOA_NA)/dt = 0
+ d(SOA_A1)/dt = 0
+ d(SOA_LV)/dt = .029*r6*OH*DMS + .15*r7*O3*monoterp
+ d(SOA_SV)/dt = .114*r6*OH*DMS + .15*r8*OH*monoterp + .15*r9*NO3*monoterp + .05*r10*O3*isoprene
+ + .05*r11*OH*isoprene + .05*r12*NO3*isoprene
+ d(monoterp)/dt = - r7*O3*monoterp - r8*OH*monoterp - r9*NO3*monoterp
+ d(isoprene)/dt = - r10*O3*isoprene - r11*OH*isoprene - r12*NO3*isoprene
+ d(H2O)/dt = r2*OH*H2O2
diff --git a/src/chemistry/pp_trop_mam_oslo/chem_mech.in b/src/chemistry/pp_trop_mam_oslo/chem_mech.in
new file mode 100644
index 0000000000..5897d33683
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/chem_mech.in
@@ -0,0 +1,109 @@
+BEGSIM
+ SPECIES
+
+ Solution
+ SO2, H2SO4
+ DMS -> CH3SCH3, H2O2
+ SO4_NA->H2SO4, SO4_A1->H2SO4, SO4_A2->NH4HSO4
+ SO4_AC->H2SO4, SO4_PR->H2SO4, BC_N->C
+ BC_AX->C, BC_NI->C, BC_A->C, BC_AI->C
+ BC_AC->C, OM_NI->C, OM_AI->C, OM_AC->C
+ DST_A2->AlSiO5, DST_A3->AlSiO5
+ SS_A1->NaCl, SS_A2->NaCl, SS_A3->NaCl
+* Approximate soa species with those of monoterpene oxidation products
+* based on Paasonen et al. (2010); Taipale et al. (2008).
+ SOA_NA->C10H16O2, SOA_A1->C10H16O2
+ SOA_LV ->C10H16O2, SOA_SV->C10H16O2
+ monoterp -> C10H16, isoprene -> C5H8
+ H2O
+ End Solution
+
+ Fixed
+ M, N2, O2, O3, OH, NO3, HO2
+ End Fixed
+
+ Col-int
+ O3 = 0.
+ O2 = 0.
+ End Col-int
+
+ End SPECIES
+
+ Solution Classes
+ Explicit
+ End Explicit
+ Implicit
+ DMS, SO2, H2O2
+ SO4_NA, SO4_A1, SO4_A2
+ SO4_AC, SO4_PR, BC_N
+ BC_AX, BC_NI, BC_A, BC_AI
+ BC_AC, OM_NI, OM_AI, OM_AC
+ DST_A2, DST_A3
+ SS_A1, SS_A2, SS_A3 , H2SO4
+ SOA_NA, SOA_A1
+ SOA_LV,SOA_SV, monoterp, isoprene
+ H2O
+ End Implicit
+ End Solution Classes
+
+ CHEMISTRY
+ Photolysis
+ [jh2o2] H2O2 + hv ->
+ End Photolysis
+
+ Reactions
+ [usr_HO2_HO2] HO2 + HO2 -> H2O2
+ H2O2 + OH -> H2O + HO2 ; 2.9e-12, -160
+ DMS + OH -> SO2 ; 9.6e-12, -234.
+ DMS + NO3 -> SO2 + HNO3 ; 1.9e-13, 520.
+ SO2 + OH + M -> H2SO4 + M ; 3.0e-31, 3.3, 1.5e-12, 0.0, 0.6
+* SOA has MW=168, and MSA=96, so to get correct MSA mass ==> factor of 96/168 = 0.57
+* Then account for 0.25 which is 0.25 MSA molec per DMS molec (the other 0.75 goes to SO2)
+* Then 0.2 assumed yield for SOA_LV and 0.8 assumed yield for SOA_SV gives the coefficients below
+* reaction rate from Chin et al 1996, JGR, vol 101, no D13
+*
+ [usr_DMS_OH] DMS + OH -> .75 * SO2 + .5 * HO2 + 0.029*SOA_LV + 0.114*SOA_SV
+*
+*cka: added organic vapor oxidation with constants from IUPAC below
+* Assume a yield of 15% for SOA LV production from these reactions
+* Assume a yield of 15 % for monoterpene and 5% for isoprene SOA SV production reactions
+* SOA_LV: very low volatility, can nucleate or grow small particles (oxidation products from O3+monoterp)
+* SOA_SV: rest of SOA formed
+ monoterp + O3 -> .15*SOA_LV ; 8.05e-16, -640.
+ monoterp + OH -> .15*SOA_SV ; 1.2e-11, 440.
+ monoterp + NO3 -> .15*SOA_SV ; 1.2e-12, 490.
+ isoprene + O3 -> .05*SOA_SV ; 1.03e-14, -1995.
+ isoprene + OH -> .05*SOA_SV ; 2.7e-11, 390.
+ isoprene + NO3 -> .05*SOA_SV ; 3.15e-12, -450.
+ End Reactions
+
+ Heterogeneous
+ H2O2, SO2
+ End Heterogeneous
+
+ Ext Forcing
+ SO2 <- dataset
+ BC_NI <-dataset
+ BC_AX <-dataset
+ BC_N <-dataset
+ OM_NI <-dataset
+ SO4_PR <-dataset
+ H2O <- dataset
+ End Ext Forcing
+
+ END CHEMISTRY
+
+ SIMULATION PARAMETERS
+
+ Version Options
+ model = cam
+ machine = intel
+ architecture = hybrid
+ vec_ftns = on
+ multitask = on
+ namemod = on
+ modules = on
+ End Version Options
+
+ END SIMULATION PARAMETERS
+ENDSIM
diff --git a/src/chemistry/pp_trop_mam_oslo/chem_mods.F90 b/src/chemistry/pp_trop_mam_oslo/chem_mods.F90
new file mode 100644
index 0000000000..bcd985192b
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/chem_mods.F90
@@ -0,0 +1,50 @@
+ module chem_mods
+!--------------------------------------------------------------
+! ... Basic chemistry parameters and arrays
+!--------------------------------------------------------------
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ implicit none
+ save
+ integer, parameter :: phtcnt = 1, & ! number of photolysis reactions
+ rxntot = 13, & ! number of total reactions
+ gascnt = 12, & ! number of gas phase reactions
+ nabscol = 2, & ! number of absorbing column densities
+ gas_pcnst = 30, & ! number of "gas phase" species
+ nfs = 7, & ! number of "fixed" species
+ relcnt = 0, & ! number of relationship species
+ grpcnt = 0, & ! number of group members
+ nzcnt = 38, & ! number of non-zero matrix entries
+ extcnt = 7, & ! number of species with external forcing
+ clscnt1 = 0, & ! number of species in explicit class
+ clscnt2 = 0, & ! number of species in hov class
+ clscnt3 = 0, & ! number of species in ebi class
+ clscnt4 = 30, & ! number of species in implicit class
+ clscnt5 = 0, & ! number of species in rodas class
+ indexm = 1, & ! index of total atm density in invariant array
+ indexh2o = 0, & ! index of water vapor density
+ clsze = 1, & ! loop length for implicit chemistry
+ rxt_tag_cnt = 3, &
+ enthalpy_cnt = 0, &
+ nslvd = 0
+ integer :: clscnt(5) = 0
+ integer :: cls_rxt_cnt(4,5) = 0
+ integer :: clsmap(gas_pcnst,5) = 0
+ integer :: permute(gas_pcnst,5) = 0
+ integer :: diag_map(clscnt4) = 0
+ real(r8) :: adv_mass(gas_pcnst) = 0._r8
+ real(r8) :: crb_mass(gas_pcnst) = 0._r8
+ real(r8) :: fix_mass(max(1,nfs))
+ real(r8), allocatable :: cph_enthalpy(:)
+ integer, allocatable :: cph_rid(:)
+ integer, allocatable :: num_rnts(:)
+ integer, allocatable :: rxt_tag_map(:)
+ real(r8), allocatable :: pht_alias_mult(:,:)
+ character(len=32), allocatable :: rxt_tag_lst(:)
+ character(len=16), allocatable :: pht_alias_lst(:,:)
+ character(len=16) :: inv_lst(max(1,nfs))
+ character(len=16) :: extfrc_lst(max(1,extcnt))
+ logical :: frc_from_dataset(max(1,extcnt))
+ logical :: is_vector
+ logical :: is_scalar
+ character(len=16) :: slvd_lst(max(1,nslvd))
+ end module chem_mods
diff --git a/src/chemistry/pp_trop_mam_oslo/m_rxt_id.F90 b/src/chemistry/pp_trop_mam_oslo/m_rxt_id.F90
new file mode 100644
index 0000000000..278910603d
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/m_rxt_id.F90
@@ -0,0 +1,16 @@
+ module m_rxt_id
+ implicit none
+ integer, parameter :: rid_jh2o2 = 1
+ integer, parameter :: rid_usr_HO2_HO2 = 2
+ integer, parameter :: rid_usr_DMS_OH = 7
+ integer, parameter :: rid_r0003 = 3
+ integer, parameter :: rid_r0004 = 4
+ integer, parameter :: rid_r0005 = 5
+ integer, parameter :: rid_r0006 = 6
+ integer, parameter :: rid_r0008 = 8
+ integer, parameter :: rid_r0009 = 9
+ integer, parameter :: rid_r0010 = 10
+ integer, parameter :: rid_r0011 = 11
+ integer, parameter :: rid_r0012 = 12
+ integer, parameter :: rid_r0013 = 13
+ end module m_rxt_id
diff --git a/src/chemistry/pp_trop_mam_oslo/m_spc_id.F90 b/src/chemistry/pp_trop_mam_oslo/m_spc_id.F90
new file mode 100644
index 0000000000..f288d118fa
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/m_spc_id.F90
@@ -0,0 +1,33 @@
+ module m_spc_id
+ implicit none
+ integer, parameter :: id_SO2 = 1
+ integer, parameter :: id_H2SO4 = 2
+ integer, parameter :: id_DMS = 3
+ integer, parameter :: id_H2O2 = 4
+ integer, parameter :: id_SO4_NA = 5
+ integer, parameter :: id_SO4_A1 = 6
+ integer, parameter :: id_SO4_A2 = 7
+ integer, parameter :: id_SO4_AC = 8
+ integer, parameter :: id_SO4_PR = 9
+ integer, parameter :: id_BC_N = 10
+ integer, parameter :: id_BC_AX = 11
+ integer, parameter :: id_BC_NI = 12
+ integer, parameter :: id_BC_A = 13
+ integer, parameter :: id_BC_AI = 14
+ integer, parameter :: id_BC_AC = 15
+ integer, parameter :: id_OM_NI = 16
+ integer, parameter :: id_OM_AI = 17
+ integer, parameter :: id_OM_AC = 18
+ integer, parameter :: id_DST_A2 = 19
+ integer, parameter :: id_DST_A3 = 20
+ integer, parameter :: id_SS_A1 = 21
+ integer, parameter :: id_SS_A2 = 22
+ integer, parameter :: id_SS_A3 = 23
+ integer, parameter :: id_SOA_NA = 24
+ integer, parameter :: id_SOA_A1 = 25
+ integer, parameter :: id_SOA_LV = 26
+ integer, parameter :: id_SOA_SV = 27
+ integer, parameter :: id_monoterp = 28
+ integer, parameter :: id_isoprene = 29
+ integer, parameter :: id_H2O = 30
+ end module m_spc_id
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_adjrxt.F90 b/src/chemistry/pp_trop_mam_oslo/mo_adjrxt.F90
new file mode 100644
index 0000000000..fe6931f11d
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_adjrxt.F90
@@ -0,0 +1,34 @@
+ module mo_adjrxt
+ private
+ public :: adjrxt
+ contains
+ subroutine adjrxt( rate, inv, m, ncol, nlev )
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : nfs, rxntot
+ implicit none
+!--------------------------------------------------------------------
+! ... dummy arguments
+!--------------------------------------------------------------------
+ integer, intent(in) :: ncol, nlev
+ real(r8), intent(in) :: inv(ncol,nlev,nfs)
+ real(r8), intent(in) :: m(ncol,nlev)
+ real(r8), intent(inout) :: rate(ncol,nlev,rxntot)
+!--------------------------------------------------------------------
+! ... local variables
+!--------------------------------------------------------------------
+ real(r8) :: im(ncol,nlev)
+ im(:,:) = 1._r8 / m(:,:)
+ rate(:,:, 3) = rate(:,:, 3) * inv(:,:, 5)
+ rate(:,:, 4) = rate(:,:, 4) * inv(:,:, 5)
+ rate(:,:, 5) = rate(:,:, 5) * inv(:,:, 6)
+ rate(:,:, 7) = rate(:,:, 7) * inv(:,:, 5)
+ rate(:,:, 8) = rate(:,:, 8) * inv(:,:, 4)
+ rate(:,:, 9) = rate(:,:, 9) * inv(:,:, 5)
+ rate(:,:, 10) = rate(:,:, 10) * inv(:,:, 6)
+ rate(:,:, 11) = rate(:,:, 11) * inv(:,:, 4)
+ rate(:,:, 12) = rate(:,:, 12) * inv(:,:, 5)
+ rate(:,:, 13) = rate(:,:, 13) * inv(:,:, 6)
+ rate(:,:, 2) = rate(:,:, 2) * inv(:,:, 7) * inv(:,:, 7) * im(:,:)
+ rate(:,:, 6) = rate(:,:, 6) * inv(:,:, 5) * inv(:,:, 1)
+ end subroutine adjrxt
+ end module mo_adjrxt
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_exp_sol.F90 b/src/chemistry/pp_trop_mam_oslo/mo_exp_sol.F90
new file mode 100644
index 0000000000..cfde22391a
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_exp_sol.F90
@@ -0,0 +1,79 @@
+module mo_exp_sol
+ private
+ public :: exp_sol
+ public :: exp_sol_inti
+contains
+ subroutine exp_sol_inti
+ use mo_tracname, only : solsym
+ use chem_mods, only : clscnt1, clsmap
+ use ppgrid, only : pver
+ use cam_history, only : addfld
+ implicit none
+ integer :: i,j
+ do i = 1,clscnt1
+ j = clsmap(i,1)
+ call addfld( trim(solsym(j))//'_CHMP', (/ 'lev' /), 'I', '/cm3/s', 'chemical production rate' )
+ call addfld( trim(solsym(j))//'_CHML', (/ 'lev' /), 'I', '/cm3/s', 'chemical loss rate' )
+ enddo
+ end subroutine exp_sol_inti
+ subroutine exp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, xhnm, ncol, lchnk, ltrop )
+ !-----------------------------------------------------------------------
+ ! ... Exp_sol advances the volumetric mixing ratio
+ ! forward one time step via the fully explicit
+ ! Euler scheme
+ !-----------------------------------------------------------------------
+ use chem_mods, only : clscnt1, extcnt, gas_pcnst, clsmap, rxntot
+ use ppgrid, only : pcols, pver
+ use mo_prod_loss, only : exp_prod_loss
+ use mo_indprd, only : indprd
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use cam_history, only : outfld
+ use mo_tracname, only : solsym
+ implicit none
+ !-----------------------------------------------------------------------
+ ! ... Dummy arguments
+ !-----------------------------------------------------------------------
+ integer, intent(in) :: ncol ! columns in chunck
+ integer, intent(in) :: lchnk ! chunk id
+ real(r8), intent(in) :: delt ! time step (s)
+ real(r8), intent(in) :: het_rates(ncol,pver,max(1,gas_pcnst)) ! het rates (1/cm^3/s)
+ real(r8), intent(in) :: reaction_rates(ncol,pver,rxntot) ! rxt rates (1/cm^3/s)
+ real(r8), intent(in) :: extfrc(ncol,pver,extcnt) ! "external insitu forcing" (1/cm^3/s)
+ real(r8), intent(in) :: xhnm(ncol,pver)
+ integer, intent(in) :: ltrop(pcols) ! chemistry troposphere boundary (index)
+ real(r8), intent(inout) :: base_sol(ncol,pver,gas_pcnst) ! working mixing ratios (vmr)
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ integer :: i, k, l, m
+ real(r8), dimension(ncol,pver,clscnt1) :: &
+ prod, &
+ loss, &
+ ind_prd
+ real(r8), dimension(ncol,pver) :: wrk
+ !-----------------------------------------------------------------------
+ ! ... Put "independent" production in the forcing
+ !-----------------------------------------------------------------------
+ call indprd( 1, ind_prd, clscnt1, base_sol, extfrc, &
+ reaction_rates, ncol )
+ !-----------------------------------------------------------------------
+ ! ... Form F(y)
+ !-----------------------------------------------------------------------
+ call exp_prod_loss( prod, loss, base_sol, reaction_rates, het_rates )
+ !-----------------------------------------------------------------------
+ ! ... Solve for the mixing ratio at t(n+1)
+ !-----------------------------------------------------------------------
+ do m = 1,clscnt1
+ l = clsmap(m,1)
+ do i = 1,ncol
+ do k = ltrop(i)+1,pver
+ base_sol(i,k,l) = base_sol(i,k,l) + delt * (prod(i,k,m) + ind_prd(i,k,m) - loss(i,k,m))
+ end do
+ end do
+ wrk(:,:) = (prod(:,:,m) + ind_prd(:,:,m))*xhnm
+ call outfld( trim(solsym(l))//'_CHMP', wrk(:,:), ncol, lchnk )
+ wrk(:,:) = (loss(:,:,m))*xhnm
+ call outfld( trim(solsym(l))//'_CHML', wrk(:,:), ncol, lchnk )
+ end do
+ end subroutine exp_sol
+end module mo_exp_sol
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_imp_sol.F90 b/src/chemistry/pp_trop_mam_oslo/mo_imp_sol.F90
new file mode 100644
index 0000000000..d885728ba4
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_imp_sol.F90
@@ -0,0 +1,392 @@
+module mo_imp_sol
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : clscnt4, gas_pcnst, clsmap
+ use cam_logfile, only : iulog
+ implicit none
+ private
+ public :: imp_slv_inti, imp_sol
+ save
+ real(r8), parameter :: rel_err = 1.e-3_r8
+ real(r8), parameter :: high_rel_err = 1.e-4_r8
+ !-----------------------------------------------------------------------
+ ! Newton-Raphson iteration limits
+ !-----------------------------------------------------------------------
+ integer, parameter :: itermax = 11
+ integer, parameter :: cut_limit = 5
+ real(r8), parameter :: small = 1.e-40_r8
+ real(r8) :: epsilon(clscnt4)
+ logical :: factor(itermax)
+contains
+ subroutine imp_slv_inti
+ !-----------------------------------------------------------------------
+ ! ... Initialize the implict solver
+ !-----------------------------------------------------------------------
+ use mo_chem_utls, only : get_spc_ndx
+ implicit none
+ !-----------------------------------------------------------------------
+ ! ... Local variables
+ !-----------------------------------------------------------------------
+ integer :: m, ox_ndx, o3a_ndx
+ real(r8) :: eps(gas_pcnst)
+ factor(:) = .true.
+ eps(:) = rel_err
+ ox_ndx = get_spc_ndx( 'OX' )
+ if( ox_ndx < 1 ) then
+ ox_ndx = get_spc_ndx( 'O3' )
+ end if
+ if( ox_ndx > 0 ) then
+ eps(ox_ndx) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'HNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'HO2NO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'N2O5' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'OH' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'HO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ o3a_ndx = get_spc_ndx( 'O3A' )
+ if( o3a_ndx > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XHNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XHO2NO2' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'XNO2NO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ m = get_spc_ndx( 'NO2XNO3' )
+ if( m > 0 ) then
+ eps(m) = high_rel_err
+ end if
+ do m = 1,clscnt4
+ epsilon(m) = eps(clsmap(m,4))
+ end do
+ end subroutine imp_slv_inti
+ subroutine imp_sol( base_sol, reaction_rates, het_rates, extfrc, delt, &
+ ncol,nlev, lchnk, prod_out, loss_out )
+ !-----------------------------------------------------------------------
+ ! ... imp_sol advances the volumetric mixing ratio
+ ! forward one time step via the fully implicit euler scheme.
+ ! this source is meant for small l1 cache machines such as
+ ! the intel pentium and itanium cpus
+ !-----------------------------------------------------------------------
+ use chem_mods, only : rxntot, extcnt, nzcnt, permute, cls_rxt_cnt
+ use mo_tracname, only : solsym
+ use mo_lin_matrix, only : linmat
+ use mo_nln_matrix, only : nlnmat
+ use mo_lu_factor, only : lu_fac
+ use mo_lu_solve, only : lu_slv
+ use mo_prod_loss, only : imp_prod_loss
+ use mo_indprd, only : indprd
+ use time_manager, only : get_nstep
+ use perf_mod, only : t_startf, t_stopf
+ implicit none
+ !-----------------------------------------------------------------------
+ ! ... dummy args
+ !-----------------------------------------------------------------------
+ integer, intent(in) :: ncol ! columns in chunck
+ integer, intent(in) :: nlev
+ integer, intent(in) :: lchnk ! chunk id
+ real(r8), intent(in) :: delt ! time step (s)
+ real(r8), intent(in) :: reaction_rates(ncol,nlev,max(1,rxntot)) ! rxt rates (1/cm^3/s)
+ real(r8), intent(in) :: extfrc(ncol,nlev,max(1,extcnt)) ! external in-situ forcing (1/cm^3/s)
+ real(r8), intent(in) :: het_rates(ncol,nlev,max(1,gas_pcnst)) ! washout rates (1/s)
+ real(r8), intent(inout) :: base_sol(ncol,nlev,gas_pcnst) ! species mixing ratios (vmr)
+ real(r8), intent(out) :: prod_out(ncol,nlev,max(1,clscnt4))
+ real(r8), intent(out) :: loss_out(ncol,nlev,max(1,clscnt4))
+ !-----------------------------------------------------------------------
+ ! ... local variables
+ !-----------------------------------------------------------------------
+ integer :: nr_iter, &
+ lev, &
+ i, &
+ j, &
+ k, l, &
+ m
+ integer :: fail_cnt, cut_cnt, stp_con_cnt
+ integer :: nstep
+ real(r8) :: interval_done, dt, dti
+ real(r8) :: max_delta(max(1,clscnt4))
+ real(r8) :: sys_jac(max(1,nzcnt))
+ real(r8) :: lin_jac(max(1,nzcnt))
+ real(r8), dimension(max(1,clscnt4)) :: &
+ solution, &
+ forcing, &
+ iter_invariant, &
+ prod, &
+ loss
+ real(r8) :: lrxt(max(1,rxntot))
+ real(r8) :: lsol(max(1,gas_pcnst))
+ real(r8) :: lhet(max(1,gas_pcnst))
+ real(r8), dimension(ncol,nlev,max(1,clscnt4)) :: &
+ ind_prd
+ logical :: convergence
+ logical :: frc_mask, iter_conv
+ logical :: converged(max(1,clscnt4))
+ solution(:) = 0._r8
+ !-----------------------------------------------------------------------
+ ! ... class independent forcing
+ !-----------------------------------------------------------------------
+ if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then
+ call indprd( 4, ind_prd, clscnt4, base_sol, extfrc, &
+ reaction_rates, ncol )
+ else
+ do m = 1,max(1,clscnt4)
+ ind_prd(:,:,m) = 0._r8
+ end do
+ end if
+ level_loop : do lev = 1,nlev
+ column_loop : do i = 1,ncol
+ !-----------------------------------------------------------------------
+ ! ... transfer from base to local work arrays
+ !-----------------------------------------------------------------------
+ do m = 1,rxntot
+ lrxt(m) = reaction_rates(i,lev,m)
+ end do
+ if( gas_pcnst > 0 ) then
+ do m = 1,gas_pcnst
+ lhet(m) = het_rates(i,lev,m)
+ end do
+ end if
+ !-----------------------------------------------------------------------
+ ! ... time step loop
+ !-----------------------------------------------------------------------
+ dt = delt
+ cut_cnt = 0
+ fail_cnt = 0
+ stp_con_cnt = 0
+ interval_done = 0._r8
+ time_step_loop : do
+ dti = 1._r8 / dt
+ !-----------------------------------------------------------------------
+ ! ... transfer from base to local work arrays
+ !-----------------------------------------------------------------------
+ do m = 1,gas_pcnst
+ lsol(m) = base_sol(i,lev,m)
+ end do
+ !-----------------------------------------------------------------------
+ ! ... transfer from base to class array
+ !-----------------------------------------------------------------------
+ do k = 1,clscnt4
+ j = clsmap(k,4)
+ m = permute(k,4)
+ solution(m) = lsol(j)
+ end do
+ !-----------------------------------------------------------------------
+ ! ... set the iteration invariant part of the function f(y)
+ !-----------------------------------------------------------------------
+ if( cls_rxt_cnt(1,4) > 0 .or. extcnt > 0 ) then
+ do m = 1,clscnt4
+ iter_invariant(m) = dti * solution(m) + ind_prd(i,lev,m)
+ end do
+ else
+ do m = 1,clscnt4
+ iter_invariant(m) = dti * solution(m)
+ end do
+ end if
+ !-----------------------------------------------------------------------
+ ! ... the linear component
+ !-----------------------------------------------------------------------
+ if( cls_rxt_cnt(2,4) > 0 ) then
+ call t_startf( 'lin_mat' )
+ call linmat( lin_jac, lsol, lrxt, lhet )
+ call t_stopf( 'lin_mat' )
+ end if
+ !=======================================================================
+ ! the newton-raphson iteration for f(y) = 0
+ !=======================================================================
+ iter_loop : do nr_iter = 1,itermax
+ !-----------------------------------------------------------------------
+ ! ... the non-linear component
+ !-----------------------------------------------------------------------
+ if( factor(nr_iter) ) then
+ call t_startf( 'nln_mat' )
+ call nlnmat( sys_jac, lsol, lrxt, lin_jac, dti )
+ call t_stopf( 'nln_mat' )
+ !-----------------------------------------------------------------------
+ ! ... factor the "system" matrix
+ !-----------------------------------------------------------------------
+ call t_startf( 'lu_fac' )
+ call lu_fac( sys_jac )
+ call t_stopf( 'lu_fac' )
+ end if
+ !-----------------------------------------------------------------------
+ ! ... form f(y)
+ !-----------------------------------------------------------------------
+ call t_startf( 'prod_loss' )
+ call imp_prod_loss( prod, loss, lsol, lrxt, lhet )
+ call t_stopf( 'prod_loss' )
+ do m = 1,clscnt4
+ forcing(m) = solution(m)*dti - (iter_invariant(m) + prod(m) - loss(m))
+ end do
+ !-----------------------------------------------------------------------
+ ! ... solve for the mixing ratio at t(n+1)
+ !-----------------------------------------------------------------------
+ call t_startf( 'lu_slv' )
+ call lu_slv( sys_jac, forcing )
+ call t_stopf( 'lu_slv' )
+ do m = 1,clscnt4
+ solution(m) = solution(m) + forcing(m)
+ end do
+ !-----------------------------------------------------------------------
+ ! ... convergence measures
+ !-----------------------------------------------------------------------
+ if( nr_iter > 1 ) then
+ do k = 1,clscnt4
+ m = permute(k,4)
+ if( abs(solution(m)) > 1.e-20_r8 ) then
+ max_delta(k) = abs( forcing(m)/solution(m) )
+ else
+ max_delta(k) = 0._r8
+ end if
+ end do
+ end if
+ !-----------------------------------------------------------------------
+ ! ... limit iterate
+ !-----------------------------------------------------------------------
+ where( solution(:) < 0._r8 )
+ solution(:) = 0._r8
+ endwhere
+ !-----------------------------------------------------------------------
+ ! ... transfer latest solution back to work array
+ !-----------------------------------------------------------------------
+ do k = 1,clscnt4
+ j = clsmap(k,4)
+ m = permute(k,4)
+ lsol(j) = solution(m)
+ end do
+ !-----------------------------------------------------------------------
+ ! ... check for convergence
+ !-----------------------------------------------------------------------
+ converged(:) = .true.
+ if( nr_iter > 1 ) then
+ do k = 1,clscnt4
+ m = permute(k,4)
+ frc_mask = abs( forcing(m) ) > small
+ if( frc_mask ) then
+ converged(k) = abs(forcing(m)) <= epsilon(k)*abs(solution(m))
+ else
+ converged(k) = .true.
+ end if
+ end do
+ convergence = all( converged(:) )
+ if( convergence ) then
+ exit
+ end if
+ end if
+ end do iter_loop
+ !-----------------------------------------------------------------------
+ ! ... check for newton-raphson convergence
+ !-----------------------------------------------------------------------
+ if( .not. convergence ) then
+ !-----------------------------------------------------------------------
+ ! ... non-convergence
+ !-----------------------------------------------------------------------
+ fail_cnt = fail_cnt + 1
+ nstep = get_nstep()
+ write(iulog,'('' imp_sol: Time step '',1p,e21.13,'' failed to converge @ (lchnk,lev,col,nstep) = '',4i6)') &
+ dt,lchnk,lev,i,nstep
+ stp_con_cnt = 0
+ if( cut_cnt < cut_limit ) then
+ cut_cnt = cut_cnt + 1
+ if( cut_cnt < cut_limit ) then
+ dt = .5_r8 * dt
+ else
+ dt = .1_r8 * dt
+ end if
+ cycle time_step_loop
+ else
+ write(iulog,'('' imp_sol: Failed to converge @ (lchnk,lev,col,nstep,dt,time) = '',4i6,1p,2e21.13)') &
+ lchnk,lev,i,nstep,dt,interval_done+dt
+ do m = 1,clscnt4
+ if( .not. converged(m) ) then
+ write(iulog,'(1x,a8,1x,1pe10.3)') solsym(clsmap(m,4)), max_delta(m)
+ end if
+ end do
+ end if
+ end if
+ !-----------------------------------------------------------------------
+ ! ... check for interval done
+ !-----------------------------------------------------------------------
+ interval_done = interval_done + dt
+ if( abs( delt - interval_done ) <= .0001_r8 ) then
+ if( fail_cnt > 0 ) then
+ write(iulog,*) 'imp_sol : @ (lchnk,lev,col) = ',lchnk,lev,i,' failed ',fail_cnt,' times'
+ end if
+ exit time_step_loop
+ else
+ !-----------------------------------------------------------------------
+ ! ... transfer latest solution back to base array
+ !-----------------------------------------------------------------------
+ if( convergence ) then
+ stp_con_cnt = stp_con_cnt + 1
+ end if
+ do m = 1,gas_pcnst
+ base_sol(i,lev,m) = lsol(m)
+ end do
+ if( stp_con_cnt >= 2 ) then
+ dt = 2._r8*dt
+ stp_con_cnt = 0
+ end if
+ dt = min( dt,delt-interval_done )
+ ! write(iulog,'('' imp_sol: New time step '',1p,e21.13)') dt
+ end if
+ end do time_step_loop
+ !-----------------------------------------------------------------------
+ ! ... Transfer latest solution back to base array
+ !-----------------------------------------------------------------------
+ cls_loop: do k = 1,clscnt4
+ j = clsmap(k,4)
+ m = permute(k,4)
+ base_sol(i,lev,j) = solution(m)
+ ! output diagnostics
+ prod_out(i,lev,k) = prod(k) + ind_prd(i,lev,k)
+ loss_out(i,lev,k) = loss(k)
+ end do cls_loop
+ end do column_loop
+ end do level_loop
+ end subroutine imp_sol
+end module mo_imp_sol
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_indprd.F90 b/src/chemistry/pp_trop_mam_oslo/mo_indprd.F90
new file mode 100644
index 0000000000..f9ec6830fb
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_indprd.F90
@@ -0,0 +1,56 @@
+ module mo_indprd
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ private
+ public :: indprd
+ contains
+ subroutine indprd( class, prod, nprod, y, extfrc, rxt, ncol )
+ use chem_mods, only : gas_pcnst, extcnt, rxntot
+ use ppgrid, only : pver
+ implicit none
+!--------------------------------------------------------------------
+! ... dummy arguments
+!--------------------------------------------------------------------
+ integer, intent(in) :: class
+ integer, intent(in) :: ncol
+ integer, intent(in) :: nprod
+ real(r8), intent(in) :: y(ncol,pver,gas_pcnst)
+ real(r8), intent(in) :: rxt(ncol,pver,rxntot)
+ real(r8), intent(in) :: extfrc(ncol,pver,extcnt)
+ real(r8), intent(inout) :: prod(ncol,pver,nprod)
+!--------------------------------------------------------------------
+! ... "independent" production for Implicit species
+!--------------------------------------------------------------------
+ if( class == 4 ) then
+ prod(:,:,1) = 0._r8
+ prod(:,:,2) = + extfrc(:,:,1)
+ prod(:,:,3) =rxt(:,:,2)
+ prod(:,:,4) = 0._r8
+ prod(:,:,5) = 0._r8
+ prod(:,:,6) = 0._r8
+ prod(:,:,7) = 0._r8
+ prod(:,:,8) = + extfrc(:,:,6)
+ prod(:,:,9) = + extfrc(:,:,4)
+ prod(:,:,10) = + extfrc(:,:,3)
+ prod(:,:,11) = + extfrc(:,:,2)
+ prod(:,:,12) = 0._r8
+ prod(:,:,13) = 0._r8
+ prod(:,:,14) = 0._r8
+ prod(:,:,15) = + extfrc(:,:,5)
+ prod(:,:,16) = 0._r8
+ prod(:,:,17) = 0._r8
+ prod(:,:,18) = 0._r8
+ prod(:,:,19) = 0._r8
+ prod(:,:,20) = 0._r8
+ prod(:,:,21) = 0._r8
+ prod(:,:,22) = 0._r8
+ prod(:,:,23) = 0._r8
+ prod(:,:,24) = 0._r8
+ prod(:,:,25) = 0._r8
+ prod(:,:,26) = 0._r8
+ prod(:,:,27) = 0._r8
+ prod(:,:,28) = 0._r8
+ prod(:,:,29) = 0._r8
+ prod(:,:,30) = + extfrc(:,:,7)
+ end if
+ end subroutine indprd
+ end module mo_indprd
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_lin_matrix.F90 b/src/chemistry/pp_trop_mam_oslo/mo_lin_matrix.F90
new file mode 100644
index 0000000000..e4c7687ebb
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_lin_matrix.F90
@@ -0,0 +1,74 @@
+ module mo_lin_matrix
+ private
+ public :: linmat
+ contains
+ subroutine linmat01( mat, y, rxt, het_rates )
+!----------------------------------------------
+! ... linear matrix entries for implicit species
+!----------------------------------------------
+ use chem_mods, only : gas_pcnst, rxntot, nzcnt
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ implicit none
+!----------------------------------------------
+! ... dummy arguments
+!----------------------------------------------
+ real(r8), intent(in) :: y(gas_pcnst)
+ real(r8), intent(in) :: rxt(rxntot)
+ real(r8), intent(in) :: het_rates(max(1,gas_pcnst))
+ real(r8), intent(inout) :: mat(nzcnt)
+ mat(1) = -( rxt(4) + rxt(5) + rxt(7) + het_rates(3) )
+ mat(5) = -( rxt(6) + het_rates(1) )
+ mat(2) = rxt(4) + rxt(5) + .750_r8*rxt(7)
+ mat(7) = -( rxt(1) + rxt(3) + het_rates(4) )
+ mat(9) = -( het_rates(5) )
+ mat(10) = -( het_rates(6) )
+ mat(11) = -( het_rates(7) )
+ mat(12) = -( het_rates(8) )
+ mat(13) = -( het_rates(9) )
+ mat(14) = -( het_rates(10) )
+ mat(15) = -( het_rates(11) )
+ mat(16) = -( het_rates(12) )
+ mat(17) = -( het_rates(13) )
+ mat(18) = -( het_rates(14) )
+ mat(19) = -( het_rates(15) )
+ mat(20) = -( het_rates(16) )
+ mat(21) = -( het_rates(17) )
+ mat(22) = -( het_rates(18) )
+ mat(23) = -( het_rates(19) )
+ mat(24) = -( het_rates(20) )
+ mat(25) = -( het_rates(21) )
+ mat(26) = -( het_rates(22) )
+ mat(27) = -( het_rates(23) )
+ mat(28) = -( het_rates(2) )
+ mat(6) = rxt(6)
+ mat(29) = -( het_rates(24) )
+ mat(30) = -( het_rates(25) )
+ mat(31) = -( het_rates(26) )
+ mat(3) = .029_r8*rxt(7)
+ mat(33) = .150_r8*rxt(8)
+ mat(32) = -( het_rates(27) )
+ mat(4) = .114_r8*rxt(7)
+ mat(34) = .150_r8*rxt(9) + .150_r8*rxt(10)
+ mat(36) = .050_r8*rxt(11) + .050_r8*rxt(12) + .050_r8*rxt(13)
+ mat(35) = -( rxt(8) + rxt(9) + rxt(10) + het_rates(28) )
+ mat(37) = -( rxt(11) + rxt(12) + rxt(13) + het_rates(29) )
+ mat(38) = -( het_rates(30) )
+ mat(8) = rxt(3)
+ end subroutine linmat01
+ subroutine linmat( mat, y, rxt, het_rates )
+!----------------------------------------------
+! ... linear matrix entries for implicit species
+!----------------------------------------------
+ use chem_mods, only : gas_pcnst, rxntot, nzcnt
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ implicit none
+!----------------------------------------------
+! ... dummy arguments
+!----------------------------------------------
+ real(r8), intent(in) :: y(gas_pcnst)
+ real(r8), intent(in) :: rxt(rxntot)
+ real(r8), intent(in) :: het_rates(max(1,gas_pcnst))
+ real(r8), intent(inout) :: mat(nzcnt)
+ call linmat01( mat, y, rxt, het_rates )
+ end subroutine linmat
+ end module mo_lin_matrix
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_lu_factor.F90 b/src/chemistry/pp_trop_mam_oslo/mo_lu_factor.F90
new file mode 100644
index 0000000000..703de44018
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_lu_factor.F90
@@ -0,0 +1,57 @@
+ module mo_lu_factor
+ private
+ public :: lu_fac
+ contains
+ subroutine lu_fac01( lu )
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ implicit none
+!-----------------------------------------------------------------------
+! ... dummy args
+!-----------------------------------------------------------------------
+ real(r8), intent(inout) :: lu(:)
+ lu(1) = 1._r8 / lu(1)
+ lu(2) = lu(2) * lu(1)
+ lu(3) = lu(3) * lu(1)
+ lu(4) = lu(4) * lu(1)
+ lu(5) = 1._r8 / lu(5)
+ lu(6) = lu(6) * lu(5)
+ lu(7) = 1._r8 / lu(7)
+ lu(8) = lu(8) * lu(7)
+ lu(9) = 1._r8 / lu(9)
+ lu(10) = 1._r8 / lu(10)
+ lu(11) = 1._r8 / lu(11)
+ lu(12) = 1._r8 / lu(12)
+ lu(13) = 1._r8 / lu(13)
+ lu(14) = 1._r8 / lu(14)
+ lu(15) = 1._r8 / lu(15)
+ lu(16) = 1._r8 / lu(16)
+ lu(17) = 1._r8 / lu(17)
+ lu(18) = 1._r8 / lu(18)
+ lu(19) = 1._r8 / lu(19)
+ lu(20) = 1._r8 / lu(20)
+ lu(21) = 1._r8 / lu(21)
+ lu(22) = 1._r8 / lu(22)
+ lu(23) = 1._r8 / lu(23)
+ lu(24) = 1._r8 / lu(24)
+ lu(25) = 1._r8 / lu(25)
+ lu(26) = 1._r8 / lu(26)
+ lu(27) = 1._r8 / lu(27)
+ lu(28) = 1._r8 / lu(28)
+ lu(29) = 1._r8 / lu(29)
+ lu(30) = 1._r8 / lu(30)
+ lu(31) = 1._r8 / lu(31)
+ lu(32) = 1._r8 / lu(32)
+ lu(35) = 1._r8 / lu(35)
+ lu(37) = 1._r8 / lu(37)
+ lu(38) = 1._r8 / lu(38)
+ end subroutine lu_fac01
+ subroutine lu_fac( lu )
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ implicit none
+!-----------------------------------------------------------------------
+! ... dummy args
+!-----------------------------------------------------------------------
+ real(r8), intent(inout) :: lu(:)
+ call lu_fac01( lu )
+ end subroutine lu_fac
+ end module mo_lu_factor
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_lu_solve.F90 b/src/chemistry/pp_trop_mam_oslo/mo_lu_solve.F90
new file mode 100644
index 0000000000..862191c56b
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_lu_solve.F90
@@ -0,0 +1,90 @@
+ module mo_lu_solve
+ private
+ public :: lu_slv
+ contains
+ subroutine lu_slv01( lu, b )
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : clscnt4, nzcnt
+ implicit none
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ real(r8), intent(in) :: lu(:)
+ real(r8), intent(inout) :: b(:)
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! ... solve L * y = b
+!-----------------------------------------------------------------------
+ b(2) = b(2) - lu(2) * b(1)
+ b(26) = b(26) - lu(3) * b(1)
+ b(27) = b(27) - lu(4) * b(1)
+ b(23) = b(23) - lu(6) * b(2)
+ b(30) = b(30) - lu(8) * b(3)
+ end subroutine lu_slv01
+ subroutine lu_slv02( lu, b )
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : clscnt4, nzcnt
+ implicit none
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ real(r8), intent(in) :: lu(:)
+ real(r8), intent(inout) :: b(:)
+!-----------------------------------------------------------------------
+! ... Local variables
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! ... solve L * y = b
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+! ... Solve U * x = y
+!-----------------------------------------------------------------------
+ b(30) = b(30) * lu(38)
+ b(29) = b(29) * lu(37)
+ b(27) = b(27) - lu(36) * b(29)
+ b(28) = b(28) * lu(35)
+ b(27) = b(27) - lu(34) * b(28)
+ b(26) = b(26) - lu(33) * b(28)
+ b(27) = b(27) * lu(32)
+ b(26) = b(26) * lu(31)
+ b(25) = b(25) * lu(30)
+ b(24) = b(24) * lu(29)
+ b(23) = b(23) * lu(28)
+ b(22) = b(22) * lu(27)
+ b(21) = b(21) * lu(26)
+ b(20) = b(20) * lu(25)
+ b(19) = b(19) * lu(24)
+ b(18) = b(18) * lu(23)
+ b(17) = b(17) * lu(22)
+ b(16) = b(16) * lu(21)
+ b(15) = b(15) * lu(20)
+ b(14) = b(14) * lu(19)
+ b(13) = b(13) * lu(18)
+ b(12) = b(12) * lu(17)
+ b(11) = b(11) * lu(16)
+ b(10) = b(10) * lu(15)
+ b(9) = b(9) * lu(14)
+ b(8) = b(8) * lu(13)
+ b(7) = b(7) * lu(12)
+ b(6) = b(6) * lu(11)
+ b(5) = b(5) * lu(10)
+ b(4) = b(4) * lu(9)
+ b(3) = b(3) * lu(7)
+ b(2) = b(2) * lu(5)
+ b(1) = b(1) * lu(1)
+ end subroutine lu_slv02
+ subroutine lu_slv( lu, b )
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : clscnt4, nzcnt
+ implicit none
+!-----------------------------------------------------------------------
+! ... Dummy args
+!-----------------------------------------------------------------------
+ real(r8), intent(in) :: lu(:)
+ real(r8), intent(inout) :: b(:)
+ call lu_slv01( lu, b )
+ call lu_slv02( lu, b )
+ end subroutine lu_slv
+ end module mo_lu_solve
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_nln_matrix.F90 b/src/chemistry/pp_trop_mam_oslo/mo_nln_matrix.F90
new file mode 100644
index 0000000000..3aa3cd3972
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_nln_matrix.F90
@@ -0,0 +1,103 @@
+ module mo_nln_matrix
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ private
+ public :: nlnmat
+ contains
+ subroutine nlnmat( mat, y, rxt, lmat, dti )
+ use chem_mods, only : gas_pcnst, rxntot, nzcnt
+ implicit none
+!----------------------------------------------
+! ... dummy arguments
+!----------------------------------------------
+ real(r8), intent(in) :: dti
+ real(r8), intent(in) :: lmat(nzcnt)
+ real(r8), intent(in) :: y(gas_pcnst)
+ real(r8), intent(in) :: rxt(rxntot)
+ real(r8), intent(inout) :: mat(nzcnt)
+ call nlnmat_finit( mat, lmat, dti )
+ end subroutine nlnmat
+ subroutine nlnmat_finit( mat, lmat, dti )
+ use chem_mods, only : gas_pcnst, rxntot, nzcnt
+ implicit none
+!----------------------------------------------
+! ... dummy arguments
+!----------------------------------------------
+ real(r8), intent(in) :: dti
+ real(r8), intent(in) :: lmat(nzcnt)
+ real(r8), intent(inout) :: mat(nzcnt)
+!----------------------------------------------
+! ... local variables
+!----------------------------------------------
+!----------------------------------------------
+! ... complete matrix entries implicit species
+!----------------------------------------------
+ mat( 1) = lmat( 1)
+ mat( 2) = lmat( 2)
+ mat( 3) = lmat( 3)
+ mat( 4) = lmat( 4)
+ mat( 5) = lmat( 5)
+ mat( 6) = lmat( 6)
+ mat( 7) = lmat( 7)
+ mat( 8) = lmat( 8)
+ mat( 9) = lmat( 9)
+ mat( 10) = lmat( 10)
+ mat( 11) = lmat( 11)
+ mat( 12) = lmat( 12)
+ mat( 13) = lmat( 13)
+ mat( 14) = lmat( 14)
+ mat( 15) = lmat( 15)
+ mat( 16) = lmat( 16)
+ mat( 17) = lmat( 17)
+ mat( 18) = lmat( 18)
+ mat( 19) = lmat( 19)
+ mat( 20) = lmat( 20)
+ mat( 21) = lmat( 21)
+ mat( 22) = lmat( 22)
+ mat( 23) = lmat( 23)
+ mat( 24) = lmat( 24)
+ mat( 25) = lmat( 25)
+ mat( 26) = lmat( 26)
+ mat( 27) = lmat( 27)
+ mat( 28) = lmat( 28)
+ mat( 29) = lmat( 29)
+ mat( 30) = lmat( 30)
+ mat( 31) = lmat( 31)
+ mat( 32) = lmat( 32)
+ mat( 33) = lmat( 33)
+ mat( 34) = lmat( 34)
+ mat( 35) = lmat( 35)
+ mat( 36) = lmat( 36)
+ mat( 37) = lmat( 37)
+ mat( 38) = lmat( 38)
+ mat( 1) = mat( 1) - dti
+ mat( 5) = mat( 5) - dti
+ mat( 7) = mat( 7) - dti
+ mat( 9) = mat( 9) - dti
+ mat( 10) = mat( 10) - dti
+ mat( 11) = mat( 11) - dti
+ mat( 12) = mat( 12) - dti
+ mat( 13) = mat( 13) - dti
+ mat( 14) = mat( 14) - dti
+ mat( 15) = mat( 15) - dti
+ mat( 16) = mat( 16) - dti
+ mat( 17) = mat( 17) - dti
+ mat( 18) = mat( 18) - dti
+ mat( 19) = mat( 19) - dti
+ mat( 20) = mat( 20) - dti
+ mat( 21) = mat( 21) - dti
+ mat( 22) = mat( 22) - dti
+ mat( 23) = mat( 23) - dti
+ mat( 24) = mat( 24) - dti
+ mat( 25) = mat( 25) - dti
+ mat( 26) = mat( 26) - dti
+ mat( 27) = mat( 27) - dti
+ mat( 28) = mat( 28) - dti
+ mat( 29) = mat( 29) - dti
+ mat( 30) = mat( 30) - dti
+ mat( 31) = mat( 31) - dti
+ mat( 32) = mat( 32) - dti
+ mat( 35) = mat( 35) - dti
+ mat( 37) = mat( 37) - dti
+ mat( 38) = mat( 38) - dti
+ end subroutine nlnmat_finit
+ end module mo_nln_matrix
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_phtadj.F90 b/src/chemistry/pp_trop_mam_oslo/mo_phtadj.F90
new file mode 100644
index 0000000000..aaa43829fe
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_phtadj.F90
@@ -0,0 +1,24 @@
+ module mo_phtadj
+ private
+ public :: phtadj
+ contains
+ subroutine phtadj( p_rate, inv, m, ncol, nlev )
+ use chem_mods, only : nfs, phtcnt
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ implicit none
+!--------------------------------------------------------------------
+! ... dummy arguments
+!--------------------------------------------------------------------
+ integer, intent(in) :: ncol, nlev
+ real(r8), intent(in) :: inv(ncol,nlev,max(1,nfs))
+ real(r8), intent(in) :: m(ncol,nlev)
+ real(r8), intent(inout) :: p_rate(ncol,nlev,max(1,phtcnt))
+!--------------------------------------------------------------------
+! ... local variables
+!--------------------------------------------------------------------
+ integer :: k
+ real(r8) :: im(ncol,nlev)
+ do k = 1,nlev
+ end do
+ end subroutine phtadj
+ end module mo_phtadj
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_prod_loss.F90 b/src/chemistry/pp_trop_mam_oslo/mo_prod_loss.F90
new file mode 100644
index 0000000000..0cbb77be48
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_prod_loss.F90
@@ -0,0 +1,97 @@
+ module mo_prod_loss
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ private
+ public :: exp_prod_loss
+ public :: imp_prod_loss
+ contains
+ subroutine exp_prod_loss( prod, loss, y, rxt, het_rates )
+ use ppgrid, only : pver
+ implicit none
+!--------------------------------------------------------------------
+! ... dummy args
+!--------------------------------------------------------------------
+ real(r8), dimension(:,:,:), intent(out) :: &
+ prod, &
+ loss
+ real(r8), intent(in) :: y(:,:,:)
+ real(r8), intent(in) :: rxt(:,:,:)
+ real(r8), intent(in) :: het_rates(:,:,:)
+ end subroutine exp_prod_loss
+ subroutine imp_prod_loss( prod, loss, y, rxt, het_rates )
+ use ppgrid, only : pver
+ implicit none
+!--------------------------------------------------------------------
+! ... dummy args
+!--------------------------------------------------------------------
+ real(r8), dimension(:), intent(out) :: &
+ prod, &
+ loss
+ real(r8), intent(in) :: y(:)
+ real(r8), intent(in) :: rxt(:)
+ real(r8), intent(in) :: het_rates(:)
+!--------------------------------------------------------------------
+! ... loss and production for Implicit method
+!--------------------------------------------------------------------
+ loss(1) = ( + rxt(4) + rxt(5) + rxt(7) + het_rates(3))* y(3)
+ prod(1) = 0._r8
+ loss(2) = ( + rxt(6) + het_rates(1))* y(1)
+ prod(2) = (rxt(4) +rxt(5) +.750_r8*rxt(7))*y(3)
+ loss(3) = ( + rxt(1) + rxt(3) + het_rates(4))* y(4)
+ prod(3) = 0._r8
+ loss(4) = ( + het_rates(5))* y(5)
+ prod(4) = 0._r8
+ loss(5) = ( + het_rates(6))* y(6)
+ prod(5) = 0._r8
+ loss(6) = ( + het_rates(7))* y(7)
+ prod(6) = 0._r8
+ loss(7) = ( + het_rates(8))* y(8)
+ prod(7) = 0._r8
+ loss(8) = ( + het_rates(9))* y(9)
+ prod(8) = 0._r8
+ loss(9) = ( + het_rates(10))* y(10)
+ prod(9) = 0._r8
+ loss(10) = ( + het_rates(11))* y(11)
+ prod(10) = 0._r8
+ loss(11) = ( + het_rates(12))* y(12)
+ prod(11) = 0._r8
+ loss(12) = ( + het_rates(13))* y(13)
+ prod(12) = 0._r8
+ loss(13) = ( + het_rates(14))* y(14)
+ prod(13) = 0._r8
+ loss(14) = ( + het_rates(15))* y(15)
+ prod(14) = 0._r8
+ loss(15) = ( + het_rates(16))* y(16)
+ prod(15) = 0._r8
+ loss(16) = ( + het_rates(17))* y(17)
+ prod(16) = 0._r8
+ loss(17) = ( + het_rates(18))* y(18)
+ prod(17) = 0._r8
+ loss(18) = ( + het_rates(19))* y(19)
+ prod(18) = 0._r8
+ loss(19) = ( + het_rates(20))* y(20)
+ prod(19) = 0._r8
+ loss(20) = ( + het_rates(21))* y(21)
+ prod(20) = 0._r8
+ loss(21) = ( + het_rates(22))* y(22)
+ prod(21) = 0._r8
+ loss(22) = ( + het_rates(23))* y(23)
+ prod(22) = 0._r8
+ loss(23) = ( + het_rates(2))* y(2)
+ prod(23) =rxt(6)*y(1)
+ loss(24) = ( + het_rates(24))* y(24)
+ prod(24) = 0._r8
+ loss(25) = ( + het_rates(25))* y(25)
+ prod(25) = 0._r8
+ loss(26) = ( + het_rates(26))* y(26)
+ prod(26) =.029_r8*rxt(7)*y(3) +.150_r8*rxt(8)*y(28)
+ loss(27) = ( + het_rates(27))* y(27)
+ prod(27) = (.050_r8*rxt(11) +.050_r8*rxt(12) +.050_r8*rxt(13))*y(29) &
+ + (.150_r8*rxt(9) +.150_r8*rxt(10))*y(28) +.114_r8*rxt(7)*y(3)
+ loss(28) = ( + rxt(8) + rxt(9) + rxt(10) + het_rates(28))* y(28)
+ prod(28) = 0._r8
+ loss(29) = ( + rxt(11) + rxt(12) + rxt(13) + het_rates(29))* y(29)
+ prod(29) = 0._r8
+ loss(30) = ( + het_rates(30))* y(30)
+ prod(30) =rxt(3)*y(4)
+ end subroutine imp_prod_loss
+ end module mo_prod_loss
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_rxt_rates_conv.F90 b/src/chemistry/pp_trop_mam_oslo/mo_rxt_rates_conv.F90
new file mode 100644
index 0000000000..7f9000e78e
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_rxt_rates_conv.F90
@@ -0,0 +1,25 @@
+module mo_rxt_rates_conv
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ implicit none
+ private
+ public :: set_rates
+contains
+ subroutine set_rates( rxt_rates, sol, ncol )
+ real(r8), intent(inout) :: rxt_rates(:,:,:)
+ real(r8), intent(in) :: sol(:,:,:)
+ integer, intent(in) :: ncol
+ rxt_rates(:ncol,:, 1) = rxt_rates(:ncol,:, 1)*sol(:ncol,:, 4) ! rate_const*H2O2
+ ! rate_const
+ rxt_rates(:ncol,:, 3) = rxt_rates(:ncol,:, 3)*sol(:ncol,:, 4) ! rate_const*OH*H2O2
+ rxt_rates(:ncol,:, 4) = rxt_rates(:ncol,:, 4)*sol(:ncol,:, 3) ! rate_const*OH*DMS
+ rxt_rates(:ncol,:, 5) = rxt_rates(:ncol,:, 5)*sol(:ncol,:, 3) ! rate_const*NO3*DMS
+ rxt_rates(:ncol,:, 6) = rxt_rates(:ncol,:, 6)*sol(:ncol,:, 1) ! rate_const*OH*M*SO2
+ rxt_rates(:ncol,:, 7) = rxt_rates(:ncol,:, 7)*sol(:ncol,:, 3) ! rate_const*OH*DMS
+ rxt_rates(:ncol,:, 8) = rxt_rates(:ncol,:, 8)*sol(:ncol,:, 28) ! rate_const*O3*monoterp
+ rxt_rates(:ncol,:, 9) = rxt_rates(:ncol,:, 9)*sol(:ncol,:, 28) ! rate_const*OH*monoterp
+ rxt_rates(:ncol,:, 10) = rxt_rates(:ncol,:, 10)*sol(:ncol,:, 28) ! rate_const*NO3*monoterp
+ rxt_rates(:ncol,:, 11) = rxt_rates(:ncol,:, 11)*sol(:ncol,:, 29) ! rate_const*O3*isoprene
+ rxt_rates(:ncol,:, 12) = rxt_rates(:ncol,:, 12)*sol(:ncol,:, 29) ! rate_const*OH*isoprene
+ rxt_rates(:ncol,:, 13) = rxt_rates(:ncol,:, 13)*sol(:ncol,:, 29) ! rate_const*NO3*isoprene
+ end subroutine set_rates
+end module mo_rxt_rates_conv
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_setrxt.F90 b/src/chemistry/pp_trop_mam_oslo/mo_setrxt.F90
new file mode 100644
index 0000000000..b9909e2e6b
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_setrxt.F90
@@ -0,0 +1,90 @@
+
+ module mo_setrxt
+
+ use shr_kind_mod, only : r8 => shr_kind_r8
+
+ private
+ public :: setrxt
+ public :: setrxt_hrates
+
+ contains
+
+ subroutine setrxt( rate, temp, m, ncol )
+
+ use ppgrid, only : pver, pcols
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : rxntot
+ use mo_jpl, only : jpl
+
+ implicit none
+
+!-------------------------------------------------------
+! ... dummy arguments
+!-------------------------------------------------------
+ integer, intent(in) :: ncol
+ real(r8), intent(in) :: temp(pcols,pver)
+ real(r8), intent(in) :: m(ncol,pver)
+ real(r8), intent(inout) :: rate(ncol,pver,rxntot)
+
+!-------------------------------------------------------
+! ... local variables
+!-------------------------------------------------------
+ integer :: n
+ real(r8) :: itemp(ncol,pver)
+ real(r8) :: exp_fac(ncol,pver)
+ real(r8) :: ko(ncol,pver)
+ real(r8) :: kinf(ncol,pver)
+
+ itemp(:ncol,:) = 1._r8 / temp(:ncol,:)
+ n = ncol*pver
+ rate(:,:,3) = 2.9e-12_r8 * exp( -160._r8 * itemp(:,:) )
+ rate(:,:,4) = 9.6e-12_r8 * exp( -234._r8 * itemp(:,:) )
+ rate(:,:,5) = 1.9e-13_r8 * exp( 520._r8 * itemp(:,:) )
+ rate(:,:,8) = 8.05e-16_r8 * exp( -640._r8 * itemp(:,:) )
+ rate(:,:,9) = 1.2e-11_r8 * exp( 440._r8 * itemp(:,:) )
+ rate(:,:,10) = 1.2e-12_r8 * exp( 490._r8 * itemp(:,:) )
+ rate(:,:,11) = 1.03e-14_r8 * exp( -1995._r8 * itemp(:,:) )
+ rate(:,:,12) = 2.7e-11_r8 * exp( 390._r8 * itemp(:,:) )
+ rate(:,:,13) = 3.15e-12_r8 * exp( -450._r8 * itemp(:,:) )
+
+ itemp(:,:) = 300._r8 * itemp(:,:)
+
+ ko(:,:) = 3.0e-31_r8 * itemp(:,:)**3.3_r8
+ kinf(:,:) = 1.5e-12_r8
+ call jpl( rate(1,1,6), m, 0.6_r8, ko, kinf, n )
+
+ end subroutine setrxt
+
+
+ subroutine setrxt_hrates( rate, temp, m, ncol, kbot )
+
+ use ppgrid, only : pver, pcols
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use chem_mods, only : rxntot
+ use mo_jpl, only : jpl
+
+ implicit none
+
+!-------------------------------------------------------
+! ... dummy arguments
+!-------------------------------------------------------
+ integer, intent(in) :: ncol
+ integer, intent(in) :: kbot
+ real(r8), intent(in) :: temp(pcols,pver)
+ real(r8), intent(in) :: m(ncol,pver)
+ real(r8), intent(inout) :: rate(ncol,pver,rxntot)
+
+!-------------------------------------------------------
+! ... local variables
+!-------------------------------------------------------
+ integer :: n
+ real(r8) :: itemp(ncol,kbot)
+ real(r8) :: exp_fac(ncol,kbot)
+ real(r8) :: ko(ncol,kbot)
+ real(r8) :: kinf(ncol,kbot)
+ real(r8) :: wrk(ncol,kbot)
+
+
+ end subroutine setrxt_hrates
+
+ end module mo_setrxt
diff --git a/src/chemistry/pp_trop_mam_oslo/mo_sim_dat.F90 b/src/chemistry/pp_trop_mam_oslo/mo_sim_dat.F90
new file mode 100644
index 0000000000..ff81ecfc5d
--- /dev/null
+++ b/src/chemistry/pp_trop_mam_oslo/mo_sim_dat.F90
@@ -0,0 +1,132 @@
+
+ module mo_sim_dat
+
+ private
+ public :: set_sim_dat
+
+ contains
+
+ subroutine set_sim_dat
+
+ use chem_mods, only : clscnt, cls_rxt_cnt, clsmap, permute, adv_mass, fix_mass, crb_mass
+ use chem_mods, only : diag_map
+ use chem_mods, only : phtcnt, rxt_tag_cnt, rxt_tag_lst, rxt_tag_map
+ use chem_mods, only : pht_alias_lst, pht_alias_mult
+ use chem_mods, only : extfrc_lst, inv_lst, slvd_lst
+ use chem_mods, only : enthalpy_cnt, cph_enthalpy, cph_rid, num_rnts, rxntot
+ use cam_abortutils,only : endrun
+ use mo_tracname, only : solsym
+ use chem_mods, only : frc_from_dataset
+ use chem_mods, only : is_scalar, is_vector
+ use shr_kind_mod, only : r8 => shr_kind_r8
+ use cam_logfile, only : iulog
+
+ implicit none
+
+!--------------------------------------------------------------
+! ... local variables
+!--------------------------------------------------------------
+ integer :: ios
+
+ is_scalar = .true.
+ is_vector = .false.
+
+ clscnt(:) = (/ 0, 0, 0, 30, 0 /)
+
+ cls_rxt_cnt(:,4) = (/ 1, 12, 0, 30 /)
+
+ solsym(: 30) = (/ 'SO2 ','H2SO4 ','DMS ','H2O2 ','SO4_NA ', &
+ 'SO4_A1 ','SO4_A2 ','SO4_AC ','SO4_PR ','BC_N ', &
+ 'BC_AX ','BC_NI ','BC_A ','BC_AI ','BC_AC ', &
+ 'OM_NI ','OM_AI ','OM_AC ','DST_A2 ','DST_A3 ', &
+ 'SS_A1 ','SS_A2 ','SS_A3 ','SOA_NA ','SOA_A1 ', &
+ 'SOA_LV ','SOA_SV ','monoterp ','isoprene ','H2O ' /)
+
+ adv_mass(: 30) = (/ 64.064800_r8, 98.078400_r8, 62.132400_r8, 34.013600_r8, 98.078400_r8, &
+ 98.078400_r8, 115.107340_r8, 98.078400_r8, 98.078400_r8, 12.011000_r8, &
+ 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, &
+ 12.011000_r8, 12.011000_r8, 12.011000_r8, 135.064039_r8, 135.064039_r8, &
+ 58.442468_r8, 58.442468_r8, 58.442468_r8, 168.227200_r8, 168.227200_r8, &
+ 168.227200_r8, 168.227200_r8, 136.228400_r8, 68.114200_r8, 18.014200_r8 /)
+
+ crb_mass(: 30) = (/ 0.000000_r8, 0.000000_r8, 24.022000_r8, 0.000000_r8, 0.000000_r8, &
+ 0.000000_r8, 0.000000_r8, 0.000000_r8, 0.000000_r8, 12.011000_r8, &
+ 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, 12.011000_r8, &
+ 12.011000_r8, 12.011000_r8, 12.011000_r8, 0.000000_r8, 0.000000_r8, &
+ 0.000000_r8, 0.000000_r8, 0.000000_r8, 120.110000_r8, 120.110000_r8, &
+ 120.110000_r8, 120.110000_r8, 120.110000_r8, 60.055000_r8, 0.000000_r8 /)
+
+ fix_mass(: 7) = (/ 0.00000000_r8, 28.0134800_r8, 31.9988000_r8, 47.9982000_r8, 17.0068000_r8, &
+ 62.0049400_r8, 33.0062000_r8 /)
+
+ clsmap(: 30,4) = (/ 3, 1, 4, 5, 6, 7, 8, 9, 10, 11, &
+ 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, &
+ 22, 23, 2, 24, 25, 26, 27, 28, 29, 30 /)
+
+ permute(: 30,4) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, &
+ 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, &
+ 21, 22, 23, 24, 25, 26, 27, 28, 29, 30 /)
+
+ diag_map(: 30) = (/ 1, 5, 7, 9, 10, 11, 12, 13, 14, 15, &
+ 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, &
+ 26, 27, 28, 29, 30, 31, 32, 35, 37, 38 /)
+
+ extfrc_lst(: 7) = (/ 'SO2 ','BC_NI ','BC_AX ','BC_N ','OM_NI ', &
+ 'SO4_PR ','H2O ' /)
+
+ frc_from_dataset(: 7) = (/ .true., .true., .true., .true., .true., &
+ .true., .true. /)
+
+ inv_lst(: 7) = (/ 'M ', 'N2 ', 'O2 ', 'O3 ', 'OH ', &
+ 'NO3 ', 'HO2 ' /)
+
+ if( allocated( rxt_tag_lst ) ) then
+ deallocate( rxt_tag_lst )
+ end if
+ allocate( rxt_tag_lst(rxt_tag_cnt),stat=ios )
+ if( ios /= 0 ) then
+ write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_lst; error = ',ios
+ call endrun
+ end if
+ if( allocated( rxt_tag_map ) ) then
+ deallocate( rxt_tag_map )
+ end if
+ allocate( rxt_tag_map(rxt_tag_cnt),stat=ios )
+ if( ios /= 0 ) then
+ write(iulog,*) 'set_sim_dat: failed to allocate rxt_tag_map; error = ',ios
+ call endrun
+ end if
+ rxt_tag_lst( 1: 3) = (/ 'jh2o2 ', 'usr_HO2_HO2 ', &
+ 'usr_DMS_OH ' /)
+ rxt_tag_map(:rxt_tag_cnt) = (/ 1, 2, 7 /)
+ if( allocated( pht_alias_lst ) ) then
+ deallocate( pht_alias_lst )
+ end if
+ allocate( pht_alias_lst(phtcnt,2),stat=ios )
+ if( ios /= 0 ) then
+ write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_lst; error = ',ios
+ call endrun
+ end if
+ if( allocated( pht_alias_mult ) ) then
+ deallocate( pht_alias_mult )
+ end if
+ allocate( pht_alias_mult(phtcnt,2),stat=ios )
+ if( ios /= 0 ) then
+ write(iulog,*) 'set_sim_dat: failed to allocate pht_alias_mult; error = ',ios
+ call endrun
+ end if
+ pht_alias_lst(:,1) = (/ ' ' /)
+ pht_alias_lst(:,2) = (/ ' ' /)
+ pht_alias_mult(:,1) = (/ 1._r8 /)
+ pht_alias_mult(:,2) = (/ 1._r8 /)
+ allocate( num_rnts(rxntot-phtcnt),stat=ios )
+ if( ios /= 0 ) then
+ write(iulog,*) 'set_sim_dat: failed to allocate num_rnts; error = ',ios
+ call endrun
+ end if
+ num_rnts(:) = (/ 2, 2, 2, 2, 3, 2, 2, 2, 2, 2, &
+ 2, 2 /)
+
+ end subroutine set_sim_dat
+
+ end module mo_sim_dat
diff --git a/src/chemistry/utils/prescribed_volcaero.F90 b/src/chemistry/utils/prescribed_volcaero.F90
index 092310a7b9..a8792c7a4d 100644
--- a/src/chemistry/utils/prescribed_volcaero.F90
+++ b/src/chemistry/utils/prescribed_volcaero.F90
@@ -24,6 +24,7 @@ module prescribed_volcaero
public :: write_prescribed_volcaero_restart
public :: read_prescribed_volcaero_restart
public :: has_prescribed_volcaero
+ public :: has_prescribed_volcaero_cmip6,solar_bands,terrestrial_bands
public :: init_prescribed_volcaero_restart
@@ -45,6 +46,11 @@ module prescribed_volcaero
integer :: fixed_tod = 0
integer :: radius_ndx
+ ! CMIP6 extension
+ logical, save :: has_prescribed_volcaero_cmip6 = .false.
+ integer, parameter :: solar_bands=14, terrestrial_bands=16
+ character(len=256) :: locfn
+
contains
!-------------------------------------------------------------------
@@ -54,6 +60,10 @@ subroutine prescribed_volcaero_readnl(nlfile)
use namelist_utils, only: find_group_name
use units, only: getunit, freeunit
use mpishorthand
+ ! CMIP6
+ use cam_pio_utils, only : cam_pio_openfile, init_pio_subsystem
+ use pio, only : pio_inquire, file_desc_t, pio_inq_dimname
+ use pio, only : pio_nowrite, pio_closefile, pio_noerr
character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
@@ -61,6 +71,11 @@ subroutine prescribed_volcaero_readnl(nlfile)
integer :: unitn, ierr
character(len=*), parameter :: subname = 'prescribed_volcaero_readnl'
+ ! CMIP6
+ integer :: dimid,ndims
+ type(file_desc_t) :: ncid
+ character(len=80) :: dimname
+
character(len=16) :: prescribed_volcaero_name
character(len=256) :: prescribed_volcaero_file
character(len=256) :: prescribed_volcaero_filelist
@@ -136,6 +151,28 @@ subroutine prescribed_volcaero_readnl(nlfile)
! Turn on prescribed volcanics if user has specified an input dataset.
if (len_trim(filename) > 0 .and. filename.ne.'NONE') has_prescribed_volcaero = .true.
+ ! Check if input file contains CMIP6 forcing
+ if (has_prescribed_volcaero) then
+ if (len_trim(datapath) > 0 ) then
+ locfn=trim(datapath)//'/'//trim(filename)
+ else
+ locfn=trim(filename)
+ endif
+ call init_pio_subsystem
+ call cam_pio_openfile(ncid,locfn,PIO_NOWRITE)
+ ierr = pio_inquire(ncid,ndimensions=ndims)
+ do dimid=1,ndims
+ ierr = pio_inq_dimname(ncid,dimid,dimname)
+ ! assume CMIP6 if vertical coordinate is altitude
+ if ( trim(dimname) == 'altitude' ) then
+ has_prescribed_volcaero = .false.
+ has_prescribed_volcaero_cmip6 = .true.
+ endif
+ enddo
+ call pio_closefile(ncid)
+ endif
+
+
end subroutine prescribed_volcaero_readnl
!-------------------------------------------------------------------
@@ -146,12 +183,32 @@ subroutine prescribed_volcaero_register()
integer :: idx
+ ! CMIP6
+ integer :: band
+ character(len=3) :: c3
+
if (has_prescribed_volcaero) then
call pbuf_add_field(volcaero_name,'physpkg',dtype_r8,(/pcols,pver/),idx)
call pbuf_add_field(volcrad_name, 'physpkg',dtype_r8,(/pcols,pver/),idx)
endif
+ ! CMIP6
+ if (has_prescribed_volcaero_cmip6) then
+ do band=1,solar_bands
+ write(c3,'(i3)') band
+ call pbuf_add_field('ext_sun'//trim(adjustl(c3)),'physpkg',dtype_r8,(/pcols,pver/),idx)
+ call pbuf_add_field('omega_sun'//trim(adjustl(c3)),'physpkg',dtype_r8,(/pcols,pver/),idx)
+ call pbuf_add_field('g_sun'//trim(adjustl(c3)),'physpkg',dtype_r8,(/pcols,pver/),idx)
+ enddo
+ do band=1,terrestrial_bands
+ write(c3,'(i3)') band
+ call pbuf_add_field('ext_earth'//trim(adjustl(c3)),'physpkg',dtype_r8,(/pcols,pver/),idx)
+ call pbuf_add_field('omega_earth'//trim(adjustl(c3)),'physpkg',dtype_r8,(/pcols,pver/),idx)
+ call pbuf_add_field('g_earth'//trim(adjustl(c3)),'physpkg',dtype_r8,(/pcols,pver/),idx)
+ enddo
+ endif
+
endsubroutine prescribed_volcaero_register
!-------------------------------------------------------------------
@@ -160,15 +217,24 @@ subroutine prescribed_volcaero_init()
use tracer_data, only : trcdata_init
use cam_history, only : addfld, horiz_only
- use physics_buffer, only : pbuf_get_index
+ use ppgrid, only : pver
+ use error_messages, only: handle_err
+ use ppgrid, only: pcols, pver, begchunk, endchunk
+
+ use physics_buffer, only : physics_buffer_desc, pbuf_get_index
implicit none
integer :: ndx, istat
integer :: errcode
character(len=32) :: specifier(1)
+
+ ! CMIP6
+ integer :: band
+ character(len=3) :: c3
+ character(len=32) :: specifier_cmip6(3*(solar_bands+terrestrial_bands))
- if ( has_prescribed_volcaero ) then
+ if ( has_prescribed_volcaero .or. has_prescribed_volcaero_cmip6 ) then
if ( masterproc ) then
write(iulog,*) 'volcanic aerosol is prescribed in :'//trim(filename)
endif
@@ -176,6 +242,9 @@ subroutine prescribed_volcaero_init()
return
endif
+ ! not CMIP6
+ if ( has_prescribed_volcaero ) then
+
specifier(1) = trim(volcaero_name)//':'//trim(fld_name)
@@ -192,6 +261,35 @@ subroutine prescribed_volcaero_init()
radius_ndx = pbuf_get_index(volcrad_name, errcode)
+ ! CMIP6
+ else
+
+ do band=1,solar_bands
+ write(c3,'(i3)') band
+ specifier_cmip6(band*3-2) = 'ext_sun'//trim(adjustl(c3))//':'//'ext_sun'//trim(adjustl(c3))
+ specifier_cmip6(band*3-1) = 'omega_sun'//trim(adjustl(c3))//':'//'omega_sun'//trim(adjustl(c3))
+ specifier_cmip6(band*3-0) = 'g_sun'//trim(adjustl(c3))//':'//'g_sun'//trim(adjustl(c3))
+ call addfld('ext_sun'//trim(adjustl(c3)),(/ 'lev' /), 'I', '1/km', 'Extinction coefficient of solar bands' )
+ call addfld('omega_sun'//trim(adjustl(c3)),(/ 'lev' /), 'I', '1', 'Single scattering albedo of solar bands' )
+ call addfld('g_sun'//trim(adjustl(c3)),(/ 'lev' /), 'I', '1', 'Asymmetry factor of solar bands' )
+ enddo
+ do band=1,terrestrial_bands
+ write(c3,'(i3)') band
+ specifier_cmip6((solar_bands+band)*3-2) = 'ext_earth'//trim(adjustl(c3))//':'//'ext_earth'//trim(adjustl(c3))
+ specifier_cmip6((solar_bands+band)*3-1) = 'omega_earth'//trim(adjustl(c3))//':'//'omega_earth'//trim(adjustl(c3))
+ specifier_cmip6((solar_bands+band)*3-0) = 'g_earth'//trim(adjustl(c3))//':'//'g_earth'//trim(adjustl(c3))
+ call addfld('ext_earth'//trim(adjustl(c3)),(/ 'lev' /), 'I', '1/km', 'Extinction coefficient of terrestrial bands' )
+ call addfld('omega_earth'//trim(adjustl(c3)),(/ 'lev' /), 'I', '1', 'Single scattering albedo of terrestrial bands' )
+ call addfld('g_earth'//trim(adjustl(c3)),(/ 'lev' /), 'I', '1', 'Asymmetry factor of terrestrial bands' )
+ enddo
+
+ allocate(file%in_pbuf(size(specifier_cmip6)))
+ file%in_pbuf(:) = .true.
+ call trcdata_init( specifier_cmip6, filename, filelist, datapath, fields, file, &
+ rmv_file, cycle_yr, fixed_ymd, fixed_tod, data_type)
+
+ endif
+
end subroutine prescribed_volcaero_init
!-------------------------------------------------------------------
@@ -235,10 +333,17 @@ subroutine prescribed_volcaero_adv( state, pbuf2d)
!WACCM-derived relation between mass concentration and wet aerosol radius in meters
real(r8),parameter :: radius_conversion = 1.9e-4_r8
- if( .not. has_prescribed_volcaero ) return
+ ! CMIP6
+ integer :: band
+ character(len=3) :: c3
+
+ if ( .not. (has_prescribed_volcaero .or. has_prescribed_volcaero_cmip6) ) return
call advance_trcdata( fields, file, state, pbuf2d )
+ ! not CMIP6
+ if ( has_prescribed_volcaero ) then
+
! copy prescribed tracer fields into state svariable with the correct units
do c = begchunk,endchunk
pbuf_chnk => pbuf_get_chunk(pbuf2d, c)
@@ -285,6 +390,65 @@ subroutine prescribed_volcaero_adv( state, pbuf2d)
enddo
+ ! CMIP6
+ else
+
+ do c = begchunk,endchunk
+ pbuf_chnk => pbuf_get_chunk(pbuf2d, c)
+ call tropopause_find(state(c), tropLev, primary=TROP_ALG_TWMO, backup=TROP_ALG_CLIMATE)
+ ncol = state(c)%ncol
+ do band=1,solar_bands
+ write(c3,'(i3)') band
+ call pbuf_get_field(pbuf_chnk, fields(band*3-2)%pbuf_ndx, data)
+ do i = 1,ncol
+ do k = 1,pver
+ if ( k >= tropLev(i) ) data(i,k) = 0._r8
+ enddo
+ enddo
+ call outfld('ext_sun'//trim(adjustl(c3)),data(:,:), pcols, state(c)%lchnk)
+ call pbuf_get_field(pbuf_chnk, fields(band*3-1)%pbuf_ndx, data)
+ do i = 1,ncol
+ do k = 1,pver
+ if ( k >= tropLev(i) ) data(i,k) = 0.999_r8
+ enddo
+ enddo
+ call outfld('omega_sun'//trim(adjustl(c3)),data(:,:), pcols, state(c)%lchnk)
+ call pbuf_get_field(pbuf_chnk, fields(band*3-0)%pbuf_ndx, data)
+ do i = 1,ncol
+ do k = 1,pver
+ if ( k >= tropLev(i) ) data(i,k) = 0.5_r8
+ enddo
+ enddo
+ call outfld('g_sun'//trim(adjustl(c3)),data(:,:), pcols, state(c)%lchnk)
+ enddo
+ do band=1,terrestrial_bands
+ write(c3,'(i3)') band
+ call pbuf_get_field(pbuf_chnk, fields((solar_bands+band)*3-2)%pbuf_ndx, data)
+ do i = 1,ncol
+ do k = 1,pver
+ if ( k >= tropLev(i) ) data(i,k) = 0._r8
+ enddo
+ enddo
+ call outfld('ext_earth'//trim(adjustl(c3)),data(:,:), pcols, state(c)%lchnk)
+ call pbuf_get_field(pbuf_chnk, fields((solar_bands+band)*3-1)%pbuf_ndx, data)
+ do i = 1,ncol
+ do k = 1,pver
+ if ( k >= tropLev(i) ) data(i,k) = 0.999_r8
+ enddo
+ enddo
+ call outfld('omega_earth'//trim(adjustl(c3)),data(:,:), pcols, state(c)%lchnk)
+ call pbuf_get_field(pbuf_chnk, fields((solar_bands+band)*3-0)%pbuf_ndx, data)
+ do i = 1,ncol
+ do k = 1,pver
+ if ( k >= tropLev(i) ) data(i,k) = 0.5_r8
+ enddo
+ enddo
+ call outfld('g_earth'//trim(adjustl(c3)),data(:,:), pcols, state(c)%lchnk)
+ enddo
+ enddo
+
+ endif
+
end subroutine prescribed_volcaero_adv
!-------------------------------------------------------------------
diff --git a/src/control/cam_history.F90 b/src/control/cam_history.F90
index 0f08e35904..465d51e1d3 100644
--- a/src/control/cam_history.F90
+++ b/src/control/cam_history.F90
@@ -2215,6 +2215,8 @@ subroutine fldlst ()
! on that grid.
integer, allocatable :: gridsontape(:,:)
+ logical, parameter :: i_am_a_nazi_arse=.false. !+tht if T exit on error
+
!
! First ensure contents of fincl, fexcl, and fwrtpr are all valid names
!
@@ -2232,9 +2234,12 @@ subroutine fldlst ()
write(iulog,*) trim(errormsg)
call shr_sys_flush(iulog)
end if
+ fincl(f:pflds-1,t)=fincl(f+1:pflds,t)
+ fincl(pflds,t)=' '
errors_found = errors_found + 1
+ else
+ f = f + 1
end if
- f = f + 1
end do
f = 1
@@ -2242,16 +2247,18 @@ subroutine fldlst ()
mastername=''
listentry => get_entry_by_name(masterlinkedlist, fexcl(f,t))
if(associated(listentry)) mastername = listentry%field%name
-
if (fexcl(f,t) /= mastername) then
write(errormsg,'(3a,2(i0,a))')'FLDLST: ', trim(fexcl(f,t)), ' in fexcl(', f,', ',t, ') not found'
if (masterproc) then
write(iulog,*) trim(errormsg)
call shr_sys_flush(iulog)
end if
+ fexcl(f:pflds-1,t)=fexcl(f+1:pflds,t)
+ fexcl(pflds,t)=' '
errors_found = errors_found + 1
+ else
+ f = f + 1
end if
- f = f + 1
end do
f = 1
@@ -2286,7 +2293,7 @@ subroutine fldlst ()
! Give masterproc a chance to write all the log messages
call mpi_barrier(mpicom, t)
write(errormsg, '(a,i0,a)') 'FLDLST: ',errors_found,' errors found, see log'
- call endrun(trim(errormsg))
+ if (i_am_a_nazi_arse) call endrun(trim(errormsg))
end if
nflds(:) = 0
diff --git a/src/control/ncdio_atm.F90 b/src/control/ncdio_atm.F90
index 7f1e3364c4..619d9b5b61 100644
--- a/src/control/ncdio_atm.F90
+++ b/src/control/ncdio_atm.F90
@@ -207,6 +207,7 @@ subroutine infld_real_1d_2d(varname, ncid, dimname1, &
else
call pio_setframe(ncid, varid, int(1,kind=pio_offset_kind))
end if
+ ndims = ndims - 1
end if
! NB: strt and cnt were initialized to 1
@@ -625,6 +626,7 @@ subroutine infld_real_2d_3d(varname, ncid, dimname1, dimname2, &
else
call pio_setframe(ncid, varid, int(1,kind=pio_offset_kind))
end if
+ ndims = ndims - 1
end if
field_dnames(1) = dimname1
diff --git a/src/control/runtime_opts.F90 b/src/control/runtime_opts.F90
index f390d45744..53b36d061f 100644
--- a/src/control/runtime_opts.F90
+++ b/src/control/runtime_opts.F90
@@ -38,6 +38,9 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon)
use physconst, only: physconst_readnl
use physics_buffer, only: pbuf_readnl
use phys_control, only: phys_ctl_readnl
+#ifdef OSLO_AERO
+ use oslo_control, only: oslo_ctl_readnl
+#endif
use wv_saturation, only: wv_sat_readnl
use ref_pres, only: ref_pres_readnl
use cam3_aero_data, only: cam3_aero_data_readnl
@@ -179,6 +182,9 @@ subroutine read_namelist(nlfilename, single_column, scmlat, scmlon)
call rayleigh_friction_readnl(nlfilename)
#if ( defined OFFLINE_DYN )
call metdata_readnl(nlfilename)
+#endif
+#if (defined OSLO_AERO)
+ call oslo_ctl_readnl(nlfilename)
#endif
call offline_driver_readnl(nlfilename)
call analytic_ic_readnl(nlfilename)
diff --git a/src/dynamics/fv/cd_core.F90 b/src/dynamics/fv/cd_core.F90
index e679a1d144..de71ae6450 100644
--- a/src/dynamics/fv/cd_core.F90
+++ b/src/dynamics/fv/cd_core.F90
@@ -12,7 +12,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
mlt, ncx, ncy, nmfx, nmfy, iremote, &
cxtag, cytag, mfxtag, mfytag, &
cxreqs, cyreqs, mfxreqs, mfyreqs, &
- kmtp, am_correction, am_fixer, dod, don ,high_order_top)
+ kmtp, am_correction, am_geom_crrct, am_fixer, dod, don ,high_order_top)
! Dynamical core for both C- and D-grid Lagrangian dynamics
!
@@ -82,6 +82,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
real(r8), intent(in) :: del2coef
integer, intent(in) :: kmtp ! range of levels (1:kmtp) where order is reduced
logical, intent(in) :: am_correction ! logical switch for correction (applied here)
+ logical, intent(in) :: am_geom_crrct ! logical switch for correction (applied here)
logical, intent(in) :: am_fixer ! logical switch for fixer (generate out args)
logical, intent(in) :: high_order_top ! use uniform 4th order everywhere (incl. model top)
@@ -168,6 +169,11 @@ subroutine cd_core(grid, nx, u, v, pt, &
real(r8), intent(out) :: &
ptk(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast)
+!+diag 3/7/2017 local array
+ real(r8) :: &
+ ucc(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d,grid%kfirst:grid%klast) ! u-Winds correction
+!-diag
+
! C.-C. Chen, omega calculation
real(r8), intent(out) :: &
cx_om(grid%im,grid%jfirst:grid%jlast,grid%kfirst:grid%klast) ! Courant in X
@@ -229,7 +235,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
integer :: npes_yz
integer i, j, k, ml
- integer js1g1, js2g0, js2g1, jn2g1 ,js4g0,jn3g0
+ integer js1g1, js2g0, js2g1, jn2g1 ,js4g0 ,jn3g0
integer jn2g0, jn1g1
integer iord , jord
@@ -290,6 +296,12 @@ subroutine cd_core(grid, nx, u, v, pt, &
real(r8) :: ptr(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast+1)
logical :: sw_am_corr
+ logical :: am_press_crrct !+tht 11.05.2019
+ real(r8):: wg_hiord !+tht 11.05.2019
+
+!+tht 12.10.2017
+ real(r8) tpr, acap
+!-tht 12.10.2017
!******************************************************************
!******************************************************************
@@ -371,6 +383,15 @@ subroutine cd_core(grid, nx, u, v, pt, &
endif
#endif
+!+tht 11.05.2019
+ am_press_crrct = am_geom_crrct.and.am_correction
+ if (am_press_crrct) then
+ wg_hiord =-D1_0
+ else
+ wg_hiord = D0_0
+ endif
+!-tht 11.05.2019
+
npes_yz = grid%npes_yz
im = grid%im
@@ -399,14 +420,25 @@ subroutine cd_core(grid, nx, u, v, pt, &
kelp(grid%im,grid%jfirst-1:grid%jlast ,grid%kfirst:grid%klast ), &
dpn(grid%im,grid%jfirst :grid%jlast ,grid%kfirst:grid%klast ), &
dpo(grid%im,grid%jfirst :grid%jlast ,grid%kfirst:grid%klast ) )
+!+tht 12/04/2019
+! define polar cap contributions correctly
+ acap=1._r8/4._r8 ! effective AM/MoI contribution from polar caps
+!-tht 12/04/2019
+ endif
+ if (am_press_crrct) then
+ allocate( &
+ dpr(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast ) )
+ xakap = 1._r8/cap3vc(1,jfirst,kfirst)
endif
if (am_correction) then
allocate( &
- dpr(grid%im,grid%jfirst-1:grid%jlast+1,grid%kfirst:grid%klast ), &
ddpu(grid%im,grid%jfirst :grid%jlast ,grid%kfirst:grid%klast ), &
dpns(grid%jfirst:grid%jlast,grid%kfirst:grid%klast), &
ddus(grid%jfirst:grid%jlast,grid%kfirst:grid%klast) )
- xakap = 1._r8/cap3vc(1,jfirst,kfirst)
+!+tht 04.07.2017
+ ddus = 0._r8
+ ucc = 0._r8
+!-tht 04.07.2017
else
xakap = 1._r8
endif
@@ -454,6 +486,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
jn2g0 = min(jm-1,jlast)
jn1g1 = min(jm,jlast+1)
jn2g1 = min(jm-1,jlast+1)
+
js4g0 = max(4,jfirst)
jn3g0 = min(jm-2,jlast)
@@ -732,7 +765,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
ua(1,jfirst-ng_d,k), va(1,jfirst-ng_s,k), &
uc(1,jfirst-ng_d,k), vc(1,jfirst-2,k), &
u_cen(1,jfirst-ng_d,k), v_cen(1,jfirst-ng_s,k), &
- reset_winds, met_rlx(k), am_correction)
+ reset_winds, met_rlx(k), am_geom_crrct)
! Optionally filter advecting C-grid winds
if (filtcw .gt. 0) then
@@ -780,7 +813,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
ua(1,jfirst-ng_d,k), va(1,jfirst-ng_s,k), &
uc(1,jfirst-ng_d,k), vc(1,jfirst-2,k), &
ptc(1,jfirst,k), delpf(1,jfirst-ng_d,k), &
- ptk(1,jfirst,k), tiny, iord, jord, am_correction)
+ ptk(1,jfirst,k), tiny, iord, jord, am_geom_crrct)
end do
call FVstopclock(grid,'---C_CORE')
@@ -1044,7 +1077,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
do k = kfirst, klast
do j = js2g0, jn2g0
- if (am_correction) then
+ if (am_press_crrct) then
do i = 1, im
! AM fix: ensure interior pressure torque vanishes
@@ -1125,7 +1158,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
call FVstartclock(grid,'---C_V_PGRAD')
- if (am_correction) then
+ if (am_press_crrct) then
!$omp parallel do private(i, j, k)
! AM correction (pressure, advective winds): pxc -> ptr
do k = kfirst, klast+1
@@ -1308,8 +1341,20 @@ subroutine cd_core(grid, nx, u, v, pt, &
dpo(i,j,k)=(kelp(i,j,k)*cosp(j)+kelp(i,j-1,k)*cosp(j-1))/(cosp(j)+cosp(j-1)) ! A->D
end do
end do
+ if (jfirst.eq.1) then
+ do i = 1, im
+ dpn(i, 2,k)=(help(i, 2 ,k)*cosp( 2 )+acap*help(i, 1,k)*cose( 2))/cosp( 2 )
+ dpo(i, 2,k)=(kelp(i, 2 ,k)*cosp( 2 )+acap*kelp(i, 1,k)*cose( 2))/cosp( 2 )
+ end do
+ endif
+ if (jlast.eq.jm) then
+ do i = 1, im
+ dpn(i,jm,k)=(help(i,jm-1,k)*cosp(jm-1)+acap*help(i,jm,k)*cose(jm))/cosp(jm-1)
+ dpo(i,jm,k)=(kelp(i,jm-1,k)*cosp(jm-1)+acap*kelp(i,jm,k)*cose(jm))/cosp(jm-1)
+ end do
+ endif
end do
-
+
if (am_correction) then
!$omp parallel do private(i, j, k)
do k = kfirst, klast
@@ -1324,7 +1369,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
do k = kfirst, klast
do j = js2g0, jlast
do i = 1, im
- ddu(i,j,k)=ddu(i,j,k)* D0_5*(dpo(i,j,k)+dpn(i,j,k)*3._r8)*D0_5
+ ddu(i,j,k)=ddu(i,j,k)* D0_5*(dpo(i,j,k)+dpn(i,j,k) ) ! new 05/03/2019
end do
end do
end do
@@ -1332,15 +1377,23 @@ subroutine cd_core(grid, nx, u, v, pt, &
!$omp parallel do private(i, j, k)
do k = kfirst, klast
do j = js2g0, jlast
- ddus(j,k) = ddu(1,j,k) + (u(1,j,k) + uc(1,j,k)/D4_0)*ddpu(1,j,k) - &
- vf(1,j,k)*(dpn(1,j,k) - dpo(1,j,k))*D0_5
+ ddus(j,k) = ddu(1,j,k) &
+ + (u(1,j,k) + uc(1,j,k)*D0_5)*ddpu(1,j,k) & ! new 05/03/2019
+ + wg_hiord*vf(1,j,k)*(dpn(1,j,k) - dpo(1,j,k))*D0_5
dpns(j,k) = dpn(1,j,k)
do i = 2, im
- ddus(j,k) = ddus(j,k) + ddu(i,j,k) +(u(i,j,k)+uc(i,j,k)/D4_0)*ddpu(i,j,k) - &
- vf(i,j,k)*(dpn(i,j,k)-dpo(i,j,k))*D0_5
+ ddus(j,k) = ddus(j,k) &
+ + ddu(i,j,k) &
+ + (u(i,j,k)+uc(i,j,k)*D0_5)*ddpu(i,j,k) & ! new 05/03/2019
+ + wg_hiord*vf(i,j,k)*(dpn(i,j,k)-dpo(i,j,k))*D0_5
dpns(j,k) = dpns(j,k) + dpn(i,j,k)
end do
ddus(j,k) = ddus(j,k)/dpns(j,k)
+!+tht 12.10.2017 taper beyond 72S/N
+ tpr = max(abs(-2.5_r8 + ((j-1)-0.5_r8)*(5._r8/(jm-1))),2._r8)
+ tpr = cos(pi*tpr)**2
+ ddus(j,k)=ddus(j,k)*tpr
+!-tht 12.10.2017
end do
end do
@@ -1349,6 +1402,9 @@ subroutine cd_core(grid, nx, u, v, pt, &
do j = js4g0, jn3g0
do i = 1, im !+++++++++++++++++++++++++++++++++++++++++++++
uc(i,j,k) = uc(i,j,k) + ddus(j,k) ! APPLY AM CORRECTION
+!+tht correction diagnostic
+ ucc(i,j,k)= ddus(j,k)
+!-tht
enddo !+++++++++++++++++++++++++++++++++++++++++++++
enddo
enddo
@@ -1356,26 +1412,40 @@ subroutine cd_core(grid, nx, u, v, pt, &
end if ! (am_correction)
if (am_fixer) then
-
+ if (.not.am_geom_crrct) then
+!$omp parallel do private(i, j, k)
+ do k = kfirst, klast
+ do j = js2g0, jlast
+ do i = 1, im
+ dpn(i,j,k)=(help(i,j,k) +help(i,j-1,k) )/( 2._r8 )
+ dpo(i,j,k)=(kelp(i,j,k) +kelp(i,j-1,k) )/( 2._r8 )
+ end do
+ end do
+ if (jfirst.eq.1) then
+ do i = 1, im
+ dpn(i, 2,k)=(help(i, 2 ,k) + help(i, 1,k) )/( 2._r8 )
+ dpo(i, 2,k)=(kelp(i, 2 ,k) + kelp(i, 1,k) )/( 2._r8 )
+ end do
+ endif
+ if (jlast.eq.jm) then
+ do i = 1, im
+ dpn(i,jm,k)=(help(i,jm-1,k) + help(i,jm,k) )/( 2._r8 )
+ dpo(i,jm,k)=(kelp(i,jm-1,k) + kelp(i,jm,k) )/( 2._r8 )
+ end do
+ endif
+ end do
+ endif
!$omp parallel do private(i, j, k)
do k = kfirst, klast
do j = js2g0, jlast
do i = 1, im
don(j,k) = don(j,k) + (cosp(j) + cosp(j-1))*cose(j) &
*(uc(i,j,k)*dpn(i,j,k) &
- + (u(i,j,k) + cose(j)*oma)*(dpn(i,j,k) - dpo(i,j,k)))
+ +(u(i,j,k) + cose(j)*oma)*(dpn(i,j,k)-dpo(i,j,k)))
dod(j,k) = dod(j,k) + (cosp(j) + cosp(j-1))*cose(j)**2*dpn(i,j,k)
end do
end do
-
- ! north pole
- if (jfirst == 1) then
- do i = 1, im
- dod(1,k) = dod(1,k) + grid%acap/(D0_5*im)*cose(1)**2*help(i,1,k)
- end do
- end if
end do
-
end if ! (am_fixer)
call FVstopclock(grid,'---dp4corr_COMM_2')
@@ -1683,8 +1753,8 @@ subroutine cd_core(grid, nx, u, v, pt, &
end if
call FVstopclock(grid,'---PRE_D_PGRAD_COMM_1')
#endif
-
- if (am_correction) then
+
+ if (am_press_crrct) then
! AM correction (pressure, prognostic winds): pkc -> ptr
!$omp parallel do private(i, j, k)
do k = kfirst, klast+1
@@ -1705,7 +1775,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
end do
endif
- if (am_correction) then
+ if (am_press_crrct) then
!$omp parallel do private(i, j, k)
! Beware k+1 references directly below (AAM)
do k = kfirst, klast
@@ -1758,7 +1828,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
cycle
end if
- if (am_correction) then
+ if (am_press_crrct) then
do j=js2g1,jn2g0 ! wk3 needed S
wk3(1,j) = (wz(1,j,k)+wz(im,j,k)) * &
(ptr(1,j,k) - ptr(im,j,k))
@@ -1808,7 +1878,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
! N-S walls
do j=js2g0,jn1g1 ! wk1 needed N
- if (am_correction) then
+ if (am_press_crrct) then
do i=1,im
wk1(i,j) = (wz(i,j,k) + wz(i,j-1,k))*(ptr(i,j,k) - ptr(i,j-1,k))
enddo
@@ -1846,7 +1916,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
enddo
enddo
- if (am_correction) then
+ if (am_press_crrct) then
! use true pressure for wk1, then update it
do j = js1g1, jn1g1
@@ -1873,7 +1943,7 @@ subroutine cd_core(grid, nx, u, v, pt, &
!$omp parallel do private(i, j, k, wk, wk1, wk2, wk3)
do k = kfirst, klast
- if (am_correction) then
+ if (am_press_crrct) then
do j = js1g1, jn1g1
wk1(1,j) = dpr(1,j,k) + dpr(im,j,k)
do i = 2, im
@@ -1913,7 +1983,16 @@ subroutine cd_core(grid, nx, u, v, pt, &
* (wk2(im,j)-wk2(1,j)+wz3(im,j,k+1)-wz3(im,j,k))
end do
- if (am_correction) then
+!+tht replace in output adv.tend. diag with correction diag 3/7/2017
+ !do j = js2g0, jlast
+ ! do i = 1, im-1
+ ! uc(i,j,k) = ucc(i,j,k)
+ ! end do
+ ! uc(im,j,k) = ucc(im,j,k)
+ !end do
+!-tht
+
+ if (am_geom_crrct) then
! apply cos-weighted avg'ing
do j = js2g0, jn2g0 ! Assumes wk2 ghosted on N
do i = 1, im
diff --git a/src/dynamics/fv/ctem.F90 b/src/dynamics/fv/ctem.F90
index 4d39bb6105..f036875f3e 100644
--- a/src/dynamics/fv/ctem.F90
+++ b/src/dynamics/fv/ctem.F90
@@ -57,7 +57,7 @@ subroutine ctem_diags( u3, v3, omga, pt, h2o, ps, pe, grid)
! ... local variables
!-------------------------------------------------------------
real(r8), parameter :: hscale = 7000._r8 ! pressure scale height
- real(r8), parameter :: navp = 1.e35_r8
+ real(r8), parameter :: navp = 1.e35_r8 !+tht use this only for T, missing winds are set to zero
real(r8) :: pinterp
real(r8) :: w(grid%ifirstxy:grid%ilastxy,plev,grid%jfirstxy:grid%jlastxy) ! vertical velocity
@@ -301,19 +301,24 @@ subroutine ctem_diags( u3, v3, omga, pt, h2o, ps, pe, grid)
do k = ip_b+1, plevp
if( has_zm(k,j) ) then
rdiv(k) = 1._r8/count( ip_gm1g(:,j) >= k )
+!+tht define zonal mean winds taking zero for below-ground value
+ u2d(k,j) = um(k) * rplon
+ v2d(k,j) = vm(k) * rplon
+ w2d(k,j) = wm(k) * rplon
+!-tht
um(k) = um(k) * rdiv(k)
vm(k) = vm(k) * rdiv(k)
wm(k) = wm(k) * rdiv(k)
thm(k) = thm(k) * rdiv(k)
- u2d(k,j) = um(k)
- v2d(k,j) = vm(k)
+ !u2d(k,j) = um(k) !+tht c'd out
+ !v2d(k,j) = vm(k) !+tht c'd out
th2d(k,j) = thm(k)
- w2d(k,j) = wm(k)
+ !w2d(k,j) = wm(k) !+tht c'd out
else
- u2d(k,j) = navp
- v2d(k,j) = navp
+ u2d(k,j) = 0._r8 ! navp
+ v2d(k,j) = 0._r8 ! navp
th2d(k,j) = navp
- w2d(k,j) = navp
+ w2d(k,j) = 0._r8 ! navp
end if
end do
@@ -411,10 +416,10 @@ subroutine ctem_diags( u3, v3, omga, pt, h2o, ps, pe, grid)
uw(k,j) = uw(k,j) * rdiv(k)
uv(k,j) = uv(k,j) * rdiv(k)
else
- vth(k,j) = navp
- wth(k,j) = navp
- uw(k,j) = navp
- uv(k,j) = navp
+ vth(k,j) = 0._r8 ! navp
+ wth(k,j) = 0._r8 ! navp
+ uw(k,j) = 0._r8 ! navp
+ uv(k,j) = 0._r8 ! navp
end if
end do
diff --git a/src/dynamics/fv/d2a3dikj.F90 b/src/dynamics/fv/d2a3dikj.F90
index fe3ffbb8c3..2ff9bbd748 100644
--- a/src/dynamics/fv/d2a3dikj.F90
+++ b/src/dynamics/fv/d2a3dikj.F90
@@ -14,7 +14,7 @@ module d2a3dikj_mod
!
! !INTERFACE:
- subroutine d2a3dikj(grid, am_correction, u, v, ua, va)
+ subroutine d2a3dikj(grid, am_geom_crrct, u, v, ua, va)
! !USES:
@@ -36,7 +36,7 @@ subroutine d2a3dikj(grid, am_correction, u, v, ua, va)
implicit none
! !INPUT PARAMETERS:
type (t_fvdycore_grid), intent(in) :: grid
- logical, intent(in) :: am_correction
+ logical, intent(in) :: am_geom_crrct
real(r8), intent(in) :: u(grid%ifirstxy:grid%ilastxy, &
grid%jfirstxy:grid%jlastxy,grid%km) ! U-Wind
real(r8), intent(in) :: v(grid%ifirstxy:grid%ilastxy, &
@@ -127,7 +127,7 @@ subroutine d2a3dikj(grid, am_correction, u, v, ua, va)
if ( jlastxy .lt. jm ) then
- if (am_correction) then
+ if (am_geom_crrct) then
!$omp parallel do private(i, k)
do k = 1, km
do i = ifirstxy, ilastxy
@@ -146,7 +146,7 @@ subroutine d2a3dikj(grid, am_correction, u, v, ua, va)
end if
#endif
- if (am_correction) then
+ if (am_geom_crrct) then
!$omp parallel do private(i,j,k)
do k = 1, km
do j = jfirstxy, jlastxy-1
diff --git a/src/dynamics/fv/dp_coupling.F90 b/src/dynamics/fv/dp_coupling.F90
index 61f2465308..031084bfa7 100644
--- a/src/dynamics/fv/dp_coupling.F90
+++ b/src/dynamics/fv/dp_coupling.F90
@@ -270,7 +270,7 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out)
allocate (v3(ifirstxy:ilastxy, km, jfirstxy:jlastxy))
if (iam .lt. grid%npes_xy) then
- call d2a3dikj(grid, dyn_state%am_correction, u3sxy, v3sxy, u3, v3)
+ call d2a3dikj(grid, dyn_state%am_geom_crrct, u3sxy, v3sxy, u3, v3)
end if ! (iam .lt. grid%npes_xy)
call t_stopf ('d2a3dikj')
@@ -303,9 +303,9 @@ subroutine d_p_coupling(grid, phys_state, phys_tend, pbuf2d, dyn_out)
if (iam .lt. grid%npes_xy) then
! (note dummy use of dva3 hence call order matters)
- call d2a3dikj(grid, dyn_state%am_correction,duf3sxy, dummy, duf3 ,dva3)
- call d2a3dikj(grid, dyn_state%am_correction,dua3sxy, dva3sxy, dua3, dva3)
- call d2a3dikj(grid, dyn_state%am_correction, du3sxy, dv3sxy, du3 , dv3 )
+ call d2a3dikj(grid, dyn_state%am_geom_crrct,duf3sxy, dummy, duf3 ,dva3)
+ call d2a3dikj(grid, dyn_state%am_geom_crrct,dua3sxy, dva3sxy, dua3, dva3)
+ call d2a3dikj(grid, dyn_state%am_geom_crrct, du3sxy, dv3sxy, du3 , dv3 )
end if ! (iam .lt. grid%npes_xy)
call t_startf('DP_CPLN_fv_am')
@@ -949,7 +949,7 @@ subroutine p_d_coupling(grid, phys_state, phys_tend, &
call t_startf('uv3s_update')
if (iam .lt. grid%npes_xy) then
call uv3s_update(grid, dudtxy, u3sxy, dvdtxy, v3sxy, dt5, &
- dyn_state%am_correction)
+ dyn_state%am_geom_crrct)
end if ! (iam .lt. grid%npes_xy)
call t_stopf('uv3s_update')
diff --git a/src/dynamics/fv/dyn_comp.F90 b/src/dynamics/fv/dyn_comp.F90
index a16f0672e0..a8a2e2fe88 100644
--- a/src/dynamics/fv/dyn_comp.F90
+++ b/src/dynamics/fv/dyn_comp.F90
@@ -183,15 +183,18 @@ subroutine dyn_readnl(nlfilename)
real(r8):: fv_del2coef = 3.e5_r8 ! strength of 2nd order velocity damping
logical :: fv_high_altitude = .false. ! switch to apply variables appropriate for high-altitude physics
- logical :: fv_am_correction = .false. ! apply correction for angular momentum (AM)
- ! conservation in SW eqns
- logical :: fv_am_fixer = .false. ! apply global fixer to conserve AM
- logical :: fv_am_fix_lbl = .false. ! apply global AM fixer level by level
- logical :: fv_am_diag = .false. ! turns on an AM diagnostic calculation written to log file
+ logical :: fv_high_order_top=.false.! do not degrade calculation to 1st order near the model top
+
+ logical :: fv_am_correction=.false. ! apply correction for angular momentum (AM) in SW eqns
+ logical :: fv_am_geom_crrct=.false. ! apply correction for angular momentum (AM) in geometry
+ logical :: fv_am_fixer =.false. ! apply global fixer to conserve AM
+ logical :: fv_am_fix_lbl =.false. ! apply global AM fixer level by level
+ logical :: fv_am_diag =.false. ! turns on an AM diagnostic calculation written to log file
namelist /dyn_fv_inparm/ fv_nsplit, fv_nspltrac, fv_nspltvrm, fv_iord, fv_jord, &
fv_kord, fv_conserve, fv_filtcw, fv_fft_flt, &
- fv_div24del2flag, fv_del2coef, fv_am_correction, &
+ fv_div24del2flag, fv_del2coef, fv_high_order_top, &
+ fv_am_correction, fv_am_geom_crrct, &
fv_am_fixer, fv_am_fix_lbl, fv_am_diag, fv_high_altitude, &
fv_print_dpcoup_warn
@@ -253,9 +256,15 @@ subroutine dyn_readnl(nlfilename)
call mpi_bcast(fv_del2coef, 1, mpi_real8, mstrid, mpicom, ierr)
if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_del2coef")
+ call mpi_bcast(fv_high_order_top, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_high_order_top")
+
call mpi_bcast(fv_am_correction, 1, mpi_logical, mstrid, mpicom, ierr)
if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_am_correction")
+ call mpi_bcast(fv_am_geom_crrct, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: fv_am_geom_crrct")
+
! if fv_am_fix_lbl is true then fv_am_fixer must also be true.
if (fv_am_fix_lbl .and. .not. fv_am_fixer) then
fv_am_fixer = .true.
@@ -326,7 +335,9 @@ subroutine dyn_readnl(nlfilename)
dyn_state%div24del2flag = fv_div24del2flag
dyn_state%del2coef = fv_del2coef
+ dyn_state%high_order_top= fv_high_order_top
dyn_state%am_correction = fv_am_correction
+ dyn_state%am_geom_crrct = fv_am_geom_crrct
dyn_state%am_fixer = fv_am_fixer
dyn_state%am_fix_lbl = fv_am_fix_lbl
dyn_state%am_diag = fv_am_diag
@@ -349,7 +360,8 @@ subroutine dyn_readnl(nlfilename)
write(iulog,*)' FFT filter (fv_fft_flt) = ', fv_fft_flt
write(iulog,*)' Divergence/velocity damping (fv_div24del2flag) = ', fv_div24del2flag
write(iulog,*)' Coef for 2nd order velocity damping (fv_del2coef) = ', fv_del2coef
- write(iulog,*)' '
+ write(iulog,*)' High-order top = ', fv_high_order_top
+ write(iulog,*)' Geometry & pressure corr. for AM (fv_am_geom_crrct) = ', fv_am_geom_crrct
write(iulog,*)' Angular momentum (AM) correction (fv_am_correction) = ', fv_am_correction
write(iulog,*)' Apply AM fixer (fv_am_fixer) = ', fv_am_fixer
write(iulog,*)' Level by level AM fixer (fv_am_fix_lbl) = ', fv_am_fix_lbl
@@ -1033,6 +1045,7 @@ subroutine dyn_run(ptop, ndt, te0, dyn_state, dyn_in, dyn_out, rc)
! angular momentum (AM) conservation
logical :: am_correction ! apply AM correction?
+ logical :: am_geom_crrct ! apply AM geom. corr?
logical :: am_fixer ! apply AM fixer?
logical :: am_fix_lbl ! apply fixer separately on each shallow-water layer?
logical :: am_fix_taper=.false. ! def. no tapering; modified if global fixer applied or high_order_top=.false.
@@ -1072,7 +1085,7 @@ subroutine dyn_run(ptop, ndt, te0, dyn_state, dyn_in, dyn_out, rc)
! NOTE -- model behaviour with high_order_top=true is still under validation and may require
! some other form of enhanced damping in the top layer
- logical, parameter :: high_order_top=.false.
+ logical :: high_order_top
!--------------------------------------------------------------------------------------
kmtp=dyn_state%grid%km/8
@@ -1118,7 +1131,9 @@ subroutine dyn_run(ptop, ndt, te0, dyn_state, dyn_in, dyn_out, rc)
high_alt = grid%high_alt
consv = dyn_state%consv
+ high_order_top= dyn_state%high_order_top
am_correction = dyn_state%am_correction
+ am_geom_crrct = dyn_state%am_geom_crrct
am_fixer = dyn_state%am_fixer
am_fix_lbl = dyn_state%am_fix_lbl
am_diag = dyn_state%am_diag
@@ -1856,7 +1871,7 @@ subroutine dyn_run(ptop, ndt, te0, dyn_state, dyn_in, dyn_out, rc)
cxtaga, cytaga, mfxtaga, mfytaga, cdcreqs(1,1), &
cdcreqs(1,2), cdcreqs(1,3), cdcreqs(1,4), &
kmtp, &
- am_correction, am_fix_out, dod, don ,high_order_top)
+ am_correction, am_geom_crrct, am_fix_out, dod, don ,high_order_top)
ctreqs(2,:) = cdcreqs(:,1)
ctreqs(3,:) = cdcreqs(:,2)
@@ -2620,7 +2635,7 @@ subroutine dyn_run(ptop, ndt, te0, dyn_state, dyn_in, dyn_out, rc)
phisxy, cp3v, cap3v, kord, pelnxy, &
te0, tempxy, dp0xy, mfxxy, mfyxy, &
uc_i, vc_i, du_fix_s, du_fix_i, &
- am_correction, (am_fixer.or.am_diag) )
+ am_geom_crrct, (am_fixer.or.am_diag) )
if (am_diag) then
!$omp parallel do private(i,j,k)
diff --git a/src/dynamics/fv/dyn_grid.F90 b/src/dynamics/fv/dyn_grid.F90
index eaf43e2d5e..722fd8e6fe 100644
--- a/src/dynamics/fv/dyn_grid.F90
+++ b/src/dynamics/fv/dyn_grid.F90
@@ -130,7 +130,7 @@ subroutine dyn_grid_init()
! Initialize FV specific grid object variables
dt = get_step_size()
call grid_vars_init(pi, rearth, omega, dt, state%fft_flt, &
- state%am_correction, grid)
+ state%am_geom_crrct, grid)
! initialize commap variables
diff --git a/src/dynamics/fv/dynamics_vars.F90 b/src/dynamics/fv/dynamics_vars.F90
index 3f66fb538a..dc07854fb7 100644
--- a/src/dynamics/fv/dynamics_vars.F90
+++ b/src/dynamics/fv/dynamics_vars.F90
@@ -295,6 +295,8 @@ module dynamics_vars
integer :: div24del2flag ! 2 for 2nd order div damping, 4 for 4th order div damping,
! 42 for 4th order div damping plus 2nd order velocity damping
real(r8) :: del2coef ! strength of 2nd order velocity damping
+ logical :: high_order_top! use normal 4-order PPM calculation near the model top
+ logical :: am_geom_crrct ! apply correction for angular momentum (AM) conservation in geometry
logical :: am_correction ! apply correction for angular momentum (AM) conservation in SW eqns
logical :: am_fixer ! apply global fixer to conserve AM
logical :: am_fix_lbl ! apply global AM fixer level by level
@@ -720,7 +722,7 @@ end subroutine spmd_vars_init
!========================================================================================
subroutine grid_vars_init(pi, ae, om, dt, fft_flt, &
- am_correction, grid)
+ am_geom_crrct, grid)
! Initialize FV specific GRID vars
!
@@ -739,7 +741,7 @@ subroutine grid_vars_init(pi, ae, om, dt, fft_flt, &
real(r8), intent(in) :: om ! angular velocity of earth's rotation
real(r8), intent(in) :: dt
integer, intent(in) :: fft_flt
- logical, intent(in) :: am_correction
+ logical, intent(in) :: am_geom_crrct
type( T_FVDYCORE_GRID ), intent(inout) :: grid
@@ -812,7 +814,7 @@ subroutine grid_vars_init(pi, ae, om, dt, fft_flt, &
! Define cosine at edges..
- if (am_correction) then
+ if (am_geom_crrct) then
do j = 2, jm
ph5 = -0.5_r8*pi + ((j-1)-0.5_r8)*(pi/(jm-1._r8))
cose(j) = cos(ph5)
@@ -830,7 +832,7 @@ subroutine grid_vars_init(pi, ae, om, dt, fft_flt, &
sinp( 1) = -1._r8
sinp(jm) = 1._r8
- if (am_correction) then
+ if (am_geom_crrct) then
do j = 2, jm-1
sinp(j) = (cose(j) - cose(j+1))/grid%dp ! sqrt(cosp^2+sinp^2)=1
end do
@@ -954,7 +956,7 @@ subroutine grid_vars_init(pi, ae, om, dt, fft_flt, &
! Compute coriolis parameter at cell corners.
- if (am_correction) then
+ if (am_geom_crrct) then
do j = js2gc, jn1gc
grid%fc(j) = (om+om)*grid%sine(j)
end do
diff --git a/src/dynamics/fv/sw_core.F90 b/src/dynamics/fv/sw_core.F90
index 823e8c9b10..654b7d151a 100644
--- a/src/dynamics/fv/sw_core.F90
+++ b/src/dynamics/fv/sw_core.F90
@@ -63,7 +63,7 @@ module sw_core
subroutine c_sw(grid, u, v, pt, delp, &
u2, v2, &
uc, vc, ptc, delpf, ptk, &
- tiny, iord, jord, am_correction)
+ tiny, iord, jord, am_geom_crrct)
! Routine for shallow water dynamics on the C-grid
@@ -78,7 +78,7 @@ subroutine c_sw(grid, u, v, pt, delp, &
type (T_FVDYCORE_GRID), intent(in) :: grid
integer, intent(in):: iord
integer, intent(in):: jord
- logical, intent(in):: am_correction
+ logical, intent(in):: am_geom_crrct
real(r8), intent(in):: u2(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d)
real(r8), intent(in):: v2(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d)
@@ -267,7 +267,7 @@ subroutine c_sw(grid, u, v, pt, delp, &
! New va definition
- if (am_correction) then
+ if (am_geom_crrct) then
do j=js2g1,jn2g0 ! va needed on S (for YCC, iv==1)
do i=1,im
! weight by cos
@@ -504,11 +504,11 @@ end subroutine c_sw
! !INTERFACE:
subroutine d_sw( grid, u, v, uc, vc, &
pt, delp, delpf, cx3, cy3, &
- mfx, mfy, cdx, cdy, &
+ mfx, mfy, cdx, cdy, &
cdxde, cdxdp, cdyde, cdydp, & !ldel2 variables
cdxdiv, cdydiv, cdx4, cdy4, cdtau4, &
ldiv2, ldiv4, ldel2, &
- iord, jord, tiny, am_correction, &
+ iord, jord, tiny, am_correction, &
ddp, duc, vf)
!--------------------------------------------------------------------------
! Routine for shallow water dynamics on the D-grid
@@ -1376,7 +1376,7 @@ end subroutine d_sw
!
! !INTERFACE:
subroutine d2a2c_winds(grid, u, v, ua, va, uc, vc, u_cen, v_cen, &
- reset_winds, met_rlx, am_correction)
+ reset_winds, met_rlx, am_geom_crrct)
implicit none
@@ -1395,7 +1395,7 @@ subroutine d2a2c_winds(grid, u, v, ua, va, uc, vc, u_cen, v_cen, &
real(r8), intent(in):: u_cen(grid%im,grid%jfirst-grid%ng_d:grid%jlast+grid%ng_d)
real(r8), intent(in):: v_cen(grid%im,grid%jfirst-grid%ng_s:grid%jlast+grid%ng_d)
real(r8), intent(in):: met_rlx
- logical, intent(in):: am_correction
+ logical, intent(in):: am_geom_crrct
! !DESCRIPTION:
!
@@ -1553,7 +1553,7 @@ subroutine d2a2c_winds(grid, u, v, ua, va, uc, vc, u_cen, v_cen, &
va(im,j) = v(im,j) + v(1,j)
enddo
- if (am_correction) then
+ if (am_geom_crrct) then
do j = js2gd, jn2gsm1
do i = 1, im
ua(i,j) =(u(i,j)*cose(j) + u(i,j+1)*cose(j+1))/cosp(j) ! curl free -> curl free
@@ -1637,7 +1637,7 @@ subroutine d2a2c_winds(grid, u, v, ua, va, uc, vc, u_cen, v_cen, &
enddo
enddo
- if (am_correction) then
+ if (am_geom_crrct) then
do j = js2g2, jn1g2 ! vc needed N*2, S*2 (for ycc), va defined at poles
do i = 1, im
vc(i,j) = D0_25*(va(i,j)*cosp(j) + va(i,j-1)*cosp(j-1))/cose(j) ! div free -> div free
diff --git a/src/dynamics/fv/te_map.F90 b/src/dynamics/fv/te_map.F90
index 04fc3a1b72..7044974a45 100644
--- a/src/dynamics/fv/te_map.F90
+++ b/src/dynamics/fv/te_map.F90
@@ -18,7 +18,7 @@ subroutine te_map(grid, consv, convt, ps, omga, &
hs, cp3v, cap3v, kord, peln, &
te0, te, dz, mfx, mfy, &
uc, vc, du_s, du_w, &
- am_correction, am_diag_lbl)
+ am_geom_crrct, am_diag_lbl)
!
! !USES:
@@ -84,7 +84,7 @@ subroutine te_map(grid, consv, convt, ps, omga, &
real(r8) pkz(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy,grid%km) ! layer-mean pk for converting t to pt
! AM conservation mods
- logical, intent(in) :: am_correction ! logical switch for AM correction
+ logical, intent(in) :: am_geom_crrct ! logical switch for AM correction
logical, intent(in) :: am_diag_lbl ! input
real(r8), intent(in) :: du_s(grid%km)
@@ -628,7 +628,7 @@ subroutine te_map(grid, consv, convt, ps, omga, &
if(j /= 1) then
- if (am_correction) then
+ if (am_geom_crrct) then
! WS 99.07.29 : protect j==jfirst case
if (j > jfirst) then
@@ -678,7 +678,7 @@ subroutine te_map(grid, consv, convt, ps, omga, &
enddo
enddo
- else ! not am_correction
+ else ! not am_geom_crrct
! WS 99.07.29 : protect j==jfirst case
if (j > jfirst) then
@@ -710,7 +710,7 @@ subroutine te_map(grid, consv, convt, ps, omga, &
#endif
endif ! (j > jfirst)
- endif ! (am_correction)
+ endif ! (am_geom_crrct)
!-------------------------------
@@ -720,7 +720,7 @@ subroutine te_map(grid, consv, convt, ps, omga, &
0, 0, itot, i1-ifirst+1, i2-ifirst+1, &
j, jfirst, jlast, -1, kord)
- if (am_correction) then
+ if (am_geom_crrct) then
! compute zonal momentum difference due to remapping
do k=1,km
diff --git a/src/dynamics/fv/tp_core.F90 b/src/dynamics/fv/tp_core.F90
index 1265dc1582..e27f845a94 100644
--- a/src/dynamics/fv/tp_core.F90
+++ b/src/dynamics/fv/tp_core.F90
@@ -334,8 +334,8 @@ subroutine xtpv(im, ffslv, fxv, qv, cv, iord, mfxv, &
real (r8) cos_ppm !critical cosine for ppm
parameter (cos_upw = D0_05) !roughly at 87 deg.
- parameter (cos_van = D0_25) !roughly at 75 deg.
- parameter (cos_ppm = D0_25)
+ parameter (cos_van = 0.1_r8) !roughly at 84 deg.
+ parameter (cos_ppm = 0.1_r8)
integer i, imp, j
real (r8) qmax, qmin
diff --git a/src/dynamics/fv/uv3s_update.F90 b/src/dynamics/fv/uv3s_update.F90
index bcf29be3e4..ffd082a82a 100644
--- a/src/dynamics/fv/uv3s_update.F90
+++ b/src/dynamics/fv/uv3s_update.F90
@@ -5,7 +5,7 @@
! !INTERFACE:
subroutine uv3s_update(grid, dua, u3s, dva, v3s, dt5, &
- am_correction)
+ am_geom_crrct)
! !USES:
@@ -27,7 +27,7 @@ subroutine uv3s_update(grid, dua, u3s, dva, v3s, dt5, &
! dvdt on A-grid
real(r8),intent(in) :: dva(grid%ifirstxy:grid%ilastxy,grid%km,grid%jfirstxy:grid%jlastxy)
real(r8),intent(in) :: dt5 ! weighting factor
- logical, intent(in) :: am_correction
+ logical, intent(in) :: am_geom_crrct
! !INPUT/OUTPUT PARAMETERS:
real(r8), intent(inout) :: u3s(grid%ifirstxy:grid%ilastxy,grid%jfirstxy:grid%jlastxy, &
@@ -121,7 +121,7 @@ subroutine uv3s_update(grid, dua, u3s, dva, v3s, dt5, &
! Adjust D-grid winds by interpolating A-grid tendencies.
!
- if (am_correction) then
+ if (am_geom_crrct) then
do j = jfirstxy+1, jlastxy
do i = ifirstxy, ilastxy
tmp = u3s(i,j,k)
@@ -149,7 +149,7 @@ subroutine uv3s_update(grid, dua, u3s, dva, v3s, dt5, &
enddo
#if defined( SPMD )
- if (am_correction) then
+ if (am_geom_crrct) then
if ( jfirstxy .gt. 1 ) then
do i = ifirstxy, ilastxy
tmp = u3s(i,jfirstxy,k)
diff --git a/src/physics/cam/cam_diagnostics.F90 b/src/physics/cam/cam_diagnostics.F90
index 8b046924d1..0ef3a86f54 100644
--- a/src/physics/cam/cam_diagnostics.F90
+++ b/src/physics/cam/cam_diagnostics.F90
@@ -43,6 +43,7 @@ module cam_diagnostics
diag_surf, &! output diagnostics of the surface
diag_export, &! output export state
diag_physvar_ic, &
+ diag_phys_writeout_dry, &! output diagnostics of the dynamics
nsurf
@@ -205,6 +206,15 @@ subroutine diag_init_dry(pbuf2d)
call addfld (apcnst(1), (/ 'lev' /), 'A','kg/kg', trim(cnst_longname(1))//' (after physics)')
if ( dycore_is('LR') .or. dycore_is('SE') ) then
call addfld ('TFIX', horiz_only, 'A', 'K/s', 'T fixer (T equivalent of Energy correction)')
+!+tht
+ call addfld ('EBREAK', horiz_only, 'A','W/m2', 'Global-mean energy-nonconservation (W/m2)')
+ call addfld ('PTTEND_DME', (/ 'lev' /), 'A', 'K/s ', &
+ 'T-tendency due to dry mass adjustment at the end of tphysac' )
+ call addfld ('IETEND_DME', horiz_only, 'A','W/m2 ', &
+ 'Column DSE tendency due to mass adjustment at end of tphysac' )
+ call addfld ('EFLX ' , horiz_only, 'A','W/m2 ', &
+ 'Material enthalpy flux due to mass adjustment at end of tphysac')
+!-tht
end if
call addfld ('TTEND_TOT', (/ 'lev' /), 'A', 'K/s', 'Total temperature tendency')
@@ -335,6 +345,12 @@ subroutine diag_init_dry(pbuf2d)
call add_default (apcnst(1) , history_budget_histfile_num, ' ')
if ( dycore_is('LR') .or. dycore_is('SE') ) then
call add_default ('TFIX ' , history_budget_histfile_num, ' ')
+!+tht
+ call add_default ('EBREAK ' , history_budget_histfile_num, ' ')
+ call add_default ('PTTEND_DME', history_budget_histfile_num, ' ')
+ call add_default ('IETEND_DME', history_budget_histfile_num, ' ')
+ call add_default ('EFLX ' , history_budget_histfile_num, ' ')
+!-tht
end if
end if
@@ -1470,7 +1486,9 @@ subroutine diag_phys_writeout(state, pbuf)
type(physics_state), intent(inout) :: state
type(physics_buffer_desc), pointer :: pbuf(:)
+ !
! Local variable
+ !
real(r8) :: p_surf_t(pcols, nsurf) ! data interpolated to a pressure surface
call diag_phys_writeout_dry(state, pbuf, p_surf_t)
@@ -1938,7 +1956,8 @@ end subroutine diag_physvar_ic
!#######################################################################
- subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt)
+ !subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt)
+ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt, tmp_t, eflx, dsema) !tht
!---------------------------------------------------------------
!
@@ -1957,13 +1976,18 @@ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt)
type(physics_tend ), intent(in) :: tend
real(r8), intent(in) :: ztodt ! physics timestep
+ real(r8) , intent(inout) :: tmp_t (pcols,pver) !tht: holds last physics_updated T (FV)
+ real(r8) , intent(in), optional ::eflx (pcols ) !tht: surface sensible heat flux assoc.with mass adj.
+ real(r8) , intent(in), optional ::dsema(pcols ) !tht: column enthalpy tendency assoc. with mass adj.
+
!---------------------------Local workspace-----------------------------
integer :: lchnk ! chunk index
integer :: ncol ! number of columns in chunk
real(r8) :: ftem2(pcols) ! Temporary workspace for outfld variables
real(r8) :: ftem3(pcols,pver) ! Temporary workspace for outfld variables
- real(r8) :: heat_glob ! global energy integral (FV only)
+ real(r8) :: heat_glob ! tht: T-tend from fixer (FV only)
+ real(r8) :: tedif_glob !+tht energy flux from fixer (FV only)
! CAM pointers to get variables from the physics buffer
real(r8), pointer, dimension(:,:) :: t_ttend
integer :: itim_old,m
@@ -1979,13 +2003,25 @@ subroutine diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt)
call outfld('UAP', state%u, pcols, lchnk )
call outfld('VAP', state%v, pcols, lchnk )
+ !tht: heat tendencies from dme_adjust
+ if (dycore_is('LR')) then
+ tmp_t(:ncol,:pver) = (state%t(:ncol,:pver) - tmp_t(:ncol,:pver))/ztodt ! T tendency
+ call outfld('PTTEND_DME', tmp_t, pcols, lchnk )
+ if(present(dsema))call outfld('IETEND_DME', dsema, pcols, lchnk) ! dry enthalpy
+ if(present(eflx) )call outfld('EFLX' , eflx, pcols, lchnk) ! moist enthalpy
+ end if
+
! Total physics tendency for Temperature
! (remove global fixer tendency from total for FV and SE dycores)
if (dycore_is('LR') .or. dycore_is('SE')) then
- call check_energy_get_integrals( heat_glob_out=heat_glob )
+ call check_energy_get_integrals( heat_glob_out=heat_glob , tedif_glob_out=tedif_glob ) !+tht tedif
ftem2(:ncol) = heat_glob/cpair
call outfld('TFIX', ftem2, pcols, lchnk )
+!+tht
+ ftem2(:ncol) = tedif_glob/ztodt
+ call outfld('EBREAK', ftem2, pcols, lchnk )
+!-tht
ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver) - heat_glob/cpair
else
ftem3(:ncol,:pver) = tend%dtdt(:ncol,:pver)
@@ -2113,7 +2149,8 @@ end subroutine diag_phys_tend_writeout_moist
!#######################################################################
subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, &
- tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini)
+ ! tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini)
+ tmp_q, tmp_t, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini, eflx, dsema) !+tht
!---------------------------------------------------------------
!
@@ -2129,15 +2166,19 @@ subroutine diag_phys_tend_writeout(state, pbuf, tend, ztodt, &
type(physics_tend ), intent(in) :: tend
real(r8), intent(in) :: ztodt ! physics timestep
real(r8) , intent(inout) :: tmp_q (pcols,pver) ! As input, holds pre-adjusted tracers (FV)
+ real(r8) , intent(inout) :: tmp_t (pcols,pver) !tht: holds last physics_updated T (FV)
real(r8), intent(inout) :: tmp_cldliq(pcols,pver) ! As input, holds pre-adjusted tracers (FV)
real(r8), intent(inout) :: tmp_cldice(pcols,pver) ! As input, holds pre-adjusted tracers (FV)
real(r8), intent(in) :: qini (pcols,pver) ! tracer fields at beginning of physics
real(r8), intent(in) :: cldliqini (pcols,pver) ! tracer fields at beginning of physics
real(r8), intent(in) :: cldiceini (pcols,pver) ! tracer fields at beginning of physics
+ real(r8) , intent(in), optional ::eflx (pcols ) !tht: surface sensible heat flux assoc.with mass adj.
+ real(r8) , intent(in), optional ::dsema(pcols ) !tht: column enthalpy tendency assoc. with mass adj.
!-----------------------------------------------------------------------
- call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt)
+ !call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt)
+ call diag_phys_tend_writeout_dry(state, pbuf, tend, ztodt, tmp_t, eflx, dsema) !tht
if (moist_physics) then
call diag_phys_tend_writeout_moist(state, pbuf, tend, ztodt, &
tmp_q, tmp_cldliq, tmp_cldice, qini, cldliqini, cldiceini)
diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90
index ae5724f938..4bb3da9cce 100644
--- a/src/physics/cam/check_energy.F90
+++ b/src/physics/cam/check_energy.F90
@@ -955,7 +955,7 @@ subroutine calc_te_and_aam_budgets(state, outfld_name_suffix)
mo_cnst = omega*rearth**4/gravit
do k = 1, pver
do i = 1, ncol
- cos_lat = cos(state%lat(i))
+ cos_lat = cos(state%lat(i)) ! *180._r8/pi) !+tht bug fix
mr_tmp = mr_cnst*state%u(i,k)*state%pdel(i,k)*cos_lat
mo_tmp = mo_cnst*state%pdel(i,k)*cos_lat**2
diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90
index 2531857278..7ba8cc2e66 100644
--- a/src/physics/cam/clubb_intr.F90
+++ b/src/physics/cam/clubb_intr.F90
@@ -865,6 +865,8 @@ subroutine clubb_ini_cam(pbuf2d)
call addfld ('VM_CLUBB', (/ 'ilev' /), 'A', 'm/s', 'Meridional Wind')
call addfld ('THETAL', (/ 'lev' /), 'A', 'K', 'Liquid Water Potential Temperature')
call addfld ('PBLH', horiz_only, 'A', 'm', 'PBL height')
+ call addfld( 'PBLHMX', horiz_only, 'X', 'm', 'Maximum PBL height over output period')
+ call addfld( 'PBLHMN', horiz_only, 'M', 'm', 'Minimum PBL height over output period')
call addfld ('QT', (/ 'lev' /), 'A', 'kg/kg', 'Total water mixing ratio')
call addfld ('SL', (/ 'lev' /), 'A', 'J/kg', 'Liquid water static energy')
call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction')
@@ -2600,6 +2602,8 @@ subroutine clubb_tend_cam( &
! Output the PBL depth
call outfld('PBLH', pblh, pcols, lchnk)
+ call outfld('PBLHMX', pblh, pcols, lchnk)
+ call outfld('PBLHMN', pblh, pcols, lchnk)
! Assign the first pver levels of cloud_frac back to cld
cld(:,1:pver) = cloud_frac(:,1:pver)
diff --git a/src/physics/cam/clubb_intr.F90.beta07 b/src/physics/cam/clubb_intr.F90.beta07
new file mode 100644
index 0000000000..4a998dec85
--- /dev/null
+++ b/src/physics/cam/clubb_intr.F90.beta07
@@ -0,0 +1,3649 @@
+module clubb_intr
+
+ !----------------------------------------------------------------------------------------------------- !
+ ! Module to interface CAM with Cloud Layers Unified by Bi-normals (CLUBB), developed !
+ ! by the University of Wisconsin Milwaukee Group (UWM). !
+ ! !
+ ! CLUBB replaces the exisiting turbulence, shallow convection, and macrophysics in CAM5 !
+ ! !
+ ! Lastly, a implicit diffusion solver is called, and tendencies retrieved by !
+ ! differencing the diffused and initial states. !
+ ! !
+ ! Calling sequence: !
+ ! !
+ !---------------------------Code history-------------------------------------------------------------- !
+ ! Authors: P. Bogenschutz, C. Craig, A. Gettelman !
+ ! !
+ !----------------------------------------------------------------------------------------------------- !
+
+ use shr_kind_mod, only: r8=>shr_kind_r8
+ use ppgrid, only: pver, pverp, pcols
+ use phys_control, only: phys_getopts
+ use physconst, only: rair, cpair, gravit, latvap, latice, zvir, rh2o, karman
+ use spmd_utils, only: masterproc
+ use constituents, only: pcnst, cnst_add
+ use pbl_utils, only: calc_ustar, calc_obklen
+ use ref_pres, only: top_lev => trop_cloud_top_lev
+ use zm_conv_intr, only: zmconv_microp
+ implicit none
+
+ private
+ save
+
+ ! ----------------- !
+ ! Public interfaces !
+ ! ----------------- !
+
+ public :: clubb_ini_cam, clubb_register_cam, clubb_tend_cam, &
+#ifdef CLUBB_SGS
+ ! This utilizes CLUBB specific variables in its interface
+ stats_init_clubb, &
+#endif
+ stats_end_timestep_clubb, &
+ clubb_readnl, &
+ clubb_init_cnst, &
+ clubb_implements_cnst
+
+#ifdef CLUBB_SGS
+ ! Both of these utilize CLUBB specific variables in their interface
+ private :: stats_zero, stats_avg
+#endif
+
+ logical, public :: do_cldcool
+
+ ! ------------ !
+ ! Private data !
+ ! ------------ !
+
+ integer, parameter :: &
+ grid_type = 3, & ! The 2 option specifies stretched thermodynamic levels
+ hydromet_dim = 0 ! The hydromet array in SAM-CLUBB is currently 0 elements
+
+ real(r8), parameter, dimension(0) :: &
+ sclr_tol = 1.e-8_r8 ! Total water in kg/kg
+
+ character(len=6), parameter :: &
+ saturation_equation = "gfdl" ! Goff & Gratch (1946) approximation for SVP
+
+ real(r8), parameter :: &
+ theta0 = 300._r8, & ! Reference temperature [K]
+ ts_nudge = 86400._r8, & ! Time scale for u/v nudging (not used) [s]
+ p0_clubb = 100000._r8
+
+ integer, parameter :: &
+ sclr_dim = 0 ! Higher-order scalars, set to zero
+
+ real(r8), parameter :: &
+ wp3_const = 1._r8 ! Constant to add to wp3 when moments are advected
+
+ real(r8), parameter :: &
+ wpthlp_const = 10.0_r8 ! Constant to add to wpthlp when moments are advected
+
+ real(r8), parameter :: &
+ wprtp_const = 0.01_r8 ! Constant to add to wprtp when moments are advected
+
+ real(r8), parameter :: &
+ rtpthlp_const = 0.01_r8 ! Constant to add to rtpthlp when moments are advected
+
+ real(r8), parameter :: unset_r8 = huge(1.0_r8)
+
+ real(r8) :: clubb_timestep = unset_r8 ! Default CLUBB timestep, unless overwriten by namelist
+ real(r8) :: clubb_rnevap_effic = unset_r8
+
+ real(r8) :: clubb_c11 = unset_r8
+ real(r8) :: clubb_c11b = unset_r8
+ real(r8) :: clubb_c14 = unset_r8
+ real(r8) :: clubb_gamma_coef = unset_r8
+ real(r8) :: clubb_c_K10 = unset_r8
+ real(r8) :: clubb_c_K10h = unset_r8
+ real(r8) :: clubb_beta = unset_r8
+ real(r8) :: clubb_C2rt = unset_r8
+ real(r8) :: clubb_C2thl = unset_r8
+ real(r8) :: clubb_C2rtthl = unset_r8
+ real(r8) :: clubb_C8 = unset_r8
+ real(r8) :: clubb_C7 = unset_r8
+ real(r8) :: clubb_C7b = unset_r8
+ real(r8) :: clubb_Skw_denom_coef = unset_r8
+ real(r8) :: clubb_lambda0_stability_coef = unset_r8
+ real(r8) :: clubb_mult_coef = unset_r8
+
+! Constant parameters
+ logical, parameter, private :: &
+ l_uv_nudge = .false., & ! Use u/v nudging (not used)
+ l_implemented = .true., & ! Implemented in a host model (always true)
+ l_host_applies_sfc_fluxes = .false. ! Whether the host model applies the surface fluxes
+
+ logical, parameter, private :: &
+ apply_to_heat = .false. ! Apply WACCM energy fixer to heat or not (.true. = yes (duh))
+
+ logical :: lq(pcnst)
+ logical :: prog_modal_aero
+ logical :: do_rainturb
+ logical :: do_expldiff
+ logical :: clubb_do_adv
+ logical :: clubb_do_liqsupersat = .false.
+ logical :: history_budget
+
+ logical :: clubb_l_lscale_plume_centered
+ logical :: clubb_l_use_ice_latent
+
+ integer :: history_budget_histfile_num
+ integer :: edsclr_dim ! Number of scalars to transport in CLUBB
+ integer :: offset
+
+! define physics buffer indicies here
+ integer :: &
+ wp2_idx, & ! vertical velocity variances
+ wp3_idx, & ! third moment of vertical velocity
+ wpthlp_idx, & ! turbulent flux of thetal
+ wprtp_idx, & ! turbulent flux of total water
+ rtpthlp_idx, & ! covariance of thetal and rt
+ rtp2_idx, & ! variance of total water
+ thlp2_idx, & ! variance of thetal
+ up2_idx, & ! variance of east-west wind
+ vp2_idx, & ! variance of north-south wind
+ upwp_idx, & ! east-west momentum flux
+ vpwp_idx, & ! north-south momentum flux
+ thlm_idx, & ! mean thetal
+ rtm_idx, & ! mean total water mixing ratio
+ um_idx, & ! mean of east-west wind
+ vm_idx, & ! mean of north-south wind
+ cld_idx, & ! Cloud fraction
+ concld_idx, & ! Convective cloud fraction
+ ast_idx, & ! Stratiform cloud fraction
+ alst_idx, & ! Liquid stratiform cloud fraction
+ aist_idx, & ! Ice stratiform cloud fraction
+ qlst_idx, & ! Physical in-cloud LWC
+ qist_idx, & ! Physical in-cloud IWC
+ dp_frac_idx, & ! deep convection cloud fraction
+ sh_frac_idx, & ! shallow convection cloud fraction
+ kvh_idx, & ! CLUBB eddy diffusivity on thermo levels
+ kvm_idx, & ! CLUBB eddy diffusivity on mom levels
+ pblh_idx, & ! PBL pbuf
+ icwmrdp_idx, & ! In cloud mixing ratio for deep convection
+ tke_idx, & ! turbulent kinetic energy
+ tpert_idx, & ! temperature perturbation from PBL
+ fice_idx, & ! fice_idx index in physics buffer
+ cmeliq_idx, & ! cmeliq_idx index in physics buffer
+ relvar_idx, & ! relative cloud water variance
+ accre_enhan_idx, & ! optional accretion enhancement factor for MG
+ npccn_idx, & ! liquid ccn number concentration
+ naai_idx, & ! ice number concentration
+ prer_evap_idx, & ! rain evaporation rate
+ qrl_idx, & ! longwave cooling rate
+ radf_idx , &
+ qsatfac_idx ! subgrid cloud water saturation scaling factor
+
+ integer, public :: &
+ ixthlp2 = 0, &
+ ixwpthlp = 0, &
+ ixwprtp = 0, &
+ ixwp2 = 0, &
+ ixwp3 = 0, &
+ ixrtpthlp = 0, &
+ ixrtp2 = 0, &
+ ixup2 = 0, &
+ ixvp2 = 0
+
+ integer :: cmfmc_sh_idx = 0
+
+ integer :: &
+ dlfzm_idx = -1, & ! ZM detrained convective cloud water mixing ratio.
+ difzm_idx = -1, & ! ZM detrained convective cloud ice mixing ratio.
+ dnlfzm_idx = -1, & ! ZM detrained convective cloud water num concen.
+ dnifzm_idx = -1 ! ZM detrained convective cloud ice num concen.
+
+ ! Output arrays for CLUBB statistics
+ real(r8), allocatable, dimension(:,:,:) :: out_zt, out_zm, out_radzt, out_radzm, out_sfc
+
+ character(len=16) :: eddy_scheme ! Default set in phys_control.F90
+ character(len=16) :: deep_scheme ! Default set in phys_control.F90
+
+ integer, parameter :: ncnst=9
+ character(len=8) :: cnst_names(ncnst)
+ logical :: do_cnst=.false.
+
+ contains
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+
+ subroutine clubb_register_cam( )
+!-------------------------------------------------------------------------------
+! Description:
+! Register the constituents and fields in the physics buffer
+! Author: P. Bogenschutz, C. Craig, A. Gettelman
+!
+!-------------------------------------------------------------------------------
+#ifdef CLUBB_SGS
+
+ !------------------------------------------------ !
+ ! Register physics buffer fields and constituents !
+ !------------------------------------------------ !
+
+ ! Add CLUBB fields to pbuf
+ use physics_buffer, only: pbuf_add_field, dtype_r8, dyn_time_lvls
+
+ call phys_getopts( eddy_scheme_out = eddy_scheme, &
+ deep_scheme_out = deep_scheme, &
+ history_budget_out = history_budget, &
+ history_budget_histfile_num_out = history_budget_histfile_num )
+
+ if (clubb_do_adv) then
+ cnst_names =(/'THLP2 ','RTP2 ','RTPTHLP','WPTHLP ','WPRTP ','WP2 ','WP3 ','UP2 ','VP2 '/)
+ do_cnst=.true.
+ ! If CLUBB moments are advected, do not output them automatically which is typically done. Some moments
+ ! need a constant added to them before they are advected, thus this would corrupt the output.
+ ! Users should refer to the "XXXX_CLUBB" (THLP2_CLUBB for instance) output variables for these moments
+ call cnst_add(trim(cnst_names(1)),0._r8,0._r8,0._r8,ixthlp2,longname='second moment vertical velocity',cam_outfld=.false.)
+ call cnst_add(trim(cnst_names(2)),0._r8,0._r8,0._r8,ixrtp2,longname='second moment rtp',cam_outfld=.false.)
+ call cnst_add(trim(cnst_names(3)),0._r8,0._r8,-999999._r8,ixrtpthlp,longname='covariance rtp thlp',cam_outfld=.false.)
+ call cnst_add(trim(cnst_names(4)),0._r8,0._r8,-999999._r8,ixwpthlp,longname='CLUBB heat flux',cam_outfld=.false.)
+ call cnst_add(trim(cnst_names(5)),0._r8,0._r8,-999999._r8,ixwprtp,longname='CLUBB moisture flux',cam_outfld=.false.)
+ call cnst_add(trim(cnst_names(6)),0._r8,0._r8,0._r8,ixwp2,longname='CLUBB wp2',cam_outfld=.false.)
+ call cnst_add(trim(cnst_names(7)),0._r8,0._r8,-999999._r8,ixwp3,longname='CLUBB 3rd moment vert velocity',cam_outfld=.false.)
+ call cnst_add(trim(cnst_names(8)),0._r8,0._r8,0._r8,ixup2,longname='CLUBB 2nd moment u wind',cam_outfld=.false.)
+ call cnst_add(trim(cnst_names(9)),0._r8,0._r8,0._r8,ixvp2,longname='CLUBB 2nd moment v wind',cam_outfld=.false.)
+ end if
+
+ ! put pbuf_add calls here (see macrop_driver.F90 for sample) use indicies defined at top
+ call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx)
+ call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx)
+ call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx)
+ call pbuf_add_field('kvm', 'global', dtype_r8, (/pcols, pverp/), kvm_idx)
+ call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols/), tpert_idx)
+ call pbuf_add_field('AST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), ast_idx)
+ call pbuf_add_field('AIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), aist_idx)
+ call pbuf_add_field('ALST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), alst_idx)
+ call pbuf_add_field('QIST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qist_idx)
+ call pbuf_add_field('QLST', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), qlst_idx)
+ call pbuf_add_field('CONCLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), concld_idx)
+ call pbuf_add_field('CLD', 'global', dtype_r8, (/pcols,pver,dyn_time_lvls/), cld_idx)
+ call pbuf_add_field('FICE', 'physpkg',dtype_r8, (/pcols,pver/), fice_idx)
+ call pbuf_add_field('RAD_CLUBB', 'global', dtype_r8, (/pcols,pver/), radf_idx)
+ call pbuf_add_field('CMELIQ', 'physpkg',dtype_r8, (/pcols,pver/), cmeliq_idx)
+ call pbuf_add_field('QSATFAC', 'physpkg',dtype_r8, (/pcols,pver/), qsatfac_idx)
+
+
+ call pbuf_add_field('WP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp2_idx)
+ call pbuf_add_field('WP3_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wp3_idx)
+ call pbuf_add_field('WPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wpthlp_idx)
+ call pbuf_add_field('WPRTP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), wprtp_idx)
+ call pbuf_add_field('RTPTHLP_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtpthlp_idx)
+ call pbuf_add_field('RTP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtp2_idx)
+ call pbuf_add_field('THLP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlp2_idx)
+ call pbuf_add_field('UP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), up2_idx)
+ call pbuf_add_field('VP2_nadv', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vp2_idx)
+
+ call pbuf_add_field('UPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), upwp_idx)
+ call pbuf_add_field('VPWP', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vpwp_idx)
+ call pbuf_add_field('THLM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), thlm_idx)
+ call pbuf_add_field('RTM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), rtm_idx)
+ call pbuf_add_field('UM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), um_idx)
+ call pbuf_add_field('VM', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), vm_idx)
+
+#endif
+
+ end subroutine clubb_register_cam
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+
+function clubb_implements_cnst(name)
+
+ !----------------------------------------------------------------------------- !
+ ! !
+ ! Return true if specified constituent is implemented by this package !
+ ! !
+ !----------------------------------------------------------------------------- !
+
+ character(len=*), intent(in) :: name ! constituent name
+ logical :: clubb_implements_cnst ! return value
+
+ !-----------------------------------------------------------------------
+
+ clubb_implements_cnst = (do_cnst .and. any(name == cnst_names))
+
+end function clubb_implements_cnst
+
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+
+subroutine clubb_init_cnst(name, latvals, lonvals, mask, q)
+#ifdef CLUBB_SGS
+ use constants_clubb, only: w_tol_sqd, rt_tol, thl_tol
+#endif
+
+ !----------------------------------------------------------------------- !
+ ! !
+ ! Initialize the state if clubb_do_adv !
+ ! !
+ !----------------------------------------------------------------------- !
+
+ character(len=*), intent(in) :: name ! constituent name
+ real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol)
+ real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol)
+ logical, intent(in) :: mask(:) ! Only initialize where .true.
+ real(r8), intent(out) :: q(:,:) ! kg tracer/kg dry air (gcol, plev
+
+ !-----------------------------------------------------------------------
+ integer :: k, nlev
+
+#ifdef CLUBB_SGS
+ if (clubb_do_adv) then
+ nlev = size(q, 2)
+ do k = 1, nlev
+ if (trim(name) == trim(cnst_names(1))) then
+ where(mask)
+ q(:,k) = thl_tol**2
+ end where
+ end if
+ if (trim(name) == trim(cnst_names(2))) then
+ where(mask)
+ q(:,k) = rt_tol**2
+ end where
+ end if
+ if (trim(name) == trim(cnst_names(3))) then
+ where(mask)
+ q(:,k) = 0.0_r8
+ end where
+ end if
+ if (trim(name) == trim(cnst_names(4))) then
+ where(mask)
+ q(:,k) = 0.0_r8
+ end where
+ end if
+ if (trim(name) == trim(cnst_names(5))) then
+ where(mask)
+ q(:,k) = 0.0_r8
+ end where
+ end if
+ if (trim(name) == trim(cnst_names(6))) then
+ where(mask)
+ q(:,k) = w_tol_sqd
+ end where
+ end if
+ if (trim(name) == trim(cnst_names(7))) then
+ where(mask)
+ q(:,k) = 0.0_r8
+ end where
+ end if
+ if (trim(name) == trim(cnst_names(8))) then
+ where(mask)
+ q(:,k) = w_tol_sqd
+ end where
+ end if
+ if (trim(name) == trim(cnst_names(9))) then
+ where(mask)
+ q(:,k) = w_tol_sqd
+ end where
+ end if
+ end do
+ end if
+#endif
+
+end subroutine clubb_init_cnst
+
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+
+ subroutine clubb_readnl(nlfile)
+
+#ifdef CLUBB_SGS
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use cam_abortutils, only: endrun
+ use stats_variables, only: l_stats, l_output_rad_files
+ use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_real8
+ use clubb_api_module, only: l_diffuse_rtm_and_thlm, l_stability_correct_Kh_N2_zm
+#endif
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+#ifdef CLUBB_SGS
+
+ character(len=*), parameter :: sub = 'clubb_readnl'
+
+ logical :: clubb_history, clubb_rad_history, clubb_cloudtop_cooling, clubb_rainevap_turb, &
+ clubb_stabcorrect, clubb_expldiff ! Stats enabled (T/F)
+
+ integer :: iunit, read_status, ierr
+
+ namelist /clubb_his_nl/ clubb_history, clubb_rad_history
+ namelist /clubbpbl_diff_nl/ clubb_cloudtop_cooling, clubb_rainevap_turb, clubb_expldiff, &
+ clubb_do_adv, clubb_timestep, clubb_stabcorrect, &
+ clubb_rnevap_effic
+ namelist /clubb_params_nl/ clubb_c11, clubb_c11b, clubb_c14, clubb_mult_coef, clubb_gamma_coef, &
+ clubb_c_K10, clubb_c_K10h, clubb_beta, clubb_C2rt, clubb_C2thl, &
+ clubb_C2rtthl, clubb_C8, clubb_C7, clubb_C7b, clubb_Skw_denom_coef, &
+ clubb_lambda0_stability_coef, clubb_l_lscale_plume_centered, &
+ clubb_l_use_ice_latent, clubb_do_liqsupersat
+
+ !----- Begin Code -----
+
+ ! Determine if we want clubb_history to be output
+ clubb_history = .false. ! Initialize to false
+ l_stats = .false. ! Initialize to false
+ l_output_rad_files = .false. ! Initialize to false
+ do_cldcool = .false. ! Initialize to false
+ do_rainturb = .false. ! Initialize to false
+ do_expldiff = .false. ! Initialize to false
+
+ clubb_l_lscale_plume_centered = .false. ! Initialize to false!
+ clubb_l_use_ice_latent = .false. ! Initialize to false!
+
+ ! Read namelist to determine if CLUBB history should be called
+ if (masterproc) then
+ iunit = getunit()
+ open( iunit, file=trim(nlfile), status='old' )
+
+ call find_group_name(iunit, 'clubb_his_nl', status=read_status)
+ if (read_status == 0) then
+ read(unit=iunit, nml=clubb_his_nl, iostat=read_status)
+ if (read_status /= 0) then
+ call endrun('clubb_readnl: error reading namelist')
+ end if
+ end if
+
+ call find_group_name(iunit, 'clubb_params_nl', status=read_status)
+ if (read_status == 0) then
+ read(unit=iunit, nml=clubb_params_nl, iostat=read_status)
+ if (read_status /= 0) then
+ call endrun('clubb_readnl: error reading namelist')
+ end if
+ else
+ call endrun('clubb_readnl: error reading namelist')
+ end if
+
+ call find_group_name(iunit, 'clubbpbl_diff_nl', status=read_status)
+ if (read_status == 0) then
+ read(unit=iunit, nml=clubbpbl_diff_nl, iostat=read_status)
+ if (read_status /= 0) then
+ call endrun('clubb_readnl: error reading namelist')
+ end if
+ end if
+
+ close(unit=iunit)
+ call freeunit(iunit)
+ end if
+
+ ! Broadcast namelist variables
+ call mpi_bcast(clubb_history, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_history")
+ call mpi_bcast(clubb_rad_history, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rad_history")
+ call mpi_bcast(clubb_cloudtop_cooling, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_cloudtop_cooling")
+ call mpi_bcast(clubb_rainevap_turb, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rainevap_turb")
+ call mpi_bcast(clubb_expldiff, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_expldiff")
+ call mpi_bcast(clubb_do_adv, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_adv")
+ call mpi_bcast(clubb_timestep, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_timestep")
+ call mpi_bcast(clubb_stabcorrect, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_stabcorrect")
+ call mpi_bcast(clubb_rnevap_effic, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rnevap_effic")
+
+ call mpi_bcast(clubb_c11, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c11")
+ call mpi_bcast(clubb_c11b, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c11b")
+ call mpi_bcast(clubb_c14, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c14")
+ call mpi_bcast(clubb_mult_coef, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_mult_coef")
+ call mpi_bcast(clubb_gamma_coef, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_gamma_coef")
+ call mpi_bcast(clubb_c_K10, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10")
+ call mpi_bcast(clubb_c_K10h, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K10h")
+ call mpi_bcast(clubb_beta, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_beta")
+ call mpi_bcast(clubb_C2rt, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C2rt")
+ call mpi_bcast(clubb_C2thl, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C2thl")
+ call mpi_bcast(clubb_C2rtthl, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C2rtthl")
+ call mpi_bcast(clubb_C8, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C8")
+ call mpi_bcast(clubb_C7, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C7")
+ call mpi_bcast(clubb_C7b, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C7b")
+ call mpi_bcast(clubb_Skw_denom_coef, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_Skw_denom_coef")
+ call mpi_bcast(clubb_lambda0_stability_coef, 1, mpi_real8, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lambda0_stability_coef")
+ call mpi_bcast(clubb_l_lscale_plume_centered,1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_lscale_plume_centered")
+ call mpi_bcast(clubb_l_use_ice_latent, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_ice_latent")
+ call mpi_bcast(clubb_do_liqsupersat, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_liqsupersat")
+
+ ! Overwrite defaults if they are true
+ if (clubb_history) l_stats = .true.
+ if (clubb_rad_history) l_output_rad_files = .true.
+ if (clubb_cloudtop_cooling) do_cldcool = .true.
+ if (clubb_rainevap_turb) do_rainturb = .true.
+ if (clubb_expldiff) do_expldiff = .true.
+
+ if (clubb_stabcorrect .and. clubb_expldiff) then
+ call endrun('clubb_readnl: clubb_stabcorrect and clubb_expldiff may not both be set to true at the same time')
+ end if
+
+ if (clubb_stabcorrect) then
+ l_diffuse_rtm_and_thlm = .true. ! CLUBB flag set to true
+ l_stability_correct_Kh_N2_zm = .true. ! CLUBB flag set to true
+ endif
+
+#endif
+ end subroutine clubb_readnl
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+
+ subroutine clubb_ini_cam(pbuf2d)
+!-------------------------------------------------------------------------------
+! Description:
+! Initialize UWM CLUBB.
+! Author: Cheryl Craig March 2011
+! Modifications: Pete Bogenschutz 2011 March and onward
+! Origin: Based heavily on UWM clubb_init.F90
+! References:
+! None
+!-------------------------------------------------------------------------------
+
+
+
+#ifdef CLUBB_SGS
+
+ ! From CAM libraries
+ use cam_history, only: addfld, add_default, horiz_only
+ use ref_pres, only: pref_mid
+ use hb_diff, only: init_hb_diff
+ use rad_constituents, only: rad_cnst_get_info, rad_cnst_get_mode_num_idx, rad_cnst_get_mam_mmr_idx
+ use cam_abortutils, only: endrun
+
+ ! From the CLUBB libraries
+ use clubb_api_module, only: &
+ setup_clubb_core_api, &
+ time_precision, &
+ core_rknd, &
+ set_clubb_debug_level_api, &
+ nparams, &
+ read_parameters_api, &
+ l_stats, &
+ l_stats_samp, &
+ l_grads, &
+ stats_zt, &
+ stats_zm, &
+ stats_sfc, &
+ stats_rad_zt, &
+ stats_rad_zm, &
+ w_tol_sqd, &
+ rt_tol, &
+ thl_tol
+
+ ! These are only needed if we're using a passive scalar
+ use clubb_api_module, only: &
+ iisclr_rt, &
+ iisclr_thl, &
+ iisclr_CO2, &
+ iiedsclr_rt, &
+ iiedsclr_thl, &
+ iiedsclr_CO2
+
+ ! These are needed to set parameters
+ use clubb_api_module, only: &
+ ilambda0_stability_coef, ic_K10, ic_K10h, iC2rtthl, iC7, iC7b, iC8, iC11, iC11b, &
+ iC14, igamma_coef, imult_coef, ilmin_coef, iSkw_denom_coef, ibeta, &
+ iC2rt, iC2thl, iC2rtthl, l_do_expldiff_rtm_thlm, l_Lscale_plume_centered, &
+ l_use_ice_latent
+
+ use time_manager, only: is_first_step
+
+ use constituents, only: cnst_get_ind
+ use phys_control, only: phys_getopts
+
+#endif
+
+ use physics_buffer, only: pbuf_get_index, pbuf_set_field, physics_buffer_desc
+ implicit none
+ ! Input Variables
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+#ifdef CLUBB_SGS
+
+ real(kind=time_precision) :: dum1, dum2, dum3
+
+ real(r8), dimension(nparams) :: clubb_params ! These adjustable CLUBB parameters (C1, C2 ...)
+
+ ! The similar name to clubb_history is unfortunate...
+ logical :: history_amwg, history_clubb
+
+ integer :: err_code ! Code for when CLUBB fails
+ integer :: k, l ! Indices
+ integer :: ntop_eddy ! Top interface level to which eddy vertical diffusion is applied ( = 1 )
+ integer :: nbot_eddy ! Bottom interface level to which eddy vertical diffusion is applied ( = pver )
+ integer :: nmodes, nspec, m
+ integer :: ixq, ixcldice, ixcldliq, ixnumliq, ixnumice
+ integer :: lptr
+
+ real(r8) :: zt_g(pverp+1-top_lev) ! Height dummy array
+ real(r8) :: zi_g(pverp+1-top_lev) ! Height dummy array
+
+ ! CAM defines zi at the surface to be zero.
+ real(r8), parameter :: sfc_elevation = 0._r8
+
+ integer :: nlev
+
+ !----- Begin Code -----
+
+ nlev = pver + 1 - top_lev
+
+ if (core_rknd /= r8) then
+ call endrun('clubb_ini_cam: CLUBB library core_rknd must match CAM r8 and it does not')
+ end if
+
+ ! ----------------------------------------------------------------- !
+ ! Determine how many constituents CLUBB will transport. Note that
+ ! CLUBB does not transport aerosol consituents. Therefore, need to
+ ! determine how many aerosols constituents there are and subtract that
+ ! off of pcnst (the total consituents)
+ ! ----------------------------------------------------------------- !
+
+ call phys_getopts(prog_modal_aero_out=prog_modal_aero, &
+ history_amwg_out=history_amwg, &
+ history_clubb_out=history_clubb)
+
+ ! Select variables to apply tendencies back to CAM
+
+ ! Initialize all consituents to true to start
+ lq(1:pcnst) = .true.
+ edsclr_dim = pcnst
+
+ call cnst_get_ind('Q',ixq)
+ call cnst_get_ind('NUMICE',ixnumice)
+ call cnst_get_ind('NUMLIQ',ixnumliq)
+ call cnst_get_ind('CLDLIQ',ixcldliq)
+ call cnst_get_ind('CLDICE',ixcldice)
+
+ if (prog_modal_aero) then
+ ! Turn off modal aerosols and decrement edsclr_dim accordingly
+ call rad_cnst_get_info(0, nmodes=nmodes)
+
+ do m = 1, nmodes
+ call rad_cnst_get_mode_num_idx(m, lptr)
+ lq(lptr)=.false.
+ edsclr_dim = edsclr_dim-1
+
+ call rad_cnst_get_info(0, m, nspec=nspec)
+ do l = 1, nspec
+ call rad_cnst_get_mam_mmr_idx(m, l, lptr)
+ lq(lptr)=.false.
+ edsclr_dim = edsclr_dim-1
+ end do
+ end do
+
+ ! In addition, if running with MAM, droplet number is transported
+ ! in dropmixnuc, therefore we do NOT want CLUBB to apply transport
+ ! tendencies to avoid double counted. Else, we apply tendencies.
+ lq(ixnumliq) = .false.
+ edsclr_dim = edsclr_dim-1
+ endif
+
+ ! ----------------------------------------------------------------- !
+ ! Set the debug level. Level 2 has additional computational expense since
+ ! it checks the array variables in CLUBB for invalid values.
+ ! ----------------------------------------------------------------- !
+ call set_clubb_debug_level_api( 0 )
+
+ ! ----------------------------------------------------------------- !
+ ! use pbuf_get_fld_idx to get existing physics buffer fields from other
+ ! physics packages (e.g. tke)
+ ! ----------------------------------------------------------------- !
+
+
+ ! Defaults
+ l_stats_samp = .false.
+ l_grads = .false.
+
+ ! Overwrite defaults if needbe
+ if (l_stats) l_stats_samp = .true.
+
+ ! Define physics buffers indexes
+ cld_idx = pbuf_get_index('CLD') ! Cloud fraction
+ concld_idx = pbuf_get_index('CONCLD') ! Convective cloud cover
+ ast_idx = pbuf_get_index('AST') ! Stratiform cloud fraction
+ alst_idx = pbuf_get_index('ALST') ! Liquid stratiform cloud fraction
+ aist_idx = pbuf_get_index('AIST') ! Ice stratiform cloud fraction
+ qlst_idx = pbuf_get_index('QLST') ! Physical in-stratus LWC
+ qist_idx = pbuf_get_index('QIST') ! Physical in-stratus IWC
+ dp_frac_idx = pbuf_get_index('DP_FRAC') ! Deep convection cloud fraction
+ icwmrdp_idx = pbuf_get_index('ICWMRDP') ! In-cloud deep convective mixing ratio
+ sh_frac_idx = pbuf_get_index('SH_FRAC') ! Shallow convection cloud fraction
+ relvar_idx = pbuf_get_index('RELVAR') ! Relative cloud water variance
+ accre_enhan_idx = pbuf_get_index('ACCRE_ENHAN') ! accretion enhancement for MG
+ prer_evap_idx = pbuf_get_index('PRER_EVAP')
+ qrl_idx = pbuf_get_index('QRL')
+ cmfmc_sh_idx = pbuf_get_index('CMFMC_SH')
+
+
+ iisclr_rt = -1
+ iisclr_thl = -1
+ iisclr_CO2 = -1
+
+ iiedsclr_rt = -1
+ iiedsclr_thl = -1
+ iiedsclr_CO2 = -1
+
+ if (zmconv_microp) then
+ dlfzm_idx = pbuf_get_index('DLFZM')
+ difzm_idx = pbuf_get_index('DIFZM')
+ dnlfzm_idx = pbuf_get_index('DNLFZM')
+ dnifzm_idx = pbuf_get_index('DNIFZM')
+ end if
+
+ ! ----------------------------------------------------------------- !
+ ! Define number of tracers for CLUBB to diffuse
+ ! ----------------------------------------------------------------- !
+
+ if (do_expldiff) then
+ offset = 2 ! diffuse temperature and moisture explicitly
+ edsclr_dim = edsclr_dim + offset
+ endif
+
+ ! ----------------------------------------------------------------- !
+ ! Setup CLUBB core
+ ! ----------------------------------------------------------------- !
+
+ ! Read in parameters for CLUBB. Just read in default values
+ call read_parameters_api( -99, "", clubb_params )
+
+ ! Fill in dummy arrays for height. Note that these are overwrote
+ ! at every CLUBB step to physical values.
+ do k=1,nlev+1
+ zt_g(k) = ((k-1)*1000._r8)-500._r8 ! this is dummy garbage
+ zi_g(k) = (k-1)*1000._r8 ! this is dummy garbage
+ enddo
+
+ ! Set CLUBB parameters
+ clubb_params(ilambda0_stability_coef) = clubb_lambda0_stability_coef
+ clubb_params(ic_K10) = clubb_c_K10
+ clubb_params(ic_K10h) = clubb_c_K10h
+ clubb_params(iC2rtthl) = clubb_C2rtthl
+ clubb_params(iC2rt) = clubb_C2rt
+ clubb_params(iC2thl) = clubb_C2thl
+ clubb_params(ibeta) = clubb_beta
+ clubb_params(iC7) = clubb_C7
+ clubb_params(iC7b) = clubb_C7b
+ clubb_params(iC8) = clubb_C8
+ clubb_params(iC11) = clubb_c11
+ clubb_params(iC11b) = clubb_c11b
+ clubb_params(iC14) = clubb_c14
+ clubb_params(igamma_coef) = clubb_gamma_coef
+ clubb_params(imult_coef) = clubb_mult_coef
+ clubb_params(iSkw_denom_coef) = clubb_Skw_denom_coef
+ clubb_params(ilmin_coef) = 0.1_r8
+
+!$OMP PARALLEL
+ l_do_expldiff_rtm_thlm = do_expldiff
+ l_Lscale_plume_centered = clubb_l_lscale_plume_centered
+ l_use_ice_latent = clubb_l_use_ice_latent
+
+ ! Set up CLUBB core. Note that some of these inputs are overwritten
+ ! when clubb_tend_cam is called. The reason is that heights can change
+ ! at each time step, which is why dummy arrays are read in here for heights
+ ! as they are immediately overwrote.
+ call setup_clubb_core_api &
+ ( nlev+1, theta0, ts_nudge, & ! In
+ hydromet_dim, sclr_dim, & ! In
+ sclr_tol, edsclr_dim, clubb_params, & ! In
+ l_host_applies_sfc_fluxes, & ! In
+ l_uv_nudge, saturation_equation, & ! In
+ l_implemented, grid_type, zi_g(2), zi_g(1), zi_g(nlev+1),& ! In
+ zi_g(1:nlev+1), zt_g(1:nlev+1), sfc_elevation, & ! In
+ err_code )
+!$OMP END PARALLEL
+
+ ! ----------------------------------------------------------------- !
+ ! Set-up HB diffusion. Only initialized to diagnose PBL depth !
+ ! ----------------------------------------------------------------- !
+
+ ! Initialize eddy diffusivity module
+
+ ntop_eddy = 1 ! if >1, must be <= nbot_molec
+ nbot_eddy = pver ! currently always pver
+
+ call init_hb_diff( gravit, cpair, ntop_eddy, nbot_eddy, pref_mid, karman, eddy_scheme )
+
+ ! ----------------------------------------------------------------- !
+ ! Add output fields for the history files
+ ! ----------------------------------------------------------------- !
+
+ ! These are default CLUBB output. Not the higher order history budgets
+ call addfld ('RHO_CLUBB', (/ 'ilev' /), 'A', 'kg/m3', 'Air Density')
+ call addfld ('UP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Velocity Variance')
+ call addfld ('VP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Velocity Variance')
+ call addfld ('WP2_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Vertical Velocity Variance')
+ call addfld ('UPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Zonal Momentum Flux')
+ call addfld ('VPWP_CLUBB', (/ 'ilev' /), 'A', 'm2/s2', 'Meridional Momentum Flux')
+ call addfld ('WP3_CLUBB', (/ 'ilev' /), 'A', 'm3/s3', 'Third Moment Vertical Velocity')
+ call addfld ('WPTHLP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Heat Flux')
+ call addfld ('WPRTP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Moisture Flux')
+ call addfld ('RTP2_CLUBB', (/ 'ilev' /), 'A', 'g^2/kg^2', 'Moisture Variance')
+ call addfld ('THLP2_CLUBB', (/ 'ilev' /), 'A', 'K^2', 'Temperature Variance')
+ call addfld ('RTPTHLP_CLUBB', (/ 'ilev' /), 'A', 'K g/kg', 'Temp. Moist. Covariance')
+ call addfld ('RCM_CLUBB', (/ 'ilev' /), 'A', 'g/kg', 'Cloud Water Mixing Ratio')
+ call addfld ('WPRCP_CLUBB', (/ 'ilev' /), 'A', 'W/m2', 'Liquid Water Flux')
+ call addfld ('CLOUDFRAC_CLUBB', (/ 'lev' /), 'A', 'fraction', 'Cloud Fraction')
+ call addfld ('RCMINLAYER_CLUBB', (/ 'ilev' /), 'A', 'g/kg', 'Cloud Water in Layer')
+ call addfld ('CLOUDCOVER_CLUBB', (/ 'ilev' /), 'A', 'fraction', 'Cloud Cover')
+ call addfld ('WPTHVP_CLUBB', (/ 'lev' /), 'A', 'W/m2', 'Buoyancy Flux')
+ call addfld ('RVMTEND_CLUBB', (/ 'lev' /), 'A', 'g/kg /s', 'Water vapor tendency')
+ call addfld ('STEND_CLUBB', (/ 'lev' /), 'A', 'k/s', 'Temperature tendency')
+ call addfld ('RCMTEND_CLUBB', (/ 'lev' /), 'A', 'g/kg /s', 'Cloud Liquid Water Tendency')
+ call addfld ('RIMTEND_CLUBB', (/ 'lev' /), 'A', 'g/kg /s', 'Cloud Ice Tendency')
+ call addfld ('UTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'U-wind Tendency')
+ call addfld ('VTEND_CLUBB', (/ 'lev' /), 'A', 'm/s /s', 'V-wind Tendency')
+ call addfld ('ZT_CLUBB', (/ 'ilev' /), 'A', 'm', 'Thermodynamic Heights')
+ call addfld ('ZM_CLUBB', (/ 'ilev' /), 'A', 'm', 'Momentum Heights')
+ call addfld ('UM_CLUBB', (/ 'ilev' /), 'A', 'm/s', 'Zonal Wind')
+ call addfld ('VM_CLUBB', (/ 'ilev' /), 'A', 'm/s', 'Meridional Wind')
+ call addfld ('THETAL', (/ 'lev' /), 'A', 'K', 'Liquid Water Potential Temperature')
+ call addfld ('PBLH', horiz_only, 'A', 'm', 'PBL height')
+ call addfld ('QT', (/ 'lev' /), 'A', 'kg/kg', 'Total water mixing ratio')
+ call addfld ('SL', (/ 'lev' /), 'A', 'J/kg', 'Liquid water static energy')
+ call addfld ('CLDST', (/ 'lev' /), 'A', 'fraction', 'Stratus cloud fraction')
+ call addfld ('ZMDLF', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from ZM convection')
+ call addfld ('TTENDICE', (/ 'lev' /), 'A', 'K/s', 'T tendency from Ice Saturation Adjustment')
+ call addfld ('QVTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Q tendency from Ice Saturation Adjustment')
+ call addfld ('QCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'CLDICE tendency from Ice Saturation Adjustment')
+ call addfld ('NCTENDICE', (/ 'lev' /), 'A', 'kg/kg/s', 'NUMICE tendency from Ice Saturation Adjustment')
+ call addfld ('FQTENDICE', (/ 'lev' /), 'A', 'fraction', 'Frequency of Ice Saturation Adjustment')
+
+ call addfld ('DPDLFLIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained liquid water from deep convection')
+ call addfld ('DPDLFICE', (/ 'lev' /), 'A', 'kg/kg/s', 'Detrained ice from deep convection')
+ call addfld ('DPDLFT', (/ 'lev' /), 'A', 'K/s', 'T-tendency due to deep convective detrainment')
+ call addfld ('RELVAR', (/ 'lev' /), 'A', '-', 'Relative cloud water variance')
+ call addfld ('CLUBB_GRID_SIZE', horiz_only, 'A', 'm', 'Horizontal grid box size seen by CLUBB')
+
+
+ call addfld ('CONCLD', (/ 'lev' /), 'A', 'fraction', 'Convective cloud cover')
+ call addfld ('CMELIQ', (/ 'lev' /), 'A', 'kg/kg/s', 'Rate of cond-evap of liq within the cloud')
+
+ call addfld ('QSATFAC', (/ 'lev' /), 'A', '-', 'Subgrid cloud water saturation scaling factor')
+ call addfld ('KVH_CLUBB', (/ 'ilev' /), 'A', 'm2/s', 'Vertical Diffusivity')
+
+ ! Initialize statistics, below are dummy variables
+ dum1 = 300._r8
+ dum2 = 1200._r8
+ dum3 = 300._r8
+
+ if (l_stats) then
+
+ call stats_init_clubb( .true., dum1, dum2, &
+ nlev+1, nlev+1, nlev+1, dum3 )
+
+ allocate(out_zt(pcols,pverp,stats_zt%num_output_fields))
+ allocate(out_zm(pcols,pverp,stats_zm%num_output_fields))
+ allocate(out_sfc(pcols,1,stats_sfc%num_output_fields))
+
+ allocate(out_radzt(pcols,pverp,stats_rad_zt%num_output_fields))
+ allocate(out_radzm(pcols,pverp,stats_rad_zm%num_output_fields))
+
+ endif
+
+ ! ----------------------------------------------------------------- !
+ ! Make all of this output default, this is not CLUBB history
+ ! ----------------------------------------------------------------- !
+ if (clubb_do_adv .or. history_clubb) then
+ call add_default('WP2_CLUBB', 1, ' ')
+ call add_default('WP3_CLUBB', 1, ' ')
+ call add_default('WPTHLP_CLUBB', 1, ' ')
+ call add_default('WPRTP_CLUBB', 1, ' ')
+ call add_default('RTP2_CLUBB', 1, ' ')
+ call add_default('THLP2_CLUBB', 1, ' ')
+ call add_default('RTPTHLP_CLUBB', 1, ' ')
+ call add_default('UP2_CLUBB', 1, ' ')
+ call add_default('VP2_CLUBB', 1, ' ')
+ end if
+
+ if (history_clubb) then
+
+ call add_default('RELVAR', 1, ' ')
+ call add_default('RHO_CLUBB', 1, ' ')
+ call add_default('UPWP_CLUBB', 1, ' ')
+ call add_default('VPWP_CLUBB', 1, ' ')
+ call add_default('RCM_CLUBB', 1, ' ')
+ call add_default('WPRCP_CLUBB', 1, ' ')
+ call add_default('CLOUDFRAC_CLUBB', 1, ' ')
+ call add_default('RCMINLAYER_CLUBB', 1, ' ')
+ call add_default('CLOUDCOVER_CLUBB', 1, ' ')
+ call add_default('WPTHVP_CLUBB', 1, ' ')
+ call add_default('RVMTEND_CLUBB', 1, ' ')
+ call add_default('STEND_CLUBB', 1, ' ')
+ call add_default('RCMTEND_CLUBB', 1, ' ')
+ call add_default('RIMTEND_CLUBB', 1, ' ')
+ call add_default('UTEND_CLUBB', 1, ' ')
+ call add_default('VTEND_CLUBB', 1, ' ')
+ call add_default('ZT_CLUBB', 1, ' ')
+ call add_default('ZM_CLUBB', 1, ' ')
+ call add_default('UM_CLUBB', 1, ' ')
+ call add_default('VM_CLUBB', 1, ' ')
+ call add_default('SL', 1, ' ')
+ call add_default('QT', 1, ' ')
+ call add_default('CONCLD', 1, ' ')
+
+ end if
+
+ if (history_amwg) then
+ call add_default('PBLH', 1, ' ')
+ end if
+
+ if (history_budget) then
+ call add_default('DPDLFLIQ', history_budget_histfile_num, ' ')
+ call add_default('DPDLFICE', history_budget_histfile_num, ' ')
+ call add_default('DPDLFT', history_budget_histfile_num, ' ')
+ call add_default('STEND_CLUBB', history_budget_histfile_num, ' ')
+ call add_default('RCMTEND_CLUBB', history_budget_histfile_num, ' ')
+ call add_default('RIMTEND_CLUBB', history_budget_histfile_num, ' ')
+ call add_default('RVMTEND_CLUBB', history_budget_histfile_num, ' ')
+ call add_default('UTEND_CLUBB', history_budget_histfile_num, ' ')
+ call add_default('VTEND_CLUBB', history_budget_histfile_num, ' ')
+ endif
+
+
+ ! --------------- !
+ ! First step? !
+ ! Initialization !
+ ! --------------- !
+
+ ! Is this the first time step? If so then initialize CLUBB variables as follows
+ if (is_first_step()) then
+
+ call pbuf_set_field(pbuf2d, wp2_idx, w_tol_sqd)
+ call pbuf_set_field(pbuf2d, wp3_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, wpthlp_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, wprtp_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, rtpthlp_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, rtp2_idx, rt_tol**2)
+ call pbuf_set_field(pbuf2d, thlp2_idx, thl_tol**2)
+ call pbuf_set_field(pbuf2d, up2_idx, w_tol_sqd)
+ call pbuf_set_field(pbuf2d, vp2_idx, w_tol_sqd)
+
+ call pbuf_set_field(pbuf2d, upwp_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, vpwp_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, tke_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, kvh_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, radf_idx, 0.0_r8)
+
+ endif
+
+ ! The following is physpkg, so it needs to be initialized every time
+ call pbuf_set_field(pbuf2d, fice_idx, 0.0_r8)
+
+ ! --------------- !
+ ! End !
+ ! Initialization !
+ ! --------------- !
+
+#endif
+ end subroutine clubb_ini_cam
+
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+
+ subroutine clubb_tend_cam( &
+ state, ptend_all, pbuf, hdtime, &
+ cmfmc, cam_in, &
+ macmic_it, cld_macmic_num_steps,dlf, det_s, det_ice)
+
+!-------------------------------------------------------------------------------
+! Description: Provide tendencies of shallow convection, turbulence, and
+! macrophysics from CLUBB to CAM
+!
+! Author: Cheryl Craig, March 2011
+! Modifications: Pete Bogenschutz, March 2011 and onward
+! Origin: Based heavily on UWM clubb_init.F90
+! References:
+! None
+!-------------------------------------------------------------------------------
+
+ use physics_types, only: physics_state, physics_ptend, &
+ physics_state_copy, physics_ptend_init, &
+ physics_ptend_sum, physics_update
+
+ use physics_buffer, only: pbuf_get_index, pbuf_old_tim_idx, pbuf_get_field, &
+ physics_buffer_desc
+
+ use constituents, only: cnst_get_ind
+ use camsrfexch, only: cam_in_t
+ use time_manager, only: is_first_step
+ use cam_abortutils, only: endrun
+ use tropopause, only: tropopause_findChemTrop
+
+#ifdef CLUBB_SGS
+ use hb_diff, only: pblintd
+ use scamMOD, only: single_column,scm_clubb_iop_name
+ use clubb_api_module, only: &
+ nparams, &
+ read_parameters_api, &
+ setup_parameters_api, &
+ setup_grid_heights_api, &
+ w_tol_sqd, &
+ rt_tol, &
+ thl_tol, &
+ l_stats, &
+ stats_tsamp, &
+ stats_tout, &
+ stats_zt, &
+ stats_sfc, &
+ stats_zm, &
+ stats_rad_zt, &
+ stats_rad_zm, &
+ l_output_rad_files, &
+ pdf_parameter, &
+ stats_begin_timestep_api, &
+ advance_clubb_core_api, &
+ calculate_thlp2_rad_api, &
+ update_xp2_mc_api, &
+ zt2zm_api, zm2zt_api
+
+ ! These are not exposed by the api module, but we want them anyway!
+ use cldfrc2m, only: aist_vector, rhmini_const, rhmaxi_const, rhminis_const, rhmaxis_const
+ use cam_history, only: outfld
+
+ use macrop_driver, only: liquid_macro_tend
+#endif
+
+ implicit none
+
+ ! --------------- !
+ ! Input Auguments !
+ ! --------------- !
+
+ type(physics_state), intent(in) :: state ! Physics state variables [vary]
+ type(cam_in_t), intent(in) :: cam_in
+ real(r8), intent(in) :: hdtime ! Host model timestep [s]
+ real(r8), intent(in) :: dlf(pcols,pver) ! Detraining cld H20 from deep convection [kg/ks/s]
+ real(r8), intent(in) :: cmfmc(pcols,pverp) ! convective mass flux--m sub c [kg/m2/s]
+ integer, intent(in) :: cld_macmic_num_steps ! number of mac-mic iterations
+ integer, intent(in) :: macmic_it ! number of mac-mic iterations
+
+ ! ---------------------- !
+ ! Input-Output Auguments !
+ ! ---------------------- !
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! ---------------------- !
+ ! Output Auguments !
+ ! ---------------------- !
+
+ type(physics_ptend), intent(out) :: ptend_all ! package tendencies
+
+ ! These two variables are needed for energy check
+ real(r8), intent(out) :: det_s(pcols) ! Integral of detrained static energy from ice
+ real(r8), intent(out) :: det_ice(pcols) ! Integral of detrained ice for energy check
+
+
+ ! --------------- !
+ ! Local Variables !
+ ! --------------- !
+
+#ifdef CLUBB_SGS
+
+ type(physics_state) :: state1 ! Local copy of state variable
+ type(physics_ptend) :: ptend_loc ! Local tendency from processes, added up to return as ptend_all
+
+ integer :: i, k, t, ixind, nadv
+ integer :: ixcldice, ixcldliq, ixnumliq, ixnumice, ixq
+ integer :: itim_old
+ integer :: ncol, lchnk ! # of columns, and chunk identifier
+ integer :: err_code ! Diagnostic, for if some calculation goes amiss.
+ integer :: icnt, clubbtop
+ logical :: lq2(pcnst)
+
+
+ real(r8) :: frac_limit, ic_limit
+
+ real(r8) :: dtime ! CLUBB time step [s]
+ real(r8) :: edsclr_in(pverp+1-top_lev,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary]
+ real(r8) :: wp2_in(pverp+1-top_lev) ! vertical velocity variance (CLUBB) [m^2/s^2]
+ real(r8) :: wp3_in(pverp+1-top_lev) ! third moment vertical velocity [m^3/s^3]
+ real(r8) :: wpthlp_in(pverp+1-top_lev) ! turbulent flux of thetal [K m/s]
+ real(r8) :: wprtp_in(pverp+1-top_lev) ! turbulent flux of total water [kg/kg m/s]
+ real(r8) :: rtpthlp_in(pverp+1-top_lev) ! covariance of thetal and qt [kg/kg K]
+ real(r8) :: rtp2_in(pverp+1-top_lev) ! total water variance [kg^2/k^2]
+ real(r8) :: rtp3_in(pverp+1-top_lev) ! r_t'^3 (thermodynamic levels) (unused) [(kg/kg)^3]
+ real(r8) :: thlp2_in(pverp+1-top_lev) ! thetal variance [K^2]
+ real(r8) :: thlp3_in(pverp+1-top_lev) ! th_l'^3 (thermodynamic levels) (unused) [K^3]
+ real(r8) :: up2_in(pverp+1-top_lev) ! meridional wind variance [m^2/s^2]
+ real(r8) :: vp2_in(pverp+1-top_lev) ! zonal wind variance [m^2/s^2]
+ real(r8) :: upwp_in(pverp+1-top_lev) ! meridional wind flux [m^2/s^2]
+ real(r8) :: vpwp_in(pverp+1-top_lev) ! zonal wind flux [m^2/s^2]
+ real(r8) :: thlm_in(pverp+1-top_lev) ! liquid water potential temperature (thetal) [K]
+ real(r8) :: rtm_in(pverp+1-top_lev) ! total water mixing ratio [kg/kg]
+ real(r8) :: rvm_in(pverp+1-top_lev) ! water vapor mixing ratio [kg/kg]
+ real(r8) :: um_in(pverp+1-top_lev) ! meridional wind [m/s]
+ real(r8) :: vm_in(pverp+1-top_lev) ! zonal wind [m/s]
+ real(r8) :: rho_in(pverp+1-top_lev) ! mid-point density [kg/m^3]
+ real(r8) :: pre_in(pverp+1-top_lev) ! input for precip evaporation
+ real(r8) :: rtp2_mc_out(pverp+1-top_lev) ! total water tendency from rain evap
+ real(r8) :: thlp2_mc_out(pverp+1-top_lev) ! thetal tendency from rain evap
+ real(r8) :: wprtp_mc_out(pverp+1-top_lev)
+ real(r8) :: wpthlp_mc_out(pverp+1-top_lev)
+ real(r8) :: rtpthlp_mc_out(pverp+1-top_lev)
+ real(r8) :: rcm_out(pverp+1-top_lev) ! CLUBB output of liquid water mixing ratio [kg/kg]
+ real(r8) :: rcm_out_zm(pverp+1-top_lev)
+ real(r8) :: wprcp_out(pverp+1-top_lev) ! CLUBB output of flux of liquid water [kg/kg m/s]
+ real(r8) :: cloud_frac_out(pverp+1-top_lev) ! CLUBB output of cloud fraction [fraction]
+ real(r8) :: rcm_in_layer_out(pverp+1-top_lev)! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg]
+ real(r8) :: cloud_cover_out(pverp+1-top_lev) ! CLUBB output of in-cloud cloud fraction [fraction]
+ real(r8) :: thlprcp_out(pverp+1-top_lev)
+ real(r8) :: rho_ds_zm(pverp+1-top_lev) ! Dry, static density on momentum levels [kg/m^3]
+ real(r8) :: rho_ds_zt(pverp+1-top_lev) ! Dry, static density on thermodynamic levels [kg/m^3]
+ real(r8) :: invrs_rho_ds_zm(pverp+1-top_lev) ! Inv. dry, static density on momentum levels [m^3/kg]
+ real(r8) :: invrs_rho_ds_zt(pverp+1-top_lev) ! Inv. dry, static density on thermo. levels [m^3/kg]
+ real(r8) :: thv_ds_zm(pverp+1-top_lev) ! Dry, base-state theta_v on momentum levels [K]
+ real(r8) :: thv_ds_zt(pverp+1-top_lev) ! Dry, base-state theta_v on thermo. levels [K]
+ real(r8) :: rfrzm(pverp+1-top_lev)
+ real(r8) :: radf(pverp+1-top_lev)
+ real(r8) :: wprtp_forcing(pverp+1-top_lev)
+ real(r8) :: wpthlp_forcing(pverp+1-top_lev)
+ real(r8) :: rtp2_forcing(pverp+1-top_lev)
+ real(r8) :: thlp2_forcing(pverp+1-top_lev)
+ real(r8) :: rtpthlp_forcing(pverp+1-top_lev)
+ real(r8) :: ice_supersat_frac(pverp+1-top_lev)
+ real(r8) :: zt_g(pverp+1-top_lev) ! Thermodynamic grid of CLUBB [m]
+ real(r8) :: zi_g(pverp+1-top_lev) ! Momentum grid of CLUBB [m]
+ real(r8) :: zt_out(pcols,pverp) ! output for the thermo CLUBB grid [m]
+ real(r8) :: zi_out(pcols,pverp) ! output for momentum CLUBB grid [m]
+ real(r8) :: fcor ! Coriolis forcing [s^-1]
+ real(r8) :: sfc_elevation ! Elevation of ground [m AMSL]
+ real(r8) :: ubar ! surface wind [m/s]
+ real(r8) :: ustar ! surface stress [m/s]
+ real(r8) :: thlm_forcing(pverp+1-top_lev) ! theta_l forcing (thermodynamic levels) [K/s]
+ real(r8) :: rtm_forcing(pverp+1-top_lev) ! r_t forcing (thermodynamic levels) [(kg/kg)/s]
+ real(r8) :: um_forcing(pverp+1-top_lev) ! u wind forcing (thermodynamic levels) [m/s/s]
+ real(r8) :: vm_forcing(pverp+1-top_lev) ! v wind forcing (thermodynamic levels) [m/s/s]
+ real(r8) :: wm_zm(pverp+1-top_lev) ! w mean wind component on momentum levels [m/s]
+ real(r8) :: wm_zt(pverp+1-top_lev) ! w mean wind component on thermo. levels [m/s]
+ real(r8) :: p_in_Pa(pverp+1-top_lev) ! Air pressure (thermodynamic levels) [Pa]
+ real(r8) :: rho_zt(pverp+1-top_lev) ! Air density on thermo levels [kt/m^3]
+ real(r8) :: rho_zm(pverp+1-top_lev) ! Air density on momentum levels [kg/m^3]
+ real(r8) :: exner(pverp+1-top_lev) ! Exner function (thermodynamic levels) [-]
+ real(r8) :: wpthlp_sfc ! w' theta_l' at surface [(m K)/s]
+ real(r8) :: wprtp_sfc ! w' r_t' at surface [(kg m)/( kg s)]
+ real(r8) :: upwp_sfc ! u'w' at surface [m^2/s^2]
+ real(r8) :: vpwp_sfc ! v'w' at surface [m^2/s^2]
+ real(r8) :: sclrm_forcing(pverp+1-top_lev,sclr_dim) ! Passive scalar forcing [{units vary}/s]
+ real(r8) :: wpsclrp_sfc(sclr_dim) ! Scalar flux at surface [{units vary} m/s]
+ real(r8) :: edsclrm_forcing(pverp+1-top_lev,edsclr_dim)! Eddy passive scalar forcing [{units vary}/s]
+ real(r8) :: wpedsclrp_sfc(edsclr_dim) ! Eddy-scalar flux at surface [{units vary} m/s]
+ real(r8) :: sclrm(pverp+1-top_lev,sclr_dim) ! Passive scalar mean (thermo. levels) [units vary]
+ real(r8) :: wpsclrp(pverp+1-top_lev,sclr_dim)! w'sclr' (momentum levels) [{units vary} m/s]
+ real(r8) :: sclrp2(pverp+1-top_lev,sclr_dim) ! sclr'^2 (momentum levels) [{units vary}^2]
+ real(r8) :: sclrprtp(pverp+1-top_lev,sclr_dim) ! sclr'rt' (momentum levels) [{units vary} (kg/kg)]
+ real(r8) :: sclrpthlp(pverp+1-top_lev,sclr_dim) ! sclr'thlp' (momentum levels) [{units vary} (K)]
+ real(r8) :: hydromet(pverp+1-top_lev,hydromet_dim)
+ real(r8) :: wphydrometp(pverp+1-top_lev,hydromet_dim)
+ real(r8) :: wp2hmp(pverp+1-top_lev,hydromet_dim)
+ real(r8) :: rtphmp_zt(pverp+1-top_lev,hydromet_dim)
+ real(r8) :: thlphmp_zt (pverp+1-top_lev,hydromet_dim)
+ real(r8) :: bflx22 ! Variable for buoyancy flux for pbl [K m/s]
+ real(r8) :: khzm_out(pverp+1-top_lev) ! eddy diffusivity on momentum grids [m^2/s]
+ real(r8) :: khzt_out(pverp+1-top_lev) ! eddy diffusivity on thermo grids [m^2/s]
+ real(r8) :: qclvar_out(pverp+1-top_lev) ! cloud water variance [kg^2/kg^2]
+ real(r8) :: qclvar(pcols,pverp) ! cloud water variance [kg^2/kg^2]
+ real(r8) :: zo ! roughness height [m]
+ real(r8) :: dz_g(pver) ! thickness of layer [m]
+ real(r8) :: relvarmax
+ real(r8) :: se_upper_a, se_upper_b, se_upper_diss
+ real(r8) :: tw_upper_a, tw_upper_b, tw_upper_diss
+ real(r8) :: grid_dx(pcols), grid_dy(pcols) ! CAM grid [m]
+ real(r8) :: host_dx, host_dy ! CAM grid [m]
+
+ ! Variables below are needed to compute energy integrals for conservation
+ real(r8) :: ke_a(pcols), ke_b(pcols), te_a(pcols), te_b(pcols)
+ real(r8) :: wv_a(pcols), wv_b(pcols), wl_b(pcols), wl_a(pcols)
+ real(r8) :: se_dis, se_a(pcols), se_b(pcols), clubb_s(pver)
+
+ real(r8) :: exner_clubb(pcols,pverp) ! Exner function consistent with CLUBB [-]
+ real(r8) :: wpthlp_output(pcols,pverp) ! Heat flux output variable [W/m2]
+ real(r8) :: wprtp_output(pcols,pverp) ! Total water flux output variable [W/m2]
+ real(r8) :: wp3_output(pcols,pverp) ! wp3 output [m^3/s^3]
+ real(r8) :: rtpthlp_output(pcols,pverp) ! rtpthlp ouptut [K kg/kg]
+ real(r8) :: qt_output(pcols,pver) ! Total water mixing ratio for output [kg/kg]
+ real(r8) :: thetal_output(pcols,pver) ! Liquid water potential temperature output [K]
+ real(r8) :: sl_output(pcols,pver) ! Liquid water static energy [J/kg]
+ real(r8) :: ustar2(pcols) ! Surface stress for PBL height [m2/s2]
+ real(r8) :: rho(pcols,pverp) ! Midpoint density in CAM [kg/m^3]
+ real(r8) :: thv(pcols,pver) ! virtual potential temperature [K]
+ real(r8) :: edsclr_out(pverp,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary]
+ real(r8) :: rcm(pcols,pverp) ! CLUBB cloud water mixing ratio [kg/kg]
+ real(r8) :: cloud_frac(pcols,pverp) ! CLUBB cloud fraction [fraction]
+ real(r8) :: rcm_in_layer(pcols,pverp) ! CLUBB in-cloud liquid water mixing ratio [kg/kg]
+ real(r8) :: wprcp(pcols,pverp) ! CLUBB liquid water flux [m/s kg/kg]
+ real(r8) :: wpthvp(pcols,pverp) ! CLUBB buoyancy flux [W/m^2]
+ real(r8) :: rvm(pcols,pverp)
+ real(r8) :: dlf2(pcols,pver) ! Detraining cld H20 from shallow convection [kg/kg/day]
+ real(r8) :: eps ! Rv/Rd [-]
+ real(r8) :: dum1 ! dummy variable [units vary]
+ real(r8) :: obklen(pcols) ! Obukov length [m]
+ real(r8) :: kbfs(pcols) ! Kinematic Surface heat flux [K m/s]
+ real(r8) :: th(pcols,pver) ! potential temperature [K]
+ real(r8) :: dummy2(pcols) ! dummy variable [units vary]
+ real(r8) :: dummy3(pcols) ! dummy variable [units vary]
+ real(r8) :: kinheat(pcols) ! Kinematic Surface heat flux [K m/s]
+ real(r8) :: rrho(pcols) ! Inverse of air density [1/kg/m^3]
+ real(r8) :: kinwat(pcols) ! Kinematic water vapor flux [m/s]
+ real(r8) :: latsub
+ real(r8) :: qrl_clubb(pverp+1-top_lev)
+ real(r8) :: qrl_zm(pverp+1-top_lev)
+ real(r8) :: thlp2_rad_out(pverp+1-top_lev)
+ real(r8) :: apply_const, rtm_test
+
+ integer :: time_elapsed ! time keep track of stats [s]
+ real(r8), dimension(nparams) :: clubb_params ! These adjustable CLUBB parameters (C1, C2 ...)
+ type(pdf_parameter), dimension(pverp) :: pdf_params ! PDF parameters [units vary]
+ character(len=200) :: temp1, sub ! Strings needed for CLUBB output
+
+
+ ! --------------- !
+ ! Pointers !
+ ! --------------- !
+
+ real(r8), pointer, dimension(:,:) :: wp2 ! vertical velocity variance [m^2/s^2]
+ real(r8), pointer, dimension(:,:) :: wp3 ! third moment of vertical velocity [m^3/s^3]
+ real(r8), pointer, dimension(:,:) :: wpthlp ! turbulent flux of thetal [m/s K]
+ real(r8), pointer, dimension(:,:) :: wprtp ! turbulent flux of moisture [m/s kg/kg]
+ real(r8), pointer, dimension(:,:) :: rtpthlp ! covariance of thetal and qt [kg/kg K]
+ real(r8), pointer, dimension(:,:) :: rtp2 ! moisture variance [kg^2/kg^2]
+ real(r8), pointer, dimension(:,:) :: thlp2 ! temperature variance [K^2]
+ real(r8), pointer, dimension(:,:) :: up2 ! east-west wind variance [m^2/s^2]
+ real(r8), pointer, dimension(:,:) :: vp2 ! north-south wind variance [m^2/s^2]
+
+ real(r8), pointer, dimension(:,:) :: upwp ! east-west momentum flux [m^2/s^2]
+ real(r8), pointer, dimension(:,:) :: vpwp ! north-south momentum flux [m^2/s^2]
+ real(r8), pointer, dimension(:,:) :: thlm ! mean temperature [K]
+ real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio [kg/kg]
+ real(r8), pointer, dimension(:,:) :: um ! mean east-west wind [m/s]
+ real(r8), pointer, dimension(:,:) :: vm ! mean north-south wind [m/s]
+ real(r8), pointer, dimension(:,:) :: cld ! cloud fraction [fraction]
+ real(r8), pointer, dimension(:,:) :: concld ! convective cloud fraction [fraction]
+ real(r8), pointer, dimension(:,:) :: ast ! stratiform cloud fraction [fraction]
+ real(r8), pointer, dimension(:,:) :: alst ! liquid stratiform cloud fraction [fraction]
+ real(r8), pointer, dimension(:,:) :: aist ! ice stratiform cloud fraction [fraction]
+ real(r8), pointer, dimension(:,:) :: qlst ! Physical in-stratus LWC [kg/kg]
+ real(r8), pointer, dimension(:,:) :: qist ! Physical in-stratus IWC [kg/kg]
+ real(r8), pointer, dimension(:,:) :: deepcu ! deep convection cloud fraction [fraction]
+ real(r8), pointer, dimension(:,:) :: shalcu ! shallow convection cloud fraction [fraction]
+ real(r8), pointer, dimension(:,:) :: khzt ! eddy diffusivity on thermo levels [m^2/s]
+ real(r8), pointer, dimension(:,:) :: khzm ! eddy diffusivity on momentum levels [m^2/s]
+ real(r8), pointer, dimension(:) :: pblh ! planetary boundary layer height [m]
+ real(r8), pointer, dimension(:,:) :: tke ! turbulent kinetic energy [m^2/s^2]
+ real(r8), pointer, dimension(:,:) :: dp_icwmr ! deep convection in cloud mixing ratio [kg/kg]
+ real(r8), pointer, dimension(:,:) :: relvar ! relative cloud water variance [-]
+ real(r8), pointer, dimension(:,:) :: accre_enhan ! accretion enhancement factor [-]
+ real(r8), pointer, dimension(:,:) :: cmeliq
+ real(r8), pointer, dimension(:,:) :: cmfmc_sh ! Shallow convective mass flux--m subc (pcols,pverp) [kg/m2/s/]
+
+ real(r8), pointer, dimension(:,:) :: qsatfac
+ real(r8), pointer, dimension(:,:) :: npccn
+ real(r8), pointer, dimension(:,:) :: prer_evap
+ real(r8), pointer, dimension(:,:) :: qrl
+ real(r8), pointer, dimension(:,:) :: radf_clubb
+
+ ! ZM microphysics
+ real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio.
+ real(r8), pointer :: difzm(:,:) ! ZM detrained convective cloud ice mixing ratio.
+ real(r8), pointer :: dnlfzm(:,:) ! ZM detrained convective cloud water num concen.
+ real(r8), pointer :: dnifzm(:,:) ! ZM detrained convective cloud ice num concen.
+
+ real(r8) :: stend(pcols,pver)
+ real(r8) :: qvtend(pcols,pver)
+ real(r8) :: qctend(pcols,pver)
+ real(r8) :: inctend(pcols,pver)
+ real(r8) :: fqtend(pcols,pver)
+ real(r8) :: rhmini(pcols)
+ real(r8) :: rhmaxi(pcols)
+ integer :: troplev(pcols)
+ logical :: lqice(pcnst)
+ logical :: apply_to_surface
+
+ real(r8) :: temp2d(pcols,pver), temp2dp(pcols,pverp) ! temporary array for holding scaled outputs
+
+ integer :: nlev
+
+ intrinsic :: max
+
+#endif
+ det_s(:) = 0.0_r8
+ det_ice(:) = 0.0_r8
+#ifdef CLUBB_SGS
+
+ !-----------------------------------------------------------------------------------------------!
+ !-----------------------------------------------------------------------------------------------!
+ !-----------------------------------------------------------------------------------------------!
+ ! MAIN COMPUTATION BEGINS HERE !
+ !-----------------------------------------------------------------------------------------------!
+ !-----------------------------------------------------------------------------------------------!
+ !-----------------------------------------------------------------------------------------------!
+
+ nlev = pver + 1 - top_lev
+
+ frac_limit = 0.01_r8
+ ic_limit = 1.e-12_r8
+
+ if (clubb_do_adv) then
+ apply_const = 1._r8 ! Initialize to one, only if CLUBB's moments are advected
+ else
+ apply_const = 0._r8 ! Never want this if CLUBB's moments are not advected
+ endif
+
+ ! Get indicees for cloud and ice mass and cloud and ice number
+
+ call cnst_get_ind('Q',ixq)
+ call cnst_get_ind('CLDLIQ',ixcldliq)
+ call cnst_get_ind('CLDICE',ixcldice)
+ call cnst_get_ind('NUMLIQ',ixnumliq)
+ call cnst_get_ind('NUMICE',ixnumice)
+
+ ! Copy the state to state1 array to use in this routine
+
+ ! Initialize physics tendency arrays, copy the state to state1 array to use in this routine
+ call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq)
+ call physics_ptend_init(ptend_all, state%psetcols, 'clubb')
+
+ call physics_state_copy(state,state1)
+
+ if (clubb_do_liqsupersat) then
+ npccn_idx = pbuf_get_index('NPCCN')
+ call pbuf_get_field(pbuf, npccn_idx, npccn)
+ endif
+
+ ! Determine number of columns and which chunk computation is to be performed on
+
+ ncol = state%ncol
+ lchnk = state%lchnk
+
+ ! Determine time step of physics buffer
+
+ itim_old = pbuf_old_tim_idx()
+
+ ! Establish associations between pointers and physics buffer fields
+
+ call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, wpthlp_idx, wpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, wprtp_idx, wprtp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, rtpthlp_idx, rtpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, rtp2_idx, rtp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, thlp2_idx, thlp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, up2_idx, up2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, vp2_idx, vp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+
+ call pbuf_get_field(pbuf, upwp_idx, upwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, vpwp_idx, vpwp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, thlm_idx, thlm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+ call pbuf_get_field(pbuf, vm_idx, vm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/))
+
+ call pbuf_get_field(pbuf, tke_idx, tke)
+ call pbuf_get_field(pbuf, qrl_idx, qrl)
+ call pbuf_get_field(pbuf, radf_idx, radf_clubb)
+
+ call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, concld_idx, concld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, ast_idx, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, alst_idx, alst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, aist_idx, aist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, qlst_idx, qlst, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+ call pbuf_get_field(pbuf, qist_idx, qist, start=(/1,1,itim_old/), kount=(/pcols,pver,1/))
+
+ call pbuf_get_field(pbuf, qsatfac_idx, qsatfac)
+
+ call pbuf_get_field(pbuf, prer_evap_idx, prer_evap)
+ call pbuf_get_field(pbuf, accre_enhan_idx, accre_enhan)
+ call pbuf_get_field(pbuf, cmeliq_idx, cmeliq)
+ call pbuf_get_field(pbuf, relvar_idx, relvar)
+ call pbuf_get_field(pbuf, dp_frac_idx, deepcu)
+ call pbuf_get_field(pbuf, sh_frac_idx, shalcu)
+ call pbuf_get_field(pbuf, kvm_idx, khzt)
+ call pbuf_get_field(pbuf, kvh_idx, khzm)
+ call pbuf_get_field(pbuf, pblh_idx, pblh)
+ call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr)
+ call pbuf_get_field(pbuf, cmfmc_sh_idx, cmfmc_sh)
+
+ ! Initialize the apply_const variable (note special logic is due to eularian backstepping)
+ if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp(1:ncol,1:pver) .eq. 0._r8))) then
+ apply_const = 0._r8 ! On first time through do not remove constant
+ ! from moments since it has not been added yet
+ endif
+
+ ! Define the grid box size. CLUBB needs this information to determine what
+ ! the maximum length scale should be. This depends on the column for
+ ! variable mesh grids and lat-lon grids
+ if (single_column) then
+ ! If single column specify grid box size to be something
+ ! similar to a GCM run
+ grid_dx(:) = 100000._r8
+ grid_dy(:) = 100000._r8
+ else
+
+ call grid_size(state1, grid_dx, grid_dy)
+
+ endif
+
+ ! Determine CLUBB time step and make it sub-step friendly
+ ! For now we want CLUBB time step to be 5 min since that is
+ ! what has been scientifically validated. However, there are certain
+ ! instances when a 5 min time step will not be possible (based on
+ ! host model time step or on macro-micro sub-stepping
+
+ dtime = clubb_timestep
+
+ ! Now check to see if dtime is greater than the host model
+ ! (or sub stepped) time step. If it is, then simply
+ ! set it equal to the host (or sub step) time step.
+ ! This section is mostly to deal with small host model
+ ! time steps (or small sub-steps)
+
+ if (dtime .gt. hdtime) then
+ dtime = hdtime
+ endif
+
+ ! Now check to see if CLUBB time step divides evenly into
+ ! the host model time step. If not, force it to divide evenly.
+ ! We also want it to be 5 minutes or less. This section is
+ ! mainly for host model time steps that are not evenly divisible
+ ! by 5 minutes
+
+ if (mod(hdtime,dtime) .ne. 0) then
+ dtime = hdtime/2._r8
+ do while (dtime .gt. 300._r8)
+ dtime = dtime/2._r8
+ end do
+ endif
+
+ ! If resulting host model time step and CLUBB time step do not divide evenly
+ ! into each other, have model throw a fit.
+
+ if (mod(hdtime,dtime) .ne. 0) then
+ call endrun('clubb_tend_cam: CLUBB time step and HOST time step NOT compatible')
+ endif
+
+ ! determine number of timesteps CLUBB core should be advanced,
+ ! host time step divided by CLUBB time step
+ nadv = max(hdtime/dtime,1._r8)
+
+ ! Initialize forcings for transported scalars to zero
+
+ sclrm_forcing(:,:) = 0._r8
+ edsclrm_forcing(:,:) = 0._r8
+ sclrm(:,:) = 0._r8
+
+ ! Compute exner function consistent with CLUBB's definition, which uses a constant
+ ! surface pressure. CAM's exner (in state does not). Therefore, for consistent
+ ! treatment with CLUBB code, anytime exner is needed to treat CLUBB variables
+ ! (such as thlm), use "exner_clubb" other wise use the exner in state
+
+ do k=1,pver
+ do i=1,ncol
+ exner_clubb(i,k) = 1._r8/((state1%pmid(i,k)/p0_clubb)**(rair/cpair))
+ enddo
+ enddo
+
+ ! At each CLUBB call, initialize mean momentum and thermo CLUBB state
+ ! from the CAM state
+
+ do k=1,pver ! loop over levels
+ do i=1,ncol ! loop over columns
+
+ rtm(i,k) = state1%q(i,k,ixq)+state1%q(i,k,ixcldliq)
+ rvm(i,k) = state1%q(i,k,ixq)
+ um(i,k) = state1%u(i,k)
+ vm(i,k) = state1%v(i,k)
+ thlm(i,k) = state1%t(i,k)*exner_clubb(i,k)-(latvap/cpair)*state1%q(i,k,ixcldliq)
+
+ if (clubb_do_adv) then
+ if (macmic_it .eq. 1) then
+
+ ! Note that some of the moments below can be positive or negative.
+ ! Remove a constant that was added to prevent dynamics from clipping
+ ! them to prevent dynamics from making them positive.
+ thlp2(i,k) = state1%q(i,k,ixthlp2)
+ rtp2(i,k) = state1%q(i,k,ixrtp2)
+ rtpthlp(i,k) = state1%q(i,k,ixrtpthlp) - (rtpthlp_const*apply_const)
+ wpthlp(i,k) = state1%q(i,k,ixwpthlp) - (wpthlp_const*apply_const)
+ wprtp(i,k) = state1%q(i,k,ixwprtp) - (wprtp_const*apply_const)
+ wp2(i,k) = state1%q(i,k,ixwp2)
+ wp3(i,k) = state1%q(i,k,ixwp3) - (wp3_const*apply_const)
+ up2(i,k) = state1%q(i,k,ixup2)
+ vp2(i,k) = state1%q(i,k,ixvp2)
+ endif
+ endif
+
+ enddo
+ enddo
+
+ if (clubb_do_adv) then
+ ! If not last step of macmic loop then set apply_const back to
+ ! zero to prevent output from being corrupted.
+ if (macmic_it .eq. cld_macmic_num_steps) then
+ apply_const = 1._r8
+ else
+ apply_const = 0._r8
+ endif
+ endif
+
+ rtm(1:ncol,pverp) = rtm(1:ncol,pver)
+ um(1:ncol,pverp) = state1%u(1:ncol,pver)
+ vm(1:ncol,pverp) = state1%v(1:ncol,pver)
+ thlm(1:ncol,pverp) = thlm(1:ncol,pver)
+
+ if (clubb_do_adv) then
+ thlp2(1:ncol,pverp)=thlp2(1:ncol,pver)
+ rtp2(1:ncol,pverp)=rtp2(1:ncol,pver)
+ rtpthlp(1:ncol,pverp)=rtpthlp(1:ncol,pver)
+ wpthlp(1:ncol,pverp)=wpthlp(1:ncol,pver)
+ wprtp(1:ncol,pverp)=wprtp(1:ncol,pver)
+ wp2(1:ncol,pverp)=wp2(1:ncol,pver)
+ wp3(1:ncol,pverp)=wp3(1:ncol,pver)
+ up2(1:ncol,pverp)=up2(1:ncol,pver)
+ vp2(1:ncol,pverp)=vp2(1:ncol,pver)
+ endif
+
+ ! Compute virtual potential temperature, which is needed for CLUBB
+ do k=1,pver
+ do i=1,ncol
+ thv(i,k) = state1%t(i,k)*exner_clubb(i,k)*(1._r8+zvir*state1%q(i,k,ixq)&
+ -state1%q(i,k,ixcldliq))
+ enddo
+ enddo
+
+ ! Initialize physics tendencies
+ call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lu=.true., lv=.true., lq=lq)
+
+ call tropopause_findChemTrop(state, troplev)
+
+ ! Loop over all columns in lchnk to advance CLUBB core
+ do i=1,ncol ! loop over columns
+
+ ! Set time_elapsed to host model time step, this is for
+ ! CLUBB's budget stats
+ time_elapsed = hdtime
+
+ ! Determine Coriolis force at given latitude. This is never used
+ ! when CLUBB is implemented in a host model, therefore just set
+ ! to zero.
+ fcor = 0._r8
+
+ ! Define the CLUBB momentum grid (in height, units of m)
+ do k=1,nlev+1
+ zi_g(k) = state1%zi(i,pverp-k+1)-state1%zi(i,pver+1)
+ enddo
+
+ ! Define the CLUBB thermodynamic grid (in units of m)
+ do k=1,nlev
+ zt_g(k+1) = state1%zm(i,pver-k+1)-state1%zi(i,pver+1)
+ end do
+
+ do k=1,pver
+ dz_g(k) = state1%zi(i,k)-state1%zi(i,k+1) ! compute thickness
+ enddo
+
+ ! Thermodynamic ghost point is below surface
+ zt_g(1) = -1._r8*zt_g(2)
+
+ ! Set the elevation of the surface
+ sfc_elevation = state1%zi(i,pver+1)
+
+ ! Set the grid size
+ host_dx = grid_dx(i)
+ host_dy = grid_dy(i)
+
+ ! Compute thermodynamic stuff needed for CLUBB on thermo levels.
+ ! Inputs for the momentum levels are set below setup_clubb core
+ do k=1,nlev
+ p_in_Pa(k+1) = state1%pmid(i,pver-k+1) ! Pressure profile
+ exner(k+1) = 1._r8/exner_clubb(i,pver-k+1)
+ rho_ds_zt(k+1) = (1._r8/gravit)*(state1%pdel(i,pver-k+1)/dz_g(pver-k+1))
+ invrs_rho_ds_zt(k+1) = 1._r8/(rho_ds_zt(k+1)) ! Inverse ds rho at thermo
+ rho_in(k+1) = rho_ds_zt(k+1) ! rho on thermo
+ thv_ds_zt(k+1) = thv(i,pver-k+1) ! thetav on thermo
+ rfrzm(k+1) = state1%q(i,pver-k+1,ixcldice)
+ radf(k+1) = radf_clubb(i,pver-k+1)
+ qrl_clubb(k+1) = qrl(i,pver-k+1)/(cpair*state1%pdel(i,pver-k+1))
+ enddo
+
+ ! Below computes the same stuff for the ghost point. May or may
+ ! not be needed, just to be safe to avoid NaN's
+ rho_ds_zt(1) = rho_ds_zt(2)
+ invrs_rho_ds_zt(1) = invrs_rho_ds_zt(2)
+ rho_in(1) = rho_ds_zt(2)
+ thv_ds_zt(1) = thv_ds_zt(2)
+ rho_zt(:) = rho_in(:)
+ p_in_Pa(1) = p_in_Pa(2)
+ exner(1) = exner(2)
+ rfrzm(1) = rfrzm(2)
+ radf(1) = radf(2)
+ qrl_clubb(1) = qrl_clubb(2)
+
+ ! Compute mean w wind on thermo grid, convert from omega to w
+ wm_zt(1) = 0._r8
+ do k=1,nlev
+ wm_zt(k+1) = -1._r8*state1%omega(i,pver-k+1)/(rho_in(k+1)*gravit)
+ enddo
+
+ ! ------------------------------------------------- !
+ ! Begin case specific code for SCAM cases. !
+ ! This section of code block NOT called in !
+ ! global simulations !
+ ! ------------------------------------------------- !
+
+ if (single_column) then
+
+ ! Initialize zo if variable ustar is used
+
+ if (cam_in%landfrac(i) .ge. 0.5_r8) then
+ zo = 0.035_r8
+ else
+ zo = 0.0001_r8
+ endif
+
+ ! Compute surface wind (ubar)
+ ubar = sqrt(um(i,pver)**2+vm(i,pver)**2)
+ if (ubar .lt. 0.25_r8) ubar = 0.25_r8
+
+ ! Below denotes case specifics for surface momentum
+ ! and thermodynamic fluxes, depending on the case
+
+ ! Define ustar (based on case, if not variable)
+ ustar = 0.25_r8 ! Initialize ustar in case no case
+
+ if(trim(scm_clubb_iop_name) .eq. 'BOMEX_5day') then
+ ustar = 0.28_r8
+ endif
+
+ if(trim(scm_clubb_iop_name) .eq. 'ATEX_48hr') then
+ ustar = 0.30_r8
+ endif
+
+ if(trim(scm_clubb_iop_name) .eq. 'RICO_3day') then
+ ustar = 0.28_r8
+ endif
+
+ if(trim(scm_clubb_iop_name) .eq. 'arm97' .or. trim(scm_clubb_iop_name) .eq. 'gate' .or. &
+ trim(scm_clubb_iop_name) .eq. 'toga' .or. trim(scm_clubb_iop_name) .eq. 'mpace' .or. &
+ trim(scm_clubb_iop_name) .eq. 'ARM_CC') then
+
+ bflx22 = (gravit/theta0)*wpthlp_sfc
+ ustar = diag_ustar(zt_g(2),bflx22,ubar,zo)
+ endif
+
+ ! Compute the surface momentum fluxes, if this is a SCAM simulation
+ upwp_sfc = -um(i,pver)*ustar**2/ubar
+ vpwp_sfc = -vm(i,pver)*ustar**2/ubar
+
+ endif
+
+ ! Define surface sources for transported variables for diffusion, will
+ ! be zero as these tendencies are done in vertical_diffusion
+ do ixind=1,edsclr_dim
+ wpedsclrp_sfc(ixind) = 0._r8
+ enddo
+
+ ! Define forcings from CAM to CLUBB as zero for momentum and thermo,
+ ! forcings already applied through CAM
+ thlm_forcing = 0._r8
+ rtm_forcing = 0._r8
+ um_forcing = 0._r8
+ vm_forcing = 0._r8
+
+ wprtp_forcing = 0._r8
+ wpthlp_forcing = 0._r8
+ rtp2_forcing = 0._r8
+ thlp2_forcing = 0._r8
+ rtpthlp_forcing = 0._r8
+
+ ice_supersat_frac = 0._r8
+
+ ! Set stats output and increment equal to CLUBB and host dt
+ stats_tsamp = dtime
+ stats_tout = hdtime
+
+ ! Heights need to be set at each timestep. Therefore, recall
+ ! setup_grid and setup_parameters for this.
+
+ ! Read in parameters for CLUBB. Just read in default values
+ call read_parameters_api( -99, "", clubb_params )
+
+ ! Set-up CLUBB core at each CLUBB call because heights can change
+ call setup_grid_heights_api(l_implemented, grid_type, zi_g(2), &
+ zi_g(1), zi_g, zt_g)
+
+ call setup_parameters_api(zi_g(2), clubb_params, nlev+1, grid_type, &
+ zi_g, zt_g, err_code)
+
+ ! Compute some inputs from the thermodynamic grid
+ ! to the momentum grid
+ rho_ds_zm = zt2zm_api(rho_ds_zt)
+ rho_zm = zt2zm_api(rho_zt)
+ invrs_rho_ds_zm = zt2zm_api(invrs_rho_ds_zt)
+ thv_ds_zm = zt2zm_api(thv_ds_zt)
+ wm_zm = zt2zm_api(wm_zt)
+
+ ! Surface fluxes provided by host model
+ wpthlp_sfc = cam_in%shf(i)/(cpair*rho_ds_zm(1)) ! Sensible heat flux
+ wprtp_sfc = cam_in%lhf(i)/(latvap*rho_ds_zm(1)) ! Latent heat flux
+ upwp_sfc = cam_in%wsx(i)/rho_ds_zm(1) ! Surface meridional momentum flux
+ vpwp_sfc = cam_in%wsy(i)/rho_ds_zm(1) ! Surface zonal momentum flux
+
+ ! Need to flip arrays around for CLUBB core
+ do k=1,nlev+1
+ um_in(k) = um(i,pverp-k+1)
+ vm_in(k) = vm(i,pverp-k+1)
+ upwp_in(k) = upwp(i,pverp-k+1)
+ vpwp_in(k) = vpwp(i,pverp-k+1)
+ up2_in(k) = up2(i,pverp-k+1)
+ vp2_in(k) = vp2(i,pverp-k+1)
+ wp2_in(k) = wp2(i,pverp-k+1)
+ wp3_in(k) = wp3(i,pverp-k+1)
+ rtp2_in(k) = rtp2(i,pverp-k+1)
+ thlp2_in(k) = thlp2(i,pverp-k+1)
+ thlm_in(k) = thlm(i,pverp-k+1)
+ rtm_in(k) = rtm(i,pverp-k+1)
+ rvm_in(k) = rvm(i,pverp-k+1)
+ wprtp_in(k) = wprtp(i,pverp-k+1)
+ wpthlp_in(k) = wpthlp(i,pverp-k+1)
+ rtpthlp_in(k) = rtpthlp(i,pverp-k+1)
+
+ if (k .ne. 1) then
+ pre_in(k) = prer_evap(i,pverp-k+1)
+ endif
+
+ ! Initialize these to prevent crashing behavior
+ rcm_out(k) = 0._r8
+ wprcp_out(k) = 0._r8
+ cloud_frac_out(k) = 0._r8
+ rcm_in_layer_out(k) = 0._r8
+ cloud_cover_out(k) = 0._r8
+ edsclr_in(k,:) = 0._r8
+ khzm_out(k) = 0._r8
+ khzt_out(k) = 0._r8
+
+ ! higher order scalar stuff, put to zero
+ sclrm(k,:) = 0._r8
+ wpsclrp(k,:) = 0._r8
+ sclrp2(k,:) = 0._r8
+ sclrprtp(k,:) = 0._r8
+ sclrpthlp(k,:) = 0._r8
+ wpsclrp_sfc(:) = 0._r8
+ hydromet(k,:) = 0._r8
+ wphydrometp(k,:) = 0._r8
+ wp2hmp(k,:) = 0._r8
+ rtphmp_zt(k,:) = 0._r8
+ thlphmp_zt(k,:) = 0._r8
+
+ enddo
+
+ pre_in(1) = pre_in(2)
+
+ if (clubb_do_adv) then
+ if (macmic_it .eq. 1) then
+ wp2_in=zt2zm_api(wp2_in)
+ wpthlp_in=zt2zm_api(wpthlp_in)
+ wprtp_in=zt2zm_api(wprtp_in)
+ up2_in=zt2zm_api(up2_in)
+ vp2_in=zt2zm_api(vp2_in)
+ thlp2_in=zt2zm_api(thlp2_in)
+ rtp2_in=zt2zm_api(rtp2_in)
+ rtpthlp_in=zt2zm_api(rtpthlp_in)
+
+ do k=1,nlev+1
+ thlp2_in(k)=max(thl_tol**2,thlp2_in(k))
+ rtp2_in(k)=max(rt_tol**2,rtp2_in(k))
+ wp2_in(k)=max(w_tol_sqd,wp2_in(k))
+ up2_in(k)=max(w_tol_sqd,up2_in(k))
+ vp2_in(k)=max(w_tol_sqd,vp2_in(k))
+ enddo
+ endif
+ endif
+
+ ! rtp3_in and thlp3_in are not currently used in CLUBB's default code.
+ rtp3_in(:) = 0.0_r8
+ thlp3_in(:) = 0.0_r8
+
+ ! Do the same for tracers
+ icnt=0
+ do ixind=1,pcnst
+ if (lq(ixind)) then
+ icnt=icnt+1
+ do k=1,nlev
+ edsclr_in(k+1,icnt) = state1%q(i,pver-k+1,ixind)
+ enddo
+ edsclr_in(1,icnt) = edsclr_in(2,icnt)
+ end if
+ enddo
+
+ if (do_expldiff) then
+ do k=1,nlev
+ edsclr_in(k+1,icnt+1) = thlm(i,pver-k+1)
+ edsclr_in(k+1,icnt+2) = rtm(i,pver-k+1)
+ enddo
+
+ edsclr_in(1,icnt+1) = edsclr_in(2,icnt+1)
+ edsclr_in(1,icnt+2) = edsclr_in(2,icnt+2)
+ endif
+
+ do t=1,nadv ! do needed number of "sub" timesteps for each CAM step
+
+ ! Increment the statistics then being stats timestep
+ if (l_stats) then
+ time_elapsed = time_elapsed+dtime
+ call stats_begin_timestep_api(time_elapsed, 1, 1)
+ endif
+
+ ! Advance CLUBB CORE one timestep in the future
+ call advance_clubb_core_api &
+ ( l_implemented, dtime, fcor, sfc_elevation, hydromet_dim, &
+ thlm_forcing, rtm_forcing, um_forcing, vm_forcing, &
+ sclrm_forcing, edsclrm_forcing, wprtp_forcing, &
+ wpthlp_forcing, rtp2_forcing, thlp2_forcing, &
+ rtpthlp_forcing, wm_zm, wm_zt, &
+ wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, &
+ wpsclrp_sfc, wpedsclrp_sfc, &
+ p_in_Pa, rho_zm, rho_in, exner, &
+ rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, &
+ invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, hydromet, &
+ rfrzm, radf, &
+ wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, &
+ host_dx, host_dy, &
+ um_in, vm_in, upwp_in, &
+ vpwp_in, up2_in, vp2_in, &
+ thlm_in, rtm_in, wprtp_in, wpthlp_in, &
+ wp2_in, wp3_in, rtp2_in, rtp3_in, &
+ thlp2_in, thlp3_in, rtpthlp_in, &
+ sclrm, sclrp2, sclrprtp, sclrpthlp, &
+ wpsclrp, edsclr_in, err_code, &
+ rcm_out, wprcp_out, cloud_frac_out, ice_supersat_frac, &
+ rcm_in_layer_out, cloud_cover_out, &
+ khzm_out, khzt_out, qclvar_out, thlprcp_out, &
+ pdf_params)
+
+ if (do_rainturb) then
+ rvm_in = rtm_in - rcm_out
+ call update_xp2_mc_api(nlev+1, dtime, cloud_frac_out, &
+ rcm_out, rvm_in, thlm_in, wm_zt, exner, pre_in, pdf_params, &
+ rtp2_mc_out, thlp2_mc_out, &
+ wprtp_mc_out, wpthlp_mc_out, &
+ rtpthlp_mc_out)
+
+ dum1 = (1._r8 - cam_in%landfrac(i))
+
+ ! update turbulent moments based on rain evaporation
+ rtp2_in = rtp2_in + clubb_rnevap_effic * dum1 * rtp2_mc_out * dtime
+ thlp2_in = thlp2_in + clubb_rnevap_effic * dum1 * thlp2_mc_out * dtime
+ wprtp_in = wprtp_in + clubb_rnevap_effic * dum1 * wprtp_mc_out * dtime
+ wpthlp_in = wpthlp_in + clubb_rnevap_effic * dum1 * wpthlp_mc_out * dtime
+ endif
+
+ if (do_cldcool) then
+
+ rcm_out_zm = zt2zm_api(rcm_out)
+ qrl_zm = zt2zm_api(qrl_clubb)
+ thlp2_rad_out(:) = 0._r8
+ call calculate_thlp2_rad_api(nlev+1, rcm_out_zm, thlprcp_out, qrl_zm, thlp2_rad_out)
+ thlp2_in = thlp2_in + thlp2_rad_out * dtime
+ thlp2_in = max(thl_tol**2,thlp2_in)
+ endif
+
+ ! Check to see if stats should be output, here stats are read into
+ ! output arrays to make them conformable to CAM output
+ if (l_stats) call stats_end_timestep_clubb(i,out_zt,out_zm,&
+ out_radzt,out_radzm,out_sfc)
+
+ enddo ! end time loop
+
+ if (clubb_do_adv) then
+ if (macmic_it .eq. cld_macmic_num_steps) then
+ wp2_in=zm2zt_api(wp2_in)
+ wpthlp_in=zm2zt_api(wpthlp_in)
+ wprtp_in=zm2zt_api(wprtp_in)
+ up2_in=zm2zt_api(up2_in)
+ vp2_in=zm2zt_api(vp2_in)
+ thlp2_in=zm2zt_api(thlp2_in)
+ rtp2_in=zm2zt_api(rtp2_in)
+ rtpthlp_in=zm2zt_api(rtpthlp_in)
+
+ do k=1,nlev+1
+ thlp2_in(k)=max(thl_tol**2,thlp2_in(k))
+ rtp2_in(k)=max(rt_tol**2,rtp2_in(k))
+ wp2_in(k)=max(w_tol_sqd,wp2_in(k))
+ up2_in(k)=max(w_tol_sqd,up2_in(k))
+ vp2_in(k)=max(w_tol_sqd,vp2_in(k))
+ enddo
+ endif
+ endif
+
+ ! Arrays need to be "flipped" to CAM grid
+ do k=1,nlev+1
+
+ um(i,pverp-k+1) = um_in(k)
+ vm(i,pverp-k+1) = vm_in(k)
+ upwp(i,pverp-k+1) = upwp_in(k)
+ vpwp(i,pverp-k+1) = vpwp_in(k)
+ up2(i,pverp-k+1) = up2_in(k)
+ vp2(i,pverp-k+1) = vp2_in(k)
+ thlm(i,pverp-k+1) = thlm_in(k)
+ rtm(i,pverp-k+1) = rtm_in(k)
+ wprtp(i,pverp-k+1)= wprtp_in(k)
+ wpthlp(i,pverp-k+1) = wpthlp_in(k)
+ wp2(i,pverp-k+1) = wp2_in(k)
+ wp3(i,pverp-k+1) = wp3_in(k)
+ rtp2(i,pverp-k+1) = rtp2_in(k)
+ thlp2(i,pverp-k+1)= thlp2_in(k)
+ rtpthlp(i,pverp-k+1) = rtpthlp_in(k)
+ rcm(i,pverp-k+1) = rcm_out(k)
+ wprcp(i,pverp-k+1)= wprcp_out(k)
+ cloud_frac(i,pverp-k+1) = min(cloud_frac_out(k),1._r8)
+ rcm_in_layer(i,pverp-k+1) = rcm_in_layer_out(k)
+ zt_out(i,pverp-k+1) = zt_g(k)
+ zi_out(i,pverp-k+1) = zi_g(k)
+ khzm(i,pverp-k+1) = khzm_out(k)
+ khzt(i,pverp-k+1) = khzt_out(k)
+ qclvar(i,pverp-k+1) = min(1._r8,qclvar_out(k))
+
+ do ixind=1,edsclr_dim
+ edsclr_out(pverp-k+1,ixind) = edsclr_in(k,ixind)
+ enddo
+
+ enddo
+
+ ! Values to use above top_lev, for variables that have not already been
+ ! set up there. These are mostly fill values that should not actually be
+ ! used in the run, but may end up in diagnostic output.
+ upwp(i,:top_lev-1) = 0._r8
+ vpwp(i,:top_lev-1) = 0._r8
+ rcm(i,:top_lev-1) = 0._r8
+ wprcp(i,:top_lev-1) = 0._r8
+ cloud_frac(i,:top_lev-1) = 0._r8
+ rcm_in_layer(i,:top_lev-1) = 0._r8
+ zt_out(i,:top_lev-1) = 0._r8
+ zi_out(i,:top_lev-1) = 0._r8
+ khzm(i,:top_lev-1) = 0._r8
+ khzt(i,:top_lev-1) = 0._r8
+ qclvar(i,:top_lev-1) = 2._r8
+
+ ! enforce zero tracer tendencies above the top_lev level -- no change
+ icnt=0
+ do ixind=1,pcnst
+ if (lq(ixind)) then
+ icnt=icnt+1
+ edsclr_out(:top_lev-1,icnt) = state1%q(i,:top_lev-1,ixind)
+ end if
+ enddo
+
+ ! Fill up arrays needed for McICA. Note we do not want the ghost point,
+ ! thus why the second loop is needed.
+
+ zi_out(i,1) = 0._r8
+
+ ! Section below is concentrated on energy fixing for conservation.
+ ! There are two steps to this process. The first is to remove any tendencies
+ ! CLUBB may have produced above where it is active due to roundoff.
+ ! The second is to provider a fixer because CLUBB and CAM's thermodynamic
+ ! variables are different.
+
+ ! Initialize clubbtop with the chemistry topopause top, to prevent CLUBB from
+ ! firing up in the stratosphere
+ clubbtop = troplev(i)
+ do while ((rtp2(i,clubbtop) .le. 1.e-15_r8 .and. rcm(i,clubbtop) .eq. 0._r8) .and. clubbtop .lt. pver-1)
+ clubbtop = clubbtop + 1
+ enddo
+
+ ! Compute static energy using CLUBB's variables
+ do k=1,pver
+ clubb_s(k) = cpair*((thlm(i,k)+(latvap/cpair)*rcm(i,k))/exner_clubb(i,k))+ &
+ gravit*state1%zm(i,k)+state1%phis(i)
+ enddo
+
+ ! Compute integrals above layer where CLUBB is active
+ se_upper_a = 0._r8 ! energy in layers above where CLUBB is active AFTER CLUBB is called
+ se_upper_b = 0._r8 ! energy in layers above where CLUBB is active BEFORE CLUBB is called
+ tw_upper_a = 0._r8 ! total water in layers above where CLUBB is active AFTER CLUBB is called
+ tw_upper_b = 0._r8 ! total water in layers above where CLUBB is active BEFORE CLUBB is called
+ do k=1,clubbtop
+ se_upper_a = se_upper_a + (clubb_s(k)+0.5_r8*(um(i,k)**2+vm(i,k)**2)+(latvap+latice)* &
+ (rtm(i,k)-rcm(i,k))+(latice)*rcm(i,k))*state1%pdel(i,k)/gravit
+ se_upper_b = se_upper_b + (state1%s(i,k)+0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)+(latvap+latice)* &
+ state1%q(i,k,ixq)+(latice)*state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit
+ tw_upper_a = tw_upper_a + rtm(i,k)*state1%pdel(i,k)/gravit
+ tw_upper_b = tw_upper_b + (state1%q(i,k,ixq)+state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit
+ enddo
+
+ ! Compute the disbalance of total energy and water in upper levels,
+ ! divide by the thickness in the lower atmosphere where we will
+ ! evenly distribute this disbalance
+ se_upper_diss = (se_upper_a - se_upper_b)/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1))
+ tw_upper_diss = (tw_upper_a - tw_upper_b)/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1))
+
+ ! Perform a test to see if there will be any negative RTM errors
+ ! in the column. If so, apply the disbalance to the surface
+ apply_to_surface = .false.
+ if (tw_upper_diss .lt. 0._r8) then
+ do k=clubbtop+1,pver
+ rtm_test = (rtm(i,k) + tw_upper_diss*gravit) - rcm(i,k)
+ if (rtm_test .lt. 0._r8) then
+ apply_to_surface = .true.
+ endif
+ enddo
+ endif
+
+ if (apply_to_surface) then
+ tw_upper_diss = (tw_upper_a - tw_upper_b)/(state1%pint(i,pverp)-state1%pint(i,pver))
+ se_upper_diss = (se_upper_a - se_upper_b)/(state1%pint(i,pverp)-state1%pint(i,pver))
+ rtm(i,pver) = rtm(i,pver) + tw_upper_diss*gravit
+ if (apply_to_heat) clubb_s(pver) = clubb_s(pver) + se_upper_diss*gravit
+ else
+ ! Apply the disbalances above to layers where CLUBB is active
+ do k=clubbtop+1,pver
+ rtm(i,k) = rtm(i,k) + tw_upper_diss*gravit
+ if (apply_to_heat) clubb_s(k) = clubb_s(k) + se_upper_diss*gravit
+ enddo
+ endif
+
+ ! Essentially "zero" out tendencies in the layers above where CLUBB is active
+ do k=1,clubbtop
+ if (apply_to_heat) clubb_s(k) = state1%s(i,k)
+ rcm(i,k) = state1%q(i,k,ixcldliq)
+ rtm(i,k) = state1%q(i,k,ixq) + rcm(i,k)
+ enddo
+
+ ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water
+ ! after CLUBB is called.
+ se_a = 0._r8
+ ke_a = 0._r8
+ wv_a = 0._r8
+ wl_a = 0._r8
+
+ ! Do the same as above, but for before CLUBB was called.
+ se_b = 0._r8
+ ke_b = 0._r8
+ wv_b = 0._r8
+ wl_b = 0._r8
+ do k=1,pver
+ se_a(i) = se_a(i) + clubb_s(k)*state1%pdel(i,k)/gravit
+ ke_a(i) = ke_a(i) + 0.5_r8*(um(i,k)**2+vm(i,k)**2)*state1%pdel(i,k)/gravit
+ wv_a(i) = wv_a(i) + (rtm(i,k)-rcm(i,k))*state1%pdel(i,k)/gravit
+ wl_a(i) = wl_a(i) + (rcm(i,k))*state1%pdel(i,k)/gravit
+
+ se_b(i) = se_b(i) + state1%s(i,k)*state1%pdel(i,k)/gravit
+ ke_b(i) = ke_b(i) + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)/gravit
+ wv_b(i) = wv_b(i) + state1%q(i,k,ixq)*state1%pdel(i,k)/gravit
+ wl_b(i) = wl_b(i) + state1%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit
+ enddo
+
+ ! Based on these integrals, compute the total energy before and after CLUBB call
+ te_a(i) = se_a(i) + ke_a(i) + (latvap+latice)*wv_a(i)+latice*wl_a(i)
+ te_b(i) = se_b(i) + ke_b(i) + (latvap+latice)*wv_b(i)+latice*wl_b(i)
+
+ ! Take into account the surface fluxes of heat and moisture
+ te_b(i) = te_b(i)+(cam_in%shf(i)+(cam_in%lhf(i)/latvap)*(latvap+latice))*hdtime
+
+ ! Compute the disbalance of total energy, over depth where CLUBB is active
+ se_dis = (te_a(i) - te_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1))
+
+ ! Fix the total energy coming out of CLUBB so it achieves enery conservation.
+ ! Apply this fixer throughout the column evenly, but only at layers where
+ ! CLUBB is active.
+ do k=clubbtop+1,pver
+ clubb_s(k) = clubb_s(k) - se_dis*gravit
+ enddo
+
+ ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point
+ ! for all variables and therefore is never called in this loop
+ do k=1,pver
+
+ ptend_loc%u(i,k) = (um(i,k)-state1%u(i,k))/hdtime ! east-west wind
+ ptend_loc%v(i,k) = (vm(i,k)-state1%v(i,k))/hdtime ! north-south wind
+ ptend_loc%q(i,k,ixq) = (rtm(i,k)-rcm(i,k)-state1%q(i,k,ixq))/hdtime ! water vapor
+ ptend_loc%q(i,k,ixcldliq) = (rcm(i,k)-state1%q(i,k,ixcldliq))/hdtime ! Tendency of liquid water
+ ptend_loc%s(i,k) = (clubb_s(k)-state1%s(i,k))/hdtime ! Tendency of static energy
+
+ if (clubb_do_adv) then
+ if (macmic_it .eq. cld_macmic_num_steps) then
+
+ ! Here add a constant to moments which can be either positive or
+ ! negative. This is to prevent clipping when dynamics tries to
+ ! make all constituents positive
+ wp3(i,k) = wp3(i,k) + wp3_const
+ rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const
+ wpthlp(i,k) = wpthlp(i,k) + wpthlp_const
+ wprtp(i,k) = wprtp(i,k) + wprtp_const
+
+ ptend_loc%q(i,k,ixthlp2)=(thlp2(i,k)-state1%q(i,k,ixthlp2))/hdtime ! THLP Variance
+ ptend_loc%q(i,k,ixrtp2)=(rtp2(i,k)-state1%q(i,k,ixrtp2))/hdtime ! RTP Variance
+ ptend_loc%q(i,k,ixrtpthlp)=(rtpthlp(i,k)-state1%q(i,k,ixrtpthlp))/hdtime ! RTP THLP covariance
+ ptend_loc%q(i,k,ixwpthlp)=(wpthlp(i,k)-state1%q(i,k,ixwpthlp))/hdtime ! WPTHLP
+ ptend_loc%q(i,k,ixwprtp)=(wprtp(i,k)-state1%q(i,k,ixwprtp))/hdtime ! WPRTP
+ ptend_loc%q(i,k,ixwp2)=(wp2(i,k)-state1%q(i,k,ixwp2))/hdtime ! WP2
+ ptend_loc%q(i,k,ixwp3)=(wp3(i,k)-state1%q(i,k,ixwp3))/hdtime ! WP3
+ ptend_loc%q(i,k,ixup2)=(up2(i,k)-state1%q(i,k,ixup2))/hdtime ! UP2
+ ptend_loc%q(i,k,ixvp2)=(vp2(i,k)-state1%q(i,k,ixvp2))/hdtime ! VP2
+ else
+ ptend_loc%q(i,k,ixthlp2)=0._r8
+ ptend_loc%q(i,k,ixrtp2)=0._r8
+ ptend_loc%q(i,k,ixrtpthlp)=0._r8
+ ptend_loc%q(i,k,ixwpthlp)=0._r8
+ ptend_loc%q(i,k,ixwprtp)=0._r8
+ ptend_loc%q(i,k,ixwp2)=0._r8
+ ptend_loc%q(i,k,ixwp3)=0._r8
+ ptend_loc%q(i,k,ixup2)=0._r8
+ ptend_loc%q(i,k,ixvp2)=0._r8
+ endif
+
+ endif
+
+ ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents.
+ ! Loading up this array doesn't mean the tendencies are applied.
+ ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed
+
+ icnt=0
+ do ixind=1,pcnst
+ if (lq(ixind)) then
+ icnt=icnt+1
+ if ((ixind /= ixq) .and. (ixind /= ixcldliq) .and.&
+ (ixind /= ixthlp2) .and. (ixind /= ixrtp2) .and.&
+ (ixind /= ixrtpthlp) .and. (ixind /= ixwpthlp) .and.&
+ (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.&
+ (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then
+ ptend_loc%q(i,k,ixind) = (edsclr_out(k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents
+ end if
+ end if
+ enddo
+
+ enddo
+
+
+ enddo ! end column loop
+
+ call outfld('KVH_CLUBB', khzt, pcols, lchnk)
+
+ ! Add constant to ghost point so that output is not corrupted
+ if (clubb_do_adv) then
+ if (macmic_it .eq. cld_macmic_num_steps) then
+ wp3(:,pverp) = wp3(:,pverp) + wp3_const
+ rtpthlp(:,pverp) = rtpthlp(:,pverp) + rtpthlp_const
+ wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const
+ wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const
+ endif
+ endif
+
+ cmeliq(:,:) = ptend_loc%q(:,:,ixcldliq)
+
+ ! ------------------------------------------------- !
+ ! End column computation of CLUBB, begin to apply !
+ ! and compute output, etc !
+ ! ------------------------------------------------- !
+
+ ! Output CLUBB tendencies
+ call outfld( 'RVMTEND_CLUBB', ptend_loc%q(:,:,ixq), pcols, lchnk)
+ call outfld( 'RCMTEND_CLUBB', ptend_loc%q(:,:,ixcldliq), pcols, lchnk)
+ call outfld( 'RIMTEND_CLUBB', ptend_loc%q(:,:,ixcldice), pcols, lchnk)
+ call outfld( 'STEND_CLUBB', ptend_loc%s,pcols, lchnk)
+ call outfld( 'UTEND_CLUBB', ptend_loc%u,pcols, lchnk)
+ call outfld( 'VTEND_CLUBB', ptend_loc%v,pcols, lchnk)
+
+ call outfld( 'CMELIQ', cmeliq, pcols, lchnk)
+
+ ! Update physics tendencies
+ call physics_ptend_sum(ptend_loc,ptend_all,ncol)
+ call physics_update(state1,ptend_loc,hdtime)
+
+ ! Due to the order of operation of CLUBB, which closes on liquid first,
+ ! then advances it's predictive equations second, this can lead to
+ ! RHliq > 1 directly before microphysics is called. Therefore, we use
+ ! ice_macro_tend to enforce RHliq <= 1 everywhere before microphysics is called.
+
+ if (clubb_do_liqsupersat) then
+
+ ! -------------------------------------- !
+ ! Ice Saturation Adjustment Computation !
+ ! -------------------------------------- !
+
+ latsub = latvap + latice
+
+ lq2(:) = .FALSE.
+ lq2(ixq) = .TRUE.
+ lq2(ixcldliq) = .TRUE.
+ lq2(ixnumliq) = .TRUE.
+
+ call physics_ptend_init(ptend_loc, state%psetcols, 'iceadj', ls=.true., lq=lq2 )
+
+ stend(:ncol,:)=0._r8
+ qvtend(:ncol,:)=0._r8
+ qctend(:ncol,:)=0._r8
+ inctend(:ncol,:)=0._r8
+
+ call liquid_macro_tend(npccn(:ncol,top_lev:pver),state1%t(:ncol,top_lev:pver), &
+ state1%pmid(:ncol,top_lev:pver),state1%q(:ncol,top_lev:pver,ixq),state1%q(:ncol,top_lev:pver,ixcldliq),&
+ state1%q(:ncol,top_lev:pver,ixnumliq),latvap,hdtime,&
+ stend(:ncol,top_lev:pver),qvtend(:ncol,top_lev:pver),qctend(:ncol,top_lev:pver),&
+ inctend(:ncol,top_lev:pver))
+
+ ! update local copy of state with the tendencies
+ ptend_loc%q(:ncol,top_lev:pver,ixq)=qvtend(:ncol,top_lev:pver)
+ ptend_loc%q(:ncol,top_lev:pver,ixcldliq)=qctend(:ncol,top_lev:pver)
+ ptend_loc%q(:ncol,top_lev:pver,ixnumliq)=inctend(:ncol,top_lev:pver)
+ ptend_loc%s(:ncol,top_lev:pver)=stend(:ncol,top_lev:pver)
+
+ ! Add the ice tendency to the output tendency
+ call physics_ptend_sum(ptend_loc, ptend_all, ncol)
+
+ ! ptend_loc is reset to zero by this call
+ call physics_update(state1, ptend_loc, hdtime)
+
+ ! Write output for tendencies:
+ ! oufld: QVTENDICE,QCTENDICE,NCTENDICE,FQTENDICE
+ call outfld( 'TTENDICE', stend/cpair, pcols, lchnk )
+ call outfld( 'QVTENDICE', qvtend, pcols, lchnk )
+ call outfld( 'QCTENDICE', qctend, pcols, lchnk )
+ call outfld( 'NCTENDICE', inctend, pcols, lchnk )
+
+ where(qctend .ne. 0._r8)
+ fqtend = 1._r8
+ elsewhere
+ fqtend = 0._r8
+ end where
+
+ call outfld( 'FQTENDICE', fqtend, pcols, lchnk )
+ end if
+
+ ! ------------------------------------------------------------ !
+ ! ------------------------------------------------------------ !
+ ! ------------------------------------------------------------ !
+ ! The rest of the code deals with diagnosing variables !
+ ! for microphysics/radiation computation and macrophysics !
+ ! ------------------------------------------------------------ !
+ ! ------------------------------------------------------------ !
+ ! ------------------------------------------------------------ !
+
+
+ ! --------------------------------------------------------------------------------- !
+ ! COMPUTE THE ICE CLOUD DETRAINMENT !
+ ! Detrainment of convective condensate into the environment or stratiform cloud !
+ ! --------------------------------------------------------------------------------- !
+
+ ! Initialize the shallow convective detrainment rate, will always be zero
+ dlf2(:,:) = 0.0_r8
+
+ lqice(:) = .false.
+ lqice(ixcldliq) = .true.
+ lqice(ixcldice) = .true.
+ lqice(ixnumliq) = .true.
+ lqice(ixnumice) = .true.
+
+ call physics_ptend_init(ptend_loc,state%psetcols, 'clubb', ls=.true., lq=lqice)
+
+ if (zmconv_microp) then
+ call pbuf_get_field(pbuf, dlfzm_idx, dlfzm)
+ call pbuf_get_field(pbuf, difzm_idx, difzm)
+ call pbuf_get_field(pbuf, dnlfzm_idx, dnlfzm)
+ call pbuf_get_field(pbuf, dnifzm_idx, dnifzm)
+ end if
+
+ do k=1,pver
+ do i=1,ncol
+ if( state1%t(i,k) > 268.15_r8 ) then
+ dum1 = 0.0_r8
+ elseif ( state1%t(i,k) < 238.15_r8 ) then
+ dum1 = 1.0_r8
+ else
+ dum1 = ( 268.15_r8 - state1%t(i,k) ) / 30._r8
+ endif
+
+ if (zmconv_microp) then
+ ptend_loc%q(i,k,ixcldliq) = dlfzm(i,k) + dlf2(i,k) * ( 1._r8 - dum1 )
+ ptend_loc%q(i,k,ixcldice) = difzm(i,k) + dlf2(i,k) * dum1
+
+ ptend_loc%q(i,k,ixnumliq) = dnlfzm(i,k) + 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) &
+ / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection
+ ptend_loc%q(i,k,ixnumice) = dnifzm(i,k) + 3._r8 * ( dlf2(i,k) * dum1 ) &
+ / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection
+ ptend_loc%s(i,k) = dlf2(i,k) * dum1 * latice
+ else
+
+ ptend_loc%q(i,k,ixcldliq) = dlf(i,k) * ( 1._r8 - dum1 )
+ ptend_loc%q(i,k,ixcldice) = dlf(i,k) * dum1
+ ptend_loc%q(i,k,ixnumliq) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * ( 1._r8 - dum1 ) ) &
+ / (4._r8*3.14_r8* 8.e-6_r8**3*997._r8) + & ! Deep Convection
+ 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) &
+ / (4._r8*3.14_r8*10.e-6_r8**3*997._r8) ! Shallow Convection
+ ptend_loc%q(i,k,ixnumice) = 3._r8 * ( max(0._r8, ( dlf(i,k) - dlf2(i,k) )) * dum1 ) &
+ / (4._r8*3.14_r8*25.e-6_r8**3*500._r8) + & ! Deep Convection
+ 3._r8 * ( dlf2(i,k) * dum1 ) &
+ / (4._r8*3.14_r8*50.e-6_r8**3*500._r8) ! Shallow Convection
+ ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice
+ end if
+
+ ! Only rliq is saved from deep convection, which is the reserved liquid. We need to keep
+ ! track of the integrals of ice and static energy that is effected from conversion to ice
+ ! so that the energy checker doesn't complain.
+ det_s(i) = det_s(i) + ptend_loc%s(i,k)*state1%pdel(i,k)/gravit
+ det_ice(i) = det_ice(i) - ptend_loc%q(i,k,ixcldice)*state1%pdel(i,k)/gravit
+
+ enddo
+ enddo
+
+ det_ice(:ncol) = det_ice(:ncol)/1000._r8 ! divide by density of water
+
+ call outfld( 'DPDLFLIQ', ptend_loc%q(:,:,ixcldliq), pcols, lchnk)
+ call outfld( 'DPDLFICE', ptend_loc%q(:,:,ixcldice), pcols, lchnk)
+
+ temp2dp(:ncol,:pver) = ptend_loc%s(:ncol,:pver)/cpair
+ call outfld( 'DPDLFT', temp2d, pcols, lchnk)
+
+ call physics_ptend_sum(ptend_loc,ptend_all,ncol)
+ call physics_update(state1,ptend_loc,hdtime)
+
+ ! ------------------------------------------------- !
+ ! Diagnose relative cloud water variance !
+ ! ------------------------------------------------- !
+
+ if (deep_scheme .eq. 'CLUBB_SGS') then
+ relvarmax = 2.0_r8
+ else
+ relvarmax = 10.0_r8
+ endif
+
+ relvar(:,:) = relvarmax ! default
+
+ if (deep_scheme .ne. 'CLUBB_SGS') then
+ where (rcm(:ncol,:pver) /= 0 .and. qclvar(:ncol,:pver) /= 0) &
+ relvar(:ncol,:pver) = min(relvarmax,max(0.001_r8,rcm(:ncol,:pver)**2/qclvar(:ncol,:pver)))
+ endif
+
+ ! ------------------------------------------------- !
+ ! Optional Accretion enhancement factor !
+ ! ------------------------------------------------- !
+
+ accre_enhan(:ncol,:pver) = 1._r8
+
+ ! ------------------------------------------------- !
+ ! Diagnose some output variables !
+ ! ------------------------------------------------- !
+
+ ! density
+ rho(:ncol,1:pver) = state1%pmid(:ncol,1:pver)/(rair*state1%t(:ncol,1:pver))
+ rho(:ncol,pverp) = state1%ps(:ncol)/(rair*state1%t(:ncol,pver))
+
+ eps = rair/rh2o
+ wpthvp(:,:) = 0.0_r8
+ do k=1,pver
+ do i=1,ncol
+ ! buoyancy flux
+ wpthvp(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))+((1._r8-eps)/eps)*theta0* &
+ (wprtp(i,k)-(apply_const*wprtp_const))+((latvap/cpair)* &
+ state1%exner(i,k)-(1._r8/eps)*theta0)*wprcp(i,k)
+
+ ! total water mixing ratio
+ qt_output(i,k) = state1%q(i,k,ixq)+state1%q(i,k,ixcldliq)+state1%q(i,k,ixcldice)
+ ! liquid water potential temperature
+ thetal_output(i,k) = (state1%t(i,k)*state1%exner(i,k))-(latvap/cpair)*state1%q(i,k,ixcldliq)
+ ! liquid water static energy
+ sl_output(i,k) = cpair*state1%t(i,k)+gravit*state1%zm(i,k)-latvap*state1%q(i,k,ixcldliq)
+ enddo
+ enddo
+
+ do k=1,pverp
+ do i=1,ncol
+ wpthlp_output(i,k) = (wpthlp(i,k)-(apply_const*wpthlp_const))*rho(i,k)*cpair ! liquid water potential temperature flux
+ wprtp_output(i,k) = (wprtp(i,k)-(apply_const*wprtp_const))*rho(i,k)*latvap ! total water mixig ratio flux
+ rtpthlp_output(i,k) = rtpthlp(i,k)-(apply_const*rtpthlp_const) ! rtpthlp output
+ wp3_output(i,k) = wp3(i,k) - (apply_const*wp3_const) ! wp3 output
+ tke(i,k) = 0.5_r8*(up2(i,k)+vp2(i,k)+wp2(i,k)) ! turbulent kinetic energy
+ enddo
+ enddo
+
+ ! --------------------------------------------------------------------------------- !
+ ! Diagnose some quantities that are computed in macrop_tend here. !
+ ! These are inputs required for the microphysics calculation. !
+ ! !
+ ! FIRST PART COMPUTES THE STRATIFORM CLOUD FRACTION FROM CLUBB CLOUD FRACTION !
+ ! --------------------------------------------------------------------------------- !
+
+ ! initialize variables
+ alst(:,:) = 0.0_r8
+ qlst(:,:) = 0.0_r8
+
+ do k=1,pver
+ do i=1,ncol
+ alst(i,k) = cloud_frac(i,k)
+ qlst(i,k) = rcm(i,k)/max(0.01_r8,alst(i,k)) ! Incloud stratus condensate mixing ratio
+ enddo
+ enddo
+
+ ! --------------------------------------------------------------------------------- !
+ ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION !
+ ! --------------------------------------------------------------------------------- !
+
+ deepcu(:,pver) = 0.0_r8
+ shalcu(:,pver) = 0.0_r8
+
+ do k=1,pver-1
+ do i=1,ncol
+ ! diagnose the deep convective cloud fraction, as done in macrophysics based on the
+ ! deep convective mass flux, read in from pbuf. Since shallow convection is never
+ ! called, the shallow convective mass flux will ALWAYS be zero, ensuring that this cloud
+ ! fraction is purely from deep convection scheme.
+ deepcu(i,k) = max(0.0_r8,min(0.1_r8*log(1.0_r8+500.0_r8*(cmfmc(i,k+1)-cmfmc_sh(i,k+1))),0.6_r8))
+ shalcu(i,k) = 0._r8
+
+ if (deepcu(i,k) <= frac_limit .or. dp_icwmr(i,k) < ic_limit) then
+ deepcu(i,k) = 0._r8
+ endif
+
+ ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable
+ ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation
+ ! found in macrophysics code. Assumes that convective cloud is all nonstratiform cloud
+ ! from CLUBB plus the deep convective cloud fraction
+ concld(i,k) = min(cloud_frac(i,k)-alst(i,k)+deepcu(i,k),0.80_r8)
+ enddo
+ enddo
+
+ if (single_column) then
+ if (trim(scm_clubb_iop_name) .eq. 'ATEX_48hr' .or. &
+ trim(scm_clubb_iop_name) .eq. 'BOMEX_5day' .or. &
+ trim(scm_clubb_iop_name) .eq. 'DYCOMSrf01_4day' .or. &
+ trim(scm_clubb_iop_name) .eq. 'DYCOMSrf02_06hr' .or. &
+ trim(scm_clubb_iop_name) .eq. 'RICO_3day' .or. &
+ trim(scm_clubb_iop_name) .eq. 'ARM_CC') then
+
+ deepcu(:,:) = 0.0_r8
+ concld(:,:) = 0.0_r8
+
+ endif
+ endif
+
+ ! --------------------------------------------------------------------------------- !
+ ! COMPUTE THE ICE CLOUD FRACTION PORTION !
+ ! use the aist_vector function to compute the ice cloud fraction !
+ ! --------------------------------------------------------------------------------- !
+
+ aist(:,:top_lev-1) = 0._r8
+ qsatfac(:, :top_lev-1) = 0._r8
+
+ do k = top_lev, pver
+
+ ! For Type II PSC and for thin cirrus, the clouds can be thin, but
+ ! extensive and they should start forming when the gridbox mean saturation
+ ! reaches 1.0.
+ !
+ ! For now, use the tropopause diagnostic to determine where the Type II
+ ! PSC should be, but in the future wold like a better metric that can also
+ ! identify the level for thin cirrus. Include the tropopause level so that
+ ! the cold point tropopause will use the stratospheric values.
+ where (k <= troplev)
+ rhmini = rhminis_const
+ rhmaxi = rhmaxis_const
+ elsewhere
+ rhmini = rhmini_const
+ rhmaxi = rhmaxi_const
+ end where
+
+ call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), &
+ state1%q(:,k,ixnumice),cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol,&
+ qsatfac_out=qsatfac(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi)
+ enddo
+
+ ! --------------------------------------------------------------------------------- !
+ ! THIS PART COMPUTES THE LIQUID STRATUS FRACTION !
+ ! !
+ ! For now leave the computation of ice stratus fraction from macrop_driver intact !
+ ! because CLUBB does nothing with ice. Here I simply overwrite the liquid stratus !
+ ! fraction that was coded in macrop_driver !
+ ! --------------------------------------------------------------------------------- !
+
+ ! Recompute net stratus fraction using maximum over-lapping assumption, as done
+ ! in macrophysics code, using alst computed above and aist read in from physics buffer
+
+ do k=1,pver
+ do i=1,ncol
+
+ ast(i,k) = max(alst(i,k),aist(i,k))
+
+ qist(i,k) = state1%q(i,k,ixcldice)/max(0.01_r8,aist(i,k))
+ enddo
+ enddo
+
+ ! Probably need to add deepcu cloud fraction to the cloud fraction array, else would just
+ ! be outputting the shallow convective cloud fraction
+
+ do k=1,pver
+ do i=1,ncol
+ cloud_frac(i,k) = min(ast(i,k)+deepcu(i,k),1.0_r8)
+ enddo
+ enddo
+
+ ! --------------------------------------------------------------------------------- !
+ ! DIAGNOSE THE PBL DEPTH !
+ ! this is needed for aerosol code !
+ ! --------------------------------------------------------------------------------- !
+
+ do i=1,ncol
+ do k=1,pver
+ th(i,k) = state1%t(i,k)*state1%exner(i,k)
+ thv(i,k) = th(i,k)*(1.0_r8+zvir*state1%q(i,k,ixq))
+ enddo
+ enddo
+
+ ! diagnose surface friction and obukhov length (inputs to diagnose PBL depth)
+ call calc_ustar( ncol, state1%t(1:ncol,pver), state1%pmid(1:ncol,pver), cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), &
+ rrho(1:ncol), ustar2(1:ncol))
+ call calc_obklen( ncol, th(1:ncol,pver), thv(1:ncol,pver), cam_in%lhf(1:ncol)/latvap, cam_in%shf(1:ncol), &
+ rrho(1:ncol), ustar2(1:ncol), kinheat(1:ncol), kinwat(1:ncol), kbfs(1:ncol), &
+ obklen(1:ncol))
+
+ dummy2(:) = 0._r8
+ dummy3(:) = 0._r8
+
+ where (kbfs(:ncol) .eq. -0.0_r8) kbfs(:ncol) = 0.0_r8
+
+ ! Compute PBL depth according to Holtslag-Boville Scheme
+ call pblintd(ncol, thv, state1%zm, state1%u, state1%v, &
+ ustar2, obklen, kbfs, pblh, dummy2, &
+ state1%zi, cloud_frac(:,1:pver), 1._r8-cam_in%landfrac, dummy3)
+
+ ! Output the PBL depth
+ call outfld('PBLH', pblh, pcols, lchnk)
+
+ ! Assign the first pver levels of cloud_frac back to cld
+ cld(:,1:pver) = cloud_frac(:,1:pver)
+
+ ! --------------------------------------------------------------------------------- !
+ ! END CLOUD FRACTION DIAGNOSIS, begin to store variables back into buffer !
+ ! --------------------------------------------------------------------------------- !
+
+ ! Output calls of variables goes here
+ call outfld( 'RELVAR', relvar, pcols, lchnk )
+ call outfld( 'RHO_CLUBB', rho, pcols, lchnk )
+ call outfld( 'WP2_CLUBB', wp2, pcols, lchnk )
+ call outfld( 'UP2_CLUBB', up2, pcols, lchnk )
+ call outfld( 'VP2_CLUBB', vp2, pcols, lchnk )
+ call outfld( 'WP3_CLUBB', wp3_output, pcols, lchnk )
+ call outfld( 'UPWP_CLUBB', upwp, pcols, lchnk )
+ call outfld( 'VPWP_CLUBB', vpwp, pcols, lchnk )
+ call outfld( 'WPTHLP_CLUBB', wpthlp_output, pcols, lchnk )
+ call outfld( 'WPRTP_CLUBB', wprtp_output, pcols, lchnk )
+
+ temp2dp(:ncol,:) = rtp2(:ncol,:)*1000._r8
+ call outfld( 'RTP2_CLUBB', temp2dp, pcols, lchnk )
+
+ call outfld( 'THLP2_CLUBB', thlp2, pcols, lchnk )
+
+ rtpthlp_output(:ncol,:) = rtpthlp_output(:ncol,:) * 1000._r8
+ call outfld( 'RTPTHLP_CLUBB', rtpthlp_output, pcols, lchnk )
+
+ temp2dp(:ncol,:) = rcm(:ncol,:) * 1000._r8
+ call outfld( 'RCM_CLUBB', temp2dp, pcols, lchnk )
+
+ temp2dp(:ncol,:) = wprcp(:ncol,:) * latvap
+ call outfld( 'WPRCP_CLUBB', temp2dp, pcols, lchnk )
+
+ temp2dp(:ncol,:) = rcm_in_layer(:ncol,:) * 1000._r8
+ call outfld( 'RCMINLAYER_CLUBB', temp2dp, pcols, lchnk )
+
+ temp2dp(:ncol,:) = wpthvp(:ncol,:) * cpair
+ call outfld( 'WPTHVP_CLUBB', temp2dp, pcols, lchnk )
+
+ call outfld( 'CLOUDFRAC_CLUBB', alst, pcols, lchnk )
+ call outfld( 'CLOUDCOVER_CLUBB', cloud_frac, pcols, lchnk )
+ call outfld( 'ZT_CLUBB', zt_out, pcols, lchnk )
+ call outfld( 'ZM_CLUBB', zi_out, pcols, lchnk )
+ call outfld( 'UM_CLUBB', um, pcols, lchnk )
+ call outfld( 'VM_CLUBB', vm, pcols, lchnk )
+ call outfld( 'THETAL', thetal_output, pcols, lchnk )
+ call outfld( 'QT', qt_output, pcols, lchnk )
+ call outfld( 'SL', sl_output, pcols, lchnk )
+ call outfld( 'CONCLD', concld, pcols, lchnk )
+ call outfld( 'CLUBB_GRID_SIZE', grid_dx, pcols, lchnk )
+ call outfld( 'QSATFAC', qsatfac, pcols, lchnk)
+
+ ! Output CLUBB history here
+ if (l_stats) then
+
+ do i=1,stats_zt%num_output_fields
+
+ temp1 = trim(stats_zt%file%var(i)%name)
+ sub = temp1
+ if (len(temp1) .gt. 16) sub = temp1(1:16)
+
+ call outfld(trim(sub), out_zt(:,:,i), pcols, lchnk )
+ enddo
+
+ do i=1,stats_zm%num_output_fields
+
+ temp1 = trim(stats_zm%file%var(i)%name)
+ sub = temp1
+ if (len(temp1) .gt. 16) sub = temp1(1:16)
+
+ call outfld(trim(sub),out_zm(:,:,i), pcols, lchnk)
+ enddo
+
+ if (l_output_rad_files) then
+ do i=1,stats_rad_zt%num_output_fields
+ call outfld(trim(stats_rad_zt%file%var(i)%name), out_radzt(:,:,i), pcols, lchnk)
+ enddo
+
+ do i=1,stats_rad_zm%num_output_fields
+ call outfld(trim(stats_rad_zm%file%var(i)%name), out_radzm(:,:,i), pcols, lchnk)
+ enddo
+ endif
+
+ do i=1,stats_sfc%num_output_fields
+ call outfld(trim(stats_sfc%file%var(i)%name), out_sfc(:,:,i), pcols, lchnk)
+ enddo
+
+ endif
+
+ return
+#endif
+ end subroutine clubb_tend_cam
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+
+#ifdef CLUBB_SGS
+! ----------------------------------------------------------------------
+!
+! DISCLAIMER : this code appears to be correct but has not been
+! very thouroughly tested. If you do notice any
+! anomalous behaviour then please contact Andy and/or
+! Bjorn
+!
+! Function diag_ustar: returns value of ustar using the below
+! similarity functions and a specified buoyancy flux (bflx) given in
+! kinematic units
+!
+! phi_m (zeta > 0) = (1 + am * zeta)
+! phi_m (zeta < 0) = (1 - bm * zeta)^(-1/4)
+!
+! where zeta = z/lmo and lmo = (theta_rev/g*vonk) * (ustar^2/tstar)
+!
+! Ref: Businger, 1973, Turbulent Transfer in the Atmospheric Surface
+! Layer, in Workshop on Micormeteorology, pages 67-100.
+!
+! Code writen March, 1999 by Bjorn Stevens
+!
+
+real(r8) function diag_ustar( z, bflx, wnd, z0 )
+
+use shr_const_mod, only : shr_const_karman, shr_const_pi, shr_const_g
+
+implicit none
+
+real(r8), parameter :: am = 4.8_r8 ! " " "
+real(r8), parameter :: bm = 19.3_r8 ! " " "
+
+real(r8), parameter :: grav = shr_const_g
+real(r8), parameter :: vonk = shr_const_karman
+real(r8), parameter :: pi = shr_const_pi
+
+real(r8), intent (in) :: z ! height where u locates
+real(r8), intent (in) :: bflx ! surface buoyancy flux (m^2/s^3)
+real(r8), intent (in) :: wnd ! wind speed at z
+real(r8), intent (in) :: z0 ! momentum roughness height
+
+
+integer :: iterate
+real(r8) :: lnz, klnz, c1, x, psi1, zeta, lmo, ustar
+
+lnz = log( z / z0 )
+klnz = vonk/lnz
+c1 = pi / 2.0_r8 - 3.0_r8*log( 2.0_r8 )
+
+ustar = wnd*klnz
+if (abs(bflx) > 1.e-6_r8) then
+ do iterate=1,4
+
+ if (ustar > 1.e-6_r8) then
+ lmo = -ustar**3 / ( vonk * bflx )
+ zeta = z/lmo
+ if (zeta > 0._r8) then
+ ustar = vonk*wnd /(lnz + am*zeta)
+ else
+ x = sqrt( sqrt( 1.0_r8 - bm*zeta ) )
+ psi1 = 2._r8*log( 1.0_r8+x ) + log( 1.0_r8+x*x ) - 2._r8*atan( x ) + c1
+ ustar = wnd*vonk/(lnz - psi1)
+ end if
+
+ endif
+
+ end do
+end if
+
+
+diag_ustar = ustar
+
+return
+
+
+end function diag_ustar
+#endif
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+
+#ifdef CLUBB_SGS
+
+ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, &
+ nnzp, nnrad_zt,nnrad_zm, delt )
+ !
+ ! Description: Initializes the statistics saving functionality of
+ ! the CLUBB model. This is for purpose of CAM-CLUBB interface. Here
+ ! the traditional stats_init of CLUBB is not called, as it is not compatible
+ ! with CAM output.
+
+ !-----------------------------------------------------------------------
+
+
+ use stats_variables, only: &
+ stats_zt, & ! Variables
+ ztscr01, &
+ ztscr02, &
+ ztscr03, &
+ ztscr04, &
+ ztscr05, &
+ ztscr06, &
+ ztscr07, &
+ ztscr08, &
+ ztscr09, &
+ ztscr10, &
+ ztscr11, &
+ ztscr12, &
+ ztscr13, &
+ ztscr14, &
+ ztscr15, &
+ ztscr16, &
+ ztscr17, &
+ ztscr18, &
+ ztscr19, &
+ ztscr20, &
+ ztscr21
+
+ use stats_variables, only: &
+ stats_zm, &
+ zmscr01, &
+ zmscr02, &
+ zmscr03, &
+ zmscr04, &
+ zmscr05, &
+ zmscr06, &
+ zmscr07, &
+ zmscr08, &
+ zmscr09, &
+ zmscr10, &
+ zmscr11, &
+ zmscr12, &
+ zmscr13, &
+ zmscr14, &
+ zmscr15, &
+ zmscr16, &
+ zmscr17, &
+ stats_rad_zt, &
+ stats_rad_zm, &
+ stats_sfc, &
+ l_stats, &
+ l_output_rad_files, &
+ stats_tsamp, &
+ stats_tout, &
+ l_stats_samp, &
+ l_stats_last, &
+ l_netcdf, &
+ l_grads
+
+ use clubb_precision, only: time_precision !
+ use stats_zm_module, only: nvarmax_zm, stats_init_zm !
+ use stats_zt_module, only: nvarmax_zt, stats_init_zt !
+ use stats_rad_zt_module, only: nvarmax_rad_zt, stats_init_rad_zt !
+ use stats_rad_zm_module, only: nvarmax_rad_zm, stats_init_rad_zm !
+ use stats_sfc_module, only: nvarmax_sfc, stats_init_sfc !
+ use constants_clubb, only: fstderr, var_length !
+ use cam_history, only: addfld, horiz_only
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use cam_abortutils, only: endrun
+ use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_character
+
+ implicit none
+
+ ! Input Variables
+
+ logical, intent(in) :: l_stats_in ! Stats on? T/F
+
+ real(kind=time_precision), intent(in) :: &
+ stats_tsamp_in, & ! Sampling interval [s]
+ stats_tout_in ! Output interval [s]
+
+ integer, intent(in) :: nnzp ! Grid points in the vertical [count]
+ integer, intent(in) :: nnrad_zt ! Grid points in the radiation grid [count]
+ integer, intent(in) :: nnrad_zm ! Grid points in the radiation grid [count]
+
+ real(kind=time_precision), intent(in) :: delt ! Timestep (dtmain in CLUBB) [s]
+
+
+ ! Local Variables
+
+ ! Namelist Variables
+
+ character(len=*), parameter :: subr = 'stats_init_clubb'
+
+ character(len=var_length), dimension(nvarmax_zt) :: clubb_vars_zt ! Variables on the thermodynamic levels
+ character(len=var_length), dimension(nvarmax_zm) :: clubb_vars_zm ! Variables on the momentum levels
+ character(len=var_length), dimension(nvarmax_rad_zt) :: clubb_vars_rad_zt ! Variables on the radiation levels
+ character(len=var_length), dimension(nvarmax_rad_zm) :: clubb_vars_rad_zm ! Variables on the radiation levels
+ character(len=var_length), dimension(nvarmax_sfc) :: clubb_vars_sfc ! Variables at the model surface
+
+ namelist /clubb_stats_nl/ &
+ clubb_vars_zt, &
+ clubb_vars_zm, &
+ clubb_vars_rad_zt, &
+ clubb_vars_rad_zm, &
+ clubb_vars_sfc
+
+ ! Local Variables
+
+ logical :: l_error
+
+ character(len=200) :: temp1, sub
+
+ integer :: i, ntot, read_status
+ integer :: iunit, ierr
+
+ ! Initialize
+ l_error = .false.
+
+ ! Set stats_variables variables with inputs from calling subroutine
+ l_stats = l_stats_in
+
+ stats_tsamp = stats_tsamp_in
+ stats_tout = stats_tout_in
+
+ if ( .not. l_stats ) then
+ l_stats_samp = .false.
+ l_stats_last = .false.
+ return
+ end if
+
+ ! Initialize namelist variables
+
+ clubb_vars_zt = ''
+ clubb_vars_zm = ''
+ clubb_vars_rad_zt = ''
+ clubb_vars_rad_zm = ''
+ clubb_vars_sfc = ''
+
+ ! Read variables to compute from the namelist
+ if (masterproc) then
+ iunit= getunit()
+ open(unit=iunit,file="atm_in",status='old')
+ call find_group_name(iunit, 'clubb_stats_nl', status=read_status)
+ if (read_status == 0) then
+ read(unit=iunit, nml=clubb_stats_nl, iostat=read_status)
+ if (read_status /= 0) then
+ call endrun('stats_init_clubb: error reading namelist')
+ end if
+ end if
+ close(unit=iunit)
+ call freeunit(iunit)
+ end if
+
+ ! Broadcast namelist variables
+ call mpi_bcast(clubb_vars_zt, var_length*nvarmax_zt, mpi_character, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_zt")
+ call mpi_bcast(clubb_vars_zm, var_length*nvarmax_zm, mpi_character, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_zm")
+ call mpi_bcast(clubb_vars_rad_zt, var_length*nvarmax_rad_zt, mpi_character, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_rad_zt")
+ call mpi_bcast(clubb_vars_rad_zm, var_length*nvarmax_rad_zm, mpi_character, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_rad_zm")
+ call mpi_bcast(clubb_vars_sfc, var_length*nvarmax_sfc, mpi_character, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(subr//": FATAL: mpi_bcast: clubb_vars_sfc")
+
+ ! Hardcode these for use in CAM-CLUBB, don't want either
+ l_netcdf = .false.
+ l_grads = .false.
+
+ ! Check sampling and output frequencies
+
+ ! The model time step length, delt (which is dtmain), should multiply
+ ! evenly into the statistical sampling time step length, stats_tsamp.
+ if ( abs( stats_tsamp/delt - floor(stats_tsamp/delt) ) > 1.e-8_r8 ) then
+ l_error = .true. ! This will cause the run to stop.
+ write(fstderr,*) 'Error: stats_tsamp should be an even multiple of ', &
+ 'delt (which is dtmain). Check the appropriate ', &
+ 'model.in file.'
+ write(fstderr,*) 'stats_tsamp = ', stats_tsamp
+ write(fstderr,*) 'delt = ', delt
+ endif
+
+ ! Initialize zt (mass points)
+
+ i = 1
+ do while ( ichar(clubb_vars_zt(i)(1:1)) /= 0 .and. &
+ len_trim(clubb_vars_zt(i)) /= 0 .and. &
+ i <= nvarmax_zt )
+ i = i + 1
+ enddo
+ ntot = i - 1
+ if ( ntot == nvarmax_zt ) then
+ write(fstderr,*) "There are more statistical variables listed in ", &
+ "clubb_vars_zt than allowed for by nvarmax_zt."
+ write(fstderr,*) "Check the number of variables listed for clubb_vars_zt ", &
+ "in the stats namelist, or change nvarmax_zt."
+ write(fstderr,*) "nvarmax_zt = ", nvarmax_zt
+ call endrun ("stats_init_clubb: number of zt statistical variables exceeds limit")
+ endif
+
+ stats_zt%num_output_fields = ntot
+ stats_zt%kk = nnzp
+
+ allocate( stats_zt%z( stats_zt%kk ) )
+
+ allocate( stats_zt%accum_field_values( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) )
+ allocate( stats_zt%accum_num_samples( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) )
+ allocate( stats_zt%l_in_update( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) )
+ call stats_zero( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, &
+ stats_zt%accum_num_samples, stats_zt%l_in_update )
+
+ allocate( stats_zt%file%var( stats_zt%num_output_fields ) )
+ allocate( stats_zt%file%z( stats_zt%kk ) )
+
+ ! Allocate scratch space
+
+ allocate( ztscr01(stats_zt%kk) )
+ allocate( ztscr02(stats_zt%kk) )
+ allocate( ztscr03(stats_zt%kk) )
+ allocate( ztscr04(stats_zt%kk) )
+ allocate( ztscr05(stats_zt%kk) )
+ allocate( ztscr06(stats_zt%kk) )
+ allocate( ztscr07(stats_zt%kk) )
+ allocate( ztscr08(stats_zt%kk) )
+ allocate( ztscr09(stats_zt%kk) )
+ allocate( ztscr10(stats_zt%kk) )
+ allocate( ztscr11(stats_zt%kk) )
+ allocate( ztscr12(stats_zt%kk) )
+ allocate( ztscr13(stats_zt%kk) )
+ allocate( ztscr14(stats_zt%kk) )
+ allocate( ztscr15(stats_zt%kk) )
+ allocate( ztscr16(stats_zt%kk) )
+ allocate( ztscr17(stats_zt%kk) )
+ allocate( ztscr18(stats_zt%kk) )
+ allocate( ztscr19(stats_zt%kk) )
+ allocate( ztscr20(stats_zt%kk) )
+ allocate( ztscr21(stats_zt%kk) )
+
+ ztscr01 = 0.0_r8
+ ztscr02 = 0.0_r8
+ ztscr03 = 0.0_r8
+ ztscr04 = 0.0_r8
+ ztscr05 = 0.0_r8
+ ztscr06 = 0.0_r8
+ ztscr07 = 0.0_r8
+ ztscr08 = 0.0_r8
+ ztscr09 = 0.0_r8
+ ztscr10 = 0.0_r8
+ ztscr11 = 0.0_r8
+ ztscr12 = 0.0_r8
+ ztscr13 = 0.0_r8
+ ztscr14 = 0.0_r8
+ ztscr15 = 0.0_r8
+ ztscr16 = 0.0_r8
+ ztscr17 = 0.0_r8
+ ztscr18 = 0.0_r8
+ ztscr19 = 0.0_r8
+ ztscr20 = 0.0_r8
+ ztscr21 = 0.0_r8
+
+ ! Default initialization for array indices for zt
+
+ call stats_init_zt( clubb_vars_zt, l_error )
+
+ ! Initialize zm (momentum points)
+
+ i = 1
+ do while ( ichar(clubb_vars_zm(i)(1:1)) /= 0 .and. &
+ len_trim(clubb_vars_zm(i)) /= 0 .and. &
+ i <= nvarmax_zm )
+ i = i + 1
+ end do
+ ntot = i - 1
+ if ( ntot == nvarmax_zm ) then
+ write(fstderr,*) "There are more statistical variables listed in ", &
+ "clubb_vars_zm than allowed for by nvarmax_zm."
+ write(fstderr,*) "Check the number of variables listed for clubb_vars_zm ", &
+ "in the stats namelist, or change nvarmax_zm."
+ write(fstderr,*) "nvarmax_zm = ", nvarmax_zm
+ call endrun ("stats_init_clubb: number of zm statistical variables exceeds limit")
+ endif
+
+ stats_zm%num_output_fields = ntot
+ stats_zm%kk = nnzp
+
+ allocate( stats_zm%z( stats_zm%kk ) )
+
+ allocate( stats_zm%accum_field_values( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) )
+ allocate( stats_zm%accum_num_samples( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) )
+ allocate( stats_zm%l_in_update( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) )
+ call stats_zero( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, &
+ stats_zm%accum_num_samples, stats_zm%l_in_update )
+
+ allocate( stats_zm%file%var( stats_zm%num_output_fields ) )
+ allocate( stats_zm%file%z( stats_zm%kk ) )
+
+ ! Allocate scratch space
+
+ allocate( zmscr01(stats_zm%kk) )
+ allocate( zmscr02(stats_zm%kk) )
+ allocate( zmscr03(stats_zm%kk) )
+ allocate( zmscr04(stats_zm%kk) )
+ allocate( zmscr05(stats_zm%kk) )
+ allocate( zmscr06(stats_zm%kk) )
+ allocate( zmscr07(stats_zm%kk) )
+ allocate( zmscr08(stats_zm%kk) )
+ allocate( zmscr09(stats_zm%kk) )
+ allocate( zmscr10(stats_zm%kk) )
+ allocate( zmscr11(stats_zm%kk) )
+ allocate( zmscr12(stats_zm%kk) )
+ allocate( zmscr13(stats_zm%kk) )
+ allocate( zmscr14(stats_zm%kk) )
+ allocate( zmscr15(stats_zm%kk) )
+ allocate( zmscr16(stats_zm%kk) )
+ allocate( zmscr17(stats_zm%kk) )
+
+ zmscr01 = 0.0_r8
+ zmscr02 = 0.0_r8
+ zmscr03 = 0.0_r8
+ zmscr04 = 0.0_r8
+ zmscr05 = 0.0_r8
+ zmscr06 = 0.0_r8
+ zmscr07 = 0.0_r8
+ zmscr08 = 0.0_r8
+ zmscr09 = 0.0_r8
+ zmscr10 = 0.0_r8
+ zmscr11 = 0.0_r8
+ zmscr12 = 0.0_r8
+ zmscr13 = 0.0_r8
+ zmscr14 = 0.0_r8
+ zmscr15 = 0.0_r8
+ zmscr16 = 0.0_r8
+ zmscr17 = 0.0_r8
+
+ call stats_init_zm( clubb_vars_zm, l_error )
+
+ ! Initialize rad_zt (radiation points)
+
+ if (l_output_rad_files) then
+
+ i = 1
+ do while ( ichar(clubb_vars_rad_zt(i)(1:1)) /= 0 .and. &
+ len_trim(clubb_vars_rad_zt(i)) /= 0 .and. &
+ i <= nvarmax_rad_zt )
+ i = i + 1
+ end do
+ ntot = i - 1
+ if ( ntot == nvarmax_rad_zt ) then
+ write(fstderr,*) "There are more statistical variables listed in ", &
+ "clubb_vars_rad_zt than allowed for by nvarmax_rad_zt."
+ write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zt ", &
+ "in the stats namelist, or change nvarmax_rad_zt."
+ write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt
+ call endrun ("stats_init_clubb: number of rad_zt statistical variables exceeds limit")
+ endif
+
+ stats_rad_zt%num_output_fields = ntot
+ stats_rad_zt%kk = nnrad_zt
+
+ allocate( stats_rad_zt%z( stats_rad_zt%kk ) )
+
+ allocate( stats_rad_zt%accum_field_values( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) )
+ allocate( stats_rad_zt%accum_num_samples( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) )
+ allocate( stats_rad_zt%l_in_update( 1, 1, stats_rad_zt%kk, stats_rad_zt%num_output_fields ) )
+
+ call stats_zero( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, &
+ stats_rad_zt%accum_num_samples, stats_rad_zt%l_in_update )
+
+ allocate( stats_rad_zt%file%var( stats_rad_zt%num_output_fields ) )
+ allocate( stats_rad_zt%file%z( stats_rad_zt%kk ) )
+
+ call stats_init_rad_zt( clubb_vars_rad_zt, l_error )
+
+ ! Initialize rad_zm (radiation points)
+
+ i = 1
+ do while ( ichar(clubb_vars_rad_zm(i)(1:1)) /= 0 .and. &
+ len_trim(clubb_vars_rad_zm(i)) /= 0 .and. &
+ i <= nvarmax_rad_zm )
+ i = i + 1
+ end do
+ ntot = i - 1
+ if ( ntot == nvarmax_rad_zm ) then
+ write(fstderr,*) "There are more statistical variables listed in ", &
+ "clubb_vars_rad_zm than allowed for by nvarmax_rad_zm."
+ write(fstderr,*) "Check the number of variables listed for clubb_vars_rad_zm ", &
+ "in the stats namelist, or change nvarmax_rad_zm."
+ write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm
+ call endrun ("stats_init_clubb: number of rad_zm statistical variables exceeds limit")
+ endif
+
+ stats_rad_zm%num_output_fields = ntot
+ stats_rad_zm%kk = nnrad_zm
+
+ allocate( stats_rad_zm%z( stats_rad_zm%kk ) )
+
+ allocate( stats_rad_zm%accum_field_values( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) )
+ allocate( stats_rad_zm%accum_num_samples( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) )
+ allocate( stats_rad_zm%l_in_update( 1, 1, stats_rad_zm%kk, stats_rad_zm%num_output_fields ) )
+
+ call stats_zero( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, &
+ stats_rad_zm%accum_num_samples, stats_rad_zm%l_in_update )
+
+ allocate( stats_rad_zm%file%var( stats_rad_zm%num_output_fields ) )
+ allocate( stats_rad_zm%file%z( stats_rad_zm%kk ) )
+
+ call stats_init_rad_zm( clubb_vars_rad_zm, l_error )
+ end if ! l_output_rad_files
+
+
+ ! Initialize sfc (surface point)
+
+ i = 1
+ do while ( ichar(clubb_vars_sfc(i)(1:1)) /= 0 .and. &
+ len_trim(clubb_vars_sfc(i)) /= 0 .and. &
+ i <= nvarmax_sfc )
+ i = i + 1
+ end do
+ ntot = i - 1
+ if ( ntot == nvarmax_sfc ) then
+ write(fstderr,*) "There are more statistical variables listed in ", &
+ "clubb_vars_sfc than allowed for by nvarmax_sfc."
+ write(fstderr,*) "Check the number of variables listed for clubb_vars_sfc ", &
+ "in the stats namelist, or change nvarmax_sfc."
+ write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc
+ call endrun ("stats_init_clubb: number of sfc statistical variables exceeds limit")
+ endif
+
+ stats_sfc%num_output_fields = ntot
+ stats_sfc%kk = 1
+
+ allocate( stats_sfc%z( stats_sfc%kk ) )
+
+ allocate( stats_sfc%accum_field_values( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) )
+ allocate( stats_sfc%accum_num_samples( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) )
+ allocate( stats_sfc%l_in_update( 1, 1, stats_sfc%kk, stats_sfc%num_output_fields ) )
+
+ call stats_zero( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, &
+ stats_sfc%accum_num_samples, stats_sfc%l_in_update )
+
+ allocate( stats_sfc%file%var( stats_sfc%num_output_fields ) )
+ allocate( stats_sfc%file%z( stats_sfc%kk ) )
+
+ call stats_init_sfc( clubb_vars_sfc, l_error )
+
+ ! Check for errors
+
+ if ( l_error ) then
+ call endrun ('stats_init: errors found')
+ endif
+
+! Now call add fields
+ do i = 1, stats_zt%num_output_fields
+
+ temp1 = trim(stats_zt%file%var(i)%name)
+ sub = temp1
+ if (len(temp1) .gt. 16) sub = temp1(1:16)
+
+!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical
+ call addfld(trim(sub),(/ 'ilev' /),&
+ 'A',trim(stats_zt%file%var(i)%units),trim(stats_zt%file%var(i)%description))
+ enddo
+
+ do i = 1, stats_zm%num_output_fields
+
+ temp1 = trim(stats_zm%file%var(i)%name)
+ sub = temp1
+ if (len(temp1) .gt. 16) sub = temp1(1:16)
+
+!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical
+ call addfld(trim(sub),(/ 'ilev' /),&
+ 'A',trim(stats_zm%file%var(i)%units),trim(stats_zm%file%var(i)%description))
+ enddo
+
+ if (l_output_rad_files) then
+!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical
+ do i = 1, stats_rad_zt%num_output_fields
+ call addfld(trim(stats_rad_zt%file%var(i)%name),(/ 'ilev' /),&
+ 'A',trim(stats_rad_zt%file%var(i)%units),trim(stats_rad_zt%file%var(i)%description))
+ enddo
+
+ do i = 1, stats_rad_zm%num_output_fields
+ call addfld(trim(stats_rad_zm%file%var(i)%name),(/ 'ilev' /),&
+ 'A',trim(stats_rad_zm%file%var(i)%units),trim(stats_rad_zm%file%var(i)%description))
+ enddo
+ endif
+
+ do i = 1, stats_sfc%num_output_fields
+ call addfld(trim(stats_sfc%file%var(i)%name),horiz_only,&
+ 'A',trim(stats_sfc%file%var(i)%units),trim(stats_sfc%file%var(i)%description))
+ enddo
+
+ return
+
+
+ end subroutine stats_init_clubb
+
+#endif
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+
+
+ !-----------------------------------------------------------------------
+ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out_sfc)
+
+ ! Description: Called when the stats timestep has ended. This subroutine
+ ! is responsible for calling statistics to be written to the output
+ ! format.
+ !-----------------------------------------------------------------------
+
+#ifdef CLUBB_SGS
+
+ use shr_infnan_mod, only: is_nan => shr_infnan_isnan
+
+ use constants_clubb, only: &
+ fstderr ! Constant(s)
+
+ use stats_variables, only: &
+ stats_zt, & ! Variable(s)
+ stats_zm, &
+ stats_rad_zt, &
+ stats_rad_zm, &
+ stats_sfc, &
+ l_stats_last, &
+ stats_tsamp, &
+ stats_tout, &
+ l_output_rad_files
+
+ use error_code, only: &
+ clubb_at_least_debug_level ! Procedure(s)
+
+ use cam_abortutils, only: endrun
+
+ implicit none
+
+
+#endif
+
+ integer :: thecol
+
+ real(r8), intent(inout) :: out_zt(:,:,:) ! (pcols,pverp,zt%nn)
+ real(r8), intent(inout) :: out_zm(:,:,:) ! (pcols,pverp,zt%nn)
+ real(r8), intent(inout) :: out_radzt(:,:,:) ! (pcols,pverp,rad_zt%nn)
+ real(r8), intent(inout) :: out_radzm(:,:,:) ! (pcols,pverp,rad_zm%nn)
+ real(r8), intent(inout) :: out_sfc(:,:,:) ! (pcols,1,sfc%nn)
+
+#ifdef CLUBB_SGS
+ ! Local Variables
+
+ integer :: i, k
+ logical :: l_error
+
+ ! Check if it is time to write to file
+
+ if ( .not. l_stats_last ) return
+
+ ! Initialize
+ l_error = .false.
+
+ ! Look for errors by checking the number of sampling points
+ ! for each variable in the zt statistics at each vertical level.
+ do i = 1, stats_zt%num_output_fields
+ do k = 1, stats_zt%kk
+
+ if ( stats_zt%accum_num_samples(1,1,k,i) /= 0 .and. &
+ stats_zt%accum_num_samples(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then
+
+ l_error = .true. ! This will stop the run
+
+ if ( clubb_at_least_debug_level( 1 ) ) then
+ write(fstderr,*) 'Possible sampling error for variable ', &
+ trim(stats_zt%file%var(i)%name), ' in zt ', &
+ 'at k = ', k, &
+ '; stats_zt%accum_num_samples(',k,',',i,') = ', stats_zt%accum_num_samples(1,1,k,i)
+ endif
+
+ endif
+
+ enddo
+ enddo
+
+ ! Look for errors by checking the number of sampling points
+ ! for each variable in the zm statistics at each vertical level.
+ do i = 1, stats_zm%num_output_fields
+ do k = 1, stats_zm%kk
+
+ if ( stats_zm%accum_num_samples(1,1,k,i) /= 0 .and. &
+ stats_zm%accum_num_samples(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then
+
+ l_error = .true. ! This will stop the run
+
+ if ( clubb_at_least_debug_level( 1 ) ) then
+ write(fstderr,*) 'Possible sampling error for variable ', &
+ trim(stats_zm%file%var(i)%name), ' in zm ', &
+ 'at k = ', k, &
+ '; stats_zm%accum_num_samples(',k,',',i,') = ', stats_zm%accum_num_samples(1,1,k,i)
+ endif
+
+ endif
+
+ enddo
+ enddo
+
+ if (l_output_rad_files) then
+ ! Look for errors by checking the number of sampling points
+ ! for each variable in the rad_zt statistics at each vertical level.
+ do i = 1, stats_rad_zt%num_output_fields
+ do k = 1, stats_rad_zt%kk
+
+ if ( stats_rad_zt%accum_num_samples(1,1,k,i) /= 0 .and. &
+ stats_rad_zt%accum_num_samples(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then
+
+ l_error = .true. ! This will stop the run
+
+ if ( clubb_at_least_debug_level( 1 ) ) then
+ write(fstderr,*) 'Possible sampling error for variable ', &
+ trim(stats_rad_zt%file%var(i)%name), ' in rad_zt ', &
+ 'at k = ', k, &
+ '; stats_rad_zt%accum_num_samples(',k,',',i,') = ', stats_rad_zt%accum_num_samples(1,1,k,i)
+ endif
+
+ endif
+
+ enddo
+ enddo
+
+ ! Look for errors by checking the number of sampling points
+ ! for each variable in the rad_zm statistics at each vertical level.
+ do i = 1, stats_rad_zm%num_output_fields
+ do k = 1, stats_rad_zm%kk
+
+ if ( stats_rad_zm%accum_num_samples(1,1,k,i) /= 0 .and. &
+ stats_rad_zm%accum_num_samples(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then
+
+ l_error = .true. ! This will stop the run
+
+ if ( clubb_at_least_debug_level( 1 ) ) then
+ write(fstderr,*) 'Possible sampling error for variable ', &
+ trim(stats_rad_zm%file%var(i)%name), ' in rad_zm ', &
+ 'at k = ', k, &
+ '; stats_rad_zm%accum_num_samples(',k,',',i,') = ', stats_rad_zm%accum_num_samples(1,1,k,i)
+ endif
+
+ endif
+
+ enddo
+ enddo
+ end if ! l_output_rad_files
+
+ ! Look for errors by checking the number of sampling points
+ ! for each variable in the sfc statistics at each vertical level.
+ do i = 1, stats_sfc%num_output_fields
+ do k = 1, stats_sfc%kk
+
+ if ( stats_sfc%accum_num_samples(1,1,k,i) /= 0 .and. &
+ stats_sfc%accum_num_samples(1,1,k,i) /= floor(stats_tout/stats_tsamp) ) then
+
+ l_error = .true. ! This will stop the run
+
+ if ( clubb_at_least_debug_level( 1 ) ) then
+ write(fstderr,*) 'Possible sampling error for variable ', &
+ trim(stats_sfc%file%var(i)%name), ' in sfc ', &
+ 'at k = ', k, &
+ '; stats_sfc%accum_num_samples(',k,',',i,') = ', stats_sfc%accum_num_samples(1,1,k,i)
+ endif
+
+ endif
+
+ enddo
+ enddo
+
+ ! Stop the run if errors are found.
+ if ( l_error ) then
+ write(fstderr,*) 'Possible statistical sampling error'
+ write(fstderr,*) 'For details, set debug_level to a value of at ', &
+ 'least 1 in the appropriate model.in file.'
+ call endrun ('stats_end_timestep: error(s) found')
+ endif
+
+ ! Compute averages
+ call stats_avg( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, stats_zt%accum_num_samples )
+ call stats_avg( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, stats_zm%accum_num_samples )
+ if (l_output_rad_files) then
+ call stats_avg( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, &
+ stats_rad_zt%accum_num_samples )
+ call stats_avg( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, &
+ stats_rad_zm%accum_num_samples )
+ end if
+ call stats_avg( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, stats_sfc%accum_num_samples )
+
+ ! Here we are not outputting the data, rather reading the stats into
+ ! arrays which are conformable to CAM output. Also, the data is "flipped"
+ ! in the vertical level to be the same as CAM output.
+ do i = 1, stats_zt%num_output_fields
+ do k = 1, stats_zt%kk
+ out_zt(thecol,pverp-k+1,i) = stats_zt%accum_field_values(1,1,k,i)
+ if(is_nan(out_zt(thecol,k,i))) out_zt(thecol,k,i) = 0.0_r8
+ enddo
+ enddo
+
+ do i = 1, stats_zm%num_output_fields
+ do k = 1, stats_zt%kk
+ out_zm(thecol,pverp-k+1,i) = stats_zm%accum_field_values(1,1,k,i)
+ if(is_nan(out_zm(thecol,k,i))) out_zm(thecol,k,i) = 0.0_r8
+ enddo
+ enddo
+
+ if (l_output_rad_files) then
+ do i = 1, stats_rad_zt%num_output_fields
+ do k = 1, stats_rad_zt%kk
+ out_radzt(thecol,pverp-k+1,i) = stats_rad_zt%accum_field_values(1,1,k,i)
+ if(is_nan(out_radzt(thecol,k,i))) out_radzt(thecol,k,i) = 0.0_r8
+ enddo
+ enddo
+
+ do i = 1, stats_rad_zm%num_output_fields
+ do k = 1, stats_rad_zm%kk
+ out_radzm(thecol,pverp-k+1,i) = stats_rad_zm%accum_field_values(1,1,k,i)
+ if(is_nan(out_radzm(thecol,k,i))) out_radzm(thecol,k,i) = 0.0_r8
+ enddo
+ enddo
+
+ ! Fill in values above the CLUBB top.
+ out_zt(thecol,:top_lev-1,:) = 0.0_r8
+ out_zm(thecol,:top_lev-1,:) = 0.0_r8
+ out_radzt(thecol,:top_lev-1,:) = 0.0_r8
+ out_radzm(thecol,:top_lev-1,:) = 0.0_r8
+
+ endif
+
+ do i = 1, stats_sfc%num_output_fields
+ out_sfc(thecol,1,i) = stats_sfc%accum_field_values(1,1,1,i)
+ if(is_nan(out_sfc(thecol,1,i))) out_sfc(thecol,1,i) = 0.0_r8
+ enddo
+
+ ! Reset sample fields
+ call stats_zero( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, &
+ stats_zt%accum_num_samples, stats_zt%l_in_update )
+ call stats_zero( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, &
+ stats_zm%accum_num_samples, stats_zm%l_in_update )
+ if (l_output_rad_files) then
+ call stats_zero( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, &
+ stats_rad_zt%accum_num_samples, stats_rad_zt%l_in_update )
+ call stats_zero( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, &
+ stats_rad_zm%accum_num_samples, stats_rad_zm%l_in_update )
+ end if
+ call stats_zero( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, &
+ stats_sfc%accum_num_samples, stats_sfc%l_in_update )
+
+ return
+
+#endif
+
+ end subroutine stats_end_timestep_clubb
+
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+
+#ifdef CLUBB_SGS
+
+ !-----------------------------------------------------------------------
+ subroutine stats_zero( kk, nn, x, n, l_in_update )
+
+ ! Description:
+ ! Initialize stats to zero
+ !-----------------------------------------------------------------------
+
+ use clubb_precision, only: &
+ stat_rknd, & ! Variable(s)
+ stat_nknd
+
+
+ implicit none
+
+ ! Input
+ integer, intent(in) :: kk, nn
+
+ ! Output
+ real(kind=stat_rknd), dimension(1,1,kk,nn), intent(out) :: x
+ integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(out) :: n
+ logical, dimension(1,1,kk,nn), intent(out) :: l_in_update
+
+ ! Zero out arrays
+
+ if ( nn > 0 ) then
+ x(:,:,:,:) = 0.0_r8
+ n(:,:,:,:) = 0
+ l_in_update(:,:,:,:) = .false.
+ end if
+
+ return
+
+ end subroutine stats_zero
+
+#endif
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+
+
+#ifdef CLUBB_SGS
+ !-----------------------------------------------------------------------
+ subroutine stats_avg( kk, nn, x, n )
+
+ ! Description:
+ ! Compute the average of stats fields
+ !-----------------------------------------------------------------------
+ use clubb_precision, only: &
+ stat_rknd, & ! Variable(s)
+ stat_nknd
+
+ implicit none
+
+ ! Input
+ integer, intent(in) :: nn, kk
+ integer(kind=stat_nknd), dimension(1,1,kk,nn), intent(in) :: n
+
+ ! Output
+ real(kind=stat_rknd), dimension(1,1,kk,nn), intent(inout) :: x
+
+ ! Internal
+
+ integer k,m
+
+ ! Compute averages
+
+ do m=1,nn
+ do k=1,kk
+
+ if ( n(1,1,k,m) > 0 ) then
+ x(1,1,k,m) = x(1,1,k,m) / real( n(1,1,k,m) )
+ end if
+
+ end do
+ end do
+
+ return
+
+ end subroutine stats_avg
+
+ subroutine grid_size(state, grid_dx, grid_dy)
+ ! Determine the size of the grid for each of the columns in state
+
+ use phys_grid, only: get_area_p
+ use shr_const_mod, only: shr_const_pi
+ use physics_types, only: physics_state
+
+
+ type(physics_state), intent(in) :: state
+ real(r8), intent(out) :: grid_dx(pcols), grid_dy(pcols) ! CAM grid [m]
+
+ real(r8), parameter :: earth_ellipsoid1 = 111132.92_r8 ! first coefficient, meters per degree longitude at equator
+ real(r8), parameter :: earth_ellipsoid2 = 559.82_r8 ! second expansion coefficient for WGS84 ellipsoid
+ real(r8), parameter :: earth_ellipsoid3 = 1.175_r8 ! third expansion coefficient for WGS84 ellipsoid
+
+ real(r8) :: mpdeglat, column_area, degree
+ integer :: i
+
+ ! determine the column area in radians
+ do i=1,state%ncol
+ column_area = get_area_p(state%lchnk,i)
+ degree = sqrt(column_area)*(180._r8/shr_const_pi)
+
+ ! Now find meters per degree latitude
+ ! Below equation finds distance between two points on an ellipsoid, derived from expansion
+ ! taking into account ellipsoid using World Geodetic System (WGS84) reference
+ mpdeglat = earth_ellipsoid1 - earth_ellipsoid2 * cos(2._r8*state%lat(i)) + earth_ellipsoid3 * cos(4._r8*state%lat(i))
+ grid_dx(i) = mpdeglat * degree
+ grid_dy(i) = grid_dx(i) ! Assume these are the same
+ enddo
+
+ end subroutine grid_size
+
+#endif
+
+end module clubb_intr
diff --git a/src/physics/cam/phys_control.F90 b/src/physics/cam/phys_control.F90
index 743bcf80ff..45d94af8af 100644
--- a/src/physics/cam/phys_control.F90
+++ b/src/physics/cam/phys_control.F90
@@ -66,8 +66,8 @@ module phys_control
logical :: history_chemistry = .true. ! output default chemistry-related variables
logical :: history_carma = .false. ! output default CARMA-related variables
logical :: history_clubb = .true. ! output default CLUBB-related variables
-logical :: history_cesm_forcing = .false.
logical :: history_dust = .false.
+logical :: history_cesm_forcing = .false.
logical :: history_scwaccm_forcing = .false.
logical :: history_chemspecies_srf = .false.
@@ -100,6 +100,9 @@ module phys_control
! FV dycore angular momentum correction
logical, public, protected :: fv_am_correction = .false.
+!tht: energy adjustment in dry mass adjustment
+logical, public, protected :: dme_energy_adjust = .false.
+
!=======================================================================
contains
!=======================================================================
@@ -126,7 +129,7 @@ subroutine phys_ctl_readnl(nlfile)
history_cesm_forcing, history_scwaccm_forcing, history_chemspecies_srf, &
do_clubb_sgs, state_debug_checks, use_hetfrz_classnuc, use_gw_oro, use_gw_front, &
use_gw_front_igw, use_gw_convect_dp, use_gw_convect_sh, cld_macmic_num_steps, &
- offline_driver, convproc_do_aer
+ offline_driver, convproc_do_aer, dme_energy_adjust !+tht
!-----------------------------------------------------------------------------
if (masterproc) then
@@ -169,9 +172,9 @@ subroutine phys_ctl_readnl(nlfile)
call mpi_bcast(history_chemistry, 1, mpi_logical, masterprocid, mpicom, ierr)
call mpi_bcast(history_carma, 1, mpi_logical, masterprocid, mpicom, ierr)
call mpi_bcast(history_clubb, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(history_dust, 1, mpi_logical, masterprocid, mpicom, ierr)
call mpi_bcast(history_cesm_forcing, 1, mpi_logical, masterprocid, mpicom, ierr)
call mpi_bcast(history_chemspecies_srf, 1, mpi_logical, masterprocid, mpicom, ierr)
- call mpi_bcast(history_dust, 1, mpi_logical, masterprocid, mpicom, ierr)
call mpi_bcast(history_scwaccm_forcing, 1, mpi_logical, masterprocid, mpicom, ierr)
call mpi_bcast(do_clubb_sgs, 1, mpi_logical, masterprocid, mpicom, ierr)
call mpi_bcast(state_debug_checks, 1, mpi_logical, masterprocid, mpicom, ierr)
@@ -184,6 +187,7 @@ subroutine phys_ctl_readnl(nlfile)
call mpi_bcast(cld_macmic_num_steps, 1, mpi_integer, masterprocid, mpicom, ierr)
call mpi_bcast(offline_driver, 1, mpi_logical, masterprocid, mpicom, ierr)
call mpi_bcast(convproc_do_aer, 1, mpi_logical, masterprocid, mpicom, ierr)
+ call mpi_bcast(dme_energy_adjust, 1, mpi_logical, masterprocid, mpicom, ierr) !+tht
use_spcam = ( cam_physpkg_is('spcam_sam1mom') &
.or. cam_physpkg_is('spcam_m2005'))
@@ -280,7 +284,7 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi
history_cesm_forcing_out, history_scwaccm_forcing_out, history_chemspecies_srf_out, &
cam_chempkg_out, prog_modal_aero_out, macrop_scheme_out, &
do_clubb_sgs_out, use_spcam_out, state_debug_checks_out, cld_macmic_num_steps_out, &
- offline_driver_out, convproc_do_aer_out)
+ offline_driver_out, convproc_do_aer_out, dme_energy_adjust_out) !+tht
!-----------------------------------------------------------------------
! Purpose: Return runtime settings
! deep_scheme_out : deep convection scheme
@@ -312,9 +316,9 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi
logical, intent(out), optional :: history_chemistry_out
logical, intent(out), optional :: history_carma_out
logical, intent(out), optional :: history_clubb_out
+ logical, intent(out), optional :: history_dust_out
logical, intent(out), optional :: history_cesm_forcing_out
logical, intent(out), optional :: history_chemspecies_srf_out
- logical, intent(out), optional :: history_dust_out
logical, intent(out), optional :: history_scwaccm_forcing_out
logical, intent(out), optional :: do_clubb_sgs_out
character(len=32), intent(out), optional :: cam_chempkg_out
@@ -323,6 +327,7 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi
integer, intent(out), optional :: cld_macmic_num_steps_out
logical, intent(out), optional :: offline_driver_out
logical, intent(out), optional :: convproc_do_aer_out
+ logical, intent(out), optional :: dme_energy_adjust_out !+tht
if ( present(deep_scheme_out ) ) deep_scheme_out = deep_scheme
if ( present(shallow_scheme_out ) ) shallow_scheme_out = shallow_scheme
@@ -357,6 +362,7 @@ subroutine phys_getopts(deep_scheme_out, shallow_scheme_out, eddy_scheme_out, mi
if ( present(cld_macmic_num_steps_out) ) cld_macmic_num_steps_out = cld_macmic_num_steps
if ( present(offline_driver_out ) ) offline_driver_out = offline_driver
if ( present(convproc_do_aer_out ) ) convproc_do_aer_out = convproc_do_aer
+ if ( present(dme_energy_adjust_out ) ) dme_energy_adjust_out = dme_energy_adjust !+tht
end subroutine phys_getopts
diff --git a/src/physics/cam/physics_types.F90 b/src/physics/cam/physics_types.F90
index f08911ad50..4d1524722f 100644
--- a/src/physics/cam/physics_types.F90
+++ b/src/physics/cam/physics_types.F90
@@ -7,7 +7,7 @@ module physics_types
use ppgrid, only: pcols, pver, psubcols
use constituents, only: pcnst, qmin, cnst_name
use geopotential, only: geopotential_dse, geopotential_t
- use physconst, only: zvir, gravit, cpair, rair, cpairv, rairv
+ use physconst, only: zvir, gravit, cpair, rair, cpairv, rairv, cpliq, cpwv !+tht
use phys_grid, only: get_ncols_p, get_rlon_all_p, get_rlat_all_p, get_gcol_all_p
use cam_logfile, only: iulog
use cam_abortutils, only: endrun
@@ -17,14 +17,14 @@ module physics_types
implicit none
private ! Make default type private to the module
- logical, parameter :: adjust_te = .FALSE.
+ !logical, parameter :: adjust_te = .FALSE.!-tht (c'd out)
! Public types:
public physics_state
public physics_tend
public physics_ptend
-
+
! Public interfaces
public physics_update
@@ -72,15 +72,15 @@ module physics_types
u, &! zonal wind (m/s)
v, &! meridional wind (m/s)
s, &! dry static energy
- omega, &! vertical pressure velocity (Pa/s)
- pmid, &! midpoint pressure (Pa)
- pmiddry, &! midpoint pressure dry (Pa)
+ omega, &! vertical pressure velocity (Pa/s)
+ pmid, &! midpoint pressure (Pa)
+ pmiddry, &! midpoint pressure dry (Pa)
pdel, &! layer thickness (Pa)
pdeldry, &! layer thickness dry (Pa)
rpdel, &! reciprocal of layer thickness (Pa)
rpdeldry,&! recipricol layer thickness dry (Pa)
lnpmid, &! ln(pmid)
- lnpmiddry,&! log midpoint pressure dry (Pa)
+ lnpmiddry,&! log midpoint pressure dry (Pa)
exner, &! inverse exner function w.r.t. surface pressure (ps/p)^(R/cp)
zm ! geopotential height above surface at midpoints (m)
@@ -89,9 +89,9 @@ module physics_types
real(r8), dimension(:,:),allocatable :: &
pint, &! interface pressure (Pa)
- pintdry, &! interface pressure dry (Pa)
+ pintdry, &! interface pressure dry (Pa)
lnpint, &! ln(pint)
- lnpintdry,&! log interface pressure dry (Pa)
+ lnpintdry,&! log interface pressure dry (Pa)
zi ! geopotential height above surface at interfaces (m)
real(r8), dimension(:),allocatable :: &
@@ -171,7 +171,7 @@ subroutine physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, psetcol
type(physics_tend), pointer :: phys_tend(:)
integer, intent(in) :: begchunk, endchunk
integer, intent(in) :: psetcols
-
+
integer :: ierr=0, lchnk
type(physics_state), pointer :: state
type(physics_tend), pointer :: tend
@@ -230,8 +230,8 @@ subroutine physics_update(state, ptend, dt, tend)
real(r8) :: zvirv(state%psetcols,pver) ! Local zvir array pointer
- real(r8),allocatable :: cpairv_loc(:,:,:)
- real(r8),allocatable :: rairv_loc(:,:,:)
+ real(r8),allocatable :: cpairv_loc(:,:)
+ real(r8),allocatable :: rairv_loc(:,:)
! PERGRO limits cldliq/ice for macro/microphysics:
character(len=24), parameter :: pergro_cldlim_names(4) = &
@@ -272,29 +272,6 @@ subroutine physics_update(state, ptend, dt, tend)
end if
end if
- !-----------------------------------------------------------------------
- ! cpairv_loc and rairv_loc need to be allocated to a size which matches state and ptend
- ! If psetcols == pcols, the cpairv is the correct size and just copy
- ! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair
- if (state%psetcols == pcols) then
- allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk))
- cpairv_loc(:,:,:) = cpairv(:,:,:)
- else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then
- allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk))
- cpairv_loc(:,:,:) = cpair
- else
- call endrun('physics_update: cpairv is not allowed to vary when subcolumns are turned on')
- end if
- if (state%psetcols == pcols) then
- allocate (rairv_loc(state%psetcols,pver,begchunk:endchunk))
- rairv_loc(:,:,:) = rairv(:,:,:)
- else if (state%psetcols > pcols .and. all(rairv(:,:,:) == rair)) then
- allocate(rairv_loc(state%psetcols,pver,begchunk:endchunk))
- rairv_loc(:,:,:) = rair
- else
- call endrun('physics_update: rairv_loc is not allowed to vary when subcolumns are turned on')
- end if
-
!-----------------------------------------------------------------------
call phys_getopts(state_debug_checks_out=state_debug_checks)
@@ -394,14 +371,35 @@ subroutine physics_update(state, ptend, dt, tend)
!------------------------------------------------------------------------
! Get indices for molecular weights and call WACCM-X physconst_update
!------------------------------------------------------------------------
- if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
call physconst_update(state%q, state%t, state%lchnk, ncol)
endif
-
- if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
- zvirv(:,:) = shr_const_rwv / rairv_loc(:,:,state%lchnk) - 1._r8
+
+ !-----------------------------------------------------------------------
+ ! cpairv_loc and rairv_loc need to be allocated to a size which matches state and ptend
+ ! If psetcols == pcols, the cpairv is the correct size and just copy
+ ! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair
+ allocate(cpairv_loc(state%psetcols,pver))
+ if (state%psetcols == pcols) then
+ cpairv_loc(:,:) = cpairv(:,:,state%lchnk)
+ else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then
+ cpairv_loc(:,:) = cpair
else
- zvirv(:,:) = zvir
+ call endrun('physics_update: cpairv is not allowed to vary when subcolumns are turned on')
+ end if
+ allocate(rairv_loc(state%psetcols,pver))
+ if (state%psetcols == pcols) then
+ rairv_loc(:,:) = rairv(:,:,state%lchnk)
+ else if (state%psetcols > pcols .and. all(rairv(:,:,:) == rair)) then
+ rairv_loc(:,:) = rair
+ else
+ call endrun('physics_update: rairv_loc is not allowed to vary when subcolumns are turned on')
+ end if
+
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ zvirv(:,:) = shr_const_rwv / rairv_loc(:,:) - 1._r8
+ else
+ zvirv(:,:) = zvir
endif
!-------------------------------------------------------------------------------------------------------------
@@ -410,9 +408,9 @@ subroutine physics_update(state, ptend, dt, tend)
if(ptend%ls) then
do k = ptend%top_level, ptend%bot_level
- state%t(:ncol,k) = state%t(:ncol,k) + ptend%s(:ncol,k)*dt/cpairv_loc(:ncol,k,state%lchnk)
+ state%t(:ncol,k) = state%t(:ncol,k) + ptend%s(:ncol,k)*dt/cpairv_loc(:ncol,k)
if (present(tend)) &
- tend%dtdt(:ncol,k) = tend%dtdt(:ncol,k) + ptend%s(:ncol,k)/cpairv_loc(:ncol,k,state%lchnk)
+ tend%dtdt(:ncol,k) = tend%dtdt(:ncol,k) + ptend%s(:ncol,k)/cpairv_loc(:ncol,k)
end do
end if
@@ -421,11 +419,11 @@ subroutine physics_update(state, ptend, dt, tend)
if (ptend%ls .or. ptend%lq(1)) then
call geopotential_t ( &
state%lnpint, state%lnpmid, state%pint , state%pmid , state%pdel , state%rpdel , &
- state%t , state%q(:,:,1), rairv_loc(:,:,state%lchnk), gravit , zvirv , &
+ state%t , state%q(:,:,1), rairv_loc(:,:), gravit , zvirv , &
state%zi , state%zm , ncol )
! update dry static energy for use in next process
do k = ptend%top_level, ptend%bot_level
- state%s(:ncol,k) = state%t(:ncol,k )*cpairv_loc(:ncol,k,state%lchnk) &
+ state%s(:ncol,k) = state%t(:ncol,k )*cpairv_loc(:ncol,k) &
+ gravit*state%zm(:ncol,k) + state%phis(:ncol)
end do
end if
@@ -691,19 +689,19 @@ subroutine physics_ptend_sum(ptend, ptend_sum, ncol)
if (ptend%psetcols /= ptend_sum%psetcols) then
call endrun('physics_ptend_sum error: ptend and ptend_sum must have the same value for psetcols')
end if
-
+
if (ncol > ptend_sum%psetcols) then
call endrun('physics_ptend_sum error: ncol must be less than or equal to psetcols')
end if
-
+
psetcols = ptend_sum%psetcols
-
+
ptend_sum%top_level = ptend%top_level
ptend_sum%bot_level = ptend%bot_level
! Update u,v fields
if(ptend%lu) then
- if (.not. allocated(ptend_sum%u)) then
+ if (.not. allocated(ptend_sum%u)) then
allocate(ptend_sum%u(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%u')
ptend_sum%u=0.0_r8
@@ -730,7 +728,7 @@ subroutine physics_ptend_sum(ptend, ptend_sum, ncol)
end if
if(ptend%lv) then
- if (.not. allocated(ptend_sum%v)) then
+ if (.not. allocated(ptend_sum%v)) then
allocate(ptend_sum%v(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%v')
ptend_sum%v=0.0_r8
@@ -758,7 +756,7 @@ subroutine physics_ptend_sum(ptend, ptend_sum, ncol)
if(ptend%ls) then
- if (.not. allocated(ptend_sum%s)) then
+ if (.not. allocated(ptend_sum%s)) then
allocate(ptend_sum%s(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%s')
ptend_sum%s=0.0_r8
@@ -794,7 +792,7 @@ subroutine physics_ptend_sum(ptend, ptend_sum, ncol)
allocate(ptend_sum%cflx_srf(psetcols,pcnst), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%cflx_srf')
ptend_sum%cflx_srf=0.0_r8
-
+
allocate(ptend_sum%cflx_top(psetcols,pcnst), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_ptend_sum error: allocation error for ptend_sum%cflx_top')
ptend_sum%cflx_top=0.0_r8
@@ -912,7 +910,7 @@ subroutine physics_ptend_copy(ptend, ptend_cp)
ptend_cp%hflux_srf = ptend%hflux_srf
ptend_cp%hflux_top = ptend%hflux_top
end if
-
+
if (ptend_cp%lu) then
ptend_cp%u = ptend%u
ptend_cp%taux_srf = ptend%taux_srf
@@ -988,10 +986,10 @@ subroutine physics_ptend_init(ptend, psetcols, name, ls, lu, lv, lq)
logical, optional :: lu ! if true, then fields to support dudt are allocated
logical, optional :: lv ! if true, then fields to support dvdt are allocated
logical, dimension(pcnst),optional :: lq ! if true, then fields to support dqdt are allocated
-
+
!-----------------------------------------------------------------------
- if (allocated(ptend%s)) then
+ if (allocated(ptend%s)) then
call endrun(' physics_ptend_init: ptend should not be allocated before calling this routine')
end if
@@ -1132,29 +1130,63 @@ subroutine init_geo_unique(phys_state,ncol)
end subroutine init_geo_unique
!===============================================================================
- subroutine physics_dme_adjust(state, tend, qini, dt)
- !-----------------------------------------------------------------------
- !
+ subroutine physics_dme_adjust(state, tend, qini, dt, eflx, ent_tnd, ohf_adjust, ocnfrac, sst, ts)
+
+ use phys_control, only: phys_getopts
+
+ type(physics_state), intent(inout) :: state
+ type(physics_tend ), intent(inout) :: tend
+ real(r8), intent(in ) :: qini(pcols,pver) ! initial specific humidity
+ real(r8), intent(in ) :: dt
+ real(r8), intent(out), optional :: eflx (pcols) ! energy flux for use in check_energy
+ real(r8), intent(out), optional :: ent_tnd(pcols) ! column-integrated enthalpy tendency
+ logical , intent(in) , optional :: ohf_adjust !+tht 03/11/2015
+ real(r8), intent(in) , optional :: ocnfrac(pcols) ! Ocean fraction (fraction)
+ real(r8), intent(in) , optional :: sst (pcols) ! Sea surface temperature
+ real(r8), intent(in) , optional :: ts (pcols) ! Surface temperature
+ logical :: dme_energy_adjust
+
+ call phys_getopts(dme_energy_adjust_out=dme_energy_adjust)
+
+ if (dme_energy_adjust) then
+ if (present(eflx) .and. present(ent_tnd).and. present(ohf_adjust) &
+ .and. present(ocnfrac) .and. present(sst) .and. present(ts)) then
+ call physics_dme_adjust_THT(state, tend, qini, dt, eflx, ent_tnd, ohf_adjust, ocnfrac, sst, ts)
+ else if (present(eflx)) then
+ call physics_dme_adjust_THT(state, tend, qini, dt, eflx)
+ else
+ call physics_dme_adjust_THT(state, tend, qini, dt)
+ endif
+ else
+ call physics_dme_adjust_BAB(state, tend, qini, dt)
+ end if
+
+ end subroutine physics_dme_adjust
+
+!===============================================================================
+ subroutine physics_dme_adjust_BAB(state, tend, qini, dt)
+ !-----------------------------------------------------------------------
+ !
! Purpose: Adjust the dry mass in each layer back to the value of physics input state
- !
+ !
! Method: Conserve the integrated mass, momentum and total energy in each layer
! by scaling the specific mass of consituents, specific momentum (velocity)
! and specific total energy by the relative change in layer mass. Solve for
! the new temperature by subtracting the new kinetic energy from total energy
! and inverting the hydrostatic equation
!
- ! The mass in each layer is modified, changing the relationship of the layer
- ! interfaces and midpoints to the surface pressure. The result is no longer in
- ! the original hybrid coordinate.
+ ! The mass in each layer is modified, changing the relationship of the layer
+ ! interfaces and midpoints to the surface pressure. The result is no longer in
+ ! the original hybrid coordinate.
!
! This procedure cannot be applied to the "eul" or "sld" dycores because they
! require the hybrid coordinate.
- !
+ !
! Author: Byron Boville
! !REVISION HISTORY:
! 03.03.28 Boville Created, partly from code by Lin in p_d_adjust
- !
+ !
!-----------------------------------------------------------------------
use constituents, only : cnst_get_type_byind
@@ -1181,16 +1213,19 @@ subroutine physics_dme_adjust(state, tend, qini, dt)
real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer
- real(r8),allocatable :: cpairv_loc(:,:,:)
+ real(r8),allocatable :: cpairv_loc(:,:)
!
!-----------------------------------------------------------------------
if (state%psetcols .ne. pcols) then
call endrun('physics_dme_adjust: cannot pass in a state which has sub-columns')
end if
- if (adjust_te) then
- call endrun('physics_dme_adjust: must update code based on the "correct" energy before turning on "adjust_te"')
- end if
+!+tht N.B. adjust_te is hard-wired to .false. and has to be because associated code is nonsense.
+! There must be some religious sect at NCAR that demands both the logical and the code to
+! be preserved for no purpose at all (other than demonstrating an ability to write bad code).
+ !if (adjust_te) then
+ ! call endrun('physics_dme_adjust: must update code based on the "correct" energy before turning on "adjust_te"')
+ !end if
lchnk = state%lchnk
ncol = state%ncol
@@ -1208,24 +1243,24 @@ subroutine physics_dme_adjust(state, tend, qini, dt)
state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol)
end do
- if (adjust_te) then
- ! compute specific total energy of unadjusted state (J/kg)
- te(:ncol) = state%s(:ncol,k) + 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2)
-
- ! recompute initial u,v from the new values and the tendencies
- utmp(:ncol) = state%u(:ncol,k) - dt * tend%dudt(:ncol,k)
- vtmp(:ncol) = state%v(:ncol,k) - dt * tend%dvdt(:ncol,k)
- ! adjust specific total energy and specific momentum (velocity) to conserve each
- te (:ncol) = te (:ncol) / fdq(:ncol)
- state%u(:ncol,k) = state%u(:ncol,k ) / fdq(:ncol)
- state%v(:ncol,k) = state%v(:ncol,k ) / fdq(:ncol)
- ! compute adjusted u,v tendencies
- tend%dudt(:ncol,k) = (state%u(:ncol,k) - utmp(:ncol)) / dt
- tend%dvdt(:ncol,k) = (state%v(:ncol,k) - vtmp(:ncol)) / dt
-
- ! compute adjusted static energy
- state%s(:ncol,k) = te(:ncol) - 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2)
- end if
+ !if (adjust_te) then
+ ! ! compute specific total energy of unadjusted state (J/kg)
+ ! te(:ncol) = state%s(:ncol,k) + 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2)
+ !
+ ! ! recompute initial u,v from the new values and the tendencies
+ ! utmp(:ncol) = state%u(:ncol,k) - dt * tend%dudt(:ncol,k)
+ ! vtmp(:ncol) = state%v(:ncol,k) - dt * tend%dvdt(:ncol,k)
+ ! ! adjust specific total energy and specific momentum (velocity) to conserve each
+ ! te (:ncol) = te (:ncol) / fdq(:ncol)
+ ! state%u(:ncol,k) = state%u(:ncol,k ) / fdq(:ncol)
+ ! state%v(:ncol,k) = state%v(:ncol,k ) / fdq(:ncol)
+ ! ! compute adjusted u,v tendencies
+ ! tend%dudt(:ncol,k) = (state%u(:ncol,k) - utmp(:ncol)) / dt
+ ! tend%dvdt(:ncol,k) = (state%v(:ncol,k) - vtmp(:ncol)) / dt
+ !
+ ! ! compute adjusted static energy
+ ! state%s(:ncol,k) = te(:ncol) - 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2)
+ !end if
! compute new total pressure variables
state%pdel (:ncol,k ) = state%pdel(:ncol,k ) * fdq(:ncol)
@@ -1235,45 +1270,399 @@ subroutine physics_dme_adjust(state, tend, qini, dt)
state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k )
end do
- if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
zvirv(:,:) = shr_const_rwv / rairv(:,:,state%lchnk) - 1._r8
else
- zvirv(:,:) = zvir
+ zvirv(:,:) = zvir
endif
! compute new T,z from new s,q,dp
- if (adjust_te) then
-
+ !if (adjust_te) then
+ !
! cpairv_loc needs to be allocated to a size which matches state and ptend
! If psetcols == pcols, cpairv is the correct size and just copy into cpairv_loc
! If psetcols > pcols and all cpairv match cpair, then assign the constant cpair
+ !
+ ! if (state%psetcols == pcols) then
+ ! cpairv_loc(:,:,:) = cpairv(:,:,state%lchnk)
+ ! else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then
+ ! cpairv_loc(:,:) = cpair
+ ! else
+ ! call endrun('physics_dme_adjust: cpairv is not allowed to vary when subcolumns are turned on')
+ ! end if
+ !
+ ! call geopotential_dse(state%lnpint, state%lnpmid, state%pint, &
+ ! state%pmid , state%pdel , state%rpdel, &
+ ! state%s , state%q(:,:,1), state%phis , rairv(:,:,state%lchnk), &
+ ! gravit, cpairv_loc(:,:), zvirv, &
+ ! state%t , state%zi , state%zm , ncol)
+ !
+ ! deallocate(cpairv_loc)
+ !
+ !end if
+
+ end subroutine physics_dme_adjust_BAB
+!-----------------------------------------------------------------------
- if (state%psetcols == pcols) then
- allocate (cpairv_loc(state%psetcols,pver,begchunk:endchunk))
- cpairv_loc(:,:,:) = cpairv(:,:,:)
- else if (state%psetcols > pcols .and. all(cpairv(:,:,:) == cpair)) then
- allocate(cpairv_loc(state%psetcols,pver,begchunk:endchunk))
- cpairv_loc(:,:,:) = cpair
- else
- call endrun('physics_dme_adjust: cpairv is not allowed to vary when subcolumns are turned on')
- end if
+ subroutine physics_dme_adjust_THT(state, tend, qini, dt, eflx, ent_tnd, ohf_adjust, ocnfrac, sst, ts)
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose: Adjust the dry mass in each layer back to the value of physics input state
+ ! Adjust air specific enthalpy accordingly. Diagnose boundart enthalpy flux.
+ !
+ ! Method
+ ! Revised adjustment towards consistency with local energy conservation.
+ ! Hydrostatic pressure work, de = alpha * dp, where alpha is the specific volume
+ ! pressure adjustment, is added locally as an source of enthalpy. An enthalpy of
+ ! mass (water) exchange with the surface is also defined, which should be passed
+ ! to the surface model components (ocean/land/ice etc).
+ ! If moist thermodynamics where handled correctly in CAM, the two terms would
+ ! match, guaranteeing local energy conservation.
+ ! With the present CAM formulation (constant dry heat capacity, constant latent
+ ! heat of condensation valid for 0 degree C), consistency demands one of these
+ ! choices:
+ ! 1. no pressure work and no boundary enthalpy flux (CESM)
+ ! 2. correct local pressure work and boundary enthalpy flux equal to (S dp/g)
+ ! where S=local *dry* static energy of air
+ ! 3. same as 2., but with different specific enthalpy of boundary mass exchange,
+ ! CONDEPS, and a matching heat exchange betweeen air and condensated
+ ! = (S - CONDEPS) dp/g (sign is for a heat source for air).
+ ! Choice 3. is taken here which will allow adaptation once moist thermodynamics
+ ! is introduced in the CAM in some hopeful future. For CONDEPS the following
+ ! choice is made: CONDEPS = cpcond *ocnfrac *SST + cpcond *(1-ocnfrac) *TS
+ ! cpcond is a parameter representing the heat capacity of the condensate phase.
+ ! The boundary enthalpy flux is at present not passed to other model components,
+ ! so it is treated as internal CAM non-conservation and folded into fix_energy.
+ ! Consistently, cpcond is at present set to be =cpair, resulting in a mild
+ ! (stability-dependent) heat source for (dry) air during precipitation.
+ ! An option to return fields valid on the initial hybrid levels is included.
+ !
+ ! Author: Thomas Toniazzo (17.07.21)
+ !
+ !-----------------------------------------------------------------------
- call geopotential_dse(state%lnpint, state%lnpmid, state%pint, &
- state%pmid , state%pdel , state%rpdel, &
- state%s , state%q(:,:,1), state%phis , rairv(:,:,state%lchnk), &
- gravit, cpairv_loc(:,:,state%lchnk), zvirv, &
- state%t , state%zi , state%zm , ncol)
+ use constituents, only : cnst_get_type_byind
+ use ppgrid, only : begchunk, endchunk
+ use hycoef, only : hyai, hybi, ps0, hyam, hybm
- deallocate(cpairv_loc)
+ implicit none
+ !
+ ! Arguments
+ !
+ type(physics_state), intent(inout) :: state
+ type(physics_tend ), intent(inout) :: tend
+ real(r8), intent(in ) :: qini(pcols,pver) ! initial specific humidity
+ real(r8), intent(in ) :: dt ! model physics timestep
+ real(r8), intent(out), optional :: eflx (pcols) ! diagnostic: boundary enthalpy flux
+ real(r8), intent(out), optional :: ent_tnd(pcols) ! diagnostic: column-integrated enthalpy tendency
+ logical , intent(in) , optional :: ohf_adjust ! flag to set temperature of water condensates
+ real(r8), intent(in) , optional :: ocnfrac(pcols) ! Ocean fraction (fraction)
+ real(r8), intent(in) , optional :: sst (pcols) ! Sea surface temperature
+ real(r8), intent(in) , optional :: ts (pcols) ! Surface temperature
+
+ !---------------------------Local workspace-----------------------------
+
+ integer :: lchnk ! chunk identifier
+ integer :: ncol ! number of atmospheric columns
+ integer :: i,k,m ! Longitude, level indices
+ integer :: ierr ! error flag
+ real(r8) :: fdq (pcols) ! mass adjustment factor
+ real(r8) :: fdq_ke(pcols) ! mass adjustment factor to conserve momentum or kinetic energy
+
+ real(r8) :: te (pcols) ! total energy in a layer
+ real(r8) :: utmp (pcols) ! temp variable for recalculating the initial u values
+ real(r8) :: vtmp (pcols) ! temp variable for recalculating the initial v values
+
+ real(r8) :: zvirv(pcols,pver) ! Local zvir array pointer
+
+ real(r8) :: ps_old(pcols) ! old surface pressure
+ real(r8) :: pdel_new(pcols) ! Layer thickness (pint(k+1) - pint(k))
+ real(r8) :: mdq(pcols,pver) ! mass adjustment
+
+ real(r8) :: pdot (pcols) ! total (lagrangian) pressure adjustment
+ real(r8) :: edot (pcols) ! advective pressure adjustment
+
+ real(r8) :: condeps(pcols) ! specific enthalpy of moist reservoir with which q is exchanged
+ real(r8) :: htx (pcols) ! heat exchange with condensates
+
+ real(r8) :: qf(pcols,pcnst), qtmp(pcols,pcnst), uf(pcols), vf(pcols) ! work arrays
+
+ logical,parameter :: hybrid_coord=.false. ! Flag for hybrid (=T) or lagrangian (=F) coord
+
+!+tht 17.11.2015 option to use virtual temperature for T update
+ logical, parameter :: l_virtual = .true. ! convert T to T_v, run adjustment loop, then convert back
+ real(r8) :: tp(pcols,pver) ! work array for T/Tv
+ real(r8) :: rr(pcols) ! dry/moist R
+
+ real(r8), parameter :: Tcond = 291.16_r8 ! 18C= preindustrial global average SST
+!+tht
+! N.B.: RCP=1 -> use T, RCP.ne.1 -> use a virtual (heat) temperature
+ ! OPTION 0
+ ! reference temperature of condensates (=0, cp_wv set to cpair )
+ !real(r8), parameter :: condTr = 0._r8
+ !real(r8), parameter :: cpcond =cpair
+ !real(r8), parameter :: rcp=1._r8
+ real(r8) :: condTr, cpcond, rcp
+ condTr = 0._r8
+ cpcond =cpair
+ rcp=1._r8
+ ! OPTION 1
+ !! reference temperature of condensates (=0, cp_wv set to cp_liq)
+ ! real(r8), parameter :: condTr = 0._r8
+ ! real(r8), parameter :: cpcond =cpliq
+ ! real(r8), parameter :: rcp=cpliq/cpair
+ ! OPTION 2
+ !! reference temperature of condensates (=0, cp_liq set to cp_wv)
+ ! real(r8) :: cpcond, rcp
+ ! real(r8), parameter :: condTr = 0._r8
+ ! cpcond=cpwv
+ ! rcp=cpwv/cpair
+ ! OPTION 3
+ !! reference temperature of condensates (=triple point, according to constant value of L adopted elsewhere)
+ !real(r8) :: rcp
+ !real(r8), parameter :: condTr = 273.16_r8
+ !real(r8), parameter :: cpcond = cpliq
+ ! rcp=cpwv/cpair
+!-tht
+
+ !if (.not. dycore_is('LR') ) return
+
+ if (state%psetcols .ne. pcols) then
+ call endrun('physics_dme_adjust: cannot pass in a state which has sub-columns')
end if
- end subroutine physics_dme_adjust
-!-----------------------------------------------------------------------
+!-------------------- initialise adjustment loop ------------------------------------
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ ! virtual temperature
+ do k = 1, pver
+ tp(:ncol,k) = state%t(:ncol,k) *((1._r8+rcp*qini(:ncol,k))/(1._r8+qini(:ncol,k)))
+ enddo
+
+ ! old surface pressure
+ ps_old (:ncol) = state%ps(:ncol)
+
+ state%ps(:ncol) = state%pint(:ncol,1)
+ do k = 1, pver
+ ! specific enthalpy before adjustment
+ state%s(:ncol,k)= tp(:ncol,k)*cpairv(:ncol,k,lchnk) &
+ +0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2)
+ ! Dp'/Dp
+ mdq (:ncol,k)= state%q(:ncol,k,1) - qini(:ncol,k) ! only water-vapor mass change considered
+ ! new surface pressure
+ state%ps(:ncol) = state%ps(:ncol) + state%pdel(:ncol,k)*(1._r8 + mdq(:ncol,k))
+ end do
+
+ ! lagrangian & advective pressure change at top interface
+ pdot (:ncol) = 0._r8
+ edot (:ncol) = 0._r8
+
+ ! heat exchange with condensates
+ htx (:ncol) = 0._r8 !+tht 07.11.2015
+
+ ! energy change due to mass sources
+ if (present(eflx)) eflx(:ncol) = 0._r8
+
+ ! store old enthalpy integral
+ if (present(ent_tnd)) then
+ ent_tnd(:ncol)=0._r8
+ do k=1,pver
+ ent_tnd(:ncol)=ent_tnd-(state%t(:ncol,k)*cpairv(:ncol,k,lchnk) &
+ +0.5_r8*(state%u(:ncol,k)**2+state%v(:ncol,k)**2))*state%pdel(:ncol,k)
+ enddo
+ endif
+
+!------------------- start adjustment loop ------------------------------------------
+ do k = 1, pver
+
+ if (rcp.eq.1._r8) then
+ rr(:ncol) = (1._r8+(zvir+1._r8)*.5_r8*(qini(:ncol,k)+state%q(:ncol,k,1))) &
+ /(1._r8+.5_r8*(qini(:ncol,k)+state%q(:ncol,k,1)))
+ else
+ rr(:ncol) = 1._r8
+ endif
+
+ ! new Dp (=:Dp") for either lagrangian or hybrid-coordinate adjustment
+ if (hybrid_coord) then ! hybrid-level adjustment (Dp".ne.Dp')
+ pdel_new(:ncol) = (hyai(k+1)-hyai(k))*ps0 &
+ +(hybi(k+1)-hybi(k))*state%ps(:ncol)
+ else ! lagrangian adjustment (Dp".eq.Dp')
+ pdel_new(:ncol) = state%pdel(:ncol,k)*(1._r8 + mdq(:ncol,k))
+ endif
+
+ fdq(:ncol) = pdel_new(:ncol)/state%pdel(:ncol,k) ! this is Dp"/Dp
+
+ ! humidity adjustment: remapping flux from previous interface, /Dp"
+ if (hybrid_coord .and. k.gt.1) then
+ do m=1,pcnst
+ qf (:ncol,m) = .5_r8*(state%q(:ncol,k,m)+qtmp(:ncol,m))*edot(:ncol)/pdel_new(:ncol)
+ enddo
+ else
+ do m=1,pcnst
+ qf (:ncol,m) = 0._r8
+ enddo
+ endif
+
+ ! wind adjustment increments
+ if (hybrid_coord .and. k.gt.1) then ! here u,vtmp = u,v(k-1)
+ uf (:ncol) = .5_r8*(state%u(:ncol,k)+utmp(:ncol))*edot(:ncol)/pdel_new(:ncol)
+ vf (:ncol) = .5_r8*(state%v(:ncol,k)+vtmp(:ncol))*edot(:ncol)/pdel_new(:ncol)
+ else
+ uf (:ncol) = 0.
+ vf (:ncol) = 0.
+ endif
+ ! u,vtmp set to pre-physics u,v from the updated values and the tendencies
+ utmp(:ncol) = state%u(:ncol,k) - dt * tend%dudt(:ncol,k)
+ vtmp(:ncol) = state%v(:ncol,k) - dt * tend%dvdt(:ncol,k)
+
+ ! adjust specific enthalpy
+ if (hybrid_coord .and. k.gt.1) then ! remapping flux from previous interface, /Dp"
+ te (:ncol) = .5_r8*(state%s(:ncol,k)+state%s(:ncol,k-1))*edot(:ncol)/pdel_new(:ncol)
+ else
+ te (:ncol) = 0._r8
+ endif
+
+ ! lagrangian pressure change at mid-level
+ pdot(:ncol) = pdot(:ncol) + .5_r8*state%pdel(:ncol,k)*mdq(:ncol,k)
+ ! enthalpy change by hydrost. pressure work in full adjustment
+ te (:ncol) = te(:ncol) + state%s(:ncol,k)/(fdq(:ncol)/(1._r8+mdq(:ncol,k))) & ! te *(Dp'/Dp")
+ + rairv(:ncol,k,lchnk)*rr(:ncol)*state%t(:ncol,k)/state%pmid(:ncol,k) & ! alpha (use Tv)
+ *pdot(:ncol)/fdq(:ncol) & ! *dp*(Dp/Dp")
+ -(.5_r8*(state%zi(:ncol,k+1)+state%zi(:ncol,k))-state%zm(:ncol,k))*gravit & ! probably =0.
+ *mdq(:ncol,k)/fdq(:ncol) ! *dq*(Dp/Dp")
+ ! lagrangian pressure change at next interface
+ pdot(:ncol) = pdot(:ncol) + .5_r8*state%pdel(:ncol,k)*mdq(:ncol,k)
+
+
+ ! specific enthalpy of condensates
+ condeps(:ncol) = cpcond*(state%t(:ncol,k)-condtr)+cpwv*condtr &
+ +0.5_r8*(state%u(:ncol,k)**2+state%v(:ncol,k)**2) +gravit*state%zm(:ncol,k)
+ if (present(ohf_adjust)) then
+ if (ohf_adjust) then
+ if ( present(ocnfrac) .and. present(sst) .and. present(ts) ) then
+ condeps(:ncol) = ocnfrac(:ncol) *(cpcond*(sst(:ncol)-condtr)+cpwv*condtr) &
+ + (1._r8-ocnfrac(:ncol))*(cpcond*(ts (:ncol)-condtr)+cpwv*condtr)
+ else
+ if ( present(sst) ) then
+ condeps(:ncol) = cpcond*(sst(:ncol)-condtr)+cpwv*condtr
+ else if ( present(ts) ) then
+ condeps(:ncol) = cpcond*(ts (:ncol)-condtr)+cpwv*condtr
+ else ! fixed temperature of all condensates
+ condeps(:ncol) = cpcond*(tcond-condtr)+cpwv *condtr
+ endif
+ endif
+ endif ! if ohf_adjust=F, keep local specific enthalpy
+ endif ! if ohf_adjust not present, treated as F
+
+ ! boundary-flux diagnostic associated with water exchanged (column water-vapour gained/lost)
+ if (present(eflx)) &
+ eflx (:ncol) = eflx(:ncol) + mdq(:ncol,k)/dt*state%pdel(:ncol,k)/gravit *condeps(:ncol)
+
+ ! sensible heat exchange between atm. column and water reservoire
+ if (present(ohf_adjust)) then
+ if (ohf_adjust) then
+ ! the heat here is exchanged in the column between the local level and the surface,
+ ! i.e. over indices j with (k.le.j.le.pver)
+ htx (:ncol) = htx(:ncol) + &
+ pdel_new(:ncol)/(state%ps(:ncol)-state%pint(:ncol,k)) &
+ * mdq(:ncol,k)/fdq(:ncol) &
+ *(condeps(:ncol)-(state%s(:ncol,k)+gravit*state%zm(:ncol,k)))
+ ! local heating would be just:
+ !htx (:ncol) = mdq(:ncol,k)/fdq(:ncol) &
+ ! *(condeps(:ncol)-(state%s(:ncol,k)+gravit*state%zm(:ncol,k)))
+ te (:ncol) = te(:ncol) + htx(:ncol)
+ endif ! nothing to be done if OHF_ADJUST either .false. ...
+ endif ! ... or not present
+
+ if (hybrid_coord .and. k.lt.pver) then ! remapping flux from next interface, /Dp"
+ edot(:ncol) = pdot(:ncol) - hybi(k+1)*(state%ps(:ncol)-ps_old(:ncol))
+ te (:ncol) = te(:ncol) - .5_r8*(state%s(:ncol,k)+state%s(:ncol,k+1))*edot(:ncol)/pdel_new(:ncol)
+ endif
+
+ if (hybrid_coord .and. k.lt.pver) then ! remapping flux from next interface, /Dp"
+ do m=1,pcnst
+ qf (:ncol,m) = qf(:ncol,m) &
+ - .5_r8*(state%q(:ncol,k,m)+state%q(:ncol,k+1,m))*edot(:ncol)/pdel_new(:ncol)
+ enddo
+ uf (:ncol) = uf(:ncol) - .5_r8*(state%u(:ncol,k)+state%u(:ncol,k+1))*edot(:ncol)/pdel_new(:ncol)
+ vf (:ncol) = vf(:ncol) - .5_r8*(state%v(:ncol,k)+state%v(:ncol,k+1))*edot(:ncol)/pdel_new(:ncol)
+ endif
+
+ ! adjust constituents to conserve mass in each layer
+ do m = 1, pcnst
+ ! store unadjusted q for use in next k
+ qtmp (:ncol ,m) = state%q(:ncol,k,m)
+ state%q(:ncol,k,m) = state%q(:ncol,k,m) / fdq(:ncol) + qf(:ncol,m)
+ end do
+
+ ! compute adjusted u,v
+ uf(:ncol) = state%u(:ncol,k ) / fdq(:ncol) + uf(:ncol)
+ vf(:ncol) = state%v(:ncol,k ) / fdq(:ncol) + vf(:ncol)
+ ! adjusted u,v tendencies
+ tend%dudt(:ncol,k) = (uf(:ncol) - utmp(:ncol)) / dt
+ tend%dvdt(:ncol,k) = (vf(:ncol) - vtmp(:ncol)) / dt
+ ! store unadjusted u,v for use in next k
+ utmp(:ncol) = state%u(:ncol,k)
+ vtmp(:ncol) = state%v(:ncol,k)
+ ! write adjusted u,v
+ state%u(:ncol,k) = uf(:ncol)
+ state%v(:ncol,k) = vf(:ncol)
+
+ ! compute adjusted temperature
+ tp(:ncol,k) =(te(:ncol) - 0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2)) &
+ /cpairv(:ncol,k,lchnk)
+
+! compute new total pressure variables
+ state%pint (:ncol,k+1) = state%pint(:ncol,k ) + pdel_new(:ncol)
+ state%lnpint(:ncol,k+1) = log(state%pint(:ncol,k+1))
+ state%pdel (:ncol,k ) = pdel_new(:ncol)
+ state%rpdel (:ncol,k ) = 1._r8/ state%pdel(:ncol,k )
+
+ end do
+!------------------- end adjustment loop --------------------------------------------
+
+
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ zvirv(:,:) = shr_const_rwv / rairv(:,:,state%lchnk) - 1._r8
+ else
+ zvirv(:,:) = zvir
+ endif
+
+ ! update T
+ do k = 1, pver
+ state%t(:ncol,k) = tp(:ncol,k) /((1._r8+rcp*state%q(:ncol,k,1))/(1._r8+state%q(:ncol,k,1)))
+ enddo
+
+ ! diagnose total internal enthalpy change: will *not* match EFLX if RCP.ne.1
+ if (present(ent_tnd)) then
+ do k=1,pver
+ ent_tnd(:ncol) = ent_tnd(:ncol) + state%pdel(:ncol,k) &
+ *(state%t(:ncol,k)*cpairv(:ncol,k,lchnk) &
+ +0.5_r8*(state%u(:ncol,k)**2 + state%v(:ncol,k)**2) )
+ enddo
+ ent_tnd(:ncol)=ent_tnd(:ncol)/dt/gravit
+ endif
+ call geopotential_t ( &
+ state%lnpint, state%lnpmid, state%pint , state%pmid , state%pdel , state%rpdel , &
+ state%t , state%q(:,:,1), rairv(:,:,state%lchnk), gravit , zvirv , &
+ state%zi , state%zm , ncol )
+
+ ! update original dry static energy
+ do k = 1, pver
+ state%s(:ncol,k) = state%t(:ncol,k )*cpairv(:ncol,k,lchnk) &
+ + gravit*state%zm(:ncol,k) + state%phis(:ncol)
+ enddo
+
+ ! update dry pressure (OK after set_dry_to_wet was called in tphysac).
+ call set_state_pdry(state)
+
+ end subroutine physics_dme_adjust_THT
!===============================================================================
subroutine physics_state_copy(state_in, state_out)
-
+
use ppgrid, only: pver, pverp
use constituents, only: pcnst
@@ -1294,71 +1683,71 @@ subroutine physics_state_copy(state_in, state_out)
call physics_state_alloc ( state_out, state_in%lchnk, state_in%psetcols)
ncol = state_in%ncol
-
+
state_out%psetcols = state_in%psetcols
state_out%ngrdcol = state_in%ngrdcol
state_out%lchnk = state_in%lchnk
- state_out%ncol = state_in%ncol
- state_out%count = state_in%count
+ state_out%ncol = state_in%ncol
+ state_out%count = state_in%count
do i = 1, ncol
state_out%lat(i) = state_in%lat(i)
state_out%lon(i) = state_in%lon(i)
state_out%ps(i) = state_in%ps(i)
state_out%phis(i) = state_in%phis(i)
- state_out%te_ini(i) = state_in%te_ini(i)
- state_out%te_cur(i) = state_in%te_cur(i)
- state_out%tw_ini(i) = state_in%tw_ini(i)
- state_out%tw_cur(i) = state_in%tw_cur(i)
+ state_out%te_ini(i) = state_in%te_ini(i)
+ state_out%te_cur(i) = state_in%te_cur(i)
+ state_out%tw_ini(i) = state_in%tw_ini(i)
+ state_out%tw_cur(i) = state_in%tw_cur(i)
end do
do k = 1, pver
do i = 1, ncol
- state_out%t(i,k) = state_in%t(i,k)
- state_out%u(i,k) = state_in%u(i,k)
- state_out%v(i,k) = state_in%v(i,k)
- state_out%s(i,k) = state_in%s(i,k)
- state_out%omega(i,k) = state_in%omega(i,k)
- state_out%pmid(i,k) = state_in%pmid(i,k)
- state_out%pdel(i,k) = state_in%pdel(i,k)
- state_out%rpdel(i,k) = state_in%rpdel(i,k)
- state_out%lnpmid(i,k) = state_in%lnpmid(i,k)
- state_out%exner(i,k) = state_in%exner(i,k)
+ state_out%t(i,k) = state_in%t(i,k)
+ state_out%u(i,k) = state_in%u(i,k)
+ state_out%v(i,k) = state_in%v(i,k)
+ state_out%s(i,k) = state_in%s(i,k)
+ state_out%omega(i,k) = state_in%omega(i,k)
+ state_out%pmid(i,k) = state_in%pmid(i,k)
+ state_out%pdel(i,k) = state_in%pdel(i,k)
+ state_out%rpdel(i,k) = state_in%rpdel(i,k)
+ state_out%lnpmid(i,k) = state_in%lnpmid(i,k)
+ state_out%exner(i,k) = state_in%exner(i,k)
state_out%zm(i,k) = state_in%zm(i,k)
end do
end do
do k = 1, pverp
do i = 1, ncol
- state_out%pint(i,k) = state_in%pint(i,k)
- state_out%lnpint(i,k) = state_in%lnpint(i,k)
- state_out%zi(i,k) = state_in% zi(i,k)
+ state_out%pint(i,k) = state_in%pint(i,k)
+ state_out%lnpint(i,k) = state_in%lnpint(i,k)
+ state_out%zi(i,k) = state_in% zi(i,k)
end do
end do
do i = 1, ncol
- state_out%psdry(i) = state_in%psdry(i)
+ state_out%psdry(i) = state_in%psdry(i)
end do
do k = 1, pver
do i = 1, ncol
- state_out%lnpmiddry(i,k) = state_in%lnpmiddry(i,k)
- state_out%pmiddry(i,k) = state_in%pmiddry(i,k)
- state_out%pdeldry(i,k) = state_in%pdeldry(i,k)
- state_out%rpdeldry(i,k) = state_in%rpdeldry(i,k)
+ state_out%lnpmiddry(i,k) = state_in%lnpmiddry(i,k)
+ state_out%pmiddry(i,k) = state_in%pmiddry(i,k)
+ state_out%pdeldry(i,k) = state_in%pdeldry(i,k)
+ state_out%rpdeldry(i,k) = state_in%rpdeldry(i,k)
end do
end do
do k = 1, pverp
do i = 1, ncol
state_out%pintdry(i,k) = state_in%pintdry(i,k)
- state_out%lnpintdry(i,k) = state_in%lnpintdry(i,k)
+ state_out%lnpintdry(i,k) = state_in%lnpintdry(i,k)
end do
end do
do m = 1, pcnst
do k = 1, pver
do i = 1, ncol
- state_out%q(i,k,m) = state_in%q(i,k,m)
+ state_out%q(i,k,m) = state_in%q(i,k,m)
end do
end do
end do
@@ -1367,9 +1756,9 @@ end subroutine physics_state_copy
!===============================================================================
subroutine physics_tend_init(tend)
-
+
implicit none
-
+
!
! Arguments
!
@@ -1389,7 +1778,7 @@ subroutine physics_tend_init(tend)
tend%flx_net = 0._r8
tend%te_tnd = 0._r8
tend%tw_tnd = 0._r8
-
+
end subroutine physics_tend_init
!===============================================================================
@@ -1402,7 +1791,7 @@ subroutine set_state_pdry (state,pdeld_calc)
type(physics_state), intent(inout) :: state
logical, optional, intent(in) :: pdeld_calc ! .true. do calculate pdeld [default]
- ! .false. don't calculate pdeld
+ ! .false. don't calculate pdeld
integer ncol
integer i, k
logical do_pdeld_calc
@@ -1412,7 +1801,7 @@ subroutine set_state_pdry (state,pdeld_calc)
else
do_pdeld_calc = .true.
endif
-
+
ncol = state%ncol
@@ -1434,7 +1823,7 @@ subroutine set_state_pdry (state,pdeld_calc)
state%lnpmiddry(:ncol,:) = log(state%pmiddry(:ncol,:))
state%lnpintdry(:ncol,:) = log(state%pintdry(:ncol,:))
-end subroutine set_state_pdry
+end subroutine set_state_pdry
!===============================================================================
@@ -1445,7 +1834,7 @@ subroutine set_wet_to_dry (state)
type(physics_state), intent(inout) :: state
integer m, ncol
-
+
ncol = state%ncol
do m = 1,pcnst
@@ -1454,7 +1843,7 @@ subroutine set_wet_to_dry (state)
endif
end do
-end subroutine set_wet_to_dry
+end subroutine set_wet_to_dry
!===============================================================================
@@ -1465,7 +1854,7 @@ subroutine set_dry_to_wet (state)
type(physics_state), intent(inout) :: state
integer m, ncol
-
+
ncol = state%ncol
do m = 1,pcnst
@@ -1504,106 +1893,106 @@ subroutine physics_state_alloc(state,lchnk,psetcols)
allocate(state%lat(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lat')
-
+
allocate(state%lon(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lon')
-
+
allocate(state%ps(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ps')
-
+
allocate(state%psdry(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%psdry')
-
+
allocate(state%phis(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%phis')
-
+
allocate(state%ulat(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ulat')
-
+
allocate(state%ulon(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%ulon')
-
+
allocate(state%t(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%t')
-
+
allocate(state%u(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%u')
-
+
allocate(state%v(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%v')
-
+
allocate(state%s(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%s')
-
+
allocate(state%omega(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%omega')
-
+
allocate(state%pmid(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pmid')
-
+
allocate(state%pmiddry(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pmiddry')
-
+
allocate(state%pdel(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pdel')
-
+
allocate(state%pdeldry(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pdeldry')
-
+
allocate(state%rpdel(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%rpdel')
-
+
allocate(state%rpdeldry(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%rpdeldry')
-
+
allocate(state%lnpmid(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpmid')
-
+
allocate(state%lnpmiddry(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpmiddry')
-
+
allocate(state%exner(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%exner')
-
+
allocate(state%zm(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%zm')
-
+
allocate(state%q(psetcols,pver,pcnst), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%q')
-
+
allocate(state%pint(psetcols,pver+1), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pint')
-
+
allocate(state%pintdry(psetcols,pver+1), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%pintdry')
-
+
allocate(state%lnpint(psetcols,pver+1), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpint')
-
+
allocate(state%lnpintdry(psetcols,pver+1), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lnpintdry')
-
+
allocate(state%zi(psetcols,pver+1), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%zi')
-
+
allocate(state%te_ini(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_ini')
-
+
allocate(state%te_cur(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%te_cur')
-
+
allocate(state%tw_ini(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%tw_ini')
-
+
allocate(state%tw_cur(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%tw_cur')
-
+
allocate(state%latmapback(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%latmapback')
-
+
allocate(state%lonmapback(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%lonmapback')
-
+
allocate(state%cid(psetcols), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_alloc error: allocation error for state%cid')
@@ -1630,13 +2019,13 @@ subroutine physics_state_alloc(state,lchnk,psetcols)
state%exner(:,:) = inf
state%zm(:,:) = inf
state%q(:,:,:) = inf
-
+
state%pint(:,:) = inf
state%pintdry(:,:) = inf
state%lnpint(:,:) = inf
state%lnpintdry(:,:) = inf
state%zi(:,:) = inf
-
+
state%te_ini(:) = inf
state%te_cur(:) = inf
state%tw_ini(:) = inf
@@ -1655,103 +2044,103 @@ subroutine physics_state_dealloc(state)
deallocate(state%lat, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lat')
-
+
deallocate(state%lon, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lon')
-
+
deallocate(state%ps, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%ps')
-
+
deallocate(state%psdry, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%psdry')
-
+
deallocate(state%phis, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%phis')
-
+
deallocate(state%ulat, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%ulat')
-
+
deallocate(state%ulon, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%ulon')
-
+
deallocate(state%t, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%t')
-
+
deallocate(state%u, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%u')
-
+
deallocate(state%v, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%v')
-
+
deallocate(state%s, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%s')
-
+
deallocate(state%omega, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%omega')
-
+
deallocate(state%pmid, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pmid')
-
+
deallocate(state%pmiddry, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pmiddry')
-
+
deallocate(state%pdel, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pdel')
-
+
deallocate(state%pdeldry, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pdeldry')
-
+
deallocate(state%rpdel, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%rpdel')
-
+
deallocate(state%rpdeldry, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%rpdeldry')
-
+
deallocate(state%lnpmid, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpmid')
-
+
deallocate(state%lnpmiddry, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpmiddry')
-
+
deallocate(state%exner, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%exner')
-
+
deallocate(state%zm, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%zm')
-
+
deallocate(state%q, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%q')
-
+
deallocate(state%pint, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pint')
-
+
deallocate(state%pintdry, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%pintdry')
-
+
deallocate(state%lnpint, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpint')
-
+
deallocate(state%lnpintdry, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lnpintdry')
-
+
deallocate(state%zi, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%zi')
deallocate(state%te_ini, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_ini')
-
+
deallocate(state%te_cur, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%te_cur')
-
+
deallocate(state%tw_ini, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%tw_ini')
-
+
deallocate(state%tw_cur, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%tw_cur')
-
+
deallocate(state%latmapback, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%latmapback')
-
+
deallocate(state%lonmapback, stat=ierr)
if ( ierr /= 0 ) call endrun('physics_state_dealloc error: deallocation error for state%lonmapback')
@@ -1856,7 +2245,7 @@ subroutine physics_ptend_alloc(ptend,psetcols)
if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%hflux_top')
end if
- if (ptend%lu) then
+ if (ptend%lu) then
allocate(ptend%u(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%u')
@@ -1867,7 +2256,7 @@ subroutine physics_ptend_alloc(ptend,psetcols)
if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%taux_top')
end if
- if (ptend%lv) then
+ if (ptend%lv) then
allocate(ptend%v(psetcols,pver), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%v')
@@ -1878,7 +2267,7 @@ subroutine physics_ptend_alloc(ptend,psetcols)
if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%tauy_top')
end if
- if (any(ptend%lq)) then
+ if (any(ptend%lq)) then
allocate(ptend%q(psetcols,pver,pcnst), stat=ierr)
if ( ierr /= 0 ) call endrun('physics_ptend_alloc error: allocation error for ptend%q')
diff --git a/src/physics/cam/physpkg.F90 b/src/physics/cam/physpkg.F90
index 7982432814..35ef4aa6ba 100644
--- a/src/physics/cam/physpkg.F90
+++ b/src/physics/cam/physpkg.F90
@@ -1303,6 +1303,7 @@ subroutine tphysac (ztodt, cam_in, &
real(r8) :: tmp_cldice(pcols,pver) ! tmp space
real(r8) :: tmp_trac (pcols,pver,pcnst) ! tmp space
real(r8) :: tmp_pdel (pcols,pver) ! tmp space
+ real(r8) :: tmp_t (pcols,pver) !+tht tmp space
real(r8) :: tmp_ps (pcols) ! tmp space
! physics buffer fields for total energy and mass adjustment
@@ -1315,6 +1316,10 @@ subroutine tphysac (ztodt, cam_in, &
real(r8), pointer, dimension(:,:) :: dtcore
real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction
+ !tht: variables for dme_energy_adjust
+ real(r8):: eflx(pcols), dsema(pcols)
+ logical, parameter:: ohf_adjust =.true. ! condensates have surface specific enthalpy
+
!-----------------------------------------------------------------------
lchnk = state%lchnk
ncol = state%ncol
@@ -1565,6 +1570,7 @@ subroutine tphysac (ztodt, cam_in, &
! Scale dry mass and energy (does nothing if dycore is EUL or SLD)
call cnst_get_ind('CLDLIQ', ixcldliq)
call cnst_get_ind('CLDICE', ixcldice)
+ tmp_t (:ncol,:pver) = state%t(:ncol,:pver) !+tht
tmp_q (:ncol,:pver) = state%q(:ncol,:pver,1)
tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq)
tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice)
@@ -1589,7 +1595,11 @@ subroutine tphysac (ztodt, cam_in, &
end if
if (dycore_is('LR')) then
- call physics_dme_adjust(state, tend, qini, ztodt)
+!+tht
+ !call physics_dme_adjust(state, tend, qini, ztodt)
+ call physics_dme_adjust(state, tend, qini, ztodt, eflx, dsema, &
+ ohf_adjust, cam_in%ocnfrac, cam_in%sst, cam_in%ts)
+!-tht
call calc_te_and_aam_budgets(state, 'pAM')
endif
@@ -1609,12 +1619,16 @@ subroutine tphysac (ztodt, cam_in, &
if (cam_in%ocnfrac(i) /= 1._r8) labort = .true.
end do
if (labort) then
- call endrun ('TPHYSAC error: grid contains non-ocean point')
+ call endrun ('TPHYSAC error: in aquaplanet mode, but grid contains non-ocean point')
endif
endif
- call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, &
- qini, cldliqini, cldiceini)
+!+tht
+ !call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, &
+ ! qini, cldliqini, cldiceini)
+ call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_t, tmp_cldliq, tmp_cldice, &
+ qini, cldliqini, cldiceini, eflx, dsema)
+!-tht
call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf )
diff --git a/src/physics/cam/physpkg.F90.beta07 b/src/physics/cam/physpkg.F90.beta07
new file mode 100644
index 0000000000..42828cf8df
--- /dev/null
+++ b/src/physics/cam/physpkg.F90.beta07
@@ -0,0 +1,2351 @@
+module physpkg
+ !-----------------------------------------------------------------------
+ ! Purpose:
+ !
+ ! Provides the interface to CAM physics package
+ !
+ ! Revision history:
+ ! Aug 2005, E. B. Kluzek, Creation of module from physpkg subroutine
+ ! 2005-10-17 B. Eaton Add contents of inti.F90 to phys_init(). Add
+ ! initialization of grid info in phys_state.
+ ! Nov 2010 A. Gettelman Put micro/macro physics into separate routines
+ !-----------------------------------------------------------------------
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use spmd_utils, only: masterproc
+ use physconst, only: latvap, latice, rh2o
+ use physics_types, only: physics_state, physics_tend, physics_state_set_grid, &
+ physics_ptend, physics_tend_init, physics_update, &
+ physics_type_alloc, physics_ptend_dealloc,&
+ physics_state_alloc, physics_state_dealloc, physics_tend_alloc, physics_tend_dealloc
+ use phys_grid, only: get_ncols_p
+ use phys_gmean, only: gmean_mass
+ use ppgrid, only: begchunk, endchunk, pcols, pver, pverp, psubcols
+ use constituents, only: pcnst, cnst_name, cnst_get_ind
+ use camsrfexch, only: cam_out_t, cam_in_t
+
+ use cam_control_mod, only: ideal_phys, adiabatic
+ use phys_control, only: phys_do_flux_avg, phys_getopts, waccmx_is
+ use scamMod, only: single_column, scm_crm_mode
+ use flux_avg, only: flux_avg_init
+ use infnan, only: posinf, assignment(=)
+ use perf_mod
+ use cam_logfile, only: iulog
+ use camsrfexch, only: cam_export
+
+ use modal_aero_calcsize, only: modal_aero_calcsize_init, modal_aero_calcsize_diag, modal_aero_calcsize_reg
+ use modal_aero_wateruptake, only: modal_aero_wateruptake_init, modal_aero_wateruptake_dr, modal_aero_wateruptake_reg
+
+ implicit none
+ private
+ save
+
+ ! Public methods
+ public phys_register ! was initindx - register physics methods
+ public phys_init ! Public initialization method
+ public phys_run1 ! First phase of the public run method
+ public phys_run2 ! Second phase of the public run method
+ public phys_final ! Public finalization method
+
+ ! Private module data
+
+ ! Physics package options
+ character(len=16) :: shallow_scheme
+ character(len=16) :: macrop_scheme
+ character(len=16) :: microp_scheme
+ integer :: cld_macmic_num_steps ! Number of macro/micro substeps
+ logical :: do_clubb_sgs
+ logical :: use_subcol_microp ! if true, use subcolumns in microphysics
+ logical :: state_debug_checks ! Debug physics_state.
+ logical :: clim_modal_aero ! climate controled by prognostic or prescribed modal aerosols
+ logical :: prog_modal_aero ! Prognostic modal aerosols present
+
+ ! Physics buffer index
+ integer :: teout_idx = 0
+
+ integer :: landm_idx = 0
+ integer :: sgh_idx = 0
+ integer :: sgh30_idx = 0
+
+ integer :: qini_idx = 0
+ integer :: cldliqini_idx = 0
+ integer :: cldiceini_idx = 0
+
+ integer :: prec_str_idx = 0
+ integer :: snow_str_idx = 0
+ integer :: prec_sed_idx = 0
+ integer :: snow_sed_idx = 0
+ integer :: prec_pcw_idx = 0
+ integer :: snow_pcw_idx = 0
+ integer :: prec_dp_idx = 0
+ integer :: snow_dp_idx = 0
+ integer :: prec_sh_idx = 0
+ integer :: snow_sh_idx = 0
+ integer :: dlfzm_idx = 0 ! detrained convective cloud water mixing ratio.
+
+!=======================================================================
+contains
+!=======================================================================
+
+ subroutine phys_register
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose: Register constituents and physics buffer fields.
+ !
+ ! Author: CSM Contact: M. Vertenstein, Aug. 1997
+ ! B.A. Boville, Oct 2001
+ ! A. Gettelman, Nov 2010 - put micro/macro physics into separate routines
+ !
+ !-----------------------------------------------------------------------
+ use cam_abortutils, only: endrun
+ use physics_buffer, only: pbuf_init_time
+ use physics_buffer, only: pbuf_add_field, dtype_r8, pbuf_register_subcol
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use spmd_utils, only: masterproc
+ use constituents, only: pcnst, cnst_add, cnst_chk_dim, cnst_name
+
+ use cam_control_mod, only: moist_physics
+ use chemistry, only: chem_register
+ use cloud_fraction, only: cldfrc_register
+ use rk_stratiform, only: rk_stratiform_register
+ use microp_driver, only: microp_driver_register
+ use microp_aero, only: microp_aero_register
+ use macrop_driver, only: macrop_driver_register
+ use clubb_intr, only: clubb_register_cam
+ use conv_water, only: conv_water_register
+ use physconst, only: mwdry, cpair, mwh2o, cpwv
+ use tracers, only: tracers_register
+ use check_energy, only: check_energy_register
+ use carma_intr, only: carma_register
+ use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_register
+ use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_register
+ use ghg_data, only: ghg_data_register
+ use vertical_diffusion, only: vd_register
+ use convect_deep, only: convect_deep_register
+ use convect_shallow, only: convect_shallow_register
+ use radiation, only: radiation_register
+ use co2_cycle, only: co2_register
+ use flux_avg, only: flux_avg_register
+ use iondrag, only: iondrag_register
+ use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_reg
+ use string_utils, only: to_lower
+ use prescribed_ozone, only: prescribed_ozone_register
+ use prescribed_volcaero,only: prescribed_volcaero_register
+ use prescribed_strataero,only: prescribed_strataero_register
+ use prescribed_aero, only: prescribed_aero_register
+ use prescribed_ghg, only: prescribed_ghg_register
+ use sslt_rebin, only: sslt_rebin_register
+ use aoa_tracers, only: aoa_tracers_register
+ use aircraft_emit, only: aircraft_emit_register
+ use cam_diagnostics, only: diag_register
+ use cloud_diagnostics, only: cloud_diagnostics_register
+ use cospsimulator_intr, only: cospsimulator_intr_register
+ use rad_constituents, only: rad_cnst_get_info ! Added to query if it is a modal aero sim or not
+ use subcol, only: subcol_register
+ use subcol_utils, only: is_subcol_on
+ use dyn_comp, only: dyn_register
+ use spcam_drivers, only: spcam_register
+ use offline_driver, only: offline_driver_reg
+
+ !---------------------------Local variables-----------------------------
+ !
+ integer :: m ! loop index
+ integer :: mm ! constituent index
+ integer :: nmodes
+ !-----------------------------------------------------------------------
+
+ ! Get physics options
+ call phys_getopts(shallow_scheme_out = shallow_scheme, &
+ macrop_scheme_out = macrop_scheme, &
+ microp_scheme_out = microp_scheme, &
+ cld_macmic_num_steps_out = cld_macmic_num_steps, &
+ do_clubb_sgs_out = do_clubb_sgs, &
+ use_subcol_microp_out = use_subcol_microp, &
+ state_debug_checks_out = state_debug_checks)
+
+ ! Initialize dyn_time_lvls
+ call pbuf_init_time()
+
+ ! Register the subcol scheme
+ call subcol_register()
+
+ ! Register water vapor.
+ ! ***** N.B. ***** This must be the first call to cnst_add so that
+ ! water vapor is constituent 1.
+ if (moist_physics) then
+ call cnst_add('Q', mwh2o, cpwv, 1.E-12_r8, mm, &
+ longname='Specific humidity', readiv=.true., is_convtran1=.true.)
+ else
+ call cnst_add('Q', mwh2o, cpwv, 0.0_r8, mm, &
+ longname='Specific humidity', readiv=.false., is_convtran1=.true.)
+ end if
+
+ ! Topography file fields.
+ call pbuf_add_field('LANDM', 'global', dtype_r8, (/pcols/), landm_idx)
+ call pbuf_add_field('SGH', 'global', dtype_r8, (/pcols/), sgh_idx)
+ call pbuf_add_field('SGH30', 'global', dtype_r8, (/pcols/), sgh30_idx)
+
+ ! Fields for physics package diagnostics
+ call pbuf_add_field('QINI', 'physpkg', dtype_r8, (/pcols,pver/), qini_idx)
+ call pbuf_add_field('CLDLIQINI', 'physpkg', dtype_r8, (/pcols,pver/), cldliqini_idx)
+ call pbuf_add_field('CLDICEINI', 'physpkg', dtype_r8, (/pcols,pver/), cldiceini_idx)
+
+ ! check energy package
+ call check_energy_register
+
+ ! If using a simple physics option (e.g., held_suarez, adiabatic),
+ ! the normal CAM physics parameterizations are not called.
+ if (moist_physics) then
+
+ ! register fluxes for saving across time
+ if (phys_do_flux_avg()) call flux_avg_register()
+
+ call cldfrc_register()
+
+ ! cloud water
+ if( microp_scheme == 'RK' ) then
+ call rk_stratiform_register()
+ elseif( microp_scheme == 'MG' ) then
+ if (.not. do_clubb_sgs) call macrop_driver_register()
+ call microp_aero_register()
+ call microp_driver_register()
+ end if
+
+ ! Register CLUBB_SGS here
+ if (do_clubb_sgs) call clubb_register_cam()
+
+
+ call pbuf_add_field('PREC_STR', 'physpkg',dtype_r8,(/pcols/),prec_str_idx)
+ call pbuf_add_field('SNOW_STR', 'physpkg',dtype_r8,(/pcols/),snow_str_idx)
+ call pbuf_add_field('PREC_PCW', 'physpkg',dtype_r8,(/pcols/),prec_pcw_idx)
+ call pbuf_add_field('SNOW_PCW', 'physpkg',dtype_r8,(/pcols/),snow_pcw_idx)
+ call pbuf_add_field('PREC_SED', 'physpkg',dtype_r8,(/pcols/),prec_sed_idx)
+ call pbuf_add_field('SNOW_SED', 'physpkg',dtype_r8,(/pcols/),snow_sed_idx)
+ if (is_subcol_on()) then
+ call pbuf_register_subcol('PREC_STR', 'phys_register', prec_str_idx)
+ call pbuf_register_subcol('SNOW_STR', 'phys_register', snow_str_idx)
+ call pbuf_register_subcol('PREC_PCW', 'phys_register', prec_pcw_idx)
+ call pbuf_register_subcol('SNOW_PCW', 'phys_register', snow_pcw_idx)
+ call pbuf_register_subcol('PREC_SED', 'phys_register', prec_sed_idx)
+ call pbuf_register_subcol('SNOW_SED', 'phys_register', snow_sed_idx)
+ end if
+
+ ! Who should add FRACIS?
+ ! -- It does not seem that aero_intr should add it since FRACIS is used in convection
+ ! even if there are no prognostic aerosols ... so do it here for now
+ call pbuf_add_field('FRACIS','physpkg',dtype_r8,(/pcols,pver,pcnst/),m)
+
+ call conv_water_register()
+
+ ! Determine whether its a 'modal' aerosol simulation or not
+ call rad_cnst_get_info(0, nmodes=nmodes)
+ clim_modal_aero = (nmodes > 0)
+
+ if (clim_modal_aero) then
+ call modal_aero_calcsize_reg()
+ call modal_aero_wateruptake_reg()
+ endif
+
+ ! register chemical constituents including aerosols ...
+ call chem_register()
+
+ ! co2 constituents
+ call co2_register()
+
+ ! register data model ozone with pbuf
+ if (cam3_ozone_data_on) then
+ call cam3_ozone_data_register()
+ end if
+ call prescribed_volcaero_register()
+ call prescribed_strataero_register()
+ call prescribed_ozone_register()
+ call prescribed_aero_register()
+ call prescribed_ghg_register()
+ call sslt_rebin_register
+
+ ! CAM3 prescribed aerosols
+ if (cam3_aero_data_on) then
+ call cam3_aero_data_register()
+ end if
+
+ ! register various data model gasses with pbuf
+ call ghg_data_register()
+
+ ! carma microphysics
+ !
+ call carma_register()
+
+ ! Register iondrag variables with pbuf
+ call iondrag_register()
+
+ ! Register ionosphere variables with pbuf if mode set to ionosphere
+ if( waccmx_is('ionosphere') ) then
+ call waccmx_phys_ion_elec_temp_reg()
+ endif
+
+ call aircraft_emit_register()
+
+ ! deep convection
+ call convect_deep_register
+
+ ! shallow convection
+ call convect_shallow_register
+
+
+ call spcam_register
+
+ ! radiation
+ call radiation_register
+ call cloud_diagnostics_register
+
+ ! COSP
+ call cospsimulator_intr_register
+
+ ! vertical diffusion
+ call vd_register()
+ else
+ ! held_suarez/adiabatic physics option should be in simple_physics
+ call endrun('phys_register: moist_physics configuration error')
+ end if
+
+ ! Register diagnostics PBUF
+ call diag_register()
+
+ ! Register age of air tracers
+ call aoa_tracers_register()
+
+ ! Register test tracers
+ call tracers_register()
+
+ call dyn_register()
+
+ ! All tracers registered, check that the dimensions are correct
+ call cnst_chk_dim()
+
+ ! ***NOTE*** No registering constituents after the call to cnst_chk_dim.
+
+ call offline_driver_reg()
+
+ end subroutine phys_register
+
+
+
+ !=======================================================================
+
+ subroutine phys_inidat( cam_out, pbuf2d )
+ use cam_abortutils, only: endrun
+
+ use physics_buffer, only: pbuf_get_index, pbuf_get_field, physics_buffer_desc, pbuf_set_field, dyn_time_lvls
+
+
+ use cam_initfiles, only: initial_file_get_id, topo_file_get_id
+ use cam_grid_support, only: cam_grid_check, cam_grid_id
+ use cam_grid_support, only: cam_grid_get_dim_names
+ use pio, only: file_desc_t
+ use ncdio_atm, only: infld
+ use dycore, only: dycore_is
+ use polar_avg, only: polar_average
+ use short_lived_species, only: initialize_short_lived_species
+ use cam_control_mod, only: aqua_planet
+ use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_inidat
+
+ type(cam_out_t), intent(inout) :: cam_out(begchunk:endchunk)
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+ integer :: lchnk, m, n, i, k, ncol
+ type(file_desc_t), pointer :: fh_ini, fh_topo
+ character(len=8) :: fieldname
+ real(r8), pointer :: tptr(:,:), tptr_2(:,:), tptr3d(:,:,:), tptr3d_2(:,:,:)
+ real(r8), pointer :: qpert(:,:)
+
+ character(len=11) :: subname='phys_inidat' ! subroutine name
+ integer :: tpert_idx, qpert_idx, pblh_idx
+
+ logical :: found=.false., found2=.false.
+ integer :: ierr
+ character(len=8) :: dim1name, dim2name
+ integer :: ixcldice, ixcldliq
+ integer :: grid_id ! grid ID for data mapping
+ nullify(tptr,tptr_2,tptr3d,tptr3d_2)
+
+ fh_ini => initial_file_get_id()
+ fh_topo => topo_file_get_id()
+
+ ! dynamics variables are handled in dyn_init - here we read variables needed for physics
+ ! but not dynamics
+
+ grid_id = cam_grid_id('physgrid')
+ if (.not. cam_grid_check(grid_id)) then
+ call endrun(trim(subname)//': Internal error, no "physgrid" grid')
+ end if
+ call cam_grid_get_dim_names(grid_id, dim1name, dim2name)
+
+ allocate(tptr(1:pcols,begchunk:endchunk))
+
+ if (associated(fh_topo) .and. .not. aqua_planet) then
+ call infld('SGH', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr, found, gridname='physgrid')
+ if(.not. found) call endrun('ERROR: SGH not found on topo file')
+
+ call pbuf_set_field(pbuf2d, sgh_idx, tptr)
+
+ allocate(tptr_2(1:pcols,begchunk:endchunk))
+ call infld('SGH30', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr_2, found, gridname='physgrid')
+ if(found) then
+ call pbuf_set_field(pbuf2d, sgh30_idx, tptr_2)
+ else
+ if (masterproc) write(iulog,*) 'Warning: Error reading SGH30 from topo file.'
+ if (masterproc) write(iulog,*) 'The field SGH30 will be filled using data from SGH.'
+ call pbuf_set_field(pbuf2d, sgh30_idx, tptr)
+ end if
+
+ deallocate(tptr_2)
+
+ call infld('LANDM_COSLAT', fh_topo, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr, found, gridname='physgrid')
+
+ if(.not.found) call endrun(' ERROR: LANDM_COSLAT not found on topo dataset.')
+
+ call pbuf_set_field(pbuf2d, landm_idx, tptr)
+
+ else
+ call pbuf_set_field(pbuf2d, sgh_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, sgh30_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, landm_idx, 0._r8)
+ end if
+
+ call infld('PBLH', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr(:,:), found, gridname='physgrid')
+ if(.not. found) then
+ tptr(:,:) = 0._r8
+ if (masterproc) write(iulog,*) 'PBLH initialized to 0.'
+ end if
+ pblh_idx = pbuf_get_index('pblh')
+
+ call pbuf_set_field(pbuf2d, pblh_idx, tptr)
+
+ call infld('TPERT', fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr(:,:), found, gridname='physgrid')
+ if(.not. found) then
+ tptr(:,:) = 0._r8
+ if (masterproc) write(iulog,*) 'TPERT initialized to 0.'
+ end if
+ tpert_idx = pbuf_get_index( 'tpert')
+ call pbuf_set_field(pbuf2d, tpert_idx, tptr)
+
+ fieldname='QPERT'
+ qpert_idx = pbuf_get_index( 'qpert',ierr)
+ if (qpert_idx > 0) then
+ call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr, found, gridname='physgrid')
+ if(.not. found) then
+ tptr=0_r8
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
+ end if
+
+ allocate(tptr3d_2(pcols,pcnst,begchunk:endchunk))
+ tptr3d_2 = 0_r8
+ tptr3d_2(:,1,:) = tptr(:,:)
+
+ call pbuf_set_field(pbuf2d, qpert_idx, tptr3d_2)
+ deallocate(tptr3d_2)
+ end if
+
+ fieldname='CUSH'
+ m = pbuf_get_index('cush', ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, dim2name, 1, pcols, begchunk, endchunk, &
+ tptr, found, gridname='physgrid')
+ if(.not.found) then
+ if(masterproc) write(iulog,*) trim(fieldname), ' initialized to 1000.'
+ tptr=1000._r8
+ end if
+ do n=1,dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr, start=(/1,n/), kount=(/pcols,1/))
+ end do
+ deallocate(tptr)
+ end if
+
+ do lchnk=begchunk,endchunk
+ cam_out(lchnk)%tbot(:) = posinf
+ end do
+
+ !
+ ! 3-D fields
+ !
+
+ allocate(tptr3d(pcols,pver,begchunk:endchunk))
+
+ fieldname='CLOUD'
+ m = pbuf_get_index('CLD')
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(found) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
+ end if
+
+ fieldname='QCWAT'
+ m = pbuf_get_index(fieldname,ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(.not. found) then
+ call infld('Q',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if (found) then
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized with Q'
+ if(dycore_is('LR')) call polar_average(pver, tptr3d)
+ else
+ call endrun(' '//trim(subname)//' Error: Q must be on Initial File')
+ end if
+ end if
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ end if
+
+ fieldname = 'ICCWAT'
+ m = pbuf_get_index(fieldname, ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(found) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ else
+ call cnst_get_ind('CLDICE', ixcldice)
+ call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(found) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ end if
+ if (masterproc) then
+ if (found) then
+ write(iulog,*) trim(fieldname), ' initialized with CLDICE'
+ else
+ write(iulog,*) trim(fieldname), ' initialized to 0.0'
+ end if
+ end if
+ end if
+ end if
+
+ fieldname = 'LCWAT'
+ m = pbuf_get_index(fieldname,ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(found) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ else
+ allocate(tptr3d_2(pcols,pver,begchunk:endchunk))
+ call cnst_get_ind('CLDICE', ixcldice)
+ call cnst_get_ind('CLDLIQ', ixcldliq)
+ call infld('CLDICE',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ call infld('CLDLIQ',fh_ini,dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d_2, found2, gridname='physgrid')
+ if(found .and. found2) then
+ do lchnk = begchunk, endchunk
+ ncol = get_ncols_p(lchnk)
+ tptr3d(:ncol,:,lchnk)=tptr3d(:ncol,:,lchnk)+tptr3d_2(:ncol,:,lchnk)
+ end do
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE + CLDLIQ'
+ else if (found) then ! Data already loaded in tptr3d
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDICE only'
+ else if (found2) then
+ tptr3d(:,:,:)=tptr3d_2(:,:,:)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized with CLDLIQ only'
+ end if
+
+ if (found .or. found2) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ if(dycore_is('LR')) call polar_average(pver, tptr3d)
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.0'
+ end if
+ deallocate(tptr3d_2)
+ end if
+ end if
+
+ deallocate(tptr3d)
+ allocate(tptr3d(pcols,pver,begchunk:endchunk))
+
+ fieldname = 'TCWAT'
+ m = pbuf_get_index(fieldname,ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(.not.found) then
+ call infld('T', fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(dycore_is('LR')) call polar_average(pver, tptr3d)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized with T'
+ end if
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ end if
+
+ deallocate(tptr3d)
+ allocate(tptr3d(pcols,pverp,begchunk:endchunk))
+
+ fieldname = 'TKE'
+ m = pbuf_get_index( 'tke')
+ call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if (found) then
+ call pbuf_set_field(pbuf2d, m, tptr3d)
+ else
+ call pbuf_set_field(pbuf2d, m, 0.01_r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.01'
+ end if
+
+
+ fieldname = 'KVM'
+ m = pbuf_get_index('kvm')
+ call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if (found) then
+ call pbuf_set_field(pbuf2d, m, tptr3d)
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
+ end if
+
+
+ fieldname = 'KVH'
+ m = pbuf_get_index('kvh')
+ call infld(fieldname, fh_ini, dim1name, 'ilev', dim2name, 1, pcols, 1, pverp, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if (found) then
+ call pbuf_set_field(pbuf2d, m, tptr3d)
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
+ end if
+
+ deallocate(tptr3d)
+ allocate(tptr3d(pcols,pver,begchunk:endchunk))
+
+ fieldname = 'CONCLD'
+ m = pbuf_get_index('CONCLD',ierr)
+ if (m > 0) then
+ call infld(fieldname, fh_ini, dim1name, 'lev', dim2name, 1, pcols, 1, pver, begchunk, endchunk, &
+ tptr3d, found, gridname='physgrid')
+ if(found) then
+ do n = 1, dyn_time_lvls
+ call pbuf_set_field(pbuf2d, m, tptr3d, (/1,1,n/),(/pcols,pver,1/))
+ end do
+ else
+ call pbuf_set_field(pbuf2d, m, 0._r8)
+ if (masterproc) write(iulog,*) trim(fieldname), ' initialized to 0.'
+ end if
+
+ deallocate (tptr3d)
+ end if
+
+ call initialize_short_lived_species(fh_ini, pbuf2d)
+
+ !---------------------------------------------------------------------------------
+ ! If needed, get ion and electron temperature fields from initial condition file
+ !---------------------------------------------------------------------------------
+
+ call waccmx_phys_ion_elec_temp_inidat(fh_ini,pbuf2d)
+
+ end subroutine phys_inidat
+
+
+ subroutine phys_init( phys_state, phys_tend, pbuf2d, cam_out )
+
+ !-----------------------------------------------------------------------
+ !
+ ! Initialization of physics package.
+ !
+ !-----------------------------------------------------------------------
+
+ use physics_buffer, only: physics_buffer_desc, pbuf_initialize, pbuf_get_index
+ use physconst, only: rair, cpair, gravit, stebol, tmelt, &
+ latvap, latice, rh2o, rhoh2o, pstd, zvir, &
+ karman, rhodair, physconst_init
+ use ref_pres, only: pref_edge, pref_mid
+
+ use carma_intr, only: carma_init
+ use cam_control_mod, only: initial_run
+ use check_energy, only: check_energy_init
+ use chemistry, only: chem_init
+ use prescribed_ozone, only: prescribed_ozone_init
+ use prescribed_ghg, only: prescribed_ghg_init
+ use prescribed_aero, only: prescribed_aero_init
+ use aerodep_flx, only: aerodep_flx_init
+ use aircraft_emit, only: aircraft_emit_init
+ use prescribed_volcaero,only: prescribed_volcaero_init
+ use prescribed_strataero,only: prescribed_strataero_init
+ use cloud_fraction, only: cldfrc_init
+ use cldfrc2m, only: cldfrc2m_init
+ use co2_cycle, only: co2_init, co2_transport
+ use convect_deep, only: convect_deep_init
+ use convect_shallow, only: convect_shallow_init
+ use cam_diagnostics, only: diag_init
+ use gw_drag, only: gw_init
+ use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_init
+ use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_init
+ use radheat, only: radheat_init
+ use radiation, only: radiation_init
+ use cloud_diagnostics, only: cloud_diagnostics_init
+ use rk_stratiform, only: rk_stratiform_init
+ use wv_saturation, only: wv_sat_init
+ use microp_driver, only: microp_driver_init
+ use microp_aero, only: microp_aero_init
+ use macrop_driver, only: macrop_driver_init
+ use conv_water, only: conv_water_init
+ use spcam_drivers, only: spcam_init
+ use tracers, only: tracers_init
+ use aoa_tracers, only: aoa_tracers_init
+ use rayleigh_friction, only: rayleigh_friction_init
+ use pbl_utils, only: pbl_utils_init
+ use vertical_diffusion, only: vertical_diffusion_init
+ use phys_debug_util, only: phys_debug_init
+ use phys_debug, only: phys_debug_state_init
+ use rad_constituents, only: rad_cnst_init
+ use aer_rad_props, only: aer_rad_props_init
+ use subcol, only: subcol_init
+ use qbo, only: qbo_init
+ use iondrag, only: iondrag_init, do_waccm_ions
+#if ( defined OFFLINE_DYN )
+ use metdata, only: metdata_phys_init
+#endif
+ use epp_ionization, only: epp_ionization_init, epp_ionization_active
+ use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_init ! Initialization of ionosphere module (WACCM-X)
+ use waccmx_phys_intr, only: waccmx_phys_mspd_init ! Initialization of major species diffusion module (WACCM-X)
+ use clubb_intr, only: clubb_ini_cam
+ use sslt_rebin, only: sslt_rebin_init
+ use tropopause, only: tropopause_init
+ use solar_data, only: solar_data_init
+ use dadadj_cam, only: dadadj_init
+ use cam_abortutils, only: endrun
+
+ ! Input/output arguments
+ type(physics_state), pointer :: phys_state(:)
+ type(physics_tend ), pointer :: phys_tend(:)
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ type(cam_out_t),intent(inout) :: cam_out(begchunk:endchunk)
+
+ ! local variables
+ integer :: lchnk
+ integer :: ierr
+
+ !-----------------------------------------------------------------------
+
+ call physics_type_alloc(phys_state, phys_tend, begchunk, endchunk, pcols)
+
+ do lchnk = begchunk, endchunk
+ call physics_state_set_grid(lchnk, phys_state(lchnk))
+ end do
+
+ !-------------------------------------------------------------------------------------------
+ ! Initialize any variables in physconst which are not temporally and/or spatially constant
+ !-------------------------------------------------------------------------------------------
+ call physconst_init()
+
+ ! Initialize debugging a physics column
+ call phys_debug_init()
+
+ call pbuf_initialize(pbuf2d)
+
+ ! Initialize subcol scheme
+ call subcol_init(pbuf2d)
+
+ ! diag_init makes addfld calls for dynamics fields that are output from
+ ! the physics decomposition
+ call diag_init(pbuf2d)
+
+ call check_energy_init()
+
+ call tracers_init()
+
+ ! age of air tracers
+ call aoa_tracers_init()
+
+ teout_idx = pbuf_get_index( 'TEOUT')
+
+ ! adiabatic or ideal physics should be only used if in simple_physics
+ if (adiabatic .or. ideal_phys) then
+ if (adiabatic) then
+ call endrun('phys_init: adiabatic configuration error')
+ else
+ call endrun('phys_init: ideal_phys configuration error')
+ end if
+ end if
+
+ if (initial_run) then
+ call phys_inidat(cam_out, pbuf2d)
+ end if
+
+ ! wv_saturation is relatively independent of everything else and
+ ! low level, so init it early. Must at least do this before radiation.
+ call wv_sat_init
+
+ ! CAM3 prescribed aerosols
+ if (cam3_aero_data_on) call cam3_aero_data_init(phys_state)
+
+ ! Initialize rad constituents and their properties
+ call rad_cnst_init()
+ call aer_rad_props_init()
+
+ ! initialize carma
+ call carma_init()
+
+ ! solar irradiance data modules
+ call solar_data_init()
+
+ ! Prognostic chemistry.
+ call chem_init(phys_state,pbuf2d)
+
+ ! Prescribed tracers
+ call prescribed_ozone_init()
+ call prescribed_ghg_init()
+ call prescribed_aero_init()
+ call aerodep_flx_init()
+ call aircraft_emit_init()
+ call prescribed_volcaero_init()
+ call prescribed_strataero_init()
+
+ ! co2 cycle
+ if (co2_transport()) then
+ call co2_init()
+ end if
+
+ ! CAM3 prescribed ozone
+ if (cam3_ozone_data_on) call cam3_ozone_data_init(phys_state)
+
+ call gw_init()
+
+ call rayleigh_friction_init()
+
+ call pbl_utils_init(gravit, karman, cpair, rair, zvir)
+ call vertical_diffusion_init(pbuf2d)
+
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ call waccmx_phys_mspd_init ()
+ ! Initialization of ionosphere module if mode set to ionosphere
+ if( waccmx_is('ionosphere') ) then
+ call waccmx_phys_ion_elec_temp_init(pbuf2d)
+ endif
+ endif
+
+ call radiation_init(pbuf2d)
+
+ call cloud_diagnostics_init()
+
+ call radheat_init(pref_mid)
+
+ call convect_shallow_init(pref_edge, pbuf2d)
+
+ call cldfrc_init()
+ call cldfrc2m_init()
+
+ call convect_deep_init(pref_edge)
+
+ if( microp_scheme == 'RK' ) then
+ call rk_stratiform_init()
+ elseif( microp_scheme == 'MG' ) then
+ if (.not. do_clubb_sgs) call macrop_driver_init(pbuf2d)
+ call microp_aero_init()
+ call microp_driver_init(pbuf2d)
+ call conv_water_init
+ elseif( microp_scheme == 'SPCAM_m2005') then
+ call conv_water_init
+ end if
+
+
+ ! initiate CLUBB within CAM
+ if (do_clubb_sgs) call clubb_ini_cam(pbuf2d)
+
+ call spcam_init(pbuf2d)
+
+ call qbo_init
+
+ call iondrag_init(pref_mid)
+ ! Geomagnetic module -- after iondrag_init
+ if (epp_ionization_active) then
+ call epp_ionization_init()
+ endif
+
+#if ( defined OFFLINE_DYN )
+ call metdata_phys_init()
+#endif
+ call sslt_rebin_init()
+ call tropopause_init()
+ call dadadj_init()
+
+ prec_dp_idx = pbuf_get_index('PREC_DP')
+ snow_dp_idx = pbuf_get_index('SNOW_DP')
+ prec_sh_idx = pbuf_get_index('PREC_SH')
+ snow_sh_idx = pbuf_get_index('SNOW_SH')
+
+ dlfzm_idx = pbuf_get_index('DLFZM', ierr)
+
+ call phys_getopts(prog_modal_aero_out=prog_modal_aero)
+
+ if (clim_modal_aero) then
+
+ ! If climate calculations are affected by prescribed modal aerosols, the
+ ! the initialization routine for the dry mode radius calculation is called
+ ! here. For prognostic MAM the initialization is called from
+ ! modal_aero_initialize
+ if (.not. prog_modal_aero) then
+ call modal_aero_calcsize_init(pbuf2d)
+ endif
+
+ call modal_aero_wateruptake_init(pbuf2d)
+
+ end if
+
+ end subroutine phys_init
+
+ !
+ !-----------------------------------------------------------------------
+ !
+
+ subroutine phys_run1(phys_state, ztodt, phys_tend, pbuf2d, cam_in, cam_out)
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! First part of atmospheric physics package before updating of surface models
+ !
+ !-----------------------------------------------------------------------
+ use time_manager, only: get_nstep
+ use cam_diagnostics,only: diag_allocate, diag_physvar_ic
+ use check_energy, only: check_energy_gmean
+ use phys_control, only: phys_getopts
+ use spcam_drivers, only: tphysbc_spcam
+ use spmd_utils, only: mpicom
+ use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_allocate
+#if (defined BFB_CAM_SCAM_IOP )
+ use cam_history, only: outfld
+#endif
+ use cam_abortutils, only: endrun
+#if ( defined OFFLINE_DYN )
+ use metdata, only: get_met_srf1
+#endif
+ !
+ ! Input arguments
+ !
+ real(r8), intent(in) :: ztodt ! physics time step unless nstep=0
+ !
+ ! Input/Output arguments
+ !
+ type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state
+ type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend
+
+ type(physics_buffer_desc), pointer, dimension(:,:) :: pbuf2d
+ type(cam_in_t), dimension(begchunk:endchunk) :: cam_in
+ type(cam_out_t), dimension(begchunk:endchunk) :: cam_out
+ !-----------------------------------------------------------------------
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+ integer :: c ! indices
+ integer :: ncol ! number of columns
+ integer :: nstep ! current timestep number
+ logical :: use_spcam
+ type(physics_buffer_desc), pointer :: phys_buffer_chunk(:)
+
+ call t_startf ('physpkg_st1')
+ nstep = get_nstep()
+
+#if ( defined OFFLINE_DYN )
+ !
+ ! if offline mode set SNOWH and TS for micro-phys
+ !
+ call get_met_srf1( cam_in )
+#endif
+
+ ! The following initialization depends on the import state (cam_in)
+ ! being initialized. This isn't true when cam_init is called, so need
+ ! to postpone this initialization to here.
+ if (nstep == 0 .and. phys_do_flux_avg()) call flux_avg_init(cam_in, pbuf2d)
+
+ ! Compute total energy of input state and previous output state
+ call t_startf ('chk_en_gmean')
+ call check_energy_gmean(phys_state, pbuf2d, ztodt, nstep)
+ call t_stopf ('chk_en_gmean')
+
+ call t_stopf ('physpkg_st1')
+
+ call t_startf ('physpkg_st1')
+
+ call pbuf_allocate(pbuf2d, 'physpkg')
+ call diag_allocate()
+
+ !-----------------------------------------------------------------------
+ ! Advance time information
+ !-----------------------------------------------------------------------
+
+ call phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d)
+
+ call t_stopf ('physpkg_st1')
+
+#ifdef TRACER_CHECK
+ call gmean_mass ('before tphysbc DRY', phys_state)
+#endif
+
+
+ !-----------------------------------------------------------------------
+ ! Tendency physics before flux coupler invocation
+ !-----------------------------------------------------------------------
+ !
+
+#if (defined BFB_CAM_SCAM_IOP )
+ do c=begchunk, endchunk
+ call outfld('Tg',cam_in(c)%ts,pcols ,c )
+ end do
+#endif
+
+ call t_barrierf('sync_bc_physics', mpicom)
+ call t_startf ('bc_physics')
+ call t_adj_detailf(+1)
+
+ call phys_getopts( use_spcam_out = use_spcam)
+
+!$OMP PARALLEL DO PRIVATE (C, phys_buffer_chunk)
+ do c=begchunk, endchunk
+ !
+ ! Output physics terms to IC file
+ !
+ phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c)
+
+ call t_startf ('diag_physvar_ic')
+ call diag_physvar_ic ( c, phys_buffer_chunk, cam_out(c), cam_in(c) )
+ call t_stopf ('diag_physvar_ic')
+
+ if (use_spcam) then
+ call tphysbc_spcam (ztodt, phys_state(c), &
+ phys_tend(c), phys_buffer_chunk, &
+ cam_out(c), cam_in(c) )
+ else
+ call tphysbc (ztodt, phys_state(c), &
+ phys_tend(c), phys_buffer_chunk, &
+ cam_out(c), cam_in(c) )
+ end if
+
+ end do
+
+ call t_adj_detailf(-1)
+ call t_stopf ('bc_physics')
+
+ ! Don't call the rest in CRM mode
+ if(single_column.and.scm_crm_mode) return
+
+#ifdef TRACER_CHECK
+ call gmean_mass ('between DRY', phys_state)
+#endif
+
+ end subroutine phys_run1
+
+ !
+ !-----------------------------------------------------------------------
+ !
+
+ subroutine phys_run2(phys_state, ztodt, phys_tend, pbuf2d, cam_out, &
+ cam_in )
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! Second part of atmospheric physics package after updating of surface models
+ !
+ !-----------------------------------------------------------------------
+ use physics_buffer, only: physics_buffer_desc, pbuf_get_chunk, pbuf_deallocate, pbuf_update_tim_idx
+ use mo_lightning, only: lightning_no_prod
+ use cam_diagnostics, only: diag_deallocate, diag_surf
+ use physconst, only: stebol, latvap
+ use carma_intr, only: carma_accumulate_stats
+ use spmd_utils, only: mpicom
+#if ( defined OFFLINE_DYN )
+ use metdata, only: get_met_srf2
+#endif
+ !
+ ! Input arguments
+ !
+ real(r8), intent(in) :: ztodt ! physics time step unless nstep=0
+ !
+ ! Input/Output arguments
+ !
+ type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state
+ type(physics_tend ), intent(inout), dimension(begchunk:endchunk) :: phys_tend
+ type(physics_buffer_desc),pointer, dimension(:,:) :: pbuf2d
+
+ type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out
+ type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in
+ !
+ !-----------------------------------------------------------------------
+ !---------------------------Local workspace-----------------------------
+ !
+ integer :: c ! chunk index
+ integer :: ncol ! number of columns
+ type(physics_buffer_desc),pointer, dimension(:) :: phys_buffer_chunk
+ !
+ ! If exit condition just return
+ !
+
+ if(single_column.and.scm_crm_mode) return
+
+ !-----------------------------------------------------------------------
+ ! Tendency physics after coupler
+ ! Not necessary at terminal timestep.
+ !-----------------------------------------------------------------------
+ !
+#if ( defined OFFLINE_DYN )
+ !
+ ! if offline mode set SHFLX QFLX TAUX TAUY for vert diffusion
+ !
+ call get_met_srf2( cam_in )
+#endif
+ ! Set lightning production of NO
+ call t_startf ('lightning_no_prod')
+ call lightning_no_prod( phys_state, pbuf2d, cam_in )
+ call t_stopf ('lightning_no_prod')
+
+ call t_barrierf('sync_ac_physics', mpicom)
+ call t_startf ('ac_physics')
+ call t_adj_detailf(+1)
+
+!$OMP PARALLEL DO PRIVATE (C, NCOL, phys_buffer_chunk)
+
+ do c=begchunk,endchunk
+ ncol = get_ncols_p(c)
+ phys_buffer_chunk => pbuf_get_chunk(pbuf2d, c)
+ !
+ ! surface diagnostics for history files
+ !
+ call t_startf('diag_surf')
+ call diag_surf(cam_in(c), cam_out(c), phys_state(c), phys_buffer_chunk)
+ call t_stopf('diag_surf')
+
+ call tphysac(ztodt, cam_in(c), &
+ cam_out(c), &
+ phys_state(c), phys_tend(c), phys_buffer_chunk)
+ end do ! Chunk loop
+
+ call t_adj_detailf(-1)
+ call t_stopf('ac_physics')
+
+#ifdef TRACER_CHECK
+ call gmean_mass ('after tphysac FV:WET)', phys_state)
+#endif
+
+ call t_startf ('carma_accumulate_stats')
+ call carma_accumulate_stats()
+ call t_stopf ('carma_accumulate_stats')
+
+ call t_startf ('physpkg_st2')
+ call pbuf_deallocate(pbuf2d, 'physpkg')
+
+ call pbuf_update_tim_idx()
+ call diag_deallocate()
+ call t_stopf ('physpkg_st2')
+
+ end subroutine phys_run2
+
+ !
+ !-----------------------------------------------------------------------
+ !
+
+ subroutine phys_final( phys_state, phys_tend, pbuf2d )
+ use physics_buffer, only : physics_buffer_desc, pbuf_deallocate
+ use chemistry, only : chem_final
+ use carma_intr, only : carma_final
+ use wv_saturation, only : wv_sat_final
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! Finalization of physics package
+ !
+ !-----------------------------------------------------------------------
+ ! Input/output arguments
+ type(physics_state), pointer :: phys_state(:)
+ type(physics_tend ), pointer :: phys_tend(:)
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ if(associated(pbuf2d)) then
+ call pbuf_deallocate(pbuf2d,'global')
+ deallocate(pbuf2d)
+ end if
+ deallocate(phys_state)
+ deallocate(phys_tend)
+ call chem_final
+ call carma_final
+ call wv_sat_final
+
+ end subroutine phys_final
+
+
+ subroutine tphysac (ztodt, cam_in, &
+ cam_out, state, tend, pbuf)
+ !-----------------------------------------------------------------------
+ !
+ ! Tendency physics after coupling to land, sea, and ice models.
+ !
+ ! Computes the following:
+ !
+ ! o Aerosol Emission at Surface
+ ! o Source-Sink for Advected Tracers
+ ! o Symmetric Turbulence Scheme - Vertical Diffusion
+ ! o Rayleigh Friction
+ ! o Dry Deposition of Aerosol
+ ! o Enforce Charge Neutrality ( Only for WACCM )
+ ! o Gravity Wave Drag
+ ! o QBO Relaxation ( Only for WACCM )
+ ! o Ion Drag ( Only for WACCM )
+ ! o Scale Dry Mass Energy
+ !-----------------------------------------------------------------------
+ use physics_buffer, only: physics_buffer_desc, pbuf_set_field, pbuf_get_index, pbuf_get_field, pbuf_old_tim_idx
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use chemistry, only: chem_is_active, chem_timestep_tend, chem_emissions
+ use cam_diagnostics, only: diag_phys_tend_writeout
+ use gw_drag, only: gw_tend
+ use vertical_diffusion, only: vertical_diffusion_tend
+ use rayleigh_friction, only: rayleigh_friction_tend
+ use constituents, only: cnst_get_ind
+ use physics_types, only: physics_state, physics_tend, physics_ptend, physics_update, &
+ physics_dme_adjust, set_dry_to_wet, physics_state_check
+ use waccmx_phys_intr, only: waccmx_phys_mspd_tend ! WACCM-X major diffusion
+ use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_tend ! WACCM-X
+ use aoa_tracers, only: aoa_tracers_timestep_tend
+ use physconst, only: rhoh2o, latvap,latice
+ use aero_model, only: aero_model_drydep
+ use carma_intr, only: carma_emission_tend, carma_timestep_tend
+ use carma_flags_mod, only: carma_do_aerosol, carma_do_emission
+ use check_energy, only: check_energy_chng
+ use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng
+ use time_manager, only: get_nstep
+ use cam_abortutils, only: endrun
+ use dycore, only: dycore_is
+ use cam_control_mod, only: aqua_planet
+ use mo_gas_phase_chemdr,only: map2chm
+ use clybry_fam, only: clybry_fam_set
+ use charge_neutrality, only: charge_balance
+ use qbo, only: qbo_relax
+ use iondrag, only: iondrag_calc, do_waccm_ions
+ use perf_mod
+ use flux_avg, only: flux_avg_run
+ use unicon_cam, only: unicon_cam_org_diags
+
+ !
+ ! Arguments
+ !
+ real(r8), intent(in) :: ztodt ! Two times model timestep (2 delta-t)
+
+ type(cam_in_t), intent(inout) :: cam_in
+ type(cam_out_t), intent(inout) :: cam_out
+ type(physics_state), intent(inout) :: state
+ type(physics_tend ), intent(inout) :: tend
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+
+ type(check_tracers_data):: tracerint ! tracer mass integrals and cummulative boundary fluxes
+
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+ type(physics_ptend) :: ptend ! indivdual parameterization tendencies
+
+ integer :: nstep ! current timestep number
+ real(r8) :: zero(pcols) ! array of zeros
+
+ integer :: lchnk ! chunk identifier
+ integer :: ncol ! number of atmospheric columns
+ integer i,k,m ! Longitude, level indices
+ integer :: yr, mon, day, tod ! components of a date
+ integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water.
+
+ logical :: labort ! abort flag
+
+ real(r8) tvm(pcols,pver) ! virtual temperature
+ real(r8) prect(pcols) ! total precipitation
+ real(r8) surfric(pcols) ! surface friction velocity
+ real(r8) obklen(pcols) ! Obukhov length
+ real(r8) :: fh2o(pcols) ! h2o flux to balance source from methane chemistry
+ real(r8) :: flx_heat(pcols) ! Heat flux for check_energy_chng.
+ real(r8) :: tmp_q (pcols,pver) ! tmp space
+ real(r8) :: tmp_cldliq(pcols,pver) ! tmp space
+ real(r8) :: tmp_cldice(pcols,pver) ! tmp space
+ real(r8) :: tmp_t (pcols,pver) !tht: tmp space
+
+ ! physics buffer fields for total energy and mass adjustment
+ integer itim_old, ifld
+
+ real(r8), pointer, dimension(:,:) :: cld
+ real(r8), pointer, dimension(:,:) :: qini
+ real(r8), pointer, dimension(:,:) :: cldliqini
+ real(r8), pointer, dimension(:,:) :: cldiceini
+ real(r8), pointer, dimension(:,:) :: dtcore
+ real(r8), pointer, dimension(:,:) :: ast ! relative humidity cloud fraction
+
+ !tht: variables for dme_energy_adjust
+ real(r8):: eflx(pcols), dsema(pcols)
+ logical, parameter:: ohf_adjust =.true. ! condensates have surface specific enthalpy
+
+ !-----------------------------------------------------------------------
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ nstep = get_nstep()
+
+ ! Adjust the surface fluxes to reduce instabilities in near sfc layer
+ if (phys_do_flux_avg()) then
+ call flux_avg_run(state, cam_in, pbuf, nstep, ztodt)
+ endif
+
+ ! Validate the physics state.
+ if (state_debug_checks) &
+ call physics_state_check(state, name="before tphysac")
+
+ call t_startf('tphysac_init')
+ ! Associate pointers with physics buffer fields
+ itim_old = pbuf_old_tim_idx()
+
+
+ ifld = pbuf_get_index('DTCORE')
+ call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+ call pbuf_get_field(pbuf, qini_idx, qini)
+ call pbuf_get_field(pbuf, cldliqini_idx, cldliqini)
+ call pbuf_get_field(pbuf, cldiceini_idx, cldiceini)
+
+ ifld = pbuf_get_index('CLD')
+ call pbuf_get_field(pbuf, ifld, cld, start=(/1,1,itim_old/),kount=(/pcols,pver,1/))
+
+ ifld = pbuf_get_index('AST')
+ call pbuf_get_field(pbuf, ifld, ast, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+ !
+ ! accumulate fluxes into net flux array for spectral dycores
+ ! jrm Include latent heat of fusion for snow
+ !
+ do i=1,ncol
+ tend%flx_net(i) = tend%flx_net(i) + cam_in%shf(i) + (cam_out%precc(i) &
+ + cam_out%precl(i))*latvap*rhoh2o &
+ + (cam_out%precsc(i) + cam_out%precsl(i))*latice*rhoh2o
+ end do
+
+ ! emissions of aerosols and gas-phase chemistry constituents at surface
+ call chem_emissions( state, cam_in )
+
+ if (carma_do_emission) then
+ ! carma emissions
+ call carma_emission_tend (state, ptend, cam_in, ztodt)
+ call physics_update(state, ptend, ztodt, tend)
+ end if
+
+ ! get nstep and zero array for energy checker
+ zero = 0._r8
+ nstep = get_nstep()
+ call check_tracers_init(state, tracerint)
+
+ ! Check if latent heat flux exceeds the total moisture content of the
+ ! lowest model layer, thereby creating negative moisture.
+
+ call qneg4('TPHYSAC ' ,lchnk ,ncol ,ztodt , &
+ state%q(1,pver,1),state%rpdel(1,pver) ,cam_in%shf , &
+ cam_in%lhf , cam_in%cflx )
+
+ call t_stopf('tphysac_init')
+ !===================================================
+ ! Source/sink terms for advected tracers.
+ !===================================================
+ call t_startf('adv_tracer_src_snk')
+ ! Test tracers
+
+ call aoa_tracers_timestep_tend(state, ptend, cam_in%cflx, cam_in%landfrac, ztodt)
+ call physics_update(state, ptend, ztodt, tend)
+ call check_tracers_chng(state, tracerint, "aoa_tracers_timestep_tend", nstep, ztodt, &
+ cam_in%cflx)
+
+ !===================================================
+ ! Chemistry and MAM calculation
+ ! MAM core aerosol conversion process is performed in the below 'chem_timestep_tend'.
+ ! In addition, surface flux of aerosol species other than 'dust' and 'sea salt', and
+ ! elevated emission of aerosol species are treated in 'chem_timestep_tend' before
+ ! Gas chemistry and MAM core aerosol conversion.
+ ! Note that surface flux is not added into the atmosphere, but elevated emission is
+ ! added into the atmosphere as tendency.
+ !===================================================
+ if (chem_is_active()) then
+ call chem_timestep_tend(state, ptend, cam_in, cam_out, ztodt, &
+ pbuf, fh2o=fh2o)
+
+ call physics_update(state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "chem", nstep, ztodt, fh2o, zero, zero, zero)
+ call check_tracers_chng(state, tracerint, "chem_timestep_tend", nstep, ztodt, &
+ cam_in%cflx)
+ end if
+ call t_stopf('adv_tracer_src_snk')
+
+ !===================================================
+ ! Vertical diffusion/pbl calculation
+ ! Call vertical diffusion code (pbl, free atmosphere and molecular)
+ !===================================================
+
+ call t_startf('vertical_diffusion_tend')
+ call vertical_diffusion_tend (ztodt ,state , cam_in, &
+ surfric ,obklen ,ptend ,ast ,pbuf )
+
+ !------------------------------------------
+ ! Call major diffusion for extended model
+ !------------------------------------------
+ if ( waccmx_is('ionosphere') .or. waccmx_is('neutral') ) then
+ call waccmx_phys_mspd_tend (ztodt ,state ,ptend)
+ endif
+
+ call physics_update(state, ptend, ztodt, tend)
+
+ call t_stopf ('vertical_diffusion_tend')
+
+ !===================================================
+ ! Rayleigh friction calculation
+ !===================================================
+ call t_startf('rayleigh_friction')
+ call rayleigh_friction_tend( ztodt, state, ptend)
+ call physics_update(state, ptend, ztodt, tend)
+ call t_stopf('rayleigh_friction')
+
+ if (do_clubb_sgs) then
+ call check_energy_chng(state, tend, "vdiff", nstep, ztodt, zero, zero, zero, zero)
+ else
+ call check_energy_chng(state, tend, "vdiff", nstep, ztodt, cam_in%cflx(:,1), zero, &
+ zero, cam_in%shf)
+ endif
+
+ call check_tracers_chng(state, tracerint, "vdiff", nstep, ztodt, cam_in%cflx)
+
+ ! aerosol dry deposition processes
+ call t_startf('aero_drydep')
+ call aero_model_drydep( state, pbuf, obklen, surfric, cam_in, ztodt, cam_out, ptend )
+ call physics_update(state, ptend, ztodt, tend)
+ call t_stopf('aero_drydep')
+
+ ! CARMA microphysics
+ !
+ ! NOTE: This does both the timestep_tend for CARMA aerosols as well as doing the dry
+ ! deposition for CARMA aerosols. It needs to follow vertical_diffusion_tend, so that
+ ! obklen and surfric have been calculated. It needs to follow aero_model_drydep, so
+ ! that cam_out%xxxdryxxx fields have already been set for CAM aerosols and cam_out
+ ! can be added to for CARMA aerosols.
+ if (carma_do_aerosol) then
+ call t_startf('carma_timestep_tend')
+ call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, obklen=obklen, ustar=surfric)
+ call physics_update(state, ptend, ztodt, tend)
+
+ call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, zero, zero, zero)
+ call t_stopf('carma_timestep_tend')
+ end if
+
+
+ !---------------------------------------------------------------------------------
+ ! ... enforce charge neutrality
+ !---------------------------------------------------------------------------------
+ call charge_balance(state, pbuf)
+
+ !===================================================
+ ! Gravity wave drag
+ !===================================================
+ call t_startf('gw_tend')
+
+ call gw_tend(state, pbuf, ztodt, ptend, cam_in, flx_heat)
+
+ call physics_update(state, ptend, ztodt, tend)
+ ! Check energy integrals
+ call check_energy_chng(state, tend, "gwdrag", nstep, ztodt, zero, &
+ zero, zero, flx_heat)
+ call t_stopf('gw_tend')
+
+ ! QBO relaxation
+ call qbo_relax(state, pbuf, ptend)
+ call physics_update(state, ptend, ztodt, tend)
+ ! Check energy integrals
+ call check_energy_chng(state, tend, "qborelax", nstep, ztodt, zero, zero, zero, zero)
+
+ ! Ion drag calculation
+ call t_startf ( 'iondrag' )
+
+ if ( do_waccm_ions ) then
+ call iondrag_calc( lchnk, ncol, state, ptend, pbuf, ztodt )
+ else
+ call iondrag_calc( lchnk, ncol, state, ptend)
+ endif
+ !----------------------------------------------------------------------------
+ ! Call ionosphere routines for extended model if mode is set to ionosphere
+ !----------------------------------------------------------------------------
+ if( waccmx_is('ionosphere') ) then
+ call waccmx_phys_ion_elec_temp_tend(state, ptend, pbuf, ztodt)
+ endif
+
+ call physics_update(state, ptend, ztodt, tend)
+
+ !---------------------------------------------------------------------------------
+ ! Enforce charge neutrality after O+ change from ionos_tend
+ !---------------------------------------------------------------------------------
+ if( waccmx_is('ionosphere') ) then
+ call charge_balance(state, pbuf)
+ endif
+
+ ! Check energy integrals
+ call check_energy_chng(state, tend, "iondrag", nstep, ztodt, zero, zero, zero, zero)
+
+ call t_stopf ( 'iondrag' )
+
+ !-------------- Energy budget checks vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
+
+ ! Save total energy for global fixer in next timestep (FV and SE dycores)
+ call pbuf_set_field(pbuf, teout_idx, state%te_cur, (/1,itim_old/),(/pcols,1/))
+
+ if (shallow_scheme .eq. 'UNICON') then
+
+ ! ------------------------------------------------------------------------
+ ! Insert the organization-related heterogeneities computed inside the
+ ! UNICON into the tracer arrays here before performing advection.
+ ! This is necessary to prevent any modifications of organization-related
+ ! heterogeneities by non convection-advection process, such as
+ ! dry and wet deposition of aerosols, MAM, etc.
+ ! Again, note that only UNICON and advection schemes are allowed to
+ ! changes to organization at this stage, although we can include the
+ ! effects of other physical processes in future.
+ ! ------------------------------------------------------------------------
+
+ call unicon_cam_org_diags(state, pbuf)
+
+ end if
+ !
+ ! FV: convert dry-type mixing ratios to moist here because physics_dme_adjust
+ ! assumes moist. This is done in p_d_coupling for other dynamics. Bundy, Feb 2004.
+ if ( dycore_is('LR') .or. dycore_is('SE')) call set_dry_to_wet(state) ! Physics had dry, dynamics wants moist
+
+ ! Scale dry mass and energy (does nothing if dycore is EUL or SLD)
+ call cnst_get_ind('CLDLIQ', ixcldliq)
+ call cnst_get_ind('CLDICE', ixcldice)
+
+ tmp_t (:ncol,:pver) = state%t(:ncol,:pver)
+ tmp_q (:ncol,:pver) = state%q(:ncol,:pver,1)
+ tmp_cldliq(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq)
+ tmp_cldice(:ncol,:pver) = state%q(:ncol,:pver,ixcldice)
+
+ !call physics_dme_adjust(state, tend, qini, ztodt)
+ call physics_dme_adjust(state, tend, qini, ztodt, eflx, dsema, &
+ ohf_adjust, cam_in%ocnfrac, cam_in%sst, cam_in%ts) !tht
+
+!!! REMOVE THIS CALL, SINCE ONLY Q IS BEING ADJUSTED. WON'T BALANCE ENERGY. TE IS SAVED BEFORE THIS
+!!! call check_energy_chng(state, tend, "drymass", nstep, ztodt, zero, zero, zero, zero)
+
+ ! store T in buffer for use in computing dynamics T-tendency in next timestep
+ do k = 1,pver
+ dtcore(:ncol,k) = state%t(:ncol,k)
+ end do
+
+ !-------------- Energy budget checks ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+
+ if (aqua_planet) then
+ labort = .false.
+ do i=1,ncol
+ if (cam_in%ocnfrac(i) /= 1._r8) labort = .true.
+ end do
+ if (labort) then
+ call endrun ('TPHYSAC error: grid contains non-ocean point')
+ endif
+ endif
+
+ !call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_cldliq, tmp_cldice, &
+ ! qini, cldliqini, cldiceini)
+ call diag_phys_tend_writeout (state, pbuf, tend, ztodt, tmp_q, tmp_t, tmp_cldliq, tmp_cldice, &
+ qini, cldliqini, cldiceini, eflx, dsema) !tht
+
+ call clybry_fam_set( ncol, lchnk, map2chm, state%q, pbuf )
+
+ end subroutine tphysac
+
+ subroutine tphysbc (ztodt, state, &
+ tend, pbuf, &
+ cam_out, cam_in )
+ !-----------------------------------------------------------------------
+ !
+ ! Purpose:
+ ! Evaluate and apply physical processes that are calculated BEFORE
+ ! coupling to land, sea, and ice models.
+ !
+ ! Processes currently included are:
+ !
+ ! o Resetting Negative Tracers to Positive
+ ! o Global Mean Total Energy Fixer
+ ! o Dry Adjustment
+ ! o Asymmetric Turbulence Scheme : Deep Convection & Shallow Convection
+ ! o Stratiform Macro-Microphysics
+ ! o Wet Scavenging of Aerosol
+ ! o Radiation
+ !
+ ! Method:
+ !
+ ! Each parameterization should be implemented with this sequence of calls:
+ ! 1) Call physics interface
+ ! 2) Check energy
+ ! 3) Call physics_update
+ ! See Interface to Column Physics and Chemistry Packages
+ ! http://www.ccsm.ucar.edu/models/atm-cam/docs/phys-interface/index.html
+ !
+ !-----------------------------------------------------------------------
+
+ use physics_buffer, only: physics_buffer_desc, pbuf_get_field
+ use physics_buffer, only: pbuf_get_index, pbuf_old_tim_idx
+ use physics_buffer, only: col_type_subcol, dyn_time_lvls
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ use dadadj_cam, only: dadadj_tend
+ use rk_stratiform, only: rk_stratiform_tend
+ use microp_driver, only: microp_driver_tend
+ use microp_aero, only: microp_aero_run
+ use macrop_driver, only: macrop_driver_tend
+ use physics_types, only: physics_state, physics_tend, physics_ptend, &
+ physics_update, physics_ptend_init, physics_ptend_sum, &
+ physics_state_check, physics_ptend_scale
+ use cam_diagnostics, only: diag_conv_tend_ini, diag_phys_writeout, diag_conv, diag_export, diag_state_b4_phys_write
+ use cam_history, only: outfld
+ use physconst, only: cpair, latvap
+ use constituents, only: pcnst, qmin, cnst_get_ind
+ use convect_deep, only: convect_deep_tend, convect_deep_tend_2, deep_scheme_does_scav_trans
+ use time_manager, only: is_first_step, get_nstep
+ use convect_shallow, only: convect_shallow_tend
+ use check_energy, only: check_energy_chng, check_energy_fix, check_energy_timestep_init
+ use check_energy, only: check_tracers_data, check_tracers_init, check_tracers_chng
+ use dycore, only: dycore_is
+ use aero_model, only: aero_model_wetdep
+ use carma_intr, only: carma_wetdep_tend, carma_timestep_tend
+ use carma_flags_mod, only: carma_do_detrain, carma_do_cldice, carma_do_cldliq, carma_do_wetdep
+ use radiation, only: radiation_tend
+ use cloud_diagnostics, only: cloud_diagnostics_calc
+ use perf_mod
+ use mo_gas_phase_chemdr,only: map2chm
+ use clybry_fam, only: clybry_fam_adj
+ use clubb_intr, only: clubb_tend_cam
+ use sslt_rebin, only: sslt_rebin_adv
+ use tropopause, only: tropopause_output
+ use cam_abortutils, only: endrun
+ use subcol, only: subcol_gen, subcol_ptend_avg
+ use subcol_utils, only: subcol_ptend_copy, is_subcol_on
+
+ ! Arguments
+
+ real(r8), intent(in) :: ztodt ! 2 delta t (model time increment)
+
+ type(physics_state), intent(inout) :: state
+ type(physics_tend ), intent(inout) :: tend
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ type(cam_out_t), intent(inout) :: cam_out
+ type(cam_in_t), intent(in) :: cam_in
+
+
+ !
+ !---------------------------Local workspace-----------------------------
+ !
+
+ type(physics_ptend) :: ptend ! indivdual parameterization tendencies
+ type(physics_state) :: state_sc ! state for sub-columns
+ type(physics_ptend) :: ptend_sc ! ptend for sub-columns
+ type(physics_ptend) :: ptend_aero ! ptend for microp_aero
+ type(physics_ptend) :: ptend_aero_sc ! ptend for microp_aero on sub-columns
+ type(physics_tend) :: tend_sc ! tend for sub-columns
+
+ integer :: nstep ! current timestep number
+
+ real(r8) :: net_flx(pcols)
+
+ real(r8) :: zdu(pcols,pver) ! detraining mass flux from deep convection
+ real(r8) :: cmfmc(pcols,pverp) ! Convective mass flux--m sub c
+
+ real(r8) cmfcme(pcols,pver) ! cmf condensation - evaporation
+
+ real(r8) dlf(pcols,pver) ! Detraining cld H20 from shallow + deep convections
+ real(r8) dlf2(pcols,pver) ! Detraining cld H20 from shallow convections
+ real(r8) pflx(pcols,pverp) ! Conv rain flux thru out btm of lev
+
+ integer lchnk ! chunk identifier
+ integer ncol ! number of atmospheric columns
+
+ integer :: i ! column indicex
+ integer :: ixcldice, ixcldliq ! constituent indices for cloud liquid and ice water.
+ ! for macro/micro co-substepping
+ integer :: macmic_it ! iteration variables
+ real(r8) :: cld_macmic_ztodt ! modified timestep
+ ! physics buffer fields to compute tendencies for stratiform package
+ integer itim_old, ifld
+ real(r8), pointer, dimension(:,:) :: cld ! cloud fraction
+
+
+ ! physics buffer fields for total energy and mass adjustment
+ real(r8), pointer, dimension(: ) :: teout
+ real(r8), pointer, dimension(:,:) :: qini
+ real(r8), pointer, dimension(:,:) :: cldliqini
+ real(r8), pointer, dimension(:,:) :: cldiceini
+ real(r8), pointer, dimension(:,:) :: dtcore
+
+ real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble
+
+ real(r8), pointer :: dlfzm(:,:) ! ZM detrained convective cloud water mixing ratio.
+
+ ! convective precipitation variables
+ real(r8),pointer :: prec_dp(:) ! total precipitation from ZM convection
+ real(r8),pointer :: snow_dp(:) ! snow from ZM convection
+ real(r8),pointer :: prec_sh(:) ! total precipitation from Hack convection
+ real(r8),pointer :: snow_sh(:) ! snow from Hack convection
+
+ ! carma precipitation variables
+ real(r8) :: prec_sed_carma(pcols) ! total precip from cloud sedimentation (CARMA)
+ real(r8) :: snow_sed_carma(pcols) ! snow from cloud ice sedimentation (CARMA)
+
+ ! stratiform precipitation variables
+ real(r8),pointer :: prec_str(:) ! sfc flux of precip from stratiform (m/s)
+ real(r8),pointer :: snow_str(:) ! sfc flux of snow from stratiform (m/s)
+ real(r8),pointer :: prec_str_sc(:) ! sfc flux of precip from stratiform (m/s) -- for subcolumns
+ real(r8),pointer :: snow_str_sc(:) ! sfc flux of snow from stratiform (m/s) -- for subcolumns
+ real(r8),pointer :: prec_pcw(:) ! total precip from prognostic cloud scheme
+ real(r8),pointer :: snow_pcw(:) ! snow from prognostic cloud scheme
+ real(r8),pointer :: prec_sed(:) ! total precip from cloud sedimentation
+ real(r8),pointer :: snow_sed(:) ! snow from cloud ice sedimentation
+
+ ! Local copies for substepping
+ real(r8) :: prec_pcw_macmic(pcols)
+ real(r8) :: snow_pcw_macmic(pcols)
+ real(r8) :: prec_sed_macmic(pcols)
+ real(r8) :: snow_sed_macmic(pcols)
+
+ ! energy checking variables
+ real(r8) :: zero(pcols) ! array of zeros
+ real(r8) :: zero_sc(pcols*psubcols) ! array of zeros
+ real(r8) :: rliq(pcols) ! vertical integral of liquid not yet in q(ixcldliq)
+ real(r8) :: rice(pcols) ! vertical integral of ice not yet in q(ixcldice)
+ real(r8) :: rliq2(pcols) ! vertical integral of liquid from shallow scheme
+ real(r8) :: det_s (pcols) ! vertical integral of detrained static energy from ice
+ real(r8) :: det_ice(pcols) ! vertical integral of detrained ice
+ real(r8) :: flx_cnd(pcols)
+ real(r8) :: flx_heat(pcols)
+ type(check_tracers_data):: tracerint ! energy integrals and cummulative boundary fluxes
+ real(r8) :: zero_tracers(pcols,pcnst)
+
+ logical :: lq(pcnst)
+ !-----------------------------------------------------------------------
+
+ call t_startf('bc_init')
+
+ zero = 0._r8
+ zero_tracers(:,:) = 0._r8
+ zero_sc(:) = 0._r8
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ nstep = get_nstep()
+
+ ! Associate pointers with physics buffer fields
+ itim_old = pbuf_old_tim_idx()
+ ifld = pbuf_get_index('CLD')
+ call pbuf_get_field(pbuf, ifld, cld, (/1,1,itim_old/),(/pcols,pver,1/))
+
+ call pbuf_get_field(pbuf, teout_idx, teout, (/1,itim_old/), (/pcols,1/))
+
+ call pbuf_get_field(pbuf, qini_idx, qini)
+ call pbuf_get_field(pbuf, cldliqini_idx, cldliqini)
+ call pbuf_get_field(pbuf, cldiceini_idx, cldiceini)
+
+ ifld = pbuf_get_index('DTCORE')
+ call pbuf_get_field(pbuf, ifld, dtcore, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+ ifld = pbuf_get_index('FRACIS')
+ call pbuf_get_field(pbuf, ifld, fracis, start=(/1,1,1/), kount=(/pcols, pver, pcnst/) )
+ fracis (:ncol,:,1:pcnst) = 1._r8
+
+ ! Set physics tendencies to 0
+ tend %dTdt(:ncol,:pver) = 0._r8
+ tend %dudt(:ncol,:pver) = 0._r8
+ tend %dvdt(:ncol,:pver) = 0._r8
+
+ ! Verify state coming from the dynamics
+ if (state_debug_checks) &
+ call physics_state_check(state, name="before tphysbc (dycore?)")
+
+ call clybry_fam_adj( ncol, lchnk, map2chm, state%q, pbuf )
+
+ ! Since clybry_fam_adj operates directly on the tracers, and has no
+ ! physics_update call, re-run qneg3.
+
+ call qneg3('TPHYSBCc',lchnk ,ncol ,pcols ,pver , &
+ 1, pcnst, qmin ,state%q )
+
+ ! Validate output of clybry_fam_adj.
+ if (state_debug_checks) &
+ call physics_state_check(state, name="clybry_fam_adj")
+
+ !
+ ! Dump out "before physics" state
+ !
+ call diag_state_b4_phys_write (state)
+
+ ! compute mass integrals of input tracers state
+ call check_tracers_init(state, tracerint)
+
+ call t_stopf('bc_init')
+
+ !===================================================
+ ! Global mean total energy fixer
+ !===================================================
+ call t_startf('energy_fixer')
+
+ if (dycore_is('LR') .or. dycore_is('SE')) then
+ call check_energy_fix(state, ptend, nstep, flx_heat)
+ call physics_update(state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "chkengyfix", nstep, ztodt, zero, zero, zero, flx_heat)
+ call outfld( 'EFIX', flx_heat , pcols, lchnk )
+ end if
+ ! Save state for convective tendency calculations.
+ call diag_conv_tend_ini(state, pbuf)
+
+ call cnst_get_ind('CLDLIQ', ixcldliq)
+ call cnst_get_ind('CLDICE', ixcldice)
+ qini (:ncol,:pver) = state%q(:ncol,:pver, 1)
+ cldliqini(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq)
+ cldiceini(:ncol,:pver) = state%q(:ncol,:pver,ixcldice)
+
+ call outfld('TEOUT', teout , pcols, lchnk )
+ call outfld('TEINP', state%te_ini, pcols, lchnk )
+ call outfld('TEFIX', state%te_cur, pcols, lchnk )
+
+ ! T tendency due to dynamics
+ if( nstep > dyn_time_lvls-1 ) then
+ dtcore(:ncol,:pver) = (state%t(:ncol,:pver) - dtcore(:ncol,:pver))/ztodt
+ call outfld( 'DTCORE', dtcore, pcols, lchnk )
+ end if
+
+ call t_stopf('energy_fixer')
+ !
+ !===================================================
+ ! Dry adjustment
+ ! This code block is not a good example of interfacing a parameterization
+ !===================================================
+ call t_startf('dry_adjustment')
+
+ call dadadj_tend(ztodt, state, ptend)
+
+ call physics_update(state, ptend, ztodt, tend)
+
+ call t_stopf('dry_adjustment')
+
+ !===================================================
+ ! Moist convection
+ !===================================================
+ call t_startf('moist_convection')
+
+ call t_startf ('convect_deep_tend')
+
+ call convect_deep_tend( &
+ cmfmc, cmfcme, &
+ pflx, zdu, &
+ rliq, rice, &
+ ztodt, &
+ state, ptend, cam_in%landfrac, pbuf)
+
+ call physics_update(state, ptend, ztodt, tend)
+
+ call t_stopf('convect_deep_tend')
+
+ call pbuf_get_field(pbuf, prec_dp_idx, prec_dp )
+ call pbuf_get_field(pbuf, snow_dp_idx, snow_dp )
+ call pbuf_get_field(pbuf, prec_sh_idx, prec_sh )
+ call pbuf_get_field(pbuf, snow_sh_idx, snow_sh )
+ call pbuf_get_field(pbuf, prec_str_idx, prec_str )
+ call pbuf_get_field(pbuf, snow_str_idx, snow_str )
+ call pbuf_get_field(pbuf, prec_sed_idx, prec_sed )
+ call pbuf_get_field(pbuf, snow_sed_idx, snow_sed )
+ call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw )
+ call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw )
+
+ if (use_subcol_microp) then
+ call pbuf_get_field(pbuf, prec_str_idx, prec_str_sc, col_type=col_type_subcol)
+ call pbuf_get_field(pbuf, snow_str_idx, snow_str_sc, col_type=col_type_subcol)
+ end if
+
+ ! Check energy integrals, including "reserved liquid"
+ flx_cnd(:ncol) = prec_dp(:ncol) + rliq(:ncol)
+ snow_dp(:ncol) = snow_dp(:ncol) + rice(:ncol)
+ call check_energy_chng(state, tend, "convect_deep", nstep, ztodt, zero, flx_cnd, snow_dp, zero)
+ snow_dp(:ncol) = snow_dp(:ncol) - rice(:ncol)
+
+ !
+ ! Call Hack (1994) convection scheme to deal with shallow/mid-level convection
+ !
+ call t_startf ('convect_shallow_tend')
+
+ if (dlfzm_idx > 0) then
+ call pbuf_get_field(pbuf, dlfzm_idx, dlfzm)
+ dlf(:ncol,:) = dlfzm(:ncol,:)
+ else
+ dlf(:,:) = 0._r8
+ end if
+
+ call convect_shallow_tend (ztodt , cmfmc, &
+ dlf , dlf2 , rliq , rliq2, &
+ state , ptend , pbuf, cam_in)
+ call t_stopf ('convect_shallow_tend')
+
+ call physics_update(state, ptend, ztodt, tend)
+
+ flx_cnd(:ncol) = prec_sh(:ncol) + rliq2(:ncol)
+ call check_energy_chng(state, tend, "convect_shallow", nstep, ztodt, zero, flx_cnd, snow_sh, zero)
+
+ call check_tracers_chng(state, tracerint, "convect_shallow", nstep, ztodt, zero_tracers)
+
+ call t_stopf('moist_convection')
+
+ ! Rebin the 4-bin version of sea salt into bins for coarse and accumulation
+ ! modes that correspond to the available optics data. This is only necessary
+ ! for CAM-RT. But it's done here so that the microphysics code which is called
+ ! from the stratiform interface has access to the same aerosols as the radiation
+ ! code.
+ call sslt_rebin_adv(pbuf, state)
+
+ !===================================================
+ ! Calculate tendencies from CARMA bin microphysics.
+ !===================================================
+ !
+ ! If CARMA is doing detrainment, then on output, rliq no longer represents water reserved
+ ! for detrainment, but instead represents potential snow fall. The mass and number of the
+ ! snow are stored in the physics buffer and will be incorporated by the MG microphysics.
+ !
+ ! Currently CARMA cloud microphysics is only supported with the MG microphysics.
+ call t_startf('carma_timestep_tend')
+
+ if (carma_do_cldice .or. carma_do_cldliq) then
+ call carma_timestep_tend(state, cam_in, cam_out, ptend, ztodt, pbuf, dlf=dlf, rliq=rliq, &
+ prec_str=prec_str, snow_str=snow_str, prec_sed=prec_sed_carma, snow_sed=snow_sed_carma)
+ call physics_update(state, ptend, ztodt, tend)
+
+ ! Before the detrainment, the reserved condensate is all liquid, but if CARMA is doing
+ ! detrainment, then the reserved condensate is snow.
+ if (carma_do_detrain) then
+ call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str+rliq, snow_str+rliq, zero)
+ else
+ call check_energy_chng(state, tend, "carma_tend", nstep, ztodt, zero, prec_str, snow_str, zero)
+ end if
+ end if
+
+ call t_stopf('carma_timestep_tend')
+
+ if( microp_scheme == 'RK' ) then
+
+ !===================================================
+ ! Calculate stratiform tendency (sedimentation, detrain, cloud fraction and microphysics )
+ !===================================================
+ call t_startf('rk_stratiform_tend')
+
+ call rk_stratiform_tend(state, ptend, pbuf, ztodt, &
+ cam_in%icefrac, cam_in%landfrac, cam_in%ocnfrac, &
+ cam_in%snowhland, & ! sediment
+ dlf, dlf2, & ! detrain
+ rliq , & ! check energy after detrain
+ cmfmc, &
+ cam_in%ts, cam_in%sst, zdu)
+
+ call physics_update(state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "cldwat_tend", nstep, ztodt, zero, prec_str, snow_str, zero)
+
+ call t_stopf('rk_stratiform_tend')
+
+ elseif( microp_scheme == 'MG' ) then
+ ! Start co-substepping of macrophysics and microphysics
+ cld_macmic_ztodt = ztodt/cld_macmic_num_steps
+
+ ! Clear precip fields that should accumulate.
+ prec_sed_macmic = 0._r8
+ snow_sed_macmic = 0._r8
+ prec_pcw_macmic = 0._r8
+ snow_pcw_macmic = 0._r8
+
+ do macmic_it = 1, cld_macmic_num_steps
+
+ !===================================================
+ ! Calculate macrophysical tendency (sedimentation, detrain, cloud fraction)
+ !===================================================
+
+ call t_startf('macrop_tend')
+
+ ! don't call Park macrophysics if CLUBB is called
+ if (macrop_scheme .ne. 'CLUBB_SGS') then
+
+ call macrop_driver_tend( &
+ state, ptend, cld_macmic_ztodt, &
+ cam_in%landfrac, cam_in%ocnfrac, cam_in%snowhland, & ! sediment
+ dlf, dlf2, & ! detrain
+ cmfmc, &
+ cam_in%ts, cam_in%sst, zdu, &
+ pbuf, det_s, det_ice)
+
+ ! Since we "added" the reserved liquid back in this routine, we need
+ ! to account for it in the energy checker
+ flx_cnd(:ncol) = -1._r8*rliq(:ncol)
+ flx_heat(:ncol) = det_s(:ncol)
+
+ ! Unfortunately, physics_update does not know what time period
+ ! "tend" is supposed to cover, and therefore can't update it
+ ! with substeps correctly. For now, work around this by scaling
+ ! ptend down by the number of substeps, then applying it for
+ ! the full time (ztodt).
+ call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol)
+ call physics_update(state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "macrop_tend", nstep, ztodt, &
+ zero, flx_cnd(:ncol)/cld_macmic_num_steps, &
+ det_ice(:ncol)/cld_macmic_num_steps, &
+ flx_heat(:ncol)/cld_macmic_num_steps)
+
+ else ! Calculate CLUBB macrophysics
+
+ ! =====================================================
+ ! CLUBB call (PBL, shallow convection, macrophysics)
+ ! =====================================================
+
+ call clubb_tend_cam(state,ptend,pbuf,cld_macmic_ztodt,&
+ cmfmc, cam_in, macmic_it, cld_macmic_num_steps, &
+ dlf, det_s, det_ice)
+
+ ! Since we "added" the reserved liquid back in this routine, we need
+ ! to account for it in the energy checker
+ flx_cnd(:ncol) = -1._r8*rliq(:ncol)
+ flx_heat(:ncol) = cam_in%shf(:ncol) + det_s(:ncol)
+
+ ! Unfortunately, physics_update does not know what time period
+ ! "tend" is supposed to cover, and therefore can't update it
+ ! with substeps correctly. For now, work around this by scaling
+ ! ptend down by the number of substeps, then applying it for
+ ! the full time (ztodt).
+ call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol)
+ ! Update physics tendencies and copy state to state_eq, because that is
+ ! input for microphysics
+ call physics_update(state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "clubb_tend", nstep, ztodt, &
+ cam_in%lhf(:ncol)/latvap/cld_macmic_num_steps, &
+ flx_cnd(:ncol)/cld_macmic_num_steps, &
+ det_ice(:ncol)/cld_macmic_num_steps, &
+ flx_heat(:ncol)/cld_macmic_num_steps)
+
+ endif
+
+ call t_stopf('macrop_tend')
+
+ !===================================================
+ ! Calculate cloud microphysics
+ !===================================================
+
+ if (is_subcol_on()) then
+ ! Allocate sub-column structures.
+ call physics_state_alloc(state_sc, lchnk, psubcols*pcols)
+ call physics_tend_alloc(tend_sc, psubcols*pcols)
+
+ ! Generate sub-columns using the requested scheme
+ call subcol_gen(state, tend, state_sc, tend_sc, pbuf)
+
+ !Initialize check energy for subcolumns
+ call check_energy_timestep_init(state_sc, tend_sc, pbuf, col_type_subcol)
+ end if
+
+ call t_startf('microp_aero_run')
+ call microp_aero_run(state, ptend_aero, cld_macmic_ztodt, pbuf)
+ call t_stopf('microp_aero_run')
+
+ call t_startf('microp_tend')
+
+ if (use_subcol_microp) then
+ call microp_driver_tend(state_sc, ptend_sc, cld_macmic_ztodt, pbuf)
+
+ ! Average the sub-column ptend for use in gridded update - will not contain ptend_aero
+ call subcol_ptend_avg(ptend_sc, state_sc%ngrdcol, lchnk, ptend)
+
+ ! Copy ptend_aero field to one dimensioned by sub-columns before summing with ptend
+ call subcol_ptend_copy(ptend_aero, state_sc, ptend_aero_sc)
+ call physics_ptend_sum(ptend_aero_sc, ptend_sc, state_sc%ncol)
+ call physics_ptend_dealloc(ptend_aero_sc)
+
+ ! Have to scale and apply for full timestep to get tend right
+ ! (see above note for macrophysics).
+ call physics_ptend_scale(ptend_sc, 1._r8/cld_macmic_num_steps, ncol)
+
+ call physics_update (state_sc, ptend_sc, ztodt, tend_sc)
+ call check_energy_chng(state_sc, tend_sc, "microp_tend_subcol", &
+ nstep, ztodt, zero_sc, &
+ prec_str_sc(:state_sc%ncol)/cld_macmic_num_steps, &
+ snow_str_sc(:state_sc%ncol)/cld_macmic_num_steps, zero_sc)
+
+ call physics_state_dealloc(state_sc)
+ call physics_tend_dealloc(tend_sc)
+ call physics_ptend_dealloc(ptend_sc)
+ else
+ call microp_driver_tend(state, ptend, cld_macmic_ztodt, pbuf)
+ end if
+ ! combine aero and micro tendencies for the grid
+ call physics_ptend_sum(ptend_aero, ptend, ncol)
+ call physics_ptend_dealloc(ptend_aero)
+
+ ! Have to scale and apply for full timestep to get tend right
+ ! (see above note for macrophysics).
+ call physics_ptend_scale(ptend, 1._r8/cld_macmic_num_steps, ncol)
+
+ call physics_update (state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "microp_tend", nstep, ztodt, &
+ zero, prec_str(:ncol)/cld_macmic_num_steps, &
+ snow_str(:ncol)/cld_macmic_num_steps, zero)
+
+ call t_stopf('microp_tend')
+ prec_sed_macmic(:ncol) = prec_sed_macmic(:ncol) + prec_sed(:ncol)
+ snow_sed_macmic(:ncol) = snow_sed_macmic(:ncol) + snow_sed(:ncol)
+ prec_pcw_macmic(:ncol) = prec_pcw_macmic(:ncol) + prec_pcw(:ncol)
+ snow_pcw_macmic(:ncol) = snow_pcw_macmic(:ncol) + snow_pcw(:ncol)
+
+ end do ! end substepping over macrophysics/microphysics
+
+ prec_sed(:ncol) = prec_sed_macmic(:ncol)/cld_macmic_num_steps
+ snow_sed(:ncol) = snow_sed_macmic(:ncol)/cld_macmic_num_steps
+ prec_pcw(:ncol) = prec_pcw_macmic(:ncol)/cld_macmic_num_steps
+ snow_pcw(:ncol) = snow_pcw_macmic(:ncol)/cld_macmic_num_steps
+ prec_str(:ncol) = prec_pcw(:ncol) + prec_sed(:ncol)
+ snow_str(:ncol) = snow_pcw(:ncol) + snow_sed(:ncol)
+
+ endif
+
+ ! Add the precipitation from CARMA to the precipitation from stratiform.
+ if (carma_do_cldice .or. carma_do_cldliq) then
+ prec_sed(:ncol) = prec_sed(:ncol) + prec_sed_carma(:ncol)
+ snow_sed(:ncol) = snow_sed(:ncol) + snow_sed_carma(:ncol)
+ end if
+
+ if ( .not. deep_scheme_does_scav_trans() ) then
+
+ ! -------------------------------------------------------------------------------
+ ! 1. Wet Scavenging of Aerosols by Convective and Stratiform Precipitation.
+ ! 2. Convective Transport of Non-Water Aerosol Species.
+ !
+ ! . Aerosol wet chemistry determines scavenging fractions, and transformations
+ ! . Then do convective transport of all trace species except qv,ql,qi.
+ ! . We needed to do the scavenging first to determine the interstitial fraction.
+ ! . When UNICON is used as unified convection, we should still perform
+ ! wet scavenging but not 'convect_deep_tend2'.
+ ! -------------------------------------------------------------------------------
+
+ call t_startf('bc_aerosols')
+ if (clim_modal_aero .and. .not. prog_modal_aero) then
+ call modal_aero_calcsize_diag(state, pbuf)
+ call modal_aero_wateruptake_dr(state, pbuf)
+ endif
+ call aero_model_wetdep( state, ztodt, dlf, cam_out, ptend, pbuf)
+ call physics_update(state, ptend, ztodt, tend)
+
+
+ if (carma_do_wetdep) then
+ ! CARMA wet deposition
+ !
+ ! NOTE: It needs to follow aero_model_wetdep, so that cam_out%xxxwetxxx
+ ! fields have already been set for CAM aerosols and cam_out can be added
+ ! to for CARMA aerosols.
+ call t_startf ('carma_wetdep_tend')
+ call carma_wetdep_tend(state, ptend, ztodt, pbuf, dlf, cam_out)
+ call physics_update(state, ptend, ztodt, tend)
+ call t_stopf ('carma_wetdep_tend')
+ end if
+
+ call t_startf ('convect_deep_tend2')
+ call convect_deep_tend_2( state, ptend, ztodt, pbuf )
+ call physics_update(state, ptend, ztodt, tend)
+ call t_stopf ('convect_deep_tend2')
+
+ ! check tracer integrals
+ call check_tracers_chng(state, tracerint, "cmfmca", nstep, ztodt, zero_tracers)
+
+ call t_stopf('bc_aerosols')
+
+ endif
+
+ !===================================================
+ ! Moist physical parameteriztions complete:
+ ! send dynamical variables, and derived variables to history file
+ !===================================================
+
+ call t_startf('bc_history_write')
+ call diag_phys_writeout(state, cam_out%psl)
+ call diag_conv(state, ztodt, pbuf)
+
+ call t_stopf('bc_history_write')
+
+ !===================================================
+ ! Write cloud diagnostics on history file
+ !===================================================
+
+ call t_startf('bc_cld_diag_history_write')
+
+ call cloud_diagnostics_calc(state, pbuf)
+
+ call t_stopf('bc_cld_diag_history_write')
+
+ !===================================================
+ ! Radiation computations
+ !===================================================
+ call t_startf('radiation')
+
+
+ call radiation_tend( &
+ state, ptend, pbuf, cam_out, cam_in, net_flx)
+
+ ! Set net flux used by spectral dycores
+ do i=1,ncol
+ tend%flx_net(i) = net_flx(i)
+ end do
+ call physics_update(state, ptend, ztodt, tend)
+ call check_energy_chng(state, tend, "radheat", nstep, ztodt, zero, zero, zero, net_flx)
+
+ call t_stopf('radiation')
+
+ ! Diagnose the location of the tropopause and its location to the history file(s).
+ call t_startf('tropopause')
+ call tropopause_output(state)
+ call t_stopf('tropopause')
+
+ ! Save atmospheric fields to force surface models
+ call t_startf('cam_export')
+ call cam_export (state,cam_out,pbuf)
+ call t_stopf('cam_export')
+
+ ! Write export state to history file
+ call t_startf('diag_export')
+ call diag_export(cam_out)
+ call t_stopf('diag_export')
+
+ end subroutine tphysbc
+
+subroutine phys_timestep_init(phys_state, cam_in, cam_out, pbuf2d)
+!-----------------------------------------------------------------------------------
+!
+! Purpose: The place for parameterizations to call per timestep initializations.
+! Generally this is used to update time interpolated fields from boundary
+! datasets.
+!
+!-----------------------------------------------------------------------------------
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use chemistry, only: chem_timestep_init
+ use chem_surfvals, only: chem_surfvals_set
+ use physics_types, only: physics_state
+ use physics_buffer, only: physics_buffer_desc
+ use carma_intr, only: carma_timestep_init
+ use ghg_data, only: ghg_data_timestep_init
+ use cam3_aero_data, only: cam3_aero_data_on, cam3_aero_data_timestep_init
+ use cam3_ozone_data, only: cam3_ozone_data_on, cam3_ozone_data_timestep_init
+ use aoa_tracers, only: aoa_tracers_timestep_init
+ use vertical_diffusion, only: vertical_diffusion_ts_init
+ use radheat, only: radheat_timestep_init
+ use solar_data, only: solar_data_advance
+ use qbo, only: qbo_timestep_init
+ use iondrag, only: do_waccm_ions, iondrag_timestep_init
+ use perf_mod
+
+ use prescribed_ozone, only: prescribed_ozone_adv
+ use prescribed_ghg, only: prescribed_ghg_adv
+ use prescribed_aero, only: prescribed_aero_adv
+ use aerodep_flx, only: aerodep_flx_adv
+ use aircraft_emit, only: aircraft_emit_adv
+ use prescribed_volcaero, only: prescribed_volcaero_adv
+ use prescribed_strataero,only: prescribed_strataero_adv
+ use mo_apex, only: mo_apex_init
+ use epp_ionization, only: epp_ionization_active
+ use iop_forcing, only: scam_use_iop_srf
+ use waccmx_phys_intr, only: waccmx_phys_ion_elec_temp_stepinit
+
+ implicit none
+
+ type(physics_state), intent(inout), dimension(begchunk:endchunk) :: phys_state
+ type(cam_in_t), intent(inout), dimension(begchunk:endchunk) :: cam_in
+ type(cam_out_t), intent(inout), dimension(begchunk:endchunk) :: cam_out
+
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ !-----------------------------------------------------------------------------
+
+ if (single_column) call scam_use_iop_srf(cam_in)
+
+ ! update geomagnetic coordinates
+ if (epp_ionization_active .or. do_waccm_ions) then
+ call mo_apex_init(phys_state)
+ endif
+
+ ! Chemistry surface values
+ call chem_surfvals_set()
+
+ ! Solar irradiance
+ call solar_data_advance()
+
+ ! Time interpolate for chemistry.
+ call chem_timestep_init(phys_state, pbuf2d)
+
+ ! Prescribed tracers
+ call prescribed_ozone_adv(phys_state, pbuf2d)
+ call prescribed_ghg_adv(phys_state, pbuf2d)
+ call prescribed_aero_adv(phys_state, pbuf2d)
+ call aircraft_emit_adv(phys_state, pbuf2d)
+ call prescribed_volcaero_adv(phys_state, pbuf2d)
+ call prescribed_strataero_adv(phys_state, pbuf2d)
+
+ ! prescribed aerosol deposition fluxes
+ call aerodep_flx_adv(phys_state, pbuf2d, cam_out)
+
+ ! CAM3 prescribed aerosol masses
+ if (cam3_aero_data_on) call cam3_aero_data_timestep_init(pbuf2d, phys_state)
+
+ ! CAM3 prescribed ozone data
+ if (cam3_ozone_data_on) call cam3_ozone_data_timestep_init(pbuf2d, phys_state)
+
+ ! Time interpolate data models of gasses in pbuf2d
+ call ghg_data_timestep_init(pbuf2d, phys_state)
+
+ ! Upper atmosphere radiative processes
+ call radheat_timestep_init(phys_state, pbuf2d)
+
+ ! Time interpolate for vertical diffusion upper boundary condition
+ call vertical_diffusion_ts_init(pbuf2d, phys_state)
+
+ !----------------------------------------------------------------------
+ ! update QBO data for this time step
+ !----------------------------------------------------------------------
+ call qbo_timestep_init
+
+ call iondrag_timestep_init()
+
+ !----------------------------------------------------------------------
+ ! update waccmx Te / Ti module
+ !----------------------------------------------------------------------
+ call waccmx_phys_ion_elec_temp_stepinit()
+
+ call carma_timestep_init()
+
+ ! age of air tracers
+ call aoa_tracers_timestep_init(phys_state)
+
+end subroutine phys_timestep_init
+
+end module physpkg
diff --git a/src/physics/cam/vertical_diffusion.F90.beta07 b/src/physics/cam/vertical_diffusion.F90.beta07
new file mode 100644
index 0000000000..f59f4aedca
--- /dev/null
+++ b/src/physics/cam/vertical_diffusion.F90.beta07
@@ -0,0 +1,1532 @@
+module vertical_diffusion
+
+!----------------------------------------------------------------------------------------------------- !
+! Module to compute vertical diffusion of momentum, moisture, trace constituents !
+! and static energy. Separate modules compute !
+! 1. stresses associated with turbulent flow over orography !
+! ( turbulent mountain stress ) !
+! 2. eddy diffusivities, including nonlocal tranport terms !
+! 3. molecular diffusivities !
+! Lastly, a implicit diffusion solver is called, and tendencies retrieved by !
+! differencing the diffused and initial states. !
+! !
+! Calling sequence: !
+! !
+! vertical_diffusion_init Initializes vertical diffustion constants and modules !
+! init_molec_diff Initializes molecular diffusivity module !
+! init_eddy_diff Initializes eddy diffusivity module (includes PBL) !
+! init_tms Initializes turbulent mountain stress module !
+! init_vdiff Initializes diffusion solver module !
+! vertical_diffusion_ts_init Time step initialization (only used for upper boundary condition) !
+! vertical_diffusion_tend Computes vertical diffusion tendencies !
+! compute_tms Computes turbulent mountain stresses !
+! compute_eddy_diff Computes eddy diffusivities and countergradient terms !
+! compute_vdiff Solves vertical diffusion equations, including molecular diffusivities !
+! !
+!----------------------------------------------------------------------------------------------------- !
+! Some notes on refactoring changes made in 2015, which were not quite finished. !
+! !
+! - eddy_diff_tend should really only have state, pbuf, and cam_in as inputs. The process of !
+! removing these arguments, and referring to pbuf fields instead, is not complete. !
+! !
+! - compute_vdiff was intended to be split up into three components: !
+! !
+! 1. Diffusion of winds and heat ("U", "V", and "S" in the fieldlist object). !
+! !
+! 2. Turbulent diffusion of a single constituent !
+! !
+! 3. Molecular diffusion of a single constituent !
+! !
+! This reorganization would allow the three resulting functions to each use a simpler interface !
+! than the current combined version, and possibly also remove the need to use the fieldlist !
+! object at all. !
+! !
+! - The conditionals controlled by "do_pbl_diags" are somewhat scattered. It might be better to !
+! pull out these diagnostic calculations and outfld calls into separate functions. !
+! !
+!---------------------------Code history-------------------------------------------------------------- !
+! J. Rosinski : Jun. 1992 !
+! J. McCaa : Sep. 2004 !
+! S. Park : Aug. 2006, Dec. 2008. Jan. 2010 !
+!----------------------------------------------------------------------------------------------------- !
+
+use shr_kind_mod, only : r8 => shr_kind_r8, i4=> shr_kind_i4
+use ppgrid, only : pcols, pver, pverp
+use constituents, only : pcnst
+use diffusion_solver, only : vdiff_selector
+use cam_abortutils, only : endrun
+use error_messages, only : handle_errmsg
+use physconst, only : &
+ cpair , & ! Specific heat of dry air
+ gravit , & ! Acceleration due to gravity
+ rair , & ! Gas constant for dry air
+ zvir , & ! rh2o/rair - 1
+ latvap , & ! Latent heat of vaporization
+ latice , & ! Latent heat of fusion
+ karman , & ! von Karman constant
+ mwdry , & ! Molecular weight of dry air
+ avogad ! Avogadro's number
+use cam_history, only : fieldname_len
+use perf_mod
+use cam_logfile, only : iulog
+use ref_pres, only : do_molec_diff, nbot_molec
+use phys_control, only : phys_getopts
+use time_manager, only : is_first_step
+
+implicit none
+private
+save
+
+! ----------------- !
+! Public interfaces !
+! ----------------- !
+
+public vd_readnl
+public vd_register ! Register multi-time-level variables with physics buffer
+public vertical_diffusion_init ! Initialization
+public vertical_diffusion_ts_init ! Time step initialization (only used for upper boundary condition)
+public vertical_diffusion_tend ! Full vertical diffusion routine
+
+! ------------ !
+! Private data !
+! ------------ !
+
+character(len=16) :: eddy_scheme ! Default set in phys_control.F90, use namelist to change
+! 'HB' = Holtslag and Boville (default)
+! 'HBR' = Holtslag and Boville and Rash
+! 'diag_TKE' = Bretherton and Park ( UW Moist Turbulence Scheme )
+logical, parameter :: wstarent = .true. ! Use wstar (.true.) or TKE (.false.) entrainment closure
+! ( when 'diag_TKE' scheme is selected )
+logical :: do_pseudocon_diff = .false. ! If .true., do pseudo-conservative variables diffusion
+
+character(len=16) :: shallow_scheme ! Shallow convection scheme
+
+type(vdiff_selector) :: fieldlist_wet ! Logical switches for moist mixing ratio diffusion
+type(vdiff_selector) :: fieldlist_dry ! Logical switches for dry mixing ratio diffusion
+type(vdiff_selector) :: fieldlist_molec ! Logical switches for molecular diffusion
+integer :: tke_idx, kvh_idx, kvm_idx ! TKE and eddy diffusivity indices for fields in the physics buffer
+integer :: kvt_idx ! Index for kinematic molecular conductivity
+integer :: turbtype_idx, smaw_idx ! Turbulence type and instability functions
+integer :: tauresx_idx, tauresy_idx ! Redisual stress for implicit surface stress
+
+character(len=fieldname_len) :: vdiffnam(pcnst) ! Names of vertical diffusion tendencies
+integer :: ixcldice, ixcldliq ! Constituent indices for cloud liquid and ice water
+integer :: ixnumice, ixnumliq
+
+integer :: pblh_idx, tpert_idx, qpert_idx
+
+! pbuf fields for unicon
+integer :: qtl_flx_idx = -1 ! for use in cloud macrophysics when UNICON is on
+integer :: qti_flx_idx = -1 ! for use in cloud macrophysics when UNICON is on
+
+! pbuf fields for tms
+integer :: ksrftms_idx = -1
+integer :: tautmsx_idx = -1
+integer :: tautmsy_idx = -1
+
+! pbuf fields for blj (Beljaars)
+integer :: dragblj_idx = -1
+integer :: taubljx_idx = -1
+integer :: taubljy_idx = -1
+
+logical :: diff_cnsrv_mass_check ! do mass conservation check
+logical :: do_iss ! switch for implicit turbulent surface stress
+logical :: prog_modal_aero = .false. ! set true if prognostic modal aerosols are present
+integer :: pmam_ncnst = 0 ! number of prognostic modal aerosol constituents
+integer, allocatable :: pmam_cnst_idx(:) ! constituent indices of prognostic modal aerosols
+
+logical :: do_pbl_diags = .false.
+logical :: waccmx_mode = .false.
+
+contains
+
+ ! =============================================================================== !
+ ! !
+ ! =============================================================================== !
+subroutine vd_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use spmd_utils, only: masterproc, masterprocid, mpi_logical, mpicom
+ use shr_log_mod, only: errMsg => shr_log_errMsg
+ use trb_mtn_stress_cam, only: trb_mtn_stress_readnl
+ use beljaars_drag_cam, only: beljaars_drag_readnl
+ use eddy_diff_cam, only: eddy_diff_readnl
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'vd_readnl'
+
+ namelist /vert_diff_nl/ diff_cnsrv_mass_check, do_iss
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'vert_diff_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, vert_diff_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+ end if
+
+ call mpi_bcast(diff_cnsrv_mass_check, 1, mpi_logical, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error")
+ call mpi_bcast(do_iss, 1, mpi_logical, masterprocid, mpicom, ierr)
+ if (ierr /= 0) call endrun(errMsg(__FILE__, __LINE__)//" mpi_bcast error")
+
+ ! Get eddy_scheme setting from phys_control.
+ call phys_getopts( eddy_scheme_out = eddy_scheme, &
+ shallow_scheme_out = shallow_scheme )
+
+ ! TMS reads its own namelist.
+ call trb_mtn_stress_readnl(nlfile)
+
+ ! Beljaars reads its own namelist.
+ call beljaars_drag_readnl(nlfile)
+
+ if (eddy_scheme == 'diag_TKE' .or. eddy_scheme == 'SPCAM_m2005' ) call eddy_diff_readnl(nlfile)
+
+end subroutine vd_readnl
+
+! =============================================================================== !
+! !
+! =============================================================================== !
+
+subroutine vd_register()
+
+ !------------------------------------------------ !
+ ! Register physics buffer fields and constituents !
+ !------------------------------------------------ !
+
+ use physics_buffer, only : pbuf_add_field, dtype_r8, dtype_i4
+ use trb_mtn_stress_cam, only : trb_mtn_stress_register
+ use beljaars_drag_cam, only : beljaars_drag_register
+ use eddy_diff_cam, only : eddy_diff_register
+
+ ! Add fields to physics buffer
+
+ ! kvt is used by gw_drag. only needs physpkg scope.
+ call pbuf_add_field('kvt', 'physpkg', dtype_r8, (/pcols,pverp/), kvt_idx)
+
+
+ call pbuf_add_field('pblh', 'global', dtype_r8, (/pcols/), pblh_idx)
+ call pbuf_add_field('tke', 'global', dtype_r8, (/pcols, pverp/), tke_idx)
+ call pbuf_add_field('kvh', 'global', dtype_r8, (/pcols, pverp/), kvh_idx)
+ call pbuf_add_field('kvm', 'global', dtype_r8, (/pcols, pverp/), kvm_idx )
+ call pbuf_add_field('turbtype', 'global', dtype_i4, (/pcols, pverp/), turbtype_idx)
+ call pbuf_add_field('smaw', 'global', dtype_r8, (/pcols, pverp/), smaw_idx)
+
+ call pbuf_add_field('tauresx', 'global', dtype_r8, (/pcols/), tauresx_idx)
+ call pbuf_add_field('tauresy', 'global', dtype_r8, (/pcols/), tauresy_idx)
+
+ call pbuf_add_field('tpert', 'global', dtype_r8, (/pcols/), tpert_idx)
+ call pbuf_add_field('qpert', 'global', dtype_r8, (/pcols,pcnst/), qpert_idx)
+
+ if (trim(shallow_scheme) == 'UNICON') then
+ call pbuf_add_field('qtl_flx', 'global', dtype_r8, (/pcols, pverp/), qtl_flx_idx)
+ call pbuf_add_field('qti_flx', 'global', dtype_r8, (/pcols, pverp/), qti_flx_idx)
+ end if
+
+ ! diag_TKE fields
+ if (eddy_scheme == 'diag_TKE' .or. eddy_scheme == 'SPCAM_m2005') then
+ call eddy_diff_register()
+ end if
+
+ ! TMS fields
+ call trb_mtn_stress_register()
+
+ ! Beljaars fields
+ call beljaars_drag_register()
+
+end subroutine vd_register
+
+! =============================================================================== !
+! !
+! =============================================================================== !
+
+subroutine vertical_diffusion_init(pbuf2d)
+
+ !------------------------------------------------------------------!
+ ! Initialization of time independent fields for vertical diffusion !
+ ! Calls initialization routines for subsidiary modules !
+ !----------------------------------------------------------------- !
+
+ use cam_history, only : addfld, add_default, horiz_only
+ use cam_history, only : register_vector_field
+ use eddy_diff_cam, only : eddy_diff_init
+ use hb_diff, only : init_hb_diff
+ use molec_diff, only : init_molec_diff
+ use diffusion_solver, only : init_vdiff, new_fieldlist_vdiff, vdiff_select
+ use constituents, only : cnst_get_ind, cnst_get_type_byind, cnst_name, cnst_get_molec_byind
+ use spmd_utils, only : masterproc
+ use ref_pres, only : press_lim_idx, pref_mid
+ use physics_buffer, only : pbuf_set_field, pbuf_get_index, physics_buffer_desc
+ use rad_constituents, only : rad_cnst_get_info, rad_cnst_get_mode_num_idx, &
+ rad_cnst_get_mam_mmr_idx
+ use trb_mtn_stress_cam,only : trb_mtn_stress_init
+ use beljaars_drag_cam, only : beljaars_drag_init
+ use upper_bc, only : ubc_init
+ use phys_control, only : waccmx_is, fv_am_correction
+
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+ character(128) :: errstring ! Error status for init_vdiff
+ integer :: ntop_eddy ! Top interface level to which eddy vertical diffusion is applied ( = 1 )
+ integer :: nbot_eddy ! Bottom interface level to which eddy vertical diffusion is applied ( = pver )
+ integer :: k ! Vertical loop index
+
+ real(r8), parameter :: ntop_eddy_pres = 1.e-5_r8 ! Pressure below which eddy diffusion is not done in WACCM-X. (Pa)
+
+ integer :: im, l, m, nmodes, nspec
+
+ logical :: history_amwg ! output the variables used by the AMWG diag package
+ logical :: history_eddy ! output the eddy variables
+ logical :: history_budget ! Output tendencies and state variables for CAM4 T, qv, ql, qi
+ integer :: history_budget_histfile_num ! output history file number for budget fields
+ logical :: history_waccm ! output variables of interest for WACCM runs
+
+ ! ----------------------------------------------------------------- !
+
+ if (masterproc) then
+ write(iulog,*)'Initializing vertical diffusion (vertical_diffusion_init)'
+ end if
+
+ ! Check to see if WACCM-X is on (currently we don't care whether the
+ ! ionosphere is on or not, since this neutral diffusion code is the
+ ! same either way).
+ waccmx_mode = waccmx_is('ionosphere') .or. waccmx_is('neutral')
+
+ ! ----------------------------------------------------------------- !
+ ! Get indices of cloud liquid and ice within the constituents array !
+ ! ----------------------------------------------------------------- !
+
+ call cnst_get_ind( 'CLDLIQ', ixcldliq )
+ call cnst_get_ind( 'CLDICE', ixcldice )
+ ! These are optional; with the CAM4 microphysics, there are no number
+ ! constituents.
+ call cnst_get_ind( 'NUMLIQ', ixnumliq, abort=.false. )
+ call cnst_get_ind( 'NUMICE', ixnumice, abort=.false. )
+
+ ! prog_modal_aero determines whether prognostic modal aerosols are present in the run.
+ call phys_getopts(prog_modal_aero_out=prog_modal_aero)
+ if (prog_modal_aero) then
+
+ ! Get the constituent indices of the number and mass mixing ratios of the modal
+ ! aerosols.
+ !
+ ! N.B. - This implementation assumes that the prognostic modal aerosols are
+ ! impacting the climate calculation (i.e., can get info from list 0).
+ !
+
+ ! First need total number of mam constituents
+ call rad_cnst_get_info(0, nmodes=nmodes)
+ do m = 1, nmodes
+ call rad_cnst_get_info(0, m, nspec=nspec)
+ pmam_ncnst = pmam_ncnst + 1 + nspec
+ end do
+
+ allocate(pmam_cnst_idx(pmam_ncnst))
+
+ ! Get the constituent indicies
+ im = 1
+ do m = 1, nmodes
+ call rad_cnst_get_mode_num_idx(m, pmam_cnst_idx(im))
+ im = im + 1
+ call rad_cnst_get_info(0, m, nspec=nspec)
+ do l = 1, nspec
+ call rad_cnst_get_mam_mmr_idx(m, l, pmam_cnst_idx(im))
+ im = im + 1
+ end do
+ end do
+ end if
+
+ ! Initialize upper boundary condition module
+
+ call ubc_init()
+
+ ! ---------------------------------------------------------------------------------------- !
+ ! Initialize molecular diffusivity module !
+ ! Note that computing molecular diffusivities is a trivial expense, but constituent !
+ ! diffusivities depend on their molecular weights. Decomposing the diffusion matrix !
+ ! for each constituent is a needless expense unless the diffusivity is significant. !
+ ! ---------------------------------------------------------------------------------------- !
+
+ !----------------------------------------------------------------------------------------
+ ! Initialize molecular diffusion and get top and bottom molecular diffusion limits
+ !----------------------------------------------------------------------------------------
+
+ if( do_molec_diff ) then
+ call init_molec_diff( r8, pcnst, mwdry, avogad, &
+ errstring)
+
+ call handle_errmsg(errstring, subname="init_molec_diff")
+
+ call addfld( 'TTPXMLC', horiz_only, 'A', 'K/S', 'Top interf. temp. flux: molec. viscosity' )
+ if( masterproc ) write(iulog,fmt='(a,i3,5x,a,i3)') 'NBOT_MOLEC =', nbot_molec
+ end if
+
+ ! ---------------------------------- !
+ ! Initialize eddy diffusivity module !
+ ! ---------------------------------- !
+
+ ! ntop_eddy must be 1 or <= nbot_molec
+ ! Currently, it is always 1 except for WACCM-X.
+ if ( waccmx_mode ) then
+ ntop_eddy = press_lim_idx(ntop_eddy_pres, top=.true.)
+ else
+ ntop_eddy = 1
+ end if
+ nbot_eddy = pver
+
+ if (masterproc) write(iulog, fmt='(a,i3,5x,a,i3)') 'NTOP_EDDY =', ntop_eddy, 'NBOT_EDDY =', nbot_eddy
+
+ select case ( eddy_scheme )
+ case ( 'diag_TKE', 'SPCAM_m2005' )
+ if( masterproc ) write(iulog,*) &
+ 'vertical_diffusion_init: eddy_diffusivity scheme: UW Moist Turbulence Scheme by Bretherton and Park'
+ call eddy_diff_init(pbuf2d, ntop_eddy, nbot_eddy)
+ case ( 'HB', 'HBR', 'SPCAM_sam1mom')
+ if( masterproc ) write(iulog,*) 'vertical_diffusion_init: eddy_diffusivity scheme: Holtslag and Boville'
+ call init_hb_diff(gravit, cpair, ntop_eddy, nbot_eddy, pref_mid, &
+ karman, eddy_scheme)
+ call addfld('HB_ri', (/ 'lev' /), 'A', 'no', 'Richardson Number (HB Scheme), I' )
+ case ( 'CLUBB_SGS' )
+ do_pbl_diags = .true.
+ end select
+
+ ! ------------------------------------------- !
+ ! Initialize turbulent mountain stress module !
+ ! ------------------------------------------- !
+
+ call trb_mtn_stress_init()
+
+ ! ----------------------------------- !
+ ! Initialize Beljaars SGO drag module !
+ ! ----------------------------------- !
+
+ call beljaars_drag_init()
+
+ ! ---------------------------------- !
+ ! Initialize diffusion solver module !
+ ! ---------------------------------- !
+
+ call init_vdiff(r8, iulog, rair, cpair, gravit, do_iss, fv_am_correction, errstring)
+ call handle_errmsg(errstring, subname="init_vdiff")
+
+ ! Use fieldlist_wet to select the fields which will be diffused using moist mixing ratios ( all by default )
+ ! Use fieldlist_dry to select the fields which will be diffused using dry mixing ratios.
+
+ fieldlist_wet = new_fieldlist_vdiff( pcnst)
+ fieldlist_dry = new_fieldlist_vdiff( pcnst)
+ fieldlist_molec = new_fieldlist_vdiff( pcnst)
+
+ if( vdiff_select( fieldlist_wet, 'u' ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 'u' ) )
+ if( vdiff_select( fieldlist_wet, 'v' ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 'v' ) )
+ if( vdiff_select( fieldlist_wet, 's' ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 's' ) )
+
+ constit_loop: do k = 1, pcnst
+
+ if (prog_modal_aero) then
+ ! Do not diffuse droplet number - treated in dropmixnuc
+ if (k == ixnumliq) cycle constit_loop
+ ! Don't diffuse modal aerosol - treated in dropmixnuc
+ do m = 1, pmam_ncnst
+ if (k == pmam_cnst_idx(m)) cycle constit_loop
+ enddo
+ end if
+
+ if( cnst_get_type_byind(k) .eq. 'wet' ) then
+ if( vdiff_select( fieldlist_wet, 'q', k ) .ne. '' ) call endrun( vdiff_select( fieldlist_wet, 'q', k ) )
+ else
+ if( vdiff_select( fieldlist_dry, 'q', k ) .ne. '' ) call endrun( vdiff_select( fieldlist_dry, 'q', k ) )
+ endif
+
+ ! ----------------------------------------------- !
+ ! Select constituents for molecular diffusion !
+ ! ----------------------------------------------- !
+ if ( cnst_get_molec_byind(k) .eq. 'minor' ) then
+ if( vdiff_select(fieldlist_molec,'q',k) .ne. '' ) call endrun( vdiff_select( fieldlist_molec,'q',k ) )
+ endif
+
+ end do constit_loop
+
+ ! ------------------------ !
+ ! Diagnostic output fields !
+ ! ------------------------ !
+
+ do k = 1, pcnst
+ vdiffnam(k) = 'VD'//cnst_name(k)
+ if( k == 1 ) vdiffnam(k) = 'VD01' !**** compatibility with old code ****
+ call addfld( vdiffnam(k), (/ 'lev' /), 'A', 'kg/kg/s', 'Vertical diffusion of '//cnst_name(k) )
+ end do
+
+ if (.not. do_pbl_diags) then
+ call addfld( 'PBLH' , horiz_only , 'A', 'm' , 'PBL height' )
+ call addfld( 'QT' , (/ 'lev' /) , 'A', 'kg/kg' , 'Total water mixing ratio' )
+ call addfld( 'SL' , (/ 'lev' /) , 'A', 'J/kg' , 'Liquid water static energy' )
+ call addfld( 'SLV' , (/ 'lev' /) , 'A', 'J/kg' , 'Liq wat virtual static energy' )
+ call addfld( 'SLFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Liquid static energy flux' )
+ call addfld( 'QTFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Total water flux' )
+ call addfld( 'TKE' , (/ 'ilev' /) , 'A', 'm2/s2' , 'Turbulent Kinetic Energy' )
+ call addfld( 'TPERT' , horiz_only , 'A', 'K' , 'Perturbation temperature (eddies in PBL)' )
+ call addfld( 'QPERT' , horiz_only , 'A', 'kg/kg' , 'Perturbation specific humidity (eddies in PBL)' )
+
+ call addfld( 'UFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Zonal momentum flux' )
+ call addfld( 'VFLX' , (/ 'ilev' /) , 'A', 'W/m2' , 'Meridional momentm flux' )
+ call register_vector_field('UFLX', 'VFLX')
+ end if
+
+ call addfld( 'USTAR' , horiz_only , 'A', 'm/s' , 'Surface friction velocity' )
+ call addfld( 'KVH' , (/ 'ilev' /) , 'A', 'm2/s' , 'Vertical diffusion diffusivities (heat/moisture)' )
+ call addfld( 'KVM' , (/ 'ilev' /) , 'A', 'm2/s' , 'Vertical diffusion diffusivities (momentum)' )
+ call addfld( 'KVT' , (/ 'ilev' /) , 'A', 'm2/s' , 'Vertical diffusion kinematic molecular conductivity')
+ call addfld( 'CGS' , (/ 'ilev' /) , 'A', 's/m2' , 'Counter-gradient coeff on surface kinematic fluxes' )
+ call addfld( 'DTVKE' , (/ 'lev' /) , 'A', 'K/s' , 'dT/dt vertical diffusion KE dissipation' )
+ call addfld( 'DTV' , (/ 'lev' /) , 'A', 'K/s' , 'T vertical diffusion' )
+ call addfld( 'DUV' , (/ 'lev' /) , 'A', 'm/s2' , 'U vertical diffusion' )
+ call addfld( 'DVV' , (/ 'lev' /) , 'A', 'm/s2' , 'V vertical diffusion' )
+
+ ! ---------------------------------------------------------------------------- !
+ ! Below ( with '_PBL') are for detailed analysis of UW Moist Turbulence Scheme !
+ ! ---------------------------------------------------------------------------- !
+
+ if (.not. do_pbl_diags) then
+
+ call addfld( 'qt_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qt_prePBL' )
+ call addfld( 'sl_pre_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'sl_prePBL' )
+ call addfld( 'slv_pre_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'slv_prePBL' )
+ call addfld( 'u_pre_PBL', (/ 'lev' /) , 'A', 'm/s' , 'u_prePBL' )
+ call addfld( 'v_pre_PBL', (/ 'lev' /) , 'A', 'm/s' , 'v_prePBL' )
+ call addfld( 'qv_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qv_prePBL' )
+ call addfld( 'ql_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'ql_prePBL' )
+ call addfld( 'qi_pre_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qi_prePBL' )
+ call addfld( 't_pre_PBL', (/ 'lev' /) , 'A', 'K' , 't_prePBL' )
+ call addfld( 'rh_pre_PBL', (/ 'lev' /) , 'A', '%' , 'rh_prePBL' )
+
+ call addfld( 'qt_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qt_afterPBL' )
+ call addfld( 'sl_aft_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'sl_afterPBL' )
+ call addfld( 'slv_aft_PBL', (/ 'lev' /) , 'A', 'J/kg' , 'slv_afterPBL' )
+ call addfld( 'u_aft_PBL', (/ 'lev' /) , 'A', 'm/s' , 'u_afterPBL' )
+ call addfld( 'v_aft_PBL', (/ 'lev' /) , 'A', 'm/s' , 'v_afterPBL' )
+ call addfld( 'qv_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qv_afterPBL' )
+ call addfld( 'ql_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'ql_afterPBL' )
+ call addfld( 'qi_aft_PBL', (/ 'lev' /) , 'A', 'kg/kg' , 'qi_afterPBL' )
+ call addfld( 't_aft_PBL', (/ 'lev' /) , 'A', 'K' , 't_afterPBL' )
+ call addfld( 'rh_aft_PBL', (/ 'lev' /) , 'A', '%' , 'rh_afterPBL' )
+
+ call addfld( 'slflx_PBL', (/ 'ilev' /) , 'A', 'J/m2/s' , 'sl flux by PBL' )
+ call addfld( 'qtflx_PBL', (/ 'ilev' /) , 'A', 'kg/m2/s', 'qt flux by PBL' )
+ call addfld( 'uflx_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'u flux by PBL' )
+ call addfld( 'vflx_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'v flux by PBL' )
+
+ call addfld( 'slflx_cg_PBL', (/ 'ilev' /) , 'A', 'J/m2/s' , 'sl_cg flux by PBL' )
+ call addfld( 'qtflx_cg_PBL', (/ 'ilev' /) , 'A', 'kg/m2/s', 'qt_cg flux by PBL' )
+ call addfld( 'uflx_cg_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'u_cg flux by PBL' )
+ call addfld( 'vflx_cg_PBL', (/ 'ilev' /) , 'A', 'kg/m/s2', 'v_cg flux by PBL' )
+
+ call addfld( 'qtten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'qt tendency by PBL' )
+ call addfld( 'slten_PBL', (/ 'lev' /) , 'A', 'J/kg/s' , 'sl tendency by PBL' )
+ call addfld( 'uten_PBL', (/ 'lev' /) , 'A', 'm/s2' , 'u tendency by PBL' )
+ call addfld( 'vten_PBL', (/ 'lev' /) , 'A', 'm/s2' , 'v tendency by PBL' )
+ call addfld( 'qvten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'qv tendency by PBL' )
+ call addfld( 'qlten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'ql tendency by PBL' )
+ call addfld( 'qiten_PBL', (/ 'lev' /) , 'A', 'kg/kg/s', 'qi tendency by PBL' )
+ call addfld( 'tten_PBL', (/ 'lev' /) , 'A', 'K/s' , 'T tendency by PBL' )
+ call addfld( 'rhten_PBL', (/ 'lev' /) , 'A', '%/s' , 'RH tendency by PBL' )
+
+ end if
+
+ call addfld ('ustar',horiz_only, 'A', ' ',' ')
+ call addfld ('obklen',horiz_only, 'A', ' ',' ')
+
+ ! ----------------------------
+ ! determine default variables
+ ! ----------------------------
+
+ call phys_getopts( history_amwg_out = history_amwg, &
+ history_eddy_out = history_eddy, &
+ history_budget_out = history_budget, &
+ history_budget_histfile_num_out = history_budget_histfile_num, &
+ history_waccm_out = history_waccm)
+
+ if (history_amwg) then
+ call add_default( vdiffnam(1), 1, ' ' )
+ call add_default( 'DTV' , 1, ' ' )
+ if (.not. do_pbl_diags) then
+ call add_default( 'PBLH' , 1, ' ' )
+ end if
+ endif
+
+ if (history_eddy) then
+ call add_default( 'UFLX ', 1, ' ' )
+ call add_default( 'VFLX ', 1, ' ' )
+ endif
+
+ if( history_budget ) then
+ call add_default( vdiffnam(ixcldliq), history_budget_histfile_num, ' ' )
+ call add_default( vdiffnam(ixcldice), history_budget_histfile_num, ' ' )
+ if( history_budget_histfile_num > 1 ) then
+ call add_default( vdiffnam(1), history_budget_histfile_num, ' ' )
+ call add_default( 'DTV' , history_budget_histfile_num, ' ' )
+ end if
+ end if
+
+ if ( history_waccm ) then
+ if (do_molec_diff) then
+ call add_default ( 'TTPXMLC', 1, ' ' )
+ end if
+ call add_default( 'DUV' , 1, ' ' )
+ call add_default( 'DVV' , 1, ' ' )
+ end if
+ ! ----------------------------
+
+
+ ksrftms_idx = pbuf_get_index('ksrftms')
+ tautmsx_idx = pbuf_get_index('tautmsx')
+ tautmsy_idx = pbuf_get_index('tautmsy')
+
+ dragblj_idx = pbuf_get_index('dragblj')
+ taubljx_idx = pbuf_get_index('taubljx')
+ taubljy_idx = pbuf_get_index('taubljy')
+
+ ! Initialization of some pbuf fields
+ if (is_first_step()) then
+ ! Initialization of pbuf fields tke, kvh, kvm are done in phys_inidat
+ call pbuf_set_field(pbuf2d, turbtype_idx, 0 )
+ call pbuf_set_field(pbuf2d, smaw_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, tauresx_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, tauresy_idx, 0.0_r8)
+ if (trim(shallow_scheme) == 'UNICON') then
+ call pbuf_set_field(pbuf2d, qtl_flx_idx, 0.0_r8)
+ call pbuf_set_field(pbuf2d, qti_flx_idx, 0.0_r8)
+ end if
+ end if
+
+end subroutine vertical_diffusion_init
+
+! =============================================================================== !
+! !
+! =============================================================================== !
+
+subroutine vertical_diffusion_ts_init( pbuf2d, state )
+
+ !-------------------------------------------------------------- !
+ ! Timestep dependent setting, !
+ ! At present only invokes upper bc code !
+ !-------------------------------------------------------------- !
+ use upper_bc, only : ubc_timestep_init
+ use physics_types , only : physics_state
+ use ppgrid , only : begchunk, endchunk
+
+ use physics_buffer, only : physics_buffer_desc
+
+ type(physics_state), intent(in) :: state(begchunk:endchunk)
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ call ubc_timestep_init( pbuf2d, state)
+
+end subroutine vertical_diffusion_ts_init
+
+! =============================================================================== !
+! !
+! =============================================================================== !
+
+subroutine vertical_diffusion_tend( &
+ ztodt , state , cam_in, &
+ ustar , obklen , ptend , &
+ cldn , pbuf)
+ !---------------------------------------------------- !
+ ! This is an interface routine for vertical diffusion !
+ !---------------------------------------------------- !
+ use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_set_field
+ use physics_types, only : physics_state, physics_ptend, physics_ptend_init
+ use camsrfexch, only : cam_in_t
+ use cam_history, only : outfld
+
+ use trb_mtn_stress_cam, only : trb_mtn_stress_tend
+ use beljaars_drag_cam, only : beljaars_drag_tend
+ use eddy_diff_cam, only : eddy_diff_tend
+ use hb_diff, only : compute_hb_diff
+ use wv_saturation, only : qsat
+ use molec_diff, only : compute_molec_diff, vd_lu_qdecomp
+ use constituents, only : qmincg, qmin
+ use diffusion_solver, only : compute_vdiff, any, operator(.not.)
+ use physconst, only : cpairv, rairv !Needed for calculation of upward H flux
+ use time_manager, only : get_nstep
+ use constituents, only : cnst_get_type_byind, cnst_name, &
+ cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx
+ use physconst, only : pi
+ use pbl_utils, only : virtem, calc_obklen, calc_ustar
+ use upper_bc, only : ubc_get_vals
+ use coords_1d, only : Coords1D
+
+ ! --------------- !
+ ! Input Arguments !
+ ! --------------- !
+
+ type(physics_state), intent(in) :: state ! Physics state variables
+ type(cam_in_t), intent(in) :: cam_in ! Surface inputs
+
+ real(r8), intent(in) :: ztodt ! 2 delta-t [ s ]
+ real(r8), intent(in) :: cldn(pcols,pver) ! New stratus fraction [ fraction ]
+
+ ! ---------------------- !
+ ! Input-Output Arguments !
+ ! ---------------------- !
+
+ type(physics_ptend), intent(out) :: ptend ! Individual parameterization tendencies
+ type(physics_buffer_desc), pointer :: pbuf(:)
+
+ ! ---------------- !
+ ! Output Arguments !
+ ! ---------------- !
+
+ real(r8), intent(out) :: ustar(pcols) ! Surface friction velocity [ m/s ]
+ real(r8), intent(out) :: obklen(pcols) ! Obukhov length [ m ]
+
+ ! --------------- !
+ ! Local Variables !
+ ! --------------- !
+
+ character(128) :: errstring ! Error status for compute_vdiff
+
+ integer :: lchnk ! Chunk identifier
+ integer :: ncol ! Number of atmospheric columns
+ integer :: i, k, l, m ! column, level, constituent indices
+
+ real(r8) :: dtk(pcols,pver) ! T tendency from KE dissipation
+ real(r8), pointer :: tke(:,:) ! Turbulent kinetic energy [ m2/s2 ]
+ integer(i4),pointer :: turbtype(:,:) ! Turbulent interface types [ no unit ]
+ real(r8), pointer :: smaw(:,:) ! Normalized Galperin instability function
+ ! ( 0<= <=4.964 and 1 at neutral )
+
+ real(r8), pointer :: qtl_flx(:,:) ! overbar(w'qtl') where qtl = qv + ql
+ real(r8), pointer :: qti_flx(:,:) ! overbar(w'qti') where qti = qv + qi
+
+ real(r8) :: cgs(pcols,pverp) ! Counter-gradient star [ cg/flux ]
+ real(r8) :: cgh(pcols,pverp) ! Counter-gradient term for heat
+ real(r8) :: rztodt ! 1./ztodt [ 1/s ]
+ real(r8), pointer :: ksrftms(:) ! Turbulent mountain stress surface drag coefficient [ kg/s/m2 ]
+ real(r8), pointer :: tautmsx(:) ! U component of turbulent mountain stress [ N/m2 ]
+ real(r8), pointer :: tautmsy(:) ! V component of turbulent mountain stress [ N/m2 ]
+ real(r8) :: tautotx(pcols) ! U component of total surface stress [ N/m2 ]
+ real(r8) :: tautoty(pcols) ! V component of total surface stress [ N/m2 ]
+
+ real(r8), pointer :: dragblj(:,:) ! Beljaars SGO form drag profile [ 1/s ]
+ real(r8), pointer :: taubljx(:) ! U component of turbulent mountain stress [ N/m2 ]
+ real(r8), pointer :: taubljy(:) ! V component of turbulent mountain stress [ N/m2 ]
+
+ real(r8), pointer :: kvh_in(:,:) ! kvh from previous timestep [ m2/s ]
+ real(r8), pointer :: kvm_in(:,:) ! kvm from previous timestep [ m2/s ]
+ real(r8), pointer :: kvt(:,:) ! Molecular kinematic conductivity for temperature [ ]
+ real(r8) :: kvq(pcols,pverp) ! Eddy diffusivity for constituents [ m2/s ]
+ real(r8) :: kvh(pcols,pverp) ! Eddy diffusivity for heat [ m2/s ]
+ real(r8) :: kvm(pcols,pverp) ! Eddy diffusivity for momentum [ m2/s ]
+ real(r8) :: kvm_temp(pcols,pverp) ! Dummy eddy diffusivity for momentum (unused) [ m2/s ]
+ real(r8) :: dtk_temp(pcols,pverp) ! Unused output from second compute_vdiff call
+ real(r8) :: tautmsx_temp(pcols) ! Unused output from second compute_vdiff call
+ real(r8) :: tautmsy_temp(pcols) ! Unused output from second compute_vdiff call
+ real(r8) :: topflx_temp(pcols) ! Unused output from second compute_vdiff call
+ real(r8) :: sprod(pcols,pverp) ! Shear production of tke [ m2/s3 ]
+ real(r8) :: sfi(pcols,pverp) ! Saturation fraction at interfaces [ fraction ]
+ real(r8) :: sl(pcols,pver)
+ real(r8) :: qt(pcols,pver)
+ real(r8) :: slv(pcols,pver)
+ real(r8) :: sl_prePBL(pcols,pver)
+ real(r8) :: qt_prePBL(pcols,pver)
+ real(r8) :: slv_prePBL(pcols,pver)
+ real(r8) :: slten(pcols,pver)
+ real(r8) :: qtten(pcols,pver)
+ real(r8) :: slflx(pcols,pverp)
+ real(r8) :: qtflx(pcols,pverp)
+ real(r8) :: uflx(pcols,pverp)
+ real(r8) :: vflx(pcols,pverp)
+ real(r8) :: slflx_cg(pcols,pverp)
+ real(r8) :: qtflx_cg(pcols,pverp)
+ real(r8) :: uflx_cg(pcols,pverp)
+ real(r8) :: vflx_cg(pcols,pverp)
+ real(r8) :: th(pcols,pver) ! Potential temperature
+ real(r8) :: topflx(pcols) ! Molecular heat flux at top interface
+ real(r8) :: rhoair
+
+ real(r8) :: ri(pcols,pver) ! richardson number (HB output)
+
+ ! for obklen calculation outside HB
+ real(r8) :: thvs(pcols) ! Virtual potential temperature at surface
+ real(r8) :: rrho(pcols) ! Reciprocal of density at surface
+ real(r8) :: khfs(pcols) ! sfc kinematic heat flux [mK/s]
+ real(r8) :: kqfs(pcols) ! sfc kinematic water vapor flux [m/s]
+ real(r8) :: kbfs(pcols) ! sfc kinematic buoyancy flux [m^2/s^3]
+
+ real(r8) :: ftem(pcols,pver) ! Saturation vapor pressure before PBL
+ real(r8) :: ftem_prePBL(pcols,pver) ! Saturation vapor pressure before PBL
+ real(r8) :: ftem_aftPBL(pcols,pver) ! Saturation vapor pressure after PBL
+ real(r8) :: tem2(pcols,pver) ! Saturation specific humidity and RH
+ real(r8) :: t_aftPBL(pcols,pver) ! Temperature after PBL diffusion
+ real(r8) :: tten(pcols,pver) ! Temperature tendency by PBL diffusion
+ real(r8) :: rhten(pcols,pver) ! RH tendency by PBL diffusion
+ real(r8) :: qv_aft_PBL(pcols,pver) ! qv after PBL diffusion
+ real(r8) :: ql_aft_PBL(pcols,pver) ! ql after PBL diffusion
+ real(r8) :: qi_aft_PBL(pcols,pver) ! qi after PBL diffusion
+ real(r8) :: s_aft_PBL(pcols,pver) ! s after PBL diffusion
+ real(r8) :: u_aft_PBL(pcols,pver) ! u after PBL diffusion
+ real(r8) :: v_aft_PBL(pcols,pver) ! v after PBL diffusion
+ real(r8) :: qv_pro(pcols,pver)
+ real(r8) :: ql_pro(pcols,pver)
+ real(r8) :: qi_pro(pcols,pver)
+ real(r8) :: s_pro(pcols,pver)
+ real(r8) :: t_pro(pcols,pver)
+ real(r8), pointer :: tauresx(:) ! Residual stress to be added in vdiff to correct
+ real(r8), pointer :: tauresy(:) ! for turb stress mismatch between sfc and atm accumulated.
+
+ ! Interpolated interface values.
+ real(r8) :: tint(pcols,pver+1) ! Temperature [ K ]
+ real(r8) :: rairi(pcols,pver+1) ! Gas constant [ J/K/kg ]
+ real(r8) :: rhoi(pcols,pver+1) ! Density of air [ kg/m^3 ]
+ real(r8) :: rhoi_dry(pcols,pver+1) ! Density of air based on dry air pressure [ kg/m^3 ]
+
+ ! Upper boundary conditions
+ real(r8) :: ubc_t(pcols) ! Temperature [ K ]
+ real(r8) :: ubc_mmr(pcols,pcnst) ! Mixing ratios [ kg/kg ]
+ real(r8) :: ubc_flux(pcols,pcnst) ! Constituent upper boundary flux (kg/s/m^2)
+
+ ! Pressure coordinates used by the solver.
+ type(Coords1D) :: p
+ type(Coords1D) :: p_dry
+
+ real(r8), pointer :: tpert(:)
+ real(r8), pointer :: qpert(:)
+ real(r8), pointer :: pblh(:)
+
+ real(r8) :: tmp1(pcols) ! Temporary storage
+
+ integer :: nstep
+ real(r8) :: sum1, sum2, sum3, pdelx
+ real(r8) :: sflx
+
+ ! Copy state so we can pass to intent(inout) routines that return
+ ! new state instead of a tendency.
+ real(r8) :: s_tmp(pcols,pver)
+ real(r8) :: u_tmp(pcols,pver)
+ real(r8) :: v_tmp(pcols,pver)
+ real(r8) :: q_tmp(pcols,pver,pcnst)
+
+ ! kq_fac*sqrt(T)*m_d/rho for molecular diffusivity
+ real(r8) :: kq_scal(pcols,pver+1)
+ ! composition dependent mw_fac on interface level
+ real(r8) :: mw_fac(pcols,pver+1,pcnst)
+
+ ! Dry static energy top boundary condition.
+ real(r8) :: dse_top(pcols)
+
+ ! Copies of flux arrays used to zero out any parts that are applied
+ ! elsewhere (e.g. by CLUBB).
+ real(r8) :: taux(pcols)
+ real(r8) :: tauy(pcols)
+ real(r8) :: shflux(pcols)
+ real(r8) :: cflux(pcols,pcnst)
+
+ logical :: lq(pcnst)
+
+ ! ----------------------- !
+ ! Main Computation Begins !
+ ! ----------------------- !
+
+ rztodt = 1._r8 / ztodt
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ call pbuf_get_field(pbuf, tauresx_idx, tauresx)
+ call pbuf_get_field(pbuf, tauresy_idx, tauresy)
+ call pbuf_get_field(pbuf, tpert_idx, tpert)
+ call pbuf_get_field(pbuf, qpert_idx, qpert)
+ call pbuf_get_field(pbuf, pblh_idx, pblh)
+ call pbuf_get_field(pbuf, turbtype_idx, turbtype)
+
+ ! Interpolate temperature to interfaces.
+ do k = 2, pver
+ do i = 1, ncol
+ tint(i,k) = 0.5_r8 * ( state%t(i,k) + state%t(i,k-1) )
+ end do
+ end do
+ tint(:ncol,pver+1) = state%t(:ncol,pver)
+
+ ! Get upper boundary values
+ call ubc_get_vals( state%lchnk, ncol, state%pint, state%zi, state%t, state%q, state%omega, state%phis, &
+ ubc_t, ubc_mmr, ubc_flux )
+
+ ! Always have a fixed upper boundary T if molecular diffusion is active. Why ?
+ ! For WACCM-X, set ubc temperature to extrapolate from next two lower interface level temperatures
+ if (do_molec_diff) then
+ if (waccmx_mode) then
+ tint(:ncol,1) = 1.5_r8*tint(:ncol,2)-.5_r8*tint(:ncol,3)
+ else
+ tint (:ncol,1) = ubc_t(:ncol)
+ endif
+ else
+ tint(:ncol,1) = state%t(:ncol,1)
+ end if
+
+ ! Set up pressure coordinates for solver calls.
+ p = Coords1D(state%pint(:ncol,:))
+ p_dry = Coords1D(state%pintdry(:ncol,:))
+
+ !------------------------------------------------------------------------
+ ! Check to see if constituent dependent gas constant needed (WACCM-X)
+ !------------------------------------------------------------------------
+ if (waccmx_mode) then
+ rairi(:ncol,1) = rairv(:ncol,1,lchnk)
+ do k = 2, pver
+ do i = 1, ncol
+ rairi(i,k) = 0.5_r8 * (rairv(i,k,lchnk)+rairv(i,k-1,lchnk))
+ end do
+ end do
+ rairi(:ncol,pver+1) = rairv(:ncol,pver,lchnk)
+ else
+ rairi(:ncol,:pver+1) = rair
+ endif
+
+ ! Compute rho at interfaces.
+ do k = 1, pver+1
+ do i = 1, ncol
+ rhoi(i,k) = p%ifc(i,k) / (rairi(i,k)*tint(i,k))
+ end do
+ end do
+
+ ! Compute rho_dry at interfaces.
+ do k = 1, pver+1
+ do i = 1, ncol
+ rhoi_dry(i,k) = p_dry%ifc(i,k) / (rairi(i,k)*tint(i,k))
+ end do
+ end do
+
+ ! ---------------------------------------- !
+ ! Computation of turbulent mountain stress !
+ ! ---------------------------------------- !
+
+ ! Consistent with the computation of 'normal' drag coefficient, we are using
+ ! the raw input (u,v) to compute 'ksrftms', not the provisionally-marched 'u,v'
+ ! within the iteration loop of the PBL scheme.
+
+ call trb_mtn_stress_tend(state, pbuf, cam_in)
+
+ call pbuf_get_field(pbuf, ksrftms_idx, ksrftms)
+ call pbuf_get_field(pbuf, tautmsx_idx, tautmsx)
+ call pbuf_get_field(pbuf, tautmsy_idx, tautmsy)
+
+ tautotx(:ncol) = cam_in%wsx(:ncol) + tautmsx(:ncol)
+ tautoty(:ncol) = cam_in%wsy(:ncol) + tautmsy(:ncol)
+
+ ! ------------------------------------- !
+ ! Computation of Beljaars SGO form drag !
+ ! ------------------------------------- !
+
+ call beljaars_drag_tend(state, pbuf, cam_in)
+
+ call pbuf_get_field(pbuf, dragblj_idx, dragblj)
+ call pbuf_get_field(pbuf, taubljx_idx, taubljx)
+ call pbuf_get_field(pbuf, taubljy_idx, taubljy)
+
+ ! Add Beljaars integrated drag
+
+ tautotx(:ncol) = tautotx(:ncol) + taubljx(:ncol)
+ tautoty(:ncol) = tautoty(:ncol) + taubljy(:ncol)
+
+ !----------------------------------------------------------------------- !
+ ! Computation of eddy diffusivities - Select appropriate PBL scheme !
+ !----------------------------------------------------------------------- !
+ call pbuf_get_field(pbuf, kvm_idx, kvm_in)
+ call pbuf_get_field(pbuf, kvh_idx, kvh_in)
+ call pbuf_get_field(pbuf, smaw_idx, smaw)
+ call pbuf_get_field(pbuf, tke_idx, tke)
+
+ ! Get potential temperature.
+ th(:ncol,:pver) = state%t(:ncol,:pver) * state%exner(:ncol,:pver)
+
+ select case (eddy_scheme)
+ case ( 'diag_TKE', 'SPCAM_m2005' )
+
+ call eddy_diff_tend(state, pbuf, cam_in, &
+ ztodt, p, tint, rhoi, cldn, wstarent, &
+ kvm_in, kvh_in, ksrftms, dragblj, tauresx, tauresy, &
+ rrho, ustar, pblh, kvm, kvh, kvq, cgh, cgs, tpert, qpert, &
+ tke, sprod, sfi, turbtype, smaw)
+
+ ! The diag_TKE scheme does not calculate the Monin-Obukhov length, which is used in dry deposition calculations.
+ ! Use the routines from pbl_utils to accomplish this. Assumes ustar and rrho have been set.
+ call virtem(ncol, th(:ncol,pver),state%q(:ncol,pver,1), thvs(:ncol))
+ call calc_obklen(ncol, th(:ncol,pver), thvs(:ncol), cam_in%cflx(:ncol,1), &
+ cam_in%shf(:ncol), rrho(:ncol), ustar(:ncol), &
+ khfs(:ncol), kqfs(:ncol), kbfs(:ncol), obklen(:ncol))
+
+
+ case ( 'HB', 'HBR', 'SPCAM_sam1mom' )
+
+ ! Modification : We may need to use 'taux' instead of 'tautotx' here, for
+ ! consistency with the previous HB scheme.
+
+ call compute_hb_diff( lchnk , ncol , &
+ th , state%t , state%q , state%zm , state%zi, &
+ state%pmid, state%u , state%v , tautotx , tautoty , &
+ cam_in%shf, cam_in%cflx(:,1), obklen , ustar , pblh , &
+ kvm , kvh , kvq , cgh , cgs , &
+ tpert , qpert , cldn , cam_in%ocnfrac , tke , &
+ ri , &
+ eddy_scheme )
+
+ call outfld( 'HB_ri', ri, pcols, lchnk )
+
+ case ( 'CLUBB_SGS' )
+
+ ! CLUBB has only a bare-bones placeholder here. If using CLUBB, the
+ ! PBL diffusion will happen before coupling, so vertical_diffusion
+ ! is only handling other things, e.g. some boundary conditions, tms,
+ ! and molecular diffusion.
+
+ call virtem(ncol, th(:ncol,pver),state%q(:ncol,pver,1), thvs(:ncol))
+
+ call calc_ustar( ncol, state%t(:ncol,pver), state%pmid(:ncol,pver), &
+ cam_in%wsx(:ncol), cam_in%wsy(:ncol), rrho(:ncol), ustar(:ncol))
+ call calc_obklen( ncol, th(:ncol,pver), thvs(:ncol), cam_in%lhf(:ncol)/latvap, &
+ cam_in%shf(:ncol), rrho(:ncol), ustar(:ncol), &
+ khfs(:ncol), kqfs(:ncol), kbfs(:ncol), obklen(:ncol))
+
+ ! These tendencies all applied elsewhere.
+ kvm = 0._r8
+ kvh = 0._r8
+ kvq = 0._r8
+
+ ! Not defined since PBL is not actually running here.
+ cgh = 0._r8
+ cgs = 0._r8
+
+ end select
+
+ call outfld( 'ustar', ustar(:), pcols, lchnk )
+ call outfld( 'obklen', obklen(:), pcols, lchnk )
+
+ ! kvh (in pbuf) is used by other physics parameterizations, and as an initial guess in compute_eddy_diff
+ ! on the next timestep. It is not updated by the compute_vdiff call below.
+ call pbuf_set_field(pbuf, kvh_idx, kvh)
+
+ ! kvm (in pbuf) is only used as an initial guess in compute_eddy_diff on the next timestep.
+ ! The contributions for molecular diffusion made to kvm by the call to compute_vdiff below
+ ! are not included in the pbuf as these are not needed in the initial guess by compute_eddy_diff.
+ call pbuf_set_field(pbuf, kvm_idx, kvm)
+
+ !------------------------------------ !
+ ! Application of diffusivities !
+ !------------------------------------ !
+
+ ! Set arrays from input state.
+ q_tmp(:ncol,:,:) = state%q(:ncol,:,:)
+ s_tmp(:ncol,:) = state%s(:ncol,:)
+ u_tmp(:ncol,:) = state%u(:ncol,:)
+ v_tmp(:ncol,:) = state%v(:ncol,:)
+
+ !------------------------------------------------------ !
+ ! Write profile output before applying diffusion scheme !
+ !------------------------------------------------------ !
+
+ if (.not. do_pbl_diags) then
+ sl_prePBL(:ncol,:pver) = s_tmp(:ncol,:) - latvap * q_tmp(:ncol,:,ixcldliq) &
+ - ( latvap + latice) * q_tmp(:ncol,:,ixcldice)
+ qt_prePBL(:ncol,:pver) = q_tmp(:ncol,:,1) + q_tmp(:ncol,:,ixcldliq) &
+ + q_tmp(:ncol,:,ixcldice)
+ slv_prePBL(:ncol,:pver) = sl_prePBL(:ncol,:pver) * ( 1._r8 + zvir*qt_prePBL(:ncol,:pver) )
+
+ call qsat(state%t(:ncol,:), state%pmid(:ncol,:), &
+ tem2(:ncol,:), ftem(:ncol,:))
+ ftem_prePBL(:ncol,:) = state%q(:ncol,:,1)/ftem(:ncol,:)*100._r8
+
+ call outfld( 'qt_pre_PBL ', qt_prePBL, pcols, lchnk )
+ call outfld( 'sl_pre_PBL ', sl_prePBL, pcols, lchnk )
+ call outfld( 'slv_pre_PBL ', slv_prePBL, pcols, lchnk )
+ call outfld( 'u_pre_PBL ', state%u, pcols, lchnk )
+ call outfld( 'v_pre_PBL ', state%v, pcols, lchnk )
+ call outfld( 'qv_pre_PBL ', state%q(:ncol,:,1), pcols, lchnk )
+ call outfld( 'ql_pre_PBL ', state%q(:ncol,:,ixcldliq), pcols, lchnk )
+ call outfld( 'qi_pre_PBL ', state%q(:ncol,:,ixcldice), pcols, lchnk )
+ call outfld( 't_pre_PBL ', state%t, pcols, lchnk )
+ call outfld( 'rh_pre_PBL ', ftem_prePBL, pcols, lchnk )
+
+ end if
+
+ ! --------------------------------------------------------------------------------- !
+ ! Call the diffusivity solver and solve diffusion equation !
+ ! The final two arguments are optional function references to !
+ ! constituent-independent and constituent-dependent moleculuar diffusivity routines !
+ ! --------------------------------------------------------------------------------- !
+
+ ! Modification : We may need to output 'tautotx_im,tautoty_im' from below 'compute_vdiff' and
+ ! separately print out as diagnostic output, because these are different from
+ ! the explicit 'tautotx, tautoty' computed above.
+ ! Note that the output 'tauresx,tauresy' from below subroutines are fully implicit ones.
+
+ call pbuf_get_field(pbuf, kvt_idx, kvt)
+
+ if (do_molec_diff .and. .not. waccmx_mode) then
+ ! Top boundary condition for dry static energy
+ dse_top(:ncol) = cpairv(:ncol,1,lchnk) * tint(:ncol,1) + &
+ gravit * state%zi(:ncol,1)
+ else
+ dse_top(:ncol) = 0._r8
+ end if
+
+ select case (eddy_scheme)
+ case ('CLUBB_SGS')
+ ! CLUBB applies some fluxes itself, but we still want constituent
+ ! fluxes applied here (except water vapor).
+ taux = 0._r8
+ tauy = 0._r8
+ shflux = 0._r8
+ cflux(:,1) = 0._r8
+ cflux(:,2:) = cam_in%cflx(:,2:)
+ case default
+ taux = cam_in%wsx
+ tauy = cam_in%wsy
+ shflux = cam_in%shf
+ cflux = cam_in%cflx
+ end select
+
+ if( any(fieldlist_wet) ) then
+
+ if (do_molec_diff) then
+ call compute_molec_diff(state%lchnk, pcols, pver, pcnst, ncol, &
+ kvm, kvt, tint, rhoi, kq_scal, cnst_mw, &
+ mw_fac, nbot_molec)
+ end if
+
+ call compute_vdiff( state%lchnk , &
+ pcols , pver , pcnst , ncol , tint , &
+ p , state%t , rhoi, ztodt , taux , &
+ tauy , shflux , cflux , &
+ kvh , kvm , kvq , cgs , cgh , &
+ state%zi , ksrftms , dragblj , &
+ qmincg , fieldlist_wet , fieldlist_molec,&
+ u_tmp , v_tmp , q_tmp , s_tmp , &
+ tautmsx , tautmsy , dtk , topflx , errstring , &
+ tauresx , tauresy , 1 , cpairv(:,:,state%lchnk), dse_top, &
+ do_molec_diff, waccmx_mode, &
+ vd_lu_qdecomp, &
+ ubc_mmr, ubc_flux, kvt, state%pmid, &
+ cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx, nbot_molec, &
+ kq_scal, mw_fac)
+
+ call handle_errmsg(errstring, subname="compute_vdiff", &
+ extra_msg="Error in fieldlist_wet call from vertical_diffusion.")
+
+ end if
+
+ if( any( fieldlist_dry ) ) then
+
+ if( do_molec_diff ) then
+ ! kvm is unused in the output here (since it was assigned
+ ! above), so we use a temp kvm for the inout argument, and
+ ! ignore the value output by compute_molec_diff.
+ kvm_temp = kvm
+ call compute_molec_diff(state%lchnk, pcols, pver, pcnst, ncol, &
+ kvm_temp, kvt, tint, rhoi_dry, kq_scal, cnst_mw, &
+ mw_fac, nbot_molec)
+ end if
+
+ call compute_vdiff( state%lchnk , &
+ pcols , pver , pcnst , ncol , tint , &
+ p_dry , state%t , rhoi_dry, ztodt , taux , &
+ tauy , shflux , cflux , &
+ kvh , kvm , kvq , cgs , cgh , &
+ state%zi , ksrftms , dragblj , &
+ qmincg , fieldlist_dry , fieldlist_molec,&
+ u_tmp , v_tmp , q_tmp , s_tmp , &
+ tautmsx_temp , tautmsy_temp , dtk_temp , topflx_temp , errstring , &
+ tauresx , tauresy , 1 , cpairv(:,:,state%lchnk), dse_top, &
+ do_molec_diff , waccmx_mode, &
+ vd_lu_qdecomp, &
+ ubc_mmr, ubc_flux, kvt, state%pmiddry, &
+ cnst_mw, cnst_fixed_ubc, cnst_fixed_ubflx, nbot_molec, &
+ kq_scal, mw_fac)
+
+ call handle_errmsg(errstring, subname="compute_vdiff", &
+ extra_msg="Error in fieldlist_dry call from vertical_diffusion.")
+
+ end if
+
+ if (prog_modal_aero) then
+
+ ! Modal aerosol species not diffused, so just add the explicit surface fluxes to the
+ ! lowest layer
+
+ tmp1(:ncol) = ztodt * gravit * state%rpdel(:ncol,pver)
+ do m = 1, pmam_ncnst
+ l = pmam_cnst_idx(m)
+ q_tmp(:ncol,pver,l) = q_tmp(:ncol,pver,l) + tmp1(:ncol) * cam_in%cflx(:ncol,l)
+ enddo
+ end if
+
+ ! -------------------------------------------------------- !
+ ! Diagnostics and output writing after applying PBL scheme !
+ ! -------------------------------------------------------- !
+
+ if (.not. do_pbl_diags) then
+
+ sl(:ncol,:pver) = s_tmp(:ncol,:) - latvap * q_tmp(:ncol,:,ixcldliq) &
+ - ( latvap + latice) * q_tmp(:ncol,:,ixcldice)
+ qt(:ncol,:pver) = q_tmp(:ncol,:,1) + q_tmp(:ncol,:,ixcldliq) &
+ + q_tmp(:ncol,:,ixcldice)
+ slv(:ncol,:pver) = sl(:ncol,:pver) * ( 1._r8 + zvir*qt(:ncol,:pver) )
+
+ slflx(:ncol,1) = 0._r8
+ qtflx(:ncol,1) = 0._r8
+ uflx(:ncol,1) = 0._r8
+ vflx(:ncol,1) = 0._r8
+
+ slflx_cg(:ncol,1) = 0._r8
+ qtflx_cg(:ncol,1) = 0._r8
+ uflx_cg(:ncol,1) = 0._r8
+ vflx_cg(:ncol,1) = 0._r8
+
+ do k = 2, pver
+ do i = 1, ncol
+ rhoair = state%pint(i,k) / ( rair * ( ( 0.5_r8*(slv(i,k)+slv(i,k-1)) - gravit*state%zi(i,k))/cpair ) )
+ slflx(i,k) = kvh(i,k) * &
+ ( - rhoair*(sl(i,k-1)-sl(i,k))/(state%zm(i,k-1)-state%zm(i,k)) &
+ + cgh(i,k) )
+ qtflx(i,k) = kvh(i,k) * &
+ ( - rhoair*(qt(i,k-1)-qt(i,k))/(state%zm(i,k-1)-state%zm(i,k)) &
+ + rhoair*(cam_in%cflx(i,1)+cam_in%cflx(i,ixcldliq)+cam_in%cflx(i,ixcldice))*cgs(i,k) )
+ uflx(i,k) = kvm(i,k) * &
+ ( - rhoair*(u_tmp(i,k-1)-u_tmp(i,k))/(state%zm(i,k-1)-state%zm(i,k)))
+ vflx(i,k) = kvm(i,k) * &
+ ( - rhoair*(v_tmp(i,k-1)-v_tmp(i,k))/(state%zm(i,k-1)-state%zm(i,k)))
+ slflx_cg(i,k) = kvh(i,k) * cgh(i,k)
+ qtflx_cg(i,k) = kvh(i,k) * rhoair * ( cam_in%cflx(i,1) + &
+ cam_in%cflx(i,ixcldliq) + cam_in%cflx(i,ixcldice) ) * cgs(i,k)
+ uflx_cg(i,k) = 0._r8
+ vflx_cg(i,k) = 0._r8
+ end do
+ end do
+
+ ! Modification : I should check whether slflx(:ncol,pverp) is correctly computed.
+ ! Note also that 'tautotx' is explicit total stress, different from
+ ! the ones that have been actually added into the atmosphere.
+
+ slflx(:ncol,pverp) = cam_in%shf(:ncol)
+ qtflx(:ncol,pverp) = cam_in%cflx(:ncol,1)
+ uflx(:ncol,pverp) = tautotx(:ncol)
+ vflx(:ncol,pverp) = tautoty(:ncol)
+
+ slflx_cg(:ncol,pverp) = 0._r8
+ qtflx_cg(:ncol,pverp) = 0._r8
+ uflx_cg(:ncol,pverp) = 0._r8
+ vflx_cg(:ncol,pverp) = 0._r8
+
+ if (trim(shallow_scheme) == 'UNICON') then
+ call pbuf_get_field(pbuf, qtl_flx_idx, qtl_flx)
+ call pbuf_get_field(pbuf, qti_flx_idx, qti_flx)
+ qtl_flx(:ncol,1) = 0._r8
+ qti_flx(:ncol,1) = 0._r8
+ do k = 2, pver
+ do i = 1, ncol
+ ! For use in the cloud macrophysics
+ ! Note that density is not added here. Also, only consider local transport term.
+ qtl_flx(i,k) = - kvh(i,k)*(q_tmp(i,k-1,1)-q_tmp(i,k,1)+q_tmp(i,k-1,ixcldliq)-q_tmp(i,k,ixcldliq))/&
+ (state%zm(i,k-1)-state%zm(i,k))
+ qti_flx(i,k) = - kvh(i,k)*(q_tmp(i,k-1,1)-q_tmp(i,k,1)+q_tmp(i,k-1,ixcldice)-q_tmp(i,k,ixcldice))/&
+ (state%zm(i,k-1)-state%zm(i,k))
+ end do
+ end do
+ do i = 1, ncol
+ rhoair = state%pint(i,pverp)/(rair*((slv(i,pver)-gravit*state%zi(i,pverp))/cpair))
+ qtl_flx(i,pverp) = cam_in%cflx(i,1)/rhoair
+ qti_flx(i,pverp) = cam_in%cflx(i,1)/rhoair
+ end do
+ end if
+
+ end if
+
+ ! --------------------------------------------------------------- !
+ ! Convert the new profiles into vertical diffusion tendencies. !
+ ! Convert KE dissipative heat change into "temperature" tendency. !
+ ! --------------------------------------------------------------- !
+
+ ! All variables are modified by vertical diffusion
+
+ lq(:) = .TRUE.
+ call physics_ptend_init(ptend,state%psetcols, "vertical diffusion", &
+ ls=.true., lu=.true., lv=.true., lq=lq)
+
+ ptend%s(:ncol,:) = ( s_tmp(:ncol,:) - state%s(:ncol,:) ) * rztodt
+ ptend%u(:ncol,:) = ( u_tmp(:ncol,:) - state%u(:ncol,:) ) * rztodt
+ ptend%v(:ncol,:) = ( v_tmp(:ncol,:) - state%v(:ncol,:) ) * rztodt
+ ptend%q(:ncol,:pver,:) = ( q_tmp(:ncol,:pver,:) - state%q(:ncol,:pver,:) ) * rztodt
+ if (.not. do_pbl_diags) then
+ slten(:ncol,:) = ( sl(:ncol,:) - sl_prePBL(:ncol,:) ) * rztodt
+ qtten(:ncol,:) = ( qt(:ncol,:) - qt_prePBL(:ncol,:) ) * rztodt
+ end if
+
+ ! ------------------------------------------------------------ !
+ ! In order to perform 'pseudo-conservative variable diffusion' !
+ ! perform the following two stages: !
+ ! !
+ ! I. Re-set (1) 'qvten' by 'qtten', and 'qlten = qiten = 0' !
+ ! (2) 'sten' by 'slten', and !
+ ! (3) 'qlten = qiten = 0' !
+ ! !
+ ! II. Apply 'positive_moisture' !
+ ! !
+ ! ------------------------------------------------------------ !
+
+ if( (eddy_scheme .eq. 'diag_TKE' .or. eddy_scheme .eq. 'SPCAM_m2005') .and. do_pseudocon_diff ) then
+
+ ptend%q(:ncol,:pver,1) = qtten(:ncol,:pver)
+ ptend%s(:ncol,:pver) = slten(:ncol,:pver)
+ ptend%q(:ncol,:pver,ixcldliq) = 0._r8
+ ptend%q(:ncol,:pver,ixcldice) = 0._r8
+ if (ixnumliq > 0) ptend%q(:ncol,:pver,ixnumliq) = 0._r8
+ if (ixnumice > 0) ptend%q(:ncol,:pver,ixnumice) = 0._r8
+
+ do i = 1, ncol
+ do k = 1, pver
+ qv_pro(i,k) = state%q(i,k,1) + ptend%q(i,k,1) * ztodt
+ ql_pro(i,k) = state%q(i,k,ixcldliq) + ptend%q(i,k,ixcldliq) * ztodt
+ qi_pro(i,k) = state%q(i,k,ixcldice) + ptend%q(i,k,ixcldice) * ztodt
+ s_pro(i,k) = state%s(i,k) + ptend%s(i,k) * ztodt
+ t_pro(i,k) = state%t(i,k) + (1._r8/cpair)*ptend%s(i,k) * ztodt
+ end do
+ end do
+
+ call positive_moisture( cpair, latvap, latvap+latice, ncol, pver, ztodt, qmin(1), qmin(ixcldliq), qmin(ixcldice), &
+ state%pdel(:ncol,pver:1:-1), qv_pro(:ncol,pver:1:-1), ql_pro(:ncol,pver:1:-1), &
+ qi_pro(:ncol,pver:1:-1), t_pro(:ncol,pver:1:-1), s_pro(:ncol,pver:1:-1), &
+ ptend%q(:ncol,pver:1:-1,1), ptend%q(:ncol,pver:1:-1,ixcldliq), &
+ ptend%q(:ncol,pver:1:-1,ixcldice), ptend%s(:ncol,pver:1:-1) )
+
+ end if
+
+ ! ----------------------------------------------------------------- !
+ ! Re-calculate diagnostic output variables after vertical diffusion !
+ ! ----------------------------------------------------------------- !
+
+ if (.not. do_pbl_diags) then
+
+ qv_aft_PBL(:ncol,:pver) = state%q(:ncol,:pver,1) + ptend%q(:ncol,:pver,1) * ztodt
+ ql_aft_PBL(:ncol,:pver) = state%q(:ncol,:pver,ixcldliq) + ptend%q(:ncol,:pver,ixcldliq) * ztodt
+ qi_aft_PBL(:ncol,:pver) = state%q(:ncol,:pver,ixcldice) + ptend%q(:ncol,:pver,ixcldice) * ztodt
+ s_aft_PBL(:ncol,:pver) = state%s(:ncol,:pver) + ptend%s(:ncol,:pver) * ztodt
+ t_aftPBL(:ncol,:pver) = ( s_aft_PBL(:ncol,:pver) - gravit*state%zm(:ncol,:pver) ) / cpair
+
+ u_aft_PBL(:ncol,:pver) = state%u(:ncol,:pver) + ptend%u(:ncol,:pver) * ztodt
+ v_aft_PBL(:ncol,:pver) = state%v(:ncol,:pver) + ptend%v(:ncol,:pver) * ztodt
+
+ call qsat(t_aftPBL(:ncol,:pver), state%pmid(:ncol,:pver), &
+ tem2(:ncol,:pver), ftem(:ncol,:pver))
+ ftem_aftPBL(:ncol,:pver) = qv_aft_PBL(:ncol,:pver) / ftem(:ncol,:pver) * 100._r8
+
+ tten(:ncol,:pver) = ( t_aftPBL(:ncol,:pver) - state%t(:ncol,:pver) ) * rztodt
+ rhten(:ncol,:pver) = ( ftem_aftPBL(:ncol,:pver) - ftem_prePBL(:ncol,:pver) ) * rztodt
+
+ end if
+
+ ! -------------------------------------------------------------- !
+ ! mass conservation check.........
+ ! -------------------------------------------------------------- !
+ if (diff_cnsrv_mass_check) then
+
+ ! Conservation check
+ do m = 1, pcnst
+ fixed_ubc: if ((.not.cnst_fixed_ubc(m)).and.(.not.cnst_fixed_ubflx(m))) then
+ col_loop: do i = 1, ncol
+ sum1 = 0._r8
+ sum2 = 0._r8
+ sum3 = 0._r8
+ do k = 1, pver
+ if(cnst_get_type_byind(m).eq.'wet') then
+ pdelx = state%pdel(i,k)
+ else
+ pdelx = state%pdeldry(i,k)
+ endif
+ sum1 = sum1 + state%q(i,k,m)*pdelx/gravit ! total column
+ sum2 = sum2 +(state%q(i,k,m)+ptend%q(i,k,m)*ztodt)*pdelx/ gravit ! total column after tendancy is applied
+ sum3 = sum3 +( ptend%q(i,k,m)*ztodt)*pdelx/ gravit ! rate of change in column
+ enddo
+ sum1 = sum1 + (cam_in%cflx(i,m) * ztodt) ! add in surface flux (kg/m2)
+ sflx = (cam_in%cflx(i,m) * ztodt)
+ if (sum1>1.e-36_r8) then
+ if( abs((sum2-sum1)/sum1) .gt. 1.e-12_r8 ) then
+ nstep = get_nstep()
+ write(iulog,'(a,a8,a,I4,2f8.3,5e25.16)') &
+ 'MASSCHECK vert diff : nstep,lon,lat,mass1,mass2,sum3,sflx,rel-diff : ', &
+ trim(cnst_name(m)), ' : ', nstep, state%lon(i)*180._r8/pi, state%lat(i)*180._r8/pi, &
+ sum1, sum2, sum3, sflx, abs(sum2-sum1)/sum1
+ call endrun('vertical_diffusion_tend : mass not conserved' )
+ endif
+ endif
+ enddo col_loop
+ endif fixed_ubc
+ enddo
+ endif
+
+ ! -------------------------------------------------------------- !
+ ! Writing state variables after PBL scheme for detailed analysis !
+ ! -------------------------------------------------------------- !
+
+ if (.not. do_pbl_diags) then
+
+ call outfld( 'sl_aft_PBL' , sl, pcols, lchnk )
+ call outfld( 'qt_aft_PBL' , qt, pcols, lchnk )
+ call outfld( 'slv_aft_PBL' , slv, pcols, lchnk )
+ call outfld( 'u_aft_PBL' , u_aft_PBL, pcols, lchnk )
+ call outfld( 'v_aft_PBL' , v_aft_PBL, pcols, lchnk )
+ call outfld( 'qv_aft_PBL' , qv_aft_PBL, pcols, lchnk )
+ call outfld( 'ql_aft_PBL' , ql_aft_PBL, pcols, lchnk )
+ call outfld( 'qi_aft_PBL' , qi_aft_PBL, pcols, lchnk )
+ call outfld( 't_aft_PBL ' , t_aftPBL, pcols, lchnk )
+ call outfld( 'rh_aft_PBL' , ftem_aftPBL, pcols, lchnk )
+ call outfld( 'slflx_PBL' , slflx, pcols, lchnk )
+ call outfld( 'qtflx_PBL' , qtflx, pcols, lchnk )
+ call outfld( 'uflx_PBL' , uflx, pcols, lchnk )
+ call outfld( 'vflx_PBL' , vflx, pcols, lchnk )
+ call outfld( 'slflx_cg_PBL' , slflx_cg, pcols, lchnk )
+ call outfld( 'qtflx_cg_PBL' , qtflx_cg, pcols, lchnk )
+ call outfld( 'uflx_cg_PBL' , uflx_cg, pcols, lchnk )
+ call outfld( 'vflx_cg_PBL' , vflx_cg, pcols, lchnk )
+ call outfld( 'slten_PBL' , slten, pcols, lchnk )
+ call outfld( 'qtten_PBL' , qtten, pcols, lchnk )
+ call outfld( 'uten_PBL' , ptend%u(:ncol,:), pcols, lchnk )
+ call outfld( 'vten_PBL' , ptend%v(:ncol,:), pcols, lchnk )
+ call outfld( 'qvten_PBL' , ptend%q(:ncol,:,1), pcols, lchnk )
+ call outfld( 'qlten_PBL' , ptend%q(:ncol,:,ixcldliq), pcols, lchnk )
+ call outfld( 'qiten_PBL' , ptend%q(:ncol,:,ixcldice), pcols, lchnk )
+ call outfld( 'tten_PBL' , tten, pcols, lchnk )
+ call outfld( 'rhten_PBL' , rhten, pcols, lchnk )
+
+ end if
+
+ ! ------------------------------------------- !
+ ! Writing the other standard output variables !
+ ! ------------------------------------------- !
+
+ if (.not. do_pbl_diags) then
+ call outfld( 'QT' , qt, pcols, lchnk )
+ call outfld( 'SL' , sl, pcols, lchnk )
+ call outfld( 'SLV' , slv, pcols, lchnk )
+ call outfld( 'SLFLX' , slflx, pcols, lchnk )
+ call outfld( 'QTFLX' , qtflx, pcols, lchnk )
+ call outfld( 'UFLX' , uflx, pcols, lchnk )
+ call outfld( 'VFLX' , vflx, pcols, lchnk )
+ call outfld( 'TKE' , tke, pcols, lchnk )
+
+ call outfld( 'PBLH' , pblh, pcols, lchnk )
+ call outfld( 'TPERT' , tpert, pcols, lchnk )
+ call outfld( 'QPERT' , qpert, pcols, lchnk )
+ end if
+ call outfld( 'USTAR' , ustar, pcols, lchnk )
+ call outfld( 'KVH' , kvh, pcols, lchnk )
+ call outfld( 'KVT' , kvt, pcols, lchnk )
+ call outfld( 'KVM' , kvm, pcols, lchnk )
+ call outfld( 'CGS' , cgs, pcols, lchnk )
+ dtk(:ncol,:) = dtk(:ncol,:) / cpair ! Normalize heating for history
+ call outfld( 'DTVKE' , dtk, pcols, lchnk )
+ dtk(:ncol,:) = ptend%s(:ncol,:) / cpair ! Normalize heating for history using dtk
+ call outfld( 'DTV' , dtk, pcols, lchnk )
+ call outfld( 'DUV' , ptend%u, pcols, lchnk )
+ call outfld( 'DVV' , ptend%v, pcols, lchnk )
+ do m = 1, pcnst
+ call outfld( vdiffnam(m) , ptend%q(1,1,m), pcols, lchnk )
+ end do
+ if( do_molec_diff ) then
+ call outfld( 'TTPXMLC' , topflx, pcols, lchnk )
+ end if
+
+ call p%finalize()
+ call p_dry%finalize()
+
+end subroutine vertical_diffusion_tend
+
+! =============================================================================== !
+! !
+! =============================================================================== !
+
+subroutine positive_moisture( cp, xlv, xls, ncol, mkx, dt, qvmin, qlmin, qimin, &
+ dp, qv, ql, qi, t, s, qvten, qlten, qiten, sten )
+ ! ------------------------------------------------------------------------------- !
+ ! If any 'ql < qlmin, qi < qimin, qv < qvmin' are developed in any layer, !
+ ! force them to be larger than minimum value by (1) condensating water vapor !
+ ! into liquid or ice, and (2) by transporting water vapor from the very lower !
+ ! layer. '2._r8' is multiplied to the minimum values for safety. !
+ ! Update final state variables and tendencies associated with this correction. !
+ ! If any condensation happens, update (s,t) too. !
+ ! Note that (qv,ql,qi,t,s) are final state variables after applying corresponding !
+ ! input tendencies. !
+ ! Be careful the order of k : '1': near-surface layer, 'mkx' : top layer !
+ ! ------------------------------------------------------------------------------- !
+ implicit none
+ integer, intent(in) :: ncol, mkx
+ real(r8), intent(in) :: cp, xlv, xls
+ real(r8), intent(in) :: dt, qvmin, qlmin, qimin
+ real(r8), intent(in) :: dp(ncol,mkx)
+ real(r8), intent(inout) :: qv(ncol,mkx), ql(ncol,mkx), qi(ncol,mkx), t(ncol,mkx), s(ncol,mkx)
+ real(r8), intent(inout) :: qvten(ncol,mkx), qlten(ncol,mkx), qiten(ncol,mkx), sten(ncol,mkx)
+ integer i, k
+ real(r8) dql, dqi, dqv, sum, aa, dum
+
+ ! Modification : I should check whether this is exactly same as the one used in
+ ! shallow convection and cloud macrophysics.
+
+ do i = 1, ncol
+ do k = mkx, 1, -1 ! From the top to the 1st (lowest) layer from the surface
+ dql = max(0._r8,1._r8*qlmin-ql(i,k))
+ dqi = max(0._r8,1._r8*qimin-qi(i,k))
+ qlten(i,k) = qlten(i,k) + dql/dt
+ qiten(i,k) = qiten(i,k) + dqi/dt
+ qvten(i,k) = qvten(i,k) - (dql+dqi)/dt
+ sten(i,k) = sten(i,k) + xlv * (dql/dt) + xls * (dqi/dt)
+ ql(i,k) = ql(i,k) + dql
+ qi(i,k) = qi(i,k) + dqi
+ qv(i,k) = qv(i,k) - dql - dqi
+ s(i,k) = s(i,k) + xlv * dql + xls * dqi
+ t(i,k) = t(i,k) + (xlv * dql + xls * dqi)/cp
+ dqv = max(0._r8,1._r8*qvmin-qv(i,k))
+ qvten(i,k) = qvten(i,k) + dqv/dt
+ qv(i,k) = qv(i,k) + dqv
+ if( k .ne. 1 ) then
+ qv(i,k-1) = qv(i,k-1) - dqv*dp(i,k)/dp(i,k-1)
+ qvten(i,k-1) = qvten(i,k-1) - dqv*dp(i,k)/dp(i,k-1)/dt
+ endif
+ qv(i,k) = max(qv(i,k),qvmin)
+ ql(i,k) = max(ql(i,k),qlmin)
+ qi(i,k) = max(qi(i,k),qimin)
+ end do
+ ! Extra moisture used to satisfy 'qv(i,1)=qvmin' is proportionally
+ ! extracted from all the layers that has 'qv > 2*qvmin'. This fully
+ ! preserves column moisture.
+ if( dqv .gt. 1.e-20_r8 ) then
+ sum = 0._r8
+ do k = 1, mkx
+ if( qv(i,k) .gt. 2._r8*qvmin ) sum = sum + qv(i,k)*dp(i,k)
+ enddo
+ aa = dqv*dp(i,1)/max(1.e-20_r8,sum)
+ if( aa .lt. 0.5_r8 ) then
+ do k = 1, mkx
+ if( qv(i,k) .gt. 2._r8*qvmin ) then
+ dum = aa*qv(i,k)
+ qv(i,k) = qv(i,k) - dum
+ qvten(i,k) = qvten(i,k) - dum/dt
+ endif
+ enddo
+ else
+ write(iulog,*) 'Full positive_moisture is impossible in vertical_diffusion'
+ endif
+ endif
+ end do
+ return
+
+end subroutine positive_moisture
+
+end module vertical_diffusion
diff --git a/src/physics/cam_oslo/aero_to_srf.F90 b/src/physics/cam_oslo/aero_to_srf.F90
new file mode 100644
index 0000000000..4dee8566e2
--- /dev/null
+++ b/src/physics/cam_oslo/aero_to_srf.F90
@@ -0,0 +1,332 @@
+module aero_to_srf
+
+!------------------------------------------------------------------------------------------------
+! Purpose:
+!
+! Partition the contributions from modal components of wet and dry
+! deposition at the surface into the fields passed to the coupler.
+!
+! *** N.B. *** Currently only a simple scheme for the 3-mode version
+! of MAM has been implemented.
+!
+! Revision history:
+! Feb 2009 M. Flanner, B. Eaton Original version for trop_mam3.
+! Sept 2009 � Seland Modified to CAM-Oslo aerosol physics.
+! The initialisation part is not used at present time.
+!------------------------------------------------------------------------------------------------
+
+#include
+
+use shr_kind_mod, only: r8 => shr_kind_r8
+use camsrfexch, only: cam_out_t
+use constituents, only: pcnst, cnst_get_ind
+use ppgrid, only: pcols
+use aerosoldef
+implicit none
+private
+save
+
+public :: &
+ modal_aero_deposition_init, &
+ set_srf_drydep, &
+ set_srf_wetdep
+
+! Private module data
+integer :: idx_bc1 = -1
+integer :: idx_pom1 = -1
+integer :: idx_soa1 = -1
+integer :: idx_soa2 = -1
+integer :: idx_dst1 = -1
+integer :: idx_dst3 = -1
+integer :: idx_ncl3 = -1
+integer :: idx_so43 = -1
+integer :: idx_num3 = -1
+
+!==============================================================================
+contains
+!==============================================================================
+
+subroutine modal_aero_deposition_init()
+
+! set aerosol indices for re-mapping surface deposition fluxes:
+! *_a1 = accumulation mode
+! *_a2 = aitken mode
+! *_a3 = coarse mode
+
+ ! Currently only trop_mam3 scheme is implemented.
+#ifndef MODAL_AERO_3MODE
+ return
+#endif
+
+ call cnst_get_ind('bc_a1', idx_bc1)
+ call cnst_get_ind('pom_a1', idx_pom1)
+ call cnst_get_ind('soa_a1', idx_soa1)
+ call cnst_get_ind('soa_a2', idx_soa2)
+ call cnst_get_ind('dst_a1', idx_dst1)
+ call cnst_get_ind('dst_a3', idx_dst3)
+ call cnst_get_ind('ncl_a3', idx_ncl3)
+ call cnst_get_ind('so4_a3', idx_so43)
+ call cnst_get_ind('num_a3', idx_num3)
+
+end subroutine modal_aero_deposition_init
+
+!==============================================================================
+subroutine set_srf_wetdep(wetdepflx, cam_out)
+
+! Set surface wet deposition fluxes passed to coupler.
+
+ ! Arguments:
+!Does not differentiate between different wet scavenging processes
+! real(r8), intent(in) :: aerdepwetis(pcols,pcnst)
+! aerosol wet deposition (interstitial)
+! aerosol wet deposition (cloud water)
+ real(r8), intent(in) :: wetdepflx(pcols,pcnst)
+
+ type(cam_out_t), intent(inout) :: cam_out ! cam export state
+
+ ! Local variables:
+ integer :: i
+ integer :: ncol ! number of columns
+!cak
+! Mass fractions of deposited sea-salt modes a2 and a3 which belong to size bins 1-4.
+! Particle diameters < 0.1 um and > 20 um are not included (size bins are defined w.r.t.
+! particle diameters, confirmed by Mark Flanner)
+real(r8), parameter :: fdst1a2 = 5.55e-1_r8
+real(r8), parameter :: fdst2a2 = 4.29e-1_r8
+real(r8), parameter :: fdst3a2 = 1.59e-2_r8
+real(r8), parameter :: fdst4a2 = 1.32e-4_r8
+real(r8), parameter :: fdst1a3 = 4.84e-3_r8
+real(r8), parameter :: fdst2a3 = 1.01e-1_r8
+real(r8), parameter :: fdst3a3 = 2.96e-1_r8
+real(r8), parameter :: fdst4a3 = 5.99e-1_r8
+!with cut-off at 10 um (not recommended by Mark Flanner) as for the optics calculations:
+!real(r8), parameter :: fdst4a3 = 3.73e-1_r8
+!cak
+ !----------------------------------------------------------------------------
+
+ ! Currently only trop_mam3 scheme is implemented.
+ ! CAM_OSLO added
+#ifdef AEROFFL
+ return
+#endif
+
+ ncol = cam_out%ncol
+
+ ! derive cam_out variables from deposition fluxes
+ ! note: wet deposition fluxes are negative into surface,
+ ! dry deposition fluxes are positive into surface.
+ ! CLM wants positive definite fluxes.
+! OS Only bcphi and dst1 is used
+ do i = 1, ncol
+ ! black carbon fluxes
+ cam_out%bcphiwet(i) = - (wetdepflx(i,l_bc_n)+wetdepflx(i,l_bc_ax) &
+ +wetdepflx(i,l_bc_ni)+wetdepflx(i,l_bc_a) &
+ +wetdepflx(i,l_bc_ai)+wetdepflx(i,l_bc_ac))
+!(aerdepwetis(i,idx_bc1)+aerdepwetcw(i,idx_bc1))
+
+ ! organic carbon fluxes
+! cam_out%ocphiwet(i) = -(aerdepwetis(i,idx_pom1)+aerdepwetis(i,idx_soa1)+aerdepwetcw(i,idx_pom1)+aerdepwetcw(i,idx_soa1))
+!cak_temp
+ cam_out%ocphiwet(i) = 0._r8
+! cam_out%ocphiwet(i) = 1.e-20_r8
+!cak_temp
+
+ ! dust fluxes
+ !
+ ! bulk bin1 (fine) dust deposition equals accumulation mode deposition:
+! os All dust aerosols
+!cak cam_out%dstwet1(i) = -(wetdepflx(i,l_dst_a2)+wetdepflx(i,l_dst_a3))
+ cam_out%dstwet1(i) = -(fdst1a2*wetdepflx(i,l_dst_a2)+fdst1a3*wetdepflx(i,l_dst_a3))
+!cak
+
+!(aerdepwetis(i,idx_dst1)+aerdepwetcw(i,idx_dst1))
+
+! ! A. Simple: Assign all coarse-mode dust to bulk size bin 3:
+! cam_out%dstwet2(i) = 0._r8
+! cam_out%dstwet3(i) = -(aerdepwetis(i,idx_dst3)+aerdepwetcw(i,idx_dst3))
+! cam_out%dstwet4(i) = 0._r8
+
+ ! in rare cases, integrated deposition tendency is upward
+ if (cam_out%bcphiwet(i) .lt. 0._r8) cam_out%bcphiwet(i) = 0._r8
+!t2 if (cam_out%bcphiwet(i) .lt. 0._r8) cam_out%bcphiwet(i) = 1.e-20_r8
+! if (cam_out%bcphiwet(i) .le. 0._r8) cam_out%bcphiwet(i) = 1.e-20_r8
+!feil if (cam_out%dstwet3(i) .lt. 0._r8) cam_out%dstwet3(i) = 0._r8
+ if (cam_out%dstwet1(i) .lt. 0._r8) cam_out%dstwet1(i) = 0._r8
+!t2 if (cam_out%dstwet1(i) .lt. 0._r8) cam_out%dstwet1(i) = 1.e-20_r8
+! if (cam_out%dstwet1(i) .le. 0._r8) cam_out%dstwet1(i) = 1.e-20_r8
+!cak_temp
+ cam_out%dstwet2(i) = -(fdst2a2*wetdepflx(i,l_dst_a2)+fdst2a3*wetdepflx(i,l_dst_a3))
+ cam_out%dstwet3(i) = -(fdst3a2*wetdepflx(i,l_dst_a2)+fdst3a3*wetdepflx(i,l_dst_a3))
+ cam_out%dstwet4(i) = -(fdst4a2*wetdepflx(i,l_dst_a2)+fdst4a3*wetdepflx(i,l_dst_a3))
+ if (cam_out%dstwet2(i).lt.0._r8) cam_out%dstwet2(i) = 0._r8
+ if (cam_out%dstwet3(i).lt.0._r8) cam_out%dstwet3(i) = 0._r8
+ if (cam_out%dstwet4(i).lt.0._r8) cam_out%dstwet4(i) = 0._r8
+!t2 if (cam_out%dstwet2(i).lt.0._r8) cam_out%dstwet2(i) = 1.e-20_r8
+!t2 if (cam_out%dstwet3(i).lt.0._r8) cam_out%dstwet3(i) = 1.e-20_r8
+!t2 if (cam_out%dstwet4(i).lt.0._r8) cam_out%dstwet4(i) = 1.e-20_r8
+! if (cam_out%dstwet2(i).le.0._r8) cam_out%dstwet2(i) = 1.e-20_r8
+! if (cam_out%dstwet3(i).le.0._r8) cam_out%dstwet3(i) = 1.e-20_r8
+! if (cam_out%dstwet4(i).le.0._r8) cam_out%dstwet4(i) = 1.e-20_r8
+!cak_temp
+
+!cak_0
+! cam_out%bcphiwet(i) = 1.e-20_r8
+! cam_out%ocphiwet(i) = 1.e-20_r8
+! cam_out%dstwet1(i) = 1.e-20_r8
+! cam_out%dstwet2(i) = 1.e-20_r8
+! cam_out%dstwet3(i) = 1.e-20_r8
+! cam_out%dstwet4(i) = 1.e-20_r8
+! cam_out%bcphiwet(i) = 1.e-7_r8 ! TEST !!!
+! cam_out%dstwet1(i) = 1.e-11_r8
+! cam_out%dstwet2(i) = 1.e-10_r8
+! cam_out%dstwet3(i) = 1.e-09_r8
+! cam_out%dstwet4(i) = 1.e-08_r8
+! if(i==ncol) then
+! write(*,*) 'bcphiwet = ', cam_out%bcphiwet(i)
+! write(*,*) 'dstwet1 = ', cam_out%dstwet1(i)
+! write(*,*) 'dstwet2 = ', cam_out%dstwet2(i)
+! write(*,*) 'dstwet3 = ', cam_out%dstwet3(i)
+! write(*,*) 'dstwet4 = ', cam_out%dstwet4(i)
+! endif
+!cak_0
+
+ enddo
+
+end subroutine set_srf_wetdep
+
+!==============================================================================
+
+subroutine set_srf_drydep(sflx, cam_out)
+
+! Set surface dry deposition fluxes passed to coupler.
+
+ ! Arguments:
+ real(r8), intent(in) :: sflx(pcols,pcnst) ! aerosol dry deposition (interstitial)
+ type(cam_out_t), intent(inout) :: cam_out ! cam export state
+
+ ! Local variables:
+ integer :: i
+ integer :: ncol ! number of columns
+!cak
+! Mass fractions of deposited sea-salt modes a2 and a3 which belong to size bins 1-4.
+! Particle diameters < 0.1 um and > 20 um are not included (size bins are defined w.r.t.
+! particle diameters, confirmed by Mark Flanner)
+real(r8), parameter :: fdst1a2 = 5.55e-1_r8
+real(r8), parameter :: fdst2a2 = 4.29e-1_r8
+real(r8), parameter :: fdst3a2 = 1.59e-2_r8
+real(r8), parameter :: fdst4a2 = 1.32e-4_r8
+real(r8), parameter :: fdst1a3 = 4.84e-3_r8
+real(r8), parameter :: fdst2a3 = 1.01e-1_r8
+real(r8), parameter :: fdst3a3 = 2.96e-1_r8
+real(r8), parameter :: fdst4a3 = 5.99e-1_r8
+!with cut-off at 10 um (not recommended by Mark Flanner) as for the optics calculations:
+!real(r8), parameter :: fdst4a3 = 3.73e-1_r8
+!cak
+ !----------------------------------------------------------------------------
+
+!cak write(*,*) 'test dry 1'
+
+ ! Currently only trop_mam3 scheme is implemented.
+#ifdef AEROFFL
+ return
+#endif
+
+!cak write(*,*) 'test dry 2'
+
+ ncol = cam_out%ncol
+
+ ! derive cam_out variables from deposition fluxes
+ ! note: wet deposition fluxes are negative into surface,
+ ! dry deposition fluxes are positive into surface.
+ ! CLM wants positive definite fluxes.
+!cak: all cam_out fluxes are positive definite here...
+ do i = 1, ncol
+ ! black carbon fluxes
+!cak_old cam_out%bcphidry(i) = -(sflx(i,l_bc_n)+sflx(i,l_bc_ax) &
+!cak_old + sflx(i,l_bc_ni)+sflx(i,l_bc_a)+sflx(i,l_bc_ai)+sflx(i,l_bc_ac))
+ cam_out%bcphidry(i) = -(sflx(i,l_bc_ni)+sflx(i,l_bc_a)+sflx(i,l_bc_ai)+sflx(i,l_bc_ac))
+!cak_temp
+ cam_out%bcphodry(i) = -(sflx(i,l_bc_n)+sflx(i,l_bc_ax))
+!cak_old cam_out%bcphodry(i) = 0._r8
+! cam_out%bcphodry(i) = 1.e-20_r8
+!cak_temp
+
+ ! organic carbon fluxes
+! cam_out%ocphidry(i) = aerdepdryis(i,idx_pom1)+aerdepdryis(i,idx_soa1)+aer!depdrycw(i,idx_pom1)+aerdepdrycw(i,idx_soa1)
+! cam_out%ocphodry(i) = aerdepdryis(i,idx_soa2)+aerdepdrycw(i,idx_soa2)
+!cak_temp
+ cam_out%ocphidry(i) = 0._r8
+ cam_out%ocphodry(i) = 0._r8
+! cam_out%ocphidry(i) = 1.e-20_r8
+! cam_out%ocphodry(i) = 1.e-20_r8
+!cak_temp
+
+ ! dust fluxes
+ !
+ ! bulk bin1 (fine) dust deposition equals accumulation mode deposition:
+!cak cam_out%dstdry1(i) = -(sflx(i,l_dst_a2)+sflx(i,l_dst_a3))
+ cam_out%dstdry1(i) = -(fdst1a2*sflx(i,l_dst_a2)+fdst1a3*sflx(i,l_dst_a3))
+!cak
+!aerdepdryis(i,idx_dst1)+aerdepdrycw(i,idx_dst1)
+
+ ! Two options for partitioning deposition into bins 2-4:
+ ! A. Simple: Assign all coarse-mode dust to bulk size bin 3:
+! cam_out%dstdry2(i) = 0._r8
+! cam_out%dstdry3(i) = aerdepdryis(i,idx_dst3)+aerdepdrycw(i,idx_dst3)
+! cam_out%dstdry4(i) = 0._r8
+
+ ! in rare cases, integrated deposition tendency is upward
+ if (cam_out%bcphidry(i) .lt. 0._r8) cam_out%bcphidry(i) = 0._r8
+!t2 if (cam_out%bcphidry(i) .lt. 0._r8) cam_out%bcphidry(i) = 1.e-20_r8
+! if (cam_out%bcphidry(i) .le. 0._r8) cam_out%bcphidry(i) = 1.e-20_r8
+ if (cam_out%dstdry1(i) .lt. 0._r8) cam_out%dstdry1(i) = 0._r8
+!t2 if (cam_out%dstdry1(i) .lt. 0._r8) cam_out%dstdry1(i) = 1.e-20_r8
+! if (cam_out%dstdry1(i) .le. 0._r8) cam_out%dstdry1(i) = 1.e-20_r8
+!cak_temp
+! cam_out%dstdry2(i) = 0._r8
+! cam_out%dstdry3(i) = 0._r8
+! cam_out%dstdry4(i) = 0._r8
+ cam_out%dstdry2(i) = -(fdst2a2*sflx(i,l_dst_a2)+fdst2a3*sflx(i,l_dst_a3))
+ cam_out%dstdry3(i) = -(fdst3a2*sflx(i,l_dst_a2)+fdst3a3*sflx(i,l_dst_a3))
+ cam_out%dstdry4(i) = -(fdst4a2*sflx(i,l_dst_a2)+fdst4a3*sflx(i,l_dst_a3))
+ if (cam_out%dstdry2(i).lt.0._r8) cam_out%dstdry2(i) = 0._r8
+ if (cam_out%dstdry3(i).lt.0._r8) cam_out%dstdry3(i) = 0._r8
+ if (cam_out%dstdry4(i).lt.0._r8) cam_out%dstdry4(i) = 0._r8
+!t2 if (cam_out%dstdry2(i).lt.0._r8) cam_out%dstdry2(i) = 1.e-20_r8
+!t2 if (cam_out%dstdry3(i).lt.0._r8) cam_out%dstdry3(i) = 1.e-20_r8
+!t2 if (cam_out%dstdry4(i).lt.0._r8) cam_out%dstdry4(i) = 1.e-20_r8
+! if (cam_out%dstdry2(i).le.0._r8) cam_out%dstdry2(i) = 1.e-20_r8
+! if (cam_out%dstdry3(i).le.0._r8) cam_out%dstdry3(i) = 1.e-20_r8
+! if (cam_out%dstdry4(i).le.0._r8) cam_out%dstdry4(i) = 1.e-20_r8
+!cak_temp
+
+!cak_0
+! cam_out%bcphidry(i) = 1.e-20_r8
+! cam_out%bcphodry(i) = 1.e-20_r8
+! cam_out%ocphidry(i) = 1.e-20_r8
+! cam_out%ocphodry(i) = 1.e-20_r8
+! cam_out%dstdry1(i) = 1.e-20_r8
+! cam_out%dstdry2(i) = 1.e-20_r8
+! cam_out%dstdry3(i) = 1.e-20_r8
+! cam_out%dstdry4(i) = 1.e-20_r8
+! cam_out%bcphidry(i) = 1.e-7_r8 ! TEST !!!
+! cam_out%dstdry1(i) = 1.e-11_r8
+! cam_out%dstdry2(i) = 1.e-10_r8
+! cam_out%dstdry3(i) = 1.e-09_r8
+! cam_out%dstdry4(i) = 1.e-08_r8
+! if(i==ncol) then
+! write(*,*) 'bcphidry = ', cam_out%bcphidry(i)
+! write(*,*) 'dstdry1 = ', cam_out%dstdry1(i)
+! write(*,*) 'dstdry2 = ', cam_out%dstdry2(i)
+! write(*,*) 'dstdry3 = ', cam_out%dstdry3(i)
+! write(*,*) 'dstdry4 = ', cam_out%dstdry4(i)
+! endif
+!cak_0
+
+ enddo
+
+end subroutine set_srf_drydep
+
+!==============================================================================
+
+end module aero_to_srf
diff --git a/src/physics/cam_oslo/aerocopt.h b/src/physics/cam_oslo/aerocopt.h
new file mode 100644
index 0000000000..bc48cfbe37
--- /dev/null
+++ b/src/physics/cam_oslo/aerocopt.h
@@ -0,0 +1,8 @@
+! For subroutines initaeropt and intaeropt1to3,4,6to10:
+
+ common /aerocopt1/ bep1, bep2to3, bep4, bep5to10
+
+ real(r8) bep1(38,10,6,16,6)
+ real(r8) bep2to3(38,10,16,6,2:3)
+ real(r8) bep4(38,10,6,16,6,6)
+ real(r8) bep5to10(38,10,6,6,6,6,5:10)
diff --git a/src/physics/cam_oslo/aerocopt2.h b/src/physics/cam_oslo/aerocopt2.h
new file mode 100644
index 0000000000..7272b9e2d0
--- /dev/null
+++ b/src/physics/cam_oslo/aerocopt2.h
@@ -0,0 +1,9 @@
+! For subroutines initaeropt and intaeropt0:
+
+ common /aerocopt2/ bex440, bax440, bex500, bax500, bax550, &
+ bex670, bax670, bex870, bax870, &
+ bex550lt1, bex550gt1, backscx550
+
+ real(r8) bex440, bax440, bex500, bax500, bax550, &
+ bex670, bax670, bex870, bax870, &
+ bex550lt1, bex550gt1, backscx550
diff --git a/src/physics/cam_oslo/aerodry.h b/src/physics/cam_oslo/aerodry.h
new file mode 100644
index 0000000000..03ca519713
--- /dev/null
+++ b/src/physics/cam_oslo/aerodry.h
@@ -0,0 +1,13 @@
+! For subroutine initdryp and intdrypar:
+
+ common /dryarr1/ &
+ a0cintbg, a0cintbg05, a0cintbg125, &
+ a0aaeros, a0aaerol, a0vaeros, a0vaerol, &
+ a1var, a2to3var, a4var, a5to10var
+
+ real(r8) a0cintbg, a0cintbg05, a0cintbg125, &
+ a0aaeros, a0aaerol, a0vaeros, a0vaerol
+ real(r8) a1var(19,6,16,6)
+ real(r8) a2to3var(19,16,6,2:3)
+ real(r8) a4var(19,6,16,6,6)
+ real(r8) a5to10var(19,6,6,6,6,5:10)
diff --git a/src/physics/cam_oslo/checkTableHeader.F90 b/src/physics/cam_oslo/checkTableHeader.F90
new file mode 100644
index 0000000000..20a8f3615a
--- /dev/null
+++ b/src/physics/cam_oslo/checkTableHeader.F90
@@ -0,0 +1,25 @@
+
+ subroutine checkTableHeader (ifil)
+
+! This subroutine reads the header-text in a look-up table (in file with iu=ifil).
+! Later: use it to also check AeroTab - CAM5-Oslo consistency w.r.t. assumed modal
+! radii, mass densities, etc...
+
+ integer, intent(in) :: ifil
+ character*80 headertext
+ character*12 text0, text1
+
+
+ text0='X-CHECK LUT'
+ text1='none '
+ do while (text1(2:12).ne.text0(2:12))
+ read(ifil,1000) headertext
+ text1=headertext(2:12)
+! write(*,*) 'text0, text1 =', text0, text1
+ enddo
+
+
+ 1000 format(A)
+
+ return
+ end subroutine checkTableHeader
\ No newline at end of file
diff --git a/src/physics/cam_oslo/coltst4intcons.F90 b/src/physics/cam_oslo/coltst4intcons.F90
new file mode 100644
index 0000000000..e95de3f58a
--- /dev/null
+++ b/src/physics/cam_oslo/coltst4intcons.F90
@@ -0,0 +1,302 @@
+
+subroutine coltst4intcons (lchnk, ncol, qm1, deltah_km, rhoda, fnbc, &
+ dload_mi, dload_ss, dload_s4, dload_oc, dload_bc, &
+ dload_bc_0, dload_bc_2, dload_bc_4, dload_bc_12, dload_bc_14, dload_bc_ac, &
+ dload_oc_4, dload_oc_14, dload_oc_ac, dload_s4_a, dload_s4_1, dload_s4_5)
+
+! Testing column burdens for internal consistency between intdrypar
+! (use of aerodryk*.out look-up tables) and calculations directly
+! from the qm1 array. Made by Alf Kirkevag 8/12-2015.
+
+! Due to a problem with initialization of some values (seemingly),
+! the output variables COLR* (column burden ratio for tracers *)
+! should not be checked for the first output file from an initial run.
+! Initial test results after coorecting a bug in AeroTab October 2016:
+! Results from month 5 in a test simulation with 2000 aerosol emissions
+! and f10_f10 resolution (10x15_10x15) gave the following globally
+! averaged COLR* values:
+!
+! COLRBC0 = 1.000015 ;
+! COLRBC12 = 0.9991855 ;
+! COLRBC14 = 0.9992678 ;
+! COLRBC2 = 0.9991855 ;
+! COLRBC4 = 0.9997123 ;
+! COLRBCAC = 1.000379 ;
+! COLROC14 = 0.9989312 ;
+! COLROC4 = 0.9995964 ;
+! COLROCAC = 0.9993698 ;
+! COLRSUL1 = 1.034586 ;
+! COLRSUL5 = 1.03905 ;
+! COLRSULA = 1.000236 ;
+!
+! with regional variations within 0.01 for all tracers except for the
+! externally mixed tracers so4_na (COLRSUL1 = 1.02 - 1.04) and so4_pr
+! (COLRSUL5 = 1.035 - 1.039). The biases for COLRSUL1 and COLRSUL5 are
+! consistent with a ratio between mass density for sulfuric acid and
+! ammonium sulfate (1841/1769=1.041), and that CAM5-Olso does not take
+! into account the former.
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use constituents, only: pcnst
+ use aerosoldef
+ use cam_history, only: outfld
+
+ implicit none
+
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ real(r8), intent(in) :: qm1(pcols,pver,pcnst) ! Specific humidity and tracers (kg/kg)
+ real(r8), intent(in) :: deltah_km(pcols,pver) ! Layer thickness, unit km
+ real(r8), intent(in) :: rhoda(pcols,pver)
+ real(r8), intent(in) :: fnbc(pcols,pver)
+ real(r8), intent(in) :: dload_mi(pcols)
+ real(r8), intent(in) :: dload_ss(pcols)
+ real(r8), intent(in) :: dload_s4(pcols)
+ real(r8), intent(in) :: dload_oc(pcols)
+ real(r8), intent(in) :: dload_bc(pcols)
+ real(r8), intent(in) :: dload_bc_0(pcols)
+ real(r8), intent(in) :: dload_bc_2(pcols)
+ real(r8), intent(in) :: dload_bc_4(pcols)
+ real(r8), intent(in) :: dload_bc_12(pcols)
+ real(r8), intent(in) :: dload_bc_14(pcols)
+ real(r8), intent(in) :: dload_bc_ac(pcols)
+ real(r8), intent(in) :: dload_oc_4(pcols)
+ real(r8), intent(in) :: dload_oc_14(pcols)
+ real(r8), intent(in) :: dload_oc_ac(pcols)
+ real(r8), intent(in) :: dload_s4_a(pcols)
+ real(r8), intent(in) :: dload_s4_1(pcols)
+ real(r8), intent(in) :: dload_s4_5(pcols)
+!
+!---------------------------Local variables-----------------------------
+!
+ integer icol, k
+ real(r8) columnb(pcols), colratio(pcols)
+! strict test, only expected to apply for some externally mixed modes:
+! real(r8), parameter :: oneplus = 1.003_r8
+! real(r8), parameter :: oneminus = 0.997_r8
+! less strict test, expected to apply for externally mixed modes, except
+! in the first time-steps, seemingly due to problem with initialization:
+ real(r8), parameter :: oneplus = 1.05_r8
+ real(r8), parameter :: oneminus = 0.95_r8
+!
+!
+!---------------------------Test calculations---------------------------
+
+!BC:
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*qm1(icol,k,l_bc_ax)*rhoda(icol,k)
+ colratio(icol) = dload_bc_0(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my bc 0 ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLRBC0 ', colratio, pcols,lchnk)
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*qm1(icol,k,l_bc_a)*rhoda(icol,k)
+ colratio(icol) = dload_bc_2(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my bc 2 ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLRBC2 ', colratio, pcols,lchnk)
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*qm1(icol,k,l_bc_ai)*rhoda(icol,k)
+ colratio(icol) = dload_bc_4(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my bc 4 ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLRBC4 ', colratio, pcols,lchnk)
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*qm1(icol,k,l_bc_n)*rhoda(icol,k)
+ colratio(icol) = dload_bc_12(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my bc 12 ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLRBC12', colratio, pcols,lchnk)
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*qm1(icol,k,l_bc_ni)*rhoda(icol,k)
+ colratio(icol) = dload_bc_14(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my bc 14 ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLRBC14 ', colratio, pcols,lchnk)
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*qm1(icol,k,l_bc_ac)*rhoda(icol,k)
+ colratio(icol) = dload_bc_ac(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my bc ac ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLRBCAC', colratio, pcols,lchnk)
+
+!OC:
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*qm1(icol,k,l_om_ai)*rhoda(icol,k)
+ colratio(icol) = dload_oc_4(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my oc 4 ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLROC4 ', colratio, pcols,lchnk)
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*qm1(icol,k,l_om_ni)*rhoda(icol,k)
+ colratio(icol) = dload_oc_14(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my oc 14 ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLROC14', colratio, pcols,lchnk)
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*(qm1(icol,k,l_om_ac)+qm1(icol,k,l_soa_a1))*rhoda(icol,k)
+ colratio(icol) = dload_oc_ac(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my oc ac and soa a1 ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLROCAC', colratio, pcols,lchnk)
+
+!Sulfate:
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*(qm1(icol,k,l_so4_a1) &
+ + qm1(icol,k,l_so4_a2) &
+ + qm1(icol,k,l_so4_ac))*rhoda(icol,k)
+ colratio(icol) = dload_s4_a(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my sulfate a ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLRSULA', colratio, pcols,lchnk)
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*(qm1(icol,k,l_so4_na))*rhoda(icol,k)
+ colratio(icol) = dload_s4_1(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my sulfate 1 ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLRSUL1', colratio, pcols,lchnk)
+
+ do icol=1,ncol
+ columnb(icol) = 0.0_r8
+ colratio(icol) = 0.0_r8
+ end do
+ do icol=1,ncol
+ do k=1,pver
+ columnb(icol) = columnb(icol)+deltah_km(icol,k) &
+ * 1.e9*(qm1(icol,k,l_so4_pr))*rhoda(icol,k)
+ colratio(icol) = dload_s4_5(icol)/columnb(icol)
+ end do
+! if(colratio(icol).lt.oneminus.or.colratio(icol).gt.oneplus) then
+! write(99,*) 'my sulfate 5 ratio =', icol, colratio(icol)
+! endif
+ end do
+
+ call outfld('COLRSUL5', colratio, pcols,lchnk)
+
+ return
+end subroutine coltst4intcons
diff --git a/src/physics/cam_oslo/initaeropt.F90 b/src/physics/cam_oslo/initaeropt.F90
new file mode 100644
index 0000000000..18be036917
--- /dev/null
+++ b/src/physics/cam_oslo/initaeropt.F90
@@ -0,0 +1,581 @@
+subroutine initaeropt
+
+!Purpose: To read in the AeroCom look-up tables for aerosol optical properties.
+! The grid for discrete input-values in the look-up tables is defined in opptab.
+
+! Tabulating the 'aerocomk'-files to save computing time.
+! Updated for new kcomp1.out including condensed SOA - Alf Kirkevåg, May 2013
+! Extended for new SOA treatment - Alf Kirkevaag, September 2015.
+! Modified for optimized added masses and mass fractions for
+! concentrations from condensation, coagulation or cloud-processing
+! - Alf Kirkevaag, May 2016.
+! Modified for optimized added masses and mass fractions for concentrations from
+! condensation, coagulation or cloud-processing - Alf Kirkevaag, May 2016.
+
+ use oslo_control, only: oslo_getopts, dir_string_length
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use commondefinitions, only: nmodes, nbmodes
+ use opttab, only: cate, cat, fac, faq, fbc, rh, fombg, fbcbg
+ use cam_logfile, only: iulog
+
+ implicit none
+
+#include
+#include
+
+ integer kcomp, irelh, ictot, ifac, ifbc, ifaq
+ integer ifombg, ifbcbg
+ integer ic, ifil, lin, iv
+ real(r8) catot, relh, frombg, frbcbg, frac, fabc, fraq, &
+ bext440, babs440, bext500, babs500, babs550, &
+ bext670, babs670, bext870, babs870, &
+ bebg440, babg440, bebg500, babg500, babg550, &
+ bebg670, babg670, bebg870, babg870, &
+ bebc440, babc440, bebc500, babc500, babc550, &
+ bebc670, babc670, bebc870, babc870, &
+ beoc440, baoc440, beoc500, baoc500, baoc550, &
+ beoc670, baoc670, beoc870, baoc870, &
+ besu440, basu440, besu500, basu500, basu550, &
+ besu670, basu670, besu870, basu870, &
+ bebg550lt1, bebg550gt1, bebc550lt1, bebc550gt1, &
+ beoc550lt1, beoc550gt1, besu550lt1, besu550gt1, &
+ backscat550
+
+ real(r8) :: eps2 = 1.e-2_r8
+ real(r8) :: eps4 = 1.e-4_r8
+ real(r8) :: eps6 = 1.e-6_r8
+ real(r8) :: eps7 = 1.e-7_r8
+
+ character(len=dir_string_length) :: aerotab_table_dir
+
+ call oslo_getopts(aerotab_table_dir_out = aerotab_table_dir)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ open(11,file=trim(aerotab_table_dir)//'/aerocomk2.out' &
+ ,form='formatted',status='old')
+ open(12,file=trim(aerotab_table_dir)//'/aerocomk3.out' &
+ ,form='formatted',status='old')
+ open(13,file=trim(aerotab_table_dir)//'/aerocomk4.out' &
+ ,form='formatted',status='old')
+ open(14,file=trim(aerotab_table_dir)//'/aerocomk5.out' &
+ ,form='formatted',status='old')
+ open(15,file=trim(aerotab_table_dir)//'/aerocomk6.out' &
+ ,form='formatted',status='old')
+ open(16,file=trim(aerotab_table_dir)//'/aerocomk7.out' &
+ ,form='formatted',status='old')
+ open(17,file=trim(aerotab_table_dir)//'/aerocomk8.out' &
+ ,form='formatted',status='old')
+ open(18,file=trim(aerotab_table_dir)//'/aerocomk9.out' &
+ ,form='formatted',status='old')
+ open(19,file=trim(aerotab_table_dir)//'/aerocomk10.out' &
+ ,form='formatted',status='old')
+ open(20,file=trim(aerotab_table_dir)//'/aerocomk0.out' &
+ ,form='formatted',status='old')
+ open(21,file=trim(aerotab_table_dir)//'/aerocomk1.out' &
+ ,form='formatted',status='old')
+
+! Skipping the header-text in all input files (Later: use it to check AeroTab - CAM5-Oslo consistency!)
+ do ifil = 11,21
+ call checkTableHeader (ifil)
+ enddo
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! Mode 0, BC(ax
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ ifil = 11
+
+ read(9+ifil,996) kcomp, relh, &
+ bex440, bax440, bex500, bax500, bax550, bex670, bax670, &
+ bex870, bax870, bex550lt1, bex550gt1, backscx550
+
+ if(bex440<=0.0_r8) then
+ write(*,*) 'bex440 =', bex440
+ write(*,*) 'Error in initialization of bex1'
+ stop
+ endif
+
+ write(iulog,*)'aerocom mode 0 ok'
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! New mode 1 (H2SO4 and SOA + condensate from H2SO4 and SOA)
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ ifil = 1
+ do lin = 1,5760 ! 10x6x16x6
+
+ read(20+ifil,997) kcomp, relh, frombg, catot, frac, &
+ bext440, bext500, bext670, bext870, &
+ bebg440, bebg500, bebg670, bebg870, &
+ bebc440, bebc500, bebc670, bebc870, &
+ beoc440, beoc500, beoc670, beoc870, &
+ besu440, besu500, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebg550lt1, bebg550gt1, bebc550lt1, bebc550gt1, &
+ beoc550lt1, beoc550gt1, besu550lt1, besu550gt1, &
+ backscat550, babg550, babc550, baoc550, basu550
+
+ do ic=1,10
+ if(abs(relh-rh(ic)) shr_kind_r8
+ use oslo_control, only: oslo_getopts, dir_string_length
+ use commondefinitions, only: nmodes, nbmodes
+ use opttab, only: cate, cat, fac, faq, fbc, fombg, fbcbg
+ use cam_logfile, only: iulog
+
+ implicit none
+
+!Purpose: To read in the AeroCom look-up tables for calculation of dry
+! aerosol size and mass distribution properties. The grid for discrete
+! input-values in the look-up tables is defined in opptab.
+
+! Tabulating the 'aerodryk'-files to save computing time. Routine
+! originally made by Alf Kirkevaag, and modified for new aerosol
+! schemes in January 2006.
+! Updated for new kcomp1.out including condensed SOA - Alf Kirkevåg,
+! May 2013, and extended for new SOA treatment October 2015.
+! Modified for optimized added masses and mass fractions for
+! concentrations from condensation, coagulation or cloud-processing
+! - Alf Kirkevaag, May 2016.
+! Modified for optimized added masses and mass fractions for concentrations from
+! condensation, coagulation or cloud-processing - Alf Kirkevaag, May 2016.
+
+
+#include
+
+ integer iv, kcomp, ifombg, ifbcbg, ictot, ifac, ifbc, ifaq
+ integer ic, ifil, lin
+ real(r8) frombg, frbcbg, catot, frac, fabc, fraq, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol
+ real(r8) :: eps2 = 1.e-2_r8
+ real(r8) :: eps4 = 1.e-4_r8
+ real(r8) :: eps6 = 1.e-6_r8
+ real(r8) :: eps7 = 1.e-7_r8
+ character(len=dir_string_length) :: aerotab_table_dir
+
+ call oslo_getopts(aerotab_table_dir_out = aerotab_table_dir)
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ open(11,file=trim(aerotab_table_dir)//'/aerodryk2.out' &
+ ,form='formatted',status='old')
+ open(12,file=trim(aerotab_table_dir)//'/aerodryk3.out' &
+ ,form='formatted',status='old')
+ open(13,file=trim(aerotab_table_dir)//'/aerodryk4.out' &
+ ,form='formatted',status='old')
+ open(14,file=trim(aerotab_table_dir)//'/aerodryk5.out' &
+ ,form='formatted',status='old')
+ open(15,file=trim(aerotab_table_dir)//'/aerodryk6.out' &
+ ,form='formatted',status='old')
+ open(16,file=trim(aerotab_table_dir)//'/aerodryk7.out' &
+ ,form='formatted',status='old')
+ open(17,file=trim(aerotab_table_dir)//'/aerodryk8.out' &
+ ,form='formatted',status='old')
+ open(18,file=trim(aerotab_table_dir)//'/aerodryk9.out' &
+ ,form='formatted',status='old')
+ open(19,file=trim(aerotab_table_dir)//'/aerodryk10.out' &
+ ,form='formatted',status='old')
+ open(20,file=trim(aerotab_table_dir)//'/aerodryk0.out' &
+ ,form='formatted',status='old')
+ open(21,file=trim(aerotab_table_dir)//'/aerodryk1.out' &
+ ,form='formatted',status='old')
+
+! Skipping the header-text in all input files (Later: use it to check AeroTab - CAM5-Oslo consistency!)
+ do ifil = 11,21
+ call checkTableHeader (ifil)
+ enddo
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! Mode 0, BC(ax)
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ ifil = 11
+
+ read(9+ifil,996) kcomp, cintbg, cintbg05, cintbg125, &
+ aaeros, aaerol, vaeros, vaerol
+
+! no ictot-, ifac-, ifbc- or ifaq-dependency for this mode,
+! since BC(ax) is purely externally mixed
+
+ a0cintbg=cintbg
+ a0cintbg05=cintbg05
+ a0cintbg125=cintbg125
+
+ a0aaeros=aaeros
+ a0aaerol=aaerol
+ a0vaeros=vaeros
+ a0vaerol=vaerol
+
+ write(iulog,*)'mode 0 ok'
+
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! Mode 1 (H2SO4 and SOA + condensate from H2SO4 and SOA)
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ ifil = 1
+ do lin = 1,576 ! 6x16x6
+
+ read(20+ifil,997) kcomp, frombg, catot, frac, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol
+
+ do ic=1,6
+ if(abs(frombg-fombg(ic)) shr_kind_r8
+ use opttab, only: fombg, fbcbg, cate, cat, fac, faq, fbc, rh, eps
+ use commondefinitions, only: nbmodes, nmodes
+
+ implicit none
+
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ real(r8), intent(in) :: rhum(pcols,pver) ! level relative humidity (fraction)
+ real(r8), intent(in) :: f_soana(pcols,pver) ! SOA/(SOA+H2SO4) mass fraction for the background in mode 1
+ real(r8), intent(in) :: faitbc(pcols,pver) ! BC/(BC + OC) mass fraction for the background in mode 4
+ real(r8), intent(in) :: fnbc(pcols,pver) ! BC/(BC + OC) mass fraction for the background in mode 14
+ real(r8), intent(in) :: focm(pcols,pver,4) ! fraction of added mass which is either SOA condensate or OC coagulate
+ real(r8), intent(in) :: Cam(pcols,pver,nbmodes) ! added internally mixed SO4+BC+OC concentration for a normalized mode
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! aerosol mode number concentration
+ real(r8), intent(in) :: fcm(pcols,pver,nbmodes) ! fraction of added mass which is either BC or OC/SOA (carbonaceous)
+ real(r8), intent(in) :: fbcm(pcols,pver,nbmodes) ! fraction of added mass as BC/(BC+OC)
+ real(r8), intent(in) :: faqm(pcols,pver,nbmodes) ! fraction of added sulfate which is from aqueous phase (ammonium sulfate)
+ real(r8) :: eps10 = 1.e-10_r8
+!
+! Output arguments
+!
+ real(r8), intent(out) :: xrh(pcols,pver) ! rhum for use in the interpolations
+ integer, intent(out) :: irh1(pcols,pver)
+ real(r8), intent(out) :: xfombg(pcols,pver) ! f_soana for use in the interpolations (mode 1)
+ integer, intent(out) :: ifombg1(pcols,pver)
+ real(r8), intent(out) :: xfbcbg(pcols,pver) ! faitbc for use in the interpolations (mode 4)
+ integer, intent(out) :: ifbcbg1(pcols,pver)
+ real(r8), intent(out) :: xfbcbgn(pcols,pver) ! fnbc for use in the interpolations (mode 14)
+ integer, intent(out) :: ifbcbgn1(pcols,pver)
+ real(r8), intent(out) :: xct(pcols,pver,nmodes) ! Cam/Nnatk for use in the interpolations
+ integer, intent(out) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(out) :: xfac(pcols,pver,nbmodes) ! focm (1-4) or fcm (5-10) for use in the interpolations
+ integer, intent(out) :: ifac1(pcols,pver,nbmodes)
+ real(r8), intent(out) :: xfbc(pcols,pver,nbmodes) ! fbcm for use in the interpolations
+ integer, intent(out) :: ifbc1(pcols,pver,nbmodes)
+ real(r8), intent(out) :: xfaq(pcols,pver,nbmodes) ! faqm for use in the interpolations
+ integer, intent(out) :: ifaq1(pcols,pver,nbmodes)
+!
+!---------------------------Local variables-----------------------------
+!
+ integer k, icol, i, irelh
+!
+!------------------------------------------------------------------------
+!
+
+! write(*,*) 'Before xrh-loop'
+ do k=1,pver
+ do icol=1,ncol
+ xrh(icol,k) = min(max(rhum(icol,k),rh(1)),rh(10))
+ end do
+ end do
+
+! write(*,*) 'Before rh-loop'
+ do irelh=1,9
+ do k=1,pver
+ do icol=1,ncol
+ if(xrh(icol,k) >= rh(irelh).and. &
+ xrh(icol,k)<=rh(irelh+1)) then
+ irh1(icol,k)=irelh
+ endif
+ end do
+ end do
+ end do
+! write(*,*) 'xrh, irh1, irh2 =', xrh(1,26), irh1(1,26), irh2(1,26)
+
+ do k=1,pver
+ do icol=1,ncol
+! find common xfombg, ifombg1 and ifombg2 for use in the interpolation routines
+ xfombg(icol,k) =min(max(f_soana(icol,k),fombg(1)),fombg(6))
+ ifombg1(icol,k)=int(5.0_r8*xfombg(icol,k)-eps10)+1 ! Boer linkes til def. i opttab.F90
+ end do
+ enddo
+
+ do k=1,pver
+ do icol=1,ncol
+! find common xfbcbg, ifbcbg1 and ifbcbg2 for use in the interpolation routines
+ xfbcbg(icol,k) =min(max(faitbc(icol,k),fbcbg(1)),fbcbg(6)) ! Boer linkes til def. i opttab.F90
+ ifbcbg1(icol,k)=min(max(int(4*log10(xfbcbg(icol,k))+6),1),5)
+! find common xfbcbgn, ifbcbgn1 and ifbcbgn2 for use in the interpolation routines
+ xfbcbgn(icol,k) =min(max(fnbc(icol,k),fbcbg(1)),fbcbg(6)) ! Boer linkes til def. i opttab.F90
+ ifbcbgn1(icol,k)=min(max(int(4*log10(xfbcbgn(icol,k))+6),1),5)
+ end do
+ enddo
+
+ do i=1,4
+ do k=1,pver
+ do icol=1,ncol
+! find common xfac, ifac1 and ifac2 for use in the interpolation routines
+ xfac(icol,k,i) =min(max(focm(icol,k,i),fac(1)),fac(6))
+ ifac1(icol,k,i)=int(5.0_r8*xfac(icol,k,i)-eps10)+1 ! Boer linkes til def. i opttab.F90
+ end do
+ enddo
+ enddo
+ do i=5,nbmodes
+ do k=1,pver
+ do icol=1,ncol
+! find common xfac, ifac1 and ifac2 for use in the interpolation routines
+ xfac(icol,k,i) =min(max(fcm(icol,k,i),fac(1)),fac(6))
+ ifac1(icol,k,i)=int(5.0_r8*xfac(icol,k,i)-eps10)+1 ! Boer linkes til def. i opttab.F90
+ end do
+ enddo
+ enddo
+
+ do i=1,nbmodes
+ do k=1,pver
+ do icol=1,ncol
+! find common xfbc, ifbc1 and ifbc2 for use in the interpolation routines
+ xfbc(icol,k,i) =min(max(fbcm(icol,k,i),fbc(1)),fbc(6)) ! Boer linkes til def. i opttab.F90
+ ifbc1(icol,k,i)=min(max(int(4*log10(xfbc(icol,k,i))+6),1),5)
+ end do
+ enddo
+ enddo
+
+ do i=1,nbmodes
+ do k=1,pver
+ do icol=1,ncol
+! find common xfaq, ifaq1 and ifaq2 for use in the interpolation routines
+ xfaq(icol,k,i) =min(max(faqm(icol,k,i),faq(1)),faq(6))
+ ifaq1(icol,k,i)=int(5.0_r8*xfaq(icol,k,i)-eps10)+1 ! Boer linkes til def. i opttab.F90
+ end do
+ enddo
+ enddo
+
+! find common xct, ict1 and ict2 for use in the interpolation routines ! Boer linkes til def. i opttab.F90
+ do i=1,4
+ do k=1,pver
+ do icol=1,ncol
+ xct(icol,k,i)=min(max(Cam(icol,k,i)/(Nnatk(icol,k,i)+eps),cate(i,1)),cate(i,16))
+ if(i.le.2) then
+ ict1(icol,k,i)=min(max(int(3*log10(xct(icol,k,i))+19.666_r8),1),15)
+ elseif(i.eq.3) then ! mode not used
+ xct(icol,k,i)=cate(i,1)
+ ict1(icol,k,i)=1
+ else
+ ict1(icol,k,i)=min(max(int(3*log10(xct(icol,k,i))+13.903_r8),1),15)
+ endif
+ end do
+ end do
+ end do
+
+ do i=5,10
+ do k=1,pver
+ do icol=1,ncol
+ xct(icol,k,i)=min(max(Cam(icol,k,i)/(Nnatk(icol,k,i)+eps),cat(i,1)),cat(i,6))
+ if(i.eq.5) then
+ ict1(icol,k,i)=min(max(int(log10(xct(icol,k,i))+4.824_r8),1),5)
+ elseif(i.eq.6) then
+ ict1(icol,k,i)=min(max(int(log10(xct(icol,k,i))+4.523_r8),1),5)
+ elseif(i.eq.7) then
+ ict1(icol,k,i)=min(max(int(log10(xct(icol,k,i))+4.699_r8),1),5)
+ elseif(i.eq.8) then
+ ict1(icol,k,i)=min(max(int(log10(xct(icol,k,i))+5.921_r8),1),5)
+ elseif(i.eq.9) then
+ ict1(icol,k,i)=min(max(int(log10(xct(icol,k,i))+4.301_r8),1),5)
+ else
+ ict1(icol,k,i)=min(max(int(log10(xct(icol,k,i))+4.699_r8),1),5)
+ endif
+ end do
+ end do
+ end do
+
+ do i=11,nmodes ! for the externally mixed modes 11-14 (now only 12 and 14)
+ do k=1,pver
+ do icol=1,ncol
+ xct(icol,k,i)=cate(i-10,1)
+ ict1(icol,k,i)=1
+ end do
+ end do
+ end do
+
+ return
+
+end subroutine inputForInterpol
diff --git a/src/physics/cam_oslo/intaeropt0.F90 b/src/physics/cam_oslo/intaeropt0.F90
new file mode 100644
index 0000000000..c44729668b
--- /dev/null
+++ b/src/physics/cam_oslo/intaeropt0.F90
@@ -0,0 +1,207 @@
+subroutine intaeropt0 (lchnk, ncol, Nnatk, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebg550lt1, bebg550gt1, bebc550lt1, bebc550gt1, &
+ beoc550lt1, beoc550gt1, besu550lt1, besu550gt1, &
+ backsc550, babg550, babc550, baoc550, basu550)
+
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use opttab, only: cate, cat, fac, faq, fbc
+ use commondefinitions, only: nmodes, nbmodes
+
+ implicit none
+
+#include
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+!
+! Output arguments: Modal total and absorption extiction coefficients (for AeroCom)
+! for 440nm, 500nm, 550nm, 670nm and 870nm, and for d<1um (lt1) and d>1um (gt1).
+! March 2009: + backscatter coefficient, backsc550 (km-1 sr-1).
+
+ real(r8), intent(out) :: &
+ bext440(pcols,pver,0:nbmodes), babs440(pcols,pver,0:nbmodes), &
+ bext500(pcols,pver,0:nbmodes), babs500(pcols,pver,0:nbmodes), &
+ bext550(pcols,pver,0:nbmodes), babs550(pcols,pver,0:nbmodes), &
+ bext670(pcols,pver,0:nbmodes), babs670(pcols,pver,0:nbmodes), &
+ bext870(pcols,pver,0:nbmodes), babs870(pcols,pver,0:nbmodes), &
+ bebg440(pcols,pver,0:nbmodes), & ! babg440(pcols,pver,0:nbmodes), &
+ bebg500(pcols,pver,0:nbmodes), & ! babg500(pcols,pver,0:nbmodes), &
+ bebg550(pcols,pver,0:nbmodes), babg550(pcols,pver,0:nbmodes), &
+ bebg670(pcols,pver,0:nbmodes), & ! babg670(pcols,pver,0:nbmodes), &
+ bebg870(pcols,pver,0:nbmodes), & ! babg870(pcols,pver,0:nbmodes), &
+ bebc440(pcols,pver,0:nbmodes), & ! babc440(pcols,pver,0:nbmodes), &
+ bebc500(pcols,pver,0:nbmodes), & ! babc500(pcols,pver,0:nbmodes), &
+ bebc550(pcols,pver,0:nbmodes), babc550(pcols,pver,0:nbmodes), &
+ bebc670(pcols,pver,0:nbmodes), & ! babc670(pcols,pver,0:nbmodes), &
+ bebc870(pcols,pver,0:nbmodes), & ! babc870(pcols,pver,0:nbmodes), &
+ beoc440(pcols,pver,0:nbmodes), & ! baoc440(pcols,pver,0:nbmodes), &
+ beoc500(pcols,pver,0:nbmodes), & ! baoc500(pcols,pver,0:nbmodes), &
+ beoc550(pcols,pver,0:nbmodes), baoc550(pcols,pver,0:nbmodes), &
+ beoc670(pcols,pver,0:nbmodes), & ! baoc670(pcols,pver,0:nbmodes), &
+ beoc870(pcols,pver,0:nbmodes), & ! baoc870(pcols,pver,0:nbmodes), &
+ besu440(pcols,pver,0:nbmodes), & ! basu440(pcols,pver,0:nbmodes), &
+ besu500(pcols,pver,0:nbmodes), & ! basu500(pcols,pver,0:nbmodes), &
+ besu550(pcols,pver,0:nbmodes), basu550(pcols,pver,0:nbmodes), &
+ besu670(pcols,pver,0:nbmodes), & ! basu670(pcols,pver,0:nbmodes), &
+ besu870(pcols,pver,0:nbmodes), & ! basu870(pcols,pver,0:nbmodes), &
+ bebg550lt1(pcols,pver,0:nbmodes), bebg550gt1(pcols,pver,0:nbmodes), &
+ bebc550lt1(pcols,pver,0:nbmodes), bebc550gt1(pcols,pver,0:nbmodes), &
+ beoc550lt1(pcols,pver,0:nbmodes), beoc550gt1(pcols,pver,0:nbmodes), &
+ besu550lt1(pcols,pver,0:nbmodes), besu550gt1(pcols,pver,0:nbmodes), &
+ backsc550(pcols,pver,0:nbmodes)
+!
+!---------------------------Local variables-----------------------------
+!
+
+ integer i, iv, ierr, k, kcomp, icol
+
+ kcomp=0
+
+! BC(ax) mode:
+
+! initialize all output fields
+ do k=1,pver
+ do icol=1,ncol
+ bext440(icol,k,kcomp)=0.0_r8
+ babs440(icol,k,kcomp)=0.0_r8
+ bext500(icol,k,kcomp)=0.0_r8
+ babs500(icol,k,kcomp)=0.0_r8
+ bext550(icol,k,kcomp)=0.0_r8
+ babs550(icol,k,kcomp)=0.0_r8
+ bext670(icol,k,kcomp)=0.0_r8
+ babs670(icol,k,kcomp)=0.0_r8
+ bext870(icol,k,kcomp)=0.0_r8
+ babs870(icol,k,kcomp)=0.0_r8
+ bebg440(icol,k,kcomp)=0.0_r8
+! babg440(icol,k,kcomp)=0.0_r8
+ bebg500(icol,k,kcomp)=0.0_r8
+! babg500(icol,k,kcomp)=0.0_r8
+ bebg550(icol,k,kcomp)=0.0_r8
+ babg550(icol,k,kcomp)=0.0_r8
+ bebg670(icol,k,kcomp)=0.0_r8
+! babg670(icol,k,kcomp)=0.0_r8
+ bebg870(icol,k,kcomp)=0.0_r8
+! babg870(icol,k,kcomp)=0.0_r8
+ bebc440(icol,k,kcomp)=0.0_r8
+! babc440(icol,k,kcomp)=0.0_r8
+ bebc500(icol,k,kcomp)=0.0_r8
+! babc500(icol,k,kcomp)=0.0_r8
+ bebc550(icol,k,kcomp)=0.0_r8
+ babc550(icol,k,kcomp)=0.0_r8
+ bebc670(icol,k,kcomp)=0.0_r8
+! babc670(icol,k,kcomp)=0.0_r8
+ bebc870(icol,k,kcomp)=0.0_r8
+! babc870(icol,k,kcomp)=0.0_r8
+ beoc440(icol,k,kcomp)=0.0_r8
+! baoc440(icol,k,kcomp)=0.0_r8
+ beoc500(icol,k,kcomp)=0.0_r8
+! baoc500(icol,k,kcomp)=0.0_r8
+ beoc550(icol,k,kcomp)=0.0_r8
+ baoc550(icol,k,kcomp)=0.0_r8
+ beoc670(icol,k,kcomp)=0.0_r8
+! baoc670(icol,k,kcomp)=0.0_r8
+ beoc870(icol,k,kcomp)=0.0_r8
+! baoc870(icol,k,kcomp)=0.0_r8
+ besu440(icol,k,kcomp)=0.0_r8
+! basu440(icol,k,kcomp)=0.0_r8
+ besu500(icol,k,kcomp)=0.0_r8
+! basu500(icol,k,kcomp)=0.0_r8
+ besu550(icol,k,kcomp)=0.0_r8
+ basu550(icol,k,kcomp)=0.0_r8
+ besu670(icol,k,kcomp)=0.0_r8
+! basu670(icol,k,kcomp)=0.0_r8
+ besu870(icol,k,kcomp)=0.0_r8
+! basu870(icol,k,kcomp)=0.0_r8
+ bebg550lt1(icol,k,kcomp)=0.0_r8
+ bebg550gt1(icol,k,kcomp)=0.0_r8
+ bebc550lt1(icol,k,kcomp)=0.0_r8
+ bebc550gt1(icol,k,kcomp)=0.0_r8
+ beoc550lt1(icol,k,kcomp)=0.0_r8
+ beoc550gt1(icol,k,kcomp)=0.0_r8
+ besu550lt1(icol,k,kcomp)=0.0_r8
+ besu550gt1(icol,k,kcomp)=0.0_r8
+ backsc550(icol,k,kcomp)=0.0_r8
+ end do
+ end do
+
+ do k=1,pver
+ do icol=1,ncol
+
+ if(Nnatk(icol,k,kcomp).gt.0) then
+
+ bext440(icol,k,kcomp)=bex440
+ babs440(icol,k,kcomp)=bax440
+ bext500(icol,k,kcomp)=bex500
+ babs500(icol,k,kcomp)=bax500
+ bext550(icol,k,kcomp)=bex550lt1+bex550gt1
+ babs550(icol,k,kcomp)=bax550
+ bext670(icol,k,kcomp)=bex670
+ babs670(icol,k,kcomp)=bax670
+ bext870(icol,k,kcomp)=bex870
+ babs870(icol,k,kcomp)=bax870
+ bebg440(icol,k,kcomp)=bex440
+! babg440(icol,k,kcomp)=bax440
+ bebg500(icol,k,kcomp)=bex500
+! babg500(icol,k,kcomp)=bax500
+ bebg550(icol,k,kcomp)=bex550lt1+bex550gt1
+ babg550(icol,k,kcomp)=bax550
+ bebg670(icol,k,kcomp)=bex670
+! babg670(icol,k,kcomp)=bax670
+ bebg870(icol,k,kcomp)=bex870
+! babg870(icol,k,kcomp)=bax870
+ bebc440(icol,k,kcomp)=0.0_r8
+! babc440(icol,k,kcomp)=0.0_r8
+ bebc500(icol,k,kcomp)=0.0_r8
+! babc500(icol,k,kcomp)=0.0_r8
+ bebc670(icol,k,kcomp)=0.0_r8
+! babc670(icol,k,kcomp)=0.0_r8
+ bebc870(icol,k,kcomp)=0.0_r8
+! babc870(icol,k,kcomp)=0.0_r8
+ beoc440(icol,k,kcomp)=0.0_r8
+! baoc440(icol,k,kcomp)=0.0_r8
+ beoc500(icol,k,kcomp)=0.0_r8
+! baoc500(icol,k,kcomp)=0.0_r8
+ beoc670(icol,k,kcomp)=0.0_r8
+! baoc670(icol,k,kcomp)=0.0_r8
+ beoc870(icol,k,kcomp)=0.0_r8
+! baoc870(icol,k,kcomp)=0.0_r8
+ besu440(icol,k,kcomp)=0.0_r8
+! basu440(icol,k,kcomp)=0.0_r8
+ besu500(icol,k,kcomp)=0.0_r8
+! basu500(icol,k,kcomp)=0.0_r8
+ besu670(icol,k,kcomp)=0.0_r8
+! basu670(icol,k,kcomp)=0.0_r8
+ besu870(icol,k,kcomp)=0.0_r8
+! basu870(icol,k,kcomp)=0.0_r8
+ bebg550lt1(icol,k,kcomp)=bex550lt1
+ bebg550gt1(icol,k,kcomp)=bex550gt1
+ bebc550lt1(icol,k,kcomp)=0.0_r8
+ bebc550gt1(icol,k,kcomp)=0.0_r8
+ beoc550lt1(icol,k,kcomp)=0.0_r8
+ beoc550gt1(icol,k,kcomp)=0.0_r8
+ besu550lt1(icol,k,kcomp)=0.0_r8
+ besu550gt1(icol,k,kcomp)=0.0_r8
+ backsc550(icol,k,kcomp)=backscx550
+
+ endif
+
+ end do ! icol
+ end do ! k
+
+ return
+end subroutine intaeropt0
+
+
+
+
diff --git a/src/physics/cam_oslo/intaeropt1.F90 b/src/physics/cam_oslo/intaeropt1.F90
new file mode 100644
index 0000000000..a80a204940
--- /dev/null
+++ b/src/physics/cam_oslo/intaeropt1.F90
@@ -0,0 +1,317 @@
+subroutine intaeropt1 (lchnk, ncol, xrh, irh1, mplus10, &
+ Nnatk, xfombg, ifombg1, xct, ict1, xfac, ifac1, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebg550lt1, bebg550gt1, bebc550lt1, bebc550gt1, &
+ beoc550lt1, beoc550gt1, besu550lt1, besu550gt1, &
+ backsc550, babg550, babc550, baoc550, basu550)
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use opttab, only: cate, fombg, cat, fac, faq, fbc, rh
+ use commondefinitions, only: nmodes, nbmodes
+
+ implicit none
+
+#include
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ integer, intent(in) :: mplus10 ! mode number (0) or number + 10 (1)
+ real(r8), intent(in) :: xrh(pcols,pver) ! level relative humidity (fraction)
+ integer, intent(in) :: irh1(pcols,pver)
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xfombg(pcols,pver) ! SOA/(SOA+H2SO4) for the background mode
+ integer, intent(in) :: ifombg1(pcols,pver)
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! condensed SOA/(SOA+H2SO4) (1-4) or added carbonaceous fraction (5-10)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+
+! Output arguments: Modal total and absorption extiction coefficients (for AeroCom)
+! for 440nm, 500nm, 550nm, 670nm and 870nm, and for d<1um (lt1) and d>1um (gt1).
+! March 2009: + backscatter coefficient, backsc550 (km-1 sr-1).
+! Rewritten by Alf Kirkevaag September 2015 to a more generalized for for
+! interpolations using common subroutines interpol*dim.
+
+ real(r8), intent(out) :: &
+ bext440(pcols,pver,0:nbmodes), babs440(pcols,pver,0:nbmodes), &
+ bext500(pcols,pver,0:nbmodes), babs500(pcols,pver,0:nbmodes), &
+ bext550(pcols,pver,0:nbmodes), babs550(pcols,pver,0:nbmodes), &
+ bext670(pcols,pver,0:nbmodes), babs670(pcols,pver,0:nbmodes), &
+ bext870(pcols,pver,0:nbmodes), babs870(pcols,pver,0:nbmodes), &
+ bebg440(pcols,pver,0:nbmodes), & ! babg440(pcols,pver,0:nbmodes), &
+ bebg500(pcols,pver,0:nbmodes), & ! babg500(pcols,pver,0:nbmodes), &
+ bebg550(pcols,pver,0:nbmodes), babg550(pcols,pver,0:nbmodes), &
+ bebg670(pcols,pver,0:nbmodes), & ! babg670(pcols,pver,0:nbmodes), &
+ bebg870(pcols,pver,0:nbmodes), & ! babg870(pcols,pver,0:nbmodes), &
+ bebc440(pcols,pver,0:nbmodes), & ! babc440(pcols,pver,0:nbmodes), &
+ bebc500(pcols,pver,0:nbmodes), & ! babc500(pcols,pver,0:nbmodes), &
+ bebc550(pcols,pver,0:nbmodes), babc550(pcols,pver,0:nbmodes), &
+ bebc670(pcols,pver,0:nbmodes), & ! babc670(pcols,pver,0:nbmodes), &
+ bebc870(pcols,pver,0:nbmodes), & ! babc870(pcols,pver,0:nbmodes), &
+ beoc440(pcols,pver,0:nbmodes), & ! baoc440(pcols,pver,0:nbmodes), &
+ beoc500(pcols,pver,0:nbmodes), & ! baoc500(pcols,pver,0:nbmodes), &
+ beoc550(pcols,pver,0:nbmodes), baoc550(pcols,pver,0:nbmodes), &
+ beoc670(pcols,pver,0:nbmodes), & ! baoc670(pcols,pver,0:nbmodes), &
+ beoc870(pcols,pver,0:nbmodes), & ! baoc870(pcols,pver,0:nbmodes), &
+ besu440(pcols,pver,0:nbmodes), & ! basu440(pcols,pver,0:nbmodes), &
+ besu500(pcols,pver,0:nbmodes), & ! basu500(pcols,pver,0:nbmodes), &
+ besu550(pcols,pver,0:nbmodes), basu550(pcols,pver,0:nbmodes), &
+ besu670(pcols,pver,0:nbmodes), & ! basu670(pcols,pver,0:nbmodes), &
+ besu870(pcols,pver,0:nbmodes), & ! basu870(pcols,pver,0:nbmodes), &
+ bebg550lt1(pcols,pver,0:nbmodes), bebg550gt1(pcols,pver,0:nbmodes), &
+ bebc550lt1(pcols,pver,0:nbmodes), bebc550gt1(pcols,pver,0:nbmodes), &
+ beoc550lt1(pcols,pver,0:nbmodes), beoc550gt1(pcols,pver,0:nbmodes), &
+ besu550lt1(pcols,pver,0:nbmodes), besu550gt1(pcols,pver,0:nbmodes), &
+ backsc550(pcols,pver,0:nbmodes)
+!
+!---------------------------Local variables-----------------------------
+!
+
+ real(r8) a, b, e, eps
+
+ integer i, iv, ierr, irelh, ifombg, ictot, ifac, kcomp, k, icol, kc10
+
+! Temporary storage of often used array elements
+ integer t_irh1, t_irh2, t_ifo1, t_ifo2, t_ict1, t_ict2, t_ifc1, t_ifc2
+ real(r8) t_fac1, t_fac2, t_xfac
+ real(r8) t_xrh, t_rh1, t_rh2, t_fombg1, t_fombg2, t_xfombg
+ real(r8) t_xct, t_cat1, t_cat2
+ real(r8) d2mx(4), dxm1(4), invd(4)
+ real(r8) opt4d(2,2,2,2)
+ real(r8) ome1, ome2, ge1, ge2, bex1, bex2, ske1, ske2
+ real(r8) opt1, opt2, opt(38)
+
+ parameter (e=2.718281828_r8, eps=1.0e-60_r8)
+
+
+! write(*,*) 'Before kcomp-loop'
+
+! SO4/SOA(Ait) mode:
+
+ do kcomp=1,1
+
+! write(*,*) 'kcomp = ', kcomp
+
+! initialize all output fields Bruk For All istedet?
+ do k=1,pver
+ do icol=1,ncol
+ bext440(icol,k,kcomp)=0.0_r8
+ babs440(icol,k,kcomp)=0.0_r8
+ bext500(icol,k,kcomp)=0.0_r8
+ babs500(icol,k,kcomp)=0.0_r8
+ bext550(icol,k,kcomp)=0.0_r8
+ babs550(icol,k,kcomp)=0.0_r8
+ bext670(icol,k,kcomp)=0.0_r8
+ babs670(icol,k,kcomp)=0.0_r8
+ bext870(icol,k,kcomp)=0.0_r8
+ babs870(icol,k,kcomp)=0.0_r8
+ bebg440(icol,k,kcomp)=0.0_r8
+! babg440(icol,k,kcomp)=0.0_r8
+ bebg500(icol,k,kcomp)=0.0_r8
+! babg500(icol,k,kcomp)=0.0_r8
+ bebg550(icol,k,kcomp)=0.0_r8
+ babg550(icol,k,kcomp)=0.0_r8
+ bebg670(icol,k,kcomp)=0.0_r8
+! babg670(icol,k,kcomp)=0.0_r8
+ bebg870(icol,k,kcomp)=0.0_r8
+! babg870(icol,k,kcomp)=0.0_r8
+ bebc440(icol,k,kcomp)=0.0_r8
+! babc440(icol,k,kcomp)=0.0_r8
+ bebc500(icol,k,kcomp)=0.0_r8
+! babc500(icol,k,kcomp)=0.0_r8
+ bebc550(icol,k,kcomp)=0.0_r8
+ babc550(icol,k,kcomp)=0.0_r8
+ bebc670(icol,k,kcomp)=0.0_r8
+! babc670(icol,k,kcomp)=0.0_r8
+ bebc870(icol,k,kcomp)=0.0_r8
+! babc870(icol,k,kcomp)=0.0_r8
+ beoc440(icol,k,kcomp)=0.0_r8
+! baoc440(icol,k,kcomp)=0.0_r8
+ beoc500(icol,k,kcomp)=0.0_r8
+! baoc500(icol,k,kcomp)=0.0_r8
+ beoc550(icol,k,kcomp)=0.0_r8
+ baoc550(icol,k,kcomp)=0.0_r8
+ beoc670(icol,k,kcomp)=0.0_r8
+! baoc670(icol,k,kcomp)=0.0_r8
+ beoc870(icol,k,kcomp)=0.0_r8
+! baoc870(icol,k,kcomp)=0.0_r8
+ besu440(icol,k,kcomp)=0.0_r8
+! basu440(icol,k,kcomp)=0.0_r8
+ besu500(icol,k,kcomp)=0.0_r8
+! basu500(icol,k,kcomp)=0.0_r8
+ besu550(icol,k,kcomp)=0.0_r8
+ basu550(icol,k,kcomp)=0.0_r8
+ besu670(icol,k,kcomp)=0.0_r8
+! basu670(icol,k,kcomp)=0.0_r8
+ besu870(icol,k,kcomp)=0.0_r8
+! basu870(icol,k,kcomp)=0.0_r8
+ bebg550lt1(icol,k,kcomp)=0.0_r8
+ bebg550gt1(icol,k,kcomp)=0.0_r8
+ bebc550lt1(icol,k,kcomp)=0.0_r8
+ bebc550gt1(icol,k,kcomp)=0.0_r8
+ beoc550lt1(icol,k,kcomp)=0.0_r8
+ beoc550gt1(icol,k,kcomp)=0.0_r8
+ besu550lt1(icol,k,kcomp)=0.0_r8
+ besu550gt1(icol,k,kcomp)=0.0_r8
+ backsc550(icol,k,kcomp)=0.0_r8
+ end do
+ end do
+
+ if(mplus10==0) then
+ kc10=kcomp
+ else
+ write(*,*) "mplus10=1 is no loger an option for kcomp=1."
+ stop
+ endif
+
+
+ do k=1,pver
+ do icol=1,ncol
+
+ if(Nnatk(icol,k,kc10).gt.0) then
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+
+ t_irh1 = irh1(icol,k)
+ t_irh2 = t_irh1+1
+ t_ifo1 = ifombg1(icol,k)
+ t_ifo2 = t_ifo1+1
+ t_ict1 = ict1(icol,k,kcomp)
+ t_ict2 = t_ict1+1
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+
+ t_rh1 = rh(t_irh1)
+ t_rh2 = rh(t_irh2)
+ t_fombg1 = fombg(t_ifo1)
+ t_fombg2 = fombg(t_ifo2)
+ t_cat1 = cate(kcomp,t_ict1)
+ t_cat2 = cate(kcomp,t_ict2)
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+
+ t_xrh = xrh(icol,k)
+ t_xct = xct(icol,k,kc10)
+ t_xfac = xfac(icol,k,kcomp)
+ t_xfombg = xfombg(icol,k)
+
+! partial lengths along each dimension (1-4) for interpolation
+ d2mx(1) = (t_rh2-t_xrh)
+ dxm1(1) = (t_xrh-t_rh1)
+ invd(1) = 1.0_r8/(t_rh2-t_rh1)
+ d2mx(2) = (t_fombg2-t_xfombg)
+ dxm1(2) = (t_xfombg-t_fombg1)
+ invd(2) = 1.0_r8/(t_fombg2-t_fombg1)
+ d2mx(3) = (t_cat2-t_xct)
+ dxm1(3) = (t_xct-t_cat1)
+ invd(3) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(4) = (t_fac2-t_xfac)
+ dxm1(4) = (t_xfac-t_fac1)
+ invd(4) = 1.0_r8/(t_fac2-t_fac1)
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+
+ do iv=1,38 ! variable number
+
+! end points as basis for multidimentional linear interpolation
+ opt4d(1,1,1,1)=bep1(iv,t_irh1,t_ifo1,t_ict1,t_ifc1)
+ opt4d(1,1,1,2)=bep1(iv,t_irh1,t_ifo1,t_ict1,t_ifc2)
+ opt4d(1,1,2,1)=bep1(iv,t_irh1,t_ifo1,t_ict2,t_ifc1)
+ opt4d(1,1,2,2)=bep1(iv,t_irh1,t_ifo1,t_ict2,t_ifc2)
+ opt4d(1,2,1,1)=bep1(iv,t_irh1,t_ifo2,t_ict1,t_ifc1)
+ opt4d(1,2,1,2)=bep1(iv,t_irh1,t_ifo2,t_ict1,t_ifc2)
+ opt4d(1,2,2,1)=bep1(iv,t_irh1,t_ifo2,t_ict2,t_ifc1)
+ opt4d(1,2,2,2)=bep1(iv,t_irh1,t_ifo2,t_ict2,t_ifc2)
+ opt4d(2,1,1,1)=bep1(iv,t_irh2,t_ifo1,t_ict1,t_ifc1)
+ opt4d(2,1,1,2)=bep1(iv,t_irh2,t_ifo1,t_ict1,t_ifc2)
+ opt4d(2,1,2,1)=bep1(iv,t_irh2,t_ifo1,t_ict2,t_ifc1)
+ opt4d(2,1,2,2)=bep1(iv,t_irh2,t_ifo1,t_ict2,t_ifc2)
+ opt4d(2,2,1,1)=bep1(iv,t_irh2,t_ifo2,t_ict1,t_ifc1)
+ opt4d(2,2,1,2)=bep1(iv,t_irh2,t_ifo2,t_ict1,t_ifc2)
+ opt4d(2,2,2,1)=bep1(iv,t_irh2,t_ifo2,t_ict2,t_ifc1)
+ opt4d(2,2,2,2)=bep1(iv,t_irh2,t_ifo2,t_ict2,t_ifc2)
+
+! interpolation in the fac, cat and fombg dimensions
+ call lininterpol4dim (d2mx, dxm1, invd, opt4d, opt1, opt2)
+
+! finally, interpolation in the rh dimension
+ opt(iv)=((t_rh2-t_xrh)*opt1+(t_xrh-t_rh1)*opt2) &
+ /(t_rh2-t_rh1)
+
+! if(mplus10==1) then
+! write(*,*) 'kcomp, iv, opt(iv) =', kcomp, iv, opt(iv)
+! write(*,*) 'kc10, Nnatk =', kc10, Nnatk(icol,k,kc10)
+! endif
+
+ end do ! iv=1,38
+
+ bext440(icol,k,kcomp)=opt(1)
+ bext500(icol,k,kcomp)=opt(2)
+ bext670(icol,k,kcomp)=opt(3)
+ bext870(icol,k,kcomp)=opt(4)
+ bebg440(icol,k,kcomp)=opt(5)
+ bebg500(icol,k,kcomp)=opt(6)
+ bebg670(icol,k,kcomp)=opt(7)
+ bebg870(icol,k,kcomp)=opt(8)
+ bebc440(icol,k,kcomp)=opt(9)
+ bebc500(icol,k,kcomp)=opt(10)
+ bebc670(icol,k,kcomp)=opt(11)
+ bebc870(icol,k,kcomp)=opt(12)
+ beoc440(icol,k,kcomp)=opt(13)
+ beoc500(icol,k,kcomp)=opt(14)
+ beoc670(icol,k,kcomp)=opt(15)
+ beoc870(icol,k,kcomp)=opt(16)
+ besu440(icol,k,kcomp)=opt(17)
+ besu500(icol,k,kcomp)=opt(18)
+ besu670(icol,k,kcomp)=opt(19)
+ besu870(icol,k,kcomp)=opt(20)
+ babs440(icol,k,kcomp)=opt(21)
+ babs500(icol,k,kcomp)=opt(22)
+ babs550(icol,k,kcomp)=opt(23)
+ babs670(icol,k,kcomp)=opt(24)
+ babs870(icol,k,kcomp)=opt(25)
+ bebg550lt1(icol,k,kcomp)=opt(26)
+ bebg550gt1(icol,k,kcomp)=opt(27)
+ bebc550lt1(icol,k,kcomp)=opt(28)
+ bebc550gt1(icol,k,kcomp)=opt(29)
+ beoc550lt1(icol,k,kcomp)=opt(30)
+ beoc550gt1(icol,k,kcomp)=opt(31)
+ besu550lt1(icol,k,kcomp)=opt(32)
+ besu550gt1(icol,k,kcomp)=opt(33)
+ backsc550(icol,k,kcomp)=opt(34)
+ babg550(icol,k,kcomp)=opt(35)
+ babc550(icol,k,kcomp)=opt(36)
+ baoc550(icol,k,kcomp)=opt(37)
+ basu550(icol,k,kcomp)=opt(38)
+ bebg550(icol,k,kcomp)=opt(26)+opt(27)
+ bebc550(icol,k,kcomp)=opt(28)+opt(29)
+ beoc550(icol,k,kcomp)=opt(30)+opt(31)
+ besu550(icol,k,kcomp)=opt(32)+opt(33)
+ bext550(icol,k,kcomp)=bebg550(icol,k,kcomp)+bebc550(icol,k,kcomp) &
+ +beoc550(icol,k,kcomp)+besu550(icol,k,kcomp)
+
+ endif
+
+ end do ! icol
+ end do ! k
+
+ end do ! kcomp
+
+ return
+
+end subroutine intaeropt1
+
+
+
+
diff --git a/src/physics/cam_oslo/intaeropt2to3.F90 b/src/physics/cam_oslo/intaeropt2to3.F90
new file mode 100644
index 0000000000..20ab80818b
--- /dev/null
+++ b/src/physics/cam_oslo/intaeropt2to3.F90
@@ -0,0 +1,299 @@
+subroutine intaeropt2to3 (lchnk, ncol, xrh, irh1, mplus10, &
+ Nnatk, xct, ict1, xfac, ifac1, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebg550lt1, bebg550gt1, bebc550lt1, bebc550gt1, &
+ beoc550lt1, beoc550gt1, besu550lt1, besu550gt1, &
+ backsc550, babg550, babc550, baoc550, basu550)
+
+! Extended by Alf Kirkevaag to include SOA in September 2015
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use opttab, only: cate, cat, fac, faq, fbc, rh
+ use commondefinitions, only: nmodes, nbmodes
+
+ implicit none
+
+#include
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ integer, intent(in) :: mplus10 ! mode number (0) or number + 10 (1)
+ real(r8), intent(in) :: xrh(pcols,pver) ! level relative humidity (fraction)
+ integer, intent(in) :: irh1(pcols,pver)
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! condensed SOA/(SOA+H2SO4) (1-4) or added carbonaceous fraction (5-10)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+!
+! Output arguments: Modal total and absorption extiction coefficients (for AeroCom)
+!old: for 550nm (1) and 865nm (2), and for r<1um (lt1) and r>1um (gt1).
+! for 440nm, 500nm, 550nm, 670nm and 870nm, and for d<1um (lt1) and d>1um (gt1).
+! March 2009: + backscatter coefficient, backsc550 (km-1 sr-1).
+! Rewritten by Alf Kirkevaag September 2015 to a more generalized for for
+! interpolations using common subroutines interpol*dim.
+
+ real(r8), intent(out) :: &
+ bext440(pcols,pver,0:nbmodes), babs440(pcols,pver,0:nbmodes), &
+ bext500(pcols,pver,0:nbmodes), babs500(pcols,pver,0:nbmodes), &
+ bext550(pcols,pver,0:nbmodes), babs550(pcols,pver,0:nbmodes), &
+ bext670(pcols,pver,0:nbmodes), babs670(pcols,pver,0:nbmodes), &
+ bext870(pcols,pver,0:nbmodes), babs870(pcols,pver,0:nbmodes), &
+ bebg440(pcols,pver,0:nbmodes), & ! babg440(pcols,pver,0:nbmodes), &
+ bebg500(pcols,pver,0:nbmodes), & ! babg500(pcols,pver,0:nbmodes), &
+ bebg550(pcols,pver,0:nbmodes), babg550(pcols,pver,0:nbmodes), &
+ bebg670(pcols,pver,0:nbmodes), & ! babg670(pcols,pver,0:nbmodes), &
+ bebg870(pcols,pver,0:nbmodes), & ! babg870(pcols,pver,0:nbmodes), &
+ bebc440(pcols,pver,0:nbmodes), & ! babc440(pcols,pver,0:nbmodes), &
+ bebc500(pcols,pver,0:nbmodes), & ! babc500(pcols,pver,0:nbmodes), &
+ bebc550(pcols,pver,0:nbmodes), babc550(pcols,pver,0:nbmodes), &
+ bebc670(pcols,pver,0:nbmodes), & ! babc670(pcols,pver,0:nbmodes), &
+ bebc870(pcols,pver,0:nbmodes), & ! babc870(pcols,pver,0:nbmodes), &
+ beoc440(pcols,pver,0:nbmodes), & ! baoc440(pcols,pver,0:nbmodes), &
+ beoc500(pcols,pver,0:nbmodes), & ! baoc500(pcols,pver,0:nbmodes), &
+ beoc550(pcols,pver,0:nbmodes), baoc550(pcols,pver,0:nbmodes), &
+ beoc670(pcols,pver,0:nbmodes), & ! baoc670(pcols,pver,0:nbmodes), &
+ beoc870(pcols,pver,0:nbmodes), & ! baoc870(pcols,pver,0:nbmodes), &
+ besu440(pcols,pver,0:nbmodes), & ! basu440(pcols,pver,0:nbmodes), &
+ besu500(pcols,pver,0:nbmodes), & ! basu500(pcols,pver,0:nbmodes), &
+ besu550(pcols,pver,0:nbmodes), basu550(pcols,pver,0:nbmodes), &
+ besu670(pcols,pver,0:nbmodes), & ! basu670(pcols,pver,0:nbmodes), &
+ besu870(pcols,pver,0:nbmodes), & ! basu870(pcols,pver,0:nbmodes), &
+ bebg550lt1(pcols,pver,0:nbmodes), bebg550gt1(pcols,pver,0:nbmodes), &
+ bebc550lt1(pcols,pver,0:nbmodes), bebc550gt1(pcols,pver,0:nbmodes), &
+ beoc550lt1(pcols,pver,0:nbmodes), beoc550gt1(pcols,pver,0:nbmodes), &
+ besu550lt1(pcols,pver,0:nbmodes), besu550gt1(pcols,pver,0:nbmodes), &
+ backsc550(pcols,pver,0:nbmodes)
+!
+!---------------------------Local variables-----------------------------
+!
+
+ real(r8) a, b, e, eps
+
+ integer i, iv, kcomp, k, icol, kc10
+
+! Temporary storage of often used array elements
+ integer t_irh1, t_irh2, t_ict1, t_ict2, t_ifc1, t_ifc2
+ real(r8) t_fac1, t_fac2, t_xfac, t_xrh, t_xct, t_rh1, t_rh2, &
+ t_cat1, t_cat2
+ real(r8) d2mx(3), dxm1(3), invd(3)
+ real(r8) opt3d(2,2,2)
+ real(r8) opt1, opt2, opt(38)
+
+ parameter (e=2.718281828_r8, eps=1.0e-60_r8)
+
+
+! write(*,*) 'Before kcomp-loop'
+
+! SO4(Ait), BC(Ait) and OC(Ait) modes:
+
+ do kcomp=2,3
+
+! write(*,*) 'kcomp = ', kcomp
+
+
+! initialize all output fields Bruk For All istedet?
+ do k=1,pver
+ do icol=1,ncol
+ bext440(icol,k,kcomp)=0.0_r8
+ babs440(icol,k,kcomp)=0.0_r8
+ bext500(icol,k,kcomp)=0.0_r8
+ babs500(icol,k,kcomp)=0.0_r8
+ bext550(icol,k,kcomp)=0.0_r8
+ babs550(icol,k,kcomp)=0.0_r8
+ bext670(icol,k,kcomp)=0.0_r8
+ babs670(icol,k,kcomp)=0.0_r8
+ bext870(icol,k,kcomp)=0.0_r8
+ babs870(icol,k,kcomp)=0.0_r8
+ bebg440(icol,k,kcomp)=0.0_r8
+! babg440(icol,k,kcomp)=0.0_r8
+ bebg500(icol,k,kcomp)=0.0_r8
+! babg500(icol,k,kcomp)=0.0_r8
+ bebg550(icol,k,kcomp)=0.0_r8
+ babg550(icol,k,kcomp)=0.0_r8
+ bebg670(icol,k,kcomp)=0.0_r8
+! babg670(icol,k,kcomp)=0.0_r8
+ bebg870(icol,k,kcomp)=0.0_r8
+! babg870(icol,k,kcomp)=0.0_r8
+ bebc440(icol,k,kcomp)=0.0_r8
+! babc440(icol,k,kcomp)=0.0_r8
+ bebc500(icol,k,kcomp)=0.0_r8
+! babc500(icol,k,kcomp)=0.0_r8
+ bebc550(icol,k,kcomp)=0.0_r8
+ babc550(icol,k,kcomp)=0.0_r8
+ bebc670(icol,k,kcomp)=0.0_r8
+! babc670(icol,k,kcomp)=0.0_r8
+ bebc870(icol,k,kcomp)=0.0_r8
+! babc870(icol,k,kcomp)=0.0_r8
+ beoc440(icol,k,kcomp)=0.0_r8
+! baoc440(icol,k,kcomp)=0.0_r8
+ beoc500(icol,k,kcomp)=0.0_r8
+! baoc500(icol,k,kcomp)=0.0_r8
+ beoc550(icol,k,kcomp)=0.0_r8
+ baoc550(icol,k,kcomp)=0.0_r8
+ beoc670(icol,k,kcomp)=0.0_r8
+! baoc670(icol,k,kcomp)=0.0_r8
+ beoc870(icol,k,kcomp)=0.0_r8
+! baoc870(icol,k,kcomp)=0.0_r8
+ besu440(icol,k,kcomp)=0.0_r8
+! basu440(icol,k,kcomp)=0.0_r8
+ besu500(icol,k,kcomp)=0.0_r8
+! basu500(icol,k,kcomp)=0.0_r8
+ besu550(icol,k,kcomp)=0.0_r8
+ basu550(icol,k,kcomp)=0.0_r8
+ besu670(icol,k,kcomp)=0.0_r8
+! basu670(icol,k,kcomp)=0.0_r8
+ besu870(icol,k,kcomp)=0.0_r8
+! basu870(icol,k,kcomp)=0.0_r8
+ bebg550lt1(icol,k,kcomp)=0.0_r8
+ bebg550gt1(icol,k,kcomp)=0.0_r8
+ bebc550lt1(icol,k,kcomp)=0.0_r8
+ bebc550gt1(icol,k,kcomp)=0.0_r8
+ beoc550lt1(icol,k,kcomp)=0.0_r8
+ beoc550gt1(icol,k,kcomp)=0.0_r8
+ besu550lt1(icol,k,kcomp)=0.0_r8
+ besu550gt1(icol,k,kcomp)=0.0_r8
+ backsc550(icol,k,kcomp)=0.0_r8
+ end do
+ end do
+
+ end do ! kcomp
+
+ do kcomp=2,2 ! kcomp=3 is no longer used
+
+ if(mplus10==0) then
+ kc10=kcomp
+ else
+ kc10=kcomp+10
+ endif
+
+
+ do k=1,pver
+ do icol=1,ncol
+
+ if(Nnatk(icol,k,kc10).gt.0) then
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+
+ t_irh1 = irh1(icol,k)
+ t_irh2 = t_irh1+1
+ t_ict1 = ict1(icol,k,kc10)
+ t_ict2 = t_ict1+1
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+ t_rh1 = rh(t_irh1)
+ t_rh2 = rh(t_irh2)
+ t_cat1 = cate(kcomp,t_ict1)
+ t_cat2 = cate(kcomp,t_ict2)
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+ t_xrh = xrh(icol,k)
+ t_xct = xct(icol,k,kc10)
+ t_xfac = xfac(icol,k,kcomp)
+
+! partial lengths along each dimension (1-4) for interpolation
+ d2mx(1) = (t_rh2-t_xrh)
+ dxm1(1) = (t_xrh-t_rh1)
+ invd(1) = 1.0_r8/(t_rh2-t_rh1)
+ d2mx(2) = (t_cat2-t_xct)
+ dxm1(2) = (t_xct-t_cat1)
+ invd(2) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(3) = (t_fac2-t_xfac)
+ dxm1(3) = (t_xfac-t_fac1)
+ invd(3) = 1.0_r8/(t_fac2-t_fac1)
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+
+ do iv=1,38 ! variable number
+
+! end points as basis for multidimentional linear interpolation
+ opt3d(1,1,1)=bep2to3(iv,t_irh1,t_ict1,t_ifc1,kcomp)
+ opt3d(1,1,2)=bep2to3(iv,t_irh1,t_ict1,t_ifc2,kcomp)
+ opt3d(1,2,1)=bep2to3(iv,t_irh1,t_ict2,t_ifc1,kcomp)
+ opt3d(1,2,2)=bep2to3(iv,t_irh1,t_ict2,t_ifc2,kcomp)
+ opt3d(2,1,1)=bep2to3(iv,t_irh2,t_ict1,t_ifc1,kcomp)
+ opt3d(2,1,2)=bep2to3(iv,t_irh2,t_ict1,t_ifc2,kcomp)
+ opt3d(2,2,1)=bep2to3(iv,t_irh2,t_ict2,t_ifc1,kcomp)
+ opt3d(2,2,2)=bep2to3(iv,t_irh2,t_ict2,t_ifc2,kcomp)
+
+! interpolation in the (fac and) cat dimension
+ call lininterpol3dim (d2mx, dxm1, invd, opt3d, opt1, opt2)
+
+! finally, interpolation in the rh dimension
+ opt(iv)=((t_rh2-t_xrh)*opt1+(t_xrh-t_rh1)*opt2) &
+ /(t_rh2-t_rh1)
+
+
+ end do ! iv=1,38
+
+ bext440(icol,k,kcomp)=opt(1)
+ bext500(icol,k,kcomp)=opt(2)
+ bext670(icol,k,kcomp)=opt(3)
+ bext870(icol,k,kcomp)=opt(4)
+ bebg440(icol,k,kcomp)=opt(5)
+ bebg500(icol,k,kcomp)=opt(6)
+ bebg670(icol,k,kcomp)=opt(7)
+ bebg870(icol,k,kcomp)=opt(8)
+ bebc440(icol,k,kcomp)=opt(9)
+ bebc500(icol,k,kcomp)=opt(10)
+ bebc670(icol,k,kcomp)=opt(11)
+ bebc870(icol,k,kcomp)=opt(12)
+ beoc440(icol,k,kcomp)=opt(13)
+ beoc500(icol,k,kcomp)=opt(14)
+ beoc670(icol,k,kcomp)=opt(15)
+ beoc870(icol,k,kcomp)=opt(16)
+ besu440(icol,k,kcomp)=opt(17)
+ besu500(icol,k,kcomp)=opt(18)
+ besu670(icol,k,kcomp)=opt(19)
+ besu870(icol,k,kcomp)=opt(20)
+ babs440(icol,k,kcomp)=opt(21)
+ babs500(icol,k,kcomp)=opt(22)
+ babs550(icol,k,kcomp)=opt(23)
+ babs670(icol,k,kcomp)=opt(24)
+ babs870(icol,k,kcomp)=opt(25)
+ bebg550lt1(icol,k,kcomp)=opt(26)
+ bebg550gt1(icol,k,kcomp)=opt(27)
+ bebc550lt1(icol,k,kcomp)=opt(28)
+ bebc550gt1(icol,k,kcomp)=opt(29)
+ beoc550lt1(icol,k,kcomp)=opt(30)
+ beoc550gt1(icol,k,kcomp)=opt(31)
+ besu550lt1(icol,k,kcomp)=opt(32)
+ besu550gt1(icol,k,kcomp)=opt(33)
+ backsc550(icol,k,kcomp)=opt(34)
+ babg550(icol,k,kcomp)=opt(35)
+ babc550(icol,k,kcomp)=opt(36)
+ baoc550(icol,k,kcomp)=opt(37)
+ basu550(icol,k,kcomp)=opt(38)
+ bebg550(icol,k,kcomp)=opt(26)+opt(27)
+ bebc550(icol,k,kcomp)=opt(28)+opt(29)
+ beoc550(icol,k,kcomp)=opt(30)+opt(31)
+ besu550(icol,k,kcomp)=opt(32)+opt(33)
+ bext550(icol,k,kcomp)=bebg550(icol,k,kcomp)+bebc550(icol,k,kcomp) &
+ +beoc550(icol,k,kcomp)+besu550(icol,k,kcomp)
+
+ endif ! Nnatk > 0
+
+
+ end do ! icol
+ end do ! k
+
+
+ end do ! kcomp
+
+ return
+end subroutine intaeropt2to3
+
+
+
+
diff --git a/src/physics/cam_oslo/intaeropt4.F90 b/src/physics/cam_oslo/intaeropt4.F90
new file mode 100644
index 0000000000..42ab4e583c
--- /dev/null
+++ b/src/physics/cam_oslo/intaeropt4.F90
@@ -0,0 +1,339 @@
+subroutine intaeropt4 (lchnk, ncol, xrh, irh1, mplus10, Nnatk, &
+ xfbcbg, ifbcbg1, xct, ict1, xfac, ifac1, xfaq, ifaq1, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebg550lt1, bebg550gt1, bebc550lt1, bebc550gt1, &
+ beoc550lt1, beoc550gt1, besu550lt1, besu550gt1, &
+ backsc550, babg550, babc550, baoc550, basu550)
+
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use opttab, only: fbcbg, cate, cat, fac, faq, fbc, rh
+ use commondefinitions, only: nmodes, nbmodes
+
+ implicit none
+
+#include
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ integer, intent(in) :: mplus10 ! mode number (0) or number + 10 (1)
+ real(r8), intent(in) :: xrh(pcols,pver) ! level relative humidity (fraction)
+ integer, intent(in) :: irh1(pcols,pver)
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xfbcbg(pcols,pver)
+ integer, intent(in) :: ifbcbg1(pcols,pver)
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! condensed SOA/(SOA+H2SO4) (1-4) or added carbonaceous fraction (5-10)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfaq(pcols,pver,nbmodes) ! modal SO4(aq)/SO4
+ integer, intent(in) :: ifaq1(pcols,pver,nbmodes)
+
+!
+! Output arguments: Modal total and absorption extiction coefficients (for AeroCom)
+! for 550nm (1) and 865nm (2), and for r<1um (lt1) and r>1um (gt1).
+! March 2009: + backscatter coefficient, backsc550 (km-1 sr-1).
+! Rewritten by Alf Kirkevaag September 2015 to a more generalized for for
+! interpolations using common subroutines interpol*dim.
+
+ real(r8), intent(out) :: &
+ bext440(pcols,pver,0:nbmodes), babs440(pcols,pver,0:nbmodes), &
+ bext500(pcols,pver,0:nbmodes), babs500(pcols,pver,0:nbmodes), &
+ bext550(pcols,pver,0:nbmodes), babs550(pcols,pver,0:nbmodes), &
+ bext670(pcols,pver,0:nbmodes), babs670(pcols,pver,0:nbmodes), &
+ bext870(pcols,pver,0:nbmodes), babs870(pcols,pver,0:nbmodes), &
+ bebg440(pcols,pver,0:nbmodes), & ! babg440(pcols,pver,0:nbmodes), &
+ bebg500(pcols,pver,0:nbmodes), & ! babg500(pcols,pver,0:nbmodes), &
+ bebg550(pcols,pver,0:nbmodes), babg550(pcols,pver,0:nbmodes), &
+ bebg670(pcols,pver,0:nbmodes), & ! babg670(pcols,pver,0:nbmodes), &
+ bebg870(pcols,pver,0:nbmodes), & ! babg870(pcols,pver,0:nbmodes), &
+ bebc440(pcols,pver,0:nbmodes), & ! babc440(pcols,pver,0:nbmodes), &
+ bebc500(pcols,pver,0:nbmodes), & ! babc500(pcols,pver,0:nbmodes), &
+ bebc550(pcols,pver,0:nbmodes), babc550(pcols,pver,0:nbmodes), &
+ bebc670(pcols,pver,0:nbmodes), & ! babc670(pcols,pver,0:nbmodes), &
+ bebc870(pcols,pver,0:nbmodes), & ! babc870(pcols,pver,0:nbmodes), &
+ beoc440(pcols,pver,0:nbmodes), & ! baoc440(pcols,pver,0:nbmodes), &
+ beoc500(pcols,pver,0:nbmodes), & ! baoc500(pcols,pver,0:nbmodes), &
+ beoc550(pcols,pver,0:nbmodes), baoc550(pcols,pver,0:nbmodes), &
+ beoc670(pcols,pver,0:nbmodes), & ! baoc670(pcols,pver,0:nbmodes), &
+ beoc870(pcols,pver,0:nbmodes), & ! baoc870(pcols,pver,0:nbmodes), &
+ besu440(pcols,pver,0:nbmodes), & ! basu440(pcols,pver,0:nbmodes), &
+ besu500(pcols,pver,0:nbmodes), & ! basu500(pcols,pver,0:nbmodes), &
+ besu550(pcols,pver,0:nbmodes), basu550(pcols,pver,0:nbmodes), &
+ besu670(pcols,pver,0:nbmodes), & ! basu670(pcols,pver,0:nbmodes), &
+ besu870(pcols,pver,0:nbmodes), & ! basu870(pcols,pver,0:nbmodes), &
+ bebg550lt1(pcols,pver,0:nbmodes), bebg550gt1(pcols,pver,0:nbmodes), &
+ bebc550lt1(pcols,pver,0:nbmodes), bebc550gt1(pcols,pver,0:nbmodes), &
+ beoc550lt1(pcols,pver,0:nbmodes), beoc550gt1(pcols,pver,0:nbmodes), &
+ besu550lt1(pcols,pver,0:nbmodes), besu550gt1(pcols,pver,0:nbmodes), &
+ backsc550(pcols,pver,0:nbmodes)
+!
+!---------------------------Local variables-----------------------------
+!
+ real(r8) a, b, e, eps
+
+ integer i, iv, kcomp, k, icol, kc10
+
+! Temporary storage of often used array elements
+ integer t_irh1, t_irh2, t_ict1, t_ict2, t_ifc1, t_ifc2, t_ifa1, t_ifa2
+ real(r8) t_fbcbg1, t_fbcbg2
+ integer t_ifb1, t_ifb2
+ real(r8) t_faq1, t_faq2, t_xfaq
+ real(r8) t_fac1, t_fac2, t_xfac
+ real(r8) t_xrh, t_xct, t_rh1, t_rh2
+ real(r8) t_cat1, t_cat2
+ real(r8) t_xfbcbg
+ real(r8) d2mx(5), dxm1(5), invd(5)
+ real(r8) opt5d(2,2,2,2,2)
+ real(r8) opt1, opt2, opt(38)
+
+ parameter (e=2.718281828_r8, eps=1.0e-60_r8)
+
+
+! write(*,*) 'Before kcomp-loop'
+
+! BC&OC(Ait) mode:
+
+ do kcomp=4,4
+
+! write(*,*) 'kcomp = ', kcomp
+
+! initialize all output fields
+ do k=1,pver
+ do icol=1,ncol
+ bext440(icol,k,kcomp)=0.0_r8
+ babs440(icol,k,kcomp)=0.0_r8
+ bext500(icol,k,kcomp)=0.0_r8
+ babs500(icol,k,kcomp)=0.0_r8
+ bext550(icol,k,kcomp)=0.0_r8
+ babs550(icol,k,kcomp)=0.0_r8
+ bext670(icol,k,kcomp)=0.0_r8
+ babs670(icol,k,kcomp)=0.0_r8
+ bext870(icol,k,kcomp)=0.0_r8
+ babs870(icol,k,kcomp)=0.0_r8
+ bebg440(icol,k,kcomp)=0.0_r8
+! babg440(icol,k,kcomp)=0.0_r8
+ bebg500(icol,k,kcomp)=0.0_r8
+! babg500(icol,k,kcomp)=0.0_r8
+ bebg550(icol,k,kcomp)=0.0_r8
+ babg550(icol,k,kcomp)=0.0_r8
+ bebg670(icol,k,kcomp)=0.0_r8
+! babg670(icol,k,kcomp)=0.0_r8
+ bebg870(icol,k,kcomp)=0.0_r8
+! babg870(icol,k,kcomp)=0.0_r8
+ bebc440(icol,k,kcomp)=0.0_r8
+! babc440(icol,k,kcomp)=0.0_r8
+ bebc500(icol,k,kcomp)=0.0_r8
+! babc500(icol,k,kcomp)=0.0_r8
+ bebc550(icol,k,kcomp)=0.0_r8
+ babc550(icol,k,kcomp)=0.0_r8
+ bebc670(icol,k,kcomp)=0.0_r8
+! babc670(icol,k,kcomp)=0.0_r8
+ bebc870(icol,k,kcomp)=0.0_r8
+! babc870(icol,k,kcomp)=0.0_r8
+ beoc440(icol,k,kcomp)=0.0_r8
+! baoc440(icol,k,kcomp)=0.0_r8
+ beoc500(icol,k,kcomp)=0.0_r8
+! baoc500(icol,k,kcomp)=0.0_r8
+ beoc550(icol,k,kcomp)=0.0_r8
+ baoc550(icol,k,kcomp)=0.0_r8
+ beoc670(icol,k,kcomp)=0.0_r8
+! baoc670(icol,k,kcomp)=0.0_r8
+ beoc870(icol,k,kcomp)=0.0_r8
+! baoc870(icol,k,kcomp)=0.0_r8
+ besu440(icol,k,kcomp)=0.0_r8
+! basu440(icol,k,kcomp)=0.0_r8
+ besu500(icol,k,kcomp)=0.0_r8
+! basu500(icol,k,kcomp)=0.0_r8
+ besu550(icol,k,kcomp)=0.0_r8
+ basu550(icol,k,kcomp)=0.0_r8
+ besu670(icol,k,kcomp)=0.0_r8
+! basu670(icol,k,kcomp)=0.0_r8
+ besu870(icol,k,kcomp)=0.0_r8
+! basu870(icol,k,kcomp)=0.0_r8
+ bebg550lt1(icol,k,kcomp)=0.0_r8
+ bebg550gt1(icol,k,kcomp)=0.0_r8
+ bebc550lt1(icol,k,kcomp)=0.0_r8
+ bebc550gt1(icol,k,kcomp)=0.0_r8
+ beoc550lt1(icol,k,kcomp)=0.0_r8
+ beoc550gt1(icol,k,kcomp)=0.0_r8
+ besu550lt1(icol,k,kcomp)=0.0_r8
+ besu550gt1(icol,k,kcomp)=0.0_r8
+ backsc550(icol,k,kcomp)=0.0_r8
+ end do
+ end do
+
+ if(mplus10==0) then
+ kc10=kcomp
+ else
+ kc10=kcomp+10
+ endif
+
+
+ do k=1,pver
+ do icol=1,ncol
+
+ if(Nnatk(icol,k,kc10).gt.0) then
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+
+ t_irh1 = irh1(icol,k)
+ t_irh2 = t_irh1+1
+ t_ifb1 = ifbcbg1(icol,k)
+ t_ifb2 = t_ifb1+1
+ t_ict1 = ict1(icol,k,kc10)
+ t_ict2 = t_ict1+1
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+ t_ifa1 = ifaq1(icol,k,kcomp)
+ t_ifa2 = t_ifa1+1
+
+ t_rh1 = rh(t_irh1)
+ t_rh2 = rh(t_irh2)
+ t_fbcbg1 = fbcbg(t_ifb1)
+ t_fbcbg2 = fbcbg(t_ifb2)
+ t_cat1 = cate(kcomp,t_ict1)
+ t_cat2 = cate(kcomp,t_ict2)
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+ t_faq1 = faq(t_ifa1)
+ t_faq2 = faq(t_ifa2)
+
+ t_xrh = xrh(icol,k)
+ t_xfbcbg = xfbcbg(icol,k)
+ t_xct = xct(icol,k,kc10)
+ t_xfac = xfac(icol,k,kcomp)
+ t_xfaq = xfaq(icol,k,kcomp)
+
+! partial lengths along each dimension (1-5) for interpolation
+ d2mx(1) = (t_rh2-t_xrh)
+ dxm1(1) = (t_xrh-t_rh1)
+ invd(1) = 1.0_r8/(t_rh2-t_rh1)
+ d2mx(2) = (t_fbcbg2-t_xfbcbg)
+ dxm1(2) = (t_xfbcbg-t_fbcbg1)
+ invd(2) = 1.0_r8/(t_fbcbg2-t_fbcbg1)
+ d2mx(3) = (t_cat2-t_xct)
+ dxm1(3) = (t_xct-t_cat1)
+ invd(3) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(4) = (t_fac2-t_xfac)
+ dxm1(4) = (t_xfac-t_fac1)
+ invd(4) = 1.0_r8/(t_fac2-t_fac1)
+ d2mx(5) = (t_faq2-t_xfaq)
+ dxm1(5) = (t_xfaq-t_faq1)
+ invd(5) = 1.0_r8/(t_faq2-t_faq1)
+
+
+ do iv=1,38 ! variable number
+
+ opt5d(1,1,1,1,1)=bep4(iv,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,1,1,1,2)=bep4(iv,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,1,1,2,1)=bep4(iv,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,1,1,2,2)=bep4(iv,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,1,2,1,1)=bep4(iv,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,1,2,1,2)=bep4(iv,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,1,2,2,1)=bep4(iv,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,1,2,2,2)=bep4(iv,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(1,2,1,1,1)=bep4(iv,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,2,1,1,2)=bep4(iv,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,2,1,2,1)=bep4(iv,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,2,1,2,2)=bep4(iv,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,2,2,1,1)=bep4(iv,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,2,2,1,2)=bep4(iv,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,2,2,2,1)=bep4(iv,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,2,2,2,2)=bep4(iv,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,1,1,1,1)=bep4(iv,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,1,1,1,2)=bep4(iv,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,1,1,2,1)=bep4(iv,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,1,1,2,2)=bep4(iv,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,1,2,1,1)=bep4(iv,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,1,2,1,2)=bep4(iv,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,1,2,2,1)=bep4(iv,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,1,2,2,2)=bep4(iv,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,2,1,1,1)=bep4(iv,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,2,1,1,2)=bep4(iv,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,2,1,2,1)=bep4(iv,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,2,1,2,2)=bep4(iv,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,2,2,1,1)=bep4(iv,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,2,2,1,2)=bep4(iv,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,2,2,2,1)=bep4(iv,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,2,2,2,2)=bep4(iv,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+
+! interpolation in the faq, fac, cat and fbcbg dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, opt1, opt2)
+
+! finally, interpolation in the rh dimension
+ opt(iv)=((t_rh2-t_xrh)*opt1+(t_xrh-t_rh1)*opt2) &
+ /(t_rh2-t_rh1)
+
+! write(*,*) opt(iv)
+
+ end do ! iv=1,38
+
+ bext440(icol,k,kcomp)=opt(1)
+ bext500(icol,k,kcomp)=opt(2)
+ bext670(icol,k,kcomp)=opt(3)
+ bext870(icol,k,kcomp)=opt(4)
+ bebg440(icol,k,kcomp)=opt(5)
+ bebg500(icol,k,kcomp)=opt(6)
+ bebg670(icol,k,kcomp)=opt(7)
+ bebg870(icol,k,kcomp)=opt(8)
+ bebc440(icol,k,kcomp)=opt(9)
+ bebc500(icol,k,kcomp)=opt(10)
+ bebc670(icol,k,kcomp)=opt(11)
+ bebc870(icol,k,kcomp)=opt(12)
+ beoc440(icol,k,kcomp)=opt(13)
+ beoc500(icol,k,kcomp)=opt(14)
+ beoc670(icol,k,kcomp)=opt(15)
+ beoc870(icol,k,kcomp)=opt(16)
+ besu440(icol,k,kcomp)=opt(17)
+ besu500(icol,k,kcomp)=opt(18)
+ besu670(icol,k,kcomp)=opt(19)
+ besu870(icol,k,kcomp)=opt(20)
+ babs440(icol,k,kcomp)=opt(21)
+ babs500(icol,k,kcomp)=opt(22)
+ babs550(icol,k,kcomp)=opt(23)
+ babs670(icol,k,kcomp)=opt(24)
+ babs870(icol,k,kcomp)=opt(25)
+ bebg550lt1(icol,k,kcomp)=opt(26)
+ bebg550gt1(icol,k,kcomp)=opt(27)
+ bebc550lt1(icol,k,kcomp)=opt(28)
+ bebc550gt1(icol,k,kcomp)=opt(29)
+ beoc550lt1(icol,k,kcomp)=opt(30)
+ beoc550gt1(icol,k,kcomp)=opt(31)
+ besu550lt1(icol,k,kcomp)=opt(32)
+ besu550gt1(icol,k,kcomp)=opt(33)
+ backsc550(icol,k,kcomp)=opt(34)
+ babg550(icol,k,kcomp)=opt(35)
+ babc550(icol,k,kcomp)=opt(36)
+ baoc550(icol,k,kcomp)=opt(37)
+ basu550(icol,k,kcomp)=opt(38)
+ bebg550(icol,k,kcomp)=opt(26)+opt(27)
+ bebc550(icol,k,kcomp)=opt(28)+opt(29)
+ beoc550(icol,k,kcomp)=opt(30)+opt(31)
+ besu550(icol,k,kcomp)=opt(32)+opt(33)
+ bext550(icol,k,kcomp)=bebg550(icol,k,kcomp)+bebc550(icol,k,kcomp) &
+ +beoc550(icol,k,kcomp)+besu550(icol,k,kcomp)
+
+ endif
+
+ end do ! icol
+ end do ! k
+
+ end do ! kcomp
+
+ return
+
+end subroutine intaeropt4
+
+
+
+
diff --git a/src/physics/cam_oslo/intaeropt5to10.F90 b/src/physics/cam_oslo/intaeropt5to10.F90
new file mode 100644
index 0000000000..11226da38d
--- /dev/null
+++ b/src/physics/cam_oslo/intaeropt5to10.F90
@@ -0,0 +1,334 @@
+subroutine intaeropt5to10 (lchnk, ncol, xrh, irh1, Nnatk, &
+ xct, ict1, xfac, ifac1, xfbc, ifbc1, xfaq, ifaq1, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebg550lt1, bebg550gt1, bebc550lt1, bebc550gt1, &
+ beoc550lt1, beoc550gt1, besu550lt1, besu550gt1, &
+ backsc550, babg550, babc550, baoc550, basu550)
+
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use opttab, only: cate, cat, fac, faq, fbc, rh
+ use commondefinitions, only: nmodes, nbmodes
+
+ implicit none
+
+#include
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ real(r8), intent(in) :: xrh(pcols,pver) ! level relative humidity (fraction)
+ integer, intent(in) :: irh1(pcols,pver)
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! modal (OC+BC)/(SO4+BC+OC)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfbc(pcols,pver,nbmodes) ! modal BC/(OC+BC)
+ integer, intent(in) :: ifbc1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfaq(pcols,pver,nbmodes) ! modal SO4(aq)/SO4
+ integer, intent(in) :: ifaq1(pcols,pver,nbmodes)
+!
+! Output arguments: Modal total and absorption extiction coefficients (for AeroCom)
+! for 550nm (1) and 865nm (2), and for r<1um (lt1) and r>1um (gt1).
+! March 2009: + backscatter coefficient, backsc550 (km-1 sr-1).
+! Rewritten by Alf Kirkevaag September 2015 to a more generalized for for
+! interpolations using common subroutines interpol*dim.
+!
+ real(r8), intent(out) :: &
+ bext440(pcols,pver,0:nbmodes), babs440(pcols,pver,0:nbmodes), &
+ bext500(pcols,pver,0:nbmodes), babs500(pcols,pver,0:nbmodes), &
+ bext550(pcols,pver,0:nbmodes), babs550(pcols,pver,0:nbmodes), &
+ bext670(pcols,pver,0:nbmodes), babs670(pcols,pver,0:nbmodes), &
+ bext870(pcols,pver,0:nbmodes), babs870(pcols,pver,0:nbmodes), &
+ bebg440(pcols,pver,0:nbmodes), & ! babg440(pcols,pver,0:nbmodes), &
+ bebg500(pcols,pver,0:nbmodes), & ! babg500(pcols,pver,0:nbmodes), &
+ bebg550(pcols,pver,0:nbmodes), babg550(pcols,pver,0:nbmodes), &
+ bebg670(pcols,pver,0:nbmodes), & ! babg670(pcols,pver,0:nbmodes), &
+ bebg870(pcols,pver,0:nbmodes), & ! babg870(pcols,pver,0:nbmodes), &
+ bebc440(pcols,pver,0:nbmodes), & ! babc440(pcols,pver,0:nbmodes), &
+ bebc500(pcols,pver,0:nbmodes), & ! babc500(pcols,pver,0:nbmodes), &
+ bebc550(pcols,pver,0:nbmodes), babc550(pcols,pver,0:nbmodes), &
+ bebc670(pcols,pver,0:nbmodes), & ! babc670(pcols,pver,0:nbmodes), &
+ bebc870(pcols,pver,0:nbmodes), & ! babc870(pcols,pver,0:nbmodes), &
+ beoc440(pcols,pver,0:nbmodes), & ! baoc440(pcols,pver,0:nbmodes), &
+ beoc500(pcols,pver,0:nbmodes), & ! baoc500(pcols,pver,0:nbmodes), &
+ beoc550(pcols,pver,0:nbmodes), baoc550(pcols,pver,0:nbmodes), &
+ beoc670(pcols,pver,0:nbmodes), & ! baoc670(pcols,pver,0:nbmodes), &
+ beoc870(pcols,pver,0:nbmodes), & ! baoc870(pcols,pver,0:nbmodes), &
+ besu440(pcols,pver,0:nbmodes), & ! basu440(pcols,pver,0:nbmodes), &
+ besu500(pcols,pver,0:nbmodes), & ! basu500(pcols,pver,0:nbmodes), &
+ besu550(pcols,pver,0:nbmodes), basu550(pcols,pver,0:nbmodes), &
+ besu670(pcols,pver,0:nbmodes), & ! basu670(pcols,pver,0:nbmodes), &
+ besu870(pcols,pver,0:nbmodes), & ! basu870(pcols,pver,0:nbmodes), &
+ bebg550lt1(pcols,pver,0:nbmodes), bebg550gt1(pcols,pver,0:nbmodes), &
+ bebc550lt1(pcols,pver,0:nbmodes), bebc550gt1(pcols,pver,0:nbmodes), &
+ beoc550lt1(pcols,pver,0:nbmodes), beoc550gt1(pcols,pver,0:nbmodes), &
+ besu550lt1(pcols,pver,0:nbmodes), besu550gt1(pcols,pver,0:nbmodes), &
+ backsc550(pcols,pver,0:nbmodes)
+!
+!---------------------------Local variables-----------------------------
+!
+ real(r8) a, b, e, eps
+
+ integer i, iv, kcomp, k, icol
+
+! Temporary storage of often used array elements
+ integer t_irh1, t_irh2, t_ict1, t_ict2, t_ifa1, t_ifa2
+ integer t_ifb1, t_ifb2, t_ifc1, t_ifc2
+ real(r8) t_faq1, t_faq2, t_xfaq
+ real(r8) t_fbc1, t_fbc2, t_xfbc
+ real(r8) t_fac1, t_fac2, t_xfac
+ real(r8) t_xrh, t_xct, t_rh1, t_rh2
+ real(r8) t_cat1, t_cat2
+ real(r8) d2mx(5), dxm1(5), invd(5)
+ real(r8) opt5d(2,2,2,2,2)
+ real(r8) opt1, opt2, opt(38)
+
+ parameter (e=2.718281828_r8, eps=1.0e-60_r8)
+
+
+! write(*,*) 'Before kcomp-loop'
+
+! Modes 5 to 10 (SO4(Ait75) and mineral and seasalt-modes + cond./coag./aq.):
+
+ do kcomp=5,10
+
+! write(*,*) 'kcomp = ', kcomp
+
+! initialize all output fields
+ do k=1,pver
+ do icol=1,ncol
+ bext440(icol,k,kcomp)=0.0_r8
+ babs440(icol,k,kcomp)=0.0_r8
+ bext500(icol,k,kcomp)=0.0_r8
+ babs500(icol,k,kcomp)=0.0_r8
+ bext550(icol,k,kcomp)=0.0_r8
+ babs550(icol,k,kcomp)=0.0_r8
+ bext670(icol,k,kcomp)=0.0_r8
+ babs670(icol,k,kcomp)=0.0_r8
+ bext870(icol,k,kcomp)=0.0_r8
+ babs870(icol,k,kcomp)=0.0_r8
+ bebg440(icol,k,kcomp)=0.0_r8
+! babg440(icol,k,kcomp)=0.0_r8
+ bebg500(icol,k,kcomp)=0.0_r8
+! babg500(icol,k,kcomp)=0.0_r8
+ bebg550(icol,k,kcomp)=0.0_r8
+ babg550(icol,k,kcomp)=0.0_r8
+ bebg670(icol,k,kcomp)=0.0_r8
+! babg670(icol,k,kcomp)=0.0_r8
+ bebg870(icol,k,kcomp)=0.0_r8
+! babg870(icol,k,kcomp)=0.0_r8
+ bebc440(icol,k,kcomp)=0.0_r8
+! babc440(icol,k,kcomp)=0.0_r8
+ bebc500(icol,k,kcomp)=0.0_r8
+! babc500(icol,k,kcomp)=0.0_r8
+ bebc550(icol,k,kcomp)=0.0_r8
+ babc550(icol,k,kcomp)=0.0_r8
+ bebc670(icol,k,kcomp)=0.0_r8
+! babc670(icol,k,kcomp)=0.0_r8
+ bebc870(icol,k,kcomp)=0.0_r8
+! babc870(icol,k,kcomp)=0.0_r8
+ beoc440(icol,k,kcomp)=0.0_r8
+! baoc440(icol,k,kcomp)=0.0_r8
+ beoc500(icol,k,kcomp)=0.0_r8
+! baoc500(icol,k,kcomp)=0.0_r8
+ beoc550(icol,k,kcomp)=0.0_r8
+ baoc550(icol,k,kcomp)=0.0_r8
+ beoc670(icol,k,kcomp)=0.0_r8
+! baoc670(icol,k,kcomp)=0.0_r8
+ beoc870(icol,k,kcomp)=0.0_r8
+! baoc870(icol,k,kcomp)=0.0_r8
+ besu440(icol,k,kcomp)=0.0_r8
+! basu440(icol,k,kcomp)=0.0_r8
+ besu500(icol,k,kcomp)=0.0_r8
+! basu500(icol,k,kcomp)=0.0_r8
+ besu550(icol,k,kcomp)=0.0_r8
+ basu550(icol,k,kcomp)=0.0_r8
+ besu670(icol,k,kcomp)=0.0_r8
+! basu670(icol,k,kcomp)=0.0_r8
+ besu870(icol,k,kcomp)=0.0_r8
+! basu870(icol,k,kcomp)=0.0_r8
+ bebg550lt1(icol,k,kcomp)=0.0_r8
+ bebg550gt1(icol,k,kcomp)=0.0_r8
+ bebc550lt1(icol,k,kcomp)=0.0_r8
+ bebc550gt1(icol,k,kcomp)=0.0_r8
+ beoc550lt1(icol,k,kcomp)=0.0_r8
+ beoc550gt1(icol,k,kcomp)=0.0_r8
+ besu550lt1(icol,k,kcomp)=0.0_r8
+ besu550gt1(icol,k,kcomp)=0.0_r8
+ backsc550(icol,k,kcomp)=0.0_r8
+ end do
+ end do
+
+
+ do k=1,pver
+ do icol=1,ncol
+
+ if(Nnatk(icol,k,kcomp).gt.0) then
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+
+ t_irh1 = irh1(icol,k)
+ t_irh2 = t_irh1+1
+ t_ict1 = ict1(icol,k,kcomp)
+ t_ict2 = t_ict1+1
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+
+ t_ifb1 = ifbc1(icol,k,kcomp)
+ t_ifb2 = t_ifb1+1
+ t_ifa1 = ifaq1(icol,k,kcomp)
+ t_ifa2 = t_ifa1+1
+
+ t_rh1 = rh(t_irh1)
+ t_rh2 = rh(t_irh2)
+ t_cat1 = cat(kcomp,t_ict1)
+ t_cat2 = cat(kcomp,t_ict2)
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+ t_fbc1 = fbc(t_ifb1)
+ t_fbc2 = fbc(t_ifb2)
+ t_faq1 = faq(t_ifa1)
+ t_faq2 = faq(t_ifa2)
+
+ t_xrh = xrh(icol,k)
+ t_xct = xct(icol,k,kcomp)
+ t_xfac = xfac(icol,k,kcomp)
+ t_xfbc = xfbc(icol,k,kcomp)
+ t_xfaq = xfaq(icol,k,kcomp)
+
+! partial lengths along each dimension (1-5) for interpolation
+ d2mx(1) = (t_rh2-t_xrh)
+ dxm1(1) = (t_xrh-t_rh1)
+ invd(1) = 1.0_r8/(t_rh2-t_rh1)
+ d2mx(2) = (t_cat2-t_xct)
+ dxm1(2) = (t_xct-t_cat1)
+ invd(2) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(3) = (t_fac2-t_xfac)
+ dxm1(3) = (t_xfac-t_fac1)
+ invd(3) = 1.0_r8/(t_fac2-t_fac1)
+ d2mx(4) = (t_fbc2-t_xfbc)
+ dxm1(4) = (t_xfbc-t_fbc1)
+ invd(4) = 1.0_r8/(t_fbc2-t_fbc1)
+ d2mx(5) = (t_faq2-t_xfaq)
+ dxm1(5) = (t_xfaq-t_faq1)
+ invd(5) = 1.0_r8/(t_faq2-t_faq1)
+
+
+ do iv=1,38 ! variable number
+
+ opt5d(1,1,1,1,1)=bep5to10(iv,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,1,1,2)=bep5to10(iv,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,1,2,1)=bep5to10(iv,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,1,2,2)=bep5to10(iv,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,1,2,1,1)=bep5to10(iv,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,2,1,2)=bep5to10(iv,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,2,2,1)=bep5to10(iv,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,2,2,2)=bep5to10(iv,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,1,1,1)=bep5to10(iv,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,1,1,2)=bep5to10(iv,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,1,2,1)=bep5to10(iv,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,1,2,2)=bep5to10(iv,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,2,1,1)=bep5to10(iv,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,2,1,2)=bep5to10(iv,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,2,2,1)=bep5to10(iv,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,2,2,2)=bep5to10(iv,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,1,1,1)=bep5to10(iv,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,1,1,2)=bep5to10(iv,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,1,2,1)=bep5to10(iv,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,1,2,2)=bep5to10(iv,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,2,1,1)=bep5to10(iv,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,2,1,2)=bep5to10(iv,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,2,2,1)=bep5to10(iv,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,2,2,2)=bep5to10(iv,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,1,1,1)=bep5to10(iv,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,1,1,2)=bep5to10(iv,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,1,2,1)=bep5to10(iv,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,1,2,2)=bep5to10(iv,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,2,1,1)=bep5to10(iv,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,2,1,2)=bep5to10(iv,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,2,2,1)=bep5to10(iv,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,2,2,2)=bep5to10(iv,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+
+! interpolation in the faq, fbc, fac and cat dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, opt1, opt2)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before opt'
+
+ opt(iv)=((t_rh2-t_xrh)*opt1+(t_xrh-t_rh1)*opt2) &
+ /(t_rh2-t_rh1)
+
+! write(*,*) opt(iv)
+
+ end do ! iv=1,38
+
+ bext440(icol,k,kcomp)=opt(1)
+ bext500(icol,k,kcomp)=opt(2)
+ bext670(icol,k,kcomp)=opt(3)
+ bext870(icol,k,kcomp)=opt(4)
+ bebg440(icol,k,kcomp)=opt(5)
+ bebg500(icol,k,kcomp)=opt(6)
+ bebg670(icol,k,kcomp)=opt(7)
+ bebg870(icol,k,kcomp)=opt(8)
+ bebc440(icol,k,kcomp)=opt(9)
+ bebc500(icol,k,kcomp)=opt(10)
+ bebc670(icol,k,kcomp)=opt(11)
+ bebc870(icol,k,kcomp)=opt(12)
+ beoc440(icol,k,kcomp)=opt(13)
+ beoc500(icol,k,kcomp)=opt(14)
+ beoc670(icol,k,kcomp)=opt(15)
+ beoc870(icol,k,kcomp)=opt(16)
+ besu440(icol,k,kcomp)=opt(17)
+ besu500(icol,k,kcomp)=opt(18)
+ besu670(icol,k,kcomp)=opt(19)
+ besu870(icol,k,kcomp)=opt(20)
+ babs440(icol,k,kcomp)=opt(21)
+ babs500(icol,k,kcomp)=opt(22)
+ babs550(icol,k,kcomp)=opt(23)
+ babs670(icol,k,kcomp)=opt(24)
+ babs870(icol,k,kcomp)=opt(25)
+ bebg550lt1(icol,k,kcomp)=opt(26)
+ bebg550gt1(icol,k,kcomp)=opt(27)
+ bebc550lt1(icol,k,kcomp)=opt(28)
+ bebc550gt1(icol,k,kcomp)=opt(29)
+ beoc550lt1(icol,k,kcomp)=opt(30)
+ beoc550gt1(icol,k,kcomp)=opt(31)
+ besu550lt1(icol,k,kcomp)=opt(32)
+ besu550gt1(icol,k,kcomp)=opt(33)
+ backsc550(icol,k,kcomp)=opt(34)
+ babg550(icol,k,kcomp)=opt(35)
+ babc550(icol,k,kcomp)=opt(36)
+ baoc550(icol,k,kcomp)=opt(37)
+ basu550(icol,k,kcomp)=opt(38)
+ bebg550(icol,k,kcomp)=opt(26)+opt(27)
+ bebc550(icol,k,kcomp)=opt(28)+opt(29)
+ beoc550(icol,k,kcomp)=opt(30)+opt(31)
+ besu550(icol,k,kcomp)=opt(32)+opt(33)
+ bext550(icol,k,kcomp)=bebg550(icol,k,kcomp)+bebc550(icol,k,kcomp) &
+ +beoc550(icol,k,kcomp)+besu550(icol,k,kcomp)
+
+ endif
+
+
+ end do ! icol
+ end do ! k
+
+ end do ! kcomp
+
+ return
+
+end subroutine intaeropt5to10
+
+
+
+
diff --git a/src/physics/cam_oslo/intdrypar0.F90 b/src/physics/cam_oslo/intdrypar0.F90
new file mode 100644
index 0000000000..21c416a048
--- /dev/null
+++ b/src/physics/cam_oslo/intdrypar0.F90
@@ -0,0 +1,148 @@
+subroutine intdrypar0 (lchnk, ncol, Nnatk, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol,&
+ cknorm,cknlt05,ckngt125)
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use opttab, only: cate, cat, fac, faq, fbc, rh
+ use commondefinitions, only: nmodes, nbmodes
+
+ implicit none
+
+#include
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+!
+! Input-Output arguments
+!
+ real(r8), intent(inout) :: &
+ cknorm(pcols,pver,0:nmodes), cknlt05(pcols,pver,0:nmodes), ckngt125(pcols,pver,0:nmodes)
+!
+! Output arguments: Modal mass concentrations (cint), area (aaero) and volume (vaero)
+! (for AeroCom determination of particle effective radii) of each constituent. cint*05
+! and cint*125 are for r<0.5um and r>1.25um, respectively. aaeros and vaeros are
+! integrated over r<0.5um, and aaerol and vaerol over r>0.5um.
+!
+ real(r8), intent(out) :: &
+ cintbg(pcols,pver,0:nbmodes), cintbg05(pcols,pver,0:nbmodes), cintbg125(pcols,pver,0:nbmodes), &
+ cintbc(pcols,pver,0:nbmodes), cintbc05(pcols,pver,0:nbmodes), cintbc125(pcols,pver,0:nbmodes), &
+ cintoc(pcols,pver,0:nbmodes), cintoc05(pcols,pver,0:nbmodes), cintoc125(pcols,pver,0:nbmodes), &
+ cintsc(pcols,pver,0:nbmodes), cintsc05(pcols,pver,0:nbmodes), cintsc125(pcols,pver,0:nbmodes), &
+ cintsa(pcols,pver,0:nbmodes), cintsa05(pcols,pver,0:nbmodes), cintsa125(pcols,pver,0:nbmodes), &
+ aaeros(pcols,pver,0:nbmodes), aaerol(pcols,pver,0:nbmodes), &
+ vaeros(pcols,pver,0:nbmodes), vaerol(pcols,pver,0:nbmodes)
+!
+!---------------------------Local variables-----------------------------
+!
+ real(r8) a, b, e, eps
+
+ integer i, ierr, kcomp, k, icol
+
+ parameter (eps=1.0e-60_r8)
+
+! Mode 0, BC(ax):
+
+ kcomp=0
+
+! initialize output fields
+ do k=1,pver
+ do icol=1,ncol
+ cintbg(icol,k,kcomp)=0.0_r8
+ cintbg05(icol,k,kcomp)=0.0_r8
+ cintbg125(icol,k,kcomp)=0.0_r8
+ cintbc(icol,k,kcomp)=0.0_r8
+ cintbc05(icol,k,kcomp)=0.0_r8
+ cintbc125(icol,k,kcomp)=0.0_r8
+ cintoc(icol,k,kcomp)=0.0_r8
+ cintoc05(icol,k,kcomp)=0.0_r8
+ cintoc125(icol,k,kcomp)=0.0_r8
+ cintsc(icol,k,kcomp)=0.0_r8
+ cintsc05(icol,k,kcomp)=0.0_r8
+ cintsc125(icol,k,kcomp)=0.0_r8
+ cintsa(icol,k,kcomp)=0.0_r8
+ cintsa05(icol,k,kcomp)=0.0_r8
+ cintsa125(icol,k,kcomp)=0.0_r8
+ aaeros(icol,k,kcomp)=0.0_r8
+ aaerol(icol,k,kcomp)=0.0_r8
+ vaeros(icol,k,kcomp)=0.0_r8
+ vaerol(icol,k,kcomp)=0.0_r8
+ end do
+ end do
+
+ do k=1,pver
+ do icol=1,ncol
+
+ if(Nnatk(icol,k,kcomp)>0.0_r8) then
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ do i=1,19 ! variable number
+
+ if(i==1) then
+ cintbg(icol,k,kcomp)=a0cintbg
+ elseif(i==2) then
+ cintbg05(icol,k,kcomp)=a0cintbg05
+ elseif(i==3) then
+ cintbg125(icol,k,kcomp)=a0cintbg125
+ elseif(i==4) then
+ cintbc(icol,k,kcomp)=eps
+ elseif(i==5) then
+ cintbc05(icol,k,kcomp)=eps
+ elseif(i==6) then
+ cintbc125(icol,k,kcomp)=eps
+ elseif(i==7) then
+ cintoc(icol,k,kcomp)=eps
+ elseif(i==8) then
+ cintoc05(icol,k,kcomp)=eps
+ elseif(i==9) then
+ cintoc125(icol,k,kcomp)=eps
+ elseif(i==10) then
+ cintsc(icol,k,kcomp)=eps
+ elseif(i==11) then
+ cintsc05(icol,k,kcomp)=eps
+ elseif(i==12) then
+ cintsc125(icol,k,kcomp)=eps
+ elseif(i==13) then
+ cintsa(icol,k,kcomp)=eps
+ elseif(i==14) then
+ cintsa05(icol,k,kcomp)=eps
+ elseif(i==15) then
+ cintsa125(icol,k,kcomp)=eps
+ elseif(i==16) then
+ aaeros(icol,k,kcomp)=a0aaeros
+ elseif(i==17) then
+ aaerol(icol,k,kcomp)=a0aaerol
+ elseif(i==18) then
+ vaeros(icol,k,kcomp)=a0vaeros
+ elseif(i==19) then
+ vaerol(icol,k,kcomp)=a0vaerol
+ endif
+
+ end do ! i=1,19
+
+ endif
+
+ cknorm(icol,k,kcomp) = a0cintbg
+ cknlt05(icol,k,kcomp) = a0cintbg05
+ ckngt125(icol,k,kcomp)= a0cintbg125
+
+! if(k.eq.1.or.k.eq.pver) write(*,*) 'cknorm =', cknorm(icol,k,kcomp)
+! if(k.eq.1.or.k.eq.pver) write(*,*) 'cknlt05 =', cknlt05(icol,k,kcomp)
+! if(k.eq.1.or.k.eq.pver) write(*,*) 'ckngt125 =', ckngt125(icol,k,kcomp)
+
+ end do ! icol
+ end do ! k
+
+
+ return
+end subroutine intdrypar0
+
+
+
+
diff --git a/src/physics/cam_oslo/intdrypar1.F90 b/src/physics/cam_oslo/intdrypar1.F90
new file mode 100644
index 0000000000..6265ce4b66
--- /dev/null
+++ b/src/physics/cam_oslo/intdrypar1.F90
@@ -0,0 +1,274 @@
+subroutine intdrypar1 (lchnk, ncol, Nnatk, xfombg, ifombg1, xct, ict1, xfac, ifac1, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol, &
+ aaerosn,aaeroln,vaerosn,vaeroln,cknorm,cknlt05,ckngt125)
+
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use opttab, only: fombg, cate, cat, fac, faq, nbmp1
+ use commondefinitions, only: nmodes, nbmodes
+
+ implicit none
+
+#include
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xfombg(pcols,pver) ! SOA/(SOA+H2SO4) for the background mode (1)
+ integer, intent(in) :: ifombg1(pcols,pver)
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! condensed SOA/(SOA+H2SO4) (1-4) or added carbonaceous fraction (5-10)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+!
+! Input-Output arguments
+!
+ real(r8), intent(inout) :: &
+ aaerosn(pcols,pver,nbmp1:nmodes), aaeroln(pcols,pver,nbmp1:nmodes), &
+ vaerosn(pcols,pver,nbmp1:nmodes), vaeroln(pcols,pver,nbmp1:nmodes), &
+ cknorm(pcols,pver,0:nmodes), cknlt05(pcols,pver,0:nmodes), ckngt125(pcols,pver,0:nmodes)
+!
+!
+! Output arguments: Modal mass concentrations (cint), area (aaero) and volume (vaero)
+! (for AeroCom determination of particle effective radii) of each constituent. cint*05
+! and cint*125 are for r<0.5um and r>1.25um, respectively. aaeros and vaeros are
+! integrated over r<0.5um, and aaerol and vaerol over r>0.5um.
+!
+ real(r8), intent(out) :: &
+ cintbg(pcols,pver,0:nbmodes), cintbg05(pcols,pver,0:nbmodes), cintbg125(pcols,pver,0:nbmodes), &
+ cintbc(pcols,pver,0:nbmodes), cintbc05(pcols,pver,0:nbmodes), cintbc125(pcols,pver,0:nbmodes), &
+ cintoc(pcols,pver,0:nbmodes), cintoc05(pcols,pver,0:nbmodes), cintoc125(pcols,pver,0:nbmodes), &
+ cintsc(pcols,pver,0:nbmodes), cintsc05(pcols,pver,0:nbmodes), cintsc125(pcols,pver,0:nbmodes), &
+ cintsa(pcols,pver,0:nbmodes), cintsa05(pcols,pver,0:nbmodes), cintsa125(pcols,pver,0:nbmodes), &
+ aaeros(pcols,pver,0:nbmodes), aaerol(pcols,pver,0:nbmodes), &
+ vaeros(pcols,pver,0:nbmodes), vaerol(pcols,pver,0:nbmodes)
+!
+!---------------------------Local variables-----------------------------
+!
+ real(r8) a, b, e, eps
+
+ integer iv, kcomp, k, icol
+
+! Temporary storage of often used array elements
+ integer t_ifo1, t_ifo2
+ integer t_ict1, t_ict2, t_ifc1, t_ifc2
+ real(r8) t_xct, t_cat1, t_cat2
+ real(r8) t_fac1, t_fac2, t_xfac
+ real(r8) t_fombg1, t_fombg2, t_xfombg, t_xfombgn
+
+ real(r8) d2mx(3), dxm1(3), invd(3)
+ real(r8) opt3d(2,2,2)
+ real(r8) opt1, opt2, opt
+
+ parameter (e=2.718281828_r8, eps=1.0e-60_r8)
+
+
+! write(*,*) 'Before kcomp-loop'
+
+! Mode 1, SO4(Ait):
+
+ kcomp=1
+
+! initialize output fields
+ do k=1,pver
+ do icol=1,ncol
+ cintbg(icol,k,kcomp)=0.0_r8
+ cintbg05(icol,k,kcomp)=0.0_r8
+ cintbg125(icol,k,kcomp)=0.0_r8
+ cintbc(icol,k,kcomp)=0.0_r8
+ cintbc05(icol,k,kcomp)=0.0_r8
+ cintbc125(icol,k,kcomp)=0.0_r8
+ cintoc(icol,k,kcomp)=0.0_r8
+ cintoc05(icol,k,kcomp)=0.0_r8
+ cintoc125(icol,k,kcomp)=0.0_r8
+ cintsc(icol,k,kcomp)=0.0_r8
+ cintsc05(icol,k,kcomp)=0.0_r8
+ cintsc125(icol,k,kcomp)=0.0_r8
+ cintsa(icol,k,kcomp)=0.0_r8
+ cintsa05(icol,k,kcomp)=0.0_r8
+ cintsa125(icol,k,kcomp)=0.0_r8
+ aaeros(icol,k,kcomp)=0.0_r8
+ aaerol(icol,k,kcomp)=0.0_r8
+ vaeros(icol,k,kcomp)=0.0_r8
+ vaerol(icol,k,kcomp)=0.0_r8
+ end do
+ end do
+
+ do k=1,pver
+ do icol=1,ncol
+
+ if(Nnatk(icol,k,kcomp)>0.0_r8) then
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+ t_ifo1 = ifombg1(icol,k)
+ t_ifo2 = t_ifo1+1
+ t_fombg1 = fombg(t_ifo1)
+ t_fombg2 = fombg(t_ifo2)
+ t_xfombg = xfombg(icol,k)
+ t_ict1 = ict1(icol,k,kcomp)
+ t_ict2 = t_ict1+1
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+ t_cat1 = cate(kcomp,t_ict1)
+ t_cat2 = cate(kcomp,t_ict2)
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+ t_xct = xct(icol,k,kcomp)
+ t_xfac = xfac(icol,k,kcomp)
+
+! partial lengths along each dimension (1-3) for interpolation
+ d2mx(1) = (t_fombg2-t_xfombg)
+ dxm1(1) = (t_xfombg-t_fombg1)
+ invd(1) = 1.0_r8/(t_fombg2-t_fombg1)
+ d2mx(2) = (t_cat2-t_xct)
+ dxm1(2) = (t_xct-t_cat1)
+ invd(2) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(3) = (t_fac2-t_xfac)
+ dxm1(3) = (t_xfac-t_fac1)
+ invd(3) = 1.0_r8/(t_fac2-t_fac1)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ do iv=1,19 ! variable number
+
+! end points as basis for multidimentional linear interpolation
+ opt3d(1,1,1)=a1var(iv,t_ifo1,t_ict1,t_ifc1)
+ opt3d(1,1,2)=a1var(iv,t_ifo1,t_ict1,t_ifc2)
+ opt3d(1,2,1)=a1var(iv,t_ifo1,t_ict2,t_ifc1)
+ opt3d(1,2,2)=a1var(iv,t_ifo1,t_ict2,t_ifc2)
+ opt3d(2,1,1)=a1var(iv,t_ifo2,t_ict1,t_ifc1)
+ opt3d(2,1,2)=a1var(iv,t_ifo2,t_ict1,t_ifc2)
+ opt3d(2,2,1)=a1var(iv,t_ifo2,t_ict2,t_ifc1)
+ opt3d(2,2,2)=a1var(iv,t_ifo2,t_ict2,t_ifc2)
+
+! interpolation in the fac and cat dimensions
+ call lininterpol3dim (d2mx, dxm1, invd, opt3d, opt1, opt2)
+
+! finally, interpolation in the fombg dimension
+ opt = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+
+! if(k.eq.1) write(*,*) 'opt1 =', opt
+
+
+! write(*,*) 'Before array'
+
+ if(iv==1) then
+ cintbg(icol,k,kcomp)=opt
+ elseif(iv==2) then
+ cintbg05(icol,k,kcomp)=opt
+ elseif(iv==3) then
+ cintbg125(icol,k,kcomp)=opt
+ elseif(iv==4) then
+ cintbc(icol,k,kcomp)=opt
+ elseif(iv==5) then
+ cintbc05(icol,k,kcomp)=opt
+ elseif(iv==6) then
+ cintbc125(icol,k,kcomp)=opt
+ elseif(iv==7) then
+ cintoc(icol,k,kcomp)=opt
+ elseif(iv==8) then
+ cintoc05(icol,k,kcomp)=opt
+ elseif(iv==9) then
+ cintoc125(icol,k,kcomp)=opt
+ elseif(iv==10) then
+ cintsc(icol,k,kcomp)=opt
+ elseif(iv==11) then
+ cintsc05(icol,k,kcomp)=opt
+ elseif(iv==12) then
+ cintsc125(icol,k,kcomp)=opt
+ elseif(iv==13) then
+ cintsa(icol,k,kcomp)=opt
+ elseif(iv==14) then
+ cintsa05(icol,k,kcomp)=opt
+ elseif(iv==15) then
+ cintsa125(icol,k,kcomp)=opt
+ elseif(iv==16) then
+ aaeros(icol,k,kcomp)=opt
+ elseif(iv==17) then
+ aaerol(icol,k,kcomp)=opt
+ elseif(iv==18) then
+ vaeros(icol,k,kcomp)=opt
+ elseif(iv==19) then
+ vaerol(icol,k,kcomp)=opt
+ endif
+
+ end do ! iv=1,19
+
+ endif
+
+ end do ! icol
+ end do ! k
+
+
+! Dry parameters for externally mixed mode 11,
+! SO4(n):
+
+ kcomp=11
+
+ do k=1,pver
+ do icol=1,ncol
+
+! xfombgn(icol,k) = min(max(xfombgnin(icol,k),fombg(1)),fombg(6))
+! write(*,*) 'Before fombg-loop', kcomp
+! do ifombg=1,5
+! if(xfombgn(icol,k) >= fombg(ifombg).and. &
+! xfombgn(icol,k) <= fombg(ifombg+1)) then
+! ifombgn1(icol,k)=ifombg
+! ifombgn2(icol,k)=ifombg+1
+! endif
+! end do ! ifombg
+! t_ifo1 = ifombgn1(icol,k)
+! t_ifo2 = ifombgn2(icol,k)
+! t_fombg1 = fombg(t_ifo1)
+! t_fombg2 = fombg(t_ifo2)
+! t_xfombg = xfombgn(icol,k)
+! d2mx(1) = (t_fombg2-t_xfombg)
+! dxm1(1) = (t_xfombg-t_fombg1)
+! invd(1) = 1.0_r8/(t_fombg2-t_fombg1)
+!! Only interpolation in the fombg dimension for mode 11
+! opt1 = a1var(1,1,1,1)
+! opt2 = a1var(1,2,1,1)
+! cknorm(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+! opt1 = a1var(2,1,1,1)
+! opt2 = a1var(2,2,1,1)
+! cknlt05(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+! opt1 = a1var(3,1,1,1)
+! opt2 = a1var(3,2,1,1)
+! ckngt125(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+!! (The remaining variables are actually independent of fbcbg,
+!! but we follow the same procedure anyway:)
+! opt1 = a1var(16,1,1,1)
+! opt2 = a1var(16,2,1,1)
+! aaerosn(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+! opt1 = a1var(17,1,1,1)
+! opt2 = a1var(17,2,1,1)
+! aaeroln(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+! opt1 = a1var(18,1,1,1)
+! opt2 = a1var(18,2,1,1)
+! vaerosn(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+! opt1 = a1var(19,1,1,1)
+! opt2 = a1var(19,2,1,1)
+! vaeroln(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+!
+! The procedure above is unnessesary, since neither total background
+! concentrations (OM + sulfate) nor areas & volumes depend on fombg:
+ cknorm(icol,k,kcomp) = a1var(1,1,1,1)
+ cknlt05(icol,k,kcomp) = a1var(2,1,1,1)
+ ckngt125(icol,k,kcomp) = a1var(3,1,1,1)
+ aaerosn(icol,k,kcomp) = a1var(16,1,1,1)
+ aaeroln(icol,k,kcomp) = a1var(17,1,1,1)
+ vaerosn(icol,k,kcomp) = a1var(18,1,1,1)
+ vaeroln(icol,k,kcomp) = a1var(19,1,1,1)
+
+ end do ! icol
+ end do ! k
+
+
+ return
+end subroutine intdrypar1
diff --git a/src/physics/cam_oslo/intdrypar2to3.F90 b/src/physics/cam_oslo/intdrypar2to3.F90
new file mode 100644
index 0000000000..bf7aebfe4b
--- /dev/null
+++ b/src/physics/cam_oslo/intdrypar2to3.F90
@@ -0,0 +1,221 @@
+subroutine intdrypar2to3 (lchnk, ncol, Nnatk, xct, ict1, xfac, ifac1, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol, &
+ aaerosn,aaeroln,vaerosn,vaeroln,cknorm,cknlt05,ckngt125)
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use opttab, only: cate, cat, fac, nbmp1
+ use commondefinitions, only: nmodes, nbmodes
+
+ implicit none
+
+#include
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! condensed SOA/(SOA+H2SO4) (1-4) or added carbonaceous fraction (5-10)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+!
+! Input-Output arguments
+!
+ real(r8), intent(inout) :: &
+ aaerosn(pcols,pver,nbmp1:nmodes), aaeroln(pcols,pver,nbmp1:nmodes), &
+ vaerosn(pcols,pver,nbmp1:nmodes), vaeroln(pcols,pver,nbmp1:nmodes), &
+ cknorm(pcols,pver,0:nmodes), cknlt05(pcols,pver,0:nmodes), ckngt125(pcols,pver,0:nmodes)
+!
+!
+! Output arguments: Modal mass concentrations (cint), area (aaero) and volume (vaero)
+! (for AeroCom determination of particle effective radii) of each constituent. cint*05
+! and cint*125 are for r<0.5um and r>1.25um, respectively. aaeros and vaeros are
+! integrated over r<0.5um, and aaerol and vaerol over r>0.5um.
+!
+ real(r8), intent(out) :: &
+ cintbg(pcols,pver,0:nbmodes), cintbg05(pcols,pver,0:nbmodes), cintbg125(pcols,pver,0:nbmodes), &
+ cintbc(pcols,pver,0:nbmodes), cintbc05(pcols,pver,0:nbmodes), cintbc125(pcols,pver,0:nbmodes), &
+ cintoc(pcols,pver,0:nbmodes), cintoc05(pcols,pver,0:nbmodes), cintoc125(pcols,pver,0:nbmodes), &
+ cintsc(pcols,pver,0:nbmodes), cintsc05(pcols,pver,0:nbmodes), cintsc125(pcols,pver,0:nbmodes), &
+ cintsa(pcols,pver,0:nbmodes), cintsa05(pcols,pver,0:nbmodes), cintsa125(pcols,pver,0:nbmodes), &
+ aaeros(pcols,pver,0:nbmodes), aaerol(pcols,pver,0:nbmodes), &
+ vaeros(pcols,pver,0:nbmodes), vaerol(pcols,pver,0:nbmodes)
+!
+!---------------------------Local variables-----------------------------
+!
+ real(r8) a, b, e, eps
+
+ integer iv, kcomp, k, icol
+
+! Temporary storage of often used array elements
+ integer t_ict1, t_ict2
+ real(r8) t_xct, t_cat1, t_cat2
+ real(r8) t_fac1, t_fac2, t_xfac
+ integer t_ifc1, t_ifc2
+ real(r8) d2mx(2), dxm1(2), invd(2)
+ real(r8) opt2d(2,2)
+ real(r8) opt1, opt2, opt
+
+ parameter (e=2.718281828_r8, eps=1.0e-60_r8)
+
+
+! write(*,*) 'Before kcomp-loop'
+
+! Modes 1-3, SO4(Ait), BC(Ait) and OC(Ait):
+
+ do kcomp=2,3
+
+! initialize output fields
+ do k=1,pver
+ do icol=1,ncol
+ cintbg(icol,k,kcomp)=0.0_r8
+ cintbg05(icol,k,kcomp)=0.0_r8
+ cintbg125(icol,k,kcomp)=0.0_r8
+ cintbc(icol,k,kcomp)=0.0_r8
+ cintbc05(icol,k,kcomp)=0.0_r8
+ cintbc125(icol,k,kcomp)=0.0_r8
+ cintoc(icol,k,kcomp)=0.0_r8
+ cintoc05(icol,k,kcomp)=0.0_r8
+ cintoc125(icol,k,kcomp)=0.0_r8
+ cintsc(icol,k,kcomp)=0.0_r8
+ cintsc05(icol,k,kcomp)=0.0_r8
+ cintsc125(icol,k,kcomp)=0.0_r8
+ cintsa(icol,k,kcomp)=0.0_r8
+ cintsa05(icol,k,kcomp)=0.0_r8
+ cintsa125(icol,k,kcomp)=0.0_r8
+ aaeros(icol,k,kcomp)=0.0_r8
+ aaerol(icol,k,kcomp)=0.0_r8
+ vaeros(icol,k,kcomp)=0.0_r8
+ vaerol(icol,k,kcomp)=0.0_r8
+ end do
+ end do
+
+ end do ! kcomp
+
+ do kcomp=2,2
+
+ do k=1,pver
+ do icol=1,ncol
+
+ if(Nnatk(icol,k,kcomp)>0.0_r8) then
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+ t_ict1 = ict1(icol,k,kcomp)
+ t_ict2 = t_ict1+1
+ t_cat1 = cate(kcomp,t_ict1)
+ t_cat2 = cate(kcomp,t_ict2)
+ t_xct = xct(icol,k,kcomp)
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+ t_xfac = xfac(icol,k,kcomp)
+
+! partial lengths along each dimension (1-2) for interpolation
+ d2mx(1) = (t_cat2-t_xct)
+ dxm1(1) = (t_xct-t_cat1)
+ invd(1) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(2) = (t_fac2-t_xfac)
+ dxm1(2) = (t_xfac-t_fac1)
+ invd(2) = 1.0_r8/(t_fac2-t_fac1)
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ do iv=1,19 ! variable number
+
+! end points as basis for multidimentional linear interpolation
+ opt2d(1,1)=a2to3var(iv,t_ict1,t_ifc1,kcomp)
+ opt2d(1,2)=a2to3var(iv,t_ict1,t_ifc2,kcomp)
+ opt2d(2,1)=a2to3var(iv,t_ict2,t_ifc1,kcomp)
+ opt2d(2,2)=a2to3var(iv,t_ict2,t_ifc2,kcomp)
+
+! interpolation in the fac dimension
+ opt1=(d2mx(2)*opt2d(1,1)+dxm1(2)*opt2d(1,2))*invd(2)
+ opt2=(d2mx(2)*opt2d(2,1)+dxm1(2)*opt2d(2,2))*invd(2)
+
+! finally, interpolation in the cat dimension
+ opt = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+
+! if(k.eq.1) write(*,*) 'opt2to3 =', opt
+
+! write(*,*) 'Before array'
+
+ if(iv==1) then
+ cintbg(icol,k,kcomp)=opt
+ elseif(iv==2) then
+ cintbg05(icol,k,kcomp)=opt
+ elseif(iv==3) then
+ cintbg125(icol,k,kcomp)=opt
+ elseif(iv==4) then
+ cintbc(icol,k,kcomp)=opt
+ elseif(iv==5) then
+ cintbc05(icol,k,kcomp)=opt
+ elseif(iv==6) then
+ cintbc125(icol,k,kcomp)=opt
+ elseif(iv==7) then
+ cintoc(icol,k,kcomp)=opt
+ elseif(iv==8) then
+ cintoc05(icol,k,kcomp)=opt
+ elseif(iv==9) then
+ cintoc125(icol,k,kcomp)=opt
+ elseif(iv==10) then
+ cintsc(icol,k,kcomp)=opt
+ elseif(iv==11) then
+ cintsc05(icol,k,kcomp)=opt
+ elseif(iv==12) then
+ cintsc125(icol,k,kcomp)=opt
+ elseif(iv==13) then
+ cintsa(icol,k,kcomp)=opt
+ elseif(iv==14) then
+ cintsa05(icol,k,kcomp)=opt
+ elseif(iv==15) then
+ cintsa125(icol,k,kcomp)=opt
+ elseif(iv==16) then
+ aaeros(icol,k,kcomp)=opt
+ elseif(iv==17) then
+ aaerol(icol,k,kcomp)=opt
+ elseif(iv==18) then
+ vaeros(icol,k,kcomp)=opt
+ elseif(iv==19) then
+ vaerol(icol,k,kcomp)=opt
+ endif
+ end do ! iv=1,19
+
+ endif
+
+ end do ! icol
+ end do ! k
+
+ end do ! kcomp
+
+! Dry parameters for externally mixed modes modes 12-13,
+! BC(n) and OC(n):
+
+ do kcomp=12,13 ! using dummy initialization for kcomp=3
+! do kcomp=12,12
+
+ do k=1,pver
+ do icol=1,ncol
+
+ cknorm(icol,k,kcomp) = a2to3var(1,1,1,kcomp-10)
+ cknlt05(icol,k,kcomp) = a2to3var(2,1,1,kcomp-10)
+ ckngt125(icol,k,kcomp)= a2to3var(3,1,1,kcomp-10)
+ aaerosn(icol,k,kcomp) = a2to3var(16,1,1,kcomp-10)
+ aaeroln(icol,k,kcomp) = a2to3var(17,1,1,kcomp-10)
+ vaerosn(icol,k,kcomp) = a2to3var(18,1,1,kcomp-10)
+ vaeroln(icol,k,kcomp) = a2to3var(19,1,1,kcomp-10)
+
+ end do ! icol
+ end do ! k
+
+ end do ! kcomp
+
+
+ return
+end subroutine intdrypar2to3
diff --git a/src/physics/cam_oslo/intdrypar4.F90 b/src/physics/cam_oslo/intdrypar4.F90
new file mode 100644
index 0000000000..e8fe8f9f40
--- /dev/null
+++ b/src/physics/cam_oslo/intdrypar4.F90
@@ -0,0 +1,278 @@
+subroutine intdrypar4 (lchnk, ncol, Nnatk, xfbcbg, ifbcbg1, xfbcbgn, ifbcbgn1, &
+ xct, ict1, xfac, ifac1, xfaq, ifaq1, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol, &
+ aaerosn,aaeroln,vaerosn,vaeroln,cknorm,cknlt05,ckngt125)
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use opttab, only: fbcbg, cate, cat, fac, faq, fbc, nbmp1
+ use commondefinitions, only: nmodes, nbmodes
+
+ implicit none
+
+#include
+
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! condensed SOA/(SOA+H2SO4) (1-4) or added carbonaceous fraction (5-10)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfaq(pcols,pver,nbmodes) ! modal SO4(aq)/SO4
+ integer, intent(in) :: ifaq1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfbcbg(pcols,pver) ! mass fraction BC/(BC+OC) for the background mode (4)
+ integer, intent(in) :: ifbcbg1(pcols,pver)
+ real(r8), intent(in) :: xfbcbgn(pcols,pver) ! mass fraction BC/(BC+OC) for the background mode (14)
+ integer, intent(in) :: ifbcbgn1(pcols,pver)
+!
+! Input-Output arguments
+!
+ real(r8), intent(inout) :: &
+ aaerosn(pcols,pver,nbmp1:nmodes), aaeroln(pcols,pver,nbmp1:nmodes), &
+ vaerosn(pcols,pver,nbmp1:nmodes), vaeroln(pcols,pver,nbmp1:nmodes), &
+ cknorm(pcols,pver,0:nmodes), cknlt05(pcols,pver,0:nmodes), ckngt125(pcols,pver,0:nmodes)
+!
+!
+! Output arguments: Modal mass concentrations (cint), area (aaero) and volume (vaero)
+! (for AeroCom determination of particle effective radii) of each constituent. cint*05
+! and cint*125 are for r<0.5um and r>1.25um, respectively. aaeros and vaeros are
+! integrated over r<0.5um, and aaerol and vaerol over r>0.5um.
+!
+ real(r8), intent(out) :: &
+ cintbg(pcols,pver,0:nbmodes), cintbg05(pcols,pver,0:nbmodes), cintbg125(pcols,pver,0:nbmodes), &
+ cintbc(pcols,pver,0:nbmodes), cintbc05(pcols,pver,0:nbmodes), cintbc125(pcols,pver,0:nbmodes), &
+ cintoc(pcols,pver,0:nbmodes), cintoc05(pcols,pver,0:nbmodes), cintoc125(pcols,pver,0:nbmodes), &
+ cintsc(pcols,pver,0:nbmodes), cintsc05(pcols,pver,0:nbmodes), cintsc125(pcols,pver,0:nbmodes), &
+ cintsa(pcols,pver,0:nbmodes), cintsa05(pcols,pver,0:nbmodes), cintsa125(pcols,pver,0:nbmodes), &
+ aaeros(pcols,pver,0:nbmodes), aaerol(pcols,pver,0:nbmodes), &
+ vaeros(pcols,pver,0:nbmodes), vaerol(pcols,pver,0:nbmodes)
+!
+!---------------------------Local variables-----------------------------
+!
+ real(r8) a, b, e, eps
+
+ integer iv, kcomp, k, icol
+
+! Temporary storage of often used array elements
+ integer t_ifb1, t_ifb2
+ integer t_ict1, t_ict2, t_ifc1, t_ifc2, t_ifa1, t_ifa2
+ real(r8) t_fbcbg1, t_fbcbg2
+ real(r8) t_faq1, t_faq2, t_xfaq
+ real(r8) t_fac1, t_fac2, t_xfac
+ real(r8) t_xct, t_cat1, t_cat2
+
+ real(r8) t_xfbcbg
+ real(r8) d2mx(4), dxm1(4), invd(4)
+ real(r8) opt4d(2,2,2,2)
+ real(r8) opt1, opt2, opt
+
+ parameter (e=2.718281828_r8, eps=1.0e-60_r8)
+
+
+! write(*,*) 'Before kcomp-loop'
+
+! Mode 4, BC&OC(Ait):
+
+ kcomp=4
+
+! initialize output fields
+ do k=1,pver
+ do icol=1,ncol
+ cintbg(icol,k,kcomp)=0.0_r8
+ cintbg05(icol,k,kcomp)=0.0_r8
+ cintbg125(icol,k,kcomp)=0.0_r8
+ cintbc(icol,k,kcomp)=0.0_r8
+ cintbc05(icol,k,kcomp)=0.0_r8
+ cintbc125(icol,k,kcomp)=0.0_r8
+ cintoc(icol,k,kcomp)=0.0_r8
+ cintoc05(icol,k,kcomp)=0.0_r8
+ cintoc125(icol,k,kcomp)=0.0_r8
+ cintsc(icol,k,kcomp)=0.0_r8
+ cintsc05(icol,k,kcomp)=0.0_r8
+ cintsc125(icol,k,kcomp)=0.0_r8
+ cintsa(icol,k,kcomp)=0.0_r8
+ cintsa05(icol,k,kcomp)=0.0_r8
+ cintsa125(icol,k,kcomp)=0.0_r8
+ aaeros(icol,k,kcomp)=0.0_r8
+ aaerol(icol,k,kcomp)=0.0_r8
+ vaeros(icol,k,kcomp)=0.0_r8
+ vaerol(icol,k,kcomp)=0.0_r8
+ end do
+ end do
+
+
+ do k=1,pver
+ do icol=1,ncol
+
+ if(Nnatk(icol,k,kcomp)>0.0_r8) then
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+ t_ifb1 = ifbcbg1(icol,k)
+ t_ifb2 = t_ifb1+1
+ t_ict1 = ict1(icol,k,kcomp)
+ t_ict2 = t_ict1+1
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+ t_ifa1 = ifaq1(icol,k,kcomp)
+ t_ifa2 = t_ifa1+1
+ t_fbcbg1 = fbcbg(t_ifb1)
+ t_fbcbg2 = fbcbg(t_ifb2)
+ t_cat1 = cate(kcomp,t_ict1)
+ t_cat2 = cate(kcomp,t_ict2)
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+ t_faq1 = faq(t_ifa1)
+ t_faq2 = faq(t_ifa2)
+ t_xfbcbg = xfbcbg(icol,k)
+ t_xct = xct(icol,k,kcomp)
+ t_xfac = xfac(icol,k,kcomp)
+ t_xfaq = xfaq(icol,k,kcomp)
+
+! partial lengths along each dimension (1-5) for interpolation
+ d2mx(1) = (t_fbcbg2-t_xfbcbg)
+ dxm1(1) = (t_xfbcbg-t_fbcbg1)
+ invd(1) = 1.0_r8/(t_fbcbg2-t_fbcbg1)
+ d2mx(2) = (t_cat2-t_xct)
+ dxm1(2) = (t_xct-t_cat1)
+ invd(2) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(3) = (t_fac2-t_xfac)
+ dxm1(3) = (t_xfac-t_fac1)
+ invd(3) = 1.0_r8/(t_fac2-t_fac1)
+ d2mx(4) = (t_faq2-t_xfaq)
+ dxm1(4) = (t_xfaq-t_faq1)
+ invd(4) = 1.0_r8/(t_faq2-t_faq1)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ do iv=1,19 ! variable number
+
+! end points as basis for multidimentional linear interpolation
+ opt4d(1,1,1,1)=a4var(iv,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt4d(1,1,1,2)=a4var(iv,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt4d(1,1,2,1)=a4var(iv,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt4d(1,1,2,2)=a4var(iv,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt4d(1,2,1,1)=a4var(iv,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt4d(1,2,1,2)=a4var(iv,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt4d(1,2,2,1)=a4var(iv,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt4d(1,2,2,2)=a4var(iv,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt4d(2,1,1,1)=a4var(iv,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt4d(2,1,1,2)=a4var(iv,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt4d(2,1,2,1)=a4var(iv,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt4d(2,1,2,2)=a4var(iv,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt4d(2,2,1,1)=a4var(iv,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt4d(2,2,1,2)=a4var(iv,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt4d(2,2,2,1)=a4var(iv,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt4d(2,2,2,2)=a4var(iv,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+
+! interpolation in the faq, fac and cat dimensions
+ call lininterpol4dim (d2mx, dxm1, invd, opt4d, opt1, opt2)
+
+! finally, interpolation in the fbcbg dimension
+ opt = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+
+! if(k.eq.1) write(*,*) 'opt4 =', opt
+
+! write(*,*) 'Before array'
+
+ if(iv==1) then
+ cintbg(icol,k,kcomp)=opt
+ elseif(iv==2) then
+ cintbg05(icol,k,kcomp)=opt
+ elseif(iv==3) then
+ cintbg125(icol,k,kcomp)=opt
+ elseif(iv==4) then
+ cintbc(icol,k,kcomp)=opt
+ elseif(iv==5) then
+ cintbc05(icol,k,kcomp)=opt
+ elseif(iv==6) then
+ cintbc125(icol,k,kcomp)=opt
+ elseif(iv==7) then
+ cintoc(icol,k,kcomp)=opt
+ elseif(iv==8) then
+ cintoc05(icol,k,kcomp)=opt
+ elseif(iv==9) then
+ cintoc125(icol,k,kcomp)=opt
+ elseif(iv==10) then
+ cintsc(icol,k,kcomp)=opt
+ elseif(iv==11) then
+ cintsc05(icol,k,kcomp)=opt
+ elseif(iv==12) then
+ cintsc125(icol,k,kcomp)=opt
+ elseif(iv==13) then
+ cintsa(icol,k,kcomp)=opt
+ elseif(iv==14) then
+ cintsa05(icol,k,kcomp)=opt
+ elseif(iv==15) then
+ cintsa125(icol,k,kcomp)=opt
+ elseif(iv==16) then
+ aaeros(icol,k,kcomp)=opt
+ elseif(iv==17) then
+ aaerol(icol,k,kcomp)=opt
+ elseif(iv==18) then
+ vaeros(icol,k,kcomp)=opt
+ elseif(iv==19) then
+ vaerol(icol,k,kcomp)=opt
+ endif
+
+ end do ! iv=1,19
+
+ endif
+
+ end do ! icol
+ end do ! k
+
+ kcomp=14
+ do k=1,pver
+ do icol=1,ncol
+
+ t_ifb1 = ifbcbgn1(icol,k)
+ t_ifb2 = t_ifb1+1
+ t_fbcbg1 = fbcbg(t_ifb1)
+ t_fbcbg2 = fbcbg(t_ifb2)
+ t_xfbcbg = xfbcbgn(icol,k)
+
+ d2mx(1) = (t_fbcbg2-t_xfbcbg)
+ dxm1(1) = (t_xfbcbg-t_fbcbg1)
+ invd(1) = 1.0_r8/(t_fbcbg2-t_fbcbg1)
+
+! Only interpolation in the fbcbg dimension for mode 14
+ opt1 = a4var(1,1,1,1,1)
+ opt2 = a4var(1,2,1,1,1)
+ cknorm(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+ opt1 = a4var(2,1,1,1,1)
+ opt2 = a4var(2,2,1,1,1)
+ cknlt05(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+ opt1 = a4var(3,1,1,1,1)
+ opt2 = a4var(3,2,1,1,1)
+ ckngt125(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+ opt1 = a4var(16,1,1,1,1)
+ opt2 = a4var(16,2,1,1,1)
+! (The remaining variables are actually independent of fbcbg,
+! but we follow the same procedure anyway:)
+ aaerosn(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+ opt1 = a4var(17,1,1,1,1)
+ opt2 = a4var(17,2,1,1,1)
+ aaeroln(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+ opt1 = a4var(18,1,1,1,1)
+ opt2 = a4var(18,2,1,1,1)
+ vaerosn(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+ opt1 = a4var(19,1,1,1,1)
+ opt2 = a4var(19,2,1,1,1)
+ vaeroln(icol,k,kcomp) = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+
+ end do ! icol
+ end do ! k
+
+ return
+end subroutine intdrypar4
+
+
+
+
diff --git a/src/physics/cam_oslo/intdrypar5to10.F90 b/src/physics/cam_oslo/intdrypar5to10.F90
new file mode 100644
index 0000000000..8ba2a92c0f
--- /dev/null
+++ b/src/physics/cam_oslo/intdrypar5to10.F90
@@ -0,0 +1,241 @@
+subroutine intdrypar5to10 (lchnk, ncol, Nnatk, xct, ict1, &
+ xfac, ifac1, xfbc, ifbc1, xfaq, ifaq1, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol,&
+ cknorm,cknlt05,ckngt125)
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use opttab, only: cate, cat, fac, faq, fbc, rh, nbmp1
+ use commondefinitions, only: nmodes, nbmodes
+
+ implicit none
+
+#include
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! modal (OC+BC)/(SO4+BC+OC)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfbc(pcols,pver,nbmodes) ! modal BC/(OC+BC)
+ integer, intent(in) :: ifbc1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfaq(pcols,pver,nbmodes) ! modal SO4(aq)/SO4
+ integer, intent(in) :: ifaq1(pcols,pver,nbmodes)
+!
+! Input-Output arguments
+!
+ real(r8), intent(inout) :: &
+ cknorm(pcols,pver,0:nmodes), cknlt05(pcols,pver,0:nmodes), ckngt125(pcols,pver,0:nmodes)
+!
+! Output arguments: Modal mass concentrations (cint), area (aaero) and volume (vaero)
+! (for AeroCom determination of particle effective radii) of each constituent. cint*05
+! and cint*125 are for r<0.5um and r>1.25um, respectively. aaeros and vaeros are
+! integrated over r<0.5um, and aaerol and vaerol over r>0.5um.
+!
+ real(r8), intent(out) :: &
+ cintbg(pcols,pver,0:nbmodes), cintbg05(pcols,pver,0:nbmodes), cintbg125(pcols,pver,0:nbmodes), &
+ cintbc(pcols,pver,0:nbmodes), cintbc05(pcols,pver,0:nbmodes), cintbc125(pcols,pver,0:nbmodes), &
+ cintoc(pcols,pver,0:nbmodes), cintoc05(pcols,pver,0:nbmodes), cintoc125(pcols,pver,0:nbmodes), &
+ cintsc(pcols,pver,0:nbmodes), cintsc05(pcols,pver,0:nbmodes), cintsc125(pcols,pver,0:nbmodes), &
+ cintsa(pcols,pver,0:nbmodes), cintsa05(pcols,pver,0:nbmodes), cintsa125(pcols,pver,0:nbmodes), &
+ aaeros(pcols,pver,0:nbmodes), aaerol(pcols,pver,0:nbmodes), &
+ vaeros(pcols,pver,0:nbmodes), vaerol(pcols,pver,0:nbmodes)
+!
+!---------------------------Local variables-----------------------------
+!
+ real(r8) a, b, e, eps
+
+ integer iv, kcomp, k, icol
+
+! Temporary storage of often used array elements
+ integer t_ict1, t_ict2, t_ifa1, t_ifa2
+ integer t_ifb1, t_ifb2, t_ifc1, t_ifc2
+ real(r8) t_faq1, t_faq2, t_xfaq
+ real(r8) t_fbc1, t_fbc2, t_xfbc
+ real(r8) t_fac1, t_fac2, t_xfac
+ real(r8) t_xct, t_cat1, t_cat2
+ real(r8) d2mx(4), dxm1(4), invd(4)
+ real(r8) opt4d(2,2,2,2)
+ real(r8) opt1, opt2, opt
+
+ parameter (e=2.718281828_r8, eps=1.0e-60_r8)
+
+
+! write(*,*) 'Before kcomp-loop'
+
+! Modes 5 to 10 (SO4(Ait75) and mineral and seasalt-modes + cond./coag./aq.):
+
+ do kcomp=5,10
+
+! initialize output fields
+ do k=1,pver
+ do icol=1,ncol
+ cintbg(icol,k,kcomp)=0.0_r8
+ cintbg05(icol,k,kcomp)=0.0_r8
+ cintbg125(icol,k,kcomp)=0.0_r8
+ cintbc(icol,k,kcomp)=0.0_r8
+ cintbc05(icol,k,kcomp)=0.0_r8
+ cintbc125(icol,k,kcomp)=0.0_r8
+ cintoc(icol,k,kcomp)=0.0_r8
+ cintoc05(icol,k,kcomp)=0.0_r8
+ cintoc125(icol,k,kcomp)=0.0_r8
+ cintsc(icol,k,kcomp)=0.0_r8
+ cintsc05(icol,k,kcomp)=0.0_r8
+ cintsc125(icol,k,kcomp)=0.0_r8
+ cintsa(icol,k,kcomp)=0.0_r8
+ cintsa05(icol,k,kcomp)=0.0_r8
+ cintsa125(icol,k,kcomp)=0.0_r8
+ aaeros(icol,k,kcomp)=0.0_r8
+ aaerol(icol,k,kcomp)=0.0_r8
+ vaeros(icol,k,kcomp)=0.0_r8
+ vaerol(icol,k,kcomp)=0.0_r8
+ end do
+ end do
+
+
+ do k=1,pver
+ do icol=1,ncol
+
+ if(Nnatk(icol,k,kcomp)>0.0_r8) then
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+ t_ict1 = ict1(icol,k,kcomp)
+ t_ict2 = t_ict1+1
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+ t_ifb1 = ifbc1(icol,k,kcomp)
+ t_ifb2 = t_ifb1+1
+ t_ifa1 = ifaq1(icol,k,kcomp)
+ t_ifa2 = t_ifa1+1
+ t_cat1 = cat(kcomp,t_ict1)
+ t_cat2 = cat(kcomp,t_ict2)
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+ t_fbc1 = fbc(t_ifb1)
+ t_fbc2 = fbc(t_ifb2)
+ t_faq1 = faq(t_ifa1)
+ t_faq2 = faq(t_ifa2)
+ t_xct = xct(icol,k,kcomp)
+ t_xfac = xfac(icol,k,kcomp)
+ t_xfbc = xfbc(icol,k,kcomp)
+ t_xfaq = xfaq(icol,k,kcomp)
+
+! partial lengths along each dimension (1-4) for interpolation
+ d2mx(1) = (t_cat2-t_xct)
+ dxm1(1) = (t_xct-t_cat1)
+ invd(1) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(2) = (t_fac2-t_xfac)
+ dxm1(2) = (t_xfac-t_fac1)
+ invd(2) = 1.0_r8/(t_fac2-t_fac1)
+ d2mx(3) = (t_fbc2-t_xfbc)
+ dxm1(3) = (t_xfbc-t_fbc1)
+ invd(3) = 1.0_r8/(t_fbc2-t_fbc1)
+ d2mx(4) = (t_faq2-t_xfaq)
+ dxm1(4) = (t_xfaq-t_faq1)
+ invd(4) = 1.0_r8/(t_faq2-t_faq1)
+!soa
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ do iv=1,19 ! variable number
+
+! end points as basis for multidimentional linear interpolation
+ opt4d(1,1,1,1)=a5to10var(iv,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt4d(1,1,1,2)=a5to10var(iv,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt4d(1,1,2,1)=a5to10var(iv,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt4d(1,1,2,2)=a5to10var(iv,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt4d(1,2,1,1)=a5to10var(iv,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt4d(1,2,1,2)=a5to10var(iv,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt4d(1,2,2,1)=a5to10var(iv,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt4d(1,2,2,2)=a5to10var(iv,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt4d(2,1,1,1)=a5to10var(iv,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt4d(2,1,1,2)=a5to10var(iv,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt4d(2,1,2,1)=a5to10var(iv,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt4d(2,1,2,2)=a5to10var(iv,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt4d(2,2,1,1)=a5to10var(iv,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt4d(2,2,1,2)=a5to10var(iv,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt4d(2,2,2,1)=a5to10var(iv,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt4d(2,2,2,2)=a5to10var(iv,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+
+! interpolation in the faq, fbc, and fac and dimensions
+ call lininterpol4dim (d2mx, dxm1, invd, opt4d, opt1, opt2)
+
+! finally, interpolation in the cat dimension
+ opt = (d2mx(1)*opt1+dxm1(1)*opt2)*invd(1)
+
+! if(k.eq.1.and.kcomp.eq.10) then
+! write(*,*) 'a5to10var11=', &
+! a5to10var(iv,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp), iv,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp
+! write(*,*) 'a5to10var12=',&
+! a5to10var(iv,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp), iv,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp
+! endif
+
+
+! write(*,*) 'Before array'
+
+ if(iv==1) then
+ cintbg(icol,k,kcomp)=opt
+ elseif(iv==2) then
+ cintbg05(icol,k,kcomp)=opt
+ elseif(iv==3) then
+ cintbg125(icol,k,kcomp)=opt
+ elseif(iv==4) then
+ cintbc(icol,k,kcomp)=opt
+ elseif(iv==5) then
+ cintbc05(icol,k,kcomp)=opt
+ elseif(iv==6) then
+ cintbc125(icol,k,kcomp)=opt
+ elseif(iv==7) then
+ cintoc(icol,k,kcomp)=opt
+ elseif(iv==8) then
+ cintoc05(icol,k,kcomp)=opt
+ elseif(iv==9) then
+ cintoc125(icol,k,kcomp)=opt
+ elseif(iv==10) then
+ cintsc(icol,k,kcomp)=opt
+ elseif(iv==11) then
+ cintsc05(icol,k,kcomp)=opt
+ elseif(iv==12) then
+ cintsc125(icol,k,kcomp)=opt
+ elseif(iv==13) then
+ cintsa(icol,k,kcomp)=opt
+ elseif(iv==14) then
+ cintsa05(icol,k,kcomp)=opt
+ elseif(iv==15) then
+ cintsa125(icol,k,kcomp)=opt
+ elseif(iv==16) then
+ aaeros(icol,k,kcomp)=opt
+ elseif(iv==17) then
+ aaerol(icol,k,kcomp)=opt
+ elseif(iv==18) then
+ vaeros(icol,k,kcomp)=opt
+ elseif(iv==19) then
+ vaerol(icol,k,kcomp)=opt
+ endif
+
+ end do ! iv=1,19
+
+ endif
+
+ cknorm(icol,k,kcomp) = a5to10var(1,1,1,1,1,kcomp)
+ cknlt05(icol,k,kcomp) = a5to10var(2,1,1,1,1,kcomp)
+ ckngt125(icol,k,kcomp)= a5to10var(3,1,1,1,1,kcomp)
+
+ end do ! icol
+ end do ! k
+
+ end do ! kcomp
+
+ return
+end subroutine intdrypar5to10
+
+
+
+
diff --git a/src/physics/cam_oslo/intfrh.F90 b/src/physics/cam_oslo/intfrh.F90
new file mode 100644
index 0000000000..2f0bec97a2
--- /dev/null
+++ b/src/physics/cam_oslo/intfrh.F90
@@ -0,0 +1,156 @@
+
+subroutine intfrh (lchnk, ncol, v3so4, v3insol, v3oc, v3ss, relh, frh)
+
+! Written by Alf Kirkevaag in November 2011, based on interpol1to3 in optinterpol.F90
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+!o use opttab, only: nbmodes, rh
+ use opttab, only: rh
+! use aerosoldef, only: nmodes
+ use commondefinitions, only: nmodes
+
+ implicit none
+
+! Relative humidity intries from opttab.F90:
+!! rh = (/ 0.0_r8, 0.37_r8, 0.47_r8, 0.65_r8, 0.75_r8, &
+!! 0.8_r8, 0.85_r8, 0.9_r8, 0.95_r8, 0.995_r8 /)
+! Humidity growth factors which are consistent with the aerosol optics look-up tables:
+ real(r8), dimension(10) :: fh_SO4 = (/ 1.00_r8, 1.34_r8, 1.40_r8, 1.53_r8, 1.64_r8, &
+ 1.71_r8, 1.81_r8, 1.98_r8, 2.39_r8, 5.04_r8 /)
+ real(r8), dimension(10) :: fh_insol = (/ 1.00_r8, 1.01_r8, 1.01_r8, 1.02_r8, 1.02_r8, &
+ 1.02_r8, 1.02_r8, 1.02_r8, 1.02_r8, 1.02_r8 /)
+ real(r8), dimension(10) :: fh_OC = (/ 1.00_r8, 1.02_r8, 1.05_r8, 1.14_r8, 1.19_r8, &
+ 1.22_r8, 1.27_r8, 1.36_r8, 1.59_r8, 3.18_r8 /)
+ real(r8), dimension(10) :: fh_SS = (/ 1.00_r8, 1.01_r8, 1.02_r8, 1.56_r8, 1.87_r8, &
+ 1.97_r8, 2.12_r8, 2.35_r8, 2.88_r8, 6.08_r8 /)
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+!o real(r8), intent(in) :: v3so4(pcols,pver,nbmodes) ! Modal mass fraction of Sulfate
+!o real(r8), intent(in) :: v3insol(pcols,pver,nbmodes)! Modal mass fraction of BC and dust
+!o real(r8), intent(in) :: v3oc(pcols,pver,nbmodes) ! Modal mass fraction of OC (POM)
+!o real(r8), intent(in) :: v3ss(pcols,pver,nbmodes) ! Modal mass fraction of sea-salt
+ real(r8), intent(in) :: v3so4(pcols,pver,nmodes) ! Modal mass fraction of Sulfate
+ real(r8), intent(in) :: v3insol(pcols,pver,nmodes)! Modal mass fraction of BC and dust
+ real(r8), intent(in) :: v3oc(pcols,pver,nmodes) ! Modal mass fraction of OC (POM)
+ real(r8), intent(in) :: v3ss(pcols,pver,nmodes) ! Modal mass fraction of sea-salt
+ real(r8), intent(in) :: relh(pcols,pver) ! Ambient relatve humidity (fraction)
+!
+! Output arguments
+!
+!o real(r8), intent(out) :: frh(pcols,pver,nbmodes) ! Modal humidity growth factor
+ real(r8), intent(out) :: frh(pcols,pver,nmodes) ! Modal humidity growth factor
+
+!
+!---------------------------Local variables-----------------------------
+!
+ integer i, ierr, irelh, kcomp, k, icol
+ integer irh1(pcols,pver), irh2(pcols,pver)
+ real(r8) a, b, e, fso4, finsol, foc, fss
+ real(r8) xrh(pcols,pver)
+ parameter (e=2.718281828)
+
+! Temporary storage of often used array elements
+ integer t_irh1, t_irh2
+ real(r8) t_xrh, t_rh1, t_rh2
+
+! write(*,*) 'Before xrh-loop'
+ do k=1,pver
+ do icol=1,ncol
+!test xrh(icol,k) = 0.8
+ xrh(icol,k) = min(max(relh(icol,k),rh(1)),rh(10))
+ end do
+ end do
+
+! write(*,*) 'Before rh-loop'
+ do irelh=1,9
+ do k=1,pver
+ do icol=1,ncol
+ if(xrh(icol,k) >= rh(irelh).and. &
+ xrh(icol,k)<=rh(irelh+1)) then
+ irh1(icol,k)=irelh
+ irh2(icol,k)=irelh+1
+ endif
+ end do
+ end do
+ end do
+
+!o Loop over all relevant background modes (kcomp=1,2,4-10)
+!o do kcomp=1,10
+! Loop over all relevant modes (kcomp=1,2,4-11,13,14)
+! (mode 3 is no longer included, and 12 is insoluble)
+
+ do kcomp=1,14
+
+ do icol=1,ncol
+ do k=1,pver
+ frh(icol,k,kcomp)=0.0_r8
+ end do
+ end do
+
+!o if(kcomp.ne.3) then
+ if(kcomp.ne.3.and.kcomp.ne.12) then
+
+ do k=1,pver
+ do icol=1,ncol
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+
+ t_irh1 = irh1(icol,k)
+ t_irh2 = irh2(icol,k)
+
+! write(*,*) 't_irh1,t_irh2=',t_irh1,t_irh2
+
+ t_rh1 = rh(t_irh1)
+ t_rh2 = rh(t_irh2)
+
+ t_xrh = xrh(icol,k)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+ if(t_xrh <= 0.37) then ! linear averaging w.r.t. small RH:
+ fso4 = ((t_rh2-t_xrh)*fh_SO4(t_irh1)+(t_xrh-t_rh1)*fh_SO4(t_irh2)) &
+ /(t_rh2-t_rh1)
+ finsol= ((t_rh2-t_xrh)*fh_insol(t_irh1)+(t_xrh-t_rh1)*fh_insol(t_irh2)) &
+ /(t_rh2-t_rh1)
+ foc = ((t_rh2-t_xrh)*fh_OC(t_irh1)+(t_xrh-t_rh1)*fh_OC(t_irh2)) &
+ /(t_rh2-t_rh1)
+ fss = ((t_rh2-t_xrh)*fh_SS(t_irh1)+(t_xrh-t_rh1)*fh_SS(t_irh2)) &
+ /(t_rh2-t_rh1)
+ else ! exponential averaging w.r.t. large RH:
+ a=(log(fh_SO4(t_irh2))-log(fh_SO4(t_irh1)))/(t_rh2-t_rh1)
+ b=(t_rh2*log(fh_SO4(t_irh1))-t_rh1*log(fh_SO4(t_irh2)))/(t_rh2-t_rh1)
+ fso4=e**(a*t_xrh+b)
+ a=(log(fh_insol(t_irh2))-log(fh_insol(t_irh1)))/(t_rh2-t_rh1)
+ b=(t_rh2*log(fh_insol(t_irh1))-t_rh1*log(fh_insol(t_irh2)))/(t_rh2-t_rh1)
+ finsol=e**(a*t_xrh+b)
+ a=(log(fh_OC(t_irh2))-log(fh_OC(t_irh1)))/(t_rh2-t_rh1)
+ b=(t_rh2*log(fh_OC(t_irh1))-t_rh1*log(fh_OC(t_irh2)))/(t_rh2-t_rh1)
+ foc=e**(a*t_xrh+b)
+ a=(log(fh_SS(t_irh2))-log(fh_SS(t_irh1)))/(t_rh2-t_rh1)
+ b=(t_rh2*log(fh_SS(t_irh1))-t_rh1*log(fh_SS(t_irh2)))/(t_rh2-t_rh1)
+ fss=e**(a*t_xrh+b)
+ endif
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+! linear interpolation w.r.t. mass fractions of each internally mixed component
+! (this assumption is only used here, while the full Koehler equation are solved
+! for the look-up tables for log-normal size distributions and aerosol optics):
+
+ frh(icol,k,kcomp) = v3so4(icol,k,kcomp)*fso4+v3insol(icol,k,kcomp)*finsol &
+ + v3oc(icol,k,kcomp) *foc +v3ss(icol,k,kcomp) *fss
+
+! write(*,*) 'frh =', frh(icol,k,kcomp)
+
+ end do ! icol
+ end do ! k
+
+ endif ! kcomp.ne.3.and.kcomp.ne.12
+
+ end do ! kcomp
+
+ return
+end subroutine intfrh
diff --git a/src/physics/cam_oslo/lininterpol3dim.F90 b/src/physics/cam_oslo/lininterpol3dim.F90
new file mode 100644
index 0000000000..3781b4c278
--- /dev/null
+++ b/src/physics/cam_oslo/lininterpol3dim.F90
@@ -0,0 +1,41 @@
+
+ subroutine lininterpol3dim (d2mx, dxm1, invd, opt3d, optout1, optout2)
+
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ implicit none
+
+!
+! Input arguments
+!
+ real(r8), intent(in) :: opt3d(2,2,2)
+ real(r8), intent(in) :: d2mx(3)
+ real(r8), intent(in) :: dxm1(3)
+ real(r8), intent(in) :: invd(3)
+!
+! Output arguments
+!
+ real(r8), intent(out) :: optout1
+ real(r8), intent(out) :: optout2
+!
+!---------------------------Local variables-----------------------------
+!
+ real(r8) opt2d(2,2)
+!
+!------------------------------------------------------------------------
+!
+! interpolation in the third dimension (except invd(3) factor)
+ opt2d(1,1)=d2mx(3)*opt3d(1,1,1)+dxm1(3)*opt3d(1,1,2)
+ opt2d(1,2)=d2mx(3)*opt3d(1,2,1)+dxm1(3)*opt3d(1,2,2)
+ opt2d(2,1)=d2mx(3)*opt3d(2,1,1)+dxm1(3)*opt3d(2,1,2)
+ opt2d(2,2)=d2mx(3)*opt3d(2,2,1)+dxm1(3)*opt3d(2,2,2)
+
+! interpolation in the (third and) second dimension
+ optout1=(d2mx(2)*opt2d(1,1)+dxm1(2)*opt2d(1,2))*invd(3)*invd(2)
+ optout2=(d2mx(2)*opt2d(2,1)+dxm1(2)*opt2d(2,2))*invd(3)*invd(2)
+
+
+ return
+
+end subroutine lininterpol3dim
diff --git a/src/physics/cam_oslo/lininterpol4dim.F90 b/src/physics/cam_oslo/lininterpol4dim.F90
new file mode 100644
index 0000000000..2af2bd5146
--- /dev/null
+++ b/src/physics/cam_oslo/lininterpol4dim.F90
@@ -0,0 +1,51 @@
+
+ subroutine lininterpol4dim (d2mx, dxm1, invd, opt4d, optout1, optout2)
+
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ implicit none
+
+!
+! Input arguments
+!
+ real(r8), intent(in) :: opt4d(2,2,2,2)
+ real(r8), intent(in) :: d2mx(4)
+ real(r8), intent(in) :: dxm1(4)
+ real(r8), intent(in) :: invd(4)
+!
+! Output arguments
+!
+ real(r8), intent(out) :: optout1
+ real(r8), intent(out) :: optout2
+!
+!---------------------------Local variables-----------------------------
+!
+ real(r8) opt3d(2,2,2), opt2d(2,2)
+!
+!------------------------------------------------------------------------
+!
+! interpolation in the fourth dimension (except invd(4) factor)
+ opt3d(1,1,1)=d2mx(4)*opt4d(1,1,1,1)+dxm1(4)*opt4d(1,1,1,2)
+ opt3d(1,1,2)=d2mx(4)*opt4d(1,1,2,1)+dxm1(4)*opt4d(1,1,2,2)
+ opt3d(1,2,1)=d2mx(4)*opt4d(1,2,1,1)+dxm1(4)*opt4d(1,2,1,2)
+ opt3d(1,2,2)=d2mx(4)*opt4d(1,2,2,1)+dxm1(4)*opt4d(1,2,2,2)
+ opt3d(2,1,1)=d2mx(4)*opt4d(2,1,1,1)+dxm1(4)*opt4d(2,1,1,2)
+ opt3d(2,1,2)=d2mx(4)*opt4d(2,1,2,1)+dxm1(4)*opt4d(2,1,2,2)
+ opt3d(2,2,1)=d2mx(4)*opt4d(2,2,1,1)+dxm1(4)*opt4d(2,2,1,2)
+ opt3d(2,2,2)=d2mx(4)*opt4d(2,2,2,1)+dxm1(4)*opt4d(2,2,2,2)
+
+! interpolation in the third dimension (except invd(3) factor)
+ opt2d(1,1)=d2mx(3)*opt3d(1,1,1)+dxm1(3)*opt3d(1,1,2)
+ opt2d(1,2)=d2mx(3)*opt3d(1,2,1)+dxm1(3)*opt3d(1,2,2)
+ opt2d(2,1)=d2mx(3)*opt3d(2,1,1)+dxm1(3)*opt3d(2,1,2)
+ opt2d(2,2)=d2mx(3)*opt3d(2,2,1)+dxm1(3)*opt3d(2,2,2)
+
+! interpolation in the (fourth, third and) second dimension
+ optout1=(d2mx(2)*opt2d(1,1)+dxm1(2)*opt2d(1,2))*invd(4)*invd(3)*invd(2)
+ optout2=(d2mx(2)*opt2d(2,1)+dxm1(2)*opt2d(2,2))*invd(4)*invd(3)*invd(2)
+
+
+ return
+
+end subroutine lininterpol4dim
diff --git a/src/physics/cam_oslo/lininterpol5dim.F90 b/src/physics/cam_oslo/lininterpol5dim.F90
new file mode 100644
index 0000000000..b71f529072
--- /dev/null
+++ b/src/physics/cam_oslo/lininterpol5dim.F90
@@ -0,0 +1,69 @@
+
+ subroutine lininterpol5dim (d2mx, dxm1, invd, opt5d, optout1, optout2)
+
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ implicit none
+
+!
+! Input arguments
+!
+ real(r8), intent(in) :: opt5d(2,2,2,2,2)
+ real(r8), intent(in) :: d2mx(5)
+ real(r8), intent(in) :: dxm1(5)
+ real(r8), intent(in) :: invd(5)
+!
+! Output arguments
+!
+ real(r8), intent(out) :: optout1
+ real(r8), intent(out) :: optout2
+!
+!---------------------------Local variables-----------------------------
+!
+ real(r8) opt4d(2,2,2,2), opt3d(2,2,2), opt2d(2,2)
+!
+!------------------------------------------------------------------------
+!
+! interpolation in the fifth dimension (except invd(5) factor)
+ opt4d(1,1,1,1)=d2mx(5)*opt5d(1,1,1,1,1)+dxm1(5)*opt5d(1,1,1,1,2)
+ opt4d(1,1,1,2)=d2mx(5)*opt5d(1,1,1,2,1)+dxm1(5)*opt5d(1,1,1,2,2)
+ opt4d(1,1,2,1)=d2mx(5)*opt5d(1,1,2,1,1)+dxm1(5)*opt5d(1,1,2,1,2)
+ opt4d(1,1,2,2)=d2mx(5)*opt5d(1,1,2,2,1)+dxm1(5)*opt5d(1,1,2,2,2)
+ opt4d(1,2,1,1)=d2mx(5)*opt5d(1,2,1,1,1)+dxm1(5)*opt5d(1,2,1,1,2)
+ opt4d(1,2,1,2)=d2mx(5)*opt5d(1,2,1,2,1)+dxm1(5)*opt5d(1,2,1,2,2)
+ opt4d(1,2,2,1)=d2mx(5)*opt5d(1,2,2,1,1)+dxm1(5)*opt5d(1,2,2,1,2)
+ opt4d(1,2,2,2)=d2mx(5)*opt5d(1,2,2,2,1)+dxm1(5)*opt5d(1,2,2,2,2)
+ opt4d(2,1,1,1)=d2mx(5)*opt5d(2,1,1,1,1)+dxm1(5)*opt5d(2,1,1,1,2)
+ opt4d(2,1,1,2)=d2mx(5)*opt5d(2,1,1,2,1)+dxm1(5)*opt5d(2,1,1,2,2)
+ opt4d(2,1,2,1)=d2mx(5)*opt5d(2,1,2,1,1)+dxm1(5)*opt5d(2,1,2,1,2)
+ opt4d(2,1,2,2)=d2mx(5)*opt5d(2,1,2,2,1)+dxm1(5)*opt5d(2,1,2,2,2)
+ opt4d(2,2,1,1)=d2mx(5)*opt5d(2,2,1,1,1)+dxm1(5)*opt5d(2,2,1,1,2)
+ opt4d(2,2,1,2)=d2mx(5)*opt5d(2,2,1,2,1)+dxm1(5)*opt5d(2,2,1,2,2)
+ opt4d(2,2,2,1)=d2mx(5)*opt5d(2,2,2,1,1)+dxm1(5)*opt5d(2,2,2,1,2)
+ opt4d(2,2,2,2)=d2mx(5)*opt5d(2,2,2,2,1)+dxm1(5)*opt5d(2,2,2,2,2)
+
+! interpolation in the fourth dimension (except invd(4) factor)
+ opt3d(1,1,1)=d2mx(4)*opt4d(1,1,1,1)+dxm1(4)*opt4d(1,1,1,2)
+ opt3d(1,1,2)=d2mx(4)*opt4d(1,1,2,1)+dxm1(4)*opt4d(1,1,2,2)
+ opt3d(1,2,1)=d2mx(4)*opt4d(1,2,1,1)+dxm1(4)*opt4d(1,2,1,2)
+ opt3d(1,2,2)=d2mx(4)*opt4d(1,2,2,1)+dxm1(4)*opt4d(1,2,2,2)
+ opt3d(2,1,1)=d2mx(4)*opt4d(2,1,1,1)+dxm1(4)*opt4d(2,1,1,2)
+ opt3d(2,1,2)=d2mx(4)*opt4d(2,1,2,1)+dxm1(4)*opt4d(2,1,2,2)
+ opt3d(2,2,1)=d2mx(4)*opt4d(2,2,1,1)+dxm1(4)*opt4d(2,2,1,2)
+ opt3d(2,2,2)=d2mx(4)*opt4d(2,2,2,1)+dxm1(4)*opt4d(2,2,2,2)
+
+! interpolation in the third dimension (except invd(3) factor)
+ opt2d(1,1)=d2mx(3)*opt3d(1,1,1)+dxm1(3)*opt3d(1,1,2)
+ opt2d(1,2)=d2mx(3)*opt3d(1,2,1)+dxm1(3)*opt3d(1,2,2)
+ opt2d(2,1)=d2mx(3)*opt3d(2,1,1)+dxm1(3)*opt3d(2,1,2)
+ opt2d(2,2)=d2mx(3)*opt3d(2,2,1)+dxm1(3)*opt3d(2,2,2)
+
+! interpolation in the (fifth, fourth, third and) second dimension
+ optout1=(d2mx(2)*opt2d(1,1)+dxm1(2)*opt2d(1,2))*(invd(5)*invd(4)*invd(3)*invd(2))
+ optout2=(d2mx(2)*opt2d(2,1)+dxm1(2)*opt2d(2,2))*(invd(5)*invd(4)*invd(3)*invd(2))
+
+
+ return
+
+end subroutine lininterpol5dim
diff --git a/src/physics/cam_oslo/opticsAtConstRh.F90 b/src/physics/cam_oslo/opticsAtConstRh.F90
new file mode 100644
index 0000000000..6b82a2968f
--- /dev/null
+++ b/src/physics/cam_oslo/opticsAtConstRh.F90
@@ -0,0 +1,493 @@
+
+ subroutine opticsAtConstRh (lchnk, ncol, pint, rhoda, Nnatk, xrh, irh1, irf, &
+ xct, ict1, xfaq, ifaq1, xfbcbg, ifbcbg1, &
+ xfbcbgn, ifbcbgn1, xfac, ifac1, xfbc, ifbc1, &
+ xfombg, ifombg1, vnbc, vaitbc, v_soana, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebglt1, bebggt1, bebclt1, bebcgt1, &
+ beoclt1, beocgt1, bes4lt1, bes4gt1, &
+ backsc550, babg550, babc550, baoc550, basu550, &
+ bext440n, bext500n, bext550n, bext670n, bext870n, &
+ bebg440n, bebg500n, bebg550n, bebg670n, bebg870n, &
+ bebc440n, bebc500n, bebc550n, bebc670n, bebc870n, &
+ beoc440n, beoc500n, beoc550n, beoc670n, beoc870n, &
+ besu440n, besu500n, besu550n, besu670n, besu870n, &
+ babs440n, babs500n, babs550n, babs670n, babs870n, &
+ bebglt1n, bebggt1n, bebclt1n, bebcgt1n, &
+ beoclt1n, beocgt1n, bes4lt1n, bes4gt1n, &
+ backsc550n, babg550n, babc550n, baoc550n, basu550n)
+
+! Extra AeroCom diagnostics requiring table look-ups with constant/fixed RH,
+! i.e. for RH = (/"00","40","55","65","75","85" /) (see opttab.F90)
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use cam_history, only: outfld
+ use constituents, only: pcnst
+ use opttab
+ use const
+ use aerosoldef
+ use commondefinitions
+ use physics_types, only: physics_state
+
+ implicit none
+
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ real(r8), intent(in) :: pint(pcols,pverp) ! Model interface pressures (10*Pa)
+ real(r8), intent(in) :: rhoda(pcols,pver) ! Density of dry air (kg/m^3)
+ real(r8), intent(in) :: xrh(pcols,pver) ! level relative humidity (fraction)
+ integer, intent(in) :: irh1(pcols,pver)
+ integer, intent(in) :: irf
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! aerosol mode number concentration
+ real(r8), intent(in) :: vnbc(pcols,pver)
+ real(r8), intent(in) :: vaitbc(pcols,pver)
+ real(r8), intent(in) :: v_soana(pcols,pver)
+ real(r8), intent(in) :: xfombg(pcols,pver)
+ integer, intent(in) :: ifombg1(pcols,pver)
+ real(r8), intent(in) :: xfbcbg(pcols,pver)
+ integer, intent(in) :: ifbcbg1(pcols,pver)
+ real(r8), intent(in) :: xfbcbgn(pcols,pver)
+ integer, intent(in) :: ifbcbgn1(pcols,pver)
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! facm for use in the interpolations
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfbc(pcols,pver,nbmodes) ! fbcm for use in the interpolations
+ integer, intent(in) :: ifbc1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfaq(pcols,pver,nbmodes) ! faqm for use in the interpolations
+ integer, intent(in) :: ifaq1(pcols,pver,nbmodes)
+
+!
+! Output arguments
+!
+ real(r8), intent(out) :: &
+ bext440(pcols,pver,0:nbmodes), babs440(pcols,pver,0:nbmodes), &
+ bext500(pcols,pver,0:nbmodes), babs500(pcols,pver,0:nbmodes), &
+ bext550(pcols,pver,0:nbmodes), babs550(pcols,pver,0:nbmodes), &
+ bext670(pcols,pver,0:nbmodes), babs670(pcols,pver,0:nbmodes), &
+ bext870(pcols,pver,0:nbmodes), babs870(pcols,pver,0:nbmodes), &
+ bebg440(pcols,pver,0:nbmodes), &
+ bebg500(pcols,pver,0:nbmodes), &
+ bebg550(pcols,pver,0:nbmodes), babg550(pcols,pver,0:nbmodes), &
+ bebg670(pcols,pver,0:nbmodes), &
+ bebg870(pcols,pver,0:nbmodes), &
+ bebc440(pcols,pver,0:nbmodes), &
+ bebc500(pcols,pver,0:nbmodes), &
+ bebc550(pcols,pver,0:nbmodes), babc550(pcols,pver,0:nbmodes), &
+ bebc670(pcols,pver,0:nbmodes), &
+ bebc870(pcols,pver,0:nbmodes), &
+ beoc440(pcols,pver,0:nbmodes), &
+ beoc500(pcols,pver,0:nbmodes), &
+ beoc550(pcols,pver,0:nbmodes), baoc550(pcols,pver,0:nbmodes), &
+ beoc670(pcols,pver,0:nbmodes), &
+ beoc870(pcols,pver,0:nbmodes), &
+ besu440(pcols,pver,0:nbmodes), &
+ besu500(pcols,pver,0:nbmodes), &
+ besu550(pcols,pver,0:nbmodes), basu550(pcols,pver,0:nbmodes), &
+ besu670(pcols,pver,0:nbmodes), &
+ besu870(pcols,pver,0:nbmodes), &
+ bebglt1(pcols,pver,0:nbmodes), bebggt1(pcols,pver,0:nbmodes), &
+ bebclt1(pcols,pver,0:nbmodes), bebcgt1(pcols,pver,0:nbmodes), &
+ beoclt1(pcols,pver,0:nbmodes), beocgt1(pcols,pver,0:nbmodes), &
+ bes4lt1(pcols,pver,0:nbmodes), bes4gt1(pcols,pver,0:nbmodes), &
+ backsc550(pcols,pver,0:nbmodes)
+
+ real(r8), intent(out) :: &
+ bext440n(pcols,pver,0:nbmodes), babs440n(pcols,pver,0:nbmodes), &
+ bext500n(pcols,pver,0:nbmodes), babs500n(pcols,pver,0:nbmodes), &
+ bext550n(pcols,pver,0:nbmodes), babs550n(pcols,pver,0:nbmodes), &
+ bext670n(pcols,pver,0:nbmodes), babs670n(pcols,pver,0:nbmodes), &
+ bext870n(pcols,pver,0:nbmodes), babs870n(pcols,pver,0:nbmodes), &
+ bebg440n(pcols,pver,0:nbmodes), &
+ bebg500n(pcols,pver,0:nbmodes), &
+ bebg550n(pcols,pver,0:nbmodes), babg550n(pcols,pver,0:nbmodes), &
+ bebg670n(pcols,pver,0:nbmodes), &
+ bebg870n(pcols,pver,0:nbmodes), &
+ bebc440n(pcols,pver,0:nbmodes), &
+ bebc500n(pcols,pver,0:nbmodes), &
+ bebc550n(pcols,pver,0:nbmodes), babc550n(pcols,pver,0:nbmodes), &
+ bebc670n(pcols,pver,0:nbmodes), &
+ bebc870n(pcols,pver,0:nbmodes), &
+ beoc440n(pcols,pver,0:nbmodes), &
+ beoc500n(pcols,pver,0:nbmodes), &
+ beoc550n(pcols,pver,0:nbmodes), baoc550n(pcols,pver,0:nbmodes), &
+ beoc670n(pcols,pver,0:nbmodes), &
+ beoc870n(pcols,pver,0:nbmodes), &
+ besu440n(pcols,pver,0:nbmodes), &
+ besu500n(pcols,pver,0:nbmodes), &
+ besu550n(pcols,pver,0:nbmodes), basu550n(pcols,pver,0:nbmodes), &
+ besu670n(pcols,pver,0:nbmodes), &
+ besu870n(pcols,pver,0:nbmodes), &
+ bebglt1n(pcols,pver,0:nbmodes), bebggt1n(pcols,pver,0:nbmodes), &
+ bebclt1n(pcols,pver,0:nbmodes), bebcgt1n(pcols,pver,0:nbmodes), &
+ beoclt1n(pcols,pver,0:nbmodes), beocgt1n(pcols,pver,0:nbmodes), &
+ bes4lt1n(pcols,pver,0:nbmodes), bes4gt1n(pcols,pver,0:nbmodes), &
+ backsc550n(pcols,pver,0:nbmodes)
+
+!
+!---------------------------Local variables-----------------------------
+!
+ integer i, k, icol, mplus10, irh
+ integer iloop
+
+ real(r8) deltah
+ real(r8) dod550rh(pcols), abs550rh(pcols)
+!
+ real(r8) babg440(pcols,pver,0:nbmodes), &
+ babg500(pcols,pver,0:nbmodes), &
+ babg670(pcols,pver,0:nbmodes), &
+ babg870(pcols,pver,0:nbmodes), &
+ babc440(pcols,pver,0:nbmodes), &
+ babc500(pcols,pver,0:nbmodes), &
+ babc670(pcols,pver,0:nbmodes), &
+ babc870(pcols,pver,0:nbmodes), &
+ baoc440(pcols,pver,0:nbmodes), &
+ baoc500(pcols,pver,0:nbmodes), &
+ baoc670(pcols,pver,0:nbmodes), &
+ baoc870(pcols,pver,0:nbmodes), &
+ basu440(pcols,pver,0:nbmodes), &
+ basu500(pcols,pver,0:nbmodes), &
+ basu670(pcols,pver,0:nbmodes), &
+ basu870(pcols,pver,0:nbmodes)
+ real(r8) ec550rh_aer(pcols,pver), abs550rh_aer(pcols,pver)
+ real(r8) bebglt1t(pcols,pver), bebclt1t(pcols,pver), &
+ beoclt1t(pcols,pver), bes4lt1t(pcols,pver)
+ real(r8) basu550tot(pcols,pver), babc550tot(pcols,pver), baoc550tot(pcols,pver), &
+ babc550xt(pcols,pver), baoc550xt(pcols,pver), &
+ ba550x(pcols,pver,nbmp1:nmodes), belt1x(pcols,pver,nbmp1:nmodes)
+! Additional AeroCom Phase III output:
+ real(r8) ec440rh_aer(pcols,pver), abs440rh_aer(pcols,pver), &
+ ec870rh_aer(pcols,pver), abs870rh_aer(pcols,pver), &
+ be550lt1_aer(pcols,pver,0:nbmodes), ec550rhlt1_aer(pcols,pver), &
+ abs550rh_bc(pcols,pver), abs550rh_oc(pcols,pver), &
+ abs550rh_su(pcols,pver), abs550rh_ss(pcols,pver), &
+ abs550rh_du(pcols,pver), ec550rhlt1_bc(pcols,pver), &
+ ec550rhlt1_oc(pcols,pver), ec550rhlt1_su(pcols,pver), &
+ ec550rhlt1_ss(pcols,pver), ec550rhlt1_du(pcols,pver)
+!
+ real(r8) babg440n(pcols,pver,0:nbmodes), &
+ babg500n(pcols,pver,0:nbmodes), &
+ babg670n(pcols,pver,0:nbmodes), &
+ babg870n(pcols,pver,0:nbmodes), &
+ babc440n(pcols,pver,0:nbmodes), &
+ babc500n(pcols,pver,0:nbmodes), &
+ babc670n(pcols,pver,0:nbmodes), &
+ babc870n(pcols,pver,0:nbmodes), &
+ baoc440n(pcols,pver,0:nbmodes), &
+ baoc500n(pcols,pver,0:nbmodes), &
+ baoc670n(pcols,pver,0:nbmodes), &
+ baoc870n(pcols,pver,0:nbmodes), &
+ basu440n(pcols,pver,0:nbmodes), &
+ basu500n(pcols,pver,0:nbmodes), &
+ basu670n(pcols,pver,0:nbmodes), &
+ basu870n(pcols,pver,0:nbmodes)
+
+ real(r8) bedustlt1(pcols,pver), bedustgt1(pcols,pver), &
+ besslt1(pcols,pver), bessgt1(pcols,pver)
+ real(r8) bbclt1xt(pcols,pver), &
+ boclt1xt(pcols,pver), bocgt1xt(pcols,pver)
+
+ character(len=10) :: modeString
+ character(len=20) :: varname
+
+
+!000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+ do iloop=1,1
+
+! BC(ax) mode (hydrophobic, so no rhum needed here):
+ call intaeropt0(lchnk, ncol, Nnatk, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebglt1, bebggt1, bebclt1, bebcgt1, &
+ beoclt1, beocgt1, bes4lt1, bes4gt1, &
+ backsc550, babg550, babc550, baoc550, basu550)
+
+! SO4(Ait), BC(Ait) and OC(Ait) modes:
+ mplus10=0
+ call intaeropt1(lchnk, ncol, xrh, irh1, mplus10, &
+ Nnatk, xfombg, ifombg1, xct, ict1, xfac, ifac1,&
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebglt1, bebggt1, bebclt1, bebcgt1, &
+ beoclt1, beocgt1, bes4lt1, bes4gt1, &
+ backsc550, babg550, babc550, baoc550, basu550)
+ mplus10=0
+ call intaeropt2to3(lchnk, ncol, xrh, irh1, mplus10, &
+ Nnatk, xct, ict1, xfac, ifac1, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebglt1, bebggt1, bebclt1, bebcgt1, &
+ beoclt1, beocgt1, bes4lt1, bes4gt1, &
+ backsc550, babg550, babc550, baoc550, basu550)
+
+! BC&OC(Ait) (4), OC&BC(Ait) mode
+ mplus10=0
+ call intaeropt4(lchnk, ncol, xrh, irh1, mplus10, Nnatk, &
+ xfbcbg, ifbcbg1, xct, ict1, xfac, ifac1, xfaq, ifaq1, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebglt1, bebggt1, bebclt1, bebcgt1, &
+ beoclt1, beocgt1, bes4lt1, bes4gt1, &
+ backsc550, babg550, babc550, baoc550, basu550)
+
+! SO4(Ait75) (5), Mineral (6-7) and Sea-salt (8-10) modes:
+ call intaeropt5to10(lchnk, ncol, xrh, irh1, Nnatk, &
+ xct, ict1, xfac, ifac1, xfbc, ifbc1, xfaq, ifaq1, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebglt1, bebggt1, bebclt1, bebcgt1, &
+ beoclt1, beocgt1, bes4lt1, bes4gt1, &
+ backsc550, babg550, babc550, baoc550, basu550)
+
+! then to the externally mixed SO4(n), BC(n) and OC(n) modes:
+ mplus10=1
+ call intaeropt2to3(lchnk, ncol, xrh, irh1, mplus10, &
+ Nnatk, xct, ict1, xfac, ifac1, &
+ bext440n, bext500n, bext550n, bext670n, bext870n, &
+ bebg440n, bebg500n, bebg550n, bebg670n, bebg870n, &
+ bebc440n, bebc500n, bebc550n, bebc670n, bebc870n, &
+ beoc440n, beoc500n, beoc550n, beoc670n, beoc870n, &
+ besu440n, besu500n, besu550n, besu670n, besu870n, &
+ babs440n, babs500n, babs550n, babs670n, babs870n, &
+ bebglt1n, bebggt1n, bebclt1n, bebcgt1n, &
+ beoclt1n, beocgt1n, bes4lt1n, bes4gt1n, &
+ backsc550n, babg550n, babc550n, baoc550n, basu550n)
+
+! and finally the BC&OC(n) mode:
+ mplus10=1
+ call intaeropt4(lchnk, ncol, xrh, irh1, mplus10, Nnatk, &
+ xfbcbgn, ifbcbgn1, xct, ict1, xfac, ifac1, xfaq, ifaq1, &
+ bext440n, bext500n, bext550n, bext670n, bext870n, &
+ bebg440n, bebg500n, bebg550n, bebg670n, bebg870n, &
+ bebc440n, bebc500n, bebc550n, bebc670n, bebc870n, &
+ beoc440n, beoc500n, beoc550n, beoc670n, beoc870n, &
+ besu440n, besu500n, besu550n, besu670n, besu870n, &
+ babs440n, babs500n, babs550n, babs670n, babs870n, &
+ bebglt1n, bebggt1n, bebclt1n, bebcgt1n, &
+ beoclt1n, beocgt1n, bes4lt1n, bes4gt1n, &
+ backsc550n, babg550n, babc550n, baoc550n, basu550n)
+
+ end do ! iloop
+
+
+! Initialization
+ do k=1,pver
+ do icol=1,ncol
+ ec550rh_aer(icol,k)=0.0_r8
+ abs550rh_aer(icol,k)=0.0_r8
+ ec550rhlt1_aer(icol,k)=0.0_r8
+ abs550rh_bc(icol,k)=0.0_r8
+ abs550rh_oc(icol,k)=0.0_r8
+ abs550rh_su(icol,k)=0.0_r8
+ abs550rh_ss(icol,k)=0.0_r8
+ abs550rh_du(icol,k)=0.0_r8
+ ec440rh_aer(icol,k)=0.0_r8
+ abs440rh_aer(icol,k)=0.0_r8
+ ec870rh_aer(icol,k)=0.0_r8
+ abs870rh_aer(icol,k)=0.0_r8
+ basu550tot(icol,k)=0.0_r8
+ babc550tot(icol,k)=0.0_r8
+ baoc550tot(icol,k)=0.0_r8
+ bebglt1t(icol,k)=0.0_r8
+ bebclt1t(icol,k)=0.0_r8
+ beoclt1t(icol,k)=0.0_r8
+ bes4lt1t(icol,k)=0.0_r8
+ bedustlt1(icol,k)=0.0_r8
+ besslt1(icol,k)=0.0_r8
+ end do
+ end do
+ do icol=1,ncol
+ dod550rh(icol)=0.0_r8
+ abs550rh(icol)=0.0_r8
+ end do
+
+! Calculation of extinction at given RH and absorption for all r and for r<0.5um
+ do k=1,pver
+ do icol=1,ncol
+
+ do i=0,10
+ ec550rh_aer(icol,k) = ec550rh_aer(icol,k)+Nnatk(icol,k,i)*bext550(icol,k,i)
+ abs550rh_aer(icol,k) = abs550rh_aer(icol,k)+Nnatk(icol,k,i)*babs550(icol,k,i)
+ ec440rh_aer(icol,k) = ec440rh_aer(icol,k)+Nnatk(icol,k,i)*bext440(icol,k,i)
+ abs440rh_aer(icol,k) = abs440rh_aer(icol,k)+Nnatk(icol,k,i)*babs440(icol,k,i)
+ ec870rh_aer(icol,k) = ec870rh_aer(icol,k)+Nnatk(icol,k,i)*bext870(icol,k,i)
+ abs870rh_aer(icol,k) = abs870rh_aer(icol,k)+Nnatk(icol,k,i)*babs870(icol,k,i)
+ basu550tot(icol,k) = basu550tot(icol,k)+Nnatk(icol,k,i)*basu550(icol,k,i)
+ babc550tot(icol,k) = babc550tot(icol,k)+Nnatk(icol,k,i)*babc550(icol,k,i)
+ baoc550tot(icol,k) = baoc550tot(icol,k)+Nnatk(icol,k,i)*baoc550(icol,k,i)
+ bes4lt1t(icol,k) = bes4lt1t(icol,k)+Nnatk(icol,k,i)*bes4lt1(icol,k,i)
+ bebclt1t(icol,k) = bebclt1t(icol,k)+Nnatk(icol,k,i)*bebclt1(icol,k,i)
+ beoclt1t(icol,k) = beoclt1t(icol,k)+Nnatk(icol,k,i)*beoclt1(icol,k,i)
+ enddo
+ do i=11,14
+ ec550rh_aer(icol,k) = ec550rh_aer(icol,k)+Nnatk(icol,k,i)*bext550n(icol,k,i-10)
+ abs550rh_aer(icol,k) = abs550rh_aer(icol,k)+Nnatk(icol,k,i)*babs550n(icol,k,i-10)
+ ec440rh_aer(icol,k) = ec440rh_aer(icol,k)+Nnatk(icol,k,i)*bext440n(icol,k,i-10)
+ abs440rh_aer(icol,k) = abs440rh_aer(icol,k)+Nnatk(icol,k,i)*babs440n(icol,k,i-10)
+ ec870rh_aer(icol,k) = ec870rh_aer(icol,k)+Nnatk(icol,k,i)*bext870n(icol,k,i-10)
+ abs870rh_aer(icol,k) = abs870rh_aer(icol,k)+Nnatk(icol,k,i)*babs870n(icol,k,i-10)
+ ba550x(icol,k,i)=babs550n(icol,k,i-10)
+ belt1x(icol,k,i)=bebglt1n(icol,k,i-10)
+ enddo
+
+ do i=6,7
+ bedustlt1(icol,k) = bedustlt1(icol,k) + Nnatk(icol,k,i)*bebglt1(icol,k,i)
+ enddo
+ do i=8,10
+ besslt1(icol,k) = besslt1(icol,k) + Nnatk(icol,k,i)*bebglt1(icol,k,i)
+ enddo
+ ec550rhlt1_du(icol,k) = bedustlt1(icol,k)
+ ec550rhlt1_ss(icol,k) = besslt1(icol,k)
+
+!soa: *(1-v_soan) for the sulfate volume fraction of mode 11
+ bbclt1xt(icol,k) = Nnatk(icol,k,12)*belt1x(icol,k,12) &
+ + Nnatk(icol,k,14)*belt1x(icol,k,14)*vnbc(icol,k)
+!soa + v_soan part of mode 11 for the OC volume fraction of that mode
+ boclt1xt(icol,k) = Nnatk(icol,k,13)*belt1x(icol,k,13) &
+ + Nnatk(icol,k,14)*belt1x(icol,k,14)*(1.0_r8-vnbc(icol,k))
+
+!soa: *(1-v_soana) for the sulfate volume fraction of mode 1
+ ec550rhlt1_su(icol,k) = bes4lt1t(icol,k) & ! condensate
+ + Nnatk(icol,k,1)*bebglt1(icol,k,1)*(1.0_r8-v_soana(icol,k))& ! background, SO4(Ait) mode (1)
+ + Nnatk(icol,k,5)*bebglt1(icol,k,5) ! background, SO4(Ait75) mode (5)
+ ec550rhlt1_bc(icol,k) = bebclt1t(icol,k)+bbclt1xt(icol,k) & ! coagulated + n-mode BC (12)
+ + Nnatk(icol,k,2)*bebglt1(icol,k,2) & ! background, BC(Ait) mode (2)
+ + Nnatk(icol,k,4)*bebglt1(icol,k,4)*vaitbc(icol,k) & ! background in OC&BC(Ait) mode (4)
+ + Nnatk(icol,k,0)*bebglt1(icol,k,0) ! background, BC(ax) mode (0)
+!soa + v_soan part of mode 11 for the OC volume fraction of that mode
+ ec550rhlt1_oc(icol,k) = beoclt1t(icol,k)+boclt1xt(icol,k) & ! coagulated + n-mode OC (13)
+ + Nnatk(icol,k,3)*bebglt1(icol,k,3) & ! background, OC(Ait) mode (3)
+ + Nnatk(icol,k,4)*bebglt1(icol,k,4)*(1.0_r8-vaitbc(icol,k))& ! background in OC&BC(Ait) mode (4)
+ + Nnatk(icol,k,1)*bebglt1(icol,k,1)*v_soana(icol,k)
+
+ ec550rhlt1_aer(icol,k) = ec550rhlt1_su(icol,k)+ec550rhlt1_bc(icol,k) &
+ + ec550rhlt1_oc(icol,k) + ec550rhlt1_ss(icol,k)+ec550rhlt1_du(icol,k)
+ ec550rhlt1_aer(icol,k) = 1.e-3_r8*ec550rhlt1_aer(icol,k)
+
+ abs550rh_du(icol,k) = Nnatk(icol,k,6)*babg550(icol,k,6) &
+ + Nnatk(icol,k,7)*babg550(icol,k,7)
+ abs550rh_ss(icol,k) = Nnatk(icol,k,8)*babg550(icol,k,8) &
+ + Nnatk(icol,k,9)*babg550(icol,k,9) &
+ + Nnatk(icol,k,10)*babg550(icol,k,10)
+!soa: *(1-v_soana) for the sulfate volume fraction of mode 1
+ abs550rh_su(icol,k) = basu550tot(icol,k) & ! condensate:w
+
+ + (1.0_r8-v_soana(icol,k))*Nnatk(icol,k,1)*babg550(icol,k,1) & ! background, SO4(Ait) mode (1)
+ + Nnatk(icol,k,5)*babg550(icol,k,5) ! background, SO4(Ait75) mode (5)
+
+!soa: *(1-v_soan) for the sulfate volume fraction
+ babc550xt(icol,k) = Nnatk(icol,k,12)*ba550x(icol,k,12) &
+ + Nnatk(icol,k,14)*ba550x(icol,k,14)*vnbc(icol,k)
+
+ baoc550xt(icol,k) = Nnatk(icol,k,13)*ba550x(icol,k,13) &
+ + Nnatk(icol,k,14)*ba550x(icol,k,14)*(1.0_r8-vnbc(icol,k))
+
+ abs550rh_bc(icol,k) = babc550tot(icol,k)+babc550xt(icol,k) & ! coagulated + n-mode BC (12)
+ + Nnatk(icol,k,2)*babg550(icol,k,2) & ! background, BC(Ait) mode (2)
+ + vaitbc(icol,k)*Nnatk(icol,k,4)*babg550(icol,k,4) & ! background in OC&BC(Ait) mode (4)
+ + Nnatk(icol,k,0)*babg550(icol,k,0) ! background, BC(ax) mode (0)
+
+ abs550rh_oc(icol,k) = baoc550tot(icol,k)+baoc550xt(icol,k) & ! coagulated + n-mode OC (13)
+ + v_soana(icol,k)*Nnatk(icol,k,1)*babg550(icol,k,1) & ! SOA fraction of mode 1
+ + Nnatk(icol,k,3)*babg550(icol,k,3) & ! background, OC(Ait) mode (3)
+ + (1.0_r8-vaitbc(icol,k))*Nnatk(icol,k,4)*babg550(icol,k,4) ! background in OC&BC(Ait) mode (4)
+
+ deltah=1.e-4_r8*(pint(icol,k+1)-pint(icol,k))/(rhoda(icol,k)*9.8_r8)
+ dod550rh(icol) = dod550rh(icol)+ec550rh_aer(icol,k)*deltah
+ abs550rh(icol) = abs550rh(icol)+abs550rh_aer(icol,k)*deltah
+
+ ec550rh_aer(icol,k) = 1.e-3_r8*ec550rh_aer(icol,k)
+ abs550rh_aer(icol,k) = 1.e-3_r8*abs550rh_aer(icol,k)
+ ec440rh_aer(icol,k) = 1.e-3_r8*ec440rh_aer(icol,k)
+ abs440rh_aer(icol,k) = 1.e-3_r8*abs440rh_aer(icol,k)
+ ec870rh_aer(icol,k) = 1.e-3_r8*ec870rh_aer(icol,k)
+ abs870rh_aer(icol,k) = 1.e-3_r8*abs870rh_aer(icol,k)
+
+ abs550rh_bc(icol,k) = 1.e-3_r8*abs550rh_bc(icol,k)
+ abs550rh_oc(icol,k) = 1.e-3_r8*abs550rh_oc(icol,k)
+ abs550rh_su(icol,k) = 1.e-3_r8*abs550rh_su(icol,k)
+ abs550rh_ss(icol,k) = 1.e-3_r8*abs550rh_ss(icol,k)
+ abs550rh_du(icol,k) = 1.e-3_r8*abs550rh_du(icol,k)
+
+ enddo
+ enddo
+
+ if(irf.eq.1) then
+
+ call outfld('ECDRYAER',ec550rh_aer,pcols,lchnk)
+ call outfld('ABSDRYAE',abs550rh_aer,pcols,lchnk)
+ call outfld('OD550DRY',dod550rh,pcols,lchnk) ! 2D variable
+ call outfld('AB550DRY',abs550rh,pcols,lchnk) ! 2D variable
+ call outfld('ECDRY440',ec440rh_aer,pcols,lchnk)
+ call outfld('ABSDR440',abs440rh_aer,pcols,lchnk)
+ call outfld('ECDRY870',ec870rh_aer,pcols,lchnk)
+ call outfld('ABSDR870',abs870rh_aer,pcols,lchnk)
+ call outfld('ECDRYLT1',ec550rhlt1_aer,pcols,lchnk)
+! Since we do not have enough look-up table info to take abs550rhlt1_aer,
+! instead take out abs550rh for each constituent:
+ call outfld('ABSDRYBC',abs550rh_bc,pcols,lchnk)
+ call outfld('ABSDRYOC',abs550rh_oc,pcols,lchnk)
+ call outfld('ABSDRYSU',abs550rh_su,pcols,lchnk)
+ call outfld('ABSDRYSS',abs550rh_ss,pcols,lchnk)
+ call outfld('ABSDRYDU',abs550rh_du,pcols,lchnk)
+
+ elseif(irf.ge.2) then ! only happens for AEROCOM_INSITU
+
+ irh=RF(irf)
+
+ modeString=" "
+ write(modeString,"(I2)"),irh
+ if(RF(irf).eq.0) modeString="00"
+
+!- varName = "EC44RH"//trim(modeString)
+!- call outfld(varName,ec440rh_aer(:,:),pcols,lchnk)
+ varName = "EC55RH"//trim(modeString)
+ call outfld(varName,ec550rh_aer(:,:),pcols,lchnk)
+!- varName = "EC87RH"//trim(modeString)
+!- call outfld(varName,ec870rh_aer(:,:),pcols,lchnk)
+
+!- varName = "AB44RH"//trim(modeString)
+!- call outfld(varName,abs440rh_aer(:,:),pcols,lchnk)
+ varName = "AB55RH"//trim(modeString)
+ call outfld(varName,abs550rh_aer(:,:),pcols,lchnk)
+!- varName = "AB87RH"//trim(modeString)
+!- call outfld(varName,abs870rh_aer(:,:),pcols,lchnk)
+
+ end if ! irf
+
+!000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+
+ return
+end subroutine opticsAtConstRh
+
diff --git a/src/physics/cam_oslo/optinterpol.F90 b/src/physics/cam_oslo/optinterpol.F90
new file mode 100755
index 0000000000..a9c5d2b254
--- /dev/null
+++ b/src/physics/cam_oslo/optinterpol.F90
@@ -0,0 +1,1814 @@
+module optinterpol
+
+! Purpose: To interpolate between look-up table entries for SW optical aerosol properties.
+
+! Optimized for speed by Arild Burud and Egil Storen (NoSerC), June-July 2002
+!--------------------------------------------------------------------------------
+
+! Updated for new kcomp1.out including condensed SOA - Alf Kirkevaag, May 2013.
+! Extended for new SOA treatment for kcomp1-4.out and treating SOA as coagulated OC
+! for kcomp5-10 - Alf Kirkevaag, August 2015, and also rewritten to a more generalized
+! for for interpolations using common subroutines interpol*dim.
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use opttab
+ use opttab_lw
+ use commondefinitions, only: nmodes, nbmodes
+ implicit none
+
+ private
+ save
+
+ public interpol0
+ public interpol1
+ public interpol2to3
+ public interpol4
+ public interpol5to10
+
+ contains
+
+!********************************************************************************************
+
+subroutine interpol0 (lchnk, ncol, daylight, Nnatk, omega, gass, bex, ske, lw_on, kabs)
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ implicit none
+
+
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ logical, intent(in) :: daylight(pcols) ! calculations also at (polar) night if daylight=.true.
+ logical, intent(in) :: lw_on ! LW calculations are performed if true
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+!
+! Output arguments
+!
+ real(r8), intent(out) :: omega(pcols,pver,0:nmodes,nbands) ! spectral modal single scattering albedo
+ real(r8), intent(out) :: gass(pcols,pver,0:nmodes,nbands) ! spectral modal asymmetry factor
+ real(r8), intent(out) :: bex(pcols,pver,0:nmodes,nbands) ! spectral modal extinction coefficient
+ real(r8), intent(out) :: ske(pcols,pver,0:nmodes,nbands) ! spectral modal specific extinction coefficient
+ real(r8), intent(out) :: kabs(pcols,pver,0:nmodes,nlwbands)! LW spectral modal specific absorption coefficient
+!
+!---------------------------Local variables-----------------------------
+!
+ integer i, kcomp, k, icol
+
+
+ kcomp=0
+
+ do i=1,nbands
+ do icol=1,ncol
+ do k=1,pver
+ omega(icol,k,kcomp,i)=0.0_r8
+ gass(icol,k,kcomp,i)=0.0_r8
+ bex(icol,k,kcomp,i)=0.0_r8
+ ske(icol,k,kcomp,i)=0.0_r8
+ end do
+ end do
+ end do
+ do i=1,nlwbands
+ do icol=1,ncol
+ do k=1,pver
+ kabs(icol,k,kcomp,i)=0.0_r8
+ end do
+ end do
+ end do
+
+! SW optical parameters
+
+ do k=1,pver
+ do icol=1,ncol
+
+! if(Nnatk(icol,k,kcomp)>0.0_r8) then
+ if(daylight(icol)) then
+ do i=1,nbands ! i = wavelength index
+ omega(icol,k,kcomp,i)=om0(i)
+ gass(icol,k,kcomp,i)=g0(i)
+ bex(icol,k,kcomp,i)=be0(i)
+ ske(icol,k,kcomp,i)=ke0(i)
+ end do ! i
+
+ else ! daylight
+! Need be and ke in nband=4 for lw calculation
+ bex(icol,k,kcomp,4)=be0(4)
+ ske(icol,k,kcomp,4)=ke0(4)
+ end if ! daylight
+ end do ! icol
+ end do ! k
+
+ if(lw_on) then
+
+! LW optical parameters
+
+ do k=1,pver
+ do icol=1,ncol
+
+ do i=1,nlwbands ! i = wavelength index
+ kabs(icol,k,kcomp,i)=ka0(i)
+ end do ! i
+
+ end do ! icol
+ end do ! k
+
+ endif ! lw_on
+
+ return
+end subroutine interpol0
+
+
+!********************************************************************************************
+
+subroutine interpol1 (lchnk, ncol, daylight, xrh, irh1, mplus10, Nnatk, xfombg, ifombg1, &
+ xct, ict1, xfac, ifac1, omega, gass, bex, ske, lw_on, kabs)
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ implicit none
+
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ integer, intent(in) :: mplus10 ! mode number (0) or number + 10 (1)
+ logical, intent(in) :: daylight(pcols) ! only daylight calculations if .true.
+ logical, intent(in) :: lw_on ! LW calculations are performed if true
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xrh(pcols,pver) ! level relative humidity (fraction)
+ integer, intent(in) :: irh1(pcols,pver)
+ real(r8), intent(in) :: xfombg(pcols,pver) ! SOA/(SOA+H2SO4) for the background mode
+ integer, intent(in) :: ifombg1(pcols,pver)
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! condensed SOA/(SOA+H2SO4) (1-4) or added carbonaceous fraction (5-10)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+!
+!
+! Input-Output arguments
+!
+!
+! Output arguments
+!
+ real(r8), intent(out) :: omega(pcols,pver,0:nmodes,nbands) ! spectral modal single scattering albedo
+ real(r8), intent(out) :: gass(pcols,pver,0:nmodes,nbands) ! spectral modal asymmetry factor
+ real(r8), intent(out) :: bex(pcols,pver,0:nmodes,nbands) ! spectral modal extinction coefficient
+ real(r8), intent(out) :: ske(pcols,pver,0:nmodes,nbands) ! spectral modal specific extinction coefficient
+ real(r8), intent(out) :: kabs(pcols,pver,0:nmodes,nlwbands)! LW spectral modal specific absoption coefficient
+!
+!---------------------------Local variables-----------------------------
+!
+ integer i, kcomp, k, icol, kc10
+ real(r8) a, b
+
+! Temporary storage of often used array elements
+ integer t_irh1, t_irh2, t_ict1, t_ict2, t_ifc1, t_ifc2, t_ifo1, t_ifo2
+ real(r8) t_fac1, t_fac2, t_xfac, t_xrh, t_xct, t_rh1, t_rh2, &
+ t_cat1, t_cat2, t_fombg1, t_fombg2, t_xfombg
+ real(r8) d2mx(4), dxm1(4), invd(4)
+ real(r8) opt4d(2,2,2,2)
+ real(r8) ome1, ome2, ge1, ge2, bex1, bex2, ske1, ske2
+ real(r8) kabs1, kabs2
+
+
+! write(*,*) 'Before kcomp-loop'
+ do kcomp=1,1
+
+ if(mplus10==0) then
+ kc10=kcomp
+ else
+ kc10=kcomp+10
+ endif
+
+
+! write(*,*) 'Before init-loop', kc10
+ do i=1,nbands
+ do icol=1,ncol
+ do k=1,pver
+ omega(icol,k,kc10,i)=0.0_r8
+ gass(icol,k,kc10,i)=0.0_r8
+ bex(icol,k,kc10,i)=0.0_r8
+ ske(icol,k,kc10,i)=0.0_r8
+ end do
+ end do
+ end do
+ do i=1,nlwbands
+ do icol=1,ncol
+ do k=1,pver
+ kabs(icol,k,kc10,i)=0.0_r8
+ end do
+ end do
+ end do
+
+ do k=1,pver
+ do icol=1,ncol
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+
+ t_irh1 = irh1(icol,k)
+ t_irh2 = t_irh1+1
+ t_ict1 = ict1(icol,k,kcomp)
+ t_ict2 = t_ict1+1
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+ t_ifo1 = ifombg1(icol,k)
+ t_ifo2 = t_ifo1+1
+
+ t_rh1 = rh(t_irh1)
+!x t_rh2 = t_rh1+1
+ t_rh2 = rh(t_irh2)
+ t_cat1 = cate(kcomp,t_ict1)
+ t_cat2 = cate(kcomp,t_ict2)
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+ t_fombg1 = fombg(t_ifo1)
+ t_fombg2 = fombg(t_ifo2)
+
+ t_xrh = xrh(icol,k)
+ t_xct = xct(icol,k,kcomp)
+ t_xfac = xfac(icol,k,kcomp)
+ t_xfombg = xfombg(icol,k)
+
+! partial lengths along each dimension (1-4) for interpolation
+ d2mx(1) = (t_rh2-t_xrh)
+ dxm1(1) = (t_xrh-t_rh1)
+ invd(1) = 1.0_r8/(t_rh2-t_rh1)
+ d2mx(2) = (t_fombg2-t_xfombg)
+ dxm1(2) = (t_xfombg-t_fombg1)
+ invd(2) = 1.0_r8/(t_fombg2-t_fombg1)
+ d2mx(3) = (t_cat2-t_xct)
+ dxm1(3) = (t_xct-t_cat1)
+ invd(3) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(4) = (t_fac2-t_xfac)
+ dxm1(4) = (t_xfac-t_fac1)
+ invd(4) = 1.0_r8/(t_fac2-t_fac1)
+
+
+! SW optical parameters
+ if(daylight(icol)) then
+
+ do i=1,nbands ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! single scattering albedo:
+
+! end points as basis for multidimentional linear interpolation
+ opt4d(1,1,1,1)=om1(i,t_irh1,t_ifo1,t_ict1,t_ifc1)
+ opt4d(1,1,1,2)=om1(i,t_irh1,t_ifo1,t_ict1,t_ifc2)
+ opt4d(1,1,2,1)=om1(i,t_irh1,t_ifo1,t_ict2,t_ifc1)
+ opt4d(1,1,2,2)=om1(i,t_irh1,t_ifo1,t_ict2,t_ifc2)
+ opt4d(1,2,1,1)=om1(i,t_irh1,t_ifo2,t_ict1,t_ifc1)
+ opt4d(1,2,1,2)=om1(i,t_irh1,t_ifo2,t_ict1,t_ifc2)
+ opt4d(1,2,2,1)=om1(i,t_irh1,t_ifo2,t_ict2,t_ifc1)
+ opt4d(1,2,2,2)=om1(i,t_irh1,t_ifo2,t_ict2,t_ifc2)
+ opt4d(2,1,1,1)=om1(i,t_irh2,t_ifo1,t_ict1,t_ifc1)
+ opt4d(2,1,1,2)=om1(i,t_irh2,t_ifo1,t_ict1,t_ifc2)
+ opt4d(2,1,2,1)=om1(i,t_irh2,t_ifo1,t_ict2,t_ifc1)
+ opt4d(2,1,2,2)=om1(i,t_irh2,t_ifo1,t_ict2,t_ifc2)
+ opt4d(2,2,1,1)=om1(i,t_irh2,t_ifo2,t_ict1,t_ifc1)
+ opt4d(2,2,1,2)=om1(i,t_irh2,t_ifo2,t_ict1,t_ifc2)
+ opt4d(2,2,2,1)=om1(i,t_irh2,t_ifo2,t_ict2,t_ifc1)
+ opt4d(2,2,2,2)=om1(i,t_irh2,t_ifo2,t_ict2,t_ifc2)
+
+! interpolation in the fac, cat and fombg dimensions
+ call lininterpol4dim (d2mx, dxm1, invd, opt4d, ome1, ome2)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before omega'
+ omega(icol,k,kc10,i)=((t_rh2-t_xrh)*ome1+(t_xrh-t_rh1)*ome2) &
+ /(t_rh2-t_rh1)
+!alt omega(icol,k,kc10,i)=(d2mx(1)*ome1+dxm1(1)*ome2)*invd(1)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! asymmetry factor
+
+! end points as basis for multidimentional linear interpolation
+ opt4d(1,1,1,1)=g1(i,t_irh1,t_ifo1,t_ict1,t_ifc1)
+ opt4d(1,1,1,2)=g1(i,t_irh1,t_ifo1,t_ict1,t_ifc2)
+ opt4d(1,1,2,1)=g1(i,t_irh1,t_ifo1,t_ict2,t_ifc1)
+ opt4d(1,1,2,2)=g1(i,t_irh1,t_ifo1,t_ict2,t_ifc2)
+ opt4d(1,2,1,1)=g1(i,t_irh1,t_ifo2,t_ict1,t_ifc1)
+ opt4d(1,2,1,2)=g1(i,t_irh1,t_ifo2,t_ict1,t_ifc2)
+ opt4d(1,2,2,1)=g1(i,t_irh1,t_ifo2,t_ict2,t_ifc1)
+ opt4d(1,2,2,2)=g1(i,t_irh1,t_ifo2,t_ict2,t_ifc2)
+ opt4d(2,1,1,1)=g1(i,t_irh2,t_ifo1,t_ict1,t_ifc1)
+ opt4d(2,1,1,2)=g1(i,t_irh2,t_ifo1,t_ict1,t_ifc2)
+ opt4d(2,1,2,1)=g1(i,t_irh2,t_ifo1,t_ict2,t_ifc1)
+ opt4d(2,1,2,2)=g1(i,t_irh2,t_ifo1,t_ict2,t_ifc2)
+ opt4d(2,2,1,1)=g1(i,t_irh2,t_ifo2,t_ict1,t_ifc1)
+ opt4d(2,2,1,2)=g1(i,t_irh2,t_ifo2,t_ict1,t_ifc2)
+ opt4d(2,2,2,1)=g1(i,t_irh2,t_ifo2,t_ict2,t_ifc1)
+ opt4d(2,2,2,2)=g1(i,t_irh2,t_ifo2,t_ict2,t_ifc2)
+
+! interpolation in the fac, cat and fombg dimensions
+ call lininterpol4dim (d2mx, dxm1, invd, opt4d, ge1, ge2)
+
+! finally, interpolation in the rh dimension (dim. 1)
+! write(*,*) 'Before gass'
+ gass(icol,k,kc10,i)=((t_rh2-t_xrh)*ge1+(t_xrh-t_rh1)*ge2) &
+ /(t_rh2-t_rh1)
+!alt gass(icol,k,kc10,i)=(d2mx(1)*ge1+dxm1(1)*ge2)*invd(1)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol extinction
+
+! end points as basis for multidimentional linear interpolation
+ opt4d(1,1,1,1)=be1(i,t_irh1,t_ifo1,t_ict1,t_ifc1)
+ opt4d(1,1,1,2)=be1(i,t_irh1,t_ifo1,t_ict1,t_ifc2)
+ opt4d(1,1,2,1)=be1(i,t_irh1,t_ifo1,t_ict2,t_ifc1)
+ opt4d(1,1,2,2)=be1(i,t_irh1,t_ifo1,t_ict2,t_ifc2)
+ opt4d(1,2,1,1)=be1(i,t_irh1,t_ifo2,t_ict1,t_ifc1)
+ opt4d(1,2,1,2)=be1(i,t_irh1,t_ifo2,t_ict1,t_ifc2)
+ opt4d(1,2,2,1)=be1(i,t_irh1,t_ifo2,t_ict2,t_ifc1)
+ opt4d(1,2,2,2)=be1(i,t_irh1,t_ifo2,t_ict2,t_ifc2)
+ opt4d(2,1,1,1)=be1(i,t_irh2,t_ifo1,t_ict1,t_ifc1)
+ opt4d(2,1,1,2)=be1(i,t_irh2,t_ifo1,t_ict1,t_ifc2)
+ opt4d(2,1,2,1)=be1(i,t_irh2,t_ifo1,t_ict2,t_ifc1)
+ opt4d(2,1,2,2)=be1(i,t_irh2,t_ifo1,t_ict2,t_ifc2)
+ opt4d(2,2,1,1)=be1(i,t_irh2,t_ifo2,t_ict1,t_ifc1)
+ opt4d(2,2,1,2)=be1(i,t_irh2,t_ifo2,t_ict1,t_ifc2)
+ opt4d(2,2,2,1)=be1(i,t_irh2,t_ifo2,t_ict2,t_ifc1)
+ opt4d(2,2,2,2)=be1(i,t_irh2,t_ifo2,t_ict2,t_ifc2)
+
+! interpolation in the fac, cat and fombg dimensions
+ call lininterpol4dim (d2mx, dxm1, invd, opt4d, bex1, bex2)
+
+ bex1=max(bex1,1.e-30_r8)
+ bex2=max(bex2,1.e-30_r8)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before bex'
+ if(t_xrh <= 0.37_r8) then
+ bex(icol,k,kc10,i)=((t_rh2-t_xrh)*bex1+(t_xrh-t_rh1)*bex2) &
+ /(t_rh2-t_rh1)
+!alt bex(icol,k,kc10,i)=(d2mx(1)*bex1+dxm1(1)*bex2)*invd(1)
+ else
+ a=(log(bex2)-log(bex1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(bex1)-t_rh1*log(bex2))/(t_rh2-t_rh1)
+ bex(icol,k,kc10,i)=e**(a*t_xrh+b)
+!alt a=(log(bex2)-log(bex1))*invd(1)
+!alt b=(t_rh2*log(bex1)-t_rh1*log(bex2))*invd(1)
+!alt bex(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+
+! if(bex(icol,k,kc10,8)<1.e-20_r8) then
+! write(*,995) 'bex(8)=', kc10, t_xrh, t_xct, t_xfac, t_xfombg, bex(icol,k,kc10,8)
+! endif
+ else ! daylight
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol extinction used for size information in LW
+
+ i=4
+
+! end points as basis for multidimentional linear interpolation
+ opt4d(1,1,1,1)=be1(i,t_irh1,t_ifo1,t_ict1,t_ifc1)
+ opt4d(1,1,1,2)=be1(i,t_irh1,t_ifo1,t_ict1,t_ifc2)
+ opt4d(1,1,2,1)=be1(i,t_irh1,t_ifo1,t_ict2,t_ifc1)
+ opt4d(1,1,2,2)=be1(i,t_irh1,t_ifo1,t_ict2,t_ifc2)
+ opt4d(1,2,1,1)=be1(i,t_irh1,t_ifo2,t_ict1,t_ifc1)
+ opt4d(1,2,1,2)=be1(i,t_irh1,t_ifo2,t_ict1,t_ifc2)
+ opt4d(1,2,2,1)=be1(i,t_irh1,t_ifo2,t_ict2,t_ifc1)
+ opt4d(1,2,2,2)=be1(i,t_irh1,t_ifo2,t_ict2,t_ifc2)
+ opt4d(2,1,1,1)=be1(i,t_irh2,t_ifo1,t_ict1,t_ifc1)
+ opt4d(2,1,1,2)=be1(i,t_irh2,t_ifo1,t_ict1,t_ifc2)
+ opt4d(2,1,2,1)=be1(i,t_irh2,t_ifo1,t_ict2,t_ifc1)
+ opt4d(2,1,2,2)=be1(i,t_irh2,t_ifo1,t_ict2,t_ifc2)
+ opt4d(2,2,1,1)=be1(i,t_irh2,t_ifo2,t_ict1,t_ifc1)
+ opt4d(2,2,1,2)=be1(i,t_irh2,t_ifo2,t_ict1,t_ifc2)
+ opt4d(2,2,2,1)=be1(i,t_irh2,t_ifo2,t_ict2,t_ifc1)
+ opt4d(2,2,2,2)=be1(i,t_irh2,t_ifo2,t_ict2,t_ifc2)
+
+! interpolation in the fac, cat and fombg dimensions
+ call lininterpol4dim (d2mx, dxm1, invd, opt4d, bex1, bex2)
+
+ bex1=max(bex1,1.e-30_r8)
+ bex2=max(bex2,1.e-30_r8)
+
+! finally, interpolation in the rh dimension
+ if(t_xrh <= 0.37_r8) then
+ bex(icol,k,kc10,i)=((t_rh2-t_xrh)*bex1+(t_xrh-t_rh1)*bex2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(bex2)-log(bex1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(bex1)-t_rh1*log(bex2))/(t_rh2-t_rh1)
+ bex(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ endif ! daylight
+
+
+ do i=4,4 ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol specific extinction
+
+! end points as basis for multidimentional linear interpolation
+ opt4d(1,1,1,1)=ke1(i,t_irh1,t_ifo1,t_ict1,t_ifc1)
+ opt4d(1,1,1,2)=ke1(i,t_irh1,t_ifo1,t_ict1,t_ifc2)
+ opt4d(1,1,2,1)=ke1(i,t_irh1,t_ifo1,t_ict2,t_ifc1)
+ opt4d(1,1,2,2)=ke1(i,t_irh1,t_ifo1,t_ict2,t_ifc2)
+ opt4d(1,2,1,1)=ke1(i,t_irh1,t_ifo2,t_ict1,t_ifc1)
+ opt4d(1,2,1,2)=ke1(i,t_irh1,t_ifo2,t_ict1,t_ifc2)
+ opt4d(1,2,2,1)=ke1(i,t_irh1,t_ifo2,t_ict2,t_ifc1)
+ opt4d(1,2,2,2)=ke1(i,t_irh1,t_ifo2,t_ict2,t_ifc2)
+ opt4d(2,1,1,1)=ke1(i,t_irh2,t_ifo1,t_ict1,t_ifc1)
+ opt4d(2,1,1,2)=ke1(i,t_irh2,t_ifo1,t_ict1,t_ifc2)
+ opt4d(2,1,2,1)=ke1(i,t_irh2,t_ifo1,t_ict2,t_ifc1)
+ opt4d(2,1,2,2)=ke1(i,t_irh2,t_ifo1,t_ict2,t_ifc2)
+ opt4d(2,2,1,1)=ke1(i,t_irh2,t_ifo2,t_ict1,t_ifc1)
+ opt4d(2,2,1,2)=ke1(i,t_irh2,t_ifo2,t_ict1,t_ifc2)
+ opt4d(2,2,2,1)=ke1(i,t_irh2,t_ifo2,t_ict2,t_ifc1)
+ opt4d(2,2,2,2)=ke1(i,t_irh2,t_ifo2,t_ict2,t_ifc2)
+
+! interpolation in the fac, cat and fombg dimensions
+ call lininterpol4dim (d2mx, dxm1, invd, opt4d, ske1, ske2)
+
+ ske1=max(ske1,1.e-30_r8)
+ ske2=max(ske2,1.e-30_r8)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before ske'
+ if(t_xrh <= 0.37_r8) then
+ ske(icol,k,kc10,i)=((t_rh2-t_xrh)*ske1+(t_xrh-t_rh1)*ske2) &
+ /(t_rh2-t_rh1)
+!alt ske(icol,k,kc10,i)=(d2mx(1)*ske1+dxm1(1)*ske2)*invd(1)
+ else
+ a=(log(ske2)-log(ske1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(ske1)-t_rh1*log(ske2))/(t_rh2-t_rh1)
+ ske(icol,k,kc10,i)=e**(a*t_xrh+b)
+!alt a=(log(ske2)-log(ske1))*invd(1)
+!alt b=(t_rh2*log(ske1)-t_rh1*log(ske2))*invd(1)
+!alt ske(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+
+
+
+ if (lw_on) then
+
+! LW optical parameters
+ do i=1,nlwbands ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol specific absorption in LW
+
+! end points as basis for multidimentional linear interpolation
+ opt4d(1,1,1,1)=ka1(i,t_irh1,t_ifo1,t_ict1,t_ifc1)
+ opt4d(1,1,1,2)=ka1(i,t_irh1,t_ifo1,t_ict1,t_ifc2)
+ opt4d(1,1,2,1)=ka1(i,t_irh1,t_ifo1,t_ict2,t_ifc1)
+ opt4d(1,1,2,2)=ka1(i,t_irh1,t_ifo1,t_ict2,t_ifc2)
+ opt4d(1,2,1,1)=ka1(i,t_irh1,t_ifo2,t_ict1,t_ifc1)
+ opt4d(1,2,1,2)=ka1(i,t_irh1,t_ifo2,t_ict1,t_ifc2)
+ opt4d(1,2,2,1)=ka1(i,t_irh1,t_ifo2,t_ict2,t_ifc1)
+ opt4d(1,2,2,2)=ka1(i,t_irh1,t_ifo2,t_ict2,t_ifc2)
+ opt4d(2,1,1,1)=ka1(i,t_irh2,t_ifo1,t_ict1,t_ifc1)
+ opt4d(2,1,1,2)=ka1(i,t_irh2,t_ifo1,t_ict1,t_ifc2)
+ opt4d(2,1,2,1)=ka1(i,t_irh2,t_ifo1,t_ict2,t_ifc1)
+ opt4d(2,1,2,2)=ka1(i,t_irh2,t_ifo1,t_ict2,t_ifc2)
+ opt4d(2,2,1,1)=ka1(i,t_irh2,t_ifo2,t_ict1,t_ifc1)
+ opt4d(2,2,1,2)=ka1(i,t_irh2,t_ifo2,t_ict1,t_ifc2)
+ opt4d(2,2,2,1)=ka1(i,t_irh2,t_ifo2,t_ict2,t_ifc1)
+ opt4d(2,2,2,2)=ka1(i,t_irh2,t_ifo2,t_ict2,t_ifc2)
+
+! interpolation in the fac, cat and fombg dimensions
+ call lininterpol4dim (d2mx, dxm1, invd, opt4d, kabs1, kabs2)
+
+ kabs1=max(kabs1,1.e-30)
+ kabs2=max(kabs2,1.e-30)
+
+! write(*,*) 'Before kabs'
+ if(t_xrh <= 0.37) then
+ kabs(icol,k,kc10,i)=((t_rh2-t_xrh)*kabs1+(t_xrh-t_rh1)*kabs2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(kabs2)-log(kabs1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(kabs1)-t_rh1*log(kabs2))/(t_rh2-t_rh1)
+ kabs(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+
+ endif ! lw_on
+
+ end do ! icol
+ end do ! k
+
+! write(*,*) 'kcomp, omega(1,26,kcomp,4)=', kcomp, omega(1,26,kcomp,4)
+! write(*,*) 'kcomp, gass(1,26,kcomp,4)=', kcomp, gass(1,26,kcomp,4)
+! write(*,*) 'kcomp, bex(1,26,kcomp,4)=', kcomp, bex(1,26,kcomp,4)
+! write(*,*) 'kcomp, ske(1,26,kcomp,4)=', kcomp, ske(1,26,kcomp,4)
+
+ end do ! kcomp
+
+ return
+end subroutine interpol1
+
+
+!********************************************************************************************
+
+subroutine interpol2to3 (lchnk, ncol, daylight, xrh, irh1, mplus10, Nnatk, &
+ xct, ict1, xfac, ifac1, omega, gass, bex, ske, lw_on, kabs)
+
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ implicit none
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ integer, intent(in) :: mplus10 ! mode number (0) or number + 10 (1)
+ logical, intent(in) :: daylight(pcols) ! only daylight calculations if .true.
+ logical, intent(in) :: lw_on ! LW calculations are performed if true
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xrh(pcols,pver) ! level relative humidity (fraction)
+ integer, intent(in) :: irh1(pcols,pver)
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! condensed SOA/(SOA+H2SO4) (1-4) or added carbonaceous fraction (5-10)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+!
+!
+! Input-Output arguments
+!
+!
+! Output arguments
+!
+ real(r8), intent(out) :: omega(pcols,pver,0:nmodes,nbands) ! spectral modal single scattering albedo
+ real(r8), intent(out) :: gass(pcols,pver,0:nmodes,nbands) ! spectral modal asymmetry factor
+ real(r8), intent(out) :: bex(pcols,pver,0:nmodes,nbands) ! spectral modal extinction coefficient
+ real(r8), intent(out) :: ske(pcols,pver,0:nmodes,nbands) ! spectral modal specific extinction coefficient
+ real(r8), intent(out) :: kabs(pcols,pver,0:nmodes,nlwbands)! LW spectral modal specific absorption coefficient
+!
+!---------------------------Local variables-----------------------------
+!
+ integer i, kcomp, k, icol, kc10
+ real(r8) a, b
+
+! Temporary storage of often used array elements
+ integer t_irh1, t_irh2, t_ict1, t_ict2, t_ifc1, t_ifc2
+ real(r8) t_fac1, t_fac2, t_xfac, t_xrh, t_xct, t_rh1, t_rh2, &
+ t_cat1, t_cat2
+ real(r8) d2mx(3), dxm1(3), invd(3)
+ real(r8) opt3d(2,2,2)
+ real(r8) ome1, ome2, ge1, ge2, bex1, bex2, ske1, ske2
+ real(r8) kabs1, kabs2
+
+
+! write(*,*) 'Before kcomp-loop'
+! do kcomp=2,3
+ do kcomp=2,2
+
+ if(mplus10==0) then
+ kc10=kcomp
+ else
+ kc10=kcomp+10
+ endif
+
+! write(*,*) 'Before init-loop', kc10
+ do i=1,nbands
+ do icol=1,ncol
+ do k=1,pver
+ omega(icol,k,kc10,i)=0.0_r8
+ gass(icol,k,kc10,i)=0.0_r8
+ bex(icol,k,kc10,i)=0.0_r8
+ ske(icol,k,kc10,i)=0.0_r8
+ end do
+ end do
+ end do
+ do i=1,nlwbands
+ do icol=1,ncol
+ do k=1,pver
+ kabs(icol,k,kc10,i)=0.0_r8
+ end do
+ end do
+ end do
+
+ do k=1,pver
+ do icol=1,ncol
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+
+ t_irh1 = irh1(icol,k)
+ t_irh2 = t_irh1+1
+ t_ict1 = ict1(icol,k,kc10)
+ t_ict2 = t_ict1+1
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+
+! write(*,*) 't_irh1,t_irh2=',t_irh1,t_irh2
+! write(*,*) 't_ict1,t_ict2=',t_ict1,t_ict2
+! write(*,*) 't_ifc1,t_ifc2=',t_ifc1,t_ifc2
+! write(*,*) 't_ifa1,t_ifa2=',t_ifa1,t_ifa2
+
+ t_rh1 = rh(t_irh1)
+ t_rh2 = rh(t_irh2)
+ t_cat1 = cate(kcomp,t_ict1)
+ t_cat2 = cate(kcomp,t_ict2)
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+
+! write(*,*) 't_rh1,t_rh2,t_cat1,t_cat2=',t_rh1,t_rh2,t_cat1,t_cat2
+! write(*,*) 't_fac1,t_fac2=',t_fac1,t_fac2
+
+ t_xrh = xrh(icol,k)
+ t_xct = xct(icol,k,kc10)
+ t_xfac = xfac(icol,k,kcomp)
+
+! partial lengths along each dimension (1-4) for interpolation
+ d2mx(1) = (t_rh2-t_xrh)
+ dxm1(1) = (t_xrh-t_rh1)
+ invd(1) = 1.0_r8/(t_rh2-t_rh1)
+ d2mx(2) = (t_cat2-t_xct)
+ dxm1(2) = (t_xct-t_cat1)
+ invd(2) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(3) = (t_fac2-t_xfac)
+ dxm1(3) = (t_xfac-t_fac1)
+ invd(3) = 1.0_r8/(t_fac2-t_fac1)
+
+
+! SW optical parameters
+ if(daylight(icol)) then
+
+ do i=1,nbands ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! single scattering albedo:
+
+! end points as basis for multidimentional linear interpolation
+ opt3d(1,1,1)=om2to3(i,t_irh1,t_ict1,t_ifc1,kcomp)
+ opt3d(1,1,2)=om2to3(i,t_irh1,t_ict1,t_ifc2,kcomp)
+ opt3d(1,2,1)=om2to3(i,t_irh1,t_ict2,t_ifc1,kcomp)
+ opt3d(1,2,2)=om2to3(i,t_irh1,t_ict2,t_ifc2,kcomp)
+ opt3d(2,1,1)=om2to3(i,t_irh2,t_ict1,t_ifc1,kcomp)
+ opt3d(2,1,2)=om2to3(i,t_irh2,t_ict1,t_ifc2,kcomp)
+ opt3d(2,2,1)=om2to3(i,t_irh2,t_ict2,t_ifc1,kcomp)
+ opt3d(2,2,2)=om2to3(i,t_irh2,t_ict2,t_ifc2,kcomp)
+
+! interpolation in the (fac and) cat dimension
+ call lininterpol3dim (d2mx, dxm1, invd, opt3d, ome1, ome2)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before omega'
+ omega(icol,k,kc10,i)=((t_rh2-t_xrh)*ome1+(t_xrh-t_rh1)*ome2) &
+ /(t_rh2-t_rh1)
+! write(*,*) omega(icol,k,kc10,i)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! asymmetry factor
+
+! end points as basis for multidimentional linear interpolation
+ opt3d(1,1,1)=g2to3(i,t_irh1,t_ict1,t_ifc1,kcomp)
+ opt3d(1,1,2)=g2to3(i,t_irh1,t_ict1,t_ifc2,kcomp)
+ opt3d(1,2,1)=g2to3(i,t_irh1,t_ict2,t_ifc1,kcomp)
+ opt3d(1,2,2)=g2to3(i,t_irh1,t_ict2,t_ifc2,kcomp)
+ opt3d(2,1,1)=g2to3(i,t_irh2,t_ict1,t_ifc1,kcomp)
+ opt3d(2,1,2)=g2to3(i,t_irh2,t_ict1,t_ifc2,kcomp)
+ opt3d(2,2,1)=g2to3(i,t_irh2,t_ict2,t_ifc1,kcomp)
+ opt3d(2,2,2)=g2to3(i,t_irh2,t_ict2,t_ifc2,kcomp)
+
+! interpolation in the (fac and) cat dimension
+ call lininterpol3dim (d2mx, dxm1, invd, opt3d, ge1, ge2)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before gass'
+ gass(icol,k,kc10,i)=((t_rh2-t_xrh)*ge1+(t_xrh-t_rh1)*ge2) &
+ /(t_rh2-t_rh1)
+! write(*,*) gass(icol,k,kc10,i)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol extinction
+
+! end points as basis for multidimentional linear interpolation
+ opt3d(1,1,1)=be2to3(i,t_irh1,t_ict1,t_ifc1,kcomp)
+ opt3d(1,1,2)=be2to3(i,t_irh1,t_ict1,t_ifc2,kcomp)
+ opt3d(1,2,1)=be2to3(i,t_irh1,t_ict2,t_ifc1,kcomp)
+ opt3d(1,2,2)=be2to3(i,t_irh1,t_ict2,t_ifc2,kcomp)
+ opt3d(2,1,1)=be2to3(i,t_irh2,t_ict1,t_ifc1,kcomp)
+ opt3d(2,1,2)=be2to3(i,t_irh2,t_ict1,t_ifc2,kcomp)
+ opt3d(2,2,1)=be2to3(i,t_irh2,t_ict2,t_ifc1,kcomp)
+ opt3d(2,2,2)=be2to3(i,t_irh2,t_ict2,t_ifc2,kcomp)
+
+! interpolation in the (fac and) cat dimension
+ call lininterpol3dim (d2mx, dxm1, invd, opt3d, bex1, bex2)
+
+ bex1=max(bex1,1.e-30)
+ bex2=max(bex2,1.e-30)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before bex'
+ if(t_xrh <= 0.37) then
+ bex(icol,k,kc10,i)=((t_rh2-t_xrh)*bex1+(t_xrh-t_rh1)*bex2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(bex2)-log(bex1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(bex1)-t_rh1*log(bex2))/(t_rh2-t_rh1)
+ bex(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+ else ! daylight
+
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol extinction used for LW size information
+
+ i=4
+! end points as basis for multidimentional linear interpolation
+ opt3d(1,1,1)=be2to3(i,t_irh1,t_ict1,t_ifc1,kcomp)
+ opt3d(1,1,2)=be2to3(i,t_irh1,t_ict1,t_ifc2,kcomp)
+ opt3d(1,2,1)=be2to3(i,t_irh1,t_ict2,t_ifc1,kcomp)
+ opt3d(1,2,2)=be2to3(i,t_irh1,t_ict2,t_ifc2,kcomp)
+ opt3d(2,1,1)=be2to3(i,t_irh2,t_ict1,t_ifc1,kcomp)
+ opt3d(2,1,2)=be2to3(i,t_irh2,t_ict1,t_ifc2,kcomp)
+ opt3d(2,2,1)=be2to3(i,t_irh2,t_ict2,t_ifc1,kcomp)
+ opt3d(2,2,2)=be2to3(i,t_irh2,t_ict2,t_ifc2,kcomp)
+
+! interpolation in the (fac and) cat dimension
+ call lininterpol3dim (d2mx, dxm1, invd, opt3d, bex1, bex2)
+
+ bex1=max(bex1,1.e-30)
+ bex2=max(bex2,1.e-30)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before bex'
+ if(t_xrh <= 0.37) then
+ bex(icol,k,kc10,i)=((t_rh2-t_xrh)*bex1+(t_xrh-t_rh1)*bex2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(bex2)-log(bex1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(bex1)-t_rh1*log(bex2))/(t_rh2-t_rh1)
+ bex(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ endif ! daylight
+
+
+
+ do i=4,4 ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol specific extinction
+
+! end points as basis for multidimentional linear interpolation
+ opt3d(1,1,1)=ke2to3(i,t_irh1,t_ict1,t_ifc1,kcomp)
+ opt3d(1,1,2)=ke2to3(i,t_irh1,t_ict1,t_ifc2,kcomp)
+ opt3d(1,2,1)=ke2to3(i,t_irh1,t_ict2,t_ifc1,kcomp)
+ opt3d(1,2,2)=ke2to3(i,t_irh1,t_ict2,t_ifc2,kcomp)
+ opt3d(2,1,1)=ke2to3(i,t_irh2,t_ict1,t_ifc1,kcomp)
+ opt3d(2,1,2)=ke2to3(i,t_irh2,t_ict1,t_ifc2,kcomp)
+ opt3d(2,2,1)=ke2to3(i,t_irh2,t_ict2,t_ifc1,kcomp)
+ opt3d(2,2,2)=ke2to3(i,t_irh2,t_ict2,t_ifc2,kcomp)
+
+! interpolation in the (fac and) cat dimension
+ call lininterpol3dim (d2mx, dxm1, invd, opt3d, ske1, ske2)
+
+ ske1=max(ske1,1.e-30)
+ ske2=max(ske2,1.e-30)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before ske'
+ if(t_xrh <= 0.37) then
+ ske(icol,k,kc10,i)=((t_rh2-t_xrh)*ske1+(t_xrh-t_rh1)*ske2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(ske2)-log(ske1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(ske1)-t_rh1*log(ske2))/(t_rh2-t_rh1)
+ ske(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+
+
+
+ if (lw_on) then
+
+! LW optical parameters
+ do i=1,nlwbands ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol specific absorption in LW
+
+! end points as basis for multidimentional linear interpolation
+ opt3d(1,1,1)=ka2to3(i,t_irh1,t_ict1,t_ifc1,kcomp)
+ opt3d(1,1,2)=ka2to3(i,t_irh1,t_ict1,t_ifc2,kcomp)
+ opt3d(1,2,1)=ka2to3(i,t_irh1,t_ict2,t_ifc1,kcomp)
+ opt3d(1,2,2)=ka2to3(i,t_irh1,t_ict2,t_ifc2,kcomp)
+ opt3d(2,1,1)=ka2to3(i,t_irh2,t_ict1,t_ifc1,kcomp)
+ opt3d(2,1,2)=ka2to3(i,t_irh2,t_ict1,t_ifc2,kcomp)
+ opt3d(2,2,1)=ka2to3(i,t_irh2,t_ict2,t_ifc1,kcomp)
+ opt3d(2,2,2)=ka2to3(i,t_irh2,t_ict2,t_ifc2,kcomp)
+
+! interpolation in the (fac and) cat dimension
+ call lininterpol3dim (d2mx, dxm1, invd, opt3d, kabs1, kabs2)
+
+ kabs1=max(kabs1,1.e-30_r8)
+ kabs2=max(kabs2,1.e-30_r8)
+
+! write(*,*) 'Before kabs'
+ if(t_xrh <= 0.37_r8) then
+ kabs(icol,k,kc10,i)=((t_rh2-t_xrh)*kabs1+(t_xrh-t_rh1)*kabs2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(kabs2)-log(kabs1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(kabs1)-t_rh1*log(kabs2))/(t_rh2-t_rh1)
+ kabs(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+
+ endif ! lw_on
+
+ end do ! icol
+ end do ! k
+
+! write(*,*) 'kcomp, omega(1,26,kcomp,4)=', kcomp, omega(1,26,kcomp,4)
+! write(*,*) 'kcomp, gass(1,26,kcomp,4)=', kcomp, gass(1,26,kcomp,4)
+! write(*,*) 'kcomp, bex(1,26,kcomp,4)=', kcomp, bex(1,26,kcomp,4)
+! write(*,*) 'kcomp, ske(1,26,kcomp,4)=', kcomp, ske(1,26,kcomp,4)
+
+ end do ! kcomp
+
+ return
+end subroutine interpol2to3
+
+!********************************************************************************************
+
+subroutine interpol4 (lchnk, ncol, daylight, xrh, irh1, mplus10, Nnatk, xfbcbg, ifbcbg1, &
+ xct, ict1, xfac, ifac1, xfaq, ifaq1, &
+ omega, gass, bex, ske, lw_on, kabs)
+
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ implicit none
+
+
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ integer, intent(in) :: mplus10 ! mode number (0) or number + 10 (1)
+ logical, intent(in) :: daylight(pcols) ! only daylight calculations if .true.
+ logical, intent(in) :: lw_on ! LW calculations are performed if true
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xrh(pcols,pver) ! level relative humidity (fraction)
+ integer, intent(in) :: irh1(pcols,pver)
+ real(r8), intent(in) :: xfbcbg(pcols,pver) ! mass fraction BC/(BC+OC) for the background mode
+ integer, intent(in) :: ifbcbg1(pcols,pver)
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! condensed SOA/(SOA+H2SO4) (1-4) or added carbonaceous fraction (5-10)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfaq(pcols,pver,nbmodes) ! modal SO4(aq)/SO4
+ integer, intent(in) :: ifaq1(pcols,pver,nbmodes)
+!
+! Input-Output arguments
+!
+!
+! Output arguments
+!
+ real(r8), intent(out) :: omega(pcols,pver,0:nmodes,nbands) ! spectral modal single scattering albedo
+ real(r8), intent(out) :: gass(pcols,pver,0:nmodes,nbands) ! spectral modal asymmetry factor
+ real(r8), intent(out) :: bex(pcols,pver,0:nmodes,nbands) ! spectral modal extinction coefficient
+ real(r8), intent(out) :: ske(pcols,pver,0:nmodes,nbands) ! spectral modal specific extinction coefficient
+ real(r8), intent(out) :: kabs(pcols,pver,0:nmodes,nlwbands)! LW spectral modal specific absorption coefficient
+!
+!---------------------------Local variables-----------------------------
+!
+ integer i, kcomp, k, kc10, icol
+ real(r8) a, b
+
+! Temporary storage of often used array elements
+ integer t_irh1, t_irh2, t_ict1, t_ict2, t_ifa1, t_ifa2, &
+ t_ifb1, t_ifb2, t_ifc1, t_ifc2
+ real(r8) t_faq1, t_faq2, t_xfaq, t_fbcbg1, t_fbcbg2, t_xfbcbg, t_fac1, &
+ t_fac2, t_xfac, t_xrh, t_xct, t_rh1, t_rh2, t_cat1, t_cat2
+
+ real(r8) d2mx(5), dxm1(5), invd(5)
+ real(r8) opt5d(2,2,2,2,2)
+ real(r8) ome1, ome2, ge1, ge2, bex1, bex2, ske1, ske2
+ real(r8) kabs1, kabs2
+
+
+! write(*,*) 'Before kcomp-loop'
+ do kcomp=4,4
+
+ if(mplus10==0) then
+ kc10=kcomp
+ else
+ kc10=kcomp+10
+ endif
+
+! write(*,*) 'Before init-loop', kc10
+ do i=1,nbands
+ do icol=1,ncol
+ do k=1,pver
+ omega(icol,k,kc10,i)=0.0_r8
+ gass(icol,k,kc10,i)=0.0_r8
+ bex(icol,k,kc10,i)=0.0_r8
+ ske(icol,k,kc10,i)=0.0_r8
+ end do
+ end do
+ end do
+ do i=1,nlwbands
+ do icol=1,ncol
+ do k=1,pver
+ kabs(icol,k,kc10,i)=0.0_r8
+ end do
+ end do
+ end do
+
+ do k=1,pver
+ do icol=1,ncol
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+
+ t_irh1 = irh1(icol,k)
+ t_irh2 = t_irh1+1
+ t_ict1 = ict1(icol,k,kc10)
+ t_ict2 = t_ict1+1
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+ t_ifb1 = ifbcbg1(icol,k)
+ t_ifb2 = t_ifb1+1
+ t_ifa1 = ifaq1(icol,k,kcomp)
+ t_ifa2 = t_ifa1+1
+
+ t_rh1 = rh(t_irh1)
+ t_rh2 = rh(t_irh2)
+ t_cat1 = cate(kcomp,t_ict1)
+ t_cat2 = cate(kcomp,t_ict2)
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+ t_fbcbg1 = fbcbg(t_ifb1)
+ t_fbcbg2 = fbcbg(t_ifb2)
+ t_faq1 = faq(t_ifa1)
+ t_faq2 = faq(t_ifa2)
+
+ t_xrh = xrh(icol,k)
+ t_xct = xct(icol,k,kc10)
+ t_xfac = xfac(icol,k,kcomp)
+ t_xfbcbg = xfbcbg(icol,k)
+ t_xfaq = xfaq(icol,k,kcomp)
+
+! partial lengths along each dimension (1-5) for interpolation
+ d2mx(1) = (t_rh2-t_xrh)
+ dxm1(1) = (t_xrh-t_rh1)
+ invd(1) = 1.0_r8/(t_rh2-t_rh1)
+ d2mx(2) = (t_fbcbg2-t_xfbcbg)
+ dxm1(2) = (t_xfbcbg-t_fbcbg1)
+ invd(2) = 1.0_r8/(t_fbcbg2-t_fbcbg1)
+ d2mx(3) = (t_cat2-t_xct)
+ dxm1(3) = (t_xct-t_cat1)
+ invd(3) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(4) = (t_fac2-t_xfac)
+ dxm1(4) = (t_xfac-t_fac1)
+ invd(4) = 1.0_r8/(t_fac2-t_fac1)
+ d2mx(5) = (t_faq2-t_xfaq)
+ dxm1(5) = (t_xfaq-t_faq1)
+ invd(5) = 1.0_r8/(t_faq2-t_faq1)
+
+! SW optical parameters
+ if(daylight(icol)) then
+
+ do i=1,nbands ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! single scattering albedo:
+
+ opt5d(1,1,1,1,1)=om4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,1,1,1,2)=om4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,1,1,2,1)=om4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,1,1,2,2)=om4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,1,2,1,1)=om4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,1,2,1,2)=om4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,1,2,2,1)=om4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,1,2,2,2)=om4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(1,2,1,1,1)=om4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,2,1,1,2)=om4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,2,1,2,1)=om4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,2,1,2,2)=om4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,2,2,1,1)=om4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,2,2,1,2)=om4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,2,2,2,1)=om4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,2,2,2,2)=om4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,1,1,1,1)=om4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,1,1,1,2)=om4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,1,1,2,1)=om4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,1,1,2,2)=om4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,1,2,1,1)=om4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,1,2,1,2)=om4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,1,2,2,1)=om4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,1,2,2,2)=om4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,2,1,1,1)=om4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,2,1,1,2)=om4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,2,1,2,1)=om4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,2,1,2,2)=om4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,2,2,1,1)=om4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,2,2,1,2)=om4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,2,2,2,1)=om4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,2,2,2,2)=om4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+
+! interpolation in the faq, fac, cat and fbcbg dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, ome1, ome2)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before omega'
+ omega(icol,k,kc10,i)=((t_rh2-t_xrh)*ome1+(t_xrh-t_rh1)*ome2) &
+ /(t_rh2-t_rh1)
+! write(*,*) omega(icol,k,kc10,i)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! asymmetry factor
+
+ opt5d(1,1,1,1,1)=g4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,1,1,1,2)=g4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,1,1,2,1)=g4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,1,1,2,2)=g4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,1,2,1,1)=g4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,1,2,1,2)=g4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,1,2,2,1)=g4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,1,2,2,2)=g4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(1,2,1,1,1)=g4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,2,1,1,2)=g4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,2,1,2,1)=g4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,2,1,2,2)=g4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,2,2,1,1)=g4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,2,2,1,2)=g4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,2,2,2,1)=g4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,2,2,2,2)=g4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,1,1,1,1)=g4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,1,1,1,2)=g4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,1,1,2,1)=g4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,1,1,2,2)=g4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,1,2,1,1)=g4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,1,2,1,2)=g4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,1,2,2,1)=g4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,1,2,2,2)=g4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,2,1,1,1)=g4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,2,1,1,2)=g4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,2,1,2,1)=g4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,2,1,2,2)=g4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,2,2,1,1)=g4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,2,2,1,2)=g4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,2,2,2,1)=g4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,2,2,2,2)=g4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+
+! interpolation in the faq, fac, cat and fbcbg dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, ge1, ge2)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before gass'
+ gass(icol,k,kc10,i)=((t_rh2-t_xrh)*ge1+(t_xrh-t_rh1)*ge2) &
+ /(t_rh2-t_rh1)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol extinction
+
+ opt5d(1,1,1,1,1)=be4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,1,1,1,2)=be4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,1,1,2,1)=be4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,1,1,2,2)=be4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,1,2,1,1)=be4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,1,2,1,2)=be4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,1,2,2,1)=be4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,1,2,2,2)=be4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(1,2,1,1,1)=be4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,2,1,1,2)=be4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,2,1,2,1)=be4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,2,1,2,2)=be4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,2,2,1,1)=be4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,2,2,1,2)=be4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,2,2,2,1)=be4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,2,2,2,2)=be4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,1,1,1,1)=be4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,1,1,1,2)=be4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,1,1,2,1)=be4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,1,1,2,2)=be4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,1,2,1,1)=be4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,1,2,1,2)=be4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,1,2,2,1)=be4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,1,2,2,2)=be4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,2,1,1,1)=be4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,2,1,1,2)=be4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,2,1,2,1)=be4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,2,1,2,2)=be4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,2,2,1,1)=be4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,2,2,1,2)=be4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,2,2,2,1)=be4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,2,2,2,2)=be4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+
+! interpolation in the faq, fac, cat and fbcbg dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, bex1, bex2)
+
+ bex1=max(bex1,1.e-30_r8)
+ bex2=max(bex2,1.e-30_r8)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before bex'
+ if(t_xrh <= 0.37_r8) then
+ bex(icol,k,kc10,i)=((t_rh2-t_xrh)*bex1+(t_xrh-t_rh1)*bex2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(bex2)-log(bex1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(bex1)-t_rh1*log(bex2))/(t_rh2-t_rh1)
+ bex(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+ else ! daylight
+
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol extinction called for use in size estimate for use in LW
+ i=4
+
+ opt5d(1,1,1,1,1)=be4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,1,1,1,2)=be4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,1,1,2,1)=be4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,1,1,2,2)=be4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,1,2,1,1)=be4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,1,2,1,2)=be4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,1,2,2,1)=be4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,1,2,2,2)=be4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(1,2,1,1,1)=be4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,2,1,1,2)=be4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,2,1,2,1)=be4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,2,1,2,2)=be4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,2,2,1,1)=be4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,2,2,1,2)=be4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,2,2,2,1)=be4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,2,2,2,2)=be4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,1,1,1,1)=be4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,1,1,1,2)=be4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,1,1,2,1)=be4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,1,1,2,2)=be4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,1,2,1,1)=be4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,1,2,1,2)=be4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,1,2,2,1)=be4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,1,2,2,2)=be4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,2,1,1,1)=be4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,2,1,1,2)=be4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,2,1,2,1)=be4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,2,1,2,2)=be4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,2,2,1,1)=be4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,2,2,1,2)=be4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,2,2,2,1)=be4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,2,2,2,2)=be4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+
+! interpolation in the faq, fac, cat and fbcbg dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, bex1, bex2)
+
+ bex1=max(bex1,1.e-30_r8)
+ bex2=max(bex2,1.e-30_r8)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before bex'
+ if(t_xrh <= 0.37_r8) then
+ bex(icol,k,kc10,i)=((t_rh2-t_xrh)*bex1+(t_xrh-t_rh1)*bex2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(bex2)-log(bex1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(bex1)-t_rh1*log(bex2))/(t_rh2-t_rh1)
+ bex(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ endif ! daylight
+
+
+
+
+
+ do i=4,4 ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol specific extinction
+
+ opt5d(1,1,1,1,1)=ke4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,1,1,1,2)=ke4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,1,1,2,1)=ke4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,1,1,2,2)=ke4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,1,2,1,1)=ke4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,1,2,1,2)=ke4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,1,2,2,1)=ke4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,1,2,2,2)=ke4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(1,2,1,1,1)=ke4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,2,1,1,2)=ke4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,2,1,2,1)=ke4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,2,1,2,2)=ke4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,2,2,1,1)=ke4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,2,2,1,2)=ke4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,2,2,2,1)=ke4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,2,2,2,2)=ke4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,1,1,1,1)=ke4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,1,1,1,2)=ke4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,1,1,2,1)=ke4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,1,1,2,2)=ke4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,1,2,1,1)=ke4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,1,2,1,2)=ke4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,1,2,2,1)=ke4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,1,2,2,2)=ke4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,2,1,1,1)=ke4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,2,1,1,2)=ke4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,2,1,2,1)=ke4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,2,1,2,2)=ke4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,2,2,1,1)=ke4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,2,2,1,2)=ke4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,2,2,2,1)=ke4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,2,2,2,2)=ke4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+
+! interpolation in the faq, fac, cat and fbcbg dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, ske1, ske2)
+
+ ske1=max(ske1,1.e-30_r8)
+ ske2=max(ske2,1.e-30_r8)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before ske'
+ if(t_xrh <= 0.37_r8) then
+ ske(icol,k,kc10,i)=((t_rh2-t_xrh)*ske1+(t_xrh-t_rh1)*ske2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(ske2)-log(ske1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(ske1)-t_rh1*log(ske2))/(t_rh2-t_rh1)
+ ske(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+
+
+
+ if (lw_on) then
+
+! LW optical parameters
+
+ do i=1,nlwbands ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol specific absorption
+
+ opt5d(1,1,1,1,1)=ka4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,1,1,1,2)=ka4(i,t_irh1,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,1,1,2,1)=ka4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,1,1,2,2)=ka4(i,t_irh1,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,1,2,1,1)=ka4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,1,2,1,2)=ka4(i,t_irh1,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,1,2,2,1)=ka4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,1,2,2,2)=ka4(i,t_irh1,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(1,2,1,1,1)=ka4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(1,2,1,1,2)=ka4(i,t_irh1,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(1,2,1,2,1)=ka4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(1,2,1,2,2)=ka4(i,t_irh1,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(1,2,2,1,1)=ka4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(1,2,2,1,2)=ka4(i,t_irh1,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(1,2,2,2,1)=ka4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(1,2,2,2,2)=ka4(i,t_irh1,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,1,1,1,1)=ka4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,1,1,1,2)=ka4(i,t_irh2,t_ifb1,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,1,1,2,1)=ka4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,1,1,2,2)=ka4(i,t_irh2,t_ifb1,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,1,2,1,1)=ka4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,1,2,1,2)=ka4(i,t_irh2,t_ifb1,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,1,2,2,1)=ka4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,1,2,2,2)=ka4(i,t_irh2,t_ifb1,t_ict2,t_ifc2,t_ifa2)
+ opt5d(2,2,1,1,1)=ka4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa1)
+ opt5d(2,2,1,1,2)=ka4(i,t_irh2,t_ifb2,t_ict1,t_ifc1,t_ifa2)
+ opt5d(2,2,1,2,1)=ka4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa1)
+ opt5d(2,2,1,2,2)=ka4(i,t_irh2,t_ifb2,t_ict1,t_ifc2,t_ifa2)
+ opt5d(2,2,2,1,1)=ka4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa1)
+ opt5d(2,2,2,1,2)=ka4(i,t_irh2,t_ifb2,t_ict2,t_ifc1,t_ifa2)
+ opt5d(2,2,2,2,1)=ka4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa1)
+ opt5d(2,2,2,2,2)=ka4(i,t_irh2,t_ifb2,t_ict2,t_ifc2,t_ifa2)
+
+! interpolation in the faq, fac, cat and fbcbg dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, kabs1, kabs2)
+
+ kabs1=max(kabs1,1.e-30_r8)
+ kabs2=max(kabs2,1.e-30_r8)
+
+! write(*,*) 'Before kabs'
+ if(t_xrh <= 0.37_r8) then
+ kabs(icol,k,kc10,i)=((t_rh2-t_xrh)*kabs1+(t_xrh-t_rh1)*kabs2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(kabs2)-log(kabs1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(kabs1)-t_rh1*log(kabs2))/(t_rh2-t_rh1)
+ kabs(icol,k,kc10,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+
+ endif ! lw_on
+
+ end do ! icol
+ end do ! k
+
+! write(*,*) 'kcomp, omega(1,26,kc10,4)=', kcomp, omega(1,26,kc10,4)
+! write(*,*) 'kcomp, gass(1,26,kc10,4)=', kcomp, gass(1,26,kc10,4)
+! write(*,*) 'kcomp, bex(1,26,kc10,4)=', kcomp, bex(1,26,kc10,4)
+! write(*,*) 'kcomp, ske(1,26,kc10,4)=', kcomp, ske(1,26,kc10,4)
+
+ end do ! kcomp
+
+ return
+end subroutine interpol4
+
+
+!********************************************************************************************
+
+subroutine interpol5to10 (lchnk, ncol, daylight, xrh, irh1, Nnatk, xct, ict1, &
+ xfac, ifac1, xfbc, ifbc1, xfaq, ifaq1, &
+ omega, gass, bex, ske, lw_on, kabs)
+
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+
+ implicit none
+
+
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ logical, intent(in) :: daylight(pcols) ! only daylight calculations if .true.
+ logical, intent(in) :: lw_on ! LW calculations are performed if true
+ real(r8), intent(in) :: Nnatk(pcols,pver,0:nmodes) ! modal aerosol number concentration
+ real(r8), intent(in) :: xrh(pcols,pver) ! level relative humidity (fraction)
+ integer, intent(in) :: irh1(pcols,pver)
+ real(r8), intent(in) :: xct(pcols,pver,nmodes) ! modal internally mixed SO4+BC+OC conc.
+ integer, intent(in) :: ict1(pcols,pver,nmodes)
+ real(r8), intent(in) :: xfac(pcols,pver,nbmodes) ! modal (OC+BC)/(SO4+BC+OC)
+ integer, intent(in) :: ifac1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfbc(pcols,pver,nbmodes) ! modal BC/(OC+BC)
+ integer, intent(in) :: ifbc1(pcols,pver,nbmodes)
+ real(r8), intent(in) :: xfaq(pcols,pver,nbmodes) ! modal SO4(aq)/SO4
+ integer, intent(in) :: ifaq1(pcols,pver,nbmodes)
+!
+!
+! Input-Output arguments
+!
+!
+! Output arguments
+!
+ real(r8), intent(out) :: omega(pcols,pver,0:nmodes,nbands) ! spectral modal single scattering albedo
+ real(r8), intent(out) :: gass(pcols,pver,0:nmodes,nbands) ! spectral modal asymmetry factor
+ real(r8), intent(out) :: bex(pcols,pver,0:nmodes,nbands) ! spectral modal extinction coefficient
+ real(r8), intent(out) :: ske(pcols,pver,0:nmodes,nbands) ! spectral modal specific extinction coefficient
+ real(r8), intent(out) :: kabs(pcols,pver,0:nmodes,nlwbands)! LW spectral modal specific absorption coefficient
+!
+!---------------------------Local variables-----------------------------
+!
+ integer i, kcomp, k, icol
+ real(r8) a, b
+
+! Temporary storage of often used array elements
+ integer t_irh1, t_irh2, t_ict1, t_ict2, t_ifa1, t_ifa2, &
+ t_ifb1, t_ifb2, t_ifc1, t_ifc2
+ real(r8) t_faq1, t_faq2, t_xfaq, t_fbc1, t_fbc2, t_xfbc, t_fac1, &
+ t_fac2, t_xfac, t_xrh, t_xct, t_rh1, t_rh2, t_cat1, t_cat2
+ real(r8) d2mx(5), dxm1(5), invd(5)
+ real(r8) opt5d(2,2,2,2,2)
+ real(r8) ome1, ome2, ge1, ge2, bex1, bex2, ske1, ske2
+ real(r8) kabs1, kabs2
+
+
+! write(*,*) 'Before kcomp-loop'
+ do kcomp=5,10
+
+! write(*,*) 'Before init-loop', kcomp
+ do i=1,nbands
+ do icol=1,ncol
+ do k=1,pver
+ omega(icol,k,kcomp,i)=0.0_r8
+ gass(icol,k,kcomp,i)=0.0_r8
+ bex(icol,k,kcomp,i)=0.0_r8
+ ske(icol,k,kcomp,i)=0.0_r8
+ end do
+ end do
+ end do
+ do i=1,nlwbands
+ do icol=1,ncol
+ do k=1,pver
+ kabs(icol,k,kcomp,i)=0.0_r8
+ end do
+ end do
+ end do
+
+ do k=1,pver
+ do icol=1,ncol
+
+! Collect all the vector elements into temporary storage
+! to avoid cache conflicts and excessive cross-referencing
+
+ t_irh1 = irh1(icol,k)
+ t_irh2 = t_irh1+1
+ t_ict1 = ict1(icol,k,kcomp)
+ t_ict2 = t_ict1+1
+ t_ifc1 = ifac1(icol,k,kcomp)
+ t_ifc2 = t_ifc1+1
+
+ t_ifb1 = ifbc1(icol,k,kcomp)
+ t_ifb2 = t_ifb1+1
+ t_ifa1 = ifaq1(icol,k,kcomp)
+ t_ifa2 = t_ifa1+1
+
+ t_rh1 = rh(t_irh1)
+ t_rh2 = rh(t_irh2)
+ t_cat1 = cat(kcomp,t_ict1)
+ t_cat2 = cat(kcomp,t_ict2)
+ t_fac1 = fac(t_ifc1)
+ t_fac2 = fac(t_ifc2)
+ t_fbc1 = fbc(t_ifb1)
+ t_fbc2 = fbc(t_ifb2)
+ t_faq1 = faq(t_ifa1)
+ t_faq2 = faq(t_ifa2)
+
+ t_xrh = xrh(icol,k)
+ t_xct = xct(icol,k,kcomp)
+ t_xfac = xfac(icol,k,kcomp)
+ t_xfbc = xfbc(icol,k,kcomp)
+ t_xfaq = xfaq(icol,k,kcomp)
+
+! partial lengths along each dimension (1-5) for interpolation
+ d2mx(1) = (t_rh2-t_xrh)
+ dxm1(1) = (t_xrh-t_rh1)
+ invd(1) = 1.0_r8/(t_rh2-t_rh1)
+ d2mx(2) = (t_cat2-t_xct)
+ dxm1(2) = (t_xct-t_cat1)
+ invd(2) = 1.0_r8/(t_cat2-t_cat1)
+ d2mx(3) = (t_fac2-t_xfac)
+ dxm1(3) = (t_xfac-t_fac1)
+ invd(3) = 1.0_r8/(t_fac2-t_fac1)
+ d2mx(4) = (t_fbc2-t_xfbc)
+ dxm1(4) = (t_xfbc-t_fbc1)
+ invd(4) = 1.0_r8/(t_fbc2-t_fbc1)
+ d2mx(5) = (t_faq2-t_xfaq)
+ dxm1(5) = (t_xfaq-t_faq1)
+ invd(5) = 1.0_r8/(t_faq2-t_faq1)
+
+
+! SW optical parameters
+ if(daylight(icol)) then
+
+ do i=1,nbands ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! single scattering albedo:
+
+ opt5d(1,1,1,1,1)=om5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,1,1,2)=om5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,1,2,1)=om5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,1,2,2)=om5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,1,2,1,1)=om5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,2,1,2)=om5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,2,2,1)=om5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,2,2,2)=om5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,1,1,1)=om5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,1,1,2)=om5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,1,2,1)=om5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,1,2,2)=om5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,2,1,1)=om5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,2,1,2)=om5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,2,2,1)=om5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,2,2,2)=om5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,1,1,1)=om5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,1,1,2)=om5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,1,2,1)=om5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,1,2,2)=om5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,2,1,1)=om5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,2,1,2)=om5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,2,2,1)=om5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,2,2,2)=om5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,1,1,1)=om5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,1,1,2)=om5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,1,2,1)=om5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,1,2,2)=om5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,2,1,1)=om5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,2,1,2)=om5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,2,2,1)=om5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,2,2,2)=om5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+
+! interpolation in the faq, fbc, fac and cat dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, ome1, ome2)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before omega'
+ omega(icol,k,kcomp,i)=((t_rh2-t_xrh)*ome1+(t_xrh-t_rh1)*ome2) &
+ /(t_rh2-t_rh1)
+! write(*,*) omega(icol,k,kcomp,i)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! asymmetry factor
+
+ opt5d(1,1,1,1,1)=g5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,1,1,2)=g5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,1,2,1)=g5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,1,2,2)=g5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,1,2,1,1)=g5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,2,1,2)=g5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,2,2,1)=g5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,2,2,2)=g5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,1,1,1)=g5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,1,1,2)=g5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,1,2,1)=g5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,1,2,2)=g5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,2,1,1)=g5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,2,1,2)=g5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,2,2,1)=g5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,2,2,2)=g5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,1,1,1)=g5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,1,1,2)=g5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,1,2,1)=g5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,1,2,2)=g5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,2,1,1)=g5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,2,1,2)=g5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,2,2,1)=g5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,2,2,2)=g5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,1,1,1)=g5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,1,1,2)=g5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,1,2,1)=g5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,1,2,2)=g5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,2,1,1)=g5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,2,1,2)=g5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,2,2,1)=g5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,2,2,2)=g5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+
+! interpolation in the faq, fbc, fac and cat dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, ge1, ge2)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before gass'
+ gass(icol,k,kcomp,i)=((t_rh2-t_xrh)*ge1+(t_xrh-t_rh1)*ge2) &
+ /(t_rh2-t_rh1)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol extinction
+
+ opt5d(1,1,1,1,1)=be5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,1,1,2)=be5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,1,2,1)=be5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,1,2,2)=be5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,1,2,1,1)=be5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,2,1,2)=be5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,2,2,1)=be5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,2,2,2)=be5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,1,1,1)=be5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,1,1,2)=be5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,1,2,1)=be5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,1,2,2)=be5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,2,1,1)=be5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,2,1,2)=be5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,2,2,1)=be5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,2,2,2)=be5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,1,1,1)=be5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,1,1,2)=be5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,1,2,1)=be5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,1,2,2)=be5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,2,1,1)=be5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,2,1,2)=be5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,2,2,1)=be5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,2,2,2)=be5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,1,1,1)=be5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,1,1,2)=be5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,1,2,1)=be5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,1,2,2)=be5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,2,1,1)=be5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,2,1,2)=be5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,2,2,1)=be5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,2,2,2)=be5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+
+! interpolation in the faq, fbc, fac and cat dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, bex1, bex2)
+
+ bex1=max(bex1,1.e-30_r8)
+ bex2=max(bex2,1.e-30_r8)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before bex'
+ if(t_xrh <= 0.37_r8) then
+ bex(icol,k,kcomp,i)=((t_rh2-t_xrh)*bex1+(t_xrh-t_rh1)*bex2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(bex2)-log(bex1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(bex1)-t_rh1*log(bex2))/(t_rh2-t_rh1)
+ bex(icol,k,kcomp,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+ else ! daylight
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol extinction used for aerosol size estimate needed for LW calculations
+ i=4
+ opt5d(1,1,1,1,1)=be5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,1,1,2)=be5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,1,2,1)=be5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,1,2,2)=be5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,1,2,1,1)=be5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,2,1,2)=be5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,2,2,1)=be5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,2,2,2)=be5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,1,1,1)=be5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,1,1,2)=be5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,1,2,1)=be5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,1,2,2)=be5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,2,1,1)=be5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,2,1,2)=be5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,2,2,1)=be5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,2,2,2)=be5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,1,1,1)=be5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,1,1,2)=be5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,1,2,1)=be5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,1,2,2)=be5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,2,1,1)=be5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,2,1,2)=be5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,2,2,1)=be5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,2,2,2)=be5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,1,1,1)=be5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,1,1,2)=be5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,1,2,1)=be5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,1,2,2)=be5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,2,1,1)=be5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,2,1,2)=be5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,2,2,1)=be5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,2,2,2)=be5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+
+! interpolation in the faq, fbc, fac and cat dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, bex1, bex2)
+
+ bex1=max(bex1,1.e-30_r8)
+ bex2=max(bex2,1.e-30_r8)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before bex'
+ if(t_xrh <= 0.37_r8) then
+ bex(icol,k,kcomp,i)=((t_rh2-t_xrh)*bex1+(t_xrh-t_rh1)*bex2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(bex2)-log(bex1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(bex1)-t_rh1*log(bex2))/(t_rh2-t_rh1)
+ bex(icol,k,kcomp,i)=e**(a*t_xrh+b)
+ endif
+
+ endif ! daylight
+
+
+
+ do i=4,4 ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol specific extinction
+
+ opt5d(1,1,1,1,1)=ke5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,1,1,2)=ke5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,1,2,1)=ke5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,1,2,2)=ke5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,1,2,1,1)=ke5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,2,1,2)=ke5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,2,2,1)=ke5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,2,2,2)=ke5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,1,1,1)=ke5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,1,1,2)=ke5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,1,2,1)=ke5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,1,2,2)=ke5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,2,1,1)=ke5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,2,1,2)=ke5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,2,2,1)=ke5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,2,2,2)=ke5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,1,1,1)=ke5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,1,1,2)=ke5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,1,2,1)=ke5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,1,2,2)=ke5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,2,1,1)=ke5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,2,1,2)=ke5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,2,2,1)=ke5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,2,2,2)=ke5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,1,1,1)=ke5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,1,1,2)=ke5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,1,2,1)=ke5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,1,2,2)=ke5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,2,1,1)=ke5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,2,1,2)=ke5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,2,2,1)=ke5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,2,2,2)=ke5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+
+! interpolation in the faq, fbc, fac and cat dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, ske1, ske2)
+
+ ske1=max(ske1,1.e-30_r8)
+ ske2=max(ske2,1.e-30_r8)
+
+! finally, interpolation in the rh dimension
+! write(*,*) 'Before ske'
+ if(t_xrh <= 0.37_r8) then
+ ske(icol,k,kcomp,i)=((t_rh2-t_xrh)*ske1+(t_xrh-t_rh1)*ske2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(ske2)-log(ske1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(ske1)-t_rh1*log(ske2))/(t_rh2-t_rh1)
+ ske(icol,k,kcomp,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+
+
+
+ if (lw_on) then
+
+! LW optical parameters
+
+ do i=1,nlwbands ! i = wavelength index
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! aerosol specific absorption
+
+ opt5d(1,1,1,1,1)=ka5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,1,1,2)=ka5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,1,2,1)=ka5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,1,2,2)=ka5to10(i,t_irh1,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,1,2,1,1)=ka5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,1,2,1,2)=ka5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,1,2,2,1)=ka5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,1,2,2,2)=ka5to10(i,t_irh1,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,1,1,1)=ka5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,1,1,2)=ka5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,1,2,1)=ka5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,1,2,2)=ka5to10(i,t_irh1,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(1,2,2,1,1)=ka5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(1,2,2,1,2)=ka5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(1,2,2,2,1)=ka5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(1,2,2,2,2)=ka5to10(i,t_irh1,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,1,1,1)=ka5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,1,1,2)=ka5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,1,2,1)=ka5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,1,2,2)=ka5to10(i,t_irh2,t_ict1,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,1,2,1,1)=ka5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,1,2,1,2)=ka5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,1,2,2,1)=ka5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,1,2,2,2)=ka5to10(i,t_irh2,t_ict1,t_ifc2,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,1,1,1)=ka5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,1,1,2)=ka5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,1,2,1)=ka5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,1,2,2)=ka5to10(i,t_irh2,t_ict2,t_ifc1,t_ifb2,t_ifa2,kcomp)
+ opt5d(2,2,2,1,1)=ka5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa1,kcomp)
+ opt5d(2,2,2,1,2)=ka5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb1,t_ifa2,kcomp)
+ opt5d(2,2,2,2,1)=ka5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa1,kcomp)
+ opt5d(2,2,2,2,2)=ka5to10(i,t_irh2,t_ict2,t_ifc2,t_ifb2,t_ifa2,kcomp)
+
+! interpolation in the faq, fbc, fac and cat dimensions
+ call lininterpol5dim (d2mx, dxm1, invd, opt5d, kabs1, kabs2)
+
+ kabs1=max(kabs1,1.e-30_r8)
+ kabs2=max(kabs2,1.e-30_r8)
+
+! write(*,*) 'Before kabs'
+ if(t_xrh <= 0.37_r8) then
+ kabs(icol,k,kcomp,i)=((t_rh2-t_xrh)*kabs1+(t_xrh-t_rh1)*kabs2) &
+ /(t_rh2-t_rh1)
+ else
+ a=(log(kabs2)-log(kabs1))/(t_rh2-t_rh1)
+ b=(t_rh2*log(kabs1)-t_rh1*log(kabs2))/(t_rh2-t_rh1)
+ kabs(icol,k,kcomp,i)=e**(a*t_xrh+b)
+ endif
+
+ end do ! i
+
+ endif ! lw_on
+
+ end do ! icol
+ end do ! k
+
+
+ end do ! kcomp
+
+ return
+end subroutine interpol5to10
+
+
+!********************************************************************************************
+
+
+end module optinterpol
diff --git a/src/physics/cam_oslo/opttab.F90 b/src/physics/cam_oslo/opttab.F90
new file mode 100644
index 0000000000..094695d8c1
--- /dev/null
+++ b/src/physics/cam_oslo/opttab.F90
@@ -0,0 +1,661 @@
+module opttab
+
+!Purpose: To read in SW look-up tables for calculation of aerosol optical properties,
+! and to define the grid for discrete input-values in these look-up tables.
+
+! Modified for new wavelength bands and look-up tables - Alf Kirkevaag Dec. 2013.
+! Updated for reading input files with extra header info - Alf Kirkevaag, May 2015.
+! Extended for new SOA treatment - Alf Kirkevaag, August 2015.
+! Added output (ASCII) Jabuary 2016: #ifdef COLTST4INTCONS -> extinction
+! koefficients (wrt. all added mass including condensed water vapour) are
+! written out for checking against the look-up tables (using xmgrace), e.g.
+! as function of RH (to be changed to whatever parameter the user is interested in)
+! Modified for optimized added masses and mass fractions for concentrations from
+! condensation, coagulation or cloud-processing - Alf Kirkevaag, May 2016.
+! Modified cate values for kcomp=2 (as in AeroTab) - Alf Kirkevaag October 2016.
+
+#include
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use cam_logfile, only: iulog
+ implicit none
+
+ private
+ save
+
+
+ ! Interfaces
+ public initopt
+
+
+! integer, public, parameter :: nbands=12 ! number of aerosol spectral bands in CAM4-Oslo
+ integer, public, parameter :: nbands=14 ! number of aerosol spectral bands in SW
+ integer, public, parameter :: nbmp1=11 ! number of first non-background mode
+
+ real(r8), public, dimension(10) :: rh
+ real(r8), public, dimension(6) :: fombg, fbcbg, fac, fbc, faq
+ real(r8), public, dimension(4,16) :: cate
+ real(r8), public, dimension(5:10,6) :: cat
+
+ real(r8), public :: om1(nbands,10,6,16,6)
+ real(r8), public :: g1 (nbands,10,6,16,6)
+ real(r8), public :: be1(nbands,10,6,16,6)
+ real(r8), public :: ke1(nbands,10,6,16,6)
+
+ real(r8), public :: om2to3(nbands,10,16,6,2:3)
+ real(r8), public :: g2to3 (nbands,10,16,6,2:3)
+ real(r8), public :: be2to3(nbands,10,16,6,2:3)
+ real(r8), public :: ke2to3(nbands,10,16,6,2:3)
+
+ real(r8), public :: om4(nbands,10,6,16,6,6)
+ real(r8), public :: g4 (nbands,10,6,16,6,6)
+ real(r8), public :: be4(nbands,10,6,16,6,6)
+ real(r8), public :: ke4(nbands,10,6,16,6,6)
+
+ real(r8), public :: om0(nbands)
+ real(r8), public :: g0(nbands)
+ real(r8), public :: be0(nbands)
+ real(r8), public :: ke0(nbands)
+
+ real(r8), public :: om5to10(nbands,10,6,6,6,6,5:10)
+ real(r8), public :: g5to10(nbands,10,6,6,6,6,5:10)
+ real(r8), public :: be5to10(nbands,10,6,6,6,6,5:10)
+ real(r8), public :: ke5to10(nbands,10,6,6,6,6,5:10)
+
+! relative humidity (RH, as integer for output variable names) for use in AeroCom code
+ integer, public, dimension(6) :: RF = (/0, 40, 55, 65, 75, 85 /)
+
+! AeroCom specific RH input variables for use in opticsAtConstRh.F90
+ integer, public :: irhrf1(6)
+ real(r8), public :: xrhrf(6)
+
+ real(r8), public :: e, eps
+ parameter (e=2.718281828_r8, eps=1.0e-30_r8)
+
+
+ contains
+
+subroutine initopt
+
+!---------------------------------------------------------------
+! Modified by Egil Storen/NoSerC July 2002.
+! The sequence of the indices in arrays om1, g1, be1 and ke1
+! (common block /tab1/) has been rearranged to avoid cache
+! problems while running subroutine interpol1. Files also
+! involved by this modification: interpol1.F and opttab.h.
+! Modified for new aerosol schemes by Alf Kirkevaag in January
+! 2006. Modified for new wavelength bands and look-up tables
+! by Alf Kirkevaag in December 2013, and for SOA in August 2015.
+!---------------------------------------------------------------
+
+ use oslo_control, only : oslo_getopts, dir_string_length
+
+ implicit none
+
+ integer kcomp, iwl, irelh, ictot, ifac, ifbc, ifaq, i, irf
+ integer ifombg, ifbcbg
+ integer ik, ic, ifil, lin, linmax
+ real(r8) catot, relh, frac, fabc, fraq, frombg, frbcbg
+ real(r8) ssa, ass, ext, spext
+ real(r8) :: eps2 = 1.e-2_r8
+ real(r8) :: eps3 = 1.e-3_r8
+ real(r8) :: eps4 = 1.e-4_r8
+ real(r8) :: eps6 = 1.e-6_r8
+ character(len=dir_string_length) :: aerotab_table_dir
+
+! Defining array bounds for tabulated optical parameters (and r and sigma)
+! relative humidity (only 0 value used for r and sigma tables):
+ rh = (/ 0.0_r8, 0.37_r8, 0.47_r8, 0.65_r8, 0.75_r8, 0.8_r8, 0.85_r8, 0.9_r8, 0.95_r8, 0.995_r8 /)
+
+! AeroCom specific RH input variables for use in opticsAtConstRh.F90
+ do irf=1,6
+ xrhrf(irf) = real(RF(irf))*0.01_r8
+ enddo
+ do irelh=1,9
+ do irf=1,6
+ if(xrhrf(irf)>=rh(irelh).and.xrhrf(irf)<=rh(irelh+1)) then
+ irhrf1(irf)=irelh
+ endif
+ end do
+ end do
+
+! mass fractions internal mixtures in background (fombg and fbcbg) and mass added to the
+! background modes (fac, faq, faq)
+ fombg = (/ 0.0_r8, 0.2_r8, 0.4_r8, 0.6_r8, 0.8_r8, 1.0_r8 /)
+ fac = (/ 0.0_r8, 0.2_r8, 0.4_r8, 0.6_r8, 0.8_r8, 1.0_r8 /)
+ faq = (/ 0.0_r8, 0.2_r8, 0.4_r8, 0.6_r8, 0.8_r8, 1.0_r8 /)
+
+! with more weight on low fractions (thus a logaritmic f axis) for BC,
+! which is less ambundant than sulfate and OC, and the first value
+! corresponding to a clean background mode:
+ fbcbg(1)=1.e-10_r8
+ fbc(1)=1.e-10_r8
+ do i=2,6
+ fbcbg(i)=10**((i-1)/4.0_r8-1.25_r8)
+ fbc(i)=fbcbg(i)
+ end do
+! and most weight on small concentrations for added mass onto the background:
+ do kcomp=1,4
+ cate(kcomp,1)=1.e-10_r8
+ do i=2,16
+ if(kcomp.eq.1.or.kcomp.eq.2) then
+ cate(kcomp,i)=10.0_r8**((i-1)/3.0_r8-6.222_r8)
+ elseif(kcomp.eq.3) then
+ cate(kcomp,i)=1.0e-10_r8 ! not used
+ else
+ cate(kcomp,i)=10.0_r8**((i-1)/3.0_r8-4.301_r8)
+ endif
+ end do
+ end do
+ do kcomp=5,10
+ cat(kcomp,1) =1.e-10_r8
+ do i=2,6
+ if(kcomp.eq.5) then
+ cat(kcomp,i)=10.0_r8**((i-1)-3.824_r8)
+ elseif(kcomp.eq.6) then
+ cat(kcomp,i)=10.0_r8**((i-1)-3.523_r8)
+ elseif(kcomp.eq.7) then
+ cat(kcomp,i)=10.0_r8**((i-1)-3.699_r8)
+ elseif(kcomp.eq.8) then
+ cat(kcomp,i)=10.0_r8**((i-1)-4.921_r8)
+ elseif(kcomp.eq.9) then
+ cat(kcomp,i)=10.0_r8**((i-1)-3.301_r8)
+ else
+ cat(kcomp,i)=10.0_r8**((i-1)-3.699_r8)
+ endif
+ end do
+ end do
+
+ call oslo_getopts(aerotab_table_dir_out= aerotab_table_dir)
+
+! Opening the 'kcomp'-files:
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ open(40,file=trim(aerotab_table_dir)//'/kcomp1.out' &
+ ,form='formatted',status='old')
+ open(41,file=trim(aerotab_table_dir)//'/kcomp2.out' &
+ ,form='formatted',status='old')
+ open(42,file=trim(aerotab_table_dir)//'/kcomp3.out' &
+ ,form='formatted',status='old')
+ open(43,file=trim(aerotab_table_dir)//'/kcomp4.out' &
+ ,form='formatted',status='old')
+ open(44,file=trim(aerotab_table_dir)//'/kcomp5.out' &
+ ,form='formatted',status='old')
+ open(45,file=trim(aerotab_table_dir)//'/kcomp6.out' &
+ ,form='formatted',status='old')
+ open(46,file=trim(aerotab_table_dir)//'/kcomp7.out' &
+ ,form='formatted',status='old')
+ open(47,file=trim(aerotab_table_dir)//'/kcomp8.out' &
+ ,form='formatted',status='old')
+ open(48,file=trim(aerotab_table_dir)//'/kcomp9.out' &
+ ,form='formatted',status='old')
+ open(49,file=trim(aerotab_table_dir)//'/kcomp10.out'&
+ ,form='formatted',status='old')
+ open(50,file=trim(aerotab_table_dir)//'/kcomp0.out'&
+ ,form='formatted',status='old')
+
+! Skipping the header-text in all input files (Later: use it to check AeroTab - CAM5-Oslo consistency!)
+ do ifil = 40,50
+ call checkTableHeader (ifil)
+ enddo
+
+! Then reading in the look-up table entries for each file (kcomp*.out)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! Mode 0, BC(ax)
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ ifil = 11
+ linmax=nbands
+ do lin = 1,linmax
+
+ read(39+ifil,996) kcomp, iwl, relh, &
+ ssa, ass, ext, spext
+ om0(iwl)=ssa
+ g0 (iwl)=ass
+ be0(iwl)=ext ! unit km^-1
+ ke0(iwl)=spext ! unit m^2/g
+
+! write(iulog,*) 'kcomp, om =', kcomp, om0(iwl)
+! write(iulog,*) 'kcomp, g =', kcomp, g0(iwl)
+! write(iulog,*) 'kcomp, be =', kcomp, be0(iwl)
+! write(iulog,*) 'kcomp, ke =', kcomp, ke0(iwl)
+
+ end do
+
+ do iwl=1,nbands
+ if(be0(iwl)<=0.0_r8) then
+ write(iulog,*) 'be0 =', iwl, be0(iwl)
+ write(iulog,*) 'Error in initialization of be0'
+ stop
+ endif
+ enddo
+
+ write(iulog,*)'mode 0 ok'
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! Mode 1 (H2SO4 and SOA + condesate from H2SO4 and SOA)
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+#ifdef COLTST4INTCONS
+! open(101, file='check-kcomp1.out')
+#endif
+
+ linmax = nbands*10*6*16*6 ! 14*10*6*16*6
+ do ifil = 1,1
+ do lin = 1,linmax
+
+ read(39+ifil,995) kcomp, iwl, relh, frombg, catot, frac, &
+ ssa, ass, ext, spext
+
+ do ic=1,10
+ if(abs(relh-rh(ic)) shr_kind_r8
+ use cam_logfile, only: iulog
+ use opttab
+ implicit none
+
+ private
+ save
+
+
+ ! Interfaces
+ public initopt_lw
+
+
+! Array bounds in the tabulated optical parameters
+ integer, public, parameter :: nlwbands=16 ! number of aerosol spectral bands in LW
+
+ real(r8), public :: ka0(nlwbands)
+ real(r8), public :: ka1(nlwbands,10,6,16,6)
+ real(r8), public :: ka2to3(nlwbands,10,16,6,2:3)
+ real(r8), public :: ka4(nlwbands,10,6,16,6,6)
+ real(r8), public :: ka5to10(nlwbands,10,6,6,6,6,5:10)
+
+
+ contains
+
+subroutine initopt_lw
+
+!---------------------------------------------------------------
+! Modified by Egil Storen/NoSerC July 2002.
+! The sequence of the indices in arrays om1, g1, be1 and ke1
+! (common block /tab1/) has been rearranged to avoid cache
+! problems while running subroutine interpol1. Files also
+! involved by this modification: interpol1.F and opttab.h.
+! Modified for new aerosol schemes by Alf Kirkevaag in January
+! 2006. Based on opttab.F90 and modified for new wavelength
+! bands and look-up tables by Alf Kirkevaag in January 2014,
+! and for SOA in August 2015.
+!---------------------------------------------------------------
+
+ use oslo_control, only: oslo_getopts, dir_string_length
+
+
+! implicit none
+
+ integer kcomp, iwl, irelh, ictot, ifac, ifbc, ifaq
+ integer ifombg, ifbcbg
+ integer ic, ifil, lin, linmax
+ real(r8) catot, relh, frac, fabc, fraq, frombg, frbcbg
+ real(r8) spabs
+ real(r8) rh2(10)
+ real(r8) :: eps2 = 1.e-2_r8
+ real(r8) :: eps3 = 1.e-3_r8
+ real(r8) :: eps4 = 1.e-4_r8
+ real(r8) :: eps6 = 1.e-6_r8
+ real(r8) :: eps7 = 1.e-7_r8
+ character(len=dir_string_length) :: aerotab_table_dir
+
+ call oslo_getopts(aerotab_table_dir_out = aerotab_table_dir)
+
+! Opening the 'lwkcomp'-files:
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ open(40,file=trim(aerotab_table_dir)//'/lwkcomp1.out' &
+ ,form="formatted",status="old")
+ open(41,file=trim(aerotab_table_dir)//'/lwkcomp2.out' &
+ ,form="formatted",status="old")
+ open(42,file=trim(aerotab_table_dir)//'/lwkcomp3.out' &
+ ,form="formatted",status="old")
+ open(43,file=trim(aerotab_table_dir)//'/lwkcomp4.out' &
+ ,form="formatted",status="old")
+ open(44,file=trim(aerotab_table_dir)//'/lwkcomp5.out' &
+ ,form="formatted",status="old")
+ open(45,file=trim(aerotab_table_dir)//'/lwkcomp6.out' &
+ ,form="formatted",status="old")
+ open(46,file=trim(aerotab_table_dir)//'/lwkcomp7.out' &
+ ,form="formatted",status="old")
+ open(47,file=trim(aerotab_table_dir)//'/lwkcomp8.out' &
+ ,form="formatted",status="old")
+ open(48,file=trim(aerotab_table_dir)//'/lwkcomp9.out' &
+ ,form="formatted",status="old")
+ open(49,file=trim(aerotab_table_dir)//'/lwkcomp10.out'&
+ ,form="formatted",status="old")
+ open(50,file=trim(aerotab_table_dir)//'/lwkcomp0.out'&
+ ,form="formatted",status="old")
+
+! Skipping the header-text in all input files (Later: use it to check AeroTab - CAM5-Oslo consistency!)
+ do ifil = 40,50
+ call checkTableHeader (ifil)
+ enddo
+
+! Then reading in the look-up table entries for each file (lwkcomp*.out)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! Mode 0, BC(ax)
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ ifil = 11
+ linmax=nlwbands
+ do lin = 1,linmax
+
+ read(39+ifil,996) kcomp, iwl, relh, spabs
+
+ ka0(iwl)=spabs ! unit m^2/g
+
+! write(*,*) 'kcomp, ka =', kcomp, ka0(iwl)
+
+ end do
+
+ do iwl=1,nlwbands
+ if(ka0(iwl)<=0.0_r8) then
+ write(iulog,*) 'ka0 =', iwl, ka0(iwl)
+ write(iulog,*) 'Error in initialization of ka0'
+ stop
+ endif
+ enddo
+
+ write(iulog,*)'lw mode 0 ok'
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! Mode 1 (H2SO4 + condesate from H2SO4 and SOA)
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ ifil = 1
+ linmax=nlwbands*10*6*16*6
+ do lin = 1,linmax
+
+ read(39+ifil,997) kcomp, iwl, relh, frombg, catot, frac, spabs
+
+ do ic=1,10
+ if(abs(relh-rh(ic)) shr_kind_r8
+use cam_cpl_indices, only:index_x2a_Faoo_fdms_ocn
+
+implicit none
+private
+save
+
+public :: &
+ oslo_ctl_readnl, &! read namelist from file
+ oslo_getopts ! generic query method
+
+! Private module data
+
+integer, parameter,public :: dir_string_length=256
+character(len=16), parameter :: unset_str = 'UNSET'
+integer, parameter :: unset_int = huge(1)
+
+! Namelist variables:
+real(r8), private :: volc_fraction_coarse = 0.0_r8 !Fraction of volcanic aerosols in coarse mode
+character(len=dir_string_length), private :: aerotab_table_dir = unset_str
+! DMS/Ocean namelist variables
+character(len=20), private :: dms_source = unset_str
+character(len=32), private :: dms_source_type = unset_str
+character(len=20), private :: opom_source = unset_str
+character(len=32), private :: opom_source_type = unset_str
+character(len=dir_string_length), private :: ocean_filename = unset_str
+character(len=dir_string_length), private :: ocean_filepath = unset_str
+integer, private :: dms_cycle_year = 0 ! =unset_int?
+integer, private :: opom_cycle_year = 0 ! =unset_int?
+
+!=======================================================================
+contains
+!=======================================================================
+
+subroutine oslo_ctl_readnl(nlfile)
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use mpishorthand
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ character(len=*), parameter :: subname = 'oslo_ctl_readnl'
+ logical :: dirExists=.FALSE.
+!new
+ logical :: fileExists=.FALSE.
+
+ namelist /oslo_ctl_nl/ volc_fraction_coarse, aerotab_table_dir, dms_source, &
+ dms_source_type, opom_source, opom_source_type, &
+ ocean_filename, ocean_filepath, dms_cycle_year, opom_cycle_year
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'oslo_ctl_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, oslo_ctl_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(subname // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+ end if
+
+#ifdef SPMD
+ ! Broadcast namelist variables
+ call mpibcast(volc_fraction_coarse, 1 , mpir8, 0, mpicom)
+ call mpibcast(aerotab_table_dir, len(aerotab_table_dir) , mpichar, 0, mpicom)
+!new dms variables
+ call mpibcast(dms_source, len(dms_source) , mpichar, 0, mpicom)
+ call mpibcast(dms_source_type, len(dms_source_type) , mpichar, 0, mpicom)
+ call mpibcast(opom_source, len(opom_source) , mpichar, 0, mpicom)
+ call mpibcast(opom_source_type, len(opom_source_type) , mpichar, 0, mpicom)
+ call mpibcast(ocean_filename, len(ocean_filename) , mpichar, 0, mpicom)
+ call mpibcast(ocean_filepath, len(ocean_filepath) , mpichar, 0, mpicom)
+ call mpibcast(dms_cycle_year, 1 , mpiint, 0, mpicom)
+ call mpibcast(opom_cycle_year, 1 , mpiint, 0, mpicom)
+
+#endif
+
+ ! Error checking:
+
+ ! Defaults for PBL and microphysics are set in build-namelist. Check here that
+ ! values have been set to guard against problems with hand edited namelists.
+ if(volc_fraction_coarse .lt. 0.0_r8 .OR. volc_fraction_coarse .gt. 1.0_r8)then
+ write(iulog,*)'cam_oslo: illegal value of volc_fraction_coarse', volc_fraction_coarse
+ call endrun('cam_oslo: illegal value of volc_fraction_coarse')
+ end if
+
+#if defined CPRGNU || defined __GFORTRAN__
+ inquire( file=trim(aerotab_table_dir), exist=dirExists )
+#elif defined CPRINTEL
+ inquire( directory=trim(aerotab_table_dir), exist=dirExists )
+#else
+ !Don't know how to check this on other compilres.. Assume exists
+ !and let crash later..
+ dirExists = .TRUE.
+#endif
+ if(.not. dirExists)then
+ call endrun("cam_oslo: can not find aerotab table directory "//trim(aerotab_table_dir))
+ else
+ write(iulog,*)"Reading aerosol tables from : " // trim(aerotab_table_dir)
+ endif
+
+ ! Error check for OCEAN file
+ ! can ocean file be found?
+ inquire( file=trim(ocean_filepath)//'/'//trim(ocean_filename), exist=fileExists )
+ if(.not. fileExists)then
+ call endrun("oslo_control: can not find ocean file "//trim(ocean_filepath)//'/'//trim(ocean_filename))
+ else
+ write(iulog,*)"Reading ocean tracers from : " // trim(ocean_filepath)//'/'//trim(ocean_filename)
+ endif
+
+ ! Error check for dms_source from namelist
+ if (dms_source=='ocean_flux')then
+ if (index_x2a_Faoo_fdms_ocn == 0) then
+ call endrun("cam_oslo: dms source set to "//trim(dms_source)//" but bgc is off")
+ else
+ write(iulog,*)"DMS emission source is : "// trim(dms_source)
+ endif
+ elseif(dms_source=='kettle' .or. dms_source=='lana' .or. dms_source=='emission_file')then
+ write(iulog,*)"DMS emission source is : "// trim(dms_source)
+ else
+ call endrun("oslo_control: no valid dms source from namelist: " //trim(dms_source))
+ endif
+
+ ! Error check for opom_source from namelist
+ if(opom_source=='no_file' .or. opom_source=='nilsson' .or. opom_source=='odowd')then
+ write(iulog,*)"Ocean POM emission source is : "// trim(opom_source)
+ else
+ call endrun("oslo_control: no valid opom source from namelist: " //trim(opom_source))
+ endif
+
+
+
+! more security checks needed?
+
+! end of test
+
+end subroutine oslo_ctl_readnl
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+subroutine oslo_getopts(volc_fraction_coarse_out, &
+ aerotab_table_dir_out, &
+ dms_source_out, &
+ dms_source_type_out, &
+ opom_source_out, &
+ opom_source_type_out, &
+ ocean_filename_out, &
+ ocean_filepath_out, &
+ opom_cycle_year_out, &
+ dms_cycle_year_out )
+!-----------------------------------------------------------------------
+! Purpose: Return runtime settings
+!-----------------------------------------------------------------------
+
+ real(r8), intent(out), optional :: volc_fraction_coarse_out
+ character(len=dir_string_length), intent(out), optional :: aerotab_table_dir_out
+
+ character(len=dir_string_length), intent(out), optional :: ocean_filename_out
+ character(len=dir_string_length), intent(out), optional :: ocean_filepath_out
+ character(len=20), intent(out), optional :: dms_source_out
+ character(len=32), intent(out), optional :: dms_source_type_out
+ integer , intent(out), optional :: dms_cycle_year_out
+ character(len=20), intent(out), optional :: opom_source_out
+ character(len=32), intent(out), optional :: opom_source_type_out
+ integer , intent(out), optional :: opom_cycle_year_out
+
+ if ( present(volc_fraction_coarse_out) ) volc_fraction_coarse_out = volc_fraction_coarse
+ if ( present(aerotab_table_dir_out) ) aerotab_table_dir_out = aerotab_table_dir
+
+ if ( present(ocean_filename_out) ) ocean_filename_out = ocean_filename
+ if ( present(ocean_filepath_out) ) ocean_filepath_out = ocean_filepath
+ if ( present(dms_source_out) ) dms_source_out = dms_source
+ if ( present(dms_source_type_out) )dms_source_type_out = dms_source_type
+ if ( present(dms_cycle_year_out) ) dms_cycle_year_out = dms_cycle_year
+ if ( present(opom_source_out) ) opom_source_out = opom_source
+ if ( present(opom_source_type_out))opom_source_type_out= opom_source_type
+ if ( present(opom_cycle_year_out) )opom_cycle_year_out = opom_cycle_year
+end subroutine oslo_getopts
+
+!===============================================================================
+end module oslo_control
diff --git a/src/physics/cam_oslo/pmxsub.F90 b/src/physics/cam_oslo/pmxsub.F90
new file mode 100644
index 0000000000..58687750cb
--- /dev/null
+++ b/src/physics/cam_oslo/pmxsub.F90
@@ -0,0 +1,2500 @@
+module pmxsub_mod
+
+#include
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine pmxsub(lchnk, ncol, pint, pmid, coszrs, state, t, cld, qm1, Nnatk, &
+ per_tau, per_tau_w, per_tau_w_g, per_tau_w_f, per_lw_abs, &
+ volc_ext_sun, volc_omega_sun, volc_g_sun, &
+ volc_ext_earth, volc_omega_earth, &
+#ifdef AEROCOM
+ aodvis, absvis, dod440, dod550, dod870, abs550, abs550alt)
+#else
+ aodvis, absvis)
+#endif
+
+! Optical parameters for a composite aerosol is calculated by interpolation
+! from the tables kcomp1.out-kcomp14.out.
+! Optimized June 2002 byrild Burud/NoSerC
+! Optimized July 2002 by Egil Storen/NoSerC (ces)
+! Revised for inclusion of OC and modified aerosol backgeound aerosol
+! by Alf Kirkevaag in 2003, and finally rewritten for CAM3 February 2005.
+! Modified for new aerosol schemes by Alf Kirkevaag in January 2006.
+! Updated by Alf Kirkevåg, May 2013: The SO4(Ait) mode now takes into
+! account condensed SOA in addition to H2SO4.
+! Updated for CAM5-Oslo with RRTMG by Alf Kirkevåg, 2014-2015, for new
+! SOA treatment August/September 2015, and for cleanig up and optimizing
+! the code around interpolations in November 2016.
+
+ use ppgrid
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use cam_history, only: outfld
+ use constituents, only: pcnst
+ use physconst, only: rair,pi
+ use opttab
+ use oslo_utils, only: calculateNumberConcentration
+ use parmix_progncdnc, only: calculateBulkProperties, partitionMass
+ use opttab_lw
+ use const
+ use aerosoldef
+ use commondefinitions
+ use optinterpol, only: interpol0,interpol1,interpol2to3,interpol4,interpol5to10
+ use physics_types, only: physics_state
+ use wv_saturation, only: qsat_water
+
+ implicit none
+
+!
+! Input arguments
+
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ real(r8), intent(in) :: coszrs(pcols) ! Cosine solar zenith angle
+ real(r8), intent(in) :: pint(pcols,pverp) ! Model interface pressures (10*Pa)
+ real(r8), intent(in) :: pmid(pcols,pver) ! Model level pressures (Pa)
+ real(r8), intent(in) :: t(pcols,pver) ! Model level temperatures (K)
+ real(r8), intent(in) :: cld(pcols,pver) ! cloud fraction
+ real(r8), intent(in) :: qm1(pcols,pver,pcnst) ! Specific humidity and tracers (kg/kg)
+ real(r8), intent(in) :: volc_ext_sun(pcols,pver,nbands) ! volcanic aerosol extinction for solar bands, CMIP6
+ real(r8), intent(in) :: volc_omega_sun(pcols,pver,nbands) ! volcanic aerosol SSA for solar bands, CMIP6
+ real(r8), intent(in) :: volc_g_sun(pcols,pver,nbands) ! volcanic aerosol g for solar bands, CMIP6
+ real(r8), intent(in) :: volc_ext_earth(pcols,pver,nlwbands) ! volcanic aerosol extinction for terrestrial bands, CMIP6
+ real(r8), intent(in) :: volc_omega_earth(pcols,pver,nlwbands) ! volcanic aerosol SSA for terrestrial bands, CMIP6
+! real(r8) batotsw13(pcols,pver), batotlw01(pcols,pver) ! for testing bare
+!
+! Input-output arguments
+
+ real(r8), intent(inout) :: Nnatk(pcols,pver,0:nmodes)! aerosol mode number concentration
+
+! Output arguments
+!
+ real(r8), intent(out) :: per_tau (pcols,0:pver,nbands) ! aerosol extinction optical depth
+ real(r8), intent(out) :: per_tau_w (pcols,0:pver,nbands) ! aerosol single scattering albedo * tau
+ real(r8), intent(out) :: per_tau_w_g(pcols,0:pver,nbands) ! aerosol assymetry parameter * w * tau
+ real(r8), intent(out) :: per_tau_w_f(pcols,0:pver,nbands) ! aerosol forward scattered fraction * w * tau
+ real(r8), intent(out) :: per_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optical depth (LW)
+! AOD and absorptive AOD for visible wavelength closest to 0.55 um (0.442-0.625)
+! Note that aodvis and absvis output should be devided by dayfoc to give physical (A)AOD values
+ real(r8), intent(out) :: aodvis(pcols) ! AOD vis
+ real(r8), intent(out) :: absvis(pcols) ! AAOD vis
+
+!
+!---------------------------Local variables-----------------------------
+!
+ integer i, k, ib, icol, mplus10
+ integer iloop
+ logical daylight(pcols) ! SW calculations also at (polar) night in interpol* if daylight=.true.
+
+ real(r8) aodvisvolc(pcols) ! AOD vis for CMIP6 volcanic aerosol
+ real(r8) absvisvolc(pcols) ! AAOD vis for CMIP6 volcanic aerosol
+!akc6+
+ real(r8) bevisvolc(pcols,pver) ! Extinction in vis wavelength band for CMIP6 volcanic aerosol
+!akc6-
+ real(r8) rhum(pcols,pver) ! (trimmed) relative humidity for the aerosol calculations
+!tst
+! real(r8) aodvis3d(pcols,pver) ! 3D AOD in VIS
+!tst
+
+ real(r8) deltah_km(pcols,pver) ! Layer thickness, unit km
+
+!akc6 real(r8) deltah, airmass(pcols,pver)
+ real(r8) deltah, airmassl(pcols,pver), airmass(pcols) !akc6
+ real(r8) Ca(pcols,pver), f_c(pcols,pver), f_bc(pcols,pver), f_aq(pcols,pver)
+ real(r8) fnbc(pcols,pver), faitbc(pcols,pver), f_so4_cond(pcols,pver), &
+ f_soa(pcols,pver),f_soana(pcols,pver), vnbc, vaitbc
+ real(r8) v_soana(pcols,pver), vnbcarr(pcols,pver), vaitbcarr(pcols,pver)
+ real(r8) dCtot(pcols,pver), Ctot(pcols,pver)
+ real(r8) Cam(pcols,pver,nbmodes), fbcm(pcols,pver,nbmodes), fcm(pcols,pver,nbmodes), &
+ faqm(pcols,pver,nbmodes), f_condm(pcols,pver,nbmodes), &
+ f_soam(pcols, pver,nbmodes), faqm4(pcols,pver)
+ real(r8) xrh(pcols,pver), xrhnull(pcols,pver)
+ integer irh1(pcols,pver), irh2(pcols,pver), irh1null(pcols,pver), irh2null(pcols,pver)
+ real(r8) focm(pcols,pver,4)
+! real(r8) akso4c(pcols), akbcc(pcols), akocc(pcols)
+ real(r8) ssa(pcols,pver,0:nmodes,nbands), asym(pcols,pver,0:nmodes,nbands), &
+ be(pcols,pver,0:nmodes,nbands), ke(pcols,pver,0:nmodes,nbands), &
+ betotvis(pcols,pver), batotvis(pcols,pver)
+ real(r8) ssatot(pcols,pver,nbands) ! spectral aerosol single scattering albedo
+ real(r8) asymtot(pcols,pver,nbands) ! spectral aerosol asymmetry factor
+ real(r8) betot(pcols,pver,nbands) ! spectral aerosol extinction coefficient
+ real(r8) batotlw(pcols,pver,nlwbands) ! spectral aerosol absportion extinction in LW
+ real(r8) kalw(pcols,pver,0:nmodes,nlwbands)
+ real(r8) balw(pcols,pver,0:nmodes,nlwbands)
+ logical lw_on ! LW calculations are performed in interpol* if true
+ real(r8) volc_balw(pcols,0:pver,nlwbands) ! volcanic aerosol absorption coefficient for terrestrial bands, CMIP6
+
+#ifdef COLTST4INTCONS
+!-3 real(r8) bekc1(pcols,pver), bekc2(pcols,pver), bekc3(pcols,pver), bekc4(pcols,pver), &
+ real(r8) bekc1(pcols,pver), bekc2(pcols,pver), bekc4(pcols,pver), &
+ bekc5(pcols,pver), bekc6(pcols,pver), bekc7(pcols,pver), bekc8(pcols,pver), &
+!-11 bekc9(pcols,pver), bekc10(pcols,pver), bekc11(pcols,pver), &
+ bekc9(pcols,pver), bekc10(pcols,pver), &
+!-13 bekc12(pcols,pver), bekc13(pcols,pver), bekc14(pcols,pver), bekc0(pcols,pver)
+ bekc12(pcols,pver), bekc14(pcols,pver), bekc0(pcols,pver)
+ real(r8) taukc1(pcols), taukc2(pcols), taukc3(pcols), taukc4(pcols), taukc5(pcols), &
+ taukc6(pcols), taukc7(pcols), taukc8(pcols), taukc9(pcols), taukc10(pcols), &
+ taukc11(pcols), taukc12(pcols), taukc13(pcols), taukc14(pcols), taukc0(pcols)
+ real(r8) kekc1(pcols,pver), kekc2(pcols,pver), kekc4(pcols,pver), &
+ kekc5(pcols,pver), kekc6(pcols,pver), kekc7(pcols,pver), kekc8(pcols,pver), &
+ kekc9(pcols,pver), kekc10(pcols,pver), &
+ kekc12(pcols,pver), kekc14(pcols,pver), kekc0(pcols,pver)
+#ifdef AEROCOM
+ real(r8) cmodedry(pcols,pver,0:nmodes), &
+ cmdry0(pcols), cmdry1(pcols), cmdry2(pcols), cmdry4(pcols), &
+ cmdry5(pcols), cmdry6(pcols), cmdry7(pcols), cmdry8(pcols), &
+ cmdry9(pcols), cmdry10(pcols), cmdry12(pcols), cmdry14(pcols)
+#endif
+#endif
+ real(r8) rh0(pcols,pver), rhoda(pcols,pver)
+ real(r8) ssavis(pcols,pver), asymmvis(pcols,pver), extvis(pcols,pver), dayfoc(pcols,pver)
+ real(r8) n_aerorig(pcols,pver), n_aer(pcols,pver)
+ type(physics_state), intent(in), target :: state
+ real(r8) :: es(pcols,pver) ! saturation vapor pressure
+ real(r8) :: qs(pcols,pver) ! saturation specific humidity
+ real(r8) :: rht(pcols,pver) ! relative humidity (fraction) (rh is already used in opptab)
+ real(r8) :: rh_temp(pcols,pver) ! relative humidity (fraction) for input to LUT
+ real(r8) xfombg(pcols,pver)
+ integer ifombg1(pcols,pver), ifombg2(pcols,pver)
+ real(r8) xct(pcols,pver,nmodes)
+ integer ict1(pcols,pver,nmodes)
+ real(r8) xfac(pcols,pver,nbmodes)
+ integer ifac1(pcols,pver,nbmodes)
+ real(r8) xfbc(pcols,pver,nbmodes)
+ integer ifbc1(pcols,pver,nbmodes)
+ real(r8) xfaq(pcols,pver,nbmodes)
+ integer ifaq1(pcols,pver,nbmodes)
+ real(r8) xfbcbg(pcols,pver)
+ integer ifbcbg1(pcols,pver)
+ real(r8) xfbcbgn(pcols,pver)
+ integer ifbcbgn1(pcols,pver)
+
+#ifdef AEROCOM
+ real(r8) Ctotdry(pcols,pver), Cwater(pcols,pver), mmr_aerh2o(pcols,pver), &
+ dod550dry(pcols), abs550dry(pcols)
+ real(r8) daerh2o(pcols), dload(pcols,0:nmodes), dload3d(pcols,pver,0:nmodes), &
+ dload_mi(pcols), dload_ss(pcols), &
+ dload_s4(pcols), dload_oc(pcols), dload_bc(pcols), &
+ dload_s4_a(pcols), dload_s4_1(pcols), dload_s4_5(pcols)
+ real(r8) dload_bc_0(pcols), dload_bc_ac(pcols), dload_oc_ac(pcols), &
+ dload_bc_2(pcols), dload_bc_4(pcols), dload_bc_12(pcols), dload_bc_14(pcols), &
+ dload_oc_4(pcols), dload_oc_14(pcols)
+ real(r8) cmin(pcols,pver), cseas(pcols,pver)
+ real(r8) nnat_1(pcols,pver), nnat_2(pcols,pver), nnat_3(pcols,pver), &
+ nnat_4(pcols,pver), nnat_5(pcols,pver), nnat_6(pcols,pver), &
+ nnat_7(pcols,pver), nnat_8(pcols,pver), nnat_9(pcols,pver), &
+ nnat_10(pcols,pver), nnat_12(pcols,pver), &
+ nnat_14(pcols,pver), nnat_0(pcols,pver)
+ real(r8) ck(pcols,pver,0:nmodes), cknorm(pcols,pver,0:nmodes), &
+ cknlt05(pcols,pver,0:nmodes), ckngt125(pcols,pver,0:nmodes)
+ real(r8) aaerosn(pcols,pver,nbmp1:nmodes), aaeroln(pcols,pver,nbmp1:nmodes), &
+ vaerosn(pcols,pver,nbmp1:nmodes), vaeroln(pcols,pver,nbmp1:nmodes), &
+ aaeros(pcols,pver,0:nbmodes), aaerol(pcols,pver,0:nbmodes), &
+ vaeros(pcols,pver,0:nbmodes), vaerol(pcols,pver,0:nbmodes)
+ real(r8) cintbg(pcols,pver,0:nbmodes), &
+ cintbg05(pcols,pver,0:nbmodes), cintbg125(pcols,pver,0:nbmodes), &
+ cintbc(pcols,pver,0:nbmodes), &
+ cintbc05(pcols,pver,0:nbmodes), cintbc125(pcols,pver,0:nbmodes), &
+ cintoc(pcols,pver,0:nbmodes), &
+ cintoc05(pcols,pver,0:nbmodes), cintoc125(pcols,pver,0:nbmodes), &
+ cintsc(pcols,pver,0:nbmodes), &
+ cintsc05(pcols,pver,0:nbmodes), cintsc125(pcols,pver,0:nbmodes), &
+ cintsa(pcols,pver,0:nbmodes), &
+ cintsa05(pcols,pver,0:nbmodes), cintsa125(pcols,pver,0:nbmodes)
+ real(r8) c_mi(pcols,pver), c_mi05(pcols,pver), c_mi125(pcols,pver), &
+ c_ss(pcols,pver), c_ss05(pcols,pver), c_ss125(pcols,pver), &
+ c_bc(pcols,pver), c_bc05(pcols,pver), c_bc125(pcols,pver), &
+ c_oc(pcols,pver), c_oc05(pcols,pver), c_oc125(pcols,pver), &
+ c_sa(pcols,pver), c_sa05(pcols,pver), c_sa125(pcols,pver), &
+ c_sc(pcols,pver), c_sc05(pcols,pver), c_sc125(pcols,pver), &
+ c_s4(pcols,pver), c_s405(pcols,pver), c_s4125(pcols,pver), &
+ c_s4_a(pcols,pver), c_s4_1(pcols,pver), c_s4_5(pcols,pver)
+ real(r8) c_bc_0(pcols,pver), c_bc_ac(pcols,pver), c_oc_ac(pcols,pver), &
+ c_bc_2(pcols,pver), c_bc_4(pcols,pver), c_bc_12(pcols,pver), c_bc_14(pcols,pver), &
+ c_oc_4(pcols,pver), c_oc_14(pcols,pver)
+ real(r8) c_tots(pcols), c_tot125s(pcols), c_pm25s(pcols) ! = PM all sizes, PM>2.5um and PM<2.5um (PM2.5)
+!akc6+
+ real(r8) c_tot(pcols,pver), c_tot125(pcols,pver), c_pm25(pcols,pver), &
+ mmr_pm25(pcols,pver), c_tot05(pcols,pver), c_pm1(pcols,pver), mmr_pm1(pcols,pver)
+!akc6-
+ real(r8) aaeros_tot(pcols,pver), aaerol_tot(pcols,pver), vaeros_tot(pcols,pver), &
+ vaerol_tot(pcols,pver), aaercols(pcols), aaercoll(pcols), vaercols(pcols), &
+ vaercoll(pcols), derlt05(pcols), dergt05(pcols), der(pcols), &
+ erlt053d(pcols,pver), ergt053d(pcols,pver), er3d(pcols,pver)
+ real(r8) bext440(pcols,pver,0:nbmodes), babs440(pcols,pver,0:nbmodes), &
+ bext500(pcols,pver,0:nbmodes), babs500(pcols,pver,0:nbmodes), &
+ bext550(pcols,pver,0:nbmodes), babs550(pcols,pver,0:nbmodes), &
+ bext670(pcols,pver,0:nbmodes), babs670(pcols,pver,0:nbmodes), &
+ bext870(pcols,pver,0:nbmodes), babs870(pcols,pver,0:nbmodes), &
+ bebg440(pcols,pver,0:nbmodes), babg440(pcols,pver,0:nbmodes), &
+ bebg500(pcols,pver,0:nbmodes), babg500(pcols,pver,0:nbmodes), &
+ bebg550(pcols,pver,0:nbmodes), babg550(pcols,pver,0:nbmodes), &
+ bebg670(pcols,pver,0:nbmodes), babg670(pcols,pver,0:nbmodes), &
+ bebg870(pcols,pver,0:nbmodes), babg870(pcols,pver,0:nbmodes), &
+ bebc440(pcols,pver,0:nbmodes), babc440(pcols,pver,0:nbmodes), &
+ bebc500(pcols,pver,0:nbmodes), babc500(pcols,pver,0:nbmodes), &
+ bebc550(pcols,pver,0:nbmodes), babc550(pcols,pver,0:nbmodes), &
+ bebc670(pcols,pver,0:nbmodes), babc670(pcols,pver,0:nbmodes), &
+ bebc870(pcols,pver,0:nbmodes), babc870(pcols,pver,0:nbmodes), &
+ beoc440(pcols,pver,0:nbmodes), baoc440(pcols,pver,0:nbmodes), &
+ beoc500(pcols,pver,0:nbmodes), baoc500(pcols,pver,0:nbmodes), &
+ beoc550(pcols,pver,0:nbmodes), baoc550(pcols,pver,0:nbmodes), &
+ beoc670(pcols,pver,0:nbmodes), baoc670(pcols,pver,0:nbmodes), &
+ beoc870(pcols,pver,0:nbmodes), baoc870(pcols,pver,0:nbmodes), &
+ besu440(pcols,pver,0:nbmodes), basu440(pcols,pver,0:nbmodes), &
+ besu500(pcols,pver,0:nbmodes), basu500(pcols,pver,0:nbmodes), &
+ besu550(pcols,pver,0:nbmodes), basu550(pcols,pver,0:nbmodes), &
+ besu670(pcols,pver,0:nbmodes), basu670(pcols,pver,0:nbmodes), &
+ besu870(pcols,pver,0:nbmodes), basu870(pcols,pver,0:nbmodes)
+ real(r8) bebglt1(pcols,pver,0:nbmodes), bebggt1(pcols,pver,0:nbmodes), &
+ bebclt1(pcols,pver,0:nbmodes), bebcgt1(pcols,pver,0:nbmodes), &
+ beoclt1(pcols,pver,0:nbmodes), beocgt1(pcols,pver,0:nbmodes), &
+ bes4lt1(pcols,pver,0:nbmodes), bes4gt1(pcols,pver,0:nbmodes), &
+ backsc550(pcols,pver,0:nbmodes), backsc550x(pcols,pver,nbmp1:nmodes), &
+ backsc550tot(pcols,pver), ec550_aer(pcols,pver), abs550_aer(pcols,pver), &
+ bs550_aer(pcols,pver)
+! Additional AeroCom Phase III output:
+ real(r8) asydry_aer(pcols,pver) ! dry asymtot in the visible band
+!
+ real(r8) ec550_so4(pcols,pver),ec550_bc(pcols,pver), ec550_pom(pcols,pver), &
+ ec550_ss(pcols,pver), ec550_du(pcols,pver)
+ real(r8) bext440n(pcols,pver,0:nbmodes), babs440n(pcols,pver,0:nbmodes), &
+ bext500n(pcols,pver,0:nbmodes), babs500n(pcols,pver,0:nbmodes), &
+ bext550n(pcols,pver,0:nbmodes), babs550n(pcols,pver,0:nbmodes), &
+ bext670n(pcols,pver,0:nbmodes), babs670n(pcols,pver,0:nbmodes), &
+ bext870n(pcols,pver,0:nbmodes), babs870n(pcols,pver,0:nbmodes), &
+ bebg440n(pcols,pver,0:nbmodes), babg440n(pcols,pver,0:nbmodes), &
+ bebg500n(pcols,pver,0:nbmodes), babg500n(pcols,pver,0:nbmodes), &
+ bebg550n(pcols,pver,0:nbmodes), babg550n(pcols,pver,0:nbmodes), &
+ bebg670n(pcols,pver,0:nbmodes), babg670n(pcols,pver,0:nbmodes), &
+ bebg870n(pcols,pver,0:nbmodes), babg870n(pcols,pver,0:nbmodes), &
+ bebc440n(pcols,pver,0:nbmodes), babc440n(pcols,pver,0:nbmodes), &
+ bebc500n(pcols,pver,0:nbmodes), babc500n(pcols,pver,0:nbmodes), &
+ bebc550n(pcols,pver,0:nbmodes), babc550n(pcols,pver,0:nbmodes), &
+ bebc670n(pcols,pver,0:nbmodes), babc670n(pcols,pver,0:nbmodes), &
+ bebc870n(pcols,pver,0:nbmodes), babc870n(pcols,pver,0:nbmodes), &
+ beoc440n(pcols,pver,0:nbmodes), baoc440n(pcols,pver,0:nbmodes), &
+ beoc500n(pcols,pver,0:nbmodes), baoc500n(pcols,pver,0:nbmodes), &
+ beoc550n(pcols,pver,0:nbmodes), baoc550n(pcols,pver,0:nbmodes), &
+ beoc670n(pcols,pver,0:nbmodes), baoc670n(pcols,pver,0:nbmodes), &
+ beoc870n(pcols,pver,0:nbmodes), baoc870n(pcols,pver,0:nbmodes), &
+ besu440n(pcols,pver,0:nbmodes), basu440n(pcols,pver,0:nbmodes), &
+ besu500n(pcols,pver,0:nbmodes), basu500n(pcols,pver,0:nbmodes), &
+ besu550n(pcols,pver,0:nbmodes), basu550n(pcols,pver,0:nbmodes), &
+ besu670n(pcols,pver,0:nbmodes), basu670n(pcols,pver,0:nbmodes), &
+ besu870n(pcols,pver,0:nbmodes), basu870n(pcols,pver,0:nbmodes)
+ real(r8) bebglt1n(pcols,pver,0:nbmodes), bebggt1n(pcols,pver,0:nbmodes), &
+ bebclt1n(pcols,pver,0:nbmodes), bebcgt1n(pcols,pver,0:nbmodes), &
+ beoclt1n(pcols,pver,0:nbmodes), beocgt1n(pcols,pver,0:nbmodes), &
+ bes4lt1n(pcols,pver,0:nbmodes), bes4gt1n(pcols,pver,0:nbmodes), &
+ backsc550n(pcols,pver,0:nbmodes)
+ real(r8) bext440tot(pcols,pver), babs440tot(pcols,pver), &
+ bext500tot(pcols,pver), babs500tot(pcols,pver), &
+ bext550tot(pcols,pver), babs550tot(pcols,pver), &
+ bext670tot(pcols,pver), babs670tot(pcols,pver), &
+ bext870tot(pcols,pver), babs870tot(pcols,pver), &
+ bebg440tot(pcols,pver), babg440tot(pcols,pver), &
+ bebg500tot(pcols,pver), babg500tot(pcols,pver), &
+ bebg550tot(pcols,pver), babg550tot(pcols,pver), &
+ bebg670tot(pcols,pver), babg670tot(pcols,pver), &
+ bebg870tot(pcols,pver), babg870tot(pcols,pver), &
+ bebc440tot(pcols,pver), babc440tot(pcols,pver), &
+ bebc500tot(pcols,pver), babc500tot(pcols,pver), &
+ bebc550tot(pcols,pver), babc550tot(pcols,pver), &
+ bebc670tot(pcols,pver), babc670tot(pcols,pver), &
+ bebc870tot(pcols,pver), babc870tot(pcols,pver), &
+ beoc440tot(pcols,pver), baoc440tot(pcols,pver), &
+ beoc500tot(pcols,pver), baoc500tot(pcols,pver), &
+ beoc550tot(pcols,pver), baoc550tot(pcols,pver), &
+ beoc670tot(pcols,pver), baoc670tot(pcols,pver), &
+ beoc870tot(pcols,pver), baoc870tot(pcols,pver), &
+ besu440tot(pcols,pver), basu440tot(pcols,pver), &
+ besu500tot(pcols,pver), basu500tot(pcols,pver), &
+ besu550tot(pcols,pver), basu550tot(pcols,pver), &
+ besu670tot(pcols,pver), basu670tot(pcols,pver), &
+ besu870tot(pcols,pver), basu870tot(pcols,pver)
+ real(r8) bebglt1t(pcols,pver), bebggt1t(pcols,pver), bebclt1t(pcols,pver), &
+ bebcgt1t(pcols,pver), beoclt1t(pcols,pver), beocgt1t(pcols,pver), &
+ bes4lt1t(pcols,pver), bes4gt1t(pcols,pver)
+ real(r8) be440x(pcols,pver,nbmp1:nmodes), ba440x(pcols,pver,nbmp1:nmodes), &
+ be500x(pcols,pver,nbmp1:nmodes), ba500x(pcols,pver,nbmp1:nmodes), &
+ be550x(pcols,pver,nbmp1:nmodes), ba550x(pcols,pver,nbmp1:nmodes), &
+ be670x(pcols,pver,nbmp1:nmodes), ba670x(pcols,pver,nbmp1:nmodes), &
+ be870x(pcols,pver,nbmp1:nmodes), ba870x(pcols,pver,nbmp1:nmodes), &
+ belt1x(pcols,pver,nbmp1:nmodes), begt1x(pcols,pver,nbmp1:nmodes)
+ real(r8) bebc440xt(pcols,pver),babc440xt(pcols,pver), &
+ bebc500xt(pcols,pver),babc500xt(pcols,pver), &
+ bebc550xt(pcols,pver),babc550xt(pcols,pver), &
+ bebc670xt(pcols,pver),babc670xt(pcols,pver), &
+ bebc870xt(pcols,pver),babc870xt(pcols,pver), &
+ beoc440xt(pcols,pver),baoc440xt(pcols,pver), &
+ beoc500xt(pcols,pver),baoc500xt(pcols,pver), &
+ beoc550xt(pcols,pver),baoc550xt(pcols,pver), &
+ beoc670xt(pcols,pver),baoc670xt(pcols,pver), &
+ beoc870xt(pcols,pver),baoc870xt(pcols,pver)
+ real(r8) bbclt1xt(pcols,pver), &
+ bbcgt1xt(pcols,pver), boclt1xt(pcols,pver), bocgt1xt(pcols,pver)
+ real(r8) bint440du(pcols,pver), bint500du(pcols,pver), bint550du(pcols,pver), &
+ bint670du(pcols,pver), bint870du(pcols,pver), &
+ bint440ss(pcols,pver), bint500ss(pcols,pver), bint550ss(pcols,pver), &
+ bint670ss(pcols,pver), bint870ss(pcols,pver), &
+ baint550du(pcols,pver), baint550ss(pcols,pver)
+ real(r8) bedustlt1(pcols,pver), bedustgt1(pcols,pver), &
+ besslt1(pcols,pver), bessgt1(pcols,pver)
+ real(r8) dod4403d(pcols,pver), abs4403d(pcols,pver), &
+ dod4403d_ss(pcols,pver), & ! abs4403d_ss(pcols,pver), &
+ dod4403d_dust(pcols,pver), & ! abs4403d_dust(pcols,pver), &
+ dod4403d_so4(pcols,pver), & ! abs4403d_so4(pcols,pver), &
+ dod4403d_bc(pcols,pver), & ! abs4403d_bc(pcols,pver), &
+ dod4403d_pom(pcols,pver), & ! abs4403d_pom(pcols,pver), &
+ dod5003d(pcols,pver), abs5003d(pcols,pver), &
+ dod5003d_ss(pcols,pver), & ! abs5003d_ss(pcols,pver), &
+ dod5003d_dust(pcols,pver), & ! abs5003d_dust(pcols,pver), &
+ dod5003d_so4(pcols,pver), & ! abs5003d_so4(pcols,pver), &
+ dod5003d_bc(pcols,pver), & ! abs5003d_bc(pcols,pver), &
+ dod5003d_pom(pcols,pver), & ! abs5003d_pom(pcols,pver), &
+ dod5503d(pcols,pver), abs5503d(pcols,pver), abs5503dalt(pcols,pver), &
+ dod5503d_ss(pcols,pver), abs5503d_ss(pcols,pver), &
+ dod5503d_dust(pcols,pver), abs5503d_dust(pcols,pver), &
+ dod5503d_so4(pcols,pver), abs5503d_so4(pcols,pver), &
+ dod5503d_bc(pcols,pver), abs5503d_bc(pcols,pver), &
+ dod5503d_pom(pcols,pver), abs5503d_pom(pcols,pver), &
+ dod6703d(pcols,pver), abs6703d(pcols,pver), &
+ dod6703d_ss(pcols,pver), & ! abs6703d_ss(pcols,pver), &
+ dod6703d_dust(pcols,pver), & ! abs6703d_dust(pcols,pver), &
+ dod6703d_so4(pcols,pver), & ! abs6703d_so4(pcols,pver), &
+ dod6703d_bc(pcols,pver), & ! abs6703d_bc(pcols,pver), &
+ dod6703d_pom(pcols,pver), & ! abs6703d_pom(pcols,pver), &
+ dod8703d(pcols,pver), abs8703d(pcols,pver), &
+ dod8703d_ss(pcols,pver), & ! abs8703d_ss(pcols,pver), &
+ dod8703d_dust(pcols,pver), & ! abs8703d_dust(pcols,pver), &
+ dod8703d_so4(pcols,pver), & ! abs8703d_so4(pcols,pver), &
+ dod8703d_bc(pcols,pver), & ! abs8703d_bc(pcols,pver), &
+ dod8703d_pom(pcols,pver) ! abs8703d_pom(pcols,pver)
+ real(r8) dod5503dlt1_ss(pcols,pver), dod5503dgt1_ss(pcols,pver), &
+ dod5503dlt1_dust(pcols,pver), dod5503dgt1_dust(pcols,pver), &
+ dod5503dlt1_so4(pcols,pver), dod5503dgt1_so4(pcols,pver), &
+ dod5503dlt1_bc(pcols,pver), dod5503dgt1_bc(pcols,pver), &
+ dod5503dlt1_pom(pcols,pver), dod5503dgt1_pom(pcols,pver)
+ real(r8) dod440(pcols), abs440(pcols), dod500(pcols), abs500(pcols), &
+ dod550(pcols), abs550(pcols), abs550alt(pcols), dod670(pcols),&
+ abs670(pcols), dod870(pcols), abs870(pcols), &
+ dod440_ss(pcols), dod440_dust(pcols), dod440_so4(pcols), &
+ dod440_bc(pcols), dod440_pom(pcols), &
+ dod500_ss(pcols), dod500_dust(pcols), dod500_so4(pcols), &
+ dod500_bc(pcols), dod500_pom(pcols), &
+ dod550_ss(pcols), dod550_dust(pcols), dod550_so4(pcols), &
+ dod550_bc(pcols), dod550_pom(pcols), &
+ dod670_ss(pcols), dod670_dust(pcols), dod670_so4(pcols), &
+ dod670_bc(pcols), dod670_pom(pcols), &
+ dod870_ss(pcols), dod870_dust(pcols), dod870_so4(pcols), &
+ dod870_bc(pcols), dod870_pom(pcols), &
+ dod550lt1_ss(pcols), dod550gt1_ss(pcols), dod550lt1_dust(pcols), &
+ dod550gt1_dust(pcols), dod550lt1_so4(pcols), &
+ dod550gt1_so4(pcols), dod550lt1_bc(pcols), dod550gt1_bc(pcols), &
+ dod550lt1_pom(pcols), dod550gt1_pom(pcols)
+ real(r8) abs550_ss(pcols), abs550_dust(pcols), &
+ abs550_so4(pcols), abs550_bc(pcols), abs550_pom(pcols)
+ real(r8) batotsw13(pcols,pver), batotlw01(pcols,pver)
+#endif ! AEROCOM
+!+
+#ifdef AEROCOM
+ character(len=10) :: modeString
+ character(len=20) :: varname
+ integer irf,irfmax
+ real(r8) Camrel(pcols,pver,nbmodes)
+ real(r8) Camtot(pcols,nbmodes)
+ real(r8) cxsmtot(pcols,nbmodes)
+ real(r8) cxsmrel(pcols,nbmodes)
+ real(r8) xctrel,camdiff,cxsm
+ real(r8) cxs(pcols,pver), cxstot(pcols,pver), akcxs(pcols)
+#endif
+!-
+
+!
+!-------------------------------------------------------------------------
+!
+
+!test: hentet fra aer_rad_props, saa modifisert/rettet (!x)
+ ! calculate relative humidity for table lookup into rh grid
+!x call qsat(state%t(1:ncol,1:pver), state%pmid(1:ncol,1:pver), &
+ call qsat_water(state%t(1:ncol,1:pver), state%pmid(1:ncol,1:pver), &
+ es(1:ncol,1:pver), qs(1:ncol,1:pver))
+ rht(1:ncol,1:pver) = state%q(1:ncol,1:pver,1) / qs(1:ncol,1:pver)
+ rh_temp(1:ncol,1:pver) = min(rht(1:ncol,1:pver),1._r8)
+
+
+ do k=1,pver
+ do icol=1,ncol
+! Set upper and lower relative humidity for the aerosol calculations
+ rhum(icol,k) = min(0.995_r8, max(rh_temp(icol,k), 0.01_r8))
+ rhoda(icol,k) = pmid(icol,k)/(rair*t(icol,k)) ! unit kg/m^3
+!test rhum(icol,k) = 0.01_r8
+ if (cld(icol,k) .lt. 1.0_r8) then
+ rhum(icol,k) = (rhum(icol,k) - cld(icol,k)) / (1.0_r8 - cld(icol,k)) ! clear portion
+ end if
+ rhum(icol,k) = min(0.995_r8, max(rhum(icol,k), 0.01_r8))
+ end do
+ end do
+
+! Layer thickness with unit km
+ do icol=1,ncol
+ do k=1,pver
+ deltah_km(icol,k)=1.e-4_r8*(pint(icol,k+1)-pint(icol,k))/(rhoda(icol,k)*9.8_r8)
+ end do
+ end do
+
+! interpol-calculations only when daylight or not:
+#ifdef AEROCOM ! always calculate optics (also at (polar) night)
+ do icol=1,ncol
+ daylight(icol) = .true.
+ end do
+#else ! calculate optics only in daytime
+ do icol=1,ncol
+ if (coszrs(icol) > 0.0_r8) then
+ daylight(icol) = .true.
+ else
+ daylight(icol) = .false.
+ endif
+ end do
+#endif ! AEROCOM
+
+! Set SO4, BC and OC concentrations:
+
+! initialize concentration fields
+ do i=0,nmodes
+ do k=1,pver
+ do icol=1,ncol
+ Nnatk(icol,k,i) = 0.0_r8
+ end do
+ end do
+ end do
+ do k=1,pver
+ do icol=1,ncol
+ n_aerorig(icol,k) = 0.0_r8
+ n_aer(icol,k) = 0.0_r8
+ end do
+ end do
+ kalw(:,:,:,:)=0._r8
+ be(:,:,:,:)=0._r8
+ ke(:,:,:,:)=0._r8
+ asym(:,:,:,:)=0._r8
+ ssa(:,:,:,:)=0._r8
+! Find process tagged bulk aerosol properies (from the life cycle module):
+
+ call calculateBulkProperties(ncol, qm1, rhoda, Nnatk, Ca, f_c, f_bc, &
+ f_aq, f_so4_cond, f_soa, faitbc, fnbc, f_soana)
+
+! calculating vulume fractions from mass fractions:
+ do k=1,pver
+ do icol=1,ncol
+ v_soana(icol,k) = f_soana(icol,k)/(f_soana(icol,k) &
+ +(1.0_r8-f_soana(icol,k))*rhopart(l_soa_na)/rhopart(l_so4_na))
+ end do
+ end do
+
+! Avoid very small numbers
+ do k=1,pver
+ do icol=1,ncol
+ Ca(icol,k) = max(eps,Ca(icol,k))
+ f_c(icol,k) = max(eps,f_c(icol,k))
+ f_bc(icol,k) = max(eps,f_bc(icol,k))
+ f_aq(icol,k) = max(eps,f_aq(icol,k))
+ fnbc(icol,k) = max(eps,fnbc(icol,k))
+ faitbc(icol,k) = max(eps,faitbc(icol,k))
+ end do
+ end do
+
+! Calculation of the apportionment of internally mixed SO4, BC and OC
+! mass between the various background modes.
+
+ !==> calls modalapp to partition the mass
+ call partitionMass(ncol, nnatk, Ca, f_c, f_bc, f_aq, f_so4_cond, f_soa , &
+ cam, fcm, fbcm, faqm, f_condm, f_soam )
+
+ !The following uses non-standard units, #/cm3 and ug/m3
+ Nnatk(:ncol,:,:) = Nnatk(:ncol,:,:)*1.e-6_r8
+ cam(:ncol,:,:)=cam(:ncol,:,:)*1.e9_r8
+
+! Calculate fraction of added mass which is either SOA condensate or OC coagulate,
+! which in AeroTab are both treated as condensate for kcomp=1-4.
+ do i=1,4
+ do k=1,pver
+ do icol=1,ncol
+ focm(icol,k,i) = fcm(icol,k,i)*(1.0_r8-fbcm(icol,k,i))
+ enddo
+ enddo
+ enddo
+ do k=1,pver
+ do icol=1,ncol
+ faqm4(icol,k) = faqm(icol,k,4)
+ end do
+ enddo
+
+! find common input parameters for use in the interpolation routines
+
+ call inputForInterpol (lchnk, ncol, rhum, xrh, irh1, &
+ f_soana, xfombg, ifombg1, faitbc, xfbcbg, ifbcbg1, &
+ fnbc, xfbcbgn, ifbcbgn1, Nnatk, Cam, xct, ict1, &
+ focm, fcm, xfac, ifac1, fbcm, xfbc, ifbc1, faqm, xfaq, ifaq1)
+
+! and define the respective RH input variables for dry aerosols
+ do k=1,pver
+ do icol=1,ncol
+ xrhnull(icol,k)=rh(1)
+ irh1null(icol,k)=1
+ end do
+ enddo
+
+
+#ifdef AEROCOM
+
+! Initialize overshooting mass summed over all modes
+ do k=1,pver
+ do icol=1,ncol
+ cxstot(icol,k)=0.0_r8
+ enddo
+ enddo
+ do icol=1,ncol
+ akcxs(icol)=0.0_r8
+ enddo
+
+! Initializing total and relative exessive (overshooting w.r.t.
+! look-up table maxima) added mass column:
+ do i=1,nbmodes
+ do icol=1,ncol
+ Camtot(icol,i)=0.0_r8
+ cxsmtot(icol,i)=0.0_r8
+ cxsmrel(icol,i)=0.0_r8
+ enddo
+ enddo
+! Calculating added internally mixed mass onto each mode 1-10, relative to
+! maximum mass which can be added w.r.t. the look-up tables (for level k),
+! as well as the relative exessive added mass column:
+ do i=1,4
+ do k=1,pver
+ do icol=1,ncol
+ Camrel(icol,k,i) = (Cam(icol,k,i)/(Nnatk(icol,k,i)+eps))/cate(i,16)
+ xctrel=min(max(Camrel(icol,k,i),cate(i,1)/cate(i,16)),1.0_r8)
+ camdiff=Cam(icol,k,i)-xctrel*cate(i,16)*(Nnatk(icol,k,i)+eps)
+ cxsm=max(0.0_r8,camdiff)
+ cxsmtot(icol,i)=cxsmtot(icol,i)+cxsm*deltah_km(icol,k)
+ Camtot(icol,i)=Camtot(icol,i)+Cam(icol,k,i)*deltah_km(icol,k)
+!t
+ camdiff=Cam(icol,k,i)-xct(icol,k,i)*(Nnatk(icol,k,i)+eps)
+ cxs(icol,k)=max(0.0_r8,camdiff)
+ cxstot(icol,k)= cxstot(icol,k)+cxs(icol,k)
+!t
+ enddo
+ enddo
+ enddo
+ do i=5,nbmodes
+ do k=1,pver
+ do icol=1,ncol
+ Camrel(icol,k,i) = (Cam(icol,k,i)/(Nnatk(icol,k,i)+eps))/cat(i,6)
+ xctrel=min(max(Camrel(icol,k,i),cat(i,1)/cat(i,6)),1.0_r8)
+ camdiff=Cam(icol,k,i)-xctrel*cat(i,6)*(Nnatk(icol,k,i)+eps)
+ cxsm=max(0.0_r8,camdiff)
+ cxsmtot(icol,i)=cxsmtot(icol,i)+cxsm*deltah_km(icol,k)
+ Camtot(icol,i)=Camtot(icol,i)+Cam(icol,k,i)*deltah_km(icol,k)
+!t
+ camdiff=Cam(icol,k,i)-xct(icol,k,i)*(Nnatk(icol,k,i)+eps)
+ cxs(icol,k)=max(0.0_r8,camdiff)
+ cxstot(icol,k)= cxstot(icol,k)+cxs(icol,k)
+!t
+ enddo
+ enddo
+ enddo
+
+! Total overshooting mass summed over all modes and all levels
+ do icol=1,ncol
+ do k=1,pver
+ akcxs(icol) =akcxs(icol)+cxstot(icol,k)*deltah_km(icol,k)
+ enddo
+ enddo
+ call outfld('AKCXS ',akcxs ,pcols,lchnk)
+
+ do i=1,nbmodes
+ do icol=1,ncol
+ cxsmrel(icol,i)=cxsmtot(icol,i)/(Camtot(icol,i)+eps)
+ enddo
+ enddo
+
+ do i=1,nbmodes
+ modeString=" "
+ write(modeString,"(I2)"),i
+ if(i.lt.10) modeString="0"//adjustl(modeString)
+ varName = "Camrel"//trim(modeString)
+ if(i.ne.3) call outfld(varName,Camrel(:,:,i),pcols,lchnk)
+ enddo
+
+ do i=1,nbmodes
+ modeString=" "
+ write(modeString,"(I2)"),i
+ if(i.lt.10) modeString="0"//adjustl(modeString)
+ varName = "Cxsrel"//trim(modeString)
+ if(i.ne.3) call outfld(varName,cxsmrel(:,i),pcols,lchnk)
+ enddo
+
+#endif
+
+
+! AeroCom: Find dry aerosol asymmetry factor and mass for subsequent
+! calculation of condensed water mass below...
+
+#ifdef AEROCOM
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ do k=1,pver
+ do icol=1,ncol
+ Ctotdry(icol,k)=0.0_r8
+ rh0(icol,k)=0.0_r8
+ asydry_aer(icol,k)=0.0_r8
+ end do
+ enddo
+
+ lw_on = .false. ! No LW optics needed for RH=0 (interpol returns 0-values)
+
+ do iloop=1,1 ! loop over i>1 for testing CPU use in interpol*
+! BC(ax) mode (dry only):
+ call interpol0 (lchnk, ncol, daylight, Nnatk, ssa, asym, be, ke, lw_on, kalw)
+
+ mplus10=0
+! SO4/SOA(Ait) mode:
+ call interpol1 (lchnk, ncol, daylight, xrhnull, irh1null, mplus10, &
+ Nnatk, xfombg, ifombg1, xct, ict1, xfac, ifac1, &
+ ssa, asym, be, ke, lw_on, kalw)
+
+! BC(Ait) and OC(Ait) modes:
+ call interpol2to3 (lchnk, ncol, daylight, xrhnull, irh1null, mplus10, &
+ Nnatk, xct, ict1, xfac, ifac1, &
+ ssa, asym, be, ke, lw_on, kalw)
+
+! BC&OC(Ait) mode: ------ fcm not valid here (=0). Use faitbc instead
+ call interpol4 (lchnk, ncol, daylight, xrhnull, irh1null, mplus10, &
+ Nnatk, xfbcbg, ifbcbg1, xct, ict1, xfac, ifac1, &
+ xfaq, ifaq1, ssa, asym, be, ke, lw_on, kalw)
+
+! SO4(Ait75) (5), Mineral (6-7) and Sea-salt (8-10) modes:
+ call interpol5to10 (lchnk, ncol, daylight, xrhnull, irh1null, &
+ Nnatk, xct, ict1, xfac, ifac1, &
+ xfbc, ifbc1, xfaq, ifaq1, &
+ ssa, asym, be, ke, lw_on, kalw)
+ enddo ! iloop
+
+
+ do iloop=1,1
+ mplus10=1
+! BC(Ait) and OC(Ait) modes:
+ call interpol2to3 (lchnk, ncol, daylight, xrhnull, irh1null, mplus10, &
+ Nnatk, xct, ict1, xfac, ifac1, &
+ ssa, asym, be, ke, lw_on, kalw)
+
+! BC&OC(n) mode: ------ fcm not valid here (=0). Use fnbc instead
+ call interpol4 (lchnk, ncol, daylight, xrhnull, irh1null, mplus10, &
+ Nnatk, xfbcbgn, ifbcbgn1, xct, ict1, &
+ xfac, ifac1, xfaq, ifaq1, &
+ ssa, asym, be, ke, lw_on, kalw)
+
+enddo ! iloop
+
+ do i=0,nmodes ! mode 0 to 14
+ do k=1,pver
+ do icol=1,ncol
+ dCtot(icol,k)=1.e3_r8*be(icol,k,i,4)/(ke(icol,k,i,4)+eps)
+ Ctotdry(icol,k)=Ctotdry(icol,k)+dCtot(icol,k)*Nnatk(icol,k,i)
+#ifdef COLTST4INTCONS
+ cmodedry(icol,k,i)=dCtot(icol,k)*Nnatk(icol,k,i)
+#endif
+ end do
+ enddo
+ enddo
+
+!!! AeroCom Phase III: adding asymmetry factor for dry aerosol, wavelength band 4 only
+!!! (and with no CMIP6 volcnic contribution)
+ ib=4
+ do k=1,pver
+ do icol=1,ncol
+ betot(icol,k,ib)=0.0_r8
+ ssatot(icol,k,ib)=0.0_r8
+ asymtot(icol,k,ib)=0.0_r8
+ end do
+ enddo
+ do i=0,nmodes
+ do k=1,pver
+ do icol=1,ncol
+ betot(icol,k,ib)=betot(icol,k,ib)+Nnatk(icol,k,i)*be(icol,k,i,ib)
+ ssatot(icol,k,ib)=ssatot(icol,k,ib)+Nnatk(icol,k,i) &
+ *be(icol,k,i,ib)*ssa(icol,k,i,ib)
+ asymtot(icol,k,ib)=asymtot(icol,k,ib)+Nnatk(icol,k,i) &
+ *be(icol,k,i,ib)*ssa(icol,k,i,ib)*asym(icol,k,i,ib)
+! if(ib.eq.4) then
+! write(*,*) 'i, asym =', i, asym(icol,k,i,ib)
+! write(*,*) 'i, be =', i, be(icol,k,i,ib)
+! write(*,*) 'i, ssa =', i, ssa(icol,k,i,ib)
+! endif
+
+ end do
+ enddo
+ enddo
+ do k=1,pver
+ do icol=1,ncol
+ ssatot(icol,k,ib)=ssatot(icol,k,ib)/(betot(icol,k,ib)+eps)
+ asymtot(icol,k,ib)=asymtot(icol,k,ib) &
+ /(betot(icol,k,ib)*ssatot(icol,k,ib)+eps)
+ asydry_aer(icol,k)=asymtot(icol,k,ib)
+ end do
+ enddo
+!
+ call outfld('ASYMMDRY',asydry_aer,pcols,lchnk)
+!
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+#endif ! AEROCOM
+
+! (Wet) Optical properties for each of the aerosol modes:
+
+ lw_on = .true. ! No LW optics needed for RH=0 (interpol returns 0-values)
+
+ do iloop=1,1
+! BC(ax) mode (dry only):
+ call interpol0 (lchnk, ncol, daylight, Nnatk, ssa, asym, be, ke, lw_on, kalw)
+
+ mplus10=0
+! SO4/SOA(Ait) mode:
+ call interpol1 (lchnk, ncol, daylight, xrh, irh1, mplus10, &
+ Nnatk, xfombg, ifombg1, xct, ict1, &
+ xfac, ifac1, ssa, asym, be, ke, lw_on, kalw)
+
+! BC(Ait) and OC(Ait) modes:
+ call interpol2to3 (lchnk, ncol, daylight, xrh, irh1, mplus10, &
+ Nnatk, xct, ict1, xfac, ifac1, &
+ ssa, asym, be, ke, lw_on, kalw)
+
+! BC&OC(Ait) mode: ------ fcm invalid here (=0). Using faitbc instead
+ call interpol4 (lchnk, ncol, daylight, xrh, irh1, mplus10, &
+ Nnatk, xfbcbg, ifbcbg1, xct, ict1, &
+ xfac, ifac1, xfaq, ifaq1, ssa, asym, be, ke, lw_on, kalw)
+
+! SO4(Ait75) (5), Mineral (6-7) and Sea-salt (8-10) modes:
+ call interpol5to10 (lchnk, ncol, daylight, xrh, irh1, &
+ Nnatk, xct, ict1, xfac, ifac1, &
+ xfbc, ifbc1, xfaq, ifaq1, ssa, asym, be, ke, lw_on, kalw)
+ enddo ! iloop
+
+
+! total aerosol number concentrations
+ do i=0,nmodes ! mode 0 to 14
+ do k=1,pver
+ do icol=1,ncol
+ n_aer(icol,k)=n_aer(icol,k)+Nnatk(icol,k,i)
+ end do
+ enddo
+ enddo
+ call outfld('N_AER ',n_aer ,pcols,lchnk)
+
+ do iloop=1,1
+ mplus10=1
+! SO4/SOA(Ait) mode:
+ !does no longer exist as an externally mixed mode
+
+! BC(Ait) and OC(Ait) modes:
+ call interpol2to3 (lchnk, ncol, daylight, xrh, irh1, mplus10, &
+ Nnatk, xct, ict1, xfac, ifac1, &
+ ssa, asym, be, ke, lw_on, kalw)
+
+! BC&OC(n) mode: ------ fcm not valid here (=0). Use fnbc instead
+ call interpol4 (lchnk, ncol, daylight, xrh, irh1, mplus10, &
+ Nnatk, xfbcbgn, ifbcbgn1, xct, ict1, &
+ xfac, ifac1, xfaq, ifaq1, ssa, asym, be, ke, lw_on, kalw)
+ enddo ! iloop
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+ do k=1,pver
+ do icol=1,ncol
+ Ctot(icol,k)=0.0_r8
+ end do
+ enddo
+
+ do i=0,nmodes ! mode 0 to 14
+ do k=1,pver
+ do icol=1,ncol
+ dCtot(icol,k)=1.e3_r8*be(icol,k,i,4)/(ke(icol,k,i,4)+eps)
+ Ctot(icol,k)=Ctot(icol,k)+dCtot(icol,k)*Nnatk(icol,k,i)
+ end do
+ enddo
+ enddo
+
+#ifdef AEROCOM
+#ifdef COLTST4INTCONS
+! initializing modal mass column burdens
+ do icol=1,ncol
+ cmdry0(icol)=0.0_r8
+ cmdry1(icol)=0.0_r8
+ cmdry2(icol)=0.0_r8
+ cmdry4(icol)=0.0_r8
+ cmdry5(icol)=0.0_r8
+ cmdry6(icol)=0.0_r8
+ cmdry7(icol)=0.0_r8
+ cmdry8(icol)=0.0_r8
+ cmdry9(icol)=0.0_r8
+ cmdry10(icol)=0.0_r8
+ cmdry12(icol)=0.0_r8
+ cmdry14(icol)=0.0_r8
+ enddo
+#endif
+! Mass concentration (ug/m3) and mmr (kg/kg) of aerosol condensed water
+ do k=1,pver
+ do icol=1,ncol
+ Cwater(icol,k)=Ctot(icol,k)-Ctotdry(icol,k)
+ mmr_aerh2o(icol,k)=1.e-9_r8*Cwater(icol,k)/rhoda(icol,k)
+#ifdef COLTST4INTCONS
+! and dry mass column burdens for each mode/mixture
+ deltah=deltah_km(icol,k)
+ cmdry0(icol)=cmdry0(icol)+cmodedry(icol,k,0)*deltah
+ cmdry1(icol)=cmdry1(icol)+cmodedry(icol,k,1)*deltah
+ cmdry2(icol)=cmdry2(icol)+cmodedry(icol,k,2)*deltah
+ cmdry4(icol)=cmdry4(icol)+cmodedry(icol,k,4)*deltah
+ cmdry5(icol)=cmdry5(icol)+cmodedry(icol,k,5)*deltah
+ cmdry6(icol)=cmdry6(icol)+cmodedry(icol,k,6)*deltah
+ cmdry7(icol)=cmdry7(icol)+cmodedry(icol,k,7)*deltah
+ cmdry8(icol)=cmdry8(icol)+cmodedry(icol,k,8)*deltah
+ cmdry9(icol)=cmdry9(icol)+cmodedry(icol,k,9)*deltah
+ cmdry10(icol)=cmdry10(icol)+cmodedry(icol,k,10)*deltah
+ cmdry12(icol)=cmdry12(icol)+cmodedry(icol,k,12)*deltah
+ cmdry14(icol)=cmdry14(icol)+cmodedry(icol,k,14)*deltah
+#endif
+ end do
+ enddo
+#endif
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! SW Optical properties of total aerosol:
+ do ib=1,nbands
+ do k=1,pver
+ do icol=1,ncol
+ betot(icol,k,ib)=0.0_r8
+ ssatot(icol,k,ib)=0.0_r8
+ asymtot(icol,k,ib)=0.0_r8
+ end do
+ enddo
+ enddo
+ do ib=1,nbands
+ do i=0,nmodes
+ do k=1,pver
+ do icol=1,ncol
+ betot(icol,k,ib)=betot(icol,k,ib)+Nnatk(icol,k,i)*be(icol,k,i,ib)
+ ssatot(icol,k,ib)=ssatot(icol,k,ib)+Nnatk(icol,k,i) &
+ *be(icol,k,i,ib)*ssa(icol,k,i,ib)
+ asymtot(icol,k,ib)=asymtot(icol,k,ib)+Nnatk(icol,k,i) &
+ *be(icol,k,i,ib)*ssa(icol,k,i,ib)*asym(icol,k,i,ib)
+ end do
+ enddo
+ enddo
+ enddo
+! Adding also the volcanic contribution (CMIP6), which is using a CMIP6
+! band numbering identical to the AeroTab numbering (unlike CAM) both
+! for SW and LW. I.e., no remapping is required here.
+! Info from CMIP_CAM6_radiation_v3.nc
+! wl1_sun = 0.2, 0.263158, 0.344828, 0.441501, 0.625, 0.77821, 1.24224,
+! 1.2987, 1.62602, 1.94175, 2.15054, 2.5, 3.07692, 3.84615 ;
+! wl2_sun = 0.263158, 0.344828, 0.441501, 0.625, 0.77821, 1.24224, 1.2987,
+! 1.62602, 1.94175, 2.15054, 2.5, 3.07692, 3.84615, 12.1951 ;
+! wl1_earth = 3.07692, 3.84615, 4.20168, 4.44444, 4.80769, 5.55556, 6.75676,
+! 7.19424, 8.47458, 9.25926, 10.2041, 12.1951, 14.2857, 15.873, 20, 28.5714 ;
+! wl2_earth = 3.84615, 4.20168, 4.44444, 4.80769, 5.55556, 6.75676, 7.19424,
+! 8.47458, 9.25926, 10.2041, 12.1951, 14.2857, 15.873, 20, 28.5714, 1000 ;
+ do ib=1,nbands
+ betot(1:ncol,1:pver,ib) = betot(1:ncol,1:pver,ib) &
+ + volc_ext_sun(1:ncol,1:pver,ib)
+ ssatot(1:ncol,1:pver,ib) = ssatot(1:ncol,1:pver,ib) &
+ + volc_ext_sun(1:ncol,1:pver,ib)*volc_omega_sun(1:ncol,1:pver,ib)
+ asymtot(1:ncol,1:pver,ib) = asymtot(1:ncol,1:pver,ib) &
+ + volc_ext_sun(1:ncol,1:pver,ib)*volc_omega_sun(1:ncol,1:pver,ib) &
+ *volc_g_sun(1:ncol,1:pver,ib)
+ enddo
+!akc6+
+ bevisvolc(1:ncol,1:pver) = volc_ext_sun(1:ncol,1:pver,4)
+!akc6-
+! and then calculate the total bulk optical parameters
+ do ib=1,nbands
+ do k=1,pver
+ do icol=1,ncol
+ ssatot(icol,k,ib)=ssatot(icol,k,ib)/(betot(icol,k,ib)+eps)
+ asymtot(icol,k,ib)=asymtot(icol,k,ib) &
+ /(betot(icol,k,ib)*ssatot(icol,k,ib)+eps)
+ end do
+ enddo
+ enddo
+
+!------------------------------------------------------------------------------------------------
+! Replace CAM5 standard aerosol optics with CAM5-Oslo optics (except top layer: no aerosol)
+! Remapping from AeroTab to CAM5 SW bands, see p. 167 in the CAM5.0 description:
+! CAM5 bands AeroTab bands
+! 14 3.846 12.195 14
+! 1 3.077 3.846 13
+! 2 2.500 3.077 12
+! 3 2.150 2.500 11
+! 4 1.942 2.150 10
+! 5 1.626 1.942 9
+! 6 1.299 1.626 8
+! 7 1.242 1.299 7
+! 8 0.778 1.242 6
+! 9 0.625 0.778 5
+! 10 0.442 0.625 4
+! 11 0.345 0.442 3
+! 12 0.263 0.345 2
+! 13 0.200 0.263 1
+
+ do i=1,ncol ! zero aerosol in the top layer
+ do ib=1,14 ! 1-nbands
+ per_tau(i,0,ib)= 0._r8
+ per_tau_w(i,0,ib)= 0.999_r8
+ per_tau_w_g(i,0,ib)= 0.5_r8
+ per_tau_w_f(i,0,ib)= 0.25_r8
+ end do
+ do ib=1,14 ! initialize also for the other layers
+ do k=1,pver
+ per_tau(i,k,ib)= 0._r8
+ per_tau_w(i,k,ib)= 0.999_r8
+ per_tau_w_g(i,k,ib)= 0.5_r8
+ per_tau_w_f(i,k,ib)= 0.25_r8
+ end do
+ end do
+ end do
+! Remapping of SW wavelength bands from AeroTab to CAM5
+ do i=1,ncol
+ do ib=1,13
+ do k=1,pver
+ per_tau(i,k,ib)=deltah_km(i,k)*betot(i,k,14-ib)
+ per_tau_w(i,k,ib)=per_tau(i,k,ib)*max(min(ssatot(i,k,14-ib),0.999999_r8),1.e-6_r8)
+ per_tau_w_g(i,k,ib)=per_tau_w(i,k,ib)*asymtot(i,k,14-ib)
+ per_tau_w_f(i,k,ib)=per_tau_w_g(i,k,ib)*asymtot(i,k,14-ib)
+!tst
+! if(ib.eq.4.and.k.eq.pver.and.i.eq.1) then
+! write(*,*) 'per_tau =', per_tau(i,k,ib)
+! write(*,*) 'per_tau_w =', per_tau_w(i,k,ib)
+! write(*,*) 'per_tau_w_g =', per_tau_w_g(i,k,ib)
+! endif
+!tst
+ end do
+ end do
+ ib=14
+ do k=1,pver
+ per_tau(i,k,ib)=deltah_km(i,k)*betot(i,k,ib)
+ per_tau_w(i,k,ib)=per_tau(i,k,ib)*max(min(ssatot(i,k,ib),0.999999_r8),1.e-6_r8)
+ per_tau_w_g(i,k,ib)=per_tau_w(i,k,ib)*asymtot(i,k,ib)
+ per_tau_w_f(i,k,ib)=per_tau_w_g(i,k,ib)*asymtot(i,k,ib)
+ end do
+ end do ! ncol
+!------------------------------------------------------------------------------------------------
+
+! LW Optical properties of total aerosol:
+ do ib=1,nlwbands
+ do k=1,pver
+ do icol=1,ncol
+ batotlw(icol,k,ib)=0.0_r8
+ end do
+ enddo
+ enddo
+ do ib=1,nlwbands
+ do i=0,nmodes
+ do k=1,pver
+ do icol=1,ncol
+ balw(icol,k,i,ib)=kalw(icol,k,i,ib)*(be(icol,k,i,4)/(ke(icol,k,i,4)+eps))
+ batotlw(icol,k,ib)=batotlw(icol,k,ib)+Nnatk(icol,k,i)*balw(icol,k,i,ib)
+ end do
+ enddo
+ enddo
+ enddo
+
+! Adding also the volcanic contribution (CMIP6), which is also using
+! AeroTab band numbering, so that a remapping is required here
+ do ib=1,nlwbands
+ volc_balw(1:ncol,1:pver,ib) = volc_ext_earth(:ncol,1:pver,ib) &
+ *(1.0_r8-volc_omega_earth(:ncol,1:pver,ib))
+ batotlw(1:ncol,1:pver,ib)=batotlw(1:ncol,1:pver,ib)+volc_balw(1:ncol,1:pver,ib)
+ enddo
+
+! Remapping of LW wavelength bands from AeroTab to CAM5
+ do ib=1,nlwbands
+ do i=1,ncol
+ do k=1,pver
+ per_lw_abs(i,k,ib)=deltah_km(i,k)*batotlw(i,k,17-ib)
+! if(ib.eq.1.and.k.eq.pver.and.i.eq.1) then
+! write(*,*) 'per_lw_abs =', per_lw_abs(i,k,ib)
+! endif
+ end do
+ end do
+ end do
+
+#ifdef AEROCOM
+ do i=1,ncol
+ do k=1,pver
+ batotsw13(i,k)=betot(i,k,13)*(1.0_r8-ssatot(i,k,13))
+ batotlw01(i,k)=batotlw(i,k,1)
+ end do
+ end do
+! These two fields should be close to equal, both representing absorption
+! in the 3.077-3.846 um wavelenght band (i.e., a check of LUT for LW vs. SW).
+ call outfld('BATSW13 ',batotsw13,pcols,lchnk)
+ call outfld('BATLW01 ',batotlw01,pcols,lchnk)
+#endif
+
+#ifdef COLTST4INTCONS
+! initialize modal optical extinctions
+ do k=1,pver
+ do icol=1,ncol
+ bekc0(icol,k)=0.0_r8
+ bekc1(icol,k)=0.0_r8
+ bekc2(icol,k)=0.0_r8
+ bekc4(icol,k)=0.0_r8
+ bekc5(icol,k)=0.0_r8
+ bekc6(icol,k)=0.0_r8
+ bekc7(icol,k)=0.0_r8
+ bekc8(icol,k)=0.0_r8
+ bekc9(icol,k)=0.0_r8
+ bekc10(icol,k)=0.0_r8
+ bekc12(icol,k)=0.0_r8
+ bekc14(icol,k)=0.0_r8
+!
+ kekc0(icol,k)=0.0_r8
+ kekc1(icol,k)=0.0_r8
+ kekc2(icol,k)=0.0_r8
+ kekc4(icol,k)=0.0_r8
+ kekc5(icol,k)=0.0_r8
+ kekc6(icol,k)=0.0_r8
+ kekc7(icol,k)=0.0_r8
+ kekc8(icol,k)=0.0_r8
+ kekc9(icol,k)=0.0_r8
+ kekc10(icol,k)=0.0_r8
+ kekc12(icol,k)=0.0_r8
+ kekc14(icol,k)=0.0_r8
+ end do
+ enddo
+! optical depth (in band 4 = vis.) for each of the modes
+ do k=1,pver
+ do icol=1,ncol
+ bekc0(icol,k) =Nnatk(icol,k,0) *be(icol,k,0,4)
+ bekc1(icol,k) =Nnatk(icol,k,1) *be(icol,k,1,4)
+ bekc2(icol,k) =Nnatk(icol,k,2) *be(icol,k,2,4)
+ bekc4(icol,k) =Nnatk(icol,k,4) *be(icol,k,4,4)
+ bekc5(icol,k) =Nnatk(icol,k,5) *be(icol,k,5,4)
+ bekc6(icol,k) =Nnatk(icol,k,6) *be(icol,k,6,4)
+ bekc7(icol,k) =Nnatk(icol,k,7) *be(icol,k,7,4)
+ bekc8(icol,k) =Nnatk(icol,k,8) *be(icol,k,8,4)
+ bekc9(icol,k) =Nnatk(icol,k,9) *be(icol,k,9,4)
+ bekc10(icol,k)=Nnatk(icol,k,10)*be(icol,k,10,4)
+ bekc12(icol,k)=Nnatk(icol,k,12)*be(icol,k,12,4)
+ bekc14(icol,k)=Nnatk(icol,k,14)*be(icol,k,14,4)
+!
+ kekc0(icol,k) =ke(icol,k,0,4)
+ kekc1(icol,k) =ke(icol,k,1,4)
+ kekc2(icol,k) =ke(icol,k,2,4)
+ kekc4(icol,k) =ke(icol,k,4,4)
+ kekc5(icol,k) =ke(icol,k,5,4)
+ kekc6(icol,k) =ke(icol,k,6,4)
+ kekc7(icol,k) =ke(icol,k,7,4)
+ kekc8(icol,k) =ke(icol,k,8,4)
+ kekc9(icol,k) =ke(icol,k,9,4)
+ kekc10(icol,k)=ke(icol,k,10,4)
+ kekc12(icol,k)=ke(icol,k,12,4)
+ kekc14(icol,k)=ke(icol,k,14,4)
+ end do
+ enddo
+#endif
+
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! APPROXIMATE aerosol extinction and absorption at 550nm (0.442-0.625 um)
+! (in the visible wavelength band)
+ do k=1,pver
+ do icol=1,ncol
+ betotvis(icol,k)=betot(icol,k,4)
+ batotvis(icol,k)=betotvis(icol,k)*(1.0-ssatot(icol,k,4))
+ end do
+ enddo
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+
+ do k=1,pver
+ do icol=1,ncol
+ ssavis(icol,k) = 0.0_r8
+ asymmvis(icol,k) = 0.0_r8
+ extvis(icol,k) = 0.0_r8
+ dayfoc(icol,k) = 0.0_r8
+ enddo
+ end do
+
+ do k=1,pver
+ do icol=1,ncol
+! dayfoc < 1 when looping only over gridcells with daylight
+ if(daylight(icol)) then
+ dayfoc(icol,k) = 1.0_r8
+! with the new bands in CAM5, band 4 is now at ca 0.5 um (0.442-0.625)
+ ssavis(icol,k) = ssatot(icol,k,4)
+ asymmvis(icol,k) = asymtot(icol,k,4)
+ extvis(icol,k) = betot(icol,k,4)
+ endif
+ enddo
+ end do
+
+! optical parameters in visible light (0.442-0.625um)
+ call outfld('SSAVIS ',ssavis,pcols,lchnk)
+ call outfld('ASYMMVIS',asymmvis,pcols,lchnk)
+ call outfld('EXTVIS ',extvis,pcols,lchnk)
+ call outfld('DAYFOC ',dayfoc,pcols,lchnk)
+
+! Initialize fields
+ do icol=1,ncol
+! akso4c(icol)=0.0_r8
+! akbcc(icol)=0.0_r8
+! akocc(icol)=0.0_r8
+ aodvis(icol)=0.0_r8
+ absvis(icol)=0.0_r8
+ aodvisvolc(icol)=0.0_r8
+ absvisvolc(icol)=0.0_r8
+ airmass(icol)=0.0_r8 !akc6
+#ifdef COLTST4INTCONS
+ taukc0(icol)=0.0_r8
+ taukc1(icol)=0.0_r8
+ taukc2(icol)=0.0_r8
+! taukc3(icol)=0.0_r8
+ taukc4(icol)=0.0_r8
+ taukc5(icol)=0.0_r8
+ taukc6(icol)=0.0_r8
+ taukc7(icol)=0.0_r8
+ taukc8(icol)=0.0_r8
+ taukc9(icol)=0.0_r8
+ taukc10(icol)=0.0_r8
+! taukc11(icol)=0.0_r8
+ taukc12(icol)=0.0_r8
+! taukc13(icol)=0.0_r8
+ taukc14(icol)=0.0_r8
+#endif
+ enddo
+
+ do icol=1,ncol
+ if(daylight(icol)) then
+ do k=1,pver
+! Layer thickness, unit km, and layer airmass, unit kg/m2
+ deltah=deltah_km(icol,k)
+!akc6 airmass(icol,k)=1.e3_r8*deltah*rhoda(icol,k)
+ airmassl(icol,k)=1.e3_r8*deltah*rhoda(icol,k)
+ airmass(icol)=airmass(icol)+airmassl(icol,k) !akc6
+! Optical depths at ca. 550 nm (0.442-0.625um) all aerosols
+!tst
+! aodvis3d(icol,k)=betotvis(icol,k)*deltah
+!tst
+ aodvis(icol)=aodvis(icol)+betotvis(icol,k)*deltah
+ absvis(icol)=absvis(icol)+batotvis(icol,k)*deltah
+! Optical depths at ca. 550 nm (0.442-0.625um) CMIP6 volcanic aerosol
+ aodvisvolc(icol)=aodvisvolc(icol)+volc_ext_sun(icol,k,4)*deltah
+ absvisvolc(icol)=absvisvolc(icol)+volc_ext_sun(icol,k,4) &
+ *(1.0_r8-volc_omega_sun(icol,k,4))*deltah
+#ifdef COLTST4INTCONS
+! To check internal consistency of these AOD calculations, make
+! sure that sum_i(taukc_i)=aodvis (tested to be ok on 7/1-2016).
+! Note that this will not be the case when CMIP6 volcanic forcing
+! as optical properties are included, since this comes "on top of"
+! the mixtures 0-14 below.
+ taukc0(icol) =taukc0(icol) +bekc0(icol,k)*deltah
+ taukc1(icol) =taukc1(icol) +bekc1(icol,k)*deltah
+ taukc2(icol) =taukc2(icol) +bekc2(icol,k)*deltah
+ taukc4(icol) =taukc4(icol) +bekc4(icol,k)*deltah
+ taukc5(icol) =taukc5(icol) +bekc5(icol,k)*deltah
+ taukc6(icol) =taukc6(icol) +bekc6(icol,k)*deltah
+ taukc7(icol) =taukc7(icol) +bekc7(icol,k)*deltah
+ taukc8(icol) =taukc8(icol) +bekc8(icol,k)*deltah
+ taukc9(icol) =taukc9(icol) +bekc9(icol,k)*deltah
+ taukc10(icol)=taukc10(icol)+bekc10(icol,k)*deltah
+ taukc12(icol)=taukc12(icol)+bekc12(icol,k)*deltah
+ taukc14(icol)=taukc14(icol)+bekc14(icol,k)*deltah
+#endif
+ end do ! k
+ endif ! daylight
+ end do ! icol
+
+! Extinction and absorption for 0.55 um for the total aerosol, and AODs
+#ifdef AEROCOM
+ call outfld('BETOTVIS',betotvis,pcols,lchnk)
+ call outfld('BATOTVIS',batotvis,pcols,lchnk)
+#endif
+! call outfld('AODVIS ',aodvis ,pcols,lchnk)
+ call outfld('AOD_VIS ',aodvis ,pcols,lchnk)
+ call outfld('ABSVIS ',absvis ,pcols,lchnk)
+ call outfld('AODVVOLC',aodvisvolc ,pcols,lchnk)
+ call outfld('ABSVVOLC',absvisvolc ,pcols,lchnk)
+!akc6+
+ call outfld('BVISVOLC',bevisvolc ,pcols,lchnk)
+!akc6-
+!tst
+! call outfld('AODVIS3D',aodvis3d,pcols,lchnk)
+!tst
+#ifdef COLTST4INTCONS
+ call outfld('TAUKC0 ',taukc0 ,pcols,lchnk)
+ call outfld('TAUKC1 ',taukc1 ,pcols,lchnk)
+ call outfld('TAUKC2 ',taukc2 ,pcols,lchnk)
+ call outfld('TAUKC4 ',taukc4 ,pcols,lchnk)
+ call outfld('TAUKC5 ',taukc5 ,pcols,lchnk)
+ call outfld('TAUKC6 ',taukc6 ,pcols,lchnk)
+ call outfld('TAUKC7 ',taukc7 ,pcols,lchnk)
+ call outfld('TAUKC8 ',taukc8 ,pcols,lchnk)
+ call outfld('TAUKC9 ',taukc9 ,pcols,lchnk)
+ call outfld('TAUKC10 ',taukc10,pcols,lchnk)
+ call outfld('TAUKC12 ',taukc12,pcols,lchnk)
+ call outfld('TAUKC14 ',taukc14,pcols,lchnk)
+!
+ call outfld('MECKC0 ',kekc0 ,pcols,lchnk)
+ call outfld('MECKC1 ',kekc1 ,pcols,lchnk)
+ call outfld('MECKC2 ',kekc2 ,pcols,lchnk)
+ call outfld('MECKC4 ',kekc4 ,pcols,lchnk)
+ call outfld('MECKC5 ',kekc5 ,pcols,lchnk)
+ call outfld('MECKC6 ',kekc6 ,pcols,lchnk)
+ call outfld('MECKC7 ',kekc7 ,pcols,lchnk)
+ call outfld('MECKC8 ',kekc8 ,pcols,lchnk)
+ call outfld('MECKC9 ',kekc9 ,pcols,lchnk)
+ call outfld('MECKC10 ',kekc10 ,pcols,lchnk)
+ call outfld('MECKC12 ',kekc12 ,pcols,lchnk)
+ call outfld('MECKC14 ',kekc14 ,pcols,lchnk)
+#endif
+
+#ifdef AEROCOM ! AEROCOM***********AEROCOM**************AEROCOM***************below
+
+! call outfld('BEKC4 ',bekc4 ,pcols,lchnk)
+
+! Initialize fields
+ do icol=1,ncol
+ daerh2o(icol)=0.0_r8
+ vaercols(icol)=0.0_r8
+ vaercoll(icol)=0.0_r8
+ aaercols(icol)=0.0_r8
+ aaercoll(icol)=0.0_r8
+ do i=0,nmodes
+ dload(icol,i)=0.0_r8
+ enddo
+ enddo
+
+
+!000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+! AeroCom diagnostics requiring table look-ups with ambient RH.
+
+ do irf=0,0
+ call opticsAtConstRh(lchnk, ncol, pint, rhoda, Nnatk, xrh, irh1, irf, &
+ xct, ict1, xfaq, ifaq1, xfbcbg, ifbcbg1, &
+ xfbcbgn, ifbcbgn1, xfac, ifac1, xfbc, ifbc1, &
+ xfombg, ifombg1, vnbcarr, vaitbcarr, v_soana, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebglt1, bebggt1, bebclt1, bebcgt1, &
+ beoclt1, beocgt1, bes4lt1, bes4gt1, &
+ backsc550, babg550, babc550, baoc550, basu550, &
+ bext440n, bext500n, bext550n, bext670n, bext870n, &
+ bebg440n, bebg500n, bebg550n, bebg670n, bebg870n, &
+ bebc440n, bebc500n, bebc550n, bebc670n, bebc870n, &
+ beoc440n, beoc500n, beoc550n, beoc670n, beoc870n, &
+ besu440n, besu500n, besu550n, besu670n, besu870n, &
+ babs440n, babs500n, babs550n, babs670n, babs870n, &
+ bebglt1n, bebggt1n, bebclt1n, bebcgt1n, &
+ beoclt1n, beocgt1n, bes4lt1n, bes4gt1n, &
+ backsc550n, babg550n, babc550n, baoc550n, basu550n)
+ end do ! irf
+
+!000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+ do k=1,pver
+ do icol=1,ncol
+
+ bebglt1t(icol,k)=0.0_r8
+ bebggt1t(icol,k)=0.0_r8
+ bebclt1t(icol,k)=0.0_r8
+ bebcgt1t(icol,k)=0.0_r8
+ beoclt1t(icol,k)=0.0_r8
+ beocgt1t(icol,k)=0.0_r8
+ bes4lt1t(icol,k)=0.0_r8
+ bes4gt1t(icol,k)=0.0_r8
+ bedustlt1(icol,k)=0.0_r8
+ bedustgt1(icol,k)=0.0_r8
+ besslt1(icol,k)=0.0_r8
+ bessgt1(icol,k)=0.0_r8
+
+ bext440tot(icol,k)=0.0_r8
+ babs440tot(icol,k)=0.0_r8
+ bext500tot(icol,k)=0.0_r8
+ babs500tot(icol,k)=0.0_r8
+ bext550tot(icol,k)=0.0_r8
+ babs550tot(icol,k)=0.0_r8
+ bext670tot(icol,k)=0.0_r8
+ babs670tot(icol,k)=0.0_r8
+ bext870tot(icol,k)=0.0_r8
+ babs870tot(icol,k)=0.0_r8
+
+ backsc550tot(icol,k)=0.0_r8
+
+ bebg440tot(icol,k)=0.0_r8
+! babg440tot(icol,k)=0.0_r8
+ bebg500tot(icol,k)=0.0_r8
+! babg500tot(icol,k)=0.0_r8
+ bebg550tot(icol,k)=0.0_r8
+ babg550tot(icol,k)=0.0_r8
+ bebg670tot(icol,k)=0.0_r8
+! babg670tot(icol,k)=0.0_r8
+ bebg870tot(icol,k)=0.0_r8
+! babg870tot(icol,k)=0.0_r8
+
+ bebc440tot(icol,k)=0.0_r8
+! babc440tot(icol,k)=0.0_r8
+ bebc500tot(icol,k)=0.0_r8
+! babc500tot(icol,k)=0.0_r8
+ bebc550tot(icol,k)=0.0_r8
+ babc550tot(icol,k)=0.0_r8
+ bebc670tot(icol,k)=0.0_r8
+! babc670tot(icol,k)=0.0_r8
+ bebc870tot(icol,k)=0.0_r8
+! babc870tot(icol,k)=0.0_r8
+
+ beoc440tot(icol,k)=0.0_r8
+! baoc440tot(icol,k)=0.0_r8
+ beoc500tot(icol,k)=0.0_r8
+! baoc500tot(icol,k)=0.0_r8
+ beoc550tot(icol,k)=0.0_r8
+ baoc550tot(icol,k)=0.0_r8
+ beoc670tot(icol,k)=0.0_r8
+! baoc670tot(icol,k)=0.0_r8
+ beoc870tot(icol,k)=0.0_r8
+! baoc870tot(icol,k)=0.0_r8
+
+ besu440tot(icol,k)=0.0_r8
+! basu440tot(icol,k)=0.0_r8
+ besu500tot(icol,k)=0.0_r8
+! basu500tot(icol,k)=0.0_r8
+ besu550tot(icol,k)=0.0_r8
+ basu550tot(icol,k)=0.0_r8
+ besu670tot(icol,k)=0.0_r8
+! basu670tot(icol,k)=0.0_r8
+ besu870tot(icol,k)=0.0_r8
+! basu870tot(icol,k)=0.0_r8
+
+ enddo
+ enddo
+
+ do i=0,nbmodes
+ do k=1,pver
+ do icol=1,ncol
+! total internal extinction and absorption for 0.44, 0.50, 0.55, 0.68 and 0.87 um
+ bext440tot(icol,k)=bext440tot(icol,k)+Nnatk(icol,k,i)*bext440(icol,k,i)
+ babs440tot(icol,k)=babs440tot(icol,k)+Nnatk(icol,k,i)*babs440(icol,k,i)
+ bext500tot(icol,k)=bext500tot(icol,k)+Nnatk(icol,k,i)*bext500(icol,k,i)
+ babs500tot(icol,k)=babs500tot(icol,k)+Nnatk(icol,k,i)*babs500(icol,k,i)
+ bext550tot(icol,k)=bext550tot(icol,k)+Nnatk(icol,k,i)*bext550(icol,k,i)
+ babs550tot(icol,k)=babs550tot(icol,k)+Nnatk(icol,k,i)*babs550(icol,k,i)
+ bext670tot(icol,k)=bext670tot(icol,k)+Nnatk(icol,k,i)*bext670(icol,k,i)
+ babs670tot(icol,k)=babs670tot(icol,k)+Nnatk(icol,k,i)*babs670(icol,k,i)
+ bext870tot(icol,k)=bext870tot(icol,k)+Nnatk(icol,k,i)*bext870(icol,k,i)
+ babs870tot(icol,k)=babs870tot(icol,k)+Nnatk(icol,k,i)*babs870(icol,k,i)
+ backsc550tot(icol,k)=backsc550tot(icol,k)+Nnatk(icol,k,i)*backsc550(icol,k,i)
+! extinction and absorption for 0.44, 0.50, 0.55 (no abs), 0.68 and 0.87 um
+! for the whole background aerosol (icluding SO4,BC, and OC for modes 0-5)
+ bebg440tot(icol,k)=bebg440tot(icol,k)+Nnatk(icol,k,i)*bebg440(icol,k,i)
+! babg440tot(icol,k)=babg440tot(icol,k)+Nnatk(icol,k,i)*babg440(icol,k,i)
+ bebg500tot(icol,k)=bebg500tot(icol,k)+Nnatk(icol,k,i)*bebg500(icol,k,i)
+! babg500tot(icol,k)=babg500tot(icol,k)+Nnatk(icol,k,i)*babg500(icol,k,i)
+ bebg550tot(icol,k)=bebg550tot(icol,k)+Nnatk(icol,k,i)*bebg550(icol,k,i)
+ babg550tot(icol,k)=babg550tot(icol,k)+Nnatk(icol,k,i)*babg550(icol,k,i)
+ bebg670tot(icol,k)=bebg670tot(icol,k)+Nnatk(icol,k,i)*bebg670(icol,k,i)
+! babg670tot(icol,k)=babg670tot(icol,k)+Nnatk(icol,k,i)*babg670(icol,k,i)
+ bebg870tot(icol,k)=bebg870tot(icol,k)+Nnatk(icol,k,i)*bebg870(icol,k,i)
+! babg870tot(icol,k)=babg870tot(icol,k)+Nnatk(icol,k,i)*babg870(icol,k,i)
+! extinction and absorption for 0.44, 0.50, 0.55 (no abs), 0.68 and 0.87 um
+! for each added (internally mixed through Aq./cond./coag.) component (SO4,BC,OC).
+! Condensed/coagulated SO4 on all modes 1-10, and wet-phase SO4 on modes 4-10:
+ besu440tot(icol,k)=besu440tot(icol,k)+Nnatk(icol,k,i)*besu440(icol,k,i)
+! basu440tot(icol,k)=basu440tot(icol,k)+Nnatk(icol,k,i)*basu440(icol,k,i)
+ besu500tot(icol,k)=besu500tot(icol,k)+Nnatk(icol,k,i)*besu500(icol,k,i)
+! basu500tot(icol,k)=basu500tot(icol,k)+Nnatk(icol,k,i)*basu500(icol,k,i)
+ besu550tot(icol,k)=besu550tot(icol,k)+Nnatk(icol,k,i)*besu550(icol,k,i)
+ basu550tot(icol,k)=basu550tot(icol,k)+Nnatk(icol,k,i)*basu550(icol,k,i)
+ besu670tot(icol,k)=besu670tot(icol,k)+Nnatk(icol,k,i)*besu670(icol,k,i)
+! basu670tot(icol,k)=basu670tot(icol,k)+Nnatk(icol,k,i)*basu670(icol,k,i)
+ besu870tot(icol,k)=besu870tot(icol,k)+Nnatk(icol,k,i)*besu870(icol,k,i)
+! basu870tot(icol,k)=basu870tot(icol,k)+Nnatk(icol,k,i)*basu870(icol,k,i)
+!
+! Condensed OC on modes 1-4 and coagulated BC and OC on modes 5-10:
+ if(i>=1) then
+ bebc440tot(icol,k)=bebc440tot(icol,k)+Nnatk(icol,k,i)*bebc440(icol,k,i)
+! babc440tot(icol,k)=babc440tot(icol,k)+Nnatk(icol,k,i)*babc440(icol,k,i)
+ bebc500tot(icol,k)=bebc500tot(icol,k)+Nnatk(icol,k,i)*bebc500(icol,k,i)
+! babc500tot(icol,k)=babc500tot(icol,k)+Nnatk(icol,k,i)*babc500(icol,k,i)
+ bebc550tot(icol,k)=bebc550tot(icol,k)+Nnatk(icol,k,i)*bebc550(icol,k,i)
+ babc550tot(icol,k)=babc550tot(icol,k)+Nnatk(icol,k,i)*babc550(icol,k,i)
+ bebc670tot(icol,k)=bebc670tot(icol,k)+Nnatk(icol,k,i)*bebc670(icol,k,i)
+! babc670tot(icol,k)=babc670tot(icol,k)+Nnatk(icol,k,i)*babc670(icol,k,i)
+ bebc870tot(icol,k)=bebc870tot(icol,k)+Nnatk(icol,k,i)*bebc870(icol,k,i)
+! babc870tot(icol,k)=babc870tot(icol,k)+Nnatk(icol,k,i)*babc870(icol,k,i)
+ beoc440tot(icol,k)=beoc440tot(icol,k)+Nnatk(icol,k,i)*beoc440(icol,k,i)
+! baoc440tot(icol,k)=baoc440tot(icol,k)+Nnatk(icol,k,i)*baoc440(icol,k,i)
+ beoc500tot(icol,k)=beoc500tot(icol,k)+Nnatk(icol,k,i)*beoc500(icol,k,i)
+! baoc500tot(icol,k)=baoc500tot(icol,k)+Nnatk(icol,k,i)*baoc500(icol,k,i)
+ beoc550tot(icol,k)=beoc550tot(icol,k)+Nnatk(icol,k,i)*beoc550(icol,k,i)
+ baoc550tot(icol,k)=baoc550tot(icol,k)+Nnatk(icol,k,i)*baoc550(icol,k,i)
+ beoc670tot(icol,k)=beoc670tot(icol,k)+Nnatk(icol,k,i)*beoc670(icol,k,i)
+! baoc670tot(icol,k)=baoc670tot(icol,k)+Nnatk(icol,k,i)*baoc670(icol,k,i)
+ beoc870tot(icol,k)=beoc870tot(icol,k)+Nnatk(icol,k,i)*beoc870(icol,k,i)
+! baoc870tot(icol,k)=baoc870tot(icol,k)+Nnatk(icol,k,i)*baoc870(icol,k,i)
+ endif ! i>=1
+ if(i==6.or.i==7) then
+ bedustlt1(icol,k)=bedustlt1(icol,k) &
+ +Nnatk(icol,k,i)*bebglt1(icol,k,i)
+ bedustgt1(icol,k)=bedustgt1(icol,k) &
+ +Nnatk(icol,k,i)*bebggt1(icol,k,i)
+ elseif(i>=8.and.i<=10) then
+ besslt1(icol,k)=besslt1(icol,k) &
+ +Nnatk(icol,k,i)*bebglt1(icol,k,i)
+ bessgt1(icol,k)=bessgt1(icol,k) &
+ +Nnatk(icol,k,i)*bebggt1(icol,k,i)
+ endif
+! Condensed/coagulated SO4 on all modes 1-10, and wet-phase SO4 on modes 4-10:
+ bes4lt1t(icol,k)=bes4lt1t(icol,k) &
+ +Nnatk(icol,k,i)*bes4lt1(icol,k,i)
+ bes4gt1t(icol,k)=bes4gt1t(icol,k) &
+ +Nnatk(icol,k,i)*bes4gt1(icol,k,i)
+! Condensed OC on mode 1 and coagulated BC and OC on modes 5-10:
+ if(i>=1) then
+ bebclt1t(icol,k)=bebclt1t(icol,k) &
+ +Nnatk(icol,k,i)*bebclt1(icol,k,i)
+ bebcgt1t(icol,k)=bebcgt1t(icol,k) &
+ +Nnatk(icol,k,i)*bebcgt1(icol,k,i)
+ beoclt1t(icol,k)=beoclt1t(icol,k) &
+ +Nnatk(icol,k,i)*beoclt1(icol,k,i)
+ beocgt1t(icol,k)=beocgt1t(icol,k) &
+ +Nnatk(icol,k,i)*beocgt1(icol,k,i)
+ endif ! i>=1
+ end do ! icol
+ enddo ! k
+ enddo ! i
+
+! extinction/absorptions (km-1) for each background component
+! in the internal mixture are
+ do k=1,pver
+ do icol=1,ncol
+ bint440du(icol,k)=Nnatk(icol,k,6)*bebg440(icol,k,6) &
+ +Nnatk(icol,k,7)*bebg440(icol,k,7)
+ bint500du(icol,k)=Nnatk(icol,k,6)*bebg500(icol,k,6) &
+ +Nnatk(icol,k,7)*bebg500(icol,k,7)
+ bint550du(icol,k)=Nnatk(icol,k,6)*bebg550(icol,k,6) &
+ +Nnatk(icol,k,7)*bebg550(icol,k,7)
+ bint670du(icol,k)=Nnatk(icol,k,6)*bebg670(icol,k,6) &
+ +Nnatk(icol,k,7)*bebg670(icol,k,7)
+ bint870du(icol,k)=Nnatk(icol,k,6)*bebg870(icol,k,6) &
+ +Nnatk(icol,k,7)*bebg870(icol,k,7)
+ bint440ss(icol,k)=Nnatk(icol,k,8)*bebg440(icol,k,8) &
+ +Nnatk(icol,k,9)*bebg440(icol,k,9) &
+ +Nnatk(icol,k,10)*bebg440(icol,k,10)
+ bint500ss(icol,k)=Nnatk(icol,k,8)*bebg500(icol,k,8) &
+ +Nnatk(icol,k,9)*bebg500(icol,k,9) &
+ +Nnatk(icol,k,10)*bebg500(icol,k,10)
+ bint550ss(icol,k)=Nnatk(icol,k,8)*bebg550(icol,k,8) &
+ +Nnatk(icol,k,9)*bebg550(icol,k,9) &
+ +Nnatk(icol,k,10)*bebg550(icol,k,10)
+ bint670ss(icol,k)=Nnatk(icol,k,8)*bebg670(icol,k,8) &
+ +Nnatk(icol,k,9)*bebg670(icol,k,9) &
+ +Nnatk(icol,k,10)*bebg670(icol,k,10)
+ bint870ss(icol,k)=Nnatk(icol,k,8)*bebg870(icol,k,8) &
+ +Nnatk(icol,k,9)*bebg870(icol,k,9) &
+ +Nnatk(icol,k,10)*bebg870(icol,k,10)
+ baint550du(icol,k)=Nnatk(icol,k,6)*babg550(icol,k,6) &
+ +Nnatk(icol,k,7)*babg550(icol,k,7)
+ baint550ss(icol,k)=Nnatk(icol,k,8)*babg550(icol,k,8) &
+ +Nnatk(icol,k,9)*babg550(icol,k,9) &
+ +Nnatk(icol,k,10)*babg550(icol,k,10)
+ end do
+ enddo
+
+ do i=11,14
+ do k=1,pver
+ do icol=1,ncol
+ be440x(icol,k,i)=bext440n(icol,k,i-10)
+ ba440x(icol,k,i)=babs440n(icol,k,i-10)
+ be500x(icol,k,i)=bext500n(icol,k,i-10)
+ ba500x(icol,k,i)=babs500n(icol,k,i-10)
+ be550x(icol,k,i)=bext550n(icol,k,i-10)
+ ba550x(icol,k,i)=babs550n(icol,k,i-10)
+ be670x(icol,k,i)=bext670n(icol,k,i-10)
+ ba670x(icol,k,i)=babs670n(icol,k,i-10)
+ be870x(icol,k,i)=bext870n(icol,k,i-10)
+ ba870x(icol,k,i)=babs870n(icol,k,i-10)
+ belt1x(icol,k,i)=bebglt1n(icol,k,i-10)
+ begt1x(icol,k,i)=bebggt1n(icol,k,i-10)
+ backsc550x(icol,k,i)=backsc550n(icol,k,i-10)
+ end do
+ enddo
+ enddo
+
+! The externally modes' contribution to extinction and absorption:
+ do k=1,pver
+ do icol=1,ncol
+
+!BC
+ vnbcarr(icol,k) = fnbc(icol,k)/(fnbc(icol,k) &
+ +(1.0_r8-fnbc(icol,k))*rhopart(l_bc_ni)/rhopart(l_om_ni))
+ vnbc = vnbcarr(icol,k)
+ bebc440xt(icol,k) =Nnatk(icol,k,12)*be440x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*be440x(icol,k,14)
+ babc440xt(icol,k) =Nnatk(icol,k,12)*ba440x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*ba440x(icol,k,14)
+ bebc500xt(icol,k) =Nnatk(icol,k,12)*be500x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*be500x(icol,k,14)
+ babc500xt(icol,k) =Nnatk(icol,k,12)*ba500x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*ba500x(icol,k,14)
+ bebc550xt(icol,k) =Nnatk(icol,k,12)*be550x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*be550x(icol,k,14)
+ babc550xt(icol,k) =Nnatk(icol,k,12)*ba550x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*ba550x(icol,k,14)
+ bebc670xt(icol,k) =Nnatk(icol,k,12)*be670x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*be670x(icol,k,14)
+ babc670xt(icol,k) =Nnatk(icol,k,12)*ba670x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*ba670x(icol,k,14)
+ bebc870xt(icol,k) =Nnatk(icol,k,12)*be870x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*be870x(icol,k,14)
+ babc870xt(icol,k) =Nnatk(icol,k,12)*ba870x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*ba870x(icol,k,14)
+ bbclt1xt(icol,k)=Nnatk(icol,k,12)*belt1x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*belt1x(icol,k,14)
+ bbcgt1xt(icol,k)=Nnatk(icol,k,12)*begt1x(icol,k,12) &
+ +vnbc*Nnatk(icol,k,14)*begt1x(icol,k,14)
+!OC
+ beoc440xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*be440x(icol,k,14)
+ baoc440xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*ba440x(icol,k,14)
+ beoc500xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*be500x(icol,k,14)
+ baoc500xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*ba500x(icol,k,14)
+ beoc550xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*be550x(icol,k,14)
+ baoc550xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*ba550x(icol,k,14)
+ beoc670xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*be670x(icol,k,14)
+ baoc670xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*ba670x(icol,k,14)
+ beoc870xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*be870x(icol,k,14)
+ baoc870xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*ba870x(icol,k,14)
+ boclt1xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*belt1x(icol,k,14)
+ bocgt1xt(icol,k) = &
+ +(1.0_r8-vnbc)*Nnatk(icol,k,14)*begt1x(icol,k,14)
+! Total (for all modes) absorption optical depth and backscattering
+ abs550_aer(icol,k)=babs550tot(icol,k) &
+ +Nnatk(icol,k,12)*ba550x(icol,k,12) &
+ +Nnatk(icol,k,14)*ba550x(icol,k,14)
+ abs550_aer(icol,k)=1.e-3_r8*abs550_aer(icol,k)
+ bs550_aer(icol,k)= backsc550tot(icol,k) &
+ +Nnatk(icol,k,12)*backsc550x(icol,k,12) &
+ +Nnatk(icol,k,14)*backsc550x(icol,k,14)
+ bs550_aer(icol,k)=1.e-3_r8*bs550_aer(icol,k)
+!
+ end do
+ enddo
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! collect AeroCom-fields for optical depth/absorption of each comp,
+! 3D and 2D, at 440, 500, 550, 670 and 870 nm, for all d, d<1um and d>1um
+! initialize 2d-fields
+ do icol=1,ncol
+ dod440(icol) = 0.0_r8
+ abs440(icol) = 0.0_r8
+ dod500(icol) = 0.0_r8
+ abs500(icol) = 0.0_r8
+ dod550(icol) = 0.0_r8
+ abs550(icol) = 0.0_r8
+ abs550alt(icol) = 0.0_r8
+ dod670(icol) = 0.0_r8
+ abs670(icol) = 0.0_r8
+ dod870(icol) = 0.0_r8
+ abs870(icol) = 0.0_r8
+!
+ abs550_ss(icol) = 0.0_r8
+ abs550_dust(icol) = 0.0_r8
+ abs550_so4(icol) = 0.0_r8
+ abs550_bc(icol) = 0.0_r8
+ abs550_pom(icol) = 0.0_r8
+!
+ dod440_ss(icol) = 0.0_r8
+ dod440_dust(icol) = 0.0_r8
+ dod440_so4(icol) = 0.0_r8
+ dod440_bc(icol) = 0.0_r8
+ dod440_pom(icol) = 0.0_r8
+ dod500_ss(icol) = 0.0_r8
+ dod500_dust(icol) = 0.0_r8
+ dod500_so4(icol) = 0.0_r8
+ dod500_bc(icol) = 0.0_r8
+ dod500_pom(icol) = 0.0_r8
+ dod550_ss(icol) = 0.0_r8
+ dod550_dust(icol) = 0.0_r8
+ dod550_so4(icol) = 0.0_r8
+ dod550_bc(icol) = 0.0_r8
+ dod550_pom(icol) = 0.0_r8
+ dod670_ss(icol) = 0.0_r8
+ dod670_dust(icol) = 0.0_r8
+ dod670_so4(icol) = 0.0_r8
+ dod670_bc(icol) = 0.0_r8
+ dod670_pom(icol) = 0.0_r8
+ dod870_ss(icol) = 0.0_r8
+ dod870_dust(icol) = 0.0_r8
+ dod870_so4(icol) = 0.0_r8
+ dod870_bc(icol) = 0.0_r8
+ dod870_pom(icol) = 0.0_r8
+ dod550lt1_ss(icol) = 0.0_r8
+ dod550gt1_ss(icol) = 0.0_r8
+ dod550lt1_dust(icol) = 0.0_r8
+ dod550gt1_dust(icol) = 0.0_r8
+ dod550lt1_so4(icol) = 0.0_r8
+ dod550gt1_so4(icol) = 0.0_r8
+ dod550lt1_bc(icol) = 0.0_r8
+ dod550gt1_bc(icol) = 0.0_r8
+ dod550lt1_pom(icol) = 0.0_r8
+ dod550gt1_pom(icol) = 0.0_r8
+ do k=1,pver
+ abs4403d(icol,k) = 0.0_r8
+ abs5003d(icol,k) = 0.0_r8
+ abs5503d(icol,k) = 0.0_r8
+ abs6703d(icol,k) = 0.0_r8
+ abs8703d(icol,k) = 0.0_r8
+ abs5503dalt(icol,k) = 0.0_r8
+ enddo
+ enddo
+
+ do icol=1,ncol
+ do k=1,pver
+! Layer thickness, unit km
+ deltah=deltah_km(icol,k)
+! if(k==pver) write(*,*) 'icol, deltah(pmxsub)=', icol, deltah
+! 3D optical depths for monthly averages
+!SS
+ dod4403d_ss(icol,k) = bint440ss(icol,k)*deltah
+ dod5003d_ss(icol,k) = bint500ss(icol,k)*deltah
+ dod5503d_ss(icol,k) = bint550ss(icol,k)*deltah
+ abs5503d_ss(icol,k) = baint550ss(icol,k)*deltah
+ dod6703d_ss(icol,k) = bint670ss(icol,k)*deltah
+ dod8703d_ss(icol,k) = bint870ss(icol,k)*deltah
+!DUST
+ dod4403d_dust(icol,k) = bint440du(icol,k)*deltah
+ dod5003d_dust(icol,k) = bint500du(icol,k)*deltah
+ dod5503d_dust(icol,k) = bint550du(icol,k)*deltah
+ abs5503d_dust(icol,k) = baint550du(icol,k)*deltah
+ dod6703d_dust(icol,k) = bint670du(icol,k)*deltah
+ dod8703d_dust(icol,k) = bint870du(icol,k)*deltah
+!SO4
+!soa: *(1-v_soana) for the sulfate volume fraction of mode 1
+ dod4403d_so4(icol,k) = (besu440tot(icol,k) & ! condensate )
+ +(1.0_r8-v_soana(icol,k))*Nnatk(icol,k,1)*bebg440(icol,k,1) & ! background, SO4(Ait) mode (1)
+ + Nnatk(icol,k,5)*bebg440(icol,k,5))*deltah ! background, SO4(Ait75) mode (5)
+ dod5003d_so4(icol,k) = (besu500tot(icol,k) & ! condensate
+ +(1.0_r8-v_soana(icol,k))*Nnatk(icol,k,1)*bebg500(icol,k,1) & ! background, SO4(Ait) mode (1)
+ + Nnatk(icol,k,5)*bebg500(icol,k,5))*deltah ! background, SO4(Ait75) mode (5)
+ dod5503d_so4(icol,k) = (besu550tot(icol,k) & ! condensate
+ +(1.0_r8-v_soana(icol,k))*Nnatk(icol,k,1)*bebg550(icol,k,1) & ! background, SO4(Ait) mode (1)
+ + Nnatk(icol,k,5)*bebg550(icol,k,5))*deltah ! background, SO4(Ait75) mode (5)
+ abs5503d_so4(icol,k) = (basu550tot(icol,k) & ! condensate )
+ +(1.0_r8-v_soana(icol,k))*Nnatk(icol,k,1)*babg550(icol,k,1) & ! background, SO4(Ait) mode (1)
+ + Nnatk(icol,k,5)*babg550(icol,k,5))*deltah ! background, SO4(Ait75) mode (5)
+ dod6703d_so4(icol,k) = (besu670tot(icol,k) & ! condensate
+ +(1.0_r8-v_soana(icol,k))*Nnatk(icol,k,1)*bebg670(icol,k,1) & ! background, SO4(Ait) mode (1)
+ + Nnatk(icol,k,5)*bebg670(icol,k,5))*deltah ! background, SO4(Ait75) mode (5)
+ dod8703d_so4(icol,k) = (besu870tot(icol,k) & ! condensate
+ +(1.0_r8-v_soana(icol,k))*Nnatk(icol,k,1)*bebg870(icol,k,1) & ! background, SO4(Ait) mode (1)
+ + Nnatk(icol,k,5)*bebg870(icol,k,5))*deltah ! background, SO4(Ait75) mode (5)
+!BC
+ vaitbcarr(icol,k) = faitbc(icol,k)/(faitbc(icol,k) &
+ +(1.0_r8-faitbc(icol,k))*rhopart(l_bc_ni)/rhopart(l_om_ni))
+ vaitbc = vaitbcarr(icol,k)
+ dod4403d_bc(icol,k) = (bebc440tot(icol,k)+bebc440xt(icol,k) & ! coagulated + n-mode BC (12)
+ + Nnatk(icol,k,2)*bebg440(icol,k,2) & ! background, BC(Ait) mode (2)
+ + vaitbc*Nnatk(icol,k,4)*bebg440(icol,k,4) & ! background in OC&BC(Ait) mode (4)
+ + Nnatk(icol,k,0)*bebg440(icol,k,0))*deltah ! background, BC(ax) mode (0)
+ dod5003d_bc(icol,k) = (bebc500tot(icol,k)+bebc500xt(icol,k) & ! coagulated + n-mode BC (12)
+ + Nnatk(icol,k,2)*bebg500(icol,k,2) & ! background, BC(Ait) mode (2)
+ + vaitbc*Nnatk(icol,k,4)*bebg500(icol,k,4) & ! background in OC&BC(Ait) mode (4)
+ + Nnatk(icol,k,0)*bebg500(icol,k,0))*deltah ! background, BC(ax) mode (0)
+ dod5503d_bc(icol,k) = (bebc550tot(icol,k)+bebc550xt(icol,k) & ! coagulated + n-mode BC (12)
+ + Nnatk(icol,k,2)*bebg550(icol,k,2) & ! background, BC(Ait) mode (2)
+ + vaitbc*Nnatk(icol,k,4)*bebg550(icol,k,4) & ! background in OC&BC(Ait) mode (4)
+ + Nnatk(icol,k,0)*bebg550(icol,k,0))*deltah ! background, BC(ax) mode (0)
+ abs5503d_bc(icol,k) = (babc550tot(icol,k)+babc550xt(icol,k) & ! coagulated + n-mode BC (12)
+ + Nnatk(icol,k,2)*babg550(icol,k,2) & ! background, BC(Ait) mode (2)
+ + vaitbc*Nnatk(icol,k,4)*babg550(icol,k,4) & ! background in OC&BC(Ait) mode (4)
+ + Nnatk(icol,k,0)*babg550(icol,k,0))*deltah ! background, BC(ax) mode (0)
+ dod6703d_bc(icol,k) = (bebc670tot(icol,k)+bebc670xt(icol,k) & ! coagulated + n-mode BC (12)
+ + Nnatk(icol,k,2)*bebg670(icol,k,2) & ! background, BC(Ait) mode (2)
+ + vaitbc*Nnatk(icol,k,4)*bebg670(icol,k,4) & ! background in OC&BC(Ait) mode (4)
+ + Nnatk(icol,k,0)*bebg670(icol,k,0))*deltah ! background, BC(ax) mode (0)
+ dod8703d_bc(icol,k) = (bebc870tot(icol,k)+bebc870xt(icol,k) & ! coagulated + n-mode BC (12)
+ + Nnatk(icol,k,2)*bebg870(icol,k,2) & ! background, BC(Ait) mode (2)
+ + vaitbc*Nnatk(icol,k,4)*bebg870(icol,k,4) & ! background in OC&BC(Ait) mode (4)
+ + Nnatk(icol,k,0)*bebg870(icol,k,0))*deltah ! background, BC(ax) mode (0)
+!OC
+!soa + v_soana part of mode 11 for the OC volume fraction of that mode
+! v_soana(icol,k)
+ dod4403d_pom(icol,k) = (beoc440tot(icol,k)+beoc440xt(icol,k) & ! coagulated + n-mode OC&BC (14)
+ + Nnatk(icol,k,1)*bebg440(icol,k,1)*v_soana(icol,k) & ! SOA fraction of mode 1
+!-3 + Nnatk(icol,k,3)*bebg440(icol,k,3) & ! background, OC(Ait) mode (3)
+ + (1.0_r8-vaitbc)*Nnatk(icol,k,4)*bebg440(icol,k,4))*deltah ! background in OC&BC(Ait) mode (4)
+ dod5003d_pom(icol,k) = (beoc500tot(icol,k)+beoc500xt(icol,k) & ! coagulated + n-mode OC&BC (14)
+ + Nnatk(icol,k,1)*bebg500(icol,k,1)*v_soana(icol,k) & ! SOA fraction of mode 1
+!-3 + Nnatk(icol,k,3)*bebg500(icol,k,3) & ! background, OC(Ait) mode (3)
+ + (1.0_r8-vaitbc)*Nnatk(icol,k,4)*bebg500(icol,k,4))*deltah ! background in OC&BC(Ait) mode (4)
+ dod5503d_pom(icol,k) = (beoc550tot(icol,k)+beoc550xt(icol,k) & ! coagulated + n-mode OC&BC (14)
+ + Nnatk(icol,k,1)*bebg550(icol,k,1)*v_soana(icol,k) & ! SOA fraction of mode 1
+!-3 + Nnatk(icol,k,3)*bebg550(icol,k,3) & ! background, OC(Ait) mode (3)
+ + (1.0_r8-vaitbc)*Nnatk(icol,k,4)*bebg550(icol,k,4))*deltah ! background in OC&BC(Ait) mode (4)
+ abs5503d_pom(icol,k) = (baoc550tot(icol,k)+baoc550xt(icol,k) & ! coagulated + n-mode OC&BC (14)
+ + Nnatk(icol,k,1)*babg550(icol,k,1)*v_soana(icol,k) & ! SOA fraction of mode 1
+!-3 + Nnatk(icol,k,3)*babg550(icol,k,3) & ! background, OC(Ait) mode (3)
+ + (1.0_r8-vaitbc)*Nnatk(icol,k,4)*babg550(icol,k,4))*deltah ! background in OC&BC(Ait) mode (4)
+ dod6703d_pom(icol,k) = (beoc670tot(icol,k)+beoc670xt(icol,k) & ! coagulated + n-mode OC&BC (14)
+ + Nnatk(icol,k,1)*bebg670(icol,k,1)*v_soana(icol,k) & ! SOA fraction of mode 1
+!-3 + Nnatk(icol,k,3)*bebg670(icol,k,3) & ! background, OC(Ait) mode (3)
+ + (1.0_r8-vaitbc)*Nnatk(icol,k,4)*bebg670(icol,k,4))*deltah ! background in OC&BC(Ait) mode (4)
+ dod8703d_pom(icol,k) = (beoc870tot(icol,k)+beoc870xt(icol,k) & ! coagulated + n-mode OC&BC (14)
+ + Nnatk(icol,k,1)*bebg870(icol,k,1)*v_soana(icol,k) & ! SOA fraction of mode 1
+!-3 + Nnatk(icol,k,3)*bebg870(icol,k,3) & ! background, OC(Ait) mode (3)
+ + (1.0_r8-vaitbc)*Nnatk(icol,k,4)*bebg870(icol,k,4))*deltah ! background in OC&BC(Ait) mode (4)
+
+ ec550_so4(icol,k) = 1.e-3*dod5503d_so4(icol,k)/deltah
+ ec550_bc(icol,k) = 1.e-3*dod5503d_bc(icol,k)/deltah
+ ec550_pom(icol,k) = 1.e-3*dod5503d_pom(icol,k)/deltah
+ ec550_ss(icol,k) = 1.e-3*dod5503d_ss(icol,k)/deltah
+ ec550_du(icol,k) = 1.e-3*dod5503d_dust(icol,k)/deltah
+ ec550_aer(icol,k) = ec550_so4(icol,k)+ec550_bc(icol,k)+ec550_pom(icol,k) &
+ + ec550_ss(icol,k)+ec550_du(icol,k)
+
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! Total 3D optical depths/abs. for column integrations
+ dod4403d(icol,k) = dod4403d_ss(icol,k)+dod4403d_dust(icol,k) &
+ +dod4403d_so4(icol,k)+dod4403d_bc(icol,k) &
+ +dod4403d_pom(icol,k)
+ dod5003d(icol,k) = dod5003d_ss(icol,k)+dod5003d_dust(icol,k) &
+ +dod5003d_so4(icol,k)+dod5003d_bc(icol,k) &
+ +dod5003d_pom(icol,k)
+ dod5503d(icol,k) = dod5503d_ss(icol,k)+dod5503d_dust(icol,k) &
+ +dod5503d_so4(icol,k)+dod5503d_bc(icol,k) &
+ +dod5503d_pom(icol,k)
+ dod6703d(icol,k) = dod6703d_ss(icol,k)+dod6703d_dust(icol,k) &
+ +dod6703d_so4(icol,k)+dod6703d_bc(icol,k) &
+ +dod6703d_pom(icol,k)
+ dod8703d(icol,k) = dod8703d_ss(icol,k)+dod8703d_dust(icol,k) &
+ +dod8703d_so4(icol,k)+dod8703d_bc(icol,k) &
+ +dod8703d_pom(icol,k)
+ abs5503d(icol,k) = abs5503d_ss(icol,k)+abs5503d_dust(icol,k) &
+ +abs5503d_so4(icol,k)+abs5503d_bc(icol,k) &
+ +abs5503d_pom(icol,k)
+! (Note: Local abs550alt is up to 6% larger (annually averaged) in typical b.b.
+! regions, compared to abs550. This is most likely most correct, but should be checked!)
+ do i=0,10
+ abs4403d(icol,k) = abs4403d(icol,k)+Nnatk(icol,k,i)*babs440(icol,k,i)*deltah
+ abs5003d(icol,k) = abs5003d(icol,k)+Nnatk(icol,k,i)*babs500(icol,k,i)*deltah
+ abs6703d(icol,k) = abs6703d(icol,k)+Nnatk(icol,k,i)*babs670(icol,k,i)*deltah
+ abs8703d(icol,k) = abs8703d(icol,k)+Nnatk(icol,k,i)*babs870(icol,k,i)*deltah
+ abs5503dalt(icol,k) = abs5503dalt(icol,k)+Nnatk(icol,k,i)*babs550(icol,k,i)*deltah
+ enddo
+ do i=11,14
+ abs4403d(icol,k) = abs4403d(icol,k)+Nnatk(icol,k,i)*babs440n(icol,k,i-10)*deltah
+ abs5003d(icol,k) = abs5003d(icol,k)+Nnatk(icol,k,i)*babs500n(icol,k,i-10)*deltah
+ abs6703d(icol,k) = abs6703d(icol,k)+Nnatk(icol,k,i)*babs670n(icol,k,i-10)*deltah
+ abs8703d(icol,k) = abs8703d(icol,k)+Nnatk(icol,k,i)*babs870n(icol,k,i-10)*deltah
+ abs5503dalt(icol,k) = abs5503dalt(icol,k)+Nnatk(icol,k,i)*babs550n(icol,k,i-10)*deltah
+ enddo
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! optical depths for d<1um and d>1um (r<0.5um and r>0.5um)
+!SS
+ dod5503dlt1_ss(icol,k) = besslt1(icol,k)*deltah
+ dod5503dgt1_ss(icol,k) = bessgt1(icol,k)*deltah
+!DUST
+ dod5503dlt1_dust(icol,k) = bedustlt1(icol,k)*deltah
+ dod5503dgt1_dust(icol,k) = bedustgt1(icol,k)*deltah
+
+!soa: *(1-v_soana) for the sulfate volume fraction of mode 1
+ dod5503dlt1_so4(icol,k) = (bes4lt1t(icol,k) & ! condensate
+ + Nnatk(icol,k,1)*bebglt1(icol,k,1)*(1.0_r8-v_soana(icol,k)) & ! background, SO4(Ait) mode (1)
+ + Nnatk(icol,k,5)*bebglt1(icol,k,5))*deltah ! background, SO4(Ait75) mode (5)
+ dod5503dgt1_so4(icol,k) = (bes4gt1t(icol,k) & ! condensate + n-mode (11)
+ + Nnatk(icol,k,1)*bebggt1(icol,k,1)*(1.0_r8-v_soana(icol,k)) & ! background, SO4(Ait) mode (1)
+ + Nnatk(icol,k,5)*bebggt1(icol,k,5))*deltah ! background, SO4(Ait75) mode (5)
+!BC
+ dod5503dlt1_bc(icol,k) = (bebclt1t(icol,k)+bbclt1xt(icol,k) & ! coagulated + n-mode BC (12)
+ + Nnatk(icol,k,2)*bebglt1(icol,k,2) & ! background, BC(Ait) mode (2)
+ + vaitbc*Nnatk(icol,k,4)*bebglt1(icol,k,4) & ! background in OC&BC(Ait) mode (4)
+ + Nnatk(icol,k,0)*bebglt1(icol,k,0))*deltah ! background, BC(ax) mode (0)
+ dod5503dgt1_bc(icol,k) = (bebcgt1t(icol,k)+bbcgt1xt(icol,k) & ! coagulated + n-mode BC (12)
+ + Nnatk(icol,k,2)*bebggt1(icol,k,2) & ! background, BC(Ait) mode (2)
+ + vaitbc*Nnatk(icol,k,4)*bebggt1(icol,k,4) & ! background in OC&BC(Ait) mode (4)
+ + Nnatk(icol,k,0)*bebggt1(icol,k,0))*deltah ! background, BC(ax) mode (0)
+!OC
+!soa + v_soana part of mode 11 for the OC volume fraction of that mode
+ dod5503dlt1_pom(icol,k) = (beoclt1t(icol,k)+boclt1xt(icol,k) & ! coagulated + n-mode OC&BC (14)
+ + Nnatk(icol,k,1)*bebglt1(icol,k,1)*v_soana(icol,k) & ! SOA fraction of mode 1
+!-3 + Nnatk(icol,k,3)*bebglt1(icol,k,3) & ! background, OC(Ait) mode (3)
+ + (1.0_r8-vaitbc)*Nnatk(icol,k,4)*bebglt1(icol,k,4))*deltah ! background in OC&BC(Ait) mode (4)
+ dod5503dgt1_pom(icol,k) = (beocgt1t(icol,k)+bocgt1xt(icol,k) & ! coagulated + n-mode OC&OC (14)
+ + Nnatk(icol,k,1)*bebggt1(icol,k,1)*v_soana(icol,k) & ! SOA fraction of mode 1
+!-3 + Nnatk(icol,k,3)*bebggt1(icol,k,3) & ! background, OC(Ait) mode (3)
+ + (1.0_r8-vaitbc)*Nnatk(icol,k,4)*bebggt1(icol,k,4))*deltah ! background in OC&BC(Ait) mode (4)
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+! Column integrated optical depths/abs., total and for each constituent
+ dod440(icol) = dod440(icol)+dod4403d(icol,k)
+ abs440(icol) = abs440(icol)+abs4403d(icol,k)
+ dod500(icol) = dod500(icol)+dod5003d(icol,k)
+ abs500(icol) = abs500(icol)+abs5003d(icol,k)
+ dod550(icol) = dod550(icol)+dod5503d(icol,k)
+ abs550(icol) = abs550(icol)+abs5503d(icol,k)
+ abs550alt(icol) = abs550alt(icol)+abs5503dalt(icol,k)
+ dod670(icol) = dod670(icol)+dod6703d(icol,k)
+ abs670(icol) = abs670(icol)+abs6703d(icol,k)
+ dod870(icol) = dod870(icol)+dod8703d(icol,k)
+ abs870(icol) = abs870(icol)+abs8703d(icol,k)
+! Added abs components
+ abs550_ss(icol) = abs550_ss(icol)+abs5503d_ss(icol,k)
+ abs550_dust(icol) = abs550_dust(icol)+abs5503d_dust(icol,k)
+ abs550_so4(icol) = abs550_so4(icol)+abs5503d_so4(icol,k)
+ abs550_bc(icol) = abs550_bc(icol)+abs5503d_bc(icol,k)
+ abs550_pom(icol) = abs550_pom(icol)+abs5503d_pom(icol,k)
+!
+ dod440_ss(icol) = dod440_ss(icol)+dod4403d_ss(icol,k)
+ dod440_dust(icol) = dod440_dust(icol)+dod4403d_dust(icol,k)
+ dod440_so4(icol) = dod440_so4(icol)+dod4403d_so4(icol,k)
+ dod440_bc(icol) = dod440_bc(icol)+dod4403d_bc(icol,k)
+ dod440_pom(icol) = dod440_pom(icol)+dod4403d_pom(icol,k)
+ dod500_ss(icol) = dod500_ss(icol)+dod5003d_ss(icol,k)
+ dod500_dust(icol) = dod500_dust(icol)+dod5003d_dust(icol,k)
+ dod500_so4(icol) = dod500_so4(icol)+dod5003d_so4(icol,k)
+ dod500_bc(icol) = dod500_bc(icol)+dod5003d_bc(icol,k)
+ dod500_pom(icol) = dod500_pom(icol)+dod5003d_pom(icol,k)
+ dod550_ss(icol) = dod550_ss(icol)+dod5503d_ss(icol,k)
+ dod550_dust(icol) = dod550_dust(icol)+dod5503d_dust(icol,k)
+ dod550_so4(icol) = dod550_so4(icol)+dod5503d_so4(icol,k)
+ dod550_bc(icol) = dod550_bc(icol)+dod5503d_bc(icol,k)
+ dod550_pom(icol) = dod550_pom(icol)+dod5503d_pom(icol,k)
+ dod670_ss(icol) = dod670_ss(icol)+dod6703d_ss(icol,k)
+ dod670_dust(icol) = dod670_dust(icol)+dod6703d_dust(icol,k)
+ dod670_so4(icol) = dod670_so4(icol)+dod6703d_so4(icol,k)
+ dod670_bc(icol) = dod670_bc(icol)+dod6703d_bc(icol,k)
+ dod670_pom(icol) = dod670_pom(icol)+dod6703d_pom(icol,k)
+ dod870_ss(icol) = dod870_ss(icol)+dod8703d_ss(icol,k)
+ dod870_dust(icol) = dod870_dust(icol)+dod8703d_dust(icol,k)
+ dod870_so4(icol) = dod870_so4(icol)+dod8703d_so4(icol,k)
+ dod870_bc(icol) = dod870_bc(icol)+dod8703d_bc(icol,k)
+ dod870_pom(icol) = dod870_pom(icol)+dod8703d_pom(icol,k)
+ dod550lt1_ss(icol) = dod550lt1_ss(icol)+dod5503dlt1_ss(icol,k)
+ dod550gt1_ss(icol) = dod550gt1_ss(icol)+dod5503dgt1_ss(icol,k)
+ dod550lt1_dust(icol) = dod550lt1_dust(icol)+dod5503dlt1_dust(icol,k)
+ dod550gt1_dust(icol) = dod550gt1_dust(icol)+dod5503dgt1_dust(icol,k)
+ dod550lt1_so4(icol) = dod550lt1_so4(icol)+dod5503dlt1_so4(icol,k)
+ dod550gt1_so4(icol) = dod550gt1_so4(icol)+dod5503dgt1_so4(icol,k)
+ dod550lt1_bc(icol) = dod550lt1_bc(icol)+dod5503dlt1_bc(icol,k)
+ dod550gt1_bc(icol) = dod550gt1_bc(icol)+dod5503dgt1_bc(icol,k)
+ dod550lt1_pom(icol) = dod550lt1_pom(icol)+dod5503dlt1_pom(icol,k)
+ dod550gt1_pom(icol) = dod550gt1_pom(icol)+dod5503dgt1_pom(icol,k)
+!ccccccccc1ccccccccc2ccccccccc3ccccccccc4ccccccccc5ccccccccc6ccccccccc7cc
+ enddo ! k
+
+ enddo ! icol
+
+! extinction, absorption (m-1) and backscatter coefficients (m-1 sr-1)
+ call outfld('EC550AER',ec550_aer,pcols,lchnk)
+ call outfld('ABS550_A',abs550_aer,pcols,lchnk)
+ call outfld('BS550AER',bs550_aer,pcols,lchnk)
+!
+! speciated extinction coefficients (m-1)
+ call outfld('EC550SO4',ec550_so4,pcols,lchnk)
+ call outfld('EC550BC ',ec550_bc ,pcols,lchnk)
+ call outfld('EC550POM',ec550_pom,pcols,lchnk)
+ call outfld('EC550SS ',ec550_ss ,pcols,lchnk)
+ call outfld('EC550DU ',ec550_du ,pcols,lchnk)
+!
+! optical depths and absorption as requested by AeroCom
+! notation: 3=3D, D=DOD, A=ABS, LT=d<1um, GT=d>1um
+ call outfld('DOD440 ',dod440 ,pcols,lchnk)
+ call outfld('ABS440 ',abs440 ,pcols,lchnk)
+ call outfld('DOD500 ',dod500 ,pcols,lchnk)
+ call outfld('ABS500 ',abs500 ,pcols,lchnk)
+ call outfld('DOD550 ',dod550 ,pcols,lchnk)
+ call outfld('ABS550 ',abs550 ,pcols,lchnk)
+ call outfld('ABS550AL',abs550alt,pcols,lchnk)
+ call outfld('DOD670 ',dod670 ,pcols,lchnk)
+ call outfld('ABS670 ',abs670 ,pcols,lchnk)
+ call outfld('DOD870 ',dod870 ,pcols,lchnk)
+ call outfld('ABS870 ',abs870 ,pcols,lchnk)
+ call outfld('A550_SS ',abs550_ss ,pcols,lchnk)
+ call outfld('A550_DU ',abs550_dust,pcols,lchnk)
+ call outfld('A550_SO4',abs550_so4 ,pcols,lchnk)
+ call outfld('A550_BC ',abs550_bc ,pcols,lchnk)
+ call outfld('A550_POM',abs550_pom ,pcols,lchnk)
+!
+ call outfld('D440_SS ',dod440_ss ,pcols,lchnk)
+ call outfld('D440_DU ',dod440_dust,pcols,lchnk)
+ call outfld('D440_SO4',dod440_so4 ,pcols,lchnk)
+ call outfld('D440_BC ',dod440_bc ,pcols,lchnk)
+ call outfld('D440_POM',dod440_pom ,pcols,lchnk)
+ call outfld('D500_SS ',dod500_ss ,pcols,lchnk)
+ call outfld('D500_DU ',dod500_dust,pcols,lchnk)
+ call outfld('D500_SO4',dod500_so4 ,pcols,lchnk)
+ call outfld('D500_BC ',dod500_bc ,pcols,lchnk)
+ call outfld('D500_POM',dod500_pom ,pcols,lchnk)
+ call outfld('D550_SS ',dod550_ss ,pcols,lchnk)
+ call outfld('D550_DU ',dod550_dust,pcols,lchnk)
+ call outfld('D550_SO4',dod550_so4 ,pcols,lchnk)
+ call outfld('D550_BC ',dod550_bc ,pcols,lchnk)
+ call outfld('D550_POM',dod550_pom ,pcols,lchnk)
+ call outfld('D670_SS ',dod670_ss ,pcols,lchnk)
+ call outfld('D670_DU ',dod670_dust,pcols,lchnk)
+ call outfld('D670_SO4',dod670_so4 ,pcols,lchnk)
+ call outfld('D670_BC ',dod670_bc ,pcols,lchnk)
+ call outfld('D670_POM',dod670_pom ,pcols,lchnk)
+ call outfld('D870_SS ',dod870_ss ,pcols,lchnk)
+ call outfld('D870_DU ',dod870_dust,pcols,lchnk)
+ call outfld('D870_SO4',dod870_so4 ,pcols,lchnk)
+ call outfld('D870_BC ',dod870_bc ,pcols,lchnk)
+ call outfld('D870_POM',dod870_pom ,pcols,lchnk)
+ call outfld('DLT_SS ',dod550lt1_ss,pcols,lchnk)
+ call outfld('DGT_SS ',dod550gt1_ss,pcols,lchnk)
+ call outfld('DLT_DUST',dod550lt1_dust,pcols,lchnk)
+ call outfld('DGT_DUST',dod550gt1_dust,pcols,lchnk)
+ call outfld('DLT_SO4 ',dod550lt1_so4,pcols,lchnk)
+ call outfld('DGT_SO4 ',dod550gt1_so4,pcols,lchnk)
+ call outfld('DLT_BC ',dod550lt1_bc,pcols,lchnk)
+ call outfld('DGT_BC ',dod550gt1_bc,pcols,lchnk)
+ call outfld('DLT_POM ',dod550lt1_pom,pcols,lchnk)
+ call outfld('DGT_POM ',dod550gt1_pom,pcols,lchnk)
+!tst
+! call outfld('DOD5503D',dod5503d,pcols,lchnk)
+!tst
+!- call outfld('ABS5503D',abs5503d,pcols,lchnk)
+!- call outfld('D443_SS ',dod4403d_ss ,pcols,lchnk)
+!- call outfld('D443_DU ',dod4403d_dust,pcols,lchnk)
+!- call outfld('D443_SO4',dod4403d_so4 ,pcols,lchnk)
+!- call outfld('D443_BC ',dod4403d_bc ,pcols,lchnk)
+!- call outfld('D443_POM',dod4403d_pom ,pcols,lchnk)
+!- call outfld('D503_SS ',dod5003d_ss ,pcols,lchnk)
+!- call outfld('D503_DU ',dod5003d_dust,pcols,lchnk)
+!- call outfld('D503_SO4',dod5003d_so4 ,pcols,lchnk)
+!- call outfld('D503_BC ',dod5003d_bc ,pcols,lchnk)
+!- call outfld('D503_POM',dod5003d_pom ,pcols,lchnk)
+!- call outfld('D553_SS ',dod5503d_ss ,pcols,lchnk)
+!- call outfld('D553_DU ',dod5503d_dust,pcols,lchnk)
+!- call outfld('D553_SO4',dod5503d_so4 ,pcols,lchnk)
+!- call outfld('D553_BC ',dod5503d_bc ,pcols,lchnk)
+!- call outfld('D553_POM',dod5503d_pom ,pcols,lchnk)
+!- call outfld('D673_SS ',dod6703d_ss ,pcols,lchnk)
+!- call outfld('D673_DU ',dod6703d_dust,pcols,lchnk)
+!- call outfld('D673_SO4',dod6703d_so4 ,pcols,lchnk)
+!- call outfld('D673_BC ',dod6703d_bc ,pcols,lchnk)
+!- call outfld('D673_POM',dod6703d_pom ,pcols,lchnk)
+!- call outfld('D873_SS ',dod8703d_ss ,pcols,lchnk)
+!- call outfld('D873_DU ',dod8703d_dust,pcols,lchnk)
+!- call outfld('D873_SO4',dod8703d_so4 ,pcols,lchnk)
+!- call outfld('D873_BC ',dod8703d_bc ,pcols,lchnk)
+!- call outfld('D873_POM',dod8703d_pom ,pcols,lchnk)
+
+
+!000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+! Dry parameters of each aerosol component
+! BC(ax) mode
+ call intdrypar0(lchnk, ncol, Nnatk, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol,&
+ cknorm,cknlt05,ckngt125)
+! SO4&SOA(Ait,n) mode
+ call intdrypar1(lchnk, ncol, Nnatk, xfombg, ifombg1, &
+ xct, ict1, xfac, ifac1, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol,&
+ aaerosn,aaeroln,vaerosn,vaeroln,cknorm,cknlt05,ckngt125)
+! BC(Ait,n) and OC(Ait,n) modes
+ call intdrypar2to3(lchnk, ncol, Nnatk, xct, ict1, xfac, ifac1, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol,&
+ aaerosn,aaeroln,vaerosn,vaeroln,cknorm,cknlt05,ckngt125)
+! BC&OC(Ait,n) mode ------ fcm not valid here (=0). Use faitbc or fnbc instead
+ call intdrypar4(lchnk, ncol, Nnatk, &
+ xfbcbg, ifbcbg1, xfbcbgn, ifbcbgn1, &
+ xct, ict1, xfac, ifac1, xfaq, ifaq1, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol, &
+ aaerosn,aaeroln,vaerosn,vaeroln,cknorm,cknlt05,ckngt125)
+! SO4(Ait75) (5), mineral (6-7) and Sea-salt (8-10) modes:
+ call intdrypar5to10(lchnk, ncol, Nnatk, &
+ xct, ict1, xfac, ifac1, xfbc, ifbc1, xfaq, ifaq1, &
+ cintbg, cintbg05, cintbg125, cintbc, cintbc05, cintbc125, &
+ cintoc, cintoc05, cintoc125, cintsc, cintsc05, cintsc125, &
+ cintsa, cintsa05, cintsa125, aaeros, aaerol, vaeros, vaerol,&
+ cknorm,cknlt05,ckngt125)
+
+ do k=1,pver
+ do icol=1,ncol
+ c_ss(icol,k)=0.0_r8
+ c_mi(icol,k)=0.0_r8
+ enddo
+ enddo
+
+ do k=1,pver
+ do icol=1,ncol
+! mineral and sea-salt background concentrations, internally mixed
+ c_mi(icol,k) = Nnatk(icol,k,6)*cintbg(icol,k,6) &
+ +Nnatk(icol,k,7)*cintbg(icol,k,7)
+ c_mi05(icol,k) = Nnatk(icol,k,6)*cintbg05(icol,k,6) &
+ +Nnatk(icol,k,7)*cintbg05(icol,k,7)
+ c_mi125(icol,k) = Nnatk(icol,k,6)*cintbg125(icol,k,6)&
+ +Nnatk(icol,k,7)*cintbg125(icol,k,7)
+ c_ss(icol,k) = Nnatk(icol,k,8)*cintbg(icol,k,8) &
+ +Nnatk(icol,k,9)*cintbg(icol,k,9) &
+ +Nnatk(icol,k,10)*cintbg(icol,k,10)
+ c_ss05(icol,k) = Nnatk(icol,k,8)*cintbg05(icol,k,8) &
+ +Nnatk(icol,k,9)*cintbg05(icol,k,9) &
+ +Nnatk(icol,k,10)*cintbg05(icol,k,10)
+ c_ss125(icol,k) = Nnatk(icol,k,8)*cintbg125(icol,k,8)&
+ +Nnatk(icol,k,9)*cintbg125(icol,k,9) &
+ +Nnatk(icol,k,10)*cintbg125(icol,k,10)
+! internally mixed bc and oc (from coagulation) and so4 concentrations
+! (sa=so4(aq) and sc=so4(cond+coag), separated because of different density:
+! necessary for calculation of volume fractions!), and total aerosol surface
+! areas and volumes.
+ c_bc(icol,k)=0.0_r8
+ c_bc05(icol,k)=0.0_r8
+ c_bc125(icol,k)=0.0_r8
+ c_oc(icol,k)=0.0_r8
+ c_oc05(icol,k)=0.0_r8
+ c_oc125(icol,k)=0.0_r8
+ c_s4(icol,k)=0.0_r8
+ c_s4_a(icol,k)=0.0_r8
+ c_s4_1(icol,k)=0.0_r8
+ c_s4_5(icol,k)=0.0_r8
+ c_sa(icol,k)=0.0_r8
+ c_sa05(icol,k)=0.0_r8
+ c_sa125(icol,k)=0.0_r8
+ c_sc(icol,k)=0.0_r8
+ c_sc05(icol,k)=0.0_r8
+ c_sc125(icol,k)=0.0_r8
+ aaeros_tot(icol,k)=0.0_r8
+ aaerol_tot(icol,k)=0.0_r8
+ vaeros_tot(icol,k)=0.0_r8
+ vaerol_tot(icol,k)=0.0_r8
+ c_bc_0(icol,k)=0.0_r8
+ c_bc_2(icol,k)=0.0_r8
+ c_bc_4(icol,k)=0.0_r8
+ c_bc_12(icol,k)=0.0_r8
+ c_bc_14(icol,k)=0.0_r8
+ c_oc_4(icol,k)=0.0_r8
+ c_oc_14(icol,k)=0.0_r8
+!akc6+
+ c_tot(icol,k)=0.0_r8
+ c_tot125(icol,k)=0.0_r8
+ c_tot05(icol,k)=0.0_r8
+ c_pm25(icol,k)=0.0_r8
+ c_pm1(icol,k)=0.0_r8
+ mmr_pm25(icol,k)=0.0_r8
+ mmr_pm1(icol,k)=0.0_r8
+!akc6-
+
+ do i=0,nbmodes
+ if(i.ne.3) then
+ c_bc(icol,k) = c_bc(icol,k) &
+ +Nnatk(icol,k,i)*cintbc(icol,k,i)
+ c_bc05(icol,k) = c_bc05(icol,k) &
+ +Nnatk(icol,k,i)*cintbc05(icol,k,i)
+ c_bc125(icol,k) = c_bc125(icol,k) &
+ +Nnatk(icol,k,i)*cintbc125(icol,k,i)
+ c_oc(icol,k) = c_oc(icol,k) &
+ +Nnatk(icol,k,i)*cintoc(icol,k,i)
+ c_oc05(icol,k) = c_oc05(icol,k) &
+ +Nnatk(icol,k,i)*cintoc05(icol,k,i)
+ c_oc125(icol,k) = c_oc125(icol,k) &
+ +Nnatk(icol,k,i)*cintoc125(icol,k,i)
+ c_sa(icol,k) = c_sa(icol,k) &
+ +Nnatk(icol,k,i)*cintsa(icol,k,i)
+ c_sa05(icol,k) = c_sa05(icol,k) &
+ +Nnatk(icol,k,i)*cintsa05(icol,k,i)
+ c_sa125(icol,k) = c_sa125(icol,k) &
+ +Nnatk(icol,k,i)*cintsa125(icol,k,i)
+ c_sc(icol,k) = c_sc(icol,k) &
+ +Nnatk(icol,k,i)*cintsc(icol,k,i)
+ c_sc05(icol,k) = c_sc05(icol,k) &
+ +Nnatk(icol,k,i)*cintsc05(icol,k,i)
+ c_sc125(icol,k) = c_sc125(icol,k) &
+ +Nnatk(icol,k,i)*cintsc125(icol,k,i)
+ aaeros_tot(icol,k) = aaeros_tot(icol,k) &
+ +Nnatk(icol,k,i)*aaeros(icol,k,i)
+ aaerol_tot(icol,k) = aaerol_tot(icol,k) &
+ +Nnatk(icol,k,i)*aaerol(icol,k,i)
+ vaeros_tot(icol,k) =vaeros_tot(icol,k) &
+ +Nnatk(icol,k,i)*vaeros(icol,k,i)
+ vaerol_tot(icol,k) = vaerol_tot(icol,k) &
+ +Nnatk(icol,k,i)*vaerol(icol,k,i)
+ endif
+ enddo
+! add dry aerosol area and volume of externally mixed modes
+ do i=nbmp1,nmodes
+ aaeros_tot(icol,k) = aaeros_tot(icol,k) &
+ +Nnatk(icol,k,i)*aaerosn(icol,k,i)
+ aaerol_tot(icol,k) = aaerol_tot(icol,k) &
+ +Nnatk(icol,k,i)*aaeroln(icol,k,i)
+ vaeros_tot(icol,k) =vaeros_tot(icol,k) &
+ +Nnatk(icol,k,i)*vaerosn(icol,k,i)
+ vaerol_tot(icol,k) = vaerol_tot(icol,k) &
+ +Nnatk(icol,k,i)*vaeroln(icol,k,i)
+ end do
+!c_er3d
+! Effective radii for particles smaller and greater than 0.5um,
+! and for all radii, in each layer (er=3*V/A):
+ erlt053d(icol,k)=3.0_r8*vaeros_tot(icol,k) &
+ /(aaeros_tot(icol,k)+eps)
+ ergt053d(icol,k)=3.0_r8*vaerol_tot(icol,k) &
+ /(aaerol_tot(icol,k)+eps)
+ er3d(icol,k)=3.0_r8*(vaeros_tot(icol,k)+vaerol_tot(icol,k)) &
+ /(aaeros_tot(icol,k)+aaerol_tot(icol,k)+eps)
+!c_er3d
+! column integrated dry aerosol surface areas and volumes
+! for r<0.5um and r>0.5um (s and l, respectively).
+ aaercols(icol)=aaercols(icol)+aaeros_tot(icol,k)
+ aaercoll(icol)=aaercoll(icol)+aaerol_tot(icol,k)
+ vaercols(icol)=vaercols(icol)+vaeros_tot(icol,k)
+ vaercoll(icol)=vaercoll(icol)+vaerol_tot(icol,k)
+! then add background and externally mixed BC, OC and SO4 to mass concentrations
+ c_bc_ac(icol,k)= c_bc(icol,k)
+ c_bc_0(icol,k) = Nnatk(icol,k,0)*cintbg(icol,k,0)
+ c_bc_2(icol,k) = Nnatk(icol,k,2)*cintbg(icol,k,2)
+ c_bc_4(icol,k) = Nnatk(icol,k,4)*cintbg(icol,k,4)*faitbc(icol,k)
+ c_bc_12(icol,k)= Nnatk(icol,k,12)*cknorm(icol,k,12)
+ c_bc_14(icol,k)= Nnatk(icol,k,14)*cknorm(icol,k,14)*fnbc(icol,k)
+ c_bc(icol,k) = c_bc(icol,k) &
+ +Nnatk(icol,k,2)*cintbg(icol,k,2) &
+ +Nnatk(icol,k,4)*cintbg(icol,k,4)*faitbc(icol,k) &
+ +Nnatk(icol,k,0)*cintbg(icol,k,0) &
+ +Nnatk(icol,k,12)*cknorm(icol,k,12) &
+ +Nnatk(icol,k,14)*cknorm(icol,k,14)*fnbc(icol,k)
+ c_bc05(icol,k) = c_bc05(icol,k) &
+ +Nnatk(icol,k,2)*cintbg05(icol,k,2) &
+ +Nnatk(icol,k,4)*cintbg05(icol,k,4)*faitbc(icol,k) &
+ +Nnatk(icol,k,0)*cintbg05(icol,k,0) &
+ +Nnatk(icol,k,12)*cknlt05(icol,k,12) &
+ +Nnatk(icol,k,14)*cknlt05(icol,k,14)*fnbc(icol,k)
+ c_bc125(icol,k) = c_bc125(icol,k) &
+ +Nnatk(icol,k,2)*cintbg125(icol,k,2) &
+ +Nnatk(icol,k,4)*cintbg125(icol,k,4)*faitbc(icol,k) &
+ +Nnatk(icol,k,0)*cintbg125(icol,k,0) &
+ +Nnatk(icol,k,12)*ckngt125(icol,k,12) &
+ +Nnatk(icol,k,14)*ckngt125(icol,k,14)*fnbc(icol,k)
+ c_oc_ac(icol,k)= c_oc(icol,k)
+ c_oc_4(icol,k) = Nnatk(icol,k,4)*cintbg(icol,k,4)*(1.0_r8-faitbc(icol,k))
+ c_oc_14(icol,k) = Nnatk(icol,k,14)*cknorm(icol,k,14)*(1.0_r8-fnbc(icol,k))
+ c_oc(icol,k) = c_oc(icol,k) &
+ +Nnatk(icol,k,1)*cintbg(icol,k,1)*f_soana(icol,k) &
+!-3 +Nnatk(icol,k,3)*cintbg(icol,k,3) &
+ +Nnatk(icol,k,4)*cintbg(icol,k,4)*(1.0_r8-faitbc(icol,k)) &
+ +Nnatk(icol,k,14)*cknorm(icol,k,14)*(1.0_r8-fnbc(icol,k))
+ c_oc05(icol,k) = c_oc05(icol,k) &
+ +Nnatk(icol,k,1)*cintbg05(icol,k,1)*f_soana(icol,k) &
+!-3 +Nnatk(icol,k,3)*cintbg05(icol,k,3) &
+ +Nnatk(icol,k,4)*cintbg05(icol,k,4)*(1.0_r8-faitbc(icol,k)) &
+ +Nnatk(icol,k,14)*cknlt05(icol,k,14)*(1.0_r8-fnbc(icol,k))
+ c_oc125(icol,k) = c_oc125(icol,k) &
+ +Nnatk(icol,k,1)*cintbg125(icol,k,1)*f_soana(icol,k) &
+!-3 +Nnatk(icol,k,3)*cintbg125(icol,k,3) &
+ +Nnatk(icol,k,4)*cintbg125(icol,k,4)*(1.0_r8-faitbc(icol,k)) &
+ +Nnatk(icol,k,14)*ckngt125(icol,k,14)*(1.0_r8-fnbc(icol,k))
+ c_s4(icol,k) = c_sa(icol,k)+c_sc(icol,k) &
+ +Nnatk(icol,k,1)*cintbg(icol,k,1)*(1.0_r8-f_soana(icol,k)) &
+ +Nnatk(icol,k,5)*cintbg(icol,k,5)
+ c_s405(icol,k) = c_sa05(icol,k)+c_sc05(icol,k) &
+ +Nnatk(icol,k,1)*cintbg05(icol,k,1)*(1.0_r8-f_soana(icol,k)) &
+ +Nnatk(icol,k,5)*cintbg05(icol,k,5)
+ c_s4125(icol,k) = c_sa125(icol,k)+c_sc125(icol,k) &
+ +Nnatk(icol,k,1)*cintbg125(icol,k,1)*(1.0_r8-f_soana(icol,k)) &
+ +Nnatk(icol,k,5)*cintbg125(icol,k,5)
+
+!akc6+
+ c_tot(icol,k) = c_s4(icol,k) + c_oc(icol,k) + c_bc(icol,k) &
+ + c_mi(icol,k) + c_ss(icol,k)
+ c_tot125(icol,k) = c_s4125(icol,k) + c_oc125(icol,k) + c_bc125(icol,k) &
+ + c_mi125(icol,k) + c_ss125(icol,k)
+ c_tot05(icol,k) = c_s405(icol,k) + c_oc05(icol,k) + c_bc05(icol,k) &
+ + c_mi05(icol,k) + c_ss05(icol,k)
+ c_pm25(icol,k) = c_tot(icol,k) - c_tot125(icol,k)
+ c_pm1(icol,k) = c_tot05(icol,k)
+! mass mixing ratio:
+ mmr_pm25(icol,k) = 1.e-9*c_pm25(icol,k)/rhoda(icol,k)
+ mmr_pm1(icol,k) = 1.e-9*c_pm1(icol,k)/rhoda(icol,k)
+!akc6-
+
+! converting from S to SO4 concentrations is no longer necessary, since
+! sc=H2SO4 and sa=(NH4)2SO4 now, not SO4 as in CAM4-Oslo
+! c_s4(icol,k)=c_s4(icol,k)/3._r8
+! c_s405(icol,k)=c_s405(icol,k)/3._r8
+! c_s4125(icol,k)=c_s4125(icol,k)/3._r8
+
+ c_s4_a(icol,k) = c_sa(icol,k)+c_sc(icol,k)
+ c_s4_1(icol,k) = Nnatk(icol,k,1)*cintbg(icol,k,1)*(1.0_r8-f_soana(icol,k))
+ c_s4_5(icol,k) = Nnatk(icol,k,5)*cintbg05(icol,k,5)
+
+ end do ! icol
+ enddo ! k
+
+! Total PM and PM2.5 (dry r>1.25um), surface values (ug/m3)
+ do icol=1,ncol
+! c_tots(icol) = c_s4(icol,pver) + c_oc(icol,pver) + c_bc(icol,pver) &
+! + c_mi(icol,pver) + c_ss(icol,pver)
+! c_tot125s(icol) = c_s4125(icol,pver) + c_oc125(icol,pver) + c_bc125(icol,pver) &
+! + c_mi125(icol,pver) + c_ss125(icol,pver)
+! c_pm25s(icol) = c_tots(icol) - c_tot125s(icol)
+!akc6+
+ c_tots(icol) = c_tot(icol,pver)
+ c_tot125s(icol) = c_tot125(icol,pver)
+ c_pm25s(icol) = c_pm25(icol,pver)
+!akc6-
+ enddo
+
+! Effective, column integrated, radii for particles
+! smaller and greater than 0.5um, and for all radii
+ do icol=1,ncol
+ derlt05(icol)=3.0_r8*vaercols(icol)/(aaercols(icol)+eps)
+ dergt05(icol)=3.0_r8*vaercoll(icol)/(aaercoll(icol)+eps)
+ der(icol)=3.0_r8*(vaercols(icol)+vaercoll(icol)) &
+ /(aaercols(icol)+aaercoll(icol)+eps)
+ enddo
+
+ do icol=1,ncol
+ dload_s4(icol)=0.0_r8
+ dload_s4_a(icol)=0.0_r8
+ dload_s4_1(icol)=0.0_r8
+ dload_s4_5(icol)=0.0_r8
+ dload_oc(icol)=0.0_r8
+ dload_bc(icol)=0.0_r8
+ dload_bc_ac(icol)=0.0_r8
+ dload_bc_0(icol)=0.0_r8
+ dload_bc_2(icol)=0.0_r8
+ dload_bc_4(icol)=0.0_r8
+ dload_bc_12(icol)=0.0_r8
+ dload_bc_14(icol)=0.0_r8
+ dload_oc_ac(icol)=0.0_r8
+ dload_oc_4(icol)=0.0_r8
+ dload_oc_14(icol)=0.0_r8
+ do k=1,pver
+! Layer thickness, unit km
+!- deltah=1.e-4_r8*(pint(icol,k+1)-pint(icol,k))/(rhoda(icol,k)*9.8_r8)
+ deltah=deltah_km(icol,k)
+! Modal and total mass concentrations for clean and dry aerosol,
+! i.e. not including coag./cond./Aq. BC,OC,SO4 or condensed water.
+! Units: ug/m3 for concentrations and mg/m2 (--> kg/m2 later) for mass loading.
+ do i=0,nmodes
+ ck(icol,k,i)=cknorm(icol,k,i)*Nnatk(icol,k,i)
+ dload3d(icol,k,i)=ck(icol,k,i)*deltah
+ dload(icol,i)=dload(icol,i)+dload3d(icol,k,i)
+ enddo
+ nnat_0(icol,k) =Nnatk(icol,k,0)
+ nnat_1(icol,k) =Nnatk(icol,k,1)
+ nnat_2(icol,k) =Nnatk(icol,k,2)
+ nnat_4(icol,k) =Nnatk(icol,k,4)
+ nnat_5(icol,k) =Nnatk(icol,k,5)
+ nnat_6(icol,k) =Nnatk(icol,k,6)
+ nnat_7(icol,k) =Nnatk(icol,k,7)
+ nnat_8(icol,k) =Nnatk(icol,k,8)
+ nnat_9(icol,k) =Nnatk(icol,k,9)
+ nnat_10(icol,k)=Nnatk(icol,k,10)
+ nnat_12(icol,k)=Nnatk(icol,k,12)
+ nnat_14(icol,k)=Nnatk(icol,k,14)
+! mineral and sea-salt mass concentrations
+ cmin(icol,k)=ck(icol,k,6)+ck(icol,k,7)
+ cseas(icol,k)=ck(icol,k,8)+ck(icol,k,9)+ck(icol,k,10)
+! Aerocom: Condensed water loading (mg_m2)
+ daerh2o(icol)=daerh2o(icol)+Cwater(icol,k)*deltah
+! just for checking purposes:
+ dload_s4(icol)=dload_s4(icol)+c_s4(icol,k)*deltah
+ dload_s4_a(icol)=dload_s4_a(icol)+c_s4_a(icol,k)*deltah
+ dload_s4_1(icol)=dload_s4_1(icol)+c_s4_1(icol,k)*deltah
+ dload_s4_5(icol)=dload_s4_5(icol)+c_s4_5(icol,k)*deltah
+ dload_oc(icol)=dload_oc(icol)+c_oc(icol,k)*deltah
+ dload_bc(icol)=dload_bc(icol)+c_bc(icol,k)*deltah
+!
+ dload_bc_ac(icol)=dload_bc_ac(icol)+c_bc_ac(icol,k)*deltah
+ dload_bc_0(icol)=dload_bc_0(icol)+c_bc_0(icol,k)*deltah
+ dload_bc_2(icol)=dload_bc_2(icol)+c_bc_2(icol,k)*deltah
+ dload_bc_4(icol)=dload_bc_4(icol)+c_bc_4(icol,k)*deltah
+ dload_bc_12(icol)=dload_bc_12(icol)+c_bc_12(icol,k)*deltah
+ dload_bc_14(icol)=dload_bc_14(icol)+c_bc_14(icol,k)*deltah
+ dload_oc_ac(icol)=dload_oc_ac(icol)+c_oc_ac(icol,k)*deltah
+ dload_oc_4(icol)=dload_oc_4(icol)+c_oc_4(icol,k)*deltah
+ dload_oc_14(icol)=dload_oc_14(icol)+c_oc_14(icol,k)*deltah
+!
+ end do ! k
+ dload_mi(icol)=dload(icol,6)+dload(icol,7)
+ dload_ss(icol)=dload(icol,8)+dload(icol,9)+dload(icol,10)
+ end do ! icol
+
+#ifdef COLTST4INTCONS
+! Testing column burdens for internal consistency between intdrypar*
+! (use of aerodryk*.out look-up tables) and calculations directly
+! from the qm1 array. Will only work with #define AEROCOM.
+!
+ call coltst4intcons (lchnk, ncol, qm1, deltah_km, rhoda, fnbc, &
+ dload_mi, dload_ss, dload_s4, dload_oc, dload_bc, &
+ dload_bc_0, dload_bc_2, dload_bc_4, dload_bc_12, dload_bc_14, dload_bc_ac, &
+ dload_oc_4, dload_oc_14, dload_oc_ac, dload_s4_a, dload_s4_1, dload_s4_5)
+!
+#ifdef AEROCOM
+ call outfld('CMDRY0 ',cmdry0 ,pcols,lchnk)
+ call outfld('CMDRY1 ',cmdry1 ,pcols,lchnk)
+ call outfld('CMDRY2 ',cmdry2 ,pcols,lchnk)
+ call outfld('CMDRY4 ',cmdry4 ,pcols,lchnk)
+ call outfld('CMDRY5 ',cmdry5 ,pcols,lchnk)
+ call outfld('CMDRY6 ',cmdry6 ,pcols,lchnk)
+ call outfld('CMDRY7 ',cmdry7 ,pcols,lchnk)
+ call outfld('CMDRY8 ',cmdry8 ,pcols,lchnk)
+ call outfld('CMDRY9 ',cmdry9 ,pcols,lchnk)
+ call outfld('CMDRY10 ',cmdry10 ,pcols,lchnk)
+ call outfld('CMDRY12 ',cmdry12 ,pcols,lchnk)
+ call outfld('CMDRY14 ',cmdry14 ,pcols,lchnk)
+#endif
+#endif ! COLTST4INTCONS
+
+! Internally and externally mixed dry concentrations (ug/m3) of
+! SO4, BC and OC, for all r, r<0.5um and r>1.25um...
+! call outfld('C_BCPM ',c_bc ,pcols,lchnk)
+! call outfld('C_BC05 ',c_bc05 ,pcols,lchnk)
+! call outfld('C_BC125 ',c_bc125,pcols,lchnk)
+! call outfld('C_OCPM ',c_oc ,pcols,lchnk)
+! call outfld('C_OC05 ',c_oc05 ,pcols,lchnk)
+! call outfld('C_OC125 ',c_oc125,pcols,lchnk)
+! call outfld('C_S4PM ',c_s4 ,pcols,lchnk)
+! call outfld('C_S405 ',c_s405 ,pcols,lchnk)
+! call outfld('C_S4125 ',c_s4125,pcols,lchnk)
+! ... and of background components for all r, r<0.5um and r>1.25um
+! call outfld('C_MIPM ',c_mi ,pcols,lchnk)
+! call outfld('C_MI05 ',c_mi05 ,pcols,lchnk)
+! call outfld('C_MI125 ',c_mi125,pcols,lchnk)
+! call outfld('C_SSPM ',c_ss ,pcols,lchnk)
+! call outfld('C_SS05 ',c_ss05 ,pcols,lchnk)
+! call outfld('C_SS125 ',c_ss125,pcols,lchnk)
+ call outfld('PMTOT ',c_tots ,pcols,lchnk)
+ call outfld('PM25 ',c_pm25s ,pcols,lchnk)
+!akc6+
+ call outfld('PM2P5 ',c_pm25 ,pcols,lchnk)
+ call outfld('MMRPM2P5',mmr_pm25,pcols,lchnk)
+ call outfld('MMRPM1 ',mmr_pm1 ,pcols,lchnk)
+ call outfld('MMRPM2P5_SRF',mmr_pm25(:pcols,pver),pcols,lchnk)
+!akc6-
+! total (all r) dry concentrations (ug/m3) and loadings (mg/m2)
+ call outfld('DLOAD_MI',dload_mi,pcols,lchnk)
+ call outfld('DLOAD_SS',dload_ss,pcols,lchnk)
+ call outfld('DLOAD_S4',dload_s4,pcols,lchnk)
+ call outfld('DLOAD_OC',dload_oc,pcols,lchnk)
+ call outfld('DLOAD_BC',dload_bc,pcols,lchnk)
+
+ call outfld('LOADBCAC',dload_bc_ac,pcols,lchnk)
+ call outfld('LOADBC0 ',dload_bc_0,pcols,lchnk)
+ call outfld('LOADBC2 ',dload_bc_2,pcols,lchnk)
+ call outfld('LOADBC4 ',dload_bc_4,pcols,lchnk)
+ call outfld('LOADBC12',dload_bc_12,pcols,lchnk)
+ call outfld('LOADBC14',dload_bc_14,pcols,lchnk)
+ call outfld('LOADOCAC',dload_oc_ac,pcols,lchnk)
+ call outfld('LOADOC4 ',dload_oc_4,pcols,lchnk)
+ call outfld('LOADOC14',dload_oc_14,pcols,lchnk)
+! condensed water mmr (kg/kg)
+ call outfld('MMR_AH2O',mmr_aerh2o,pcols,lchnk)
+! condensed water loading (mg/m2)
+ call outfld('DAERH2O ',daerh2o ,pcols,lchnk)
+! number concentrations (1/cm3)
+ call outfld('NNAT_0 ',nnat_0 ,pcols,lchnk)
+ call outfld('NNAT_1 ',nnat_1 ,pcols,lchnk)
+ call outfld('NNAT_2 ',nnat_2 ,pcols,lchnk)
+!=0 call outfld('NNAT_3 ',nnat_3 ,pcols,lchnk)
+ call outfld('NNAT_4 ',nnat_4 ,pcols,lchnk)
+ call outfld('NNAT_5 ',nnat_5 ,pcols,lchnk)
+ call outfld('NNAT_6 ',nnat_6 ,pcols,lchnk)
+ call outfld('NNAT_7 ',nnat_7 ,pcols,lchnk)
+ call outfld('NNAT_8 ',nnat_8 ,pcols,lchnk)
+ call outfld('NNAT_9 ',nnat_9 ,pcols,lchnk)
+ call outfld('NNAT_10 ',nnat_10,pcols,lchnk)
+!=0 call outfld('NNAT_11 ',nnat_11,pcols,lchnk)
+ call outfld('NNAT_12 ',nnat_12,pcols,lchnk)
+!=0 call outfld('NNAT_13 ',nnat_13,pcols,lchnk)
+ call outfld('NNAT_14 ',nnat_14,pcols,lchnk)
+!akc6 call outfld('AIRMASSL',airmassl,pcols,lchnk)
+ call outfld('AIRMASSL',airmassl,pcols,lchnk)
+ call outfld('AIRMASS ',airmass,pcols,lchnk) !akc6
+
+!c_er3d
+! effective dry radii (um) in each layer
+! call outfld('ERLT053D',erlt053d,pcols,lchnk)
+! call outfld('ERGT053D',ergt053d,pcols,lchnk)
+! call outfld('ER3D ',er3d ,pcols,lchnk)
+!c_er3d
+! column integrated effective dry radii (um)
+ call outfld('DERLT05 ',derlt05,pcols,lchnk)
+ call outfld('DERGT05 ',dergt05,pcols,lchnk)
+ call outfld('DER ',der ,pcols,lchnk)
+!
+
+!000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+! Extra AeroCom diagnostics requiring table look-ups with RH = constant
+
+#ifdef AEROCOM_INSITU
+ irfmax=6
+#else
+ irfmax=1
+#endif ! AEROCOM_INSITU
+
+! Note: using xrhnull etc as proxy for constant RH input values (see opttab.F90)
+ do irf=1,irfmax
+ do k=1,pver
+ do icol=1,ncol
+ xrhnull(icol,k)=xrhrf(irf)
+ irh1null(icol,k)=irhrf1(irf)
+ end do
+ enddo
+ call opticsAtConstRh(lchnk, ncol, pint, rhoda, Nnatk, xrhnull, irh1null, irf, &
+ xct, ict1, xfaq, ifaq1, xfbcbg, ifbcbg1, &
+ xfbcbgn, ifbcbgn1, xfac, ifac1, xfbc, ifbc1, &
+ xfombg, ifombg1, vnbcarr, vaitbcarr, v_soana, &
+ bext440, bext500, bext550, bext670, bext870, &
+ bebg440, bebg500, bebg550, bebg670, bebg870, &
+ bebc440, bebc500, bebc550, bebc670, bebc870, &
+ beoc440, beoc500, beoc550, beoc670, beoc870, &
+ besu440, besu500, besu550, besu670, besu870, &
+ babs440, babs500, babs550, babs670, babs870, &
+ bebglt1, bebggt1, bebclt1, bebcgt1, &
+ beoclt1, beocgt1, bes4lt1, bes4gt1, &
+ backsc550, babg550, babc550, baoc550, basu550, &
+ bext440n, bext500n, bext550n, bext670n, bext870n, &
+ bebg440n, bebg500n, bebg550n, bebg670n, bebg870n, &
+ bebc440n, bebc500n, bebc550n, bebc670n, bebc870n, &
+ beoc440n, beoc500n, beoc550n, beoc670n, beoc870n, &
+ besu440n, besu500n, besu550n, besu670n, besu870n, &
+ babs440n, babs500n, babs550n, babs670n, babs870n, &
+ bebglt1n, bebggt1n, bebclt1n, bebcgt1n, &
+ beoclt1n, beocgt1n, bes4lt1n, bes4gt1n, &
+ backsc550n, babg550n, babc550n, baoc550n, basu550n)
+ end do ! irf
+
+!000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+
+
+#endif ! ***********AEROCOM***********AEROCOM**************AEROCOM***************above
+
+
+ return
+end subroutine pmxsub
+
+end module pmxsub_mod
diff --git a/src/physics/cam_oslo/preprocessorDefinitions.h b/src/physics/cam_oslo/preprocessorDefinitions.h
new file mode 100644
index 0000000000..a666051540
--- /dev/null
+++ b/src/physics/cam_oslo/preprocessorDefinitions.h
@@ -0,0 +1,4 @@
+#undef AEROCOM
+#undef AEROFFL
+#undef COLTST4INTCONS
+#undef AEROCOM_INSITU
diff --git a/src/physics/cam_oslo/ptaero_table.F90 b/src/physics/cam_oslo/ptaero_table.F90
new file mode 100644
index 0000000000..664c708c5b
--- /dev/null
+++ b/src/physics/cam_oslo/ptaero_table.F90
@@ -0,0 +1,280 @@
+module ptaero_table
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ implicit none
+ save
+
+ integer, parameter :: max_table_rank = 4
+
+ type one_dim_array_t
+ real(r8), allocatable :: values(:)
+ end type
+
+ type ptaero_table_t
+ integer :: rank !table rank
+ integer, dimension(max_table_rank) :: dims !Dimension
+ real(r8), dimension(:,:,:,:), allocatable :: values !Table data
+ TYPE(one_dim_array_t), dimension(:), allocatable :: axisValues !axis values
+ end type ptaero_table_t
+
+
+
+contains
+
+ subroutine construct(table)
+ TYPE(ptaero_table_t), intent(inout) :: table
+
+ if(allocated(table%values))deallocate(table%values)
+ if(allocated(table%values))deallocate(table%axisValues)
+ table%dims(:)=1
+ table%rank = 0
+ end subroutine construct
+
+
+ subroutine initialize(table, mixture_id, property_id, limits1, limits2, limits3, limits4, data2d, data3d, data4d)
+ implicit none
+ TYPE(ptaero_table_t), intent(inout) :: table
+ integer, intent(in) :: mixture_id !mixture id
+ integer, intent(in) :: property_id !property (e.g. ssa, sigma, radius, whatever)
+ real(r8), dimension(:,:), intent(in), optional :: data2d !2d data
+ real(r8), dimension(:,:,:), intent(in), optional :: data3d !3d data
+ real(r8), dimension(:,:,:,:), intent(in), optional :: data4d !4d data
+ real(r8), dimension(:),intent(in),optional :: limits1
+ real(r8), dimension(:), intent(in),optional :: limits2
+ real(r8), dimension(:), intent(in),optional :: limits3
+ real(r8), dimension(:), intent(in),optional :: limits4
+
+ integer :: i
+
+ !Local variables
+ logical tableFound
+
+ !local
+ tableFound=.FALSE.
+
+ if(allocated(table%values))then
+ stop "error"
+ end if
+
+ !Find the rank
+ if(present(data2d))then
+ table%rank = 2
+ tableFound = .TRUE.
+ table%dims(1) = SIZE(data2d,1)
+ table%dims(2) = SIZE(data2d,2)
+ endif
+ if(present(data3d))then
+ table%rank = 3
+ if(tableFound .eqv. .TRUE.)then
+ stop "error"
+ end if
+ tableFound=.TRUE.
+ table%dims(1) = SIZE(data3d,1)
+ table%dims(2) = SIZE(data3d,2)
+ table%dims(3) = SIZE(data3d,3)
+ end if
+ if(present(data4d))then
+ table%rank = 4
+ if(tableFound .eqv. .TRUE.)then
+ stop "error"
+ end if
+ tableFound=.TRUE.
+ table%dims(1) = SIZE(data4d,1)
+ table%dims(2) = SIZE(data4d,2)
+ table%dims(3) = SIZE(data4d,3)
+ table%dims(4) = SIZE(data4d,4)
+ end if
+
+ allocate(table%values(table%dims(1), table%dims(2), table%dims(3), table%dims(4)))
+
+ !Allocate space for axis values
+ allocate(table%axisValues(table%rank))
+ do i=1,table%rank
+ allocate(table%axisValues(i)%values(table%dims(i)))
+ end do
+
+ do i=1,table%rank
+ select case(i)
+ case(1)
+ table%axisValues(i)%values(:)=limits1(:)
+ case(2)
+ table%axisValues(i)%values(:)=limits2(:)
+ case(3)
+ table%axisValues(i)%values(:)=limits3(:)
+ case(4)
+ table%axisValues(i)%values(:)=limits4(:)
+ end select
+ end do
+
+ select case(table%rank)
+ case(2)
+ table%values(:,:,1,1) = data2d(:,:)
+ case(3)
+ table%values(:,:,:,1) = data3d(:,:,:)
+ case(4)
+ table%values(:,:,:,:) = data4d(:,:,:,:)
+ end select
+
+ end subroutine initialize
+
+ !Search for the property along the array limits
+ recursive function binary_search(arraylimits, numberToFind, iGuess, iLow, iHigh) result(lowLimitIndex)
+ implicit none
+ real(r8), dimension(:),intent(in) :: arrayLimits !Limits along the axis we are searching
+ real(r8), intent(in) :: numberToFind !The property we are trying to find along the axis
+
+ integer, intent(inout) :: iGuess !Guessed index
+ integer,intent(inout) :: iLow !Lowest possible index
+ integer, intent(inout) :: iHigh !Highest possible index
+
+ integer :: lowLimitIndex
+
+ if(numberToFind .lt. arrayLimits(iGuess))then
+ iHigh = iGuess
+ iGuess = int(0.5_r8*(iLow+iHigh))
+ lowLimitIndex=binary_search(arrayLimits, numberToFind, iGuess, iLow, iHigh)
+ else if (numberToFind .gt. arrayLimits(iGuess+1))then
+ iLow = iGuess+1
+ iGuess = int(0.5_r8*(iLow+iHigh))
+ lowLimitIndex = binary_search(arrayLimits, numberToFind, iGuess, iLow, iHigh)
+ else !property is between iGuess and iGuess+1 ==> we are ok
+ lowLimitIndex = iLow
+ end if
+ end function binary_search
+
+
+ !Search and obtain the value
+ function searchGetValue(table, axisValuesToFind ) RESULT(output)
+ implicit none
+ TYPE(ptaero_table_t), intent(in) :: table
+ real(r8), dimension(:), intent(in) :: axisValuesToFind !array of numbers on axis
+
+ !local variables
+ integer, dimension(max_table_rank) :: lowLimit !index of axis value below
+ integer, dimension(max_table_rank) :: highLimit !index of axis value above
+ real(r8), dimension(max_table_rank):: lowFraction
+ real(r8), dimension(max_table_rank):: highFraction
+ real(r8) :: output
+
+ integer :: iGuess
+ integer :: iLow
+ integer :: iHigh
+ integer :: i
+
+ !Get the indexes in question
+ do i = 1, table%rank
+ iLow=1
+ iHigh = table%dims(i)
+ iGuess = int(0.5_r8*(iLow+iHigh)) !Guess middle value
+ lowLimit(i) = binary_search(table%axisValues(i)%values, axisValuesToFind(i), iGuess, iLow, iHigh )
+ highLimit(i) = lowLimit(i)+1
+ end do
+
+ do i=1,table%rank
+ !High fraction is distance to low value divided by total distance
+ highFraction(i) = (axisValuesToFind(i)-table%axisValues(i)%values(lowLimit(i))) &
+ /(table%axisValues(i)%values(highLimit(i)) - table%axisValues(i)%values(lowLimit(i)))
+ !Low fraction is one minus high
+ lowFraction(i) = 1.0_r8 - highFraction(i)
+ end do
+
+ !Interpolate along table limits
+ call interpolate(table, lowLimit, highLimit, lowFraction, highFraction,output)
+
+ end function searchGetValue
+
+
+ !******************************************************************
+ !Interpolate given that you know which indexes you are interested in
+ subroutine interpolate(table, lowLimits, highLimits, lowFraction, highFraction,answer)
+ implicit none
+ type(ptaero_table_t),intent(in) :: table
+ integer, intent(in), dimension(:) :: lowLimits
+ integer, intent(in), dimension(:) :: highLimits
+ real(r8), intent(in), dimension(:) :: lowFraction
+ real(r8), intent(in), dimension(:) :: highFraction
+ real(r8), intent(out) :: answer
+
+ real(r8) , dimension(2,2,2) :: tmp3D
+ real(r8) , dimension(2,2) :: tmp2D
+ real(r8) , dimension(2) :: tmp1D
+
+ if(table%rank .eq. 3) then
+ call extract3D(table%values(:,:,:,1), tmp3D, lowLimits, highLimits)
+ call interpolate3D(tmp3D, tmp2D, tmp1d, answer, highFraction, lowFraction)
+ elseif(table%rank .eq. 2) then
+ !call extract2D(table%values(:,:,1,1), tmp2D, lowLimits, highLimits)
+ call interpolate2D(tmp2D, tmp1d, answer, lowFraction, highFraction)
+ else if (table%rank .eq. 1)then
+ !call extract1D(table%values(:,1,1,1,1), tmp1D, lowLimits, highLimits)
+ call interpolate1D(tmp1D, answer, lowFraction, highFraction)
+ end if
+
+ end subroutine
+
+ !Extract a compact 3D-array from the table
+ subroutine extract3D(tmpIn, tmpOut, lowLimits, highLimits)
+ implicit none
+ real(r8), dimension(:,:,:),intent(in) :: tmpIn !Full data array
+ real(r8), dimension(2,2,2),intent(out) :: tmpOut !Extracted, condensed array
+ integer, dimension(:) :: lowLimits
+ integer, dimension(:) :: highLImits
+
+ tmpOut(1,1,1)=tmpIn(lowLimits(1),lowLimits(2),lowLimits(3))
+ tmpOut(1,1,2)=tmpIn(lowLimits(1),lowLimits(2),highLimits(3))
+
+ tmpOut(1,2,1)=tmpIn(lowLimits(1),highLimits(2),lowLimits(3))
+ tmpOut(1,2,2)=tmpIn(lowLimits(1),highLimits(2),highLimits(3))
+
+ tmpOut(2,1,1)=tmpIn(highLimits(1),lowLimits(2),lowLimits(3))
+ tmpOut(2,1,2)=tmpIn(highLimits(1),lowLimits(2),highLimits(3))
+
+ tmpOut(2,2,1)=tmpIn(highLimits(1),highLimits(2),lowLimits(3))
+ tmpOut(2,2,2)=tmpIn(highLimits(1),highLimits(2),highLimits(3))
+ end subroutine
+
+ !Remove dimension 3 and send back a 2d-array
+ subroutine interpolate3D(tmp3D, tmp2D, tmp1d, answer, lowFraction, highFraction)
+ implicit none
+ real(r8), dimension(2,2,2), intent(in) :: tmp3D
+ real(r8), dimension(2,2),intent(inout) :: tmp2D
+ real(r8), dimension(2), intent(inout) :: tmp1d
+ real(r8) :: answer
+ real(r8), intent(in), dimension(:) :: highFraction
+ real(r8), intent(in), dimension(:) :: lowFraction
+
+ tmp2D(1,1) = lowFraction(3)*tmp3D(1,1,1) + highFraction(3)*tmp3D(1,1,2)
+ tmp2D(1,2) = lowFraction(3)*tmp3D(1,2,1) + highFraction(3)*tmp3D(1,2,2)
+ tmp2D(2,1) = lowFraction(3)*tmp3D(2,1,1) + highFraction(3)*tmp3D(2,1,2)
+ tmp2D(2,2) = lowFraction(3)*tmp3D(2,2,1) + highFraction(3)*tmp3D(2,2,2)
+
+ call interpolate2D(tmp2D, tmp1D, answer, lowFraction, highFraction)
+
+ end subroutine
+
+ !Remove dimension 2 and send back a 1d-array
+ subroutine interpolate2D(tmp2D, tmp1D, answer, lowFraction, highFraction)
+ implicit none
+ real(r8), dimension(2,2),intent(in) :: tmp2D
+ real(r8), dimension(2), intent(inout) :: tmp1D
+ real(r8), dimension(:), intent(in) :: lowFraction
+ real(r8), dimension(:), intent(in) :: highFraction
+ real(r8),intent(out) :: answer
+
+ tmp1D(1) = lowFraction(2)*tmp2D(1,1) + highFraction(2)*tmp2D(1,2)
+ tmp1D(2) = lowFraction(2)*tmp2D(2,1) + highFraction(2)*tmp2D(2,2)
+
+ call interpolate1D(tmp1D, answer, lowFraction, highFraction)
+ end subroutine interpolate2D
+
+ !Interpolate a 1d-array
+ subroutine interpolate1D(tmp1D, answer, lowFraction, highFraction)
+ implicit none
+ real(r8), intent(in), dimension(2) :: tmp1D
+ real(r8), intent(out) :: answer
+ real(r8), intent(in), dimension(:) :: lowFraction
+ real(r8), intent(in), dimension(:) :: highFraction
+
+ answer = lowFraction(1)*tmp1D(1) + highFraction(1)*tmp1D(2)
+ end subroutine interpolate1D
+
+end module ptaero_table
diff --git a/src/physics/cam_oslo/radiation.F90 b/src/physics/cam_oslo/radiation.F90
new file mode 100644
index 0000000000..71e5697419
--- /dev/null
+++ b/src/physics/cam_oslo/radiation.F90
@@ -0,0 +1,2037 @@
+module radiation
+
+!---------------------------------------------------------------------------------
+!
+! CAM interface to RRTMG radiation parameterization
+!
+!---------------------------------------------------------------------------------
+
+#include
+
+use shr_kind_mod, only: r8=>shr_kind_r8
+use spmd_utils, only: masterproc
+use ppgrid, only: pcols, pver, pverp, begchunk, endchunk
+use physics_types, only: physics_state, physics_ptend
+use physics_buffer, only: physics_buffer_desc, pbuf_get_field, pbuf_old_tim_idx
+use camsrfexch, only: cam_out_t, cam_in_t
+use physconst, only: cappa, cpair
+
+use time_manager, only: get_nstep, is_first_restart_step, &
+ get_curr_calday, get_step_size
+
+use rad_constituents, only: N_DIAG, rad_cnst_get_call_list, rad_cnst_get_info, &
+ rad_cnst_get_gas, rad_cnst_out, oldcldoptics, &
+ liqcldoptics, icecldoptics
+
+use radconstants, only: nswbands, nlwbands, rrtmg_sw_cloudsim_band, rrtmg_lw_cloudsim_band, &
+ idx_sw_diag
+
+use cospsimulator_intr, only: docosp, cospsimulator_intr_init, &
+ cospsimulator_intr_run, cosp_nradsteps
+
+use scamMod, only: scm_crm_mode, single_column, have_cld, cldobs
+
+use cam_history, only: addfld, add_default, horiz_only, outfld, hist_fld_active
+use cam_history_support, only: fillvalue
+
+use pio, only: file_desc_t, var_desc_t, &
+ pio_int, pio_noerr, &
+ pio_seterrorhandling, pio_bcast_error, &
+ pio_inq_varid, pio_def_var, &
+ pio_put_var, pio_get_var
+
+use cam_abortutils, only: endrun
+use error_messages, only: handle_err
+use perf_mod, only: t_startf, t_stopf
+use cam_logfile, only: iulog
+#ifdef DIRIND
+use prescribed_volcaero, only: has_prescribed_volcaero, has_prescribed_volcaero_cmip6, solar_bands, terrestrial_bands
+use pmxsub_mod, only: pmxsub
+#endif
+
+implicit none
+private
+save
+
+public :: &
+ radiation_readnl, &! read namelist variables
+ radiation_register, &! registers radiation physics buffer fields
+ radiation_nextsw_cday, &! calendar day of next radiation calculation
+ radiation_do, &! query which radiation calcs are done this timestep
+ radiation_init, &! initialization
+ radiation_define_restart, &! define variables for restart
+ radiation_write_restart, &! write variables to restart
+ radiation_read_restart, &! read variables from restart
+ radiation_tend, &! compute heating rates and fluxes
+ rad_out_t ! type for diagnostic outputs
+
+integer,public, allocatable :: cosp_cnt(:) ! counter for cosp
+integer,public :: cosp_cnt_init = 0 !initial value for cosp counter
+
+type rad_out_t
+
+ real(r8) :: solin(pcols) ! Solar incident flux
+
+ real(r8) :: qrsc(pcols,pver)
+
+ real(r8) :: fsntc(pcols) ! Clear sky total column abs solar flux
+ real(r8) :: fsntoa(pcols) ! Net solar flux at TOA
+ real(r8) :: fsntoac(pcols) ! Clear sky net solar flux at TOA
+ real(r8) :: fsutoa(pcols) ! upwelling solar flux at TOA
+
+ real(r8) :: fsnirt(pcols) ! Near-IR flux absorbed at toa
+ real(r8) :: fsnrtc(pcols) ! Clear sky near-IR flux absorbed at toa
+ real(r8) :: fsnirtsq(pcols) ! Near-IR flux absorbed at toa >= 0.7 microns
+
+ real(r8) :: fsn200(pcols) ! fns interpolated to 200 mb
+ real(r8) :: fsn200c(pcols) ! fcns interpolated to 200 mb
+ real(r8) :: fsnr(pcols) ! fns interpolated to tropopause
+
+ real(r8) :: fsnsc(pcols) ! Clear sky surface abs solar flux
+ real(r8) :: fsdsc(pcols) ! Clear sky surface downwelling solar flux
+
+ real(r8) :: qrlc(pcols,pver)
+
+ real(r8) :: flntc(pcols) ! Clear sky lw flux at model top
+ real(r8) :: flut(pcols) ! Upward flux at top of model
+ real(r8) :: flutc(pcols) ! Upward Clear Sky flux at top of model
+ real(r8) :: lwcf(pcols) ! longwave cloud forcing
+
+ real(r8) :: fln200(pcols) ! net longwave flux interpolated to 200 mb
+ real(r8) :: fln200c(pcols) ! net clearsky longwave flux interpolated to 200 mb
+ real(r8) :: flnr(pcols) ! net longwave flux interpolated to tropopause
+
+ real(r8) :: flnsc(pcols) ! Clear sky lw flux at srf (up-down)
+ real(r8) :: fldsc(pcols) ! Clear sky lw flux at srf (down)
+
+ real(r8) :: tot_cld_vistau(pcols,pver) ! gbx water+ice cloud optical depth (only during day, night = fillvalue)
+ real(r8) :: tot_icld_vistau(pcols,pver) ! in-cld water+ice cloud optical depth (only during day, night = fillvalue)
+ real(r8) :: liq_icld_vistau(pcols,pver) ! in-cld liq cloud optical depth (only during day, night = fillvalue)
+ real(r8) :: ice_icld_vistau(pcols,pver) ! in-cld ice cloud optical depth (only during day, night = fillvalue)
+ real(r8) :: snow_icld_vistau(pcols,pver) ! snow in-cloud visible sw optical depth for output on history files
+
+ real(r8) :: cld_tau_cloudsim(pcols,pver)
+ real(r8) :: aer_tau400(pcols,0:pver)
+ real(r8) :: aer_tau550(pcols,0:pver)
+ real(r8) :: aer_tau700(pcols,0:pver)
+
+end type rad_out_t
+
+! Namelist variables
+
+integer :: iradsw = -1 ! freq. of shortwave radiation calc in time steps (positive)
+ ! or hours (negative).
+integer :: iradlw = -1 ! frequency of longwave rad. calc. in time steps (positive)
+ ! or hours (negative).
+
+integer :: irad_always = 0 ! Specifies length of time in timesteps (positive)
+ ! or hours (negative) SW/LW radiation will be
+ ! run continuously from the start of an
+ ! initial or restart run
+logical :: use_rad_dt_cosz = .false. ! if true, use radiation dt for all cosz calculations
+!logical :: spectralflux = .false. ! calculate fluxes (up and down) per band.
+!#ifdef RFMIPIRF
+! logical :: spectralflux = .true. ! calculate fluxes (up and down) per band.
+!#else
+ logical :: spectralflux = .false. ! calculate fluxes (up and down) per band.
+!#endif
+
+! Physics buffer indices
+integer :: qrs_idx = 0
+integer :: qrl_idx = 0
+integer :: su_idx = 0
+integer :: sd_idx = 0
+integer :: lu_idx = 0
+integer :: ld_idx = 0
+integer :: fsds_idx = 0
+integer :: fsns_idx = 0
+integer :: fsnt_idx = 0
+integer :: flns_idx = 0
+integer :: flnt_idx = 0
+integer :: cldfsnow_idx = 0
+integer :: cld_idx = 0
+#ifdef DIRIND
+integer :: volc_idx = 0
+#endif
+
+character(len=4) :: diag(0:N_DIAG) =(/' ','_d1 ','_d2 ','_d3 ','_d4 ','_d5 ','_d6 ','_d7 ','_d8 ','_d9 ','_d10'/)
+
+! averaging time interval for zenith angle
+real(r8) :: dt_avg = 0._r8
+
+! PIO descriptors (for restarts)
+type(var_desc_t) :: cospcnt_desc
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine radiation_readnl(nlfile)
+
+ ! Read radiation_nl namelist group.
+
+ use namelist_utils, only: find_group_name
+ use units, only: getunit, freeunit
+ use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_integer, mpi_logical
+
+ character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input
+
+ ! Local variables
+ integer :: unitn, ierr
+ integer :: dtime ! timestep size
+ character(len=*), parameter :: sub = 'radiation_readnl'
+
+ namelist /radiation_nl/ iradsw, iradlw, irad_always, &
+ use_rad_dt_cosz, spectralflux
+
+!#ifdef RFMIPIRF
+! spectralflux = .true. ! calculate fluxes (up and down) per band.
+!#endif
+
+ !-----------------------------------------------------------------------------
+
+ if (masterproc) then
+ unitn = getunit()
+ open( unitn, file=trim(nlfile), status='old' )
+ call find_group_name(unitn, 'radiation_nl', status=ierr)
+ if (ierr == 0) then
+ read(unitn, radiation_nl, iostat=ierr)
+ if (ierr /= 0) then
+ call endrun(sub // ':: ERROR reading namelist')
+ end if
+ end if
+ close(unitn)
+ call freeunit(unitn)
+ end if
+
+ ! Broadcast namelist variables
+ call mpi_bcast(iradsw, 1, mpi_integer, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradsw")
+ call mpi_bcast(iradlw, 1, mpi_integer, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: iradlw")
+ call mpi_bcast(irad_always, 1, mpi_integer, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: irad_always")
+ call mpi_bcast(use_rad_dt_cosz, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: use_rad_dt_cosz")
+ call mpi_bcast(spectralflux, 1, mpi_logical, mstrid, mpicom, ierr)
+ if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: spectralflux")
+
+ ! Convert iradsw, iradlw and irad_always from hours to timesteps if necessary
+ dtime = get_step_size()
+ if (iradsw < 0) iradsw = nint((-iradsw *3600._r8)/dtime)
+ if (iradlw < 0) iradlw = nint((-iradlw *3600._r8)/dtime)
+ if (irad_always < 0) irad_always = nint((-irad_always*3600._r8)/dtime)
+
+ !-----------------------------------------------------------------------
+ ! Print runtime options to log.
+ !-----------------------------------------------------------------------
+
+ if (masterproc) then
+ write(iulog,*) 'RRTMG radiation scheme parameters:'
+ write(iulog,10) iradsw, iradlw, irad_always, use_rad_dt_cosz, spectralflux
+ end if
+
+10 format(' Frequency (timesteps) of Shortwave Radiation calc: ',i5/, &
+ ' Frequency (timesteps) of Longwave Radiation calc: ',i5/, &
+ ' SW/LW calc done every timestep for first N steps. N=',i5/, &
+ ' Use average zenith angle: ',l5/, &
+ ' Output spectrally resolved fluxes: ',l5/)
+
+end subroutine radiation_readnl
+
+!================================================================================================
+
+subroutine radiation_register
+
+ ! Register radiation fields in the physics buffer
+
+ use physics_buffer, only: pbuf_add_field, dtype_r8
+ use radiation_data, only: rad_data_register
+
+ call pbuf_add_field('QRS' , 'global',dtype_r8,(/pcols,pver/), qrs_idx) ! shortwave radiative heating rate
+ call pbuf_add_field('QRL' , 'global',dtype_r8,(/pcols,pver/), qrl_idx) ! longwave radiative heating rate
+
+ call pbuf_add_field('FSDS' , 'global',dtype_r8,(/pcols/), fsds_idx) ! Surface solar downward flux
+ call pbuf_add_field('FSNS' , 'global',dtype_r8,(/pcols/), fsns_idx) ! Surface net shortwave flux
+ call pbuf_add_field('FSNT' , 'global',dtype_r8,(/pcols/), fsnt_idx) ! Top-of-model net shortwave flux
+
+ call pbuf_add_field('FLNS' , 'global',dtype_r8,(/pcols/), flns_idx) ! Surface net longwave flux
+ call pbuf_add_field('FLNT' , 'global',dtype_r8,(/pcols/), flnt_idx) ! Top-of-model net longwave flux
+
+ ! If the namelist has been configured for preserving the spectral fluxes, then create
+ ! physics buffer variables to store the results.
+! legg til #ifndef RFMIPIRF her ogsaa?!
+ if (spectralflux) then
+ call pbuf_add_field('SU' , 'global',dtype_r8,(/pcols,pverp,nswbands/), su_idx) ! shortwave upward flux (per band)
+ call pbuf_add_field('SD' , 'global',dtype_r8,(/pcols,pverp,nswbands/), sd_idx) ! shortwave downward flux (per band)
+ call pbuf_add_field('LU' , 'global',dtype_r8,(/pcols,pverp,nlwbands/), lu_idx) ! longwave upward flux (per band)
+ call pbuf_add_field('LD' , 'global',dtype_r8,(/pcols,pverp,nlwbands/), ld_idx) ! longwave downward flux (per band)
+ end if
+
+ call rad_data_register()
+
+end subroutine radiation_register
+
+!================================================================================================
+
+function radiation_do(op, timestep)
+
+ ! Return true if the specified operation is done this timestep.
+
+ character(len=*), intent(in) :: op ! name of operation
+ integer, intent(in), optional:: timestep
+ logical :: radiation_do ! return value
+
+ ! Local variables
+ integer :: nstep ! current timestep number
+ !-----------------------------------------------------------------------
+
+ if (present(timestep)) then
+ nstep = timestep
+ else
+ nstep = get_nstep()
+ end if
+
+ select case (op)
+
+ case ('sw') ! do a shortwave heating calc this timestep?
+ radiation_do = nstep == 0 .or. iradsw == 1 &
+ .or. (mod(nstep-1,iradsw) == 0 .and. nstep /= 1) &
+ .or. nstep <= irad_always
+
+ case ('lw') ! do a longwave heating calc this timestep?
+ radiation_do = nstep == 0 .or. iradlw == 1 &
+ .or. (mod(nstep-1,iradlw) == 0 .and. nstep /= 1) &
+ .or. nstep <= irad_always
+
+ case default
+ call endrun('radiation_do: unknown operation:'//op)
+
+ end select
+end function radiation_do
+
+!================================================================================================
+
+real(r8) function radiation_nextsw_cday()
+
+ ! Return calendar day of next sw radiation calculation
+
+ ! Local variables
+ integer :: nstep ! timestep counter
+ logical :: dosw ! true => do shosrtwave calc
+ integer :: offset ! offset for calendar day calculation
+ integer :: dTime ! integer timestep size
+ real(r8):: calday ! calendar day of
+ !-----------------------------------------------------------------------
+
+ radiation_nextsw_cday = -1._r8
+ dosw = .false.
+ nstep = get_nstep()
+ dtime = get_step_size()
+ offset = 0
+ do while (.not. dosw)
+ nstep = nstep + 1
+ offset = offset + dtime
+ if (radiation_do('sw', nstep)) then
+ radiation_nextsw_cday = get_curr_calday(offset=offset)
+ dosw = .true.
+ end if
+ end do
+ if(radiation_nextsw_cday == -1._r8) then
+ call endrun('error in radiation_nextsw_cday')
+ end if
+
+end function radiation_nextsw_cday
+
+!================================================================================================
+
+subroutine radiation_init(pbuf2d)
+
+ ! Initialize the radiation parameterization, add fields to the history buffer
+
+ use physics_buffer, only: pbuf_get_index, pbuf_set_field
+ use phys_control, only: phys_getopts
+ use radsw, only: radsw_init
+ use radlw, only: radlw_init
+ use rad_solar_var, only: rad_solar_var_init
+ use radiation_data, only: rad_data_init
+ use cloud_rad_props, only: cloud_rad_props_init
+ use modal_aer_opt, only: modal_aer_opt_init
+ use rrtmg_state, only: rrtmg_state_init
+ use time_manager, only: is_first_step
+
+
+ ! arguments
+ type(physics_buffer_desc), pointer :: pbuf2d(:,:)
+
+ ! local variables
+ integer :: icall, nmodes
+ logical :: active_calls(0:N_DIAG)
+ integer :: nstep ! current timestep number
+ logical :: history_amwg ! output the variables used by the AMWG diag package
+ logical :: history_vdiag ! output the variables used by the AMWG variability diag package
+ logical :: history_budget ! output tendencies and state variables for CAM4
+ ! temperature, water vapor, cloud ice and cloud
+ ! liquid budgets.
+ integer :: history_budget_histfile_num ! output history file number for budget fields
+ integer :: err
+
+ integer :: dtime
+ !-----------------------------------------------------------------------
+
+ call rad_solar_var_init()
+ call rrtmg_state_init()
+ call rad_data_init(pbuf2d) ! initialize output fields for offline driver
+ call radsw_init()
+ call radlw_init()
+ call cloud_rad_props_init()
+
+ cld_idx = pbuf_get_index('CLD')
+ cldfsnow_idx = pbuf_get_index('CLDFSNOW',errcode=err)
+
+ if (is_first_step()) then
+ call pbuf_set_field(pbuf2d, qrl_idx, 0._r8)
+ end if
+
+
+ ! Set the radiation timestep for cosz calculations if requested using the adjusted iradsw value from radiation
+ if (use_rad_dt_cosz) then
+ dtime = get_step_size()
+ dt_avg = iradsw*dtime
+ end if
+
+ call phys_getopts(history_amwg_out = history_amwg, &
+ history_vdiag_out = history_vdiag, &
+ history_budget_out = history_budget, &
+ history_budget_histfile_num_out = history_budget_histfile_num)
+
+ ! Determine whether modal aerosols are affecting the climate, and if so
+ ! then initialize the modal aerosol optics module
+ call rad_cnst_get_info(0, nmodes=nmodes)
+ if (nmodes > 0) call modal_aer_opt_init()
+
+ ! "irad_always" is number of time steps to execute radiation continuously from start of
+ ! initial OR restart run
+ nstep = get_nstep()
+ if (irad_always > 0) then
+ nstep = get_nstep()
+ irad_always = irad_always + nstep
+ end if
+
+ if (docosp) call cospsimulator_intr_init
+
+ allocate(cosp_cnt(begchunk:endchunk))
+ if (is_first_restart_step()) then
+ cosp_cnt(begchunk:endchunk) = cosp_cnt_init
+ else
+ cosp_cnt(begchunk:endchunk) = 0
+ end if
+
+ call addfld('O3colAbove', horiz_only, 'A', 'DU', 'Column O3 above model top', sampling_seq='rad_lwsw')
+
+ call addfld('TOT_CLD_VISTAU', (/ 'lev' /), 'A', '1', 'Total gbx cloud extinction visible sw optical depth', &
+ sampling_seq='rad_lwsw', flag_xyfill=.true.)
+ call addfld('TOT_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Total in-cloud extinction visible sw optical depth', &
+ sampling_seq='rad_lwsw', flag_xyfill=.true.)
+ call addfld('LIQ_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Liquid in-cloud extinction visible sw optical depth', &
+ sampling_seq='rad_lwsw', flag_xyfill=.true.)
+ call addfld('ICE_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Ice in-cloud extinction visible sw optical depth', &
+ sampling_seq='rad_lwsw', flag_xyfill=.true.)
+
+ if (cldfsnow_idx > 0) then
+ call addfld('SNOW_ICLD_VISTAU', (/ 'lev' /), 'A', '1', 'Snow in-cloud extinction visible sw optical depth', &
+ sampling_seq='rad_lwsw', flag_xyfill=.true.)
+ endif
+
+ ! get list of active radiation calls
+ call rad_cnst_get_call_list(active_calls)
+
+ ! Add shortwave radiation fields to history master field list.
+
+ do icall = 0, N_DIAG
+
+ if (active_calls(icall)) then
+
+ call addfld('SOLIN'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar insolation', sampling_seq='rad_lwsw')
+
+ call addfld('QRS'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Solar heating rate', sampling_seq='rad_lwsw')
+ call addfld('QRSC'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Clearsky solar heating rate', &
+ sampling_seq='rad_lwsw')
+ call addfld('FSNT'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at top of model', &
+ sampling_seq='rad_lwsw')
+ call addfld('FSNTC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at top of model', &
+ sampling_seq='rad_lwsw')
+ call addfld('FSNTOA'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at top of atmosphere', &
+ sampling_seq='rad_lwsw')
+ call addfld('FSNTOAC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at top of atmosphere', &
+ sampling_seq='rad_lwsw')
+ call addfld('SWCF'//diag(icall), horiz_only, 'A', 'W/m2', 'Shortwave cloud forcing', &
+ sampling_seq='rad_lwsw')
+ call addfld('FSUTOA'//diag(icall), horiz_only, 'A', 'W/m2', 'Upwelling solar flux at top of atmosphere', &
+ sampling_seq='rad_lwsw')
+ call addfld('FSNIRTOA'//diag(icall), horiz_only, 'A', 'W/m2', &
+ 'Net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw')
+ call addfld('FSNRTOAC'//diag(icall), horiz_only, 'A', 'W/m2', &
+ 'Clearsky net near-infrared flux (Nimbus-7 WFOV) at top of atmosphere', sampling_seq='rad_lwsw')
+ call addfld('FSNRTOAS'//diag(icall), horiz_only, 'A', 'W/m2', &
+ 'Net near-infrared flux (>= 0.7 microns) at top of atmosphere', sampling_seq='rad_lwsw')
+
+ call addfld('FSN200'//diag(icall), horiz_only, 'A', 'W/m2', 'Net shortwave flux at 200 mb', &
+ sampling_seq='rad_lwsw')
+ call addfld('FSN200C'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net shortwave flux at 200 mb', &
+ sampling_seq='rad_lwsw')
+
+ call addfld('FSNR'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at tropopause', &
+ sampling_seq='rad_lwsw')
+
+ call addfld('SOLL'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward near infrared direct to surface', &
+ sampling_seq='rad_lwsw')
+ call addfld('SOLS'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward visible direct to surface', &
+ sampling_seq='rad_lwsw')
+ call addfld('SOLLD'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward near infrared diffuse to surface', &
+ sampling_seq='rad_lwsw')
+ call addfld('SOLSD'//diag(icall), horiz_only, 'A', 'W/m2', 'Solar downward visible diffuse to surface', &
+ sampling_seq='rad_lwsw')
+ call addfld('FSNS'//diag(icall), horiz_only, 'A', 'W/m2', 'Net solar flux at surface', &
+ sampling_seq='rad_lwsw')
+ call addfld('FSNSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net solar flux at surface', &
+ sampling_seq='rad_lwsw')
+
+ call addfld('FSDS'//diag(icall), horiz_only, 'A', 'W/m2', 'Downwelling solar flux at surface', &
+ sampling_seq='rad_lwsw')
+ call addfld('FSDSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky downwelling solar flux at surface', &
+ sampling_seq='rad_lwsw')
+
+ call addfld('FUS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave upward flux')
+ call addfld('FDS'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave downward flux')
+ call addfld('FUSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky upward flux')
+ call addfld('FDSC'//diag(icall), (/ 'ilev' /), 'I', 'W/m2', 'Shortwave clear-sky downward flux')
+!#ifdef AEROFFL
+! call addfld('FDSCDRF', (/ 'ilev' /), 'A', 'W/m2', 'Shortwave clear-sky downward flux')
+! call addfld('FUSCDRF', (/ 'ilev' /), 'A', 'W/m2', 'Shortwave clear-sky upward flux')
+!#endif
+
+ if (history_amwg) then
+ call add_default('SOLIN'//diag(icall), 1, ' ')
+ call add_default('QRS'//diag(icall), 1, ' ')
+ call add_default('FSNT'//diag(icall), 1, ' ')
+ call add_default('FSNTC'//diag(icall), 1, ' ')
+ call add_default('FSNTOA'//diag(icall), 1, ' ')
+ call add_default('FSNTOAC'//diag(icall), 1, ' ')
+ call add_default('SWCF'//diag(icall), 1, ' ')
+ call add_default('FSNS'//diag(icall), 1, ' ')
+ call add_default('FSNSC'//diag(icall), 1, ' ')
+ call add_default('FSUTOA'//diag(icall), 1, ' ')
+ call add_default('FSDSC'//diag(icall), 1, ' ')
+ call add_default('FSDS'//diag(icall), 1, ' ')
+ endif
+
+ end if
+ end do
+
+#ifdef AEROFFL
+ call addfld('FDSCDRF', (/ 'ilev' /), 'A', 'W/m2', 'Shortwave clear-sky downward flux')
+ call addfld('FUSCDRF', (/ 'ilev' /), 'A', 'W/m2', 'Shortwave clear-sky upward flux')
+#endif
+
+ if (scm_crm_mode) then
+ call add_default('FUS ', 1, ' ')
+ call add_default('FUSC ', 1, ' ')
+ call add_default('FDS ', 1, ' ')
+ call add_default('FDSC ', 1, ' ')
+ endif
+
+ ! Add longwave radiation fields to history master field list.
+
+ do icall = 0, N_DIAG
+
+ if (active_calls(icall)) then
+
+ call addfld('QRL'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Longwave heating rate', sampling_seq='rad_lwsw')
+ call addfld('QRLC'//diag(icall), (/ 'lev' /), 'A', 'K/s', 'Clearsky longwave heating rate', &
+ sampling_seq='rad_lwsw')
+ call addfld('FLNT'//diag(icall), horiz_only, 'A', 'W/m2', 'Net longwave flux at top of model', &
+ sampling_seq='rad_lwsw')
+ call addfld('FLNTC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net longwave flux at top of model', &
+ sampling_seq='rad_lwsw')
+ call addfld('FLNTCLR'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky ONLY points net longwave flux at top of model',&
+ sampling_seq='rad_lwsw')
+ call addfld('FREQCLR'//diag(icall), horiz_only, 'A', 'Frac', 'Frequency of Occurrence of Clearsky', &
+ sampling_seq='rad_lwsw')
+ call addfld('FLUT'//diag(icall), horiz_only, 'A', 'W/m2', 'Upwelling longwave flux at top of model', &
+ sampling_seq='rad_lwsw')
+ call addfld('FLUTC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky upwelling longwave flux at top of model', &
+ sampling_seq='rad_lwsw')
+ call addfld('LWCF'//diag(icall), horiz_only, 'A', 'W/m2', 'Longwave cloud forcing', sampling_seq='rad_lwsw')
+
+ call addfld('FLN200'//diag(icall), horiz_only, 'A', 'W/m2', 'Net longwave flux at 200 mb', &
+ sampling_seq='rad_lwsw')
+ call addfld('FLN200C'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net longwave flux at 200 mb', &
+ sampling_seq='rad_lwsw')
+ call addfld('FLNR'//diag(icall), horiz_only, 'A', 'W/m2', 'Net longwave flux at tropopause', &
+ sampling_seq='rad_lwsw')
+
+ call addfld('FLNS'//diag(icall), horiz_only, 'A', 'W/m2', 'Net longwave flux at surface', &
+ sampling_seq='rad_lwsw')
+ call addfld('FLNSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky net longwave flux at surface', &
+ sampling_seq='rad_lwsw')
+ call addfld('FLDS'//diag(icall), horiz_only, 'A', 'W/m2', 'Downwelling longwave flux at surface', &
+ sampling_seq='rad_lwsw')
+ call addfld('FLDSC'//diag(icall), horiz_only, 'A', 'W/m2', 'Clearsky Downwelling longwave flux at surface', &
+ sampling_seq='rad_lwsw')
+ call addfld('FUL'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave upward flux')
+ call addfld('FDL'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave downward flux')
+ call addfld('FULC'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave clear-sky upward flux')
+ call addfld('FDLC'//diag(icall), (/ 'ilev' /),'I', 'W/m2', 'Longwave clear-sky downward flux')
+
+ if (history_amwg) then
+ call add_default('QRL'//diag(icall), 1, ' ')
+ call add_default('FLNT'//diag(icall), 1, ' ')
+ call add_default('FLNTC'//diag(icall), 1, ' ')
+ call add_default('FLNTCLR'//diag(icall), 1, ' ')
+ call add_default('FREQCLR'//diag(icall), 1, ' ')
+ call add_default('FLUT'//diag(icall), 1, ' ')
+ call add_default('FLUTC'//diag(icall), 1, ' ')
+ call add_default('LWCF'//diag(icall), 1, ' ')
+ call add_default('FLNS'//diag(icall), 1, ' ')
+ call add_default('FLNSC'//diag(icall), 1, ' ')
+ call add_default('FLDS'//diag(icall), 1, ' ')
+ endif
+
+ end if
+ end do
+
+ call addfld('EMIS', (/ 'lev' /), 'A', '1', 'Cloud longwave emissivity')
+
+ if (scm_crm_mode) then
+ call add_default ('FUL ', 1, ' ')
+ call add_default ('FULC ', 1, ' ')
+ call add_default ('FDL ', 1, ' ')
+ call add_default ('FDLC ', 1, ' ')
+ endif
+
+ ! Heating rate needed for d(theta)/dt computation
+ call addfld ('HR',(/ 'lev' /), 'A','K/s','Heating rate needed for d(theta)/dt computation')
+
+ if ( history_budget .and. history_budget_histfile_num > 1 ) then
+ call add_default ('QRL ', history_budget_histfile_num, ' ')
+ call add_default ('QRS ', history_budget_histfile_num, ' ')
+ end if
+
+ if (history_vdiag) then
+ call add_default('FLUT', 2, ' ')
+ call add_default('FLUT', 3, ' ')
+ end if
+
+end subroutine radiation_init
+
+!===============================================================================
+
+subroutine radiation_define_restart(file)
+
+ ! define variables to be written to restart file
+
+ ! arguments
+ type(file_desc_t), intent(inout) :: file
+
+ ! local variables
+ integer :: ierr
+ !----------------------------------------------------------------------------
+
+ call pio_seterrorhandling(File, PIO_BCAST_ERROR)
+
+ if (docosp) then
+ ierr = pio_def_var(File, 'cosp_cnt_init', pio_int, cospcnt_desc)
+ end if
+
+end subroutine radiation_define_restart
+
+!===============================================================================
+
+subroutine radiation_write_restart(file)
+
+ ! write variables to restart file
+
+ ! arguments
+ type(file_desc_t), intent(inout) :: file
+
+ ! local variables
+ integer :: ierr
+ !----------------------------------------------------------------------------
+
+ if (docosp) then
+ ierr = pio_put_var(File, cospcnt_desc, (/cosp_cnt(begchunk)/))
+ end if
+
+end subroutine radiation_write_restart
+
+!===============================================================================
+
+subroutine radiation_read_restart(file)
+
+ ! read variables from restart file
+
+ ! arguments
+ type(file_desc_t), intent(inout) :: file
+
+ ! local variables
+
+ integer :: err_handling
+ integer :: ierr
+
+ type(var_desc_t) :: vardesc
+ !----------------------------------------------------------------------------
+
+ if (docosp) then
+ call pio_seterrorhandling(File, PIO_BCAST_ERROR, err_handling)
+ ierr = pio_inq_varid(File, 'cosp_cnt_init', vardesc)
+ call pio_seterrorhandling(File, err_handling)
+ if (ierr /= PIO_NOERR) then
+ cosp_cnt_init = 0
+ else
+ ierr = pio_get_var(File, vardesc, cosp_cnt_init)
+ end if
+ end if
+
+end subroutine radiation_read_restart
+
+!===============================================================================
+
+subroutine radiation_tend( &
+!#ifdef SPAERO
+! state, ptend, pbuf, cam_out, cam_in, net_flx, xcdnc, rd_out)
+!#else
+ state, ptend, pbuf, cam_out, cam_in, net_flx, rd_out)
+!#endif
+
+ !-----------------------------------------------------------------------
+ !
+ ! Driver for radiation computation.
+ !
+ ! Revision history:
+ ! 2007-11-05 M. Iacono Install rrtmg_lw and sw as radiation model.
+ ! 2007-12-27 M. Iacono Modify to use CAM cloud optical properties with rrtmg.
+ !
+ !
+ ! 2019-05-06 A. Kirkevåg: Changes for testing the
+ ! "simple plumes" aerosols, based on NorESM1 code P. Räisänen.
+ !-----------------------------------------------------------------------
+
+ use phys_grid, only: get_rlat_all_p, get_rlon_all_p
+ use cam_control_mod, only: eccen, mvelpp, lambm0, obliqr
+ use shr_orb_mod, only: shr_orb_decl, shr_orb_cosz
+
+ use aer_rad_props, only: aer_rad_props_sw, aer_rad_props_lw
+
+ use cloud_rad_props, only: get_ice_optics_sw, get_liquid_optics_sw, liquid_cloud_get_rad_props_lw, &
+ ice_cloud_get_rad_props_lw, cloud_rad_props_get_lw, &
+ snow_cloud_get_rad_props_lw, get_snow_optics_sw
+ use slingo, only: slingo_liq_get_rad_props_lw, slingo_liq_optics_sw
+ use ebert_curry, only: ec_ice_optics_sw, ec_ice_get_rad_props_lw
+
+ use rad_solar_var, only: get_variability
+ use radsw, only: rad_rrtmg_sw
+ use radlw, only: rad_rrtmg_lw
+ use radheat, only: radheat_tend
+
+ use radiation_data, only: rad_data_write
+ use rrtmg_state, only: rrtmg_state_create, rrtmg_state_update, rrtmg_state_destroy, rrtmg_state_t, &
+ num_rrtmg_levs
+
+ use interpolate_data, only: vertinterp
+ use tropopause, only: tropopause_find, TROP_ALG_HYBSTOB, TROP_ALG_CLIMATE
+
+ use cospsimulator_intr, only: docosp, cospsimulator_intr_run, cosp_nradsteps
+
+#ifdef DIRIND
+ use commondefinitions
+ use aerosoldef
+ use opttab, only: nbands, eps
+ use constituents, only: pcnst
+ use oslo_control, only: oslo_getopts
+ use physics_buffer, only: pbuf_get_index
+!#ifdef SPAERO
+! use time_manager, only: get_curr_date
+! use physconst, only: rair
+!#endif
+#endif
+
+#ifdef DIRIND
+ real(r8) flnt_tmp(pcols) ! Net outgoing lw flux at model top for AIE calculations
+ real(r8) volc_fraction_coarse ! Fraction of volcanic aerosols going to coarse mode
+ integer :: band
+ character(len=3) :: c3
+#ifdef AEROFFL
+ logical idrf
+#endif
+#endif
+
+ ! Arguments
+ type(physics_state), intent(in), target :: state
+ type(physics_ptend), intent(out) :: ptend
+
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ type(cam_out_t), intent(inout) :: cam_out
+ type(cam_in_t), intent(in) :: cam_in
+ real(r8), intent(out) :: net_flx(pcols)
+
+ type(rad_out_t), target, optional, intent(out) :: rd_out
+
+
+ ! Local variables
+ type(rad_out_t), pointer :: rd ! allow rd_out to be optional by allocating a local object
+ ! if the argument is not present
+ logical :: write_output
+
+ integer :: i, k
+ integer :: lchnk, ncol
+ logical :: dosw, dolw
+
+#ifdef DIRIND
+ real(r8), pointer, dimension(:,:) :: rvolcmmr ! Read in stratospheric volcanoes aerosol mmr
+ real(r8), pointer, dimension(:,:) :: volcopt ! Read in stratospheric volcano SW optical parameter (CMIP6)
+#endif
+ real(r8) :: calday ! current calendar day
+ real(r8) :: delta ! Solar declination angle in radians
+ real(r8) :: eccf ! Earth orbit eccentricity factor
+ real(r8) :: clat(pcols) ! current latitudes(radians)
+ real(r8) :: clon(pcols) ! current longitudes(radians)
+ real(r8) :: coszrs(pcols) ! Cosine solar zenith angle
+
+ ! Gathered indices of day and night columns
+ ! chunk_column_index = IdxDay(daylight_column_index)
+ integer :: Nday ! Number of daylight columns
+ integer :: Nnite ! Number of night columns
+ integer :: IdxDay(pcols) ! Indices of daylight columns
+ integer :: IdxNite(pcols) ! Indices of night columns
+
+ integer :: itim_old
+
+ real(r8), pointer :: cld(:,:) ! cloud fraction
+ real(r8), pointer :: cldfsnow(:,:) ! cloud fraction of just "snow clouds- whatever they are"
+ real(r8), pointer :: qrs(:,:) ! shortwave radiative heating rate
+ real(r8), pointer :: qrl(:,:) ! longwave radiative heating rate
+ real(r8), pointer :: fsds(:) ! Surface solar down flux
+ real(r8), pointer :: fsns(:) ! Surface solar absorbed flux
+ real(r8), pointer :: fsnt(:) ! Net column abs solar flux at model top
+ real(r8), pointer :: flns(:) ! Srf longwave cooling (up-down) flux
+ real(r8), pointer :: flnt(:) ! Net outgoing lw flux at model top
+
+ real(r8), pointer, dimension(:,:,:) :: su => NULL() ! shortwave spectral flux up
+ real(r8), pointer, dimension(:,:,:) :: sd => NULL() ! shortwave spectral flux down
+ real(r8), pointer, dimension(:,:,:) :: lu => NULL() ! longwave spectral flux up
+ real(r8), pointer, dimension(:,:,:) :: ld => NULL() ! longwave spectral flux down
+
+ ! tropopause diagnostic
+ integer :: troplev(pcols)
+ real(r8) :: p_trop(pcols)
+
+ type(rrtmg_state_t), pointer :: r_state ! contains the atm concentrations in layers needed for RRTMG
+
+ ! cloud radiative parameters are "in cloud" not "in cell"
+ real(r8) :: ice_tau (nswbands,pcols,pver) ! ice extinction optical depth
+ real(r8) :: ice_tau_w (nswbands,pcols,pver) ! ice single scattering albedo * tau
+ real(r8) :: ice_tau_w_g(nswbands,pcols,pver) ! ice assymetry parameter * tau * w
+ real(r8) :: ice_tau_w_f(nswbands,pcols,pver) ! ice forward scattered fraction * tau * w
+ real(r8) :: ice_lw_abs (nlwbands,pcols,pver) ! ice absorption optics depth (LW)
+
+ ! cloud radiative parameters are "in cloud" not "in cell"
+ real(r8) :: liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth
+ real(r8) :: liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau
+ real(r8) :: liq_tau_w_g(nswbands,pcols,pver) ! liquid assymetry parameter * tau * w
+ real(r8) :: liq_tau_w_f(nswbands,pcols,pver) ! liquid forward scattered fraction * tau * w
+ real(r8) :: liq_lw_abs (nlwbands,pcols,pver) ! liquid absorption optics depth (LW)
+
+ ! cloud radiative parameters are "in cloud" not "in cell"
+ real(r8) :: cld_tau (nswbands,pcols,pver) ! cloud extinction optical depth
+ real(r8) :: cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau
+ real(r8) :: cld_tau_w_g(nswbands,pcols,pver) ! cloud assymetry parameter * w * tau
+ real(r8) :: cld_tau_w_f(nswbands,pcols,pver) ! cloud forward scattered fraction * w * tau
+ real(r8) :: cld_lw_abs (nlwbands,pcols,pver) ! cloud absorption optics depth (LW)
+
+!#ifdef SPAERO
+ ! cloud radiative parameters are "in cloud" not "in cell" with SP aerosols
+! real(r8) :: sp_liq_tau (nswbands,pcols,pver) ! liquid extinction optical depth
+! real(r8) :: sp_liq_tau_w (nswbands,pcols,pver) ! liquid single scattering albedo * tau
+! real(r8) :: sp_liq_tau_w_g(nswbands,pcols,pver) ! liquid assymetry parameter * tau * w
+! real(r8) :: sp_liq_tau_w_f(nswbands,pcols,pver) ! liquid forward scattered fraction * tau * w
+! real(r8) :: sp_cld_tau (nswbands,pcols,pver) ! liquid extinction optical depth
+! real(r8) :: sp_cld_tau_w (nswbands,pcols,pver) ! cloud single scattering albedo * tau
+! real(r8) :: sp_cld_tau_w_g(nswbands,pcols,pver) ! cloud assymetry parameter * w * tau
+! real(r8) :: sp_cld_tau_w_f(nswbands,pcols,pver) ! cloud forward scattered fraction * w * tau
+! real(r8) :: sp_cld_lw_abs (nlwbands,pcols,pver) ! cloud absorption optics depth (LW)
+!#endif
+
+ ! cloud radiative parameters are "in cloud" not "in cell"
+ real(r8) :: snow_tau (nswbands,pcols,pver) ! snow extinction optical depth
+ real(r8) :: snow_tau_w (nswbands,pcols,pver) ! snow single scattering albedo * tau
+ real(r8) :: snow_tau_w_g(nswbands,pcols,pver) ! snow assymetry parameter * tau * w
+ real(r8) :: snow_tau_w_f(nswbands,pcols,pver) ! snow forward scattered fraction * tau * w
+ real(r8) :: snow_lw_abs (nlwbands,pcols,pver)! snow absorption optics depth (LW)
+
+ ! combined cloud radiative parameters are "in cloud" not "in cell"
+ real(r8) :: cldfprime(pcols,pver) ! combined cloud fraction (snow plus regular)
+ real(r8) :: c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth
+ real(r8) :: c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau
+ real(r8) :: c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau
+ real(r8) :: c_cld_tau_w_f(nswbands,pcols,pver) ! combined cloud forward scattered fraction * w * tau
+ real(r8) :: c_cld_lw_abs (nlwbands,pcols,pver) ! combined cloud absorption optics depth (LW)
+!#ifdef SPAERO ! and for SP aerosols (only for SW)
+! real(r8) :: sp_c_cld_tau (nswbands,pcols,pver) ! combined cloud extinction optical depth
+! real(r8) :: sp_c_cld_tau_w (nswbands,pcols,pver) ! combined cloud single scattering albedo * tau
+! real(r8) :: sp_c_cld_tau_w_g(nswbands,pcols,pver) ! combined cloud assymetry parameter * w * tau
+! real(r8) :: sp_c_cld_tau_w_f(nswbands,pcols,pver) ! combined cloud forward scattered fraction * w * tau
+!#endif
+
+ real(r8) :: sfac(1:nswbands) ! time varying scaling factors due to Solar Spectral Irrad at 1 A.U. per band
+
+ integer :: icall ! index through climate/diagnostic radiation calls
+ logical :: active_calls(0:N_DIAG)
+
+ ! Aerosol radiative properties
+ real(r8) :: aer_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth
+ real(r8) :: aer_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau
+ real(r8) :: aer_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau
+ real(r8) :: aer_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau
+ real(r8) :: aer_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW)
+
+#ifdef DIRIND
+
+!#ifdef SPAERO
+! Aerosol optical properties, simple plume aerosols
+! real(r8) :: sp_tau (pcols,pver,nswbands) ! aerosol extinction optical depth, simple plumes
+! real(r8) :: sp_ssa (pcols,pver,nswbands) ! aerosol single scattering albedo, simple plumes
+! real(r8) :: sp_asy (pcols,pver,nswbands) ! aerosol assymetry parameter, simple plumes
+!
+! Aerosol optical properties, sum of NorESM + simple plume aerosols
+! real(r8) :: sp_per_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth
+! real(r8) :: sp_per_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau
+! real(r8) :: sp_per_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau
+! real(r8) :: sp_per_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau
+!
+! real(r8), intent(out) :: xcdnc(pcols) ! CDNC modification factor
+! real(r8) :: re_mult(pcols,pver) ! Multiplication factor of liquid cloud effective radius, simple plumes
+! real(r8) :: re_multeq1(pcols,pver) ! Dummy multiplication factor (=1.0) of liquid cloud effective radius, simple plumes
+! real(r8) :: xcdnceq1(pcols) ! Dummy xcdnc
+!
+!!ak real(r8) :: sp_relca(pcols,pver) ! Modified liquid cloud effective radius, simple plumes
+!
+! real(r8) :: year_fr ! Fractional year (1903.0 is the 0Z on the first of January 1903, Gregorian)
+!
+! integer :: yr, mon, day, tod ! date components
+!#endif
+!#ifdef RFMIPIRF
+! real(r8) :: per_aod (pcols,pver,nswbands) ! aerosol single scattering albedo
+! real(r8) :: per_ssa (pcols,pver,nswbands) ! aerosol single scattering albedo
+! real(r8) :: per_asy (pcols,pver,nswbands) ! aerosol assymetry parameter
+!#endif
+
+! Local variables used for calculating aerosol optics and direct and indirect forcings.
+! aodvis and absvis are AOD and absorptive AOD for visible wavelength close to 0.55 um (0.35-0.64)
+! Note that aodvis and absvis output should be devided by dayfoc to give physical (A)AOD values
+ real(r8) qdirind(pcols,pver,pcnst) ! Common tracers for indirect and direct calculations
+ real(r8) aodvis(pcols) ! AOD vis
+ real(r8) absvis(pcols) ! absorptive AOD vis
+ real(r8) clearodvis(pcols), clearabsvis(pcols), cloudfree(pcols), cloudfreemax(pcols)
+#ifdef AEROCOM
+ real(r8) dod440(pcols),dod550(pcols),dod870(pcols),abs550(pcols),abs550alt(pcols)
+ real(r8) clearod440(pcols),clearod550(pcols),clearod870(pcols),clearabs550(pcols),clearabs550alt(pcols)
+!#ifdef RFMIPIRF
+! character(len=2) :: c2
+!#endif
+#endif ! AEROCOM
+ real(r8) ftem_1d(pcols) ! work-array to avoid NAN and pcols/ncol confusion
+ real(r8) Nnatk(pcols,pver,0:nmodes) ! Modal aerosol number concentration
+ real(r8) batotlw(pcols,pver,nlwbands) ! spectral aerosol absportion extinction in LW
+ real(r8) rhoda(pcols,pver) ! air mass density, unit kg/m^3
+ real(r8) :: pmxrgnrf(pcols,pverp) ! temporary copy of pmxrgn
+ integer :: nmxrgnrf(pcols) ! temporary copy of nmxrgn
+ real(r8) :: rhtrunc(pcols,pver) ! relative humidity (as fraction)
+ real(r8) :: per_tau (pcols,0:pver,nswbands) ! aerosol extinction optical depth
+ real(r8) :: per_tau_w (pcols,0:pver,nswbands) ! aerosol single scattering albedo * tau
+ real(r8) :: per_tau_w_g(pcols,0:pver,nswbands) ! aerosol assymetry parameter * w * tau
+ real(r8) :: per_tau_w_f(pcols,0:pver,nswbands) ! aerosol forward scattered fraction * w * tau
+ real(r8) :: per_lw_abs (pcols,pver,nlwbands) ! aerosol absorption optics depth (LW)
+ integer ns ! spectral loop index
+ real(r8) :: volc_ext_sun(pcols,pver,nswbands) ! volcanic aerosol extinction for solar bands, CMIP6
+ real(r8) :: volc_omega_sun(pcols,pver,nswbands) ! volcanic aerosol SSA for solar bands, CMIP6
+ real(r8) :: volc_g_sun(pcols,pver,nswbands) ! volcanic aerosol g for solar bands, CMIP6
+ real(r8) :: volc_ext_earth(pcols,pver,nlwbands) ! volcanic aerosol extinction for terrestrial bands, CMIP6
+ real(r8) :: volc_omega_earth(pcols,pver,nlwbands) ! volcanic aerosol SSA for terrestrial bands, CMIP6
+!#ifdef SPAERO
+! real(r8) deltah_km(pcols,pver) ! Layer thickness, unit km
+!#endif
+#endif
+
+ real(r8) :: fns(pcols,pverp) ! net shortwave flux
+ real(r8) :: fcns(pcols,pverp) ! net clear-sky shortwave flux
+ real(r8) :: fnl(pcols,pverp) ! net longwave flux
+ real(r8) :: fcnl(pcols,pverp) ! net clear-sky longwave flux
+
+ ! for COSP
+ real(r8) :: emis(pcols,pver) ! Cloud longwave emissivity
+ real(r8) :: gb_snow_tau(pcols,pver) ! grid-box mean snow_tau
+ real(r8) :: gb_snow_lw(pcols,pver) ! grid-box mean LW snow optical depth
+
+ real(r8) :: ftem(pcols,pver) ! Temporary workspace for outfld variables
+
+ real(r8) :: freqclr(pcols) ! Frequency of occurrence of clear sky columns
+ real(r8) :: flntclr(pcols) ! Clearsky only columns (zero if cloudy)
+
+ character(*), parameter :: name = 'radiation_tend'
+
+ logical, parameter :: cosz_rad_call=.true. !+tht
+ !--------------------------------------------------------------------------------------
+
+ lchnk = state%lchnk
+ ncol = state%ncol
+
+ if (present(rd_out)) then
+ rd => rd_out
+ write_output = .false.
+ else
+ allocate(rd)
+ write_output=.true.
+ end if
+
+ dosw = radiation_do('sw') ! do shortwave heating calc this timestep?
+ dolw = radiation_do('lw') ! do longwave heating calc this timestep?
+
+ ! Cosine solar zenith angle for current time step
+ calday = get_curr_calday()
+ call get_rlat_all_p(lchnk, ncol, clat)
+ call get_rlon_all_p(lchnk, ncol, clon)
+
+ call shr_orb_decl(calday, eccen, mvelpp, lambm0, obliqr, &
+ delta, eccf)
+ do i = 1, ncol
+ coszrs(i) = shr_orb_cosz(calday, clat(i), clon(i), delta, dt_avg, cosz_rad_call) !+tht
+ end do
+
+ ! Gather night/day column indices.
+ Nday = 0
+ Nnite = 0
+ do i = 1, ncol
+ if ( coszrs(i) > 0.0_r8 ) then
+ Nday = Nday + 1
+ IdxDay(Nday) = i
+ else
+ Nnite = Nnite + 1
+ IdxNite(Nnite) = i
+ end if
+ end do
+
+ ! Associate pointers to physics buffer fields
+ itim_old = pbuf_old_tim_idx()
+ if (cldfsnow_idx > 0) then
+ call pbuf_get_field(pbuf, cldfsnow_idx, cldfsnow, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ endif
+ call pbuf_get_field(pbuf, cld_idx, cld, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+
+ call pbuf_get_field(pbuf, qrs_idx, qrs)
+ call pbuf_get_field(pbuf, qrl_idx, qrl)
+
+ call pbuf_get_field(pbuf, fsnt_idx, fsnt)
+ call pbuf_get_field(pbuf, fsds_idx, fsds)
+ call pbuf_get_field(pbuf, fsns_idx, fsns)
+ call pbuf_get_field(pbuf, flns_idx, flns)
+ call pbuf_get_field(pbuf, flnt_idx, flnt)
+
+ if (spectralflux) then
+ call pbuf_get_field(pbuf, su_idx, su)
+ call pbuf_get_field(pbuf, sd_idx, sd)
+ call pbuf_get_field(pbuf, lu_idx, lu)
+ call pbuf_get_field(pbuf, ld_idx, ld)
+ end if
+
+ ! For CRM, make cloud equal to input observations:
+ if (scm_crm_mode .and. have_cld) then
+ do k = 1, pver
+ cld(:ncol,k)= cldobs(k)
+ end do
+ end if
+
+#ifdef DIRIND
+ qdirind(:ncol,:,:) = state%q(:ncol,:,:)
+ if (has_prescribed_volcaero) then
+ call oslo_getopts(volc_fraction_coarse_out = volc_fraction_coarse)
+ call pbuf_get_field(pbuf, volc_idx, rvolcmmr, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ qdirind(:ncol,:,l_so4_pr) = qdirind(:ncol,:,l_so4_pr) + (1.0_r8 - volc_fraction_coarse)*rvolcmmr(:ncol,:)
+ qdirind(:ncol,:,l_ss_a3) = qdirind(:ncol,:,l_ss_a3) + volc_fraction_coarse*rvolcmmr(:ncol,:)
+ end if
+#endif
+ ! Find tropopause height if needed for diagnostic output
+ if (hist_fld_active('FSNR') .or. hist_fld_active('FLNR')) then
+ call tropopause_find(state, troplev, tropP=p_trop, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE)
+ endif
+
+ if (dosw .or. dolw) then
+
+ ! construct an RRTMG state object
+ r_state => rrtmg_state_create( state, cam_in )
+
+ call t_startf('cldoptics')
+
+ if (cldfsnow_idx > 0) then
+ do k = 1, pver
+ do i = 1, ncol
+ cldfprime(i,k) = max(cld(i,k), cldfsnow(i,k))
+ end do
+ end do
+ else
+ cldfprime(:ncol,:) = cld(:ncol,:)
+ end if
+
+
+ if (dosw) then
+
+!#ifdef SPAERO
+!*********************************** SPAERO + *********************************************
+! Define anthrop. aerosol optical properties and "cdnc" for the "simple plumes" climatology
+
+! CALL get_curr_date(yr, mon, day, tod)
+
+! Petri used a hard-coded year for BACCHUS: either 1850, 1975 or 2005
+
+! yr=2005
+
+! year_fr = yr + (calday-1.0_r8) / 365.0_r8
+
+!ak+ Need deltah_km before pmxsub is called, due to cloud optics (-> input to pmxsub later)
+! do k=1,pver
+!! NB have to multiply with 10 to get the same values as in pmxsub, due to different p units!
+! rhoda(1:ncol,k) = state%pmid(1:ncol,k)/(rair*state%t(1:ncol,k)) ! unit kg/m^3
+! deltah_km(1:ncol,k)=10._r8*1.e-4_r8*(state%pint(1:ncol,k+1)-state%pint(1:ncol,k))/(rhoda(1:ncol,k)*9.8_r8)
+! end do
+
+! initialization
+! re_mult(1:ncol,1:pver) = 1._r8
+! xcdnc(1:ncol) = 1._r8
+! for use in calls without the effect of SP aerosols
+! re_multeq1(1:ncol,1:pver) = 1._r8
+! xcdnceq1(1:ncol) = 1._r8
+!ak-
+
+! CALL simple_plumes_interface(lchnk, ncol, nswbands,state%phis, &
+! deltah_km, clon, clat, year_fr, &
+! sp_tau, sp_ssa, sp_asy, re_mult, xcdnc)
+
+! When using year 1850 for the MACv2-SP aerosols, switch them off entirely
+! IF (yr==1850) THEN
+! sp_tau(1:ncol,1:pver,1:nswbands)=0._r8
+! sp_ssa(1:ncol,1:pver,1:nswbands)=0._r8
+! sp_asy(1:ncol,1:pver,1:nswbands)=0._r8
+! re_mult(1:ncol,1:pver) = 1._r8
+! xcdnc(1:ncol) = 1._r8
+! END IF
+!*********************************** SPAERO - *********************************************
+!#endif
+
+ if (oldcldoptics) then
+ call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp=.false.)
+ call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp=.false.)
+ else
+ select case (icecldoptics)
+ case ('ebertcurry')
+ call ec_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f, oldicewp=.true.)
+ case ('mitchell')
+ call get_ice_optics_sw(state, pbuf, ice_tau, ice_tau_w, ice_tau_w_g, ice_tau_w_f)
+ case default
+ call endrun('iccldoptics must be one either ebertcurry or mitchell')
+ end select
+
+ select case (liqcldoptics)
+ case ('slingo')
+ call slingo_liq_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f, oldliqwp=.true.)
+ case ('gammadist')
+
+!#ifdef SPAERO
+! The order of the two calls below has been tested not to make any difference
+! call get_liquid_optics_sw(state, pbuf, xcdnceq1, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f)
+! call get_liquid_optics_sw(state, pbuf, xcdnc, sp_liq_tau, sp_liq_tau_w, sp_liq_tau_w_g, sp_liq_tau_w_f)
+!#else
+ call get_liquid_optics_sw(state, pbuf, liq_tau, liq_tau_w, liq_tau_w_g, liq_tau_w_f)
+!#endif
+ case default
+ call endrun('liqcldoptics must be either slingo or gammadist')
+ end select
+ end if
+
+ cld_tau(:,:ncol,:) = liq_tau(:,:ncol,:) + ice_tau(:,:ncol,:)
+ cld_tau_w(:,:ncol,:) = liq_tau_w(:,:ncol,:) + ice_tau_w(:,:ncol,:)
+ cld_tau_w_g(:,:ncol,:) = liq_tau_w_g(:,:ncol,:) + ice_tau_w_g(:,:ncol,:)
+ cld_tau_w_f(:,:ncol,:) = liq_tau_w_f(:,:ncol,:) + ice_tau_w_f(:,:ncol,:)
+!#ifdef SPAERO
+! sp_cld_tau(:,:ncol,:) = sp_liq_tau(:,:ncol,:) + ice_tau(:,:ncol,:)
+! sp_cld_tau_w(:,:ncol,:) = sp_liq_tau_w(:,:ncol,:) + ice_tau_w(:,:ncol,:)
+! sp_cld_tau_w_g(:,:ncol,:) = sp_liq_tau_w_g(:,:ncol,:) + ice_tau_w_g(:,:ncol,:)
+! sp_cld_tau_w_f(:,:ncol,:) = sp_liq_tau_w_f(:,:ncol,:) + ice_tau_w_f(:,:ncol,:)
+!#endif
+
+ if (cldfsnow_idx > 0) then
+ ! add in snow
+ call get_snow_optics_sw(state, pbuf, snow_tau, snow_tau_w, snow_tau_w_g, snow_tau_w_f)
+ do i = 1, ncol
+ do k = 1, pver
+
+ if (cldfprime(i,k) > 0._r8) then
+
+ c_cld_tau(:,i,k) = ( cldfsnow(i,k)*snow_tau(:,i,k) &
+ + cld(i,k)*cld_tau(:,i,k) )/cldfprime(i,k)
+
+ c_cld_tau_w(:,i,k) = ( cldfsnow(i,k)*snow_tau_w(:,i,k) &
+ + cld(i,k)*cld_tau_w(:,i,k) )/cldfprime(i,k)
+
+ c_cld_tau_w_g(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_g(:,i,k) &
+ + cld(i,k)*cld_tau_w_g(:,i,k) )/cldfprime(i,k)
+
+ c_cld_tau_w_f(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_f(:,i,k) &
+ + cld(i,k)*cld_tau_w_f(:,i,k) )/cldfprime(i,k)
+ else
+ c_cld_tau(:,i,k) = 0._r8
+ c_cld_tau_w(:,i,k) = 0._r8
+ c_cld_tau_w_g(:,i,k) = 0._r8
+ c_cld_tau_w_f(:,i,k) = 0._r8
+ end if
+ end do
+ end do
+!#ifdef SPAERO
+! do i = 1, ncol
+! do k = 1, pver
+! if (cldfprime(i,k) > 0._r8) then
+! sp_c_cld_tau(:,i,k) = ( cldfsnow(i,k)*snow_tau(:,i,k) &
+! + cld(i,k)*sp_cld_tau(:,i,k) )/cldfprime(i,k)
+! sp_c_cld_tau_w(:,i,k) = ( cldfsnow(i,k)*snow_tau_w(:,i,k) &
+! + cld(i,k)*sp_cld_tau_w(:,i,k) )/cldfprime(i,k)
+! sp_c_cld_tau_w_g(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_g(:,i,k) &
+! + cld(i,k)*sp_cld_tau_w_g(:,i,k) )/cldfprime(i,k)
+! sp_c_cld_tau_w_f(:,i,k) = ( cldfsnow(i,k)*snow_tau_w_f(:,i,k) &
+! + cld(i,k)*sp_cld_tau_w_f(:,i,k) )/cldfprime(i,k)
+! else
+! sp_c_cld_tau(:,i,k) = 0._r8
+! sp_c_cld_tau_w(:,i,k) = 0._r8
+! sp_c_cld_tau_w_g(:,i,k) = 0._r8
+! sp_c_cld_tau_w_f(:,i,k) = 0._r8
+! end if
+! end do
+! end do
+!#endif
+ else
+ c_cld_tau(:,:ncol,:) = cld_tau(:,:ncol,:)
+ c_cld_tau_w(:,:ncol,:) = cld_tau_w(:,:ncol,:)
+ c_cld_tau_w_g(:,:ncol,:) = cld_tau_w_g(:,:ncol,:)
+ c_cld_tau_w_f(:,:ncol,:) = cld_tau_w_f(:,:ncol,:)
+!#ifdef SPAERO
+! sp_c_cld_tau(:,:ncol,:) = sp_cld_tau(:,:ncol,:)
+! sp_c_cld_tau_w(:,:ncol,:) = sp_cld_tau_w(:,:ncol,:)
+! sp_c_cld_tau_w_g(:,:ncol,:) = sp_cld_tau_w_g(:,:ncol,:)
+! sp_c_cld_tau_w_f(:,:ncol,:) = sp_cld_tau_w_f(:,:ncol,:)
+!#endif
+ end if
+
+ ! Output cloud optical depth fields for the visible band
+ rd%tot_icld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:)
+ rd%liq_icld_vistau(:ncol,:) = liq_tau(idx_sw_diag,:ncol,:)
+ rd%ice_icld_vistau(:ncol,:) = ice_tau(idx_sw_diag,:ncol,:)
+
+ if (cldfsnow_idx > 0) then
+ rd%snow_icld_vistau(:ncol,:) = snow_tau(idx_sw_diag,:ncol,:)
+ endif
+
+ ! multiply by total cloud fraction to get gridbox value
+ rd%tot_cld_vistau(:ncol,:) = c_cld_tau(idx_sw_diag,:ncol,:)*cldfprime(:ncol,:)
+
+ ! add fillvalue for night columns
+ do i = 1, Nnite
+ rd%tot_cld_vistau(IdxNite(i),:) = fillvalue
+ rd%tot_icld_vistau(IdxNite(i),:) = fillvalue
+ rd%liq_icld_vistau(IdxNite(i),:) = fillvalue
+ rd%ice_icld_vistau(IdxNite(i),:) = fillvalue
+ if (cldfsnow_idx > 0) then
+ rd%snow_icld_vistau(IdxNite(i),:) = fillvalue
+ end if
+ end do
+
+ if (write_output) call radiation_output_cld(lchnk, ncol, rd)
+
+ end if ! if (dosw)
+
+ if (dolw) then
+
+ if (oldcldoptics) then
+ call cloud_rad_props_get_lw(state, pbuf, cld_lw_abs, oldcloud=.true.)
+ else
+ select case (icecldoptics)
+ case ('ebertcurry')
+ call ec_ice_get_rad_props_lw(state, pbuf, ice_lw_abs, oldicewp=.true.)
+ case ('mitchell')
+ call ice_cloud_get_rad_props_lw(state, pbuf, ice_lw_abs)
+ case default
+ call endrun('iccldoptics must be one either ebertcurry or mitchell')
+ end select
+
+ select case (liqcldoptics)
+ case ('slingo')
+ call slingo_liq_get_rad_props_lw(state, pbuf, liq_lw_abs, oldliqwp=.true.)
+ case ('gammadist')
+ call liquid_cloud_get_rad_props_lw(state, pbuf, liq_lw_abs)
+ case default
+ call endrun('liqcldoptics must be either slingo or gammadist')
+ end select
+
+ cld_lw_abs(:,:ncol,:) = liq_lw_abs(:,:ncol,:) + ice_lw_abs(:,:ncol,:)
+
+ end if
+
+ if (cldfsnow_idx > 0) then
+
+ ! add in snow
+ call snow_cloud_get_rad_props_lw(state, pbuf, snow_lw_abs)
+
+ do i = 1, ncol
+ do k = 1, pver
+ if (cldfprime(i,k) > 0._r8) then
+ c_cld_lw_abs(:,i,k) = ( cldfsnow(i,k)*snow_lw_abs(:,i,k) &
+ + cld(i,k)*cld_lw_abs(:,i,k) )/cldfprime(i,k)
+ else
+ c_cld_lw_abs(:,i,k) = 0._r8
+ end if
+ end do
+ end do
+ else
+ c_cld_lw_abs(:,:ncol,:) = cld_lw_abs(:,:ncol,:)
+ end if
+
+ end if ! if (dolw)
+
+ call t_stopf('cldoptics')
+
+ ! Solar radiation computation
+
+ if (dosw) then
+
+#ifdef DIRIND
+!TEST
+! qdirind(:ncol,:,l_soa_a1) = 0.0_r8
+! qdirind(:ncol,:,l_soa_na) = 0.0_r8
+! qdirind(:ncol,:,l_so4_a1) = 0.0_r8
+! qdirind(:ncol,:,l_so4_na) = 0.0_r8
+!TEST
+!cak+ Calculate CAM5-Oslo/NorESM2 aerosol optical parameters
+! (move to aer_rad_props.F90? No, then it cannot be called for night-time calculations...)
+!
+! Volcanic optics for solar (SW) bands
+ do band=1, solar_bands
+ volc_ext_sun(1:ncol,1:pver,band)=0.0_r8
+ volc_omega_sun(1:ncol,1:pver,band)=0.999_r8
+ volc_g_sun(1:ncol,1:pver,band)=0.5_r8
+ enddo
+ if (has_prescribed_volcaero_cmip6) then
+ do band=1, solar_bands
+ write(c3,'(i3)') band
+ volc_idx = pbuf_get_index('ext_sun'//trim(adjustl(c3)))
+ call pbuf_get_field(pbuf, volc_idx, volcopt, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ volc_ext_sun(1:ncol,1:pver,band)=volcopt(1:ncol,1:pver)
+ volc_idx = pbuf_get_index('omega_sun'//trim(adjustl(c3)))
+ call pbuf_get_field(pbuf, volc_idx, volcopt, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ volc_omega_sun(1:ncol,1:pver,band)=volcopt(1:ncol,1:pver)
+ volc_idx = pbuf_get_index('g_sun'//trim(adjustl(c3)))
+ call pbuf_get_field(pbuf, volc_idx, volcopt, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ volc_g_sun(1:ncol,1:pver,band)=volcopt(1:ncol,1:pver)
+ enddo
+ endif
+! Volcanic optics for terrestrial (LW) bands (g is not used here)
+ do band=1, terrestrial_bands
+ volc_ext_earth(1:ncol,1:pver,band)=0.0_r8
+ volc_omega_earth(1:ncol,1:pver,band)=0.999_r8
+ enddo
+ if (has_prescribed_volcaero_cmip6) then
+ do band=1, terrestrial_bands
+ write(c3,'(i3)') band
+ volc_idx = pbuf_get_index('ext_earth'//trim(adjustl(c3)))
+ call pbuf_get_field(pbuf, volc_idx, volcopt, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ volc_ext_earth(1:ncol,1:pver,band)=volcopt(1:ncol,1:pver)
+
+ volc_idx = pbuf_get_index('omega_earth'//trim(adjustl(c3)))
+ call pbuf_get_field(pbuf, volc_idx, volcopt, start=(/1,1,itim_old/), kount=(/pcols,pver,1/) )
+ volc_omega_earth(1:ncol,1:pver,band)=volcopt(1:ncol,1:pver)
+ enddo
+ endif
+
+ call pmxsub(lchnk, ncol, 10.0_r8*state%pint, state%pmid, &
+ coszrs, state, state%t, cld, qdirind, Nnatk, &
+ per_tau, per_tau_w, per_tau_w_g, per_tau_w_f, &
+ per_lw_abs, &
+ volc_ext_sun, volc_omega_sun, volc_g_sun, &
+ volc_ext_earth, volc_omega_earth, &
+#ifdef AEROCOM
+ aodvis, absvis, dod440, dod550, dod870, abs550, abs550alt)
+#else
+ aodvis, absvis)
+#endif
+
+!#ifdef RFMIPIRF
+!! Extra RFMIP-IRF diagnostics for each SW wave-length/number band
+! per_aod(:,:,:)=0._r8
+! per_ssa(:,:,:)=0._r8
+! per_asy(:,:,:)=0._r8
+! DO i=1,ncol
+!! DO k=0,pver
+! DO k=1,pver
+! DO ns=1,nswbands
+! per_aod(i,k,ns)=per_tau(i,k,ns)
+! per_ssa(i,k,ns)=min(per_tau_w(i,k,ns)/(per_tau(i,k,ns)+eps),1._r8)
+! per_asy(i,k,ns)=min(per_tau_w_g(i,k,ns)/(per_tau_w(i,k,ns)+eps),1._r8)
+! ENDDO
+! ENDDO
+! ENDDO
+! do ns=1,nswbands
+! write(c2,'(I2)') ns
+! call outfld('AERTAUBND'//trim(adjustl(c2)),per_aod(:,:,ns),pcols,lchnk)
+! call outfld('AERSSABND'//trim(adjustl(c2)),per_ssa(:,:,ns),pcols,lchnk)
+! call outfld('AERASYBND'//trim(adjustl(c2)),per_asy(:,:,ns),pcols,lchnk)
+! enddo
+!#endif
+
+!#ifdef SPAERO
+!*********************************** SPAERO + *********************************************
+! Use the anthropogenic aerosol optical properties for the "simple plumes" climatology
+
+! Add "simple plumes" to NorESM2 aerosols (which should be defined using year 1850 emissions)
+
+! Set aerosol optical properties zero for the top layer (0)
+! sp_per_tau(1:ncol,0,1:nswbands) = 0._r8
+! sp_per_tau_w(1:ncol,0,1:nswbands) = 0._r8
+! sp_per_tau_w_g(1:ncol,0,1:nswbands) = 0._r8
+! sp_per_tau_w_f(1:ncol,0,1:nswbands) = 0._r8
+
+! Other layers
+! DO i=1,ncol
+! DO k=1,pver
+! DO ns=1,nswbands
+! sp_per_tau(i,k,ns)=per_tau(i,k,ns) + sp_tau(i,k,ns)
+! sp_per_tau_w(i,k,ns)=per_tau_w(i,k,ns) + sp_tau(i,k,ns)*sp_ssa(i,k,ns)
+! sp_per_tau_w_g(i,k,ns)=per_tau_w_g(i,k,ns) + sp_tau(i,k,ns)*sp_ssa(i,k,ns)*sp_asy(i,k,ns)
+! sp_per_tau_w_f(i,k,ns)=per_tau_w_f(i,k,ns) + sp_tau(i,k,ns)*sp_ssa(i,k,ns)*sp_asy(i,k,ns)**2
+! ENDDO
+! ENDDO
+! ENDDO
+!*********************************** SPAERO - *********************************************
+!#endif
+
+#endif ! DIRIND
+
+ call get_variability(sfac)
+
+ ! Get the active climate/diagnostic shortwave calculations
+ call rad_cnst_get_call_list(active_calls)
+
+ ! The climate (icall==0) calculation must occur last.
+ do icall = N_DIAG, 0, -1
+
+ if (active_calls(icall)) then
+
+ ! update the concentrations in the RRTMG state object
+ call rrtmg_state_update(state, pbuf, icall, r_state)
+
+ !call aer_rad_props_sw(icall, state, pbuf, nnite, idxnite, &
+ ! aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f)
+#ifdef DIRIND
+! A first call with Oslo aerosols set to zero for radiative forcing diagnostics
+! follwoing the Ghan (2013) method:
+
+#ifdef AEROFFL ! for calculation of direct radiative forcing, not necessarily "offline" as such anymore
+ ! (just nudged), but with an extra call with 0 aerosol extiction.
+!
+!akc6+
+ idrf = .true.
+!akc6-
+ call rad_rrtmg_sw( &
+ lchnk, ncol, num_rrtmg_levs, r_state, state%pmid, &
+ cldfprime, &
+!orig aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f, &
+ per_tau*0.0_r8, per_tau_w, per_tau_w_g, per_tau_w_f, &
+ eccf, coszrs, rd%solin, sfac, cam_in%asdir, &
+ cam_in%asdif, cam_in%aldir, cam_in%aldif, qrs, rd%qrsc, &
+ fsnt, rd%fsntc, rd%fsntoa, rd%fsutoa, rd%fsntoac, &
+ rd%fsnirt, rd%fsnrtc, rd%fsnirtsq, fsns, rd%fsnsc, &
+ rd%fsdsc, fsds, cam_out%sols, cam_out%soll, cam_out%solsd, &
+!akc6+
+!#ifdef AEROFFL
+! cam_out%solld, fns, fcns, fds, fdsc, Nday, Nnite, &
+ cam_out%solld, fns, fcns, idrf, Nday, Nnite, &
+!#else
+! cam_out%solld, fns, fcns, Nday, Nnite, &
+!#endif
+!akc6-
+ IdxDay, IdxNite, su, sd, E_cld_tau=c_cld_tau, &
+ E_cld_tau_w=c_cld_tau_w, E_cld_tau_w_g=c_cld_tau_w_g, &
+ E_cld_tau_w_f=c_cld_tau_w_f, old_convert=.false.)
+
+
+ ftem(:ncol,:pver) = qrs(:ncol,:pver)/cpair
+ !
+ ! Dump shortwave radiation information to history tape buffer (diagnostics)
+ !
+!ak Note that DRF fields are now from the per_tau=0 call (clean), no longer with per_tau from pmxsub
+ call outfld('QRS_DRF ',ftem ,pcols,lchnk)
+ ftem(:ncol,:pver) = rd%qrsc(:ncol,:pver)/cpair
+ call outfld('QRSC_DRF',ftem ,pcols,lchnk)
+ call outfld('FSNT_DRF',fsnt(:) ,pcols,lchnk)
+ call outfld('FSNS_DRF',fsns(:) ,pcols,lchnk)
+ call outfld('FSNTCDRF',rd%fsntc(:) ,pcols,lchnk)
+ call outfld('FSNSCDRF',rd%fsnsc(:) ,pcols,lchnk)
+!#ifdef AEROCOM
+ call outfld('FSUTADRF',rd%fsutoa(:),pcols,lchnk)
+ call outfld('FSDS_DRF',fsds(:) ,pcols,lchnk)
+ ftem_1d(1:ncol) = fsds(1:ncol)-fsns(1:ncol)
+ call outfld('FSUS_DRF',ftem_1d,pcols,lchnk)
+ call outfld('FSDSCDRF',rd%fsdsc(:) ,pcols,lchnk)
+!#endif
+ idrf = .false.
+#endif ! AEROFFL
+#endif ! DIRIND
+
+ rd%cld_tau_cloudsim(:ncol,:) = cld_tau(rrtmg_sw_cloudsim_band,:ncol,:)
+ rd%aer_tau550(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag)
+ rd%aer_tau400(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag+1)
+ rd%aer_tau700(:ncol,:) = aer_tau(:ncol,:,idx_sw_diag-1)
+
+! Then the usual call with Oslo aerosols for radiative forcing diagnostics
+
+ call rad_rrtmg_sw( &
+ lchnk, ncol, num_rrtmg_levs, r_state, state%pmid, &
+ cldfprime, &
+#ifdef DIRIND
+ per_tau, per_tau_w, per_tau_w_g, per_tau_w_f, &
+#else
+ aer_tau, aer_tau_w, aer_tau_w_g, aer_tau_w_f, &
+#endif
+ eccf, coszrs, rd%solin, sfac, cam_in%asdir, &
+ cam_in%asdif, cam_in%aldir, cam_in%aldif, qrs, rd%qrsc, &
+ fsnt, rd%fsntc, rd%fsntoa, rd%fsutoa, rd%fsntoac, &
+ rd%fsnirt, rd%fsnrtc, rd%fsnirtsq, fsns, rd%fsnsc, &
+ rd%fsdsc, fsds, cam_out%sols, cam_out%soll, cam_out%solsd, &
+!akc6+
+#ifdef AEROFFL
+! cam_out%solld, fns, fcns, fds, fdsc, Nday, Nnite, &
+ cam_out%solld, fns, fcns, idrf, Nday, Nnite, &
+#else
+ cam_out%solld, fns, fcns, Nday, Nnite, &
+#endif
+!akc6-
+ IdxDay, IdxNite, su, sd, E_cld_tau=c_cld_tau, &
+ E_cld_tau_w=c_cld_tau_w, E_cld_tau_w_g=c_cld_tau_w_g, &
+ E_cld_tau_w_f=c_cld_tau_w_f, old_convert=.false.)
+
+
+!#ifdef SPAERO
+ !
+ ! Dump shortwave radiation information to history tape buffer (diagnostics)
+ !
+! Added, as for BACCHUS by P. Räisänen
+! call outfld('FSNT_SP ',fsnt ,pcols,lchnk)
+! call outfld('FSNS_SP ',fsns ,pcols,lchnk)
+! call outfld('FSNTC_SP',rd%fsntc ,pcols,lchnk)
+! call outfld('FSNSC_SP',rd%fsnsc ,pcols,lchnk)
+!#endif
+
+
+!#ifdef SPAERO
+!*********************************** SPAERO + *********************************************
+! THIRD CALL INCLUDING SIMPLE PLUME AEROSOLS FOR ONLY THE DIRECT EFFECT (SW ERF ari)
+
+! call rad_rrtmg_sw( &
+! lchnk, ncol, num_rrtmg_levs, r_state, state%pmid, &
+! cldfprime, &
+!ak+ per_tau, per_tau_w, per_tau_w_g, per_tau_w_f, &
+! sp_per_tau, sp_per_tau_w, sp_per_tau_w_g, sp_per_tau_w_f, &
+!ak-
+! eccf, coszrs, rd%solin, sfac, cam_in%asdir, &
+! cam_in%asdif, cam_in%aldir, cam_in%aldif, qrs, rd%qrsc, &
+! fsnt, rd%fsntc, rd%fsntoa, rd%fsutoa, rd%fsntoac, &
+! rd%fsnirt, rd%fsnrtc, rd%fsnirtsq, fsns, rd%fsnsc, &
+! rd%fsdsc, fsds, cam_out%sols, cam_out%soll, cam_out%solsd, &
+!akc6+
+!#ifdef AEROFFL
+! cam_out%solld, fns, fcns, idrf, Nday, Nnite, &
+!#else
+! cam_out%solld, fns, fcns, Nday, Nnite, &
+!#endif
+!akc6-
+! IdxDay, IdxNite, su, sd, E_cld_tau=c_cld_tau, &
+! E_cld_tau_w=c_cld_tau_w, E_cld_tau_w_g=c_cld_tau_w_g, &
+! E_cld_tau_w_f=c_cld_tau_w_f, old_convert=.false.)
+
+
+ !
+ ! Dump shortwave radiation information to history tape buffer (diagnostics)
+ !
+! Added, as for BACCHUS by P. Räisänen
+! call outfld('FSNT_SP2',fsnt ,pcols,lchnk)
+! call outfld('FSNS_SP2',fsns ,pcols,lchnk)
+! call outfld('FSNTCSP2',rd%fsntc ,pcols,lchnk)
+! call outfld('FSNSCSP2',rd%fsnsc ,pcols,lchnk)
+
+! FOURTH CALL INCLUDING SIMPLE PLUME AEROSOLS FOR BOTH THE DIRECT AND THE 1. INDIRECT EFFECT
+
+! call rad_rrtmg_sw( &
+! lchnk, ncol, num_rrtmg_levs, r_state, state%pmid, &
+! cldfprime, &
+!ak+ per_tau, per_tau_w, per_tau_w_g, per_tau_w_f, &
+! sp_per_tau, sp_per_tau_w, sp_per_tau_w_g, sp_per_tau_w_f, &
+!ak-
+! eccf, coszrs, rd%solin, sfac, cam_in%asdir, &
+! cam_in%asdif, cam_in%aldir, cam_in%aldif, qrs, rd%qrsc, &
+! fsnt, rd%fsntc, rd%fsntoa, rd%fsutoa, rd%fsntoac, &
+! rd%fsnirt, rd%fsnrtc, rd%fsnirtsq, fsns, rd%fsnsc, &
+! rd%fsdsc, fsds, cam_out%sols, cam_out%soll, cam_out%solsd, &
+!akc6+
+!#ifdef AEROFFL
+! cam_out%solld, fns, fcns, idrf, Nday, Nnite, &
+!#else
+! cam_out%solld, fns, fcns, Nday, Nnite, &
+!#endif
+!akc6-
+!ak+ IdxDay, IdxNite, su, sd, E_cld_tau=c_cld_tau, &
+!ak+ E_cld_tau_w=c_cld_tau_w, E_cld_tau_w_g=c_cld_tau_w_g, &
+!ak+ E_cld_tau_w_f=c_cld_tau_w_f, old_convert=.false.)
+! IdxDay, IdxNite, su, sd, E_cld_tau=sp_c_cld_tau, &
+! E_cld_tau_w=sp_c_cld_tau_w, E_cld_tau_w_g=sp_c_cld_tau_w_g,&
+! E_cld_tau_w_f=sp_c_cld_tau_w_f, old_convert=.false.)
+!ak-
+
+ !
+ ! Dump shortwave radiation information to history tape buffer (diagnostics)
+ !
+! Added, as for BACCHUS by P. Räisänen
+! call outfld('FSNT_SP3',fsnt ,pcols,lchnk)
+! call outfld('FSNS_SP3',fsns ,pcols,lchnk)
+! call outfld('FSNTCSP3',rd%fsntc ,pcols,lchnk)
+! call outfld('FSNSCSP3',rd%fsnsc ,pcols,lchnk)
+
+!*********************************** SPAERO + *********************************************
+!#endif
+
+!#ifdef RFMIPIRF
+! Extra RFMIP-IRF diagnostics for each SW wave-length/number band
+! do ns=1,nswbands
+! write(c2,'(I2)') ns
+! call outfld('SDBND'//trim(adjustl(c2)),sd(:,:,ns),pcols,lchnk)
+! call outfld('SUBND'//trim(adjustl(c2)),su(:,:,ns),pcols,lchnk)
+! enddo
+!#endif
+
+!ak+ Has been moved from above to after the last rad_rrtmg_sw call...
+ ! Output net fluxes at 200 mb
+ call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcns, rd%fsn200c)
+ call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fns, rd%fsn200)
+ if (hist_fld_active('FSNR')) then
+ do i = 1,ncol
+ call vertinterp(1, 1, pverp, state%pint(i,:), p_trop(i), fns(i,:), rd%fsnr(i))
+ end do
+ end if
+ if (write_output) call radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out)
+!ak-
+ end if
+ end do
+
+ end if
+
+#ifdef DIRIND
+ !Calculate cloud-free fraction assuming random overlap
+ !(kind of duplicated from cloud_cover_diags::cldsav)
+ cloudfree(1:ncol) = 1.0_r8
+ cloudfreemax(1:ncol) = 1.0_r8
+
+ !Find cloud-free fraction (note this duplicated code and may not be consistent with cldtot calculated elsewhere)
+ do k = 1, pver
+ do i=1,ncol
+ cloudfree(i) = cloudfree(i) * cloudfreemax(i)
+ cloudfreemax(i) = min(cloudfreemax(i),1.0_r8-cld(i,k))
+ end do
+ end do
+
+ !Calculate AOD (visible) for cloud free
+ do i = 1, ncol
+ clearodvis(i)=cloudfree(i)*aodvis(i)
+ clearabsvis(i)=cloudfree(i)*absvis(i)
+ end do
+! clear-sky AOD and absorptive AOD for visible wavelength close to 0.55 um (0.35-0.64)
+! Note that caodvis and cabsvis output should be devided by dayfoc*cloudfree to give physical (A)AOD values
+ call outfld('CAODVIS ',clearodvis,pcols,lchnk)
+ call outfld('CABSVIS ',clearabsvis,pcols,lchnk)
+ call outfld('CLDFREE ',cloudfree,pcols,lchnk)
+#ifdef AEROCOM
+ do i = 1, ncol
+ clearod440(i)=cloudfree(i)*dod440(i)
+ clearod550(i)=cloudfree(i)*dod550(i)
+ clearod870(i)=cloudfree(i)*dod870(i)
+ clearabs550(i)=cloudfree(i)*abs550(i)
+ clearabs550alt(i)=cloudfree(i)*abs550alt(i)
+ end do
+ call outfld('CDOD440 ',clearod440 ,pcols,lchnk)
+ call outfld('CDOD550 ',clearod550 ,pcols,lchnk)
+ call outfld('CDOD870 ',clearod870 ,pcols,lchnk)
+ call outfld('CABS550 ',clearabs550 ,pcols,lchnk)
+ call outfld('CABS550A',clearabs550alt,pcols,lchnk)
+#endif ! AEROCOM
+#endif ! DIRIND
+
+ ! Output aerosol mmr
+ call rad_cnst_out(0, state, pbuf)
+
+ ! Longwave radiation computation
+
+ if (dolw) then
+
+ call rad_cnst_get_call_list(active_calls)
+
+ ! The climate (icall==0) calculation must occur last.
+ do icall = N_DIAG, 0, -1
+
+ if (active_calls(icall)) then
+
+ ! update the conctrations in the RRTMG state object
+ call rrtmg_state_update( state, pbuf, icall, r_state)
+
+ call aer_rad_props_lw(icall, state, pbuf, aer_lw_abs)
+
+#ifdef DIRIND
+#ifdef AEROFFL ! for calculation of direct and direct radiative forcing
+!
+ call rad_rrtmg_lw( &
+ lchnk, ncol, num_rrtmg_levs, r_state, state%pmid, &
+ per_lw_abs*0.0_r8, cldfprime, c_cld_lw_abs, qrl, rd%qrlc, &
+ flns, flnt, rd%flnsc, rd%flntc, cam_out%flwds, &
+ rd%flut, rd%flutc, fnl, fcnl, rd%fldsc, &
+ lu, ld)
+
+ call outfld('FLNT_DRF',flnt(:) ,pcols,lchnk)
+ call outfld('FLNTCDRF',rd%flntc(:) ,pcols,lchnk)
+#endif ! AEROFFL
+#endif ! DIRIND
+
+ call rad_rrtmg_lw( &
+ lchnk, ncol, num_rrtmg_levs, r_state, state%pmid, &
+#ifdef DIRIND
+ per_lw_abs, cldfprime, c_cld_lw_abs, qrl, rd%qrlc, &
+#else
+ aer_lw_abs, cldfprime, c_cld_lw_abs, qrl, rd%qrlc, &
+#endif
+ flns, flnt, rd%flnsc, rd%flntc, cam_out%flwds, &
+ rd%flut, rd%flutc, fnl, fcnl, rd%fldsc, &
+ lu, ld)
+
+#ifdef DIRIND
+#ifdef AEROFFL ! FLNT_ORG is just for temporary testing vs. FLNT
+!#ifdef AEROCOM
+! call outfld('FLNT_ORG',flnt(:) ,pcols,lchnk)
+ ftem_1d(1:ncol) = cam_out%flwds(1:ncol) - flns(1:ncol)
+ call outfld('FLUS ',ftem_1d ,pcols,lchnk)
+!#endif ! AEROCOM
+#endif ! AEROFFL
+!#ifdef AEROCOM
+! do i=1,ncol
+! do k=1,pver
+! aerlwabs01(i,k) = aer_lw_abs(i,k,16)
+! end do
+! end do
+! call outfld('AERLWA01',aerlwabs01,pcols,lchnk)
+!#endif
+
+!#ifdef RFMIPIRF
+! Extra RFMIP-IRF diagnostics for each LW wave-length/number band
+! do ns=1,nlwbands
+! write(c2,'(I2)') ns
+! call outfld('LDBND'//trim(adjustl(c2)),ld(:,:,ns),pcols,lchnk)
+! call outfld('LUBND'//trim(adjustl(c2)),lu(:,:,ns),pcols,lchnk)
+! enddo
+!#endif
+
+#endif ! DIRIND
+
+ ! Output fluxes at 200 mb
+ call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fnl, rd%fln200)
+ call vertinterp(ncol, pcols, pverp, state%pint, 20000._r8, fcnl, rd%fln200c)
+ if (hist_fld_active('FLNR')) then
+ do i = 1,ncol
+ call vertinterp(1, 1, pverp, state%pint(i,:), p_trop(i), fnl(i,:), rd%flnr(i))
+ end do
+ end if
+
+ flntclr(:) = 0._r8
+ freqclr(:) = 0._r8
+ do i = 1, ncol
+ if (maxval(cldfprime(i,:)) <= 0.1_r8) then
+ freqclr(i) = 1._r8
+ flntclr(i) = rd%flntc(i)
+ end if
+ end do
+
+ if (write_output) call radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out, freqclr, flntclr)
+
+ end if
+ end do
+
+ end if
+
+ ! deconstruct the RRTMG state object
+ call rrtmg_state_destroy(r_state)
+
+ if (docosp) then
+
+ ! initialize and calculate emis
+ emis(:,:) = 0._r8
+ emis(:ncol,:) = 1._r8 - exp(-cld_lw_abs(rrtmg_lw_cloudsim_band,:ncol,:))
+ call outfld('EMIS', emis, pcols, lchnk)
+
+ ! compute grid-box mean SW and LW snow optical depth for use by COSP
+ gb_snow_tau(:,:) = 0._r8
+ gb_snow_lw(:,:) = 0._r8
+ if (cldfsnow_idx > 0) then
+ do i = 1, ncol
+ do k = 1, pver
+ if (cldfsnow(i,k) > 0._r8) then
+ gb_snow_tau(i,k) = snow_tau(rrtmg_sw_cloudsim_band,i,k)*cldfsnow(i,k)
+ gb_snow_lw(i,k) = snow_lw_abs(rrtmg_lw_cloudsim_band,i,k)*cldfsnow(i,k)
+ end if
+ end do
+ end do
+ end if
+
+ ! advance counter for this timestep (chunk dimension required for thread safety)
+ cosp_cnt(lchnk) = cosp_cnt(lchnk) + 1
+
+ ! if counter is the same as cosp_nradsteps, run cosp and reset counter
+ if (cosp_nradsteps .eq. cosp_cnt(lchnk)) then
+
+ ! N.B.: For snow optical properties, the GRID-BOX MEAN shortwave and longwave
+ ! optical depths are passed.
+ call cospsimulator_intr_run(state, pbuf, cam_in, emis, coszrs, &
+ cld_swtau_in=cld_tau(rrtmg_sw_cloudsim_band,:,:),&
+ snow_tau_in=gb_snow_tau, snow_emis_in=gb_snow_lw)
+ cosp_cnt(lchnk) = 0
+ end if
+ end if
+
+ else ! if (dosw .or. dolw) then
+
+ ! convert radiative heating rates from Q*dp to Q for energy conservation
+ do k =1 , pver
+ do i = 1, ncol
+ qrs(i,k) = qrs(i,k)/state%pdel(i,k)
+ qrl(i,k) = qrl(i,k)/state%pdel(i,k)
+ end do
+ end do
+
+ end if ! if (dosw .or. dolw) then
+
+ ! output rad inputs and resulting heating rates
+ call rad_data_write( pbuf, state, cam_in, coszrs )
+
+ ! Compute net radiative heating tendency
+ call radheat_tend(state, pbuf, ptend, qrl, qrs, fsns, &
+ fsnt, flns, flnt, cam_in%asdir, net_flx)
+
+ if (write_output) then
+ ! Compute heating rate for dtheta/dt
+ do k = 1, pver
+ do i = 1, ncol
+ ftem(i,k) = (qrs(i,k) + qrl(i,k))/cpair * (1.e5_r8/state%pmid(i,k))**cappa
+ end do
+ end do
+ call outfld('HR', ftem, pcols, lchnk)
+ end if
+
+ ! convert radiative heating rates to Q*dp for energy conservation
+ do k = 1, pver
+ do i = 1, ncol
+ qrs(i,k) = qrs(i,k)*state%pdel(i,k)
+ qrl(i,k) = qrl(i,k)*state%pdel(i,k)
+ end do
+ end do
+
+ cam_out%netsw(:ncol) = fsns(:ncol)
+
+ if (.not. present(rd_out)) then
+ deallocate(rd)
+ end if
+
+end subroutine radiation_tend
+
+!===============================================================================
+
+subroutine radiation_output_sw(lchnk, ncol, icall, rd, pbuf, cam_out)
+
+ ! Dump shortwave radiation information to history buffer.
+
+ integer , intent(in) :: lchnk
+ integer, intent(in) :: ncol
+ integer, intent(in) :: icall
+ type(rad_out_t), intent(in) :: rd
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ type(cam_out_t), intent(in) :: cam_out
+
+ ! local variables
+ real(r8), pointer :: qrs(:,:)
+ real(r8), pointer :: fsnt(:)
+ real(r8), pointer :: fsns(:)
+ real(r8), pointer :: fsds(:)
+
+ real(r8) :: ftem(pcols)
+ !----------------------------------------------------------------------------
+
+ call pbuf_get_field(pbuf, qrs_idx, qrs)
+ call pbuf_get_field(pbuf, fsnt_idx, fsnt)
+ call pbuf_get_field(pbuf, fsns_idx, fsns)
+ call pbuf_get_field(pbuf, fsds_idx, fsds)
+
+ call outfld('SOLIN'//diag(icall), rd%solin, pcols, lchnk)
+
+ call outfld('QRS'//diag(icall), qrs(:ncol,:)/cpair, ncol, lchnk)
+ call outfld('QRSC'//diag(icall), rd%qrsc(:ncol,:)/cpair, ncol, lchnk)
+
+ call outfld('FSNT'//diag(icall), fsnt, pcols, lchnk)
+ call outfld('FSNTC'//diag(icall), rd%fsntc, pcols, lchnk)
+ call outfld('FSNTOA'//diag(icall), rd%fsntoa, pcols, lchnk)
+ call outfld('FSNTOAC'//diag(icall), rd%fsntoac, pcols, lchnk)
+
+ ftem(:ncol) = rd%fsntoa(:ncol) - rd%fsntoac(:ncol)
+ call outfld('SWCF'//diag(icall), ftem, pcols, lchnk)
+
+ call outfld('FSUTOA'//diag(icall), rd%fsutoa, pcols, lchnk)
+
+ call outfld('FSNIRTOA'//diag(icall), rd%fsnirt, pcols, lchnk)
+ call outfld('FSNRTOAC'//diag(icall), rd%fsnrtc, pcols, lchnk)
+ call outfld('FSNRTOAS'//diag(icall), rd%fsnirtsq, pcols, lchnk)
+
+ call outfld('FSN200'//diag(icall), rd%fsn200, pcols, lchnk)
+ call outfld('FSN200C'//diag(icall), rd%fsn200c, pcols, lchnk)
+
+ call outfld('FSNR'//diag(icall), rd%fsnr, pcols, lchnk)
+
+ call outfld('SOLS'//diag(icall), cam_out%sols, pcols, lchnk)
+ call outfld('SOLL'//diag(icall), cam_out%soll, pcols, lchnk)
+ call outfld('SOLSD'//diag(icall), cam_out%solsd, pcols, lchnk)
+ call outfld('SOLLD'//diag(icall), cam_out%solld, pcols, lchnk)
+
+ call outfld('FSNS'//diag(icall), fsns, pcols, lchnk)
+ call outfld('FSNSC'//diag(icall), rd%fsnsc, pcols, lchnk)
+
+ call outfld('FSDS'//diag(icall), fsds, pcols, lchnk)
+ call outfld('FSDSC'//diag(icall), rd%fsdsc, pcols, lchnk)
+
+end subroutine radiation_output_sw
+
+
+!===============================================================================
+
+subroutine radiation_output_cld(lchnk, ncol, rd)
+
+ ! Dump shortwave cloud optics information to history buffer.
+
+ integer , intent(in) :: lchnk
+ integer, intent(in) :: ncol
+ type(rad_out_t), intent(in) :: rd
+ !----------------------------------------------------------------------------
+
+ call outfld('TOT_CLD_VISTAU', rd%tot_cld_vistau, pcols, lchnk)
+ call outfld('TOT_ICLD_VISTAU', rd%tot_icld_vistau, pcols, lchnk)
+ call outfld('LIQ_ICLD_VISTAU', rd%liq_icld_vistau, pcols, lchnk)
+ call outfld('ICE_ICLD_VISTAU', rd%ice_icld_vistau, pcols, lchnk)
+ if (cldfsnow_idx > 0) then
+ call outfld('SNOW_ICLD_VISTAU', rd%snow_icld_vistau, pcols, lchnk)
+ endif
+
+end subroutine radiation_output_cld
+
+!===============================================================================
+
+subroutine radiation_output_lw(lchnk, ncol, icall, rd, pbuf, cam_out, freqclr, flntclr)
+
+ ! Dump longwave radiation information to history buffer
+
+ integer, intent(in) :: lchnk
+ integer, intent(in) :: ncol
+ integer, intent(in) :: icall ! icall=0 for climate diagnostics
+ type(rad_out_t), intent(in) :: rd
+ type(physics_buffer_desc), pointer :: pbuf(:)
+ type(cam_out_t), intent(in) :: cam_out
+ real(r8), intent(in) :: freqclr(pcols)
+ real(r8), intent(in) :: flntclr(pcols)
+
+ ! local variables
+ real(r8), pointer :: qrl(:,:)
+ real(r8), pointer :: flnt(:)
+ real(r8), pointer :: flns(:)
+
+ real(r8) :: ftem(pcols)
+ !----------------------------------------------------------------------------
+
+ call pbuf_get_field(pbuf, qrl_idx, qrl)
+ call pbuf_get_field(pbuf, flnt_idx, flnt)
+ call pbuf_get_field(pbuf, flns_idx, flns)
+
+ call outfld('QRL'//diag(icall), qrl(:ncol,:)/cpair, ncol, lchnk)
+ call outfld('QRLC'//diag(icall), rd%qrlc(:ncol,:)/cpair, ncol, lchnk)
+
+ call outfld('FLNT'//diag(icall), flnt, pcols, lchnk)
+ call outfld('FLNTC'//diag(icall), rd%flntc, pcols, lchnk)
+
+ call outfld('FREQCLR'//diag(icall), freqclr, pcols, lchnk)
+ call outfld('FLNTCLR'//diag(icall), flntclr, pcols, lchnk)
+
+ call outfld('FLUT'//diag(icall), rd%flut, pcols, lchnk)
+ call outfld('FLUTC'//diag(icall), rd%flutc, pcols, lchnk)
+
+ ftem(:ncol) = rd%flutc(:ncol) - rd%flut(:ncol)
+ call outfld('LWCF'//diag(icall), ftem, pcols, lchnk)
+
+ call outfld('FLN200'//diag(icall), rd%fln200, pcols, lchnk)
+ call outfld('FLN200C'//diag(icall), rd%fln200c, pcols, lchnk)
+
+ call outfld('FLNR'//diag(icall), rd%flnr, pcols, lchnk)
+
+ call outfld('FLNS'//diag(icall), flns, pcols, lchnk)
+ call outfld('FLNSC'//diag(icall), rd%flnsc, pcols, lchnk)
+
+ call outfld('FLDS'//diag(icall), cam_out%flwds, pcols, lchnk)
+ call outfld('FLDSC'//diag(icall), rd%fldsc, pcols, lchnk)
+
+end subroutine radiation_output_lw
+
+!===============================================================================
+
+subroutine calc_col_mean(state, mmr_pointer, mean_value)
+
+ ! Compute the column mean mass mixing ratio.
+
+ type(physics_state), intent(in) :: state
+ real(r8), dimension(:,:), pointer :: mmr_pointer ! mass mixing ratio (lev)
+ real(r8), dimension(pcols), intent(out) :: mean_value ! column mean mmr
+
+ integer :: i, k, ncol
+ real(r8) :: ptot(pcols)
+ !-----------------------------------------------------------------------
+
+ ncol = state%ncol
+ mean_value = 0.0_r8
+ ptot = 0.0_r8
+
+ do k=1,pver
+ do i=1,ncol
+ mean_value(i) = mean_value(i) + mmr_pointer(i,k)*state%pdeldry(i,k)
+ ptot(i) = ptot(i) + state%pdeldry(i,k)
+ end do
+ end do
+ do i=1,ncol
+ mean_value(i) = mean_value(i) / ptot(i)
+ end do
+
+end subroutine calc_col_mean
+
+!===============================================================================
+
+end module radiation
+
diff --git a/src/physics/cam_oslo/radlw.F90 b/src/physics/cam_oslo/radlw.F90
new file mode 100644
index 0000000000..df8dd0c4b5
--- /dev/null
+++ b/src/physics/cam_oslo/radlw.F90
@@ -0,0 +1,324 @@
+
+module radlw
+!-----------------------------------------------------------------------
+!
+! Purpose: Longwave radiation calculations.
+!
+!-----------------------------------------------------------------------
+
+!akc6+
+#include
+!akc6-
+
+use shr_kind_mod, only: r8 => shr_kind_r8
+use ppgrid, only: pcols, pver, pverp
+use scamMod, only: single_column, scm_crm_mode
+use parrrtm, only: nbndlw, ngptlw
+use rrtmg_lw_init, only: rrtmg_lw_ini
+use rrtmg_lw_rad, only: rrtmg_lw
+use spmd_utils, only: masterproc
+use perf_mod, only: t_startf, t_stopf
+use cam_logfile, only: iulog
+use cam_abortutils, only: endrun
+use radconstants, only: nlwbands
+
+implicit none
+
+private
+save
+
+! Public methods
+
+public ::&
+ radlw_init, &! initialize constants
+ rad_rrtmg_lw ! driver for longwave radiation code
+
+! Private data
+integer :: ntoplw ! top level to solve for longwave cooling
+
+! Flag for cloud overlap method
+! 0=clear, 1=random, 2=maximum/random, 3=maximum
+integer, parameter :: icld = 2
+
+
+!===============================================================================
+CONTAINS
+!===============================================================================
+
+subroutine rad_rrtmg_lw(lchnk ,ncol ,rrtmg_levs,r_state, &
+ pmid ,aer_lw_abs,cld ,tauc_lw, &
+ qrl ,qrlc , &
+ flns ,flnt ,flnsc ,flntc ,flwds, &
+ flut ,flutc ,fnl ,fcnl ,fldsc, &
+ lu ,ld )
+
+!-----------------------------------------------------------------------
+ use cam_history, only: outfld
+ use mcica_subcol_gen_lw, only: mcica_subcol_lw
+ use physconst, only: cpair
+ use rrtmg_state, only: rrtmg_state_t
+
+!------------------------------Arguments--------------------------------
+!
+! Input arguments
+!
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ integer, intent(in) :: rrtmg_levs ! number of levels rad is applied
+
+!
+! Input arguments which are only passed to other routines
+!
+ type(rrtmg_state_t), intent(in) :: r_state
+
+ real(r8), intent(in) :: pmid(pcols,pver) ! Level pressure (Pascals)
+
+ real(r8), intent(in) :: aer_lw_abs (pcols,pver,nbndlw) ! aerosol absorption optics depth (LW)
+
+ real(r8), intent(in) :: cld(pcols,pver) ! Cloud cover
+ real(r8), intent(in) :: tauc_lw(nbndlw,pcols,pver) ! Cloud longwave optical depth by band
+
+!
+! Output arguments
+!
+ real(r8), intent(out) :: qrl (pcols,pver) ! Longwave heating rate
+ real(r8), intent(out) :: qrlc(pcols,pver) ! Clearsky longwave heating rate
+ real(r8), intent(out) :: flns(pcols) ! Surface cooling flux
+ real(r8), intent(out) :: flnt(pcols) ! Net outgoing flux
+ real(r8), intent(out) :: flut(pcols) ! Upward flux at top of model
+ real(r8), intent(out) :: flnsc(pcols) ! Clear sky surface cooing
+ real(r8), intent(out) :: flntc(pcols) ! Net clear sky outgoing flux
+ real(r8), intent(out) :: flutc(pcols) ! Upward clear-sky flux at top of model
+ real(r8), intent(out) :: flwds(pcols) ! Down longwave flux at surface
+ real(r8), intent(out) :: fldsc(pcols) ! Down longwave clear flux at surface
+ real(r8), intent(out) :: fcnl(pcols,pverp) ! clear sky net flux at interfaces
+ real(r8), intent(out) :: fnl(pcols,pverp) ! net flux at interfaces
+
+ real(r8), pointer, dimension(:,:,:) :: lu ! longwave spectral flux up
+ real(r8), pointer, dimension(:,:,:) :: ld ! longwave spectral flux down
+
+!
+!---------------------------Local variables-----------------------------
+!
+ integer :: i, k, kk, nbnd ! indices
+
+ real(r8) :: ful(pcols,pverp) ! Total upwards longwave flux
+ real(r8) :: fsul(pcols,pverp) ! Clear sky upwards longwave flux
+ real(r8) :: fdl(pcols,pverp) ! Total downwards longwave flux
+ real(r8) :: fsdl(pcols,pverp) ! Clear sky downwards longwv flux
+
+ real(r8) :: tsfc(pcols) ! surface temperature
+ real(r8) :: emis(pcols,nbndlw) ! surface emissivity
+
+ real(r8) :: taua_lw(pcols,rrtmg_levs-1,nbndlw) ! aerosol optical depth by band
+
+ real(r8), parameter :: dps = 1._r8/86400._r8 ! Inverse of seconds per day
+
+ ! Cloud arrays for McICA
+ integer, parameter :: nsubclw = ngptlw ! rrtmg_lw g-point (quadrature point) dimension
+ integer :: permuteseed ! permute seed for sub-column generator
+
+ real(r8) :: cicewp(pcols,rrtmg_levs-1) ! in-cloud cloud ice water path
+ real(r8) :: cliqwp(pcols,rrtmg_levs-1) ! in-cloud cloud liquid water path
+ real(r8) :: rei(pcols,rrtmg_levs-1) ! ice particle effective radius (microns)
+ real(r8) :: rel(pcols,rrtmg_levs-1) ! liquid particle radius (micron)
+
+ real(r8) :: cld_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud fraction (mcica)
+ real(r8) :: cicewp_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud ice water path (mcica)
+ real(r8) :: cliqwp_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud liquid water path (mcica)
+ real(r8) :: rei_stolw(pcols,rrtmg_levs-1) ! ice particle size (mcica)
+ real(r8) :: rel_stolw(pcols,rrtmg_levs-1) ! liquid particle size (mcica)
+ real(r8) :: tauc_stolw(nsubclw, pcols, rrtmg_levs-1) ! cloud optical depth (mcica - optional)
+
+ ! Includes extra layer above model top
+ real(r8) :: uflx(pcols,rrtmg_levs+1) ! Total upwards longwave flux
+ real(r8) :: uflxc(pcols,rrtmg_levs+1) ! Clear sky upwards longwave flux
+ real(r8) :: dflx(pcols,rrtmg_levs+1) ! Total downwards longwave flux
+ real(r8) :: dflxc(pcols,rrtmg_levs+1) ! Clear sky downwards longwv flux
+ real(r8) :: hr(pcols,rrtmg_levs) ! Longwave heating rate (K/d)
+ real(r8) :: hrc(pcols,rrtmg_levs) ! Clear sky longwave heating rate (K/d)
+ real(r8) lwuflxs(nbndlw,pcols,pverp+1) ! Longwave spectral flux up
+ real(r8) lwdflxs(nbndlw,pcols,pverp+1) ! Longwave spectral flux down
+ !-----------------------------------------------------------------------
+
+ ! mji/rrtmg
+
+ ! Calculate cloud optical properties here if using CAM method, or if using one of the
+ ! methods in RRTMG_LW, then pass in cloud physical properties and zero out cloud optical
+ ! properties here
+
+ ! Zero optional cloud optical depth input array tauc_lw,
+ ! if inputting cloud physical properties into RRTMG_LW
+ ! tauc_lw(:,:,:) = 0.
+ ! Or, pass in CAM cloud longwave optical depth to RRTMG_LW
+ ! do nbnd = 1, nbndlw
+ ! tauc_lw(nbnd,:ncol,:pver) = cldtau(:ncol,:pver)
+ ! end do
+
+ ! Call mcica sub-column generator for RRTMG_LW
+
+ ! Call sub-column generator for McICA in radiation
+ call t_startf('mcica_subcol_lw')
+
+ ! Set permute seed (must be offset between LW and SW by at least 140 to insure
+ ! effective randomization)
+ permuteseed = 150
+
+ ! These fields are no longer supplied by CAM.
+ cicewp = 0.0_r8
+ cliqwp = 0.0_r8
+ rei = 0.0_r8
+ rel = 0.0_r8
+
+ call mcica_subcol_lw(lchnk, ncol, rrtmg_levs-1, icld, permuteseed, pmid(:, pverp-rrtmg_levs+1:pverp-1), &
+ cld(:, pverp-rrtmg_levs+1:pverp-1), cicewp, cliqwp, rei, rel, tauc_lw(:, :ncol, pverp-rrtmg_levs+1:pverp-1), &
+ cld_stolw, cicewp_stolw, cliqwp_stolw, rei_stolw, rel_stolw, tauc_stolw)
+
+ call t_stopf('mcica_subcol_lw')
+
+
+ call t_startf('rrtmg_lw')
+
+ ! Convert incoming water amounts from specific humidity to vmr as needed;
+ ! Convert other incoming molecular amounts from mmr to vmr as needed;
+ ! Convert pressures from Pa to hPa;
+ ! Set surface emissivity to 1.0 here, this is treated in land surface model;
+ ! Set surface temperature
+ ! Set aerosol optical depth to zero for now
+
+ emis(:ncol,:nbndlw) = 1._r8
+ tsfc(:ncol) = r_state%tlev(:ncol,rrtmg_levs+1)
+ taua_lw(:ncol, 1:rrtmg_levs-1, :nbndlw) = aer_lw_abs(:ncol,pverp-rrtmg_levs+1:pverp-1,:nbndlw)
+
+
+ if (associated(lu)) lu(1:ncol,:,:) = 0.0_r8
+ if (associated(ld)) ld(1:ncol,:,:) = 0.0_r8
+!#ifdef RFMIPIRF
+! lu(1:ncol,:,:) = 0.0_r8
+! ld(1:ncol,:,:) = 0.0_r8
+!#endif
+
+ call rrtmg_lw(lchnk ,ncol ,rrtmg_levs ,icld , &
+ r_state%pmidmb ,r_state%pintmb ,r_state%tlay ,r_state%tlev ,tsfc ,r_state%h2ovmr, &
+ r_state%o3vmr ,r_state%co2vmr ,r_state%ch4vmr ,r_state%o2vmr ,r_state%n2ovmr ,r_state%cfc11vmr,r_state%cfc12vmr, &
+ r_state%cfc22vmr,r_state%ccl4vmr ,emis ,&
+ cld_stolw,tauc_stolw,cicewp_stolw,cliqwp_stolw ,rei, rel, &
+ taua_lw, &
+ uflx ,dflx ,hr ,uflxc ,dflxc ,hrc, &
+ lwuflxs, lwdflxs)
+
+ !
+ !----------------------------------------------------------------------
+ ! All longitudes: store history tape quantities
+ ! Flux units are in W/m2 on output from rrtmg_lw and contain output for
+ ! extra layer above model top with vertical indexing from bottom to top.
+ ! Heating units are in K/d on output from RRTMG and contain output for
+ ! extra layer above model top with vertical indexing from bottom to top.
+ ! Heating units are converted to J/kg/s below for use in CAM.
+
+ flwds(:ncol) = dflx (:ncol,1)
+ fldsc(:ncol) = dflxc(:ncol,1)
+ flns(:ncol) = uflx (:ncol,1) - dflx (:ncol,1)
+ flnsc(:ncol) = uflxc(:ncol,1) - dflxc(:ncol,1)
+ flnt(:ncol) = uflx (:ncol,rrtmg_levs) - dflx (:ncol,rrtmg_levs)
+ flntc(:ncol) = uflxc(:ncol,rrtmg_levs) - dflxc(:ncol,rrtmg_levs)
+ flut(:ncol) = uflx (:ncol,rrtmg_levs)
+ flutc(:ncol) = uflxc(:ncol,rrtmg_levs)
+
+ !
+ ! Reverse vertical indexing here for CAM arrays to go from top to bottom.
+ !
+ ful = 0._r8
+ fdl = 0._r8
+ fsul = 0._r8
+ fsdl = 0._r8
+ ful (:ncol,pverp-rrtmg_levs+1:pverp)= uflx(:ncol,rrtmg_levs:1:-1)
+ fdl (:ncol,pverp-rrtmg_levs+1:pverp)= dflx(:ncol,rrtmg_levs:1:-1)
+ fsul(:ncol,pverp-rrtmg_levs+1:pverp)=uflxc(:ncol,rrtmg_levs:1:-1)
+ fsdl(:ncol,pverp-rrtmg_levs+1:pverp)=dflxc(:ncol,rrtmg_levs:1:-1)
+
+#ifndef OSLO_AERO
+ if (single_column.and.scm_crm_mode) then
+#endif
+ call outfld('FUL ',ful,pcols,lchnk)
+ call outfld('FDL ',fdl,pcols,lchnk)
+ call outfld('FULC ',fsul,pcols,lchnk)
+ call outfld('FDLC ',fsdl,pcols,lchnk)
+#ifndef OSLO_AERO
+ endif
+#endif
+
+ fnl(:ncol,:) = ful(:ncol,:) - fdl(:ncol,:)
+ ! mji/ cam excluded this?
+ fcnl(:ncol,:) = fsul(:ncol,:) - fsdl(:ncol,:)
+
+ ! Pass longwave heating to CAM arrays and convert from K/d to J/kg/s
+ qrl = 0._r8
+ qrlc = 0._r8
+ qrl (:ncol,pverp-rrtmg_levs+1:pver)=hr (:ncol,rrtmg_levs-1:1:-1)*cpair*dps
+ qrlc(:ncol,pverp-rrtmg_levs+1:pver)=hrc(:ncol,rrtmg_levs-1:1:-1)*cpair*dps
+
+ ! Return 0 above solution domain
+ if ( ntoplw > 1 )then
+ qrl(:ncol,:ntoplw-1) = 0._r8
+ qrlc(:ncol,:ntoplw-1) = 0._r8
+ end if
+
+ ! Pass spectral fluxes, reverse layering
+ ! order=(/3,1,2/) maps the first index of lwuflxs to the third index of lu.
+!#ifndef RFMIPIRF
+ if (associated(lu)) then
+!#endif
+ lu(:ncol,pverp-rrtmg_levs+1:pverp,:) = reshape(lwuflxs(:,:ncol,rrtmg_levs:1:-1), &
+ (/ncol,rrtmg_levs,nbndlw/), order=(/3,1,2/))
+!#ifndef RFMIPIRF
+ end if
+!#endif
+
+!#ifndef RFMIPIRF
+ if (associated(ld)) then
+!#endif
+ ld(:ncol,pverp-rrtmg_levs+1:pverp,:) = reshape(lwdflxs(:,:ncol,rrtmg_levs:1:-1), &
+ (/ncol,rrtmg_levs,nbndlw/), order=(/3,1,2/))
+!#ifndef RFMIPIRF
+ end if
+!#endif
+
+ call t_stopf('rrtmg_lw')
+
+end subroutine rad_rrtmg_lw
+
+!-------------------------------------------------------------------------------
+
+subroutine radlw_init()
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Initialize various constants for radiation scheme.
+!
+!-----------------------------------------------------------------------
+
+ use ref_pres, only : pref_mid
+
+ integer :: k
+
+ ! If the top model level is above ~90 km (0.1 Pa), set the top level to compute
+ ! longwave cooling to about 80 km (1 Pa)
+ if (pref_mid(1) .lt. 0.1_r8) then
+ do k = 1, pver
+ if (pref_mid(k) .lt. 1._r8) ntoplw = k
+ end do
+ else
+ ntoplw = 1
+ end if
+ if (masterproc) then
+ write(iulog,*) 'radlw_init: ntoplw =',ntoplw
+ endif
+
+ call rrtmg_lw_ini
+
+end subroutine radlw_init
+
+!-------------------------------------------------------------------------------
+
+end module radlw
diff --git a/src/physics/cam_oslo/radsw.F90 b/src/physics/cam_oslo/radsw.F90
new file mode 100644
index 0000000000..24a3b865fd
--- /dev/null
+++ b/src/physics/cam_oslo/radsw.F90
@@ -0,0 +1,720 @@
+
+module radsw
+!-----------------------------------------------------------------------
+!
+! Purpose: Solar radiation calculations.
+!
+!-----------------------------------------------------------------------
+
+!akc6+
+#include
+!akc6-
+
+use shr_kind_mod, only: r8 => shr_kind_r8
+use ppgrid, only: pcols, pver, pverp
+use cam_abortutils, only: endrun
+use cam_history, only: outfld
+use scamMod, only: single_column,scm_crm_mode,have_asdir, &
+ asdirobs, have_asdif, asdifobs, have_aldir, &
+ aldirobs, have_aldif, aldifobs
+use cam_logfile, only: iulog
+use parrrsw, only: nbndsw, ngptsw
+use rrtmg_sw_init, only: rrtmg_sw_ini
+use rrtmg_sw_rad, only: rrtmg_sw
+use perf_mod, only: t_startf, t_stopf
+use radconstants, only: idx_sw_diag
+
+implicit none
+
+private
+save
+
+real(r8) :: fractional_solar_irradiance(1:nbndsw) ! fraction of solar irradiance in each band
+real(r8) :: solar_band_irrad(1:nbndsw) ! rrtmg-assumed solar irradiance in each sw band
+
+! Public methods
+
+public ::&
+ radsw_init, &! initialize constants
+ rad_rrtmg_sw ! driver for solar radiation code
+
+! Flag for cloud overlap method
+! 0=clear, 1=random, 2=maximum-random, 3=maximum
+integer, parameter :: icld = 2
+
+!===============================================================================
+CONTAINS
+!===============================================================================
+
+subroutine rad_rrtmg_sw(lchnk,ncol ,rrtmg_levs ,r_state , &
+ E_pmid ,E_cld , &
+ E_aer_tau,E_aer_tau_w,E_aer_tau_w_g,E_aer_tau_w_f, &
+ eccf ,E_coszrs ,solin ,sfac , &
+ E_asdir ,E_asdif ,E_aldir ,E_aldif , &
+ qrs ,qrsc ,fsnt ,fsntc ,fsntoa,fsutoa, &
+ fsntoac ,fsnirtoa ,fsnrtoac ,fsnrtoaq ,fsns , &
+ fsnsc ,fsdsc ,fsds ,sols ,soll , &
+ solsd ,solld ,fns ,fcns , &
+!akc6+
+#ifdef AEROFFL
+! fds , fdsc , &
+ idrf , &
+#endif
+!akc6-
+ Nday ,Nnite ,IdxDay ,IdxNite , &
+ su ,sd , &
+ E_cld_tau, E_cld_tau_w, E_cld_tau_w_g, E_cld_tau_w_f, &
+ old_convert)
+
+
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Solar radiation code
+!
+! Method:
+! mji/rrtmg
+! RRTMG, two-stream, with McICA
+!
+! Divides solar spectrum into 14 intervals from 0.2-12.2 micro-meters.
+! solar flux fractions specified for each interval. allows for
+! seasonally and diurnally varying solar input. Includes molecular,
+! cloud, aerosol, and surface scattering, along with h2o,o3,co2,o2,cloud,
+! and surface absorption. Computes delta-eddington reflections and
+! transmissions assuming homogeneously mixed layers. Adds the layers
+! assuming scattering between layers to be isotropic, and distinguishes
+! direct solar beam from scattered radiation.
+!
+! Longitude loops are broken into 1 or 2 sections, so that only daylight
+! (i.e. coszrs > 0) computations are done.
+!
+! Note that an extra layer above the model top layer is added.
+!
+! mks units are used.
+!
+! Special diagnostic calculation of the clear sky surface and total column
+! absorbed flux is also done for cloud forcing diagnostics.
+!
+!-----------------------------------------------------------------------
+
+ use cmparray_mod, only: CmpDayNite, ExpDayNite
+ use phys_control, only: phys_getopts
+ use mcica_subcol_gen_sw, only: mcica_subcol_sw
+ use physconst, only: cpair
+ use rrtmg_state, only: rrtmg_state_t
+
+ ! Minimum cloud amount (as a fraction of the grid-box area) to
+ ! distinguish from clear sky
+ real(r8), parameter :: cldmin = 1.0e-80_r8
+
+ ! Decimal precision of cloud amount (0 -> preserve full resolution;
+ ! 10^-n -> preserve n digits of cloud amount)
+ real(r8), parameter :: cldeps = 0.0_r8
+
+ ! Input arguments
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: ncol ! number of atmospheric columns
+ integer, intent(in) :: rrtmg_levs ! number of levels rad is applied
+
+ type(rrtmg_state_t), intent(in) :: r_state
+
+ integer, intent(in) :: Nday ! Number of daylight columns
+ integer, intent(in) :: Nnite ! Number of night columns
+ integer, intent(in), dimension(pcols) :: IdxDay ! Indicies of daylight coumns
+ integer, intent(in), dimension(pcols) :: IdxNite ! Indicies of night coumns
+
+ real(r8), intent(in) :: E_pmid(pcols,pver) ! Level pressure (Pascals)
+ real(r8), intent(in) :: E_cld(pcols,pver) ! Fractional cloud cover
+
+ real(r8), intent(in) :: E_aer_tau (pcols, 0:pver, nbndsw) ! aerosol optical depth
+ real(r8), intent(in) :: E_aer_tau_w (pcols, 0:pver, nbndsw) ! aerosol OD * ssa
+ real(r8), intent(in) :: E_aer_tau_w_g(pcols, 0:pver, nbndsw) ! aerosol OD * ssa * asm
+ real(r8), intent(in) :: E_aer_tau_w_f(pcols, 0:pver, nbndsw) ! aerosol OD * ssa * fwd
+
+ real(r8), intent(in) :: eccf ! Eccentricity factor (1./earth-sun dist^2)
+ real(r8), intent(in) :: E_coszrs(pcols) ! Cosine solar zenith angle
+ real(r8), intent(in) :: E_asdir(pcols) ! 0.2-0.7 micro-meter srfc alb: direct rad
+ real(r8), intent(in) :: E_aldir(pcols) ! 0.7-5.0 micro-meter srfc alb: direct rad
+ real(r8), intent(in) :: E_asdif(pcols) ! 0.2-0.7 micro-meter srfc alb: diffuse rad
+ real(r8), intent(in) :: E_aldif(pcols) ! 0.7-5.0 micro-meter srfc alb: diffuse rad
+ real(r8), intent(in) :: sfac(nbndsw) ! factor to account for solar variability in each band
+
+ real(r8), optional, intent(in) :: E_cld_tau (nbndsw, pcols, pver) ! cloud optical depth
+ real(r8), optional, intent(in) :: E_cld_tau_w (nbndsw, pcols, pver) ! cloud optical
+ real(r8), optional, intent(in) :: E_cld_tau_w_g(nbndsw, pcols, pver) ! cloud optical
+ real(r8), optional, intent(in) :: E_cld_tau_w_f(nbndsw, pcols, pver) ! cloud optical
+ logical, optional, intent(in) :: old_convert
+
+ ! Output arguments
+
+ real(r8), intent(out) :: solin(pcols) ! Incident solar flux
+ real(r8), intent(out) :: qrs (pcols,pver) ! Solar heating rate
+ real(r8), intent(out) :: qrsc(pcols,pver) ! Clearsky solar heating rate
+ real(r8), intent(out) :: fsns(pcols) ! Surface absorbed solar flux
+ real(r8), intent(out) :: fsnt(pcols) ! Total column absorbed solar flux
+ real(r8), intent(out) :: fsntoa(pcols) ! Net solar flux at TOA
+ real(r8), intent(out) :: fsutoa(pcols) ! Upward solar flux at TOA
+ real(r8), intent(out) :: fsds(pcols) ! Flux shortwave downwelling surface
+
+ real(r8), intent(out) :: fsnsc(pcols) ! Clear sky surface absorbed solar flux
+ real(r8), intent(out) :: fsdsc(pcols) ! Clear sky surface downwelling solar flux
+ real(r8), intent(out) :: fsntc(pcols) ! Clear sky total column absorbed solar flx
+ real(r8), intent(out) :: fsntoac(pcols) ! Clear sky net solar flx at TOA
+ real(r8), intent(out) :: sols(pcols) ! Direct solar rad on surface (< 0.7)
+ real(r8), intent(out) :: soll(pcols) ! Direct solar rad on surface (>= 0.7)
+ real(r8), intent(out) :: solsd(pcols) ! Diffuse solar rad on surface (< 0.7)
+ real(r8), intent(out) :: solld(pcols) ! Diffuse solar rad on surface (>= 0.7)
+ real(r8), intent(out) :: fsnirtoa(pcols) ! Near-IR flux absorbed at toa
+ real(r8), intent(out) :: fsnrtoac(pcols) ! Clear sky near-IR flux absorbed at toa
+ real(r8), intent(out) :: fsnrtoaq(pcols) ! Net near-IR flux at toa >= 0.7 microns
+
+ real(r8), intent(out) :: fns(pcols,pverp) ! net flux at interfaces
+ real(r8), intent(out) :: fcns(pcols,pverp) ! net clear-sky flux at interfaces
+
+ real(r8), pointer, dimension(:,:,:) :: su ! shortwave spectral flux up
+ real(r8), pointer, dimension(:,:,:) :: sd ! shortwave spectral flux down
+
+ !---------------------------Local variables-----------------------------
+
+ ! Local and reordered copies of the intent(in) variables
+
+ real(r8) :: pmid(pcols,pver) ! Level pressure (Pascals)
+
+ real(r8) :: cld(pcols,rrtmg_levs-1) ! Fractional cloud cover
+ real(r8) :: cicewp(pcols,rrtmg_levs-1) ! in-cloud cloud ice water path
+ real(r8) :: cliqwp(pcols,rrtmg_levs-1) ! in-cloud cloud liquid water path
+ real(r8) :: rel(pcols,rrtmg_levs-1) ! Liquid effective drop size (microns)
+ real(r8) :: rei(pcols,rrtmg_levs-1) ! Ice effective drop size (microns)
+
+ real(r8) :: coszrs(pcols) ! Cosine solar zenith angle
+ real(r8) :: asdir(pcols) ! 0.2-0.7 micro-meter srfc alb: direct rad
+ real(r8) :: aldir(pcols) ! 0.7-5.0 micro-meter srfc alb: direct rad
+ real(r8) :: asdif(pcols) ! 0.2-0.7 micro-meter srfc alb: diffuse rad
+ real(r8) :: aldif(pcols) ! 0.7-5.0 micro-meter srfc alb: diffuse rad
+
+ real(r8) :: h2ovmr(pcols,rrtmg_levs) ! h2o volume mixing ratio
+ real(r8) :: o3vmr(pcols,rrtmg_levs) ! o3 volume mixing ratio
+ real(r8) :: co2vmr(pcols,rrtmg_levs) ! co2 volume mixing ratio
+ real(r8) :: ch4vmr(pcols,rrtmg_levs) ! ch4 volume mixing ratio
+ real(r8) :: o2vmr(pcols,rrtmg_levs) ! o2 volume mixing ratio
+ real(r8) :: n2ovmr(pcols,rrtmg_levs) ! n2o volume mixing ratio
+
+ real(r8) :: tsfc(pcols) ! surface temperature
+
+ integer :: dyofyr ! Set to day of year for Earth/Sun distance calculation in
+ ! rrtmg_sw, or pass in adjustment directly into adjes
+ real(r8) :: solvar(nbndsw) ! solar irradiance variability in each band
+
+ integer, parameter :: nsubcsw = ngptsw ! rrtmg_sw g-point (quadrature point) dimension
+ integer :: permuteseed ! permute seed for sub-column generator
+
+ real(r8) :: diagnostic_od(pcols, pver) ! cloud optical depth - diagnostic temp variable
+
+ real(r8) :: tauc_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud optical depth
+ real(r8) :: ssac_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud single scat. albedo
+ real(r8) :: asmc_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud asymmetry parameter
+ real(r8) :: fsfc_sw(nbndsw, pcols, rrtmg_levs-1) ! cloud forward scattering fraction
+
+ real(r8) :: tau_aer_sw(pcols, rrtmg_levs-1, nbndsw) ! aer optical depth
+ real(r8) :: ssa_aer_sw(pcols, rrtmg_levs-1, nbndsw) ! aer single scat. albedo
+ real(r8) :: asm_aer_sw(pcols, rrtmg_levs-1, nbndsw) ! aer asymmetry parameter
+
+ real(r8) :: cld_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud fraction
+ real(r8) :: rei_stosw(pcols, rrtmg_levs-1) ! stochastic ice particle size
+ real(r8) :: rel_stosw(pcols, rrtmg_levs-1) ! stochastic liquid particle size
+ real(r8) :: cicewp_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud ice water path
+ real(r8) :: cliqwp_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud liquid wter path
+ real(r8) :: tauc_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud optical depth (optional)
+ real(r8) :: ssac_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud single scat. albedo (optional)
+ real(r8) :: asmc_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud asymmetry parameter (optional)
+ real(r8) :: fsfc_stosw(nsubcsw, pcols, rrtmg_levs-1) ! stochastic cloud forward scattering fraction (optional)
+
+ real(r8), parameter :: dps = 1._r8/86400._r8 ! Inverse of seconds per day
+
+ real(r8) :: swuflx(pcols,rrtmg_levs+1) ! Total sky shortwave upward flux (W/m2)
+ real(r8) :: swdflx(pcols,rrtmg_levs+1) ! Total sky shortwave downward flux (W/m2)
+ real(r8) :: swhr(pcols,rrtmg_levs) ! Total sky shortwave radiative heating rate (K/d)
+ real(r8) :: swuflxc(pcols,rrtmg_levs+1) ! Clear sky shortwave upward flux (W/m2)
+ real(r8) :: swdflxc(pcols,rrtmg_levs+1) ! Clear sky shortwave downward flux (W/m2)
+ real(r8) :: swhrc(pcols,rrtmg_levs) ! Clear sky shortwave radiative heating rate (K/d)
+ real(r8) :: swuflxs(nbndsw,pcols,rrtmg_levs+1) ! Shortwave spectral flux up
+ real(r8) :: swdflxs(nbndsw,pcols,rrtmg_levs+1) ! Shortwave spectral flux down
+
+ real(r8) :: dirdnuv(pcols,rrtmg_levs+1) ! Direct downward shortwave flux, UV/vis
+ real(r8) :: difdnuv(pcols,rrtmg_levs+1) ! Diffuse downward shortwave flux, UV/vis
+ real(r8) :: dirdnir(pcols,rrtmg_levs+1) ! Direct downward shortwave flux, near-IR
+ real(r8) :: difdnir(pcols,rrtmg_levs+1) ! Diffuse downward shortwave flux, near-IR
+
+ ! Added for net near-IR diagnostic
+ real(r8) :: ninflx(pcols,rrtmg_levs+1) ! Net shortwave flux, near-IR
+ real(r8) :: ninflxc(pcols,rrtmg_levs+1) ! Net clear sky shortwave flux, near-IR
+
+ ! Other
+
+ integer :: i, k, ns ! indices
+
+ ! Cloud radiative property arrays
+ real(r8) :: tauxcl(pcols,0:pver) ! water cloud extinction optical depth
+ real(r8) :: tauxci(pcols,0:pver) ! ice cloud extinction optical depth
+ real(r8) :: wcl(pcols,0:pver) ! liquid cloud single scattering albedo
+ real(r8) :: gcl(pcols,0:pver) ! liquid cloud asymmetry parameter
+ real(r8) :: fcl(pcols,0:pver) ! liquid cloud forward scattered fraction
+ real(r8) :: wci(pcols,0:pver) ! ice cloud single scattering albedo
+ real(r8) :: gci(pcols,0:pver) ! ice cloud asymmetry parameter
+ real(r8) :: fci(pcols,0:pver) ! ice cloud forward scattered fraction
+
+ ! Aerosol radiative property arrays
+ real(r8) :: tauxar(pcols,0:pver) ! aerosol extinction optical depth
+ real(r8) :: wa(pcols,0:pver) ! aerosol single scattering albedo
+ real(r8) :: ga(pcols,0:pver) ! aerosol assymetry parameter
+ real(r8) :: fa(pcols,0:pver) ! aerosol forward scattered fraction
+
+ ! CRM
+ real(r8) :: fus(pcols,pverp) ! Upward flux (added for CRM)
+ real(r8) :: fds(pcols,pverp) ! Downward flux (added for CRM)
+ real(r8) :: fusc(pcols,pverp) ! Upward clear-sky flux (added for CRM)
+ real(r8) :: fdsc(pcols,pverp) ! Downward clear-sky flux (added for CRM)
+
+#ifdef AEROFFL
+! real(r8), intent(out) :: fds(pcols,pverp) ! Downward flux (added for CRM)
+! real(r8), intent(out) :: fdsc(pcols,pverp) ! Downward clear-sky flux (added for CRM)
+!#else
+! real(r8) :: fds(pcols,pverp) ! Downward flux (added for CRM)
+! real(r8) :: fdsc(pcols,pverp) ! Downward clear-sky flux (added for CRM)
+ logical, intent(in) :: idrf
+#endif
+
+ integer :: kk
+
+ real(r8) :: pmidmb(pcols,rrtmg_levs) ! Level pressure (hPa)
+ real(r8) :: pintmb(pcols,rrtmg_levs+1) ! Model interface pressure (hPa)
+ real(r8) :: tlay(pcols,rrtmg_levs) ! mid point temperature
+ real(r8) :: tlev(pcols,rrtmg_levs+1) ! interface temperature
+
+ !-----------------------------------------------------------------------
+ ! START OF CALCULATION
+ !-----------------------------------------------------------------------
+
+ ! Initialize output fields:
+
+ fsds(1:ncol) = 0.0_r8
+
+ fsnirtoa(1:ncol) = 0.0_r8
+ fsnrtoac(1:ncol) = 0.0_r8
+ fsnrtoaq(1:ncol) = 0.0_r8
+
+ fsns(1:ncol) = 0.0_r8
+ fsnsc(1:ncol) = 0.0_r8
+ fsdsc(1:ncol) = 0.0_r8
+
+ fsnt(1:ncol) = 0.0_r8
+ fsntc(1:ncol) = 0.0_r8
+ fsntoa(1:ncol) = 0.0_r8
+ fsutoa(1:ncol) = 0.0_r8
+ fsntoac(1:ncol) = 0.0_r8
+
+ solin(1:ncol) = 0.0_r8
+
+ sols(1:ncol) = 0.0_r8
+ soll(1:ncol) = 0.0_r8
+ solsd(1:ncol) = 0.0_r8
+ solld(1:ncol) = 0.0_r8
+
+ qrs (1:ncol,1:pver) = 0.0_r8
+ qrsc(1:ncol,1:pver) = 0.0_r8
+ fns(1:ncol,1:pverp) = 0.0_r8
+ fcns(1:ncol,1:pverp) = 0.0_r8
+#ifndef OSLO_AERO
+ if (single_column.and.scm_crm_mode) then
+#endif
+ fus(1:ncol,1:pverp) = 0.0_r8
+ fds(1:ncol,1:pverp) = 0.0_r8
+ fusc(:ncol,:pverp) = 0.0_r8
+ fdsc(:ncol,:pverp) = 0.0_r8
+#ifndef OSLO_AERO
+ endif
+#endif
+
+ if (associated(su)) su(1:ncol,:,:) = 0.0_r8
+ if (associated(sd)) sd(1:ncol,:,:) = 0.0_r8
+!#ifdef RFMIPIRF
+! su(1:ncol,:,:) = 0.0_r8
+! sd(1:ncol,:,:) = 0.0_r8
+!#endif
+
+ ! If night everywhere, return:
+ if ( Nday == 0 ) then
+ return
+ endif
+
+ ! Rearrange input arrays
+ call CmpDayNite(E_pmid(:,pverp-rrtmg_levs+1:pver), pmid(:,1:rrtmg_levs-1), &
+ Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs-1)
+ call CmpDayNite(E_cld(:,pverp-rrtmg_levs+1:pver), cld(:,1:rrtmg_levs-1), &
+ Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs-1)
+
+ call CmpDayNite(r_state%pintmb, pintmb, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs+1)
+ call CmpDayNite(r_state%pmidmb, pmidmb, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs)
+ call CmpDayNite(r_state%h2ovmr, h2ovmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs)
+ call CmpDayNite(r_state%o3vmr, o3vmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs)
+ call CmpDayNite(r_state%co2vmr, co2vmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs)
+
+ call CmpDayNite(E_coszrs, coszrs, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call CmpDayNite(E_asdir, asdir, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call CmpDayNite(E_aldir, aldir, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call CmpDayNite(E_asdif, asdif, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call CmpDayNite(E_aldif, aldif, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+
+ call CmpDayNite(r_state%tlay, tlay, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs)
+ call CmpDayNite(r_state%tlev, tlev, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs+1)
+ call CmpDayNite(r_state%ch4vmr, ch4vmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs)
+ call CmpDayNite(r_state%o2vmr, o2vmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs)
+ call CmpDayNite(r_state%n2ovmr, n2ovmr, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, rrtmg_levs)
+
+ ! These fields are no longer input by CAM.
+ cicewp = 0.0_r8
+ cliqwp = 0.0_r8
+ rel = 0.0_r8
+ rei = 0.0_r8
+
+ ! Aerosol daylight map
+ ! Also convert to optical properties of rrtmg interface, even though
+ ! these quantities are later multiplied back together inside rrtmg !
+ ! Why does rrtmg use the factored quantities?
+ ! There are several different ways this factoring could be done.
+ ! Other ways might allow for better optimization
+ do ns = 1, nbndsw
+ do k = 1, rrtmg_levs-1
+ kk=(pverp-rrtmg_levs) + k
+ do i = 1, Nday
+ if(E_aer_tau_w(IdxDay(i),kk,ns) > 1.e-80_r8) then
+ asm_aer_sw(i,k,ns) = E_aer_tau_w_g(IdxDay(i),kk,ns)/E_aer_tau_w(IdxDay(i),kk,ns)
+ else
+ asm_aer_sw(i,k,ns) = 0._r8
+ endif
+ if(E_aer_tau(IdxDay(i),kk,ns) > 0._r8) then
+ ssa_aer_sw(i,k,ns) = E_aer_tau_w(IdxDay(i),kk,ns)/E_aer_tau(IdxDay(i),kk,ns)
+ tau_aer_sw(i,k,ns) = E_aer_tau(IdxDay(i),kk,ns)
+ else
+ ssa_aer_sw(i,k,ns) = 1._r8
+ tau_aer_sw(i,k,ns) = 0._r8
+ endif
+ enddo
+ enddo
+ enddo
+
+ if (scm_crm_mode) then
+ ! overwrite albedos for CRM
+ if(have_asdir) asdir = asdirobs(1)
+ if(have_asdif) asdif = asdifobs(1)
+ if(have_aldir) aldir = aldirobs(1)
+ if(have_aldif) aldif = aldifobs(1)
+ endif
+
+ ! Define solar incident radiation
+ do i = 1, Nday
+ solin(i) = sum(sfac(:)*solar_band_irrad(:)) * eccf * coszrs(i)
+ end do
+
+ ! Calculate cloud optical properties here if using CAM method, or if using one of the
+ ! methods in RRTMG_SW, then pass in cloud physical properties and zero out cloud optical
+ ! properties here
+
+ ! Zero optional cloud optical property input arrays tauc_sw, ssac_sw, asmc_sw,
+ ! if inputting cloud physical properties to RRTMG_SW
+ !tauc_sw(:,:,:) = 0.0_r8
+ !ssac_sw(:,:,:) = 1.0_r8
+ !asmc_sw(:,:,:) = 0.0_r8
+ !fsfc_sw(:,:,:) = 0.0_r8
+ !
+ ! Or, calculate and pass in CAM cloud shortwave optical properties to RRTMG_SW
+ !if (present(old_convert)) print *, 'old_convert',old_convert
+ !if (present(ancientmethod)) print *, 'ancientmethod',ancientmethod
+ if (present(old_convert))then
+ if (old_convert)then ! convert without limits
+ do i = 1, Nday
+ do k = 1, rrtmg_levs-1
+ kk=(pverp-rrtmg_levs) + k
+ do ns = 1, nbndsw
+ if (E_cld_tau_w(ns,IdxDay(i),kk) > 0._r8) then
+ fsfc_sw(ns,i,k)=E_cld_tau_w_f(ns,IdxDay(i),kk)/E_cld_tau_w(ns,IdxDay(i),kk)
+ asmc_sw(ns,i,k)=E_cld_tau_w_g(ns,IdxDay(i),kk)/E_cld_tau_w(ns,IdxDay(i),kk)
+ else
+ fsfc_sw(ns,i,k) = 0._r8
+ asmc_sw(ns,i,k) = 0._r8
+ endif
+
+ tauc_sw(ns,i,k)=E_cld_tau(ns,IdxDay(i),kk)
+ if (tauc_sw(ns,i,k) > 0._r8) then
+ ssac_sw(ns,i,k)=E_cld_tau_w(ns,IdxDay(i),kk)/tauc_sw(ns,i,k)
+ else
+ tauc_sw(ns,i,k) = 0._r8
+ fsfc_sw(ns,i,k) = 0._r8
+ asmc_sw(ns,i,k) = 0._r8
+ ssac_sw(ns,i,k) = 1._r8
+ endif
+ enddo
+ enddo
+ enddo
+ else
+ ! eventually, when we are done with archaic versions, This set of code will become the default.
+ do i = 1, Nday
+ do k = 1, rrtmg_levs-1
+ kk=(pverp-rrtmg_levs) + k
+ do ns = 1, nbndsw
+ if (E_cld_tau_w(ns,IdxDay(i),kk) > 0._r8) then
+ fsfc_sw(ns,i,k)=E_cld_tau_w_f(ns,IdxDay(i),kk)/max(E_cld_tau_w(ns,IdxDay(i),kk), 1.e-80_r8)
+ asmc_sw(ns,i,k)=E_cld_tau_w_g(ns,IdxDay(i),kk)/max(E_cld_tau_w(ns,IdxDay(i),kk), 1.e-80_r8)
+ else
+ fsfc_sw(ns,i,k) = 0._r8
+ asmc_sw(ns,i,k) = 0._r8
+ endif
+
+ tauc_sw(ns,i,k)=E_cld_tau(ns,IdxDay(i),kk)
+ if (tauc_sw(ns,i,k) > 0._r8) then
+ ssac_sw(ns,i,k)=max(E_cld_tau_w(ns,IdxDay(i),kk),1.e-80_r8)/max(tauc_sw(ns,i,k),1.e-80_r8)
+ else
+ tauc_sw(ns,i,k) = 0._r8
+ fsfc_sw(ns,i,k) = 0._r8
+ asmc_sw(ns,i,k) = 0._r8
+ ssac_sw(ns,i,k) = 1._r8
+ endif
+ enddo
+ enddo
+ enddo
+ endif
+ else
+ do i = 1, Nday
+ do k = 1, rrtmg_levs-1
+ kk=(pverp-rrtmg_levs) + k
+ do ns = 1, nbndsw
+ if (E_cld_tau_w(ns,IdxDay(i),kk) > 0._r8) then
+ fsfc_sw(ns,i,k)=E_cld_tau_w_f(ns,IdxDay(i),kk)/max(E_cld_tau_w(ns,IdxDay(i),kk), 1.e-80_r8)
+ asmc_sw(ns,i,k)=E_cld_tau_w_g(ns,IdxDay(i),kk)/max(E_cld_tau_w(ns,IdxDay(i),kk), 1.e-80_r8)
+ else
+ fsfc_sw(ns,i,k) = 0._r8
+ asmc_sw(ns,i,k) = 0._r8
+ endif
+
+ tauc_sw(ns,i,k)=E_cld_tau(ns,IdxDay(i),kk)
+ if (tauc_sw(ns,i,k) > 0._r8) then
+ ssac_sw(ns,i,k)=max(E_cld_tau_w(ns,IdxDay(i),kk),1.e-80_r8)/max(tauc_sw(ns,i,k),1.e-80_r8)
+ else
+ tauc_sw(ns,i,k) = 0._r8
+ fsfc_sw(ns,i,k) = 0._r8
+ asmc_sw(ns,i,k) = 0._r8
+ ssac_sw(ns,i,k) = 1._r8
+ endif
+ enddo
+ enddo
+ enddo
+ endif
+
+ ! Call mcica sub-column generator for RRTMG_SW
+
+ ! Call sub-column generator for McICA in radiation
+ call t_startf('mcica_subcol_sw')
+
+ ! Set permute seed (must be offset between LW and SW by at least 140 to insure
+ ! effective randomization)
+ permuteseed = 1
+
+
+ call mcica_subcol_sw(lchnk, Nday, rrtmg_levs-1, icld, permuteseed, pmid, &
+ cld, cicewp, cliqwp, rei, rel, tauc_sw, ssac_sw, asmc_sw, fsfc_sw, &
+ cld_stosw, cicewp_stosw, cliqwp_stosw, rei_stosw, rel_stosw, &
+ tauc_stosw, ssac_stosw, asmc_stosw, fsfc_stosw)
+
+ call t_stopf('mcica_subcol_sw')
+
+ call t_startf('rrtmg_sw')
+
+ ! Call RRTMG_SW for all layers for daylight columns
+
+
+ ! Set day of year for Earth/Sun distance calculation in rrtmg_sw, or
+ ! set to zero and pass E/S adjustment (eccf) directly into array adjes
+ dyofyr = 0
+
+ tsfc(:ncol) = tlev(:ncol,rrtmg_levs+1)
+
+ solvar(1:nbndsw) = sfac(1:nbndsw)
+
+ call rrtmg_sw(lchnk, Nday, rrtmg_levs, icld, &
+ pmidmb, pintmb, tlay, tlev, tsfc, &
+ h2ovmr, o3vmr, co2vmr, ch4vmr, o2vmr, n2ovmr, &
+ asdir, asdif, aldir, aldif, &
+ coszrs, eccf, dyofyr, solvar, &
+ cld_stosw, tauc_stosw, ssac_stosw, asmc_stosw, fsfc_stosw, &
+ cicewp_stosw, cliqwp_stosw, rei, rel, &
+ tau_aer_sw, ssa_aer_sw, asm_aer_sw, &
+ swuflx, swdflx, swhr, swuflxc, swdflxc, swhrc, &
+ dirdnuv, dirdnir, difdnuv, difdnir, ninflx, ninflxc, swuflxs, swdflxs)
+
+ ! Flux units are in W/m2 on output from rrtmg_sw and contain output for
+ ! extra layer above model top with vertical indexing from bottom to top.
+ !
+ ! Heating units are in J/kg/s on output from rrtmg_sw and contain output
+ ! for extra layer above model top with vertical indexing from bottom to top.
+ !
+ ! Reverse vertical indexing to go from top to bottom for CAM output.
+
+ ! Set the net absorted shortwave flux at TOA (top of extra layer)
+ fsntoa(1:Nday) = swdflx(1:Nday,rrtmg_levs+1) - swuflx(1:Nday,rrtmg_levs+1)
+ fsutoa(1:Nday) = swuflx(1:Nday,rrtmg_levs+1)
+ fsntoac(1:Nday) = swdflxc(1:Nday,rrtmg_levs+1) - swuflxc(1:Nday,rrtmg_levs+1)
+
+ ! Set net near-IR flux at top of the model
+ fsnirtoa(1:Nday) = ninflx(1:Nday,rrtmg_levs)
+ fsnrtoaq(1:Nday) = ninflx(1:Nday,rrtmg_levs)
+ fsnrtoac(1:Nday) = ninflxc(1:Nday,rrtmg_levs)
+
+ ! Set the net absorbed shortwave flux at the model top level
+ fsnt(1:Nday) = swdflx(1:Nday,rrtmg_levs) - swuflx(1:Nday,rrtmg_levs)
+ fsntc(1:Nday) = swdflxc(1:Nday,rrtmg_levs) - swuflxc(1:Nday,rrtmg_levs)
+
+ ! Set the downwelling flux at the surface
+ fsds(1:Nday) = swdflx(1:Nday,1)
+ fsdsc(1:Nday) = swdflxc(1:Nday,1)
+
+ ! Set the net shortwave flux at the surface
+ fsns(1:Nday) = swdflx(1:Nday,1) - swuflx(1:Nday,1)
+ fsnsc(1:Nday) = swdflxc(1:Nday,1) - swuflxc(1:Nday,1)
+
+ ! Set the UV/vis and near-IR direct and dirruse downward shortwave flux at surface
+ sols(1:Nday) = dirdnuv(1:Nday,1)
+ soll(1:Nday) = dirdnir(1:Nday,1)
+ solsd(1:Nday) = difdnuv(1:Nday,1)
+ solld(1:Nday) = difdnir(1:Nday,1)
+
+
+ ! Set the net, up and down fluxes at model interfaces
+ fns (1:Nday,pverp-rrtmg_levs+1:pverp) = swdflx(1:Nday,rrtmg_levs:1:-1) - swuflx(1:Nday,rrtmg_levs:1:-1)
+ fcns(1:Nday,pverp-rrtmg_levs+1:pverp) = swdflxc(1:Nday,rrtmg_levs:1:-1) - swuflxc(1:Nday,rrtmg_levs:1:-1)
+ fus (1:Nday,pverp-rrtmg_levs+1:pverp) = swuflx(1:Nday,rrtmg_levs:1:-1)
+ fusc(1:Nday,pverp-rrtmg_levs+1:pverp) = swuflxc(1:Nday,rrtmg_levs:1:-1)
+ fds (1:Nday,pverp-rrtmg_levs+1:pverp) = swdflx(1:Nday,rrtmg_levs:1:-1)
+ fdsc(1:Nday,pverp-rrtmg_levs+1:pverp) = swdflxc(1:Nday,rrtmg_levs:1:-1)
+
+ ! Set solar heating, reverse layering
+ ! Pass shortwave heating to CAM arrays and convert from K/d to J/kg/s
+ qrs (1:Nday,pverp-rrtmg_levs+1:pver) = swhr (1:Nday,rrtmg_levs-1:1:-1)*cpair*dps
+ qrsc(1:Nday,pverp-rrtmg_levs+1:pver) = swhrc(1:Nday,rrtmg_levs-1:1:-1)*cpair*dps
+
+ ! Set spectral fluxes, reverse layering
+ ! order=(/3,1,2/) maps the first index of swuflxs to the third index of su.
+!#ifndef RFMIPIRF
+ if (associated(su)) then
+!#endif
+ su(1:Nday,pverp-rrtmg_levs+1:pverp,:) = reshape(swuflxs(:,1:Nday,rrtmg_levs:1:-1), &
+ (/Nday,rrtmg_levs,nbndsw/), order=(/3,1,2/))
+!#ifndef RFMIPIRF
+ end if
+!#endif
+
+!#ifndef RFMIPIRF
+ if (associated(sd)) then
+!#endif
+ sd(1:Nday,pverp-rrtmg_levs+1:pverp,:) = reshape(swdflxs(:,1:Nday,rrtmg_levs:1:-1), &
+ (/Nday,rrtmg_levs,nbndsw/), order=(/3,1,2/))
+!#ifndef RFMIPIRF
+ end if
+!#endif
+
+ call t_stopf('rrtmg_sw')
+
+ ! Rearrange output arrays.
+ !
+ ! intent(out)
+
+ call ExpDayNite(solin, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(qrs, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver)
+ call ExpDayNite(qrsc, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pver)
+ call ExpDayNite(fns, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp)
+ call ExpDayNite(fcns, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp)
+ call ExpDayNite(fsns, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(fsnt, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(fsntoa, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(fsutoa, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(fsds, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(fsnsc, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(fsdsc, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(fsntc, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(fsntoac, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(sols, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(soll, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(solsd, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(solld, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(fsnirtoa, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(fsnrtoac, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+ call ExpDayNite(fsnrtoaq, Nday, IdxDay, Nnite, IdxNite, 1, pcols)
+
+!#ifndef RFMIPIRF
+ if (associated(su)) then
+!#endif
+ call ExpDayNite(su, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp, 1, nbndsw)
+!#ifndef RFMIPIRF
+ end if
+!#endif
+
+!#ifndef RFMIPIRF
+ if (associated(sd)) then
+!#endif
+ call ExpDayNite(sd, Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp, 1, nbndsw)
+!#ifndef RFMIPIRF
+ end if
+!#endif
+
+ ! these outfld calls don't work for spmd only outfield in scm mode (nonspmd)
+#ifndef OSLO_AERO
+ if (single_column .and. scm_crm_mode) then
+#endif
+ ! Following outputs added for CRM
+ call ExpDayNite(fus,Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp)
+ call ExpDayNite(fusc,Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp)
+ call outfld('FUS ', fus, pcols, lchnk)
+ call outfld('FUSC ', fusc, pcols, lchnk)
+ call ExpDayNite(fds,Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp)
+ call ExpDayNite(fdsc,Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp)
+ call outfld('FDS ', fds, pcols, lchnk)
+ call outfld('FDSC ', fdsc, pcols, lchnk)
+#ifndef OSLO_AERO
+ endif
+#endif
+
+#ifdef AEROFFL
+ if(idrf) then
+! call ExpDayNite(fusc,Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp)
+! call ExpDayNite(fdsc,Nday, IdxDay, Nnite, IdxNite, 1, pcols, 1, pverp)
+ call outfld('FUSCDRF ', fusc, pcols, lchnk)
+ call outfld('FDSCDRF ', fdsc, pcols, lchnk)
+ endif
+#endif
+
+end subroutine rad_rrtmg_sw
+
+!-------------------------------------------------------------------------------
+
+subroutine radsw_init()
+!-----------------------------------------------------------------------
+!
+! Purpose:
+! Initialize various constants for radiation scheme.
+!
+!-----------------------------------------------------------------------
+ use radconstants, only: get_solar_band_fraction_irrad, get_ref_solar_band_irrad
+
+ ! get the reference fractional solar irradiance in each band
+ call get_solar_band_fraction_irrad(fractional_solar_irradiance)
+ call get_ref_solar_band_irrad( solar_band_irrad )
+
+
+ ! Initialize rrtmg_sw
+ call rrtmg_sw_ini
+
+end subroutine radsw_init
+
+
+!-------------------------------------------------------------------------------
+
+end module radsw
diff --git a/src/physics/cam_oslo/table_manager.F90 b/src/physics/cam_oslo/table_manager.F90
new file mode 100644
index 0000000000..6f91a8459d
--- /dev/null
+++ b/src/physics/cam_oslo/table_manager.F90
@@ -0,0 +1,95 @@
+module table_manager
+
+ use ptaero_table
+ use commondefinitions
+ use aerosoldef !for the mixture ids
+
+ integer, parameter, public :: table_property_dry_radius=1
+ integer, parameter, public :: table_property_sigma=2
+ integer, parameter :: max_number_of_properties=10 !Max # properties for a mixture
+
+ TYPE(ptaero_table_t), target, dimension(max_number_of_properties*(nmodes+1)) :: property_table
+
+ integer, dimension(0:nmodes,max_number_of_properties) :: property_table_index
+ integer, save :: last_used_index=0
+
+contains
+
+ subroutine initialize_tables()
+ implicit none
+ integer :: i
+
+ last_used_index = 0
+ property_table_index(:,:) = -1 !Negative index means un-used
+
+ do i=1,SIZE(property_table)
+ !Construct an empty property table
+ call construct(property_table(i))
+ end do
+
+ end subroutine initialize_tables
+
+ !Registers a look-up table
+ subroutine register_table(mixture_id, property_id, data2D, data3D, data4D, axis1, axis2, axis3, axis4)
+ implicit none
+ integer, intent(in) :: mixture_id
+ integer, intent(in) :: property_id
+ real(r8), dimension(:,:), intent(in), optional :: data2D
+ real(r8), dimension(:,:,:), intent(in), optional :: data3D
+ real(r8), dimension(:,:,:,:), intent(in), optional :: data4D
+ real(r8), intent(in), dimension(:),optional :: axis1
+ real(r8), intent(in), dimension(:),optional :: axis2
+ real(r8), intent(in), dimension(:),optional :: axis3
+ real(r8), intent(in), dimension(:),optional :: axis4
+
+ !Increase the number of tables we are keeping track of..
+ last_used_index = last_used_index + 1
+
+ !Remember the placement of this table
+ property_table_index(mixture_id, property_id) = last_used_index
+
+ !Need to check for what kind of data the table contains..
+ if(present(data2D))then
+ call initialize(property_table(last_used_index) & !This is the table we are initializing
+ , mixture_id & !id of the mixture
+ , property_id & !id of the property
+ , limits1=axis1 & !axis limits (grid) of first axis
+ , limits2=axis2 & !axis limits (grid) of second axis
+ , data2d=data2d & !the 2d-data of the table
+ )
+ else if(present(data3D))then
+ call initialize(property_table(last_used_index) & !This is the table we are initializing
+ , mixture_id & !id of the mixture
+ , property_id & !id of the property
+ , limits1=axis1 & !axis limits (grid) of first axis
+ , limits2=axis2 & !axis limits (grid) of second axis
+ , limits3=axis3 & !axis limits (grid) of third axis
+ , data3d=data3d & !the 2d-data of the table
+ )
+ else if(present(data4D))then
+ call initialize(property_table(last_used_index) & !This is the table we are initializing
+ , mixture_id & !id of the mixture
+ , property_id & !id of the property
+ , limits1=axis1 & !axis limits (grid) of first axis
+ , limits2=axis2 & !axis limits (grid) of second axis
+ , limits3=axis3 & !axis limits (grid) of third axis
+ , limits4=axis3 & !axis limits (grid) of third axis
+ , data4d=data4d & !the 2d-data of the table
+ )
+ end if
+
+ end subroutine register_table
+
+ function get_table_pointer(mixture_id, property_id)RESULT(table_pointer)
+ integer,intent(in) :: mixture_id
+ integer,intent(in) :: property_id
+ TYPE(ptaero_table_t), pointer :: table_pointer
+
+ nullify(table_pointer)
+
+ table_pointer=>property_table(property_table_index(mixture_id, property_id))
+
+ end function
+
+
+end module table_manager
diff --git a/src/physics/camrt/radiation.F90 b/src/physics/camrt/radiation.F90
index 1ca1e074de..63ffa94f3e 100644
--- a/src/physics/camrt/radiation.F90
+++ b/src/physics/camrt/radiation.F90
@@ -861,6 +861,8 @@ subroutine radiation_tend( &
real(r8):: p_trop(pcols)
logical :: write_output ! switch for outfld calls
+
+ logical, parameter :: cosz_rad_call=.true. !+tht
!----------------------------------------------------------------------
lchnk = state%lchnk
@@ -902,7 +904,7 @@ subroutine radiation_tend( &
! Cosine solar zenith angle for current time step
call get_rlat_all_p(lchnk, ncol, clat)
call get_rlon_all_p(lchnk, ncol, clon)
- call zenith (calday, clat, clon, coszrs, ncol, dt_avg)
+ call zenith (calday, clat, clon, coszrs, ncol, dt_avg, cosz_rad_call) !+tht
! Gather night/day column indices.
Nday = 0
diff --git a/src/physics/carma/base/ChangeLog b/src/physics/carma/base/ChangeLog
new file mode 100644
index 0000000000..fd69d8c860
--- /dev/null
+++ b/src/physics/carma/base/ChangeLog
@@ -0,0 +1,563 @@
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen, Pengfei Yu
+Date: Aug 13, 2013
+
+One-line Summary:
+
+Added partial initialization and fixed problems with initialization the dry deposition code.
+
+Purpose of changes:
+
+When using fixed initialization, the dry deposition routines were
+not getting initialized, so deposition velocities were not calculated.
+That has been corrected. Also, the metric scaling was being applied
+incorrectly to vd and vf when requested as output from CARMASTATE_Get.
+A new option (partialinit) has been added that can be used with
+fixed initialization to cause reinitialization of fall velocities and
+growth kernels, but not coagulation kernels, which are the most expensive
+calculate. This gives a result that is intermediate between full and
+fixed initialization.
+
+===============================================================
+Tag name:
+Originator(s): Sean Santos
+Date: Dec 27, 2013
+
+One-line Summary:
+
+Support for the NAG Fortran compiler within CAM (nagfor).
+
+Purpose of changes:
+
+Made many changes to work with the NAG compiler within CAM. These include
+mostly changes to deal with kind in a standard-conforming way (as opposed
+to using non-standard intrinsics), and changes to ensure that the code
+contains no more than 132 characters per line.
+
+miess.F90 has more extensive changes; this module used "equivalence" in a
+way not allowed by the standard, and so much of the code had to be
+re-written to work on complex numbers without associating their components
+to reals.
+
+The Makefile is not currently updated with support for nagfor.
+
+===============================================================
+Tag name:
+Originator(s): Chuck Bardeen
+Date: Nov 15, 2013
+
+One-line Summary:
+
+Support for the gfortran compiler.
+
+Purpose of changes:
+
+Support was added to the Makefile for the gfortran compiler, and
+some compatibility bugs were fixed in the code so that it would
+compile and link under gfortran.
+
+===============================================================
+Tag name:
+Originator(s): Chuck Bardeen, Mike Mills
+Date: Nov 14, 2013
+
+One-line Summary:
+
+Sulfates wet radius and density includes the Kelvin effect on water.
+
+Purpose of changes:
+
+Changed the wetr code to take into account the Kelvin effect on the
+water in determining the weight percent, density and particle size.
+This is a simpler alternative to the weight percent per bin approach
+that MIke has used in other CARMA models.
+
+NOTE: There was also a fix for a related bug in rhopart.F90, where
+the wrong gas concentration was being used for the sulfate weight
+percent calculation.
+
+===============================================================
+Tag name:
+Originator(s): Chuck Bardeen
+Date: Nov 3, 2013
+
+One-line Summary:
+
+Neutralized sulfates as a function of volume fraction of core mass.
+
+Purpose of changes:
+
+Changes to allow for neutralization of sulfates where the neutralization
+is a function of the volume fraction of the core mass. This replaces
+neutralization by scaling the saturation vapor pressure. NOTE: This
+solution is currently not used for ice particles or when particle
+heating is being used.
+
+===============================================================
+Tag name:
+Originator(s): Sean Santos
+Date: July 15, 2013
+
+One-line Summary:
+
+Set rprat to 1 for all non-fractals.
+
+Purpose of changes:
+
+Setting rprat to 1._r8 for I_HEXAGON and I_CYLINDER shapes will prevent
+errors due to uninitialized data for the cirrus/dust model.
+
+===============================================================
+Tag name:
+Originator(s): Sean Santos
+Date: July 2, 2013
+
+One-line Summary:
+
+Fix build with debug options on and on compilers other than Intel.
+
+Purpose of changes:
+
+Fix several compatibility issues with PGI and Lahey. fractal_meanfield_mod
+in particular used Intel compiler extensions throughout.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen
+Date: June 14, 2013
+
+One-line Summary:
+
+Added sulfate heterogeneous nucleation and allow sulfuric acid
+vapor pressure to be adjusted for neutralization
+
+Purpose of changes:
+
+Add heterogeneous nucleation of sulfate aerosols to the binary
+homogeneous nucleation. Also reduced the vapor pressure for
+"neutralized" aerosols based upon Marti et al. 1997. Neutralization
+is treated very simplistically and is either all or none and just
+affects the vapor pressure.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen
+Date: May 17, 2013
+
+One-line Summary:
+
+Changed way optical properties are handled
+
+Purpose of changes:
+
+The optical properties used to be initialized by default to be
+used by particle heating; however, the fractal code can take a
+long time to calculate the optical properties. So only do the
+internal initialization if particle heating is enabled. Added
+another interface to the Group to set the optical properties to
+allow them to come from an external source.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen, Pete Colarco
+Date: May 13, 2013
+
+One-line Summary:
+
+Fixed bug in nucleation rate statistic
+
+Purpose of changes:
+
+Changed how the nucleation rate statistic is calculated to work
+around two previous bugs that involved try to calculate the
+statistic after the particle count had been updated and not
+including the nucleation loss rate in the calculation.
+
+===============================================================
+Tag name:
+Originator(s): Eric Wolf, Charles Bardeen
+Date: May 9, 2013
+
+One-line Summary:
+
+Added support for fractal particles.
+
+Purpose of changes:
+
+Allows particles to grow fractally, which means that particles are made
+up of monomers of a single size that will aggregate together in patterns
+that depend on the particles fractal dimension. This will affect growth,
+sedimentation, coagulation, deposition and optical properties.
+
+===============================================================
+Tag name:
+Originator(s): Sean Santos
+Date: April 24, 2013
+
+One-line Summary: Fix problems with different compilers and debug flags.
+
+Purpose of changes:
+
+Some cases where the carma_type object had "intent(inout)" were changed to
+"intent(in)". This would have been required if those routines had had
+explicit interfaces, because intent(in) arguments can only be passed as
+arguments that are also intent(in), or as arguments with no explicitly
+specified intent.
+
+Since Fortran 90, imag and aimag are identical generic intrinsics on most
+compilers. However, aimag is the name in the Fortran standards, while imag
+is a compiler extension. Therefore "imag" has been changed to "aimag" and
+comments that are no longer relevant have been removed.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen, Mike Mills
+Date: March 18, 2013
+
+One-line Summary:
+
+Some bug fixes related to sulfates, to evaporation, mie code
+and coagulation kernels.
+
+Purpose of changes:
+
+The wet radius for sulfates was not being calculated properly, since
+it was missing a dry particle density term. The new wet radius will be
+roughly twice what it was before. Also made some changes to allow specification
+of sulfuric acid in CARMASTATE_CreateFromReference, so that initialization
+from a reference profile can be used with sulfate models. Put some limits
+on calculations in sulfate utilities for practical temperature ranges.
+
+Fixed a problem with total evaporation that affected some models.
+
+Fixed a problem with types in the optical properties calculation when
+using Bohren and Huffman.
+
+Fixed a problem with the way the coagulation due to convection was
+being calculated that caused asymmetric coagulation kernels.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen
+Date: September 7, 2012
+
+One-line Summary:
+
+Fix bug in pheat.F90 when no solute is specified.
+
+Purpose of changes:
+
+A check to exclude a calculation in the particle growth code when
+no solutes are present was coded incorrectly causing the model
+to crash when growth is enabled, core elements exist in the group
+and no solutes are defined for the cores.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen
+Date: January 26, 2011
+
+One-line Summary:
+
+Add capability for clear sky processing when using in-cloud
+and gridbox average particles.
+
+Purpose of changes:
+
+Allows two sets of microphysical calculations to be done in one
+Step call. One is for the fraction of the grid box that is
+in-cloud and the other is for the remaining clear sky portion.
+The entire mass of particle groups that are "cloud" are only
+processed in the in-cloud portion. Other groups can also
+condense liquid, but be over the entire gridbox. These would
+have "is cloud" as false and will be processed in both the
+in-cloud and clear sky portions of the grid box. Sedimentation
+is only done once on the gridbox average values, but coagulation
+and growth are done twice.
+
+Two tests have been added for this :
+ - GROWINTEST = in-cloud test
+ - GROWCLRTEST = in-cloud & clear sky test
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen, Mike Mills
+Date: December 1, 2011
+
+One-line Summary:
+
+Bug fixes for sulfate aerosols and some additional diagnostic
+information.
+
+Purpose of changes:
+
+Fixes problems found while trying to test sulfates aerosols in
+WACCM/CARMA, where every cold temperatures are possible. Also
+Also producing some additional diagnostics to help diagnose the
+sulfate physics.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen
+Date: November 8, 2011
+
+One-line Summary:
+
+Allow configurable selection of aerosol freezing method and cleanup
+error messages.
+
+Purpose of changes:
+
+Made nucproc a bit field, so that the aerosol freezing method can
+be specified without needing to modify the code, and so that it can
+be combined with nucleation of glassy aerosols. Also surpress an
+error message from negative temperature unless it is the last
+retry. Added a test case (NUC2TEST.exe) to see at what supersaturation
+aerosol freezing begins.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen, Mike Mills
+Date: October 9, 2011
+
+One-line Summary:
+
+Fixes to support high (thermospheric) temperatures in the sulfate
+code.
+
+Purpose of changes:
+
+Modified some of the sulfate code to handle temperatures that
+result in 0 wtpct. This was causing WACCM to crash with the
+sulfate model.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen, Tianyi Fan
+Date: September 3, 2011
+
+One-line Summary:
+
+Added sulfate aerosols.
+
+Purpose of changes:
+
+Added support for sulfuric acid and sulfate aerosols. Also fixed
+some problems with the way latent and particle heats were applied
+when substepping was being used. Made the convergence criteria
+more configurable. The sulfate aerosol code is a significantly
+modified version of code from that provided by Tianyi Fan. Her
+code started with work done by Mike Mills and then was modified
+by Jason English, Tianyi Fan and Chuck Bardeen.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen
+Date: August 19, 2011
+
+One-line Summary:
+
+Bug fixes and enhancements to the particle heating code.
+
+Purpose of changes:
+
+Fixed a few bugs found running in the debugger, and changed
+dry deposition so that surface friction and aerodynamic resistance
+are provided and used per land surface type.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen
+Date: August 9, 2011
+
+One-line Summary:
+
+Enhancements to the particle heating code.
+
+Purpose of changes:
+
+Added band integrals for the planck function to provide a more
+accurate estimate of outgoing radiation for particle heating. Also
+modified the test case to start the SW band at a non-zero wavelength.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen
+Date: August 4, 2011
+
+One-line Summary:
+
+Enhancements to the particle heating code.
+
+Purpose of changes:
+
+Added the ability to flag overlap bands in for the particle heating
+calculation. These are bands which have added energy coming in; however,
+the emission should only be done in one of the bands. This is needed
+for the CAM radiation bands. Added the Bohren and Huffman mie routine,
+to provide a routine that handles a broader array of sizes and refractive
+indicies. Also changed the output from particle temperature to the difference
+in particle temperature, since that is more relevant to the impact on
+growth rates and temperatures may change for other reasons making it hard
+to do the difference later.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen
+Date: July 14, 2011
+
+One-line Summary:
+
+Setup tests to be run as regression tests.
+
+Purpose of changes:
+
+Added two new scripts run-all.csh and run-regress.csh. run-regress.csh
+runs the tests and then compares the answer to previously generated
+results in tests/bench. An error is generated if the results differ.
+To make this usable, all of the tests have be modified to have minimal
+output to the screen for normal operation.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen
+Date: July 13, 2011
+
+One-line Summary:
+
+Support for particle heating and some bug fixes
+
+Purpose of changes:
+
+Added support for passing radiative intensity into CARMA and
+having that affect the particle growth rates and partcile
+temperature.This is exercised by carma_pheattest.F90. Changed
+initialization, so pkernel is only calcualted once to speed
+things up a little. Made area ratio and radius ratio group
+properties, so there is more flexibility for setting group
+shape.
+
+===============================================================
+Tag name:
+Originator(s): Charles Bardeen
+Date: June 8, 2011
+
+One-line Summary:
+
+Support for PGI and g95 compilers
+
+Purpose of changes:
+
+Some Fortran compilers have preprocessors that failed to correctly handle
+the macros because they recursively tried to replace the name multiple
+times. To prevent this, the field names have been changes to have f_XXX
+so they don't conflict with the macro name XXX.
+
+===============================================================
+
+Tag name: 3.0.1
+Originator(s): Tianyi Fan, Charles Bardeen
+Date: December 1, 2010
+
+One-line Summary:
+
+Add wet deposition to sedimentation.
+
+Purpose of changes:
+
+Added support for dry deposition to the sedimentation routine in CARMA.
+Surface friction and land fraction are supplied by the parent model.
+
+===============================================================
+
+Tag name: 3.0.0
+Originator(s): Charles Bardeen
+Date: August 11, 2010
+
+One-line Summary:
+
+Initial release of the F90 version of CARMA based upon F77 CARMA 2.3
+
+Purpose of changes:
+
+A major revision of CARMA 2.3, with design goals of porting it to
+Fortran 90, and designing it to be embedded in other models like CAM
+and GEOS.
+
+Changes for F90:
+- All code converted to F90 (wrappers to keep core code similar to F77 code)
+- Use modules to replace common blocks
+- Dynamic memory allocation
+- Thread safe
+- Use array operations when possible
+- Use implicit none
+
+Changes for embedded models:
+- Single column
+- Programmatic interface to define microphysical model
+- Initialize from parent model state (mks units)
+- Step() can be multithreaded
+- Generate optical properties (mie coefficients)
+- Scale for cloud fraction
+- Detrain particles
+- Store information about CARMA needed for parent models (e.g. wet deposition coefficients, diagnostic group, ...)
+- Allow a fixed defintion of latent heat, consitent with parent model
+
+Updated algortihms:
+- Aerosol freezing (Koop 2000)
+- Water saturation vapor pressure (Murphy & Koop 2005)
+
+New algorithms:
+- Nucleation of glassy aerosols (Murray et al. 2010)
+- Ice particle density as a function of size (Heymsfield & Schmitt, 2010)
+- Ice fall velocity (Heymsfield & Westbrook, 2010)
+- Particle swelling with relative humidity, wet radius (Gerber 1985; Fitzgerald 1975)
+- Brownian Diffusion
+
+New features:
+- Allow specification of minimum mass rather than just radius
+- Variable density (per bin) within an element
+- Determine sedimentation to the surface
+- Dynamically allocate ACAP in miess based upon NXM1
+
+Performance:
+- Only initialize the components needed for the model configuration
+- Add retry logic to newstate/microfast, to minimize the number of substeps needed
+- Reduce size of data structures used by CARMA
+- Reorder some operations for faster array access
+- Optional initialization to a fixed reference temperature profile
+- Optional explicit sedimentation (substepped)
+- Reuse allocated memory in CARMASTATE to reduce memory allocation
+
+Bugs fixed:
+- Mass & energy conservation
+- Various bugs in fall velocity calculation
+- Scaling problems with rlheat
+- Optional Initialize every timestep for maximum accuracy
+- Various problems with setting up the model configuration (nucleation tables, scrit, nucgas, ...)
+- Improved growth stability and convergence
+- Improved stability of aerosol freezing (tabazadeh 2000)
+- Evaporation bugs (cmf not getting set, total evaporation ncore=0)
+- Modified growth equation for better approximation
+- Correct usage of SMALL_PC and FEW_PC
+
+Algorithms eliminated:
+- Horizontal advection
+- Hydrostatic approximation
+- Eddy diffusion
+- Mixed phase particles
+- Radiative Transfer
+
+Known Issues:
+- PPM advection code has noisy sedimentation when using hybrid coordinates
+- Growth code is not mass or energy conserving, so rlheat and gc are recalculated based upon condensed mass change
+- PPM advection code does not return fluxes out the top and bottom of the column, so a kludge was added to get flux out the bottom as column difference
+- Estimates for the number of substeps needed (ntsubsteps) are not very accurate
+- Full initialization (rather than to reference T) can be very slow, particularly for coagulation
+- Parameterizations for latent heats give odd values at low temperatures, use fixed values instead
+- Standard fall velocity routine has odd kinks in areas where it transitions between different Reynolds regimes
+- Standard shape fall velocity routine is not handling all shapes and aspect ratios correctly
+- Mie calculation code can still exceed IACAP estimates even though dynamically allocating ACAP
+- Core mass is sometimes larger than total mass, can happen from parent model advection, but perhaps other sources
+===============================================================
diff --git a/src/physics/carma/base/actdropl.F90 b/src/physics/carma/base/actdropl.F90
new file mode 100644
index 0000000000..068146df11
--- /dev/null
+++ b/src/physics/carma/base/actdropl.F90
@@ -0,0 +1,106 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluates particle loss rates due to nucleation :
+!! droplet activation only.
+!!
+!! The loss rates for all particle elements in a particle group are equal.
+!!
+!! To avoid nucleation into an evaporating bin, this subroutine must
+!! be called after growp, which evaluates evaporation loss rates .
+!!
+!! @author Andy Ackerman
+!! @version Dec-1995
+subroutine actdropl(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: igas !! gas index
+ integer :: igroup !! group index
+ integer :: ibin !! bin index
+ integer :: iepart !! element for condensing group index
+ integer :: inuc !! nucleating element index
+ integer :: ienucto !! index of target nucleation element
+ integer :: ignucto !! index of target nucleation group
+ integer :: inucto !! index of target nucleation bin
+ logical :: evapfrom_nucto !! .true. when target droplets are evaporating
+
+
+ ! This calculation is only necessary for temperatures greater
+ ! than -40C.
+ if( t(iz) .ge. (T0 - 40._f) ) then
+
+ ! Loop over particle groups.
+ do igroup = 1,NGROUP
+
+ ! Bypass calculation if few particles are present
+ if( pconmax(iz,igroup) .gt. FEW_PC )then
+
+ igas = inucgas(igroup) ! condensing gas
+ iepart = ienconc( igroup ) ! particle number density element
+
+ if( igas .ne. 0 )then
+
+ ! Calculate nucleation loss rates. Do not allow nucleation into
+ ! an evaporating bin.
+ do inuc = 1,nnuc2elem(iepart)
+
+ ienucto = inuc2elem(inuc,iepart)
+ if( ienucto .ne. 0 )then
+ ignucto = igelem( ienucto )
+ else
+ ignucto = 0
+ endif
+
+ ! Only compute nucleation rate for droplet activation
+ if( inucproc(iepart,ienucto) .eq. I_DROPACT ) then
+
+ ! Loop over particle bins. Loop from largest to smallest for
+ ! evaluation of index of smallest bin nucleated during time step .
+ do ibin = NBIN, 1, -1
+
+ if( ignucto .ne. 0 )then
+ inucto = inuc2bin(ibin,igroup,ignucto)
+ else
+ inucto = 0
+ endif
+
+ ! Set to .true. when target droplets are evaporating
+ if( inucto .ne. 0 )then
+ evapfrom_nucto = evaplg(inucto,ignucto) .gt. 0._f
+ else
+ evapfrom_nucto = .false.
+ endif
+
+ if( (supsatl(iz,igas) .gt. scrit(iz,ibin,igroup)) .and. &
+ (.not. evapfrom_nucto) .and. &
+ (pc(iz,ibin,iepart) .gt. SMALL_PC) )then
+
+ rnuclg(ibin,igroup,ignucto) = 1.e3_f
+ endif
+ enddo ! ibin = 1,NBIN
+ endif ! inucproc(iepart,ienucto) .eq. I_DROPACT
+ enddo ! inuc = 1,nnuc2elem(iepart)
+ endif ! (igas = inucgas(igroup)) .ne. 0
+ endif ! pconmax(iz,igroup) .gt. FEW_PC
+ enddo ! igroup = 1,NGROUP
+ endif ! t(iz) .ge. T0-40.
+
+ ! Return to caller with particle loss rates due to nucleation evaluated.
+ return
+end
diff --git a/src/physics/carma/base/adgaquad_mod.F90 b/src/physics/carma/base/adgaquad_mod.F90
new file mode 100644
index 0000000000..3cc91de56c
--- /dev/null
+++ b/src/physics/carma/base/adgaquad_mod.F90
@@ -0,0 +1,3573 @@
+!! ******************************************************************
+!! The routines listed in this file "adgaquad_mod.F90" are performing
+!! Numerical Integrations using some kind of
+!! adaptive Gauss quadrature.
+!! They are taken from the Internet (http://www.netlib.org)
+!! and parts of different software packages / libraries.
+!! ******************************************************************
+!! For any restrictions on the use of the routines, please see
+!! the original web site.
+!! ******************************************************************
+!! Changes: calls to error handler 'xerror()' replaced by
+!! WRITE(7,*) - statements.
+!! ******************************************************************
+!! list of routines and the libraries they are taken from:
+!! dqag calling routine, bounded integration interval
+!! QUADPACK; calls: dqage
+!! dqage the integration routine, bounded interval
+!! QUADPACK; calls: sd1mach,dqk15,dqk21,dqk31,
+!! dqk41,dqk51,dqk61,dqpsrt
+!! dqagi calling routine, unbounded (semi-infinite or
+!! infinite) integration interval
+!! QUADPACK; calls: dqagie
+!! dqagie the integration routine, unbounded interval
+!! QUADPACK; calls: sd1mach,dqelg,dqk15i,dqpsrt
+!! ------------------------------------------------------------------
+!! dqk15 QUADPACK; calls: sd1mach
+!! dqk21 QUADPACK; calls: sd1mach
+!! dqk31 QUADPACK; calls: sd1mach
+!! dqk41 QUADPACK; calls: sd1mach
+!! dqk51 QUADPACK; calls: sd1mach
+!! dqk61 QUADPACK; calls: sd1mach
+!! dqpsrt QUADPACK; calls: none
+!! dqk15i QUADPACK; calls: sd1mach
+!! dqelg QUADPACK; calls: sd1mach
+!! ------------------------------------------------------------------
+!! xerror Error handling routine
+!! ALLIANT (/quad); calls: xerrwv
+!! xerrwv Error handling routine
+!! SODEPACK; calls: none
+!! d1mach determine machine parameters (accuracies)
+!! BLAS; calls: none
+!! ------------------------------------------------------------------
+
+module adgaquad_mod
+
+ use carma_precision_mod
+ use adgaquad_types_mod
+
+ implicit none
+
+ private
+
+ public :: dqag
+ public :: dqage
+ public :: dqagi
+ public :: dqagie
+
+ contains
+
+ !!***begin prologue dqag
+ !!***date written 800101 (yymmdd)
+ !!***revision date 130319 (yymmdd)
+ !!***category no. h2a1a1
+ !!***keywords automatic integrator, general-purpose,
+ !! integrand examinator, globally adaptive,
+ !! gauss-kronrod
+ !!***author piessens,robert,appl. math. & progr. div - k.u.leuven
+ !! de doncker,elise,appl. math. & progr. div. - k.u.leuven
+ !!***purpose the routine calculates an approximation result to a given
+ !! definite integral i = integral of f over (a,b),
+ !! hopefully satisfying following claim for accuracy
+ !! abs(i-result)le.max(epsabs,epsrel*abs(i)).
+ !!***description
+ !!
+ !! computation of a definite integral
+ !! standard fortran subroutine
+ !! double precision version
+ !!
+ !! fx - double precision
+ !! function subprogam defining the integrand
+ !! function f(x). the actual name for f needs to be
+ !! declared e x t e r n a l in the driver program.
+ !!
+ !! fx_vars- structure containing variables need for integration
+ !! specific to fractal meanfield scattering code
+ !!
+ !! a - double precision
+ !! lower limit of integration
+ !!
+ !! b - double precision
+ !! upper limit of integration
+ !!
+ !! epsabs - double precision
+ !! absolute accoracy requested
+ !! epsrel - double precision
+ !! relative accuracy requested
+ !! if epsabs.le.0
+ !! and epsrel.lt.max(50*rel.mach.acc.,0.5d-28),
+ !! the routine will end with ier = 6.
+ !!
+ !! key - integer
+ !! key for choice of local integration rule
+ !! a gauss-kronrod pair is used with
+ !! 7 - 15 points if key.lt.2,
+ !! 10 - 21 points if key = 2,
+ !! 15 - 31 points if key = 3,
+ !! 20 - 41 points if key = 4,
+ !! 25 - 51 points if key = 5,
+ !! 30 - 61 points if key.gt.5.
+ !!
+ !! on return
+ !! result - double precision
+ !! approximation to the integral
+ !!
+ !! abserr - double precision
+ !! estimate of the modulus of the absolute error,
+ !! which should equal or exceed abs(i-result)
+ !!
+ !! neval - integer
+ !! number of integrand evaluations
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! ier.gt.0 abnormal termination of the routine
+ !! the estimates for result and error are
+ !! less reliable. it is assumed that the
+ !! requested accuracy has not been achieved.
+ !! error messages
+ !! ier = 1 maximum number of subdivisions allowed
+ !! has been achieved. one can allow more
+ !! subdivisions by increasing the value of
+ !! limit (and taking the according dimension
+ !! adjustments into account). however, if
+ !! this yield no improvement it is advised
+ !! to analyze the integrand in order to
+ !! determine the integration difficulaties.
+ !! if the position of a local difficulty can
+ !! be determined (i.e.singularity,
+ !! discontinuity within the interval) one
+ !! will probably gain from splitting up the
+ !! interval at this point and calling the
+ !! integrator on the subranges. if possible,
+ !! an appropriate special-purpose integrator
+ !! should be used which is designed for
+ !! handling the type of difficulty involved.
+ !! = 2 the occurrence of roundoff error is
+ !! detected, which prevents the requested
+ !! tolerance from being achieved.
+ !! = 3 extremely bad integrand behaviour occurs
+ !! at some points of the integration
+ !! interval.
+ !! = 6 the input is invalid, because
+ !! (epsabs.le.0 and
+ !! epsrel.lt.max(50*rel.mach.acc.,0.5d-28))
+ !! or limit.lt.1 or lenw.lt.limit*4.
+ !! result, abserr, neval, last are set
+ !! to zero.
+ !! except when lenw is invalid, iwork(1),
+ !! work(limit*2+1) and work(limit*3+1) are
+ !! set to zero, work(1) is set to a and
+ !! work(limit+1) to b.
+ !! = 9 failure in sd1mach determining machine parameters
+ !!
+ !! dimensioning parameters
+ !! limit - integer
+ !! dimensioning parameter for iwork
+ !! limit determines the maximum number of subintervals
+ !! in the partition of the given integration interval
+ !! (a,b), limit.ge.1.
+ !! if limit.lt.1, the routine will end with ier = 6.
+ !!
+ !! lenw - integer
+ !! dimensioning parameter for work
+ !! lenw must be at least limit*4.
+ !! if lenw.lt.limit*4, the routine will end with
+ !! ier = 6.
+ !!
+ !! last - integer
+ !! on return, last equals the number of subintervals
+ !! produced in the subdiviosion process, which
+ !! determines the number of significant elements
+ !! actually in the work arrays.
+ !!
+ !! work arrays
+ !! iwork - integer
+ !! vector of dimension at least limit, the first k
+ !! elements of which contain pointers to the error
+ !! estimates over the subintervals, such that
+ !! work(limit*3+iwork(1)),... , work(limit*3+iwork(k))
+ !! form a decreasing sequence with k = last if
+ !! last.le.(limit/2+2), and k = limit+1-last otherwise
+ !!
+ !! work - double precision
+ !! vector of dimension at least lenw
+ !! on return
+ !! work(1), ..., work(last) contain the left end
+ !! points of the subintervals in the partition of
+ !! (a,b),
+ !! work(limit+1), ..., work(limit+last) contain the
+ !! right end points,
+ !! work(limit*2+1), ..., work(limit*2+last) contain
+ !! the integral approximations over the subintervals,
+ !! work(limit*3+1), ..., work(limit*3+last) contain
+ !! the error estimates.
+ !!
+ !!***references (none)
+ !!***routines called dqage,xerror
+ !!***end prologue dqag
+ subroutine dqag(fx,fx_vars,a,b,epsabs,epsrel,key,result,abserr,neval,ier, &
+ limit,lenw,last,iwork,work)
+
+ ! Arguments
+ interface
+ function fx(centr, vars)
+ use carma_precision_mod, only : f
+ use adgaquad_types_mod
+ real(kind=f), intent(in) :: centr
+ type(adgaquad_vars_type), intent(inout) :: vars
+ real(kind=f) :: fx
+ end function fx
+ end interface
+ type(adgaquad_vars_type) :: fx_vars
+ real(kind=f) :: a
+ real(kind=f) :: b
+ real(kind=f) :: epsabs
+ real(kind=f) :: epsrel
+ integer :: key
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ integer :: neval
+ integer :: ier
+ integer :: limit
+ integer :: lenw
+ integer :: last
+ integer :: iwork(limit)
+ real(kind=f) :: work(lenw)
+
+ ! Local declarations
+ integer :: lvl,l1,l2,l3
+
+ ! check validity of lenw.
+ !
+ !***first executable statement dqag
+ ier = 6
+ neval = 0
+ last = 0
+ result = 0.0_f
+ abserr = 0.0_f
+ if(limit.lt.1.or.lenw.lt.limit*4) go to 10
+
+ ! prepare call for dqage.
+
+ l1 = limit+1
+ l2 = limit+l1
+ l3 = limit+l2
+
+ call dqage(fx,fx_vars,a,b,epsabs,epsrel,key,limit,result,abserr,neval, &
+ ier,work(1),work(l1),work(l2),work(l3),iwork,last)
+
+ ! call error handler if necessary.
+
+ lvl = 0
+10 if(ier.eq.6) lvl = 1
+ if(ier.ne.0) then
+ write(*,*) "ERROR: abnormal return from dqag"
+ write(*,*) " ifail=",ier," level=",lvl
+ endif
+ return
+ end subroutine dqag
+
+
+
+ !!***begin prologue dqage
+ !!***date written 800101 (yymmdd)
+ !!***revision date 130319 (yymmdd)
+ !!***category no. h2a1a1
+ !!***keywords automatic integrator, general-purpose,
+ !! integrand examinator, globally adaptive,
+ !! gauss-kronrod
+ !!***author piessens,robert,appl. math. & progr. div. - k.u.leuven
+ !! de doncker,elise,appl. math. & progr. div. - k.u.leuven
+ !!***purpose the routine calculates an approximation result to a given
+ !! definite integral i = integral of f over (a,b),
+ !! hopefully satisfying following claim for accuracy
+ !! abs(i-reslt).le.max(epsabs,epsrel*abs(i)).
+ !!***description
+ !!
+ !! computation of a definite integral
+ !! standard fortran subroutine
+ !! double precision version
+ !!
+ !! parameters
+ !! on entry
+ !! fx - double precision
+ !! function subprogram defining the integrand
+ !! function f(x). the actual name for f needs to be
+ !! declared e x t e r n a l in the driver program.
+ !!
+ !! fx_vars- structure containing variables need for integration
+ !! specific to fractal meanfield scattering code
+ !!
+ !! a - double precision
+ !! lower limit of integration
+ !!
+ !! b - double precision
+ !! upper limit of integration
+ !!
+ !! epsabs - double precision
+ !! absolute accuracy requested
+ !! epsrel - double precision
+ !! relative accuracy requested
+ !! if epsabs.le.0
+ !! and epsrel.lt.max(50*rel.mach.acc.,0.5d-28),
+ !! the routine will end with ier = 6.
+ !!
+ !! key - integer
+ !! key for choice of local integration rule
+ !! a gauss-kronrod pair is used with
+ !! 7 - 15 points if key.lt.2,
+ !! 10 - 21 points if key = 2,
+ !! 15 - 31 points if key = 3,
+ !! 20 - 41 points if key = 4,
+ !! 25 - 51 points if key = 5,
+ !! 30 - 61 points if key.gt.5.
+ !!
+ !! limit - integer
+ !! gives an upperbound on the number of subintervals
+ !! in the partition of (a,b), limit.ge.1.
+ !!
+ !! on return
+ !! result - double precision
+ !! approximation to the integral
+ !!
+ !! abserr - double precision
+ !! estimate of the modulus of the absolute error,
+ !! which should equal or exceed abs(i-result)
+ !!
+ !! neval - integer
+ !! number of integrand evaluations
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! ier.gt.0 abnormal termination of the routine
+ !! the estimates for result and error are
+ !! less reliable. it is assumed that the
+ !! requested accuracy has not been achieved.
+ !! error messages
+ !! ier = 1 maximum number of subdivisions allowed
+ !! has been achieved. one can allow more
+ !! subdivisions by increasing the value
+ !! of limit.
+ !! however, if this yields no improvement it
+ !! is rather advised to analyze the integrand
+ !! in order to determine the integration
+ !! difficulties. if the position of a local
+ !! difficulty can be determined(e.g.
+ !! singularity, discontinuity within the
+ !! interval) one will probably gain from
+ !! splitting up the interval at this point
+ !! and calling the integrator on the
+ !! subranges. if possible, an appropriate
+ !! special-purpose integrator should be used
+ !! which is designed for handling the type of
+ !! difficulty involved.
+ !! = 2 the occurrence of roundoff error is
+ !! detected, which prevents the requested
+ !! tolerance from being achieved.
+ !! = 3 extremely bad integrand behaviour occurs
+ !! at some points of the integration
+ !! interval.
+ !! = 6 the input is invalid, because
+ !! (epsabs.le.0 and
+ !! epsrel.lt.max(50*rel.mach.acc.,0.5d-28),
+ !! result, abserr, neval, last, rlist(1) ,
+ !! elist(1) and iord(1) are set to zero.
+ !! alist(1) and blist(1) are set to a and b
+ !! respectively.
+ !! = 9 failure in sd1mach determining machine parameters
+ !!
+ !! alist - double precision
+ !! vector of dimension at least limit, the first
+ !! last elements of which are the left
+ !! end points of the subintervals in the partition
+ !! of the given integration range (a,b)
+ !!
+ !! blist - double precision
+ !! vector of dimension at least limit, the first
+ !! last elements of which are the right
+ !! end points of the subintervals in the partition
+ !! of the given integration range (a,b)
+ !!
+ !! rlist - double precision
+ !! vector of dimension at least limit, the first
+ !! last elements of which are the
+ !! integral approximations on the subintervals
+ !!
+ !! elist - double precision
+ !! vector of dimension at least limit, the first
+ !! last elements of which are the moduli of the
+ !! absolute error estimates on the subintervals
+ !!
+ !! iord - integer
+ !! vector of dimension at least limit, the first k
+ !! elements of which are pointers to the
+ !! error estimates over the subintervals,
+ !! such that elist(iord(1)), ...,
+ !! elist(iord(k)) form a decreasing sequence,
+ !! with k = last if last.le.(limit/2+2), and
+ !! k = limit+1-last otherwise
+ !!
+ !! last - integer
+ !! number of subintervals actually produced in the
+ !! subdivision process
+ !!
+ !!***references (none)
+ !!***routines called sd1mach,dqk15,dqk21,dqk31,
+ !! dqk41,dqk51,dqk61,dqpsrt
+ !!***end prologue dqage
+ subroutine dqage(fx,fx_vars,a,b,epsabs,epsrel,key,limit,result,abserr, &
+ neval,ier,alist,blist,rlist,elist,iord,last)
+
+ ! Arguments
+ interface
+ function fx(centr, vars)
+ use carma_precision_mod, only : f
+ use adgaquad_types_mod
+ real(kind=f), intent(in) :: centr
+ type(adgaquad_vars_type), intent(inout) :: vars
+ real(kind=f) :: fx
+ end function fx
+ end interface
+ type(adgaquad_vars_type) :: fx_vars
+ real(kind=f) :: a
+ real(kind=f) :: b
+ real(kind=f) :: epsabs
+ real(kind=f) :: epsrel
+ integer :: limit
+ integer :: key
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ integer :: neval
+ integer :: ier
+ real(kind=f) :: alist(limit)
+ real(kind=f) :: blist(limit)
+ real(kind=f) :: rlist(limit)
+ real(kind=f) :: elist(limit)
+ integer :: iord(limit)
+ integer :: last
+
+ ! Local declarations
+ real(kind=f) :: area, area1, area12, area2, a1, a2
+ real(kind=f) :: b1, b2, dabs, defabs, defab1, defab2, dmax1, epmach
+ real(kind=f) :: errbnd,errmax,error1,error2,erro12,errsum,resabs,uflow
+ integer :: iroff1,iroff2,k,keyf,maxerr,nrmax
+
+
+ ! list of major variables
+ ! -----------------------
+ !
+ ! alist - list of left end points of all subintervals
+ ! considered up to now
+ ! blist - list of right end points of all subintervals
+ ! considered up to now
+ ! rlist(i) - approximation to the integral over
+ ! (alist(i),blist(i))
+ ! elist(i) - error estimate applying to rlist(i)
+ ! maxerr - pointer to the interval with largest
+ ! error estimate
+ ! errmax - elist(maxerr)
+ ! area - sum of the integrals over the subintervals
+ ! errsum - sum of the errors over the subintervals
+ ! errbnd - requested accuracy max(epsabs,epsrel*
+ ! abs(result))
+ ! *****1 - variable for the left subinterval
+ ! *****2 - variable for the right subinterval
+ ! last - index for subdivision
+ !
+ !
+ ! machine dependent constants
+ ! ---------------------------
+ !
+ ! epmach is the largest relative spacing.
+ ! uflow is the smallest positive magnitude.
+ !
+ !***first executable statement dqage
+ call sd1mach(4,epmach,ier)
+ if(ier.eq.9) return
+ call sd1mach(1,uflow,ier)
+ if(ier.eq.9) return
+
+ !epmach = d1mach(4)
+ !uflow = d1mach(1)
+
+ ! test on validity of parameters
+ ! ------------------------------
+ !
+ ier = 0
+ neval = 0
+ last = 0
+ result = 0.0_f
+ abserr = 0.0_f
+ alist(1) = a
+ blist(1) = b
+ rlist(1) = 0.0_f
+ elist(1) = 0.0_f
+ iord(1) = 0
+ if(epsabs.le.0.0_f.and.epsrel.lt.dmax1(0.5e2_f*epmach,0.5e-28_f)) ier = 6
+ if(ier.eq.6) go to 999
+
+ ! first approximation to the integral
+ ! -----------------------------------
+ !
+ keyf = key
+ if(key.le.0) keyf = 1
+ if(key.ge.7) keyf = 6
+ neval = 0
+ if(keyf.eq.1) call dqk15(fx,fx_vars,a,b,result,abserr,defabs,resabs,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.2) call dqk21(fx,fx_vars,a,b,result,abserr,defabs,resabs,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.3) call dqk31(fx,fx_vars,a,b,result,abserr,defabs,resabs,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.4) call dqk41(fx,fx_vars,a,b,result,abserr,defabs,resabs,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.5) call dqk51(fx,fx_vars,a,b,result,abserr,defabs,resabs,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.6) call dqk61(fx,fx_vars,a,b,result,abserr,defabs,resabs,ier)
+ if(ier.eq.9) return
+ last = 1
+ rlist(1) = result
+ elist(1) = abserr
+ iord(1) = 1
+ !
+ ! test on accuracy.
+ !
+ errbnd = dmax1(epsabs,epsrel*dabs(result))
+ if(abserr.le.0.5e2_f*epmach*defabs.and.abserr.gt.errbnd) ier = 2
+ if(limit.eq.1) ier = 1
+ if(ier.ne.0.or.(abserr.le.errbnd.and.abserr.ne.resabs).or.abserr.eq.0.0d+00) go to 60
+ !
+ ! initialization
+ ! --------------
+ !
+ errmax = abserr
+ maxerr = 1
+ area = result
+ errsum = abserr
+ nrmax = 1
+ iroff1 = 0
+ iroff2 = 0
+ !
+ ! main do-loop
+ ! ------------
+ !
+ do last = 2,limit
+ !
+ ! bisect the subinterval with the largest error estimate.
+ !
+ a1 = alist(maxerr)
+ b1 = 0.5_f*(alist(maxerr)+blist(maxerr))
+ a2 = b1
+ b2 = blist(maxerr)
+ if(keyf.eq.1) call dqk15(fx,fx_vars,a1,b1,area1,error1,resabs,defab1,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.2) call dqk21(fx,fx_vars,a1,b1,area1,error1,resabs,defab1,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.3) call dqk31(fx,fx_vars,a1,b1,area1,error1,resabs,defab1,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.4) call dqk41(fx,fx_vars,a1,b1,area1,error1,resabs,defab1,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.5) call dqk51(fx,fx_vars,a1,b1,area1,error1,resabs,defab1,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.6) call dqk61(fx,fx_vars,a1,b1,area1,error1,resabs,defab1,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.1) call dqk15(fx,fx_vars,a2,b2,area2,error2,resabs,defab2,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.2) call dqk21(fx,fx_vars,a2,b2,area2,error2,resabs,defab2,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.3) call dqk31(fx,fx_vars,a2,b2,area2,error2,resabs,defab2,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.4) call dqk41(fx,fx_vars,a2,b2,area2,error2,resabs,defab2,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.5) call dqk51(fx,fx_vars,a2,b2,area2,error2,resabs,defab2,ier)
+ if(ier.eq.9) return
+ if(keyf.eq.6) call dqk61(fx,fx_vars,a2,b2,area2,error2,resabs,defab2,ier)
+ if(ier.eq.9) return
+ ! improve previous approximations to integral
+ ! and error and test for accuracy.
+ !
+ ! neval = neval+1
+ area12 = area1+area2
+ erro12 = error1+error2
+ errsum = errsum+erro12-errmax
+ area = area+area12-rlist(maxerr)
+ if(defab1.eq.error1.or.defab2.eq.error2) go to 5
+ if(dabs(rlist(maxerr)-area12).le.0.1e-4_f*dabs(area12).and.erro12.ge.0.99_f*errmax) iroff1 = iroff1+1
+ if(last.gt.10.and.erro12.gt.errmax) iroff2 = iroff2+1
+ 5 rlist(maxerr) = area1
+ rlist(last) = area2
+ errbnd = dmax1(epsabs,epsrel*dabs(area))
+ if(errsum.le.errbnd) go to 8
+ !
+ ! test for roundoff error and eventually set error flag.
+ !
+ if(iroff1.ge.6.or.iroff2.ge.20) ier = 2
+ !
+ ! set error flag in the case that the number of subintervals
+ ! equals limit.
+ !
+ if(last.eq.limit) ier = 1
+ !
+ ! set error flag in the case of bad integrand behaviour
+ ! at a point of the integration range.
+ !
+ if(dmax1(dabs(a1),dabs(b2)).le.(0.1e1_f+0.1e3_f*epmach)*(dabs(a2)+0.1e4_f*uflow)) ier = 3
+ !
+ ! append the newly-created intervals to the list.
+ !
+ 8 if(error2.gt.error1) go to 10
+ alist(last) = a2
+ blist(maxerr) = b1
+ blist(last) = b2
+ elist(maxerr) = error1
+ elist(last) = error2
+ go to 20
+ 10 alist(maxerr) = a2
+ alist(last) = a1
+ blist(last) = b1
+ rlist(maxerr) = area2
+ rlist(last) = area1
+ elist(maxerr) = error2
+ elist(last) = error1
+ !
+ ! call subroutine dqpsrt to maintain the descending ordering
+ ! in the list of error estimates and select the subinterval
+ ! with the largest error estimate (to be bisected next).
+ !
+ 20 call dqpsrt(limit,last,maxerr,errmax,elist,iord,nrmax)
+ ! ***jump out of do-loop
+ if(ier.ne.0.or.errsum.le.errbnd) go to 40
+ end do
+ !
+ ! compute final result.
+ ! ---------------------
+ !
+ 40 result = 0.0_f
+ do k=1,last
+ result = result+rlist(k)
+ end do
+ abserr = errsum
+ 60 if(keyf.ne.1) neval = (10*keyf+1)*(2*neval+1)
+ if(keyf.eq.1) neval = 30*neval+15
+999 return
+ end subroutine dqage
+
+
+ !!***begin prologue dqagi
+ !!***date written 800101 (yymmdd)
+ !!***revision date 130319 (yymmdd)
+ !!***category no. h2a3a1,h2a4a1
+ !!***keywords automatic integrator, infinite intervals,
+ !! general-purpose, transformation, extrapolation,
+ !! globally adaptive
+ !!***author piessens,robert,appl. math. & progr. div. - k.u.leuven
+ !! de doncker,elise,appl. math. & progr. div. -k.u.leuven
+ !!***purpose the routine calculates an approximation result to a given
+ !! integral i = integral of f over (bound,+infinity)
+ !! or i = integral of f over (-infinity,bound)
+ !! or i = integral of f over (-infinity,+infinity)
+ !! hopefully satisfying following claim for accuracy
+ !! abs(i-result).le.max(epsabs,epsrel*abs(i)).
+ !!***description
+ !!
+ !! integration over infinite intervals
+ !! standard fortran subroutine
+ !!
+ !! parameters
+ !! on entry
+ !! fx - double precision
+ !! function subprogram defining the integrand
+ !! function f(x). the actual name for f needs to be
+ !! declared e x t e r n a l in the driver program.
+ !!
+ !! fx_vars- structure containing variables need for integration
+ !! specific to fractal meanfield scattering code
+ !!
+ !! bound - double precision
+ !! finite bound of integration range
+ !! (has no meaning if interval is doubly-infinite)
+ !!
+ !! inf - integer
+ !! indicating the kind of integration range involved
+ !! inf = 1 corresponds to (bound,+infinity),
+ !! inf = -1 to (-infinity,bound),
+ !! inf = 2 to (-infinity,+infinity).
+ !!
+ !! epsabs - double precision
+ !! absolute accuracy requested
+ !! epsrel - double precision
+ !! relative accuracy requested
+ !! if epsabs.le.0
+ !! and epsrel.lt.max(50*rel.mach.acc.,0.5d-28),
+ !! the routine will end with ier = 6.
+ !!
+ !!
+ !! on return
+ !! result - double precision
+ !! approximation to the integral
+ !!
+ !! abserr - double precision
+ !! estimate of the modulus of the absolute error,
+ !! which should equal or exceed abs(i-result)
+ !!
+ !! neval - integer
+ !! number of integrand evaluations
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! - ier.gt.0 abnormal termination of the routine. the
+ !! estimates for result and error are less
+ !! reliable. it is assumed that the requested
+ !! accuracy has not been achieved.
+ !! error messages
+ !! ier = 1 maximum number of subdivisions allowed
+ !! has been achieved. one can allow more
+ !! subdivisions by increasing the value of
+ !! limit (and taking the according dimension
+ !! adjustments into account). however, if
+ !! this yields no improvement it is advised
+ !! to analyze the integrand in order to
+ !! determine the integration difficulties. if
+ !! the position of a local difficulty can be
+ !! determined (e.g. singularity,
+ !! discontinuity within the interval) one
+ !! will probably gain from splitting up the
+ !! interval at this point and calling the
+ !! integrator on the subranges. if possible,
+ !! an appropriate special-purpose integrator
+ !! should be used, which is designed for
+ !! handling the type of difficulty involved.
+ !! = 2 the occurrence of roundoff error is
+ !! detected, which prevents the requested
+ !! tolerance from being achieved.
+ !! the error may be under-estimated.
+ !! = 3 extremely bad integrand behaviour occurs
+ !! at some points of the integration
+ !! interval.
+ !! = 4 the algorithm does not converge.
+ !! roundoff error is detected in the
+ !! extrapolation table.
+ !! it is assumed that the requested tolerance
+ !! cannot be achieved, and that the returned
+ !! result is the best which can be obtained.
+ !! = 5 the integral is probably divergent, or
+ !! slowly convergent. it must be noted that
+ !! divergence can occur with any other value
+ !! of ier.
+ !! = 6 the input is invalid, because
+ !! (epsabs.le.0 and
+ !! epsrel.lt.max(50*rel.mach.acc.,0.5d-28))
+ !! or limit.lt.1 or leniw.lt.limit*4.
+ !! result, abserr, neval, last are set to
+ !! zero. exept when limit or leniw is
+ !! invalid, iwork(1), work(limit*2+1) and
+ !! work(limit*3+1) are set to zero, work(1)
+ !! is set to a and work(limit+1) to b.
+ !! = 9 failure in sd1mach determining machine parameters
+ !!
+ !! dimensioning parameters
+ !! limit - integer
+ !! dimensioning parameter for iwork
+ !! limit determines the maximum number of subintervals
+ !! in the partition of the given integration interval
+ !! (a,b), limit.ge.1.
+ !! if limit.lt.1, the routine will end with ier = 6.
+ !!
+ !! lenw - integer
+ !! dimensioning parameter for work
+ !! lenw must be at least limit*4.
+ !! if lenw.lt.limit*4, the routine will end
+ !! with ier = 6.
+ !!
+ !! last - integer
+ !! on return, last equals the number of subintervals
+ !! produced in the subdivision process, which
+ !! determines the number of significant elements
+ !! actually in the work arrays.
+ !!
+ !! work arrays
+ !! iwork - integer
+ !! vector of dimension at least limit, the first
+ !! k elements of which contain pointers
+ !! to the error estimates over the subintervals,
+ !! such that work(limit*3+iwork(1)),... ,
+ !! work(limit*3+iwork(k)) form a decreasing
+ !! sequence, with k = last if last.le.(limit/2+2), and
+ !! k = limit+1-last otherwise
+ !!
+ !! work - double precision
+ !! vector of dimension at least lenw
+ !! on return
+ !! work(1), ..., work(last) contain the left
+ !! end points of the subintervals in the
+ !! partition of (a,b),
+ !! work(limit+1), ..., work(limit+last) contain
+ !! the right end points,
+ !! work(limit*2+1), ...,work(limit*2+last) contain the
+ !! integral approximations over the subintervals,
+ !! work(limit*3+1), ..., work(limit*3)
+ !! contain the error estimates.
+ !!***references (none)
+ !!***routines called dqagie,xerror
+ !!***end prologue dqagi
+ !!
+ subroutine dqagi(fx,fx_vars,bound,inf,epsabs,epsrel,result,abserr,neval, &
+ ier,limit,lenw,last,iwork,work)
+
+ ! Arguments
+ interface
+ function fx(centr, vars)
+ use carma_precision_mod, only : f
+ use adgaquad_types_mod
+ real(kind=f), intent(in) :: centr
+ type(adgaquad_vars_type), intent(inout) :: vars
+ real(kind=f) :: fx
+ end function fx
+ end interface
+ type(adgaquad_vars_type) :: fx_vars
+ real(kind=f) :: bound
+ integer :: inf
+ real(kind=f) :: epsabs
+ real(kind=f) :: epsrel
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ integer :: neval
+ integer :: ier
+ integer :: limit
+ integer :: lenw
+ integer :: last
+ integer :: iwork(limit)
+ real(kind=f) :: work(lenw)
+
+ ! Local declarations
+ integer lvl,l1,l2,l3
+
+ !
+ ! check validity of limit and lenw.
+ !
+ !***first executable statement dqagi
+ ier = 6
+ neval = 0
+ last = 0
+ result = 0.0_f
+ abserr = 0.0_f
+ if(limit.lt.1.or.lenw.lt.limit*4) go to 10
+ !
+ ! prepare call for dqagie.
+ !
+ l1 = limit+1
+ l2 = limit+l1
+ l3 = limit+l2
+
+ call dqagie(fx,fx_vars,bound,inf,epsabs,epsrel,limit,result,abserr, &
+ neval,ier,work(1),work(l1),work(l2),work(l3),iwork,last)
+ !
+ ! call error handler if necessary.
+ !
+ lvl = 0
+10 if(ier.eq.6) lvl = 1
+ if(ier.ne.0) then
+ write(*,*) "ERROR: abnormal return from dqagi"
+ write(*,*) " ifail=",ier," level=",lvl
+ endif
+ return
+ end subroutine dqagi
+
+
+ !!***begin prologue dqagie
+ !!***date written 800101 (yymmdd)
+ !!***revision date 130319 (yymmdd)
+ !!***category no. h2a3a1,h2a4a1
+ !!***keywords automatic integrator, infinite intervals,
+ !! general-purpose, transformation, extrapolation,
+ !! globally adaptive
+ !!***author piessens,robert,appl. math & progr. div - k.u.leuven
+ !! de doncker,elise,appl. math & progr. div - k.u.leuven
+ !!***purpose the routine calculates an approximation result to a given
+ !! integral i = integral of f over (bound,+infinity)
+ !! or i = integral of f over (-infinity,bound)
+ !! or i = integral of f over (-infinity,+infinity),
+ !! hopefully satisfying following claim for accuracy
+ !! abs(i-result).le.max(epsabs,epsrel*abs(i))
+ !!***description
+ !!
+ !! integration over infinite intervals
+ !! standard fortran subroutine
+ !!
+ !! fx - double precision
+ !! function subprogram defining the integrand
+ !! function f(x). the actual name for f needs to be
+ !! declared e x t e r n a l in the driver program.
+ !!
+ !! fx_vars- structure containing variables need for integration
+ !! specific to fractal meanfield scattering code
+ !!
+ !! bound - double precision
+ !! finite bound of integration range
+ !! (has no meaning if interval is doubly-infinite)
+ !!
+ !! inf - double precision
+ !! indicating the kind of integration range involved
+ !! inf = 1 corresponds to (bound,+infinity),
+ !! inf = -1 to (-infinity,bound),
+ !! inf = 2 to (-infinity,+infinity).
+ !!
+ !! epsabs - double precision
+ !! absolute accuracy requested
+ !! epsrel - double precision
+ !! relative accuracy requested
+ !! if epsabs.le.0
+ !! and epsrel.lt.max(50*rel.mach.acc.,0.5d-28),
+ !! the routine will end with ier = 6.
+ !!
+ !! limit - integer
+ !! gives an upper bound on the number of subintervals
+ !! in the partition of (a,b), limit.ge.1
+ !!
+ !! on return
+ !! result - double precision
+ !! approximation to the integral
+ !!
+ !! abserr - double precision
+ !! estimate of the modulus of the absolute error,
+ !! which should equal or exceed abs(i-result)
+ !!
+ !! neval - integer
+ !! number of integrand evaluations
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! - ier.gt.0 abnormal termination of the routine. the
+ !! estimates for result and error are less
+ !! reliable. it is assumed that the requested
+ !! accuracy has not been achieved.
+ !! error messages
+ !! ier = 1 maximum number of subdivisions allowed
+ !! has been achieved. one can allow more
+ !! subdivisions by increasing the value of
+ !! limit (and taking the according dimension
+ !! adjustments into account). however,if
+ !! this yields no improvement it is advised
+ !! to analyze the integrand in order to
+ !! determine the integration difficulties.
+ !! if the position of a local difficulty can
+ !! be determined (e.g. singularity,
+ !! discontinuity within the interval) one
+ !! will probably gain from splitting up the
+ !! interval at this point and calling the
+ !! integrator on the subranges. if possible,
+ !! an appropriate special-purpose integrator
+ !! should be used, which is designed for
+ !! handling the type of difficulty involved.
+ !! = 2 the occurrence of roundoff error is
+ !! detected, which prevents the requested
+ !! tolerance from being achieved.
+ !! the error may be under-estimated.
+ !! = 3 extremely bad integrand behaviour occurs
+ !! at some points of the integration
+ !! interval.
+ !! = 4 the algorithm does not converge.
+ !! roundoff error is detected in the
+ !! extrapolation table.
+ !! it is assumed that the requested tolerance
+ !! cannot be achieved, and that the returned
+ !! result is the best which can be obtained.
+ !! = 5 the integral is probably divergent, or
+ !! slowly convergent. it must be noted that
+ !! divergence can occur with any other value
+ !! of ier.
+ !! = 6 the input is invalid, because
+ !! (epsabs.le.0 and
+ !! epsrel.lt.max(50*rel.mach.acc.,0.5d-28),
+ !! result, abserr, neval, last, rlist(1),
+ !! elist(1) and iord(1) are set to zero.
+ !! alist(1) and blist(1) are set to 0
+ !! and 1 respectively.
+ !! = 9 failure in sd1mach determining machine parameters
+ !!
+ !! alist - double precision
+ !! vector of dimension at least limit, the first
+ !! last elements of which are the left
+ !! end points of the subintervals in the partition
+ !! of the transformed integration range (0,1).
+ !!
+ !! blist - double precision
+ !! vector of dimension at least limit, the first
+ !! last elements of which are the right
+ !! end points of the subintervals in the partition
+ !! of the transformed integration range (0,1).
+ !!
+ !! rlist - double precision
+ !! vector of dimension at least limit, the first
+ !! last elements of which are the integral
+ !! approximations on the subintervals
+ !!
+ !! elist - double precision
+ !! vector of dimension at least limit, the first
+ !! last elements of which are the moduli of the
+ !! absolute error estimates on the subintervals
+ !!
+ !! iord - integer
+ !! vector of dimension limit, the first k
+ !! elements of which are pointers to the
+ !! error estimates over the subintervals,
+ !! such that elist(iord(1)), ..., elist(iord(k))
+ !! form a decreasing sequence, with k = last
+ !! if last.le.(limit/2+2), and k = limit+1-last
+ !! otherwise
+ !!
+ !! last - integer
+ !! number of subintervals actually produced
+ !! in the subdivision process
+ !!
+ !!***references (none)
+ !!***routines called sd1mach,dqelg,dqk15i,dqpsrt
+ !!***end prologue dqagie
+ subroutine dqagie(fx,fx_vars,bound,inf,epsabs,epsrel,limit,result,abserr,neval,ier,alist,blist,rlist,elist,iord,last)
+
+ ! Arguments
+ interface
+ function fx(centr, vars)
+ use carma_precision_mod, only : f
+ use adgaquad_types_mod
+ real(kind=f), intent(in) :: centr
+ type(adgaquad_vars_type), intent(inout) :: vars
+ real(kind=f) :: fx
+ end function fx
+ end interface
+ type(adgaquad_vars_type) :: fx_vars
+ real(kind=f) :: bound
+ integer :: inf
+ real(kind=f) :: epsabs
+ real(kind=f) :: epsrel
+ integer :: limit
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ integer :: neval
+ integer :: ier
+ real(kind=f) :: alist(limit)
+ real(kind=f) :: blist(limit)
+ real(kind=f) :: rlist(limit)
+ real(kind=f) :: elist(limit)
+ integer :: iord(limit)
+ integer :: last
+
+ ! Local declartions
+ real(kind=f) :: abseps, area, area1, area12, area2
+ real(kind=f) :: a1, a2, b1, b2, correc
+ real(kind=f) :: defabs, defab1, defab2
+ real(kind=f) :: dmax1, dres, epmach, erlarg, erlast
+ real(kind=f) :: errbnd, errmax, error1, error2, erro12, errsum
+ real(kind=f) :: ertest, oflow, resabs, reseps, res3la(3), rlist2(52)
+ real(kind=f) :: small, uflow, boun
+
+ integer :: id, ierro, iroff1, iroff2, iroff3, jupbnd, k, ksgn
+ integer :: ktmin, maxerr, nres, nrmax, numrl2
+ logical :: extrap, noext
+
+
+ !
+ ! the dimension of rlist2 is determined by the value of
+ ! limexp in subroutine dqelg.
+ !
+ ! list of major variables
+ ! -----------------------
+ !
+ ! alist - list of left end points of all subintervals
+ ! considered up to now
+ ! blist - list of right end points of all subintervals
+ ! considered up to now
+ ! rlist(i) - approximation to the integral over
+ ! (alist(i),blist(i))
+ ! rlist2 - array of dimension at least (limexp+2),
+ ! containing the part of the epsilon table
+ ! wich is still needed for further computations
+ ! elist(i) - error estimate applying to rlist(i)
+ ! maxerr - pointer to the interval with largest error
+ ! estimate
+ ! errmax - elist(maxerr)
+ ! erlast - error on the interval currently subdivided
+ ! (before that subdivision has taken place)
+ ! area - sum of the integrals over the subintervals
+ ! errsum - sum of the errors over the subintervals
+ ! errbnd - requested accuracy max(epsabs,epsrel*
+ ! abs(result))
+ ! *****1 - variable for the left subinterval
+ ! *****2 - variable for the right subinterval
+ ! last - index for subdivision
+ ! nres - number of calls to the extrapolation routine
+ ! numrl2 - number of elements currently in rlist2. if an
+ ! appropriate approximation to the compounded
+ ! integral has been obtained, it is put in
+ ! rlist2(numrl2) after numrl2 has been increased
+ ! by one.
+ ! small - length of the smallest interval considered up
+ ! to now, multiplied by 1.5
+ ! erlarg - sum of the errors over the intervals larger
+ ! than the smallest interval considered up to now
+ ! extrap - logical variable denoting that the routine
+ ! is attempting to perform extrapolation. i.e.
+ ! before subdividing the smallest interval we
+ ! try to decrease the value of erlarg.
+ ! noext - logical variable denoting that extrapolation
+ ! is no longer allowed (true-value)
+ !
+ ! machine dependent constants
+ ! ---------------------------
+ !
+ ! epmach is the largest relative spacing.
+ ! uflow is the smallest positive magnitude.
+ ! oflow is the largest positive magnitude.
+ !
+ !***first executable statement dqagie
+
+ call sd1mach(4,epmach,ier)
+ if(ier.eq.9) return
+
+ !epmach = d1mach(4)
+ !
+ ! test on validity of parameters
+ ! -----------------------------
+ !
+ ier = 0
+ neval = 0
+ last = 0
+ result = 0.0_f
+ abserr = 0.0_f
+ alist(1) = 0.0_f
+ blist(1) = 0.1e1_f
+ rlist(1) = 0.0_f
+ elist(1) = 0.0_f
+ iord(1) = 0
+ if(epsabs.le.0.0_f.and.epsrel.lt.dmax1(0.5e2_f*epmach,0.5e-28_f)) ier = 6
+ if(ier.eq.6) go to 999
+ !
+ !
+ ! first approximation to the integral
+ ! -----------------------------------
+ !
+ ! determine the interval to be mapped onto (0,1).
+ ! if inf = 2 the integral is computed as i = i1+i2, where
+ ! i1 = integral of f over (-infinity,0),
+ ! i2 = integral of f over (0,+infinity).
+ !
+ boun = bound
+ if(inf.eq.2) boun = 0.0_f
+ call dqk15i(fx,fx_vars,boun,inf,0.0_f,0.1e1_f,result,abserr,defabs,resabs,ier)
+ if(ier.eq.9) return
+ !
+ ! test on accuracy
+ !
+ last = 1
+ rlist(1) = result
+ elist(1) = abserr
+ iord(1) = 1
+ dres = dabs(result)
+ errbnd = dmax1(epsabs,epsrel*dres)
+ if(abserr.le.1.0e2_f*epmach*defabs.and.abserr.gt.errbnd) ier = 2
+ if(limit.eq.1) ier = 1
+ if(ier.ne.0.or.(abserr.le.errbnd.and.abserr.ne.resabs).or.abserr.eq.0.0_f) go to 130
+ !
+ ! initialization
+ ! --------------
+ !
+ call sd1mach(1,uflow,ier)
+ if(ier.eq.9) return
+ call sd1mach(2,oflow,ier)
+ if(ier.eq.9) return
+
+ !uflow = d1mach(1)
+ !oflow = d1mach(2)
+ rlist2(1) = result
+ errmax = abserr
+ maxerr = 1
+ area = result
+ errsum = abserr
+ abserr = oflow
+ nrmax = 1
+ nres = 0
+ ktmin = 0
+ numrl2 = 2
+ extrap = .false.
+ noext = .false.
+ ierro = 0
+ iroff1 = 0
+ iroff2 = 0
+ iroff3 = 0
+ ksgn = -1
+ if(dres.ge.(0.1e1_f-0.5e2_f*epmach)*defabs) ksgn = 1
+ !
+ ! main do-loop
+ ! ------------
+ !
+ do 90 last = 2,limit
+ !
+ ! bisect the subinterval with nrmax-th largest error estimate.
+ !
+ a1 = alist(maxerr)
+ b1 = 0.5_f*(alist(maxerr)+blist(maxerr))
+ a2 = b1
+ b2 = blist(maxerr)
+ erlast = errmax
+ call dqk15i(fx,fx_vars,boun,inf,a1,b1,area1,error1,resabs,defab1,ier)
+ if(ier.eq.9) return
+ call dqk15i(fx,fx_vars,boun,inf,a2,b2,area2,error2,resabs,defab2,ier)
+ if(ier.eq.9) return
+ !
+ ! improve previous approximations to integral
+ ! and error and test for accuracy.
+ !
+ area12 = area1+area2
+ erro12 = error1+error2
+ errsum = errsum+erro12-errmax
+ area = area+area12-rlist(maxerr)
+ if(defab1.eq.error1.or.defab2.eq.error2)go to 15
+ if(dabs(rlist(maxerr)-area12).gt.0.1e-4_f*dabs(area12).or.erro12.lt.0.99_f*errmax) go to 10
+ if(extrap) iroff2 = iroff2+1
+ if(.not.extrap) iroff1 = iroff1+1
+ 10 if(last.gt.10.and.erro12.gt.errmax) iroff3 = iroff3+1
+ 15 rlist(maxerr) = area1
+ rlist(last) = area2
+ errbnd = dmax1(epsabs,epsrel*dabs(area))
+ !
+ ! test for roundoff error and eventually set error flag.
+ !
+ if(iroff1+iroff2.ge.10.or.iroff3.ge.20) ier = 2
+ if(iroff2.ge.5) ierro = 3
+ !
+ ! set error flag in the case that the number of
+ ! subintervals equals limit.
+ !
+ if(last.eq.limit) ier = 1
+ !
+ ! set error flag in the case of bad integrand behaviour
+ ! at some points of the integration range.
+ !
+ if(dmax1(dabs(a1),dabs(b2)).le.(0.1e1_f+0.1e3_f*epmach)*(dabs(a2)+0.1e4_f*uflow)) ier = 4
+ !
+ ! append the newly-created intervals to the list.
+ !
+ if(error2.gt.error1) go to 20
+ alist(last) = a2
+ blist(maxerr) = b1
+ blist(last) = b2
+ elist(maxerr) = error1
+ elist(last) = error2
+ go to 30
+ 20 alist(maxerr) = a2
+ alist(last) = a1
+ blist(last) = b1
+ rlist(maxerr) = area2
+ rlist(last) = area1
+ elist(maxerr) = error2
+ elist(last) = error1
+ !
+ ! call subroutine dqpsrt to maintain the descending ordering
+ ! in the list of error estimates and select the subinterval
+ ! with nrmax-th largest error estimate (to be bisected next).
+ !
+ 30 call dqpsrt(limit,last,maxerr,errmax,elist,iord,nrmax)
+ if(errsum.le.errbnd) go to 115
+ if(ier.ne.0) go to 100
+ if(last.eq.2) go to 80
+ if(noext) go to 90
+ erlarg = erlarg-erlast
+ if(dabs(b1-a1).gt.small) erlarg = erlarg+erro12
+ if(extrap) go to 40
+ !
+ ! test whether the interval to be bisected next is the
+ ! smallest interval.
+ !
+ if(dabs(blist(maxerr)-alist(maxerr)).gt.small) go to 90
+ extrap = .true.
+ nrmax = 2
+ 40 if(ierro.eq.3.or.erlarg.le.ertest) go to 60
+ !
+ ! the smallest interval has the largest error.
+ ! before bisecting decrease the sum of the errors over the
+ ! larger intervals (erlarg) and perform extrapolation.
+ !
+ id = nrmax
+ jupbnd = last
+ if(last.gt.(2+limit/2)) jupbnd = limit+3-last
+ do k = id,jupbnd
+ maxerr = iord(nrmax)
+ errmax = elist(maxerr)
+ if(dabs(blist(maxerr)-alist(maxerr)).gt.small) go to 90
+ nrmax = nrmax+1
+ end do
+ !
+ ! perform extrapolation.
+ !
+ 60 numrl2 = numrl2+1
+ rlist2(numrl2) = area
+ call dqelg(numrl2,rlist2,reseps,abseps,res3la,nres, ier)
+ if(ier.eq.9) return
+ ktmin = ktmin+1
+ if(ktmin.gt.5.and.abserr.lt.0.1e-2_f*errsum) ier = 5
+ if(abseps.ge.abserr) go to 70
+ ktmin = 0
+ abserr = abseps
+ result = reseps
+ correc = erlarg
+ ertest = dmax1(epsabs,epsrel*dabs(reseps))
+ if(abserr.le.ertest) go to 100
+ !
+ ! prepare bisection of the smallest interval.
+ !
+ 70 if(numrl2.eq.1) noext = .true.
+ if(ier.eq.5) go to 100
+ maxerr = iord(1)
+ errmax = elist(maxerr)
+ nrmax = 1
+ extrap = .false.
+ small = small*0.5_f
+ erlarg = errsum
+ go to 90
+ 80 small = 0.375_f
+ erlarg = errsum
+ ertest = errbnd
+ rlist2(2) = area
+ 90 continue
+ !
+ ! set final result and error estimate.
+ ! ------------------------------------
+ !
+100 if(abserr.eq.oflow) go to 115
+ if((ier+ierro).eq.0) go to 110
+ if(ierro.eq.3) abserr = abserr+correc
+ if(ier.eq.0) ier = 3
+ if(result.ne.0.0_f.and.area.ne.0.0_f)go to 105
+ if(abserr.gt.errsum)go to 115
+ if(area.eq.0.0_f) go to 130
+ go to 110
+105 if(abserr/dabs(result).gt.errsum/dabs(area))go to 115
+ !
+ ! test on divergence
+ !
+110 if(ksgn.eq.(-1).and.dmax1(dabs(result),dabs(area)).le.defabs*0.1e-1_f) go to 130
+ if(0.1e-1_f.gt.(result/area).or.(result/area).gt.0.1e3_f.or.errsum.gt.dabs(area)) ier = 6
+ go to 130
+ !
+ ! compute global integral sum.
+ !
+115 result = 0.0_f
+ do k = 1,last
+ result = result+rlist(k)
+ end do
+ abserr = errsum
+130 neval = 30*last-15
+ if(inf.eq.2) neval = 2*neval
+ if(ier.gt.2) ier=ier-1
+999 return
+ end subroutine dqagie
+
+
+ !!***begin prologue dqk15
+ !!***date written 800101 (yymmdd)
+ !!***revision date 130319 (yymmdd)
+ !!***category no. h2a1a2
+ !!***keywords 15-point gauss-kronrod rules
+ !!***author piessens,robert,appl. math. & progr. div. - k.u.leuven
+ !! de doncker,elise,appl. math. & progr. div - k.u.leuven
+ !!***purpose to compute i = integral of f over (a,b), with error
+ !! estimate
+ !! j = integral of abs(f) over (a,b)
+ !!***description
+ !!
+ !! integration rules
+ !! standard fortran subroutine
+ !! double precision version
+ !!
+ !! parameters
+ !! on entry
+ !! fx - double precision
+ !! function subprogram defining the integrand
+ !! function f(x). the actual name for f needs to be
+ !! declared e x t e r n a l in the calling program.
+ !!
+ !! fx_vars- structure containing variables need for integration
+ !! specific to fractal meanfield scattering code!
+ !!
+ !! a - double precision
+ !! lower limit of integration
+ !!
+ !! b - double precision
+ !! upper limit of integration
+ !!
+ !! on return
+ !! result - double precision
+ !! approximation to the integral i
+ !! result is computed by applying the 15-point
+ !! kronrod rule (resk) obtained by optimal addition
+ !! of abscissae to the7-point gauss rule(resg).
+ !!
+ !! abserr - double precision
+ !! estimate of the modulus of the absolute error,
+ !! which should not exceed abs(i-result)
+ !!
+ !! resabs - double precision
+ !! approximation to the integral j
+ !!
+ !! resasc - double precision
+ !! approximation to the integral of abs(f-i/(b-a))
+ !! over (a,b)
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! ier.gt.0 abnormal termination of the routine. the
+ !! estimates for result and error are less
+ !! reliable. it is assumed that the requested
+ !! accuracy has not been achieved.
+ !!
+ !!***references (none)
+ !!***routines called sd1mach
+ !!***end prologue dqk15
+ !!
+ subroutine dqk15(fx,fx_vars,a,b,result,abserr,resabs,resasc,ier)
+
+ ! Arguments
+ interface
+ function fx(centr, vars)
+ use carma_precision_mod, only : f
+ use adgaquad_types_mod
+ real(kind=f), intent(in) :: centr
+ type(adgaquad_vars_type), intent(inout) :: vars
+ real(kind=f) :: fx
+ end function fx
+ end interface
+ type(adgaquad_vars_type) :: fx_vars
+ real(kind=f) :: a
+ real(kind=f) :: b
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ real(kind=f) :: resabs
+ real(kind=f) :: resasc
+ integer :: ier
+
+ ! Local Declarations
+ real(kind=f) :: absc, centr, dabs, dhlgth, dmax2, dmin1
+ real(kind=f) :: epmach, fc, fsum, fval1, fval2, fv1(7), fv2(7), hlgth
+ real(kind=f) :: resg, resk, reskh, uflow, wg(4), wgk(8), xgk(8)
+ integer :: j,jtw,jtwm1
+
+ !
+ !
+ ! the abscissae and weights are given for the interval (-1,1).
+ ! because of symmetry only the positive abscissae and their
+ ! corresponding weights are given.
+ !
+ ! xgk - abscissae of the 15-point kronrod rule
+ ! xgk(2), xgk(4), ... abscissae of the 7-point
+ ! gauss rule
+ ! xgk(1), xgk(3), ... abscissae which are optimally
+ ! added to the 7-point gauss rule
+ !
+ ! wgk - weights of the 15-point kronrod rule
+ !
+ ! wg - weights of the 7-point gauss rule
+ !
+ !
+ ! gauss quadrature weights and kronron quadrature abscissae and weights
+ ! as evaluated with 80 decimal digit arithmetic by l. w. fullerton,
+ ! bell labs, nov. 1981.
+ !
+ data wg ( 1) / 0.129484966168869693270611432679082_f /
+ data wg ( 2) / 0.279705391489276667901467771423780_f /
+ data wg ( 3) / 0.381830050505118944950369775488975_f /
+ data wg ( 4) / 0.417959183673469387755102040816327_f /
+
+ data xgk ( 1) / 0.991455371120812639206854697526329_f /
+ data xgk ( 2) / 0.949107912342758524526189684047851_f /
+ data xgk ( 3) / 0.864864423359769072789712788640926_f /
+ data xgk ( 4) / 0.741531185599394439863864773280788_f /
+ data xgk ( 5) / 0.586087235467691130294144838258730_f /
+ data xgk ( 6) / 0.405845151377397166906606412076961_f /
+ data xgk ( 7) / 0.207784955007898467600689403773245_f /
+ data xgk ( 8) / 0.000000000000000000000000000000000_f /
+
+ data wgk ( 1) / 0.022935322010529224963732008058970_f /
+ data wgk ( 2) / 0.063092092629978553290700663189204_f /
+ data wgk ( 3) / 0.104790010322250183839876322541518_f /
+ data wgk ( 4) / 0.140653259715525918745189590510238_f /
+ data wgk ( 5) / 0.169004726639267902826583426598550_f /
+ data wgk ( 6) / 0.190350578064785409913256402421014_f /
+ data wgk ( 7) / 0.204432940075298892414161999234649_f /
+ data wgk ( 8) / 0.209482141084727828012999174891714_f /
+
+ !
+ !
+ ! list of major variables
+ ! -----------------------
+ !
+ ! centr - mid point of the interval
+ ! hlgth - half-length of the interval
+ ! absc - abscissa
+ ! fval* - function value
+ ! resg - result of the 7-point gauss formula
+ ! resk - result of the 15-point kronrod formula
+ ! reskh - approximation to the mean value of f over (a,b),
+ ! i.e. to i/(b-a)
+ !
+ ! machine dependent constants
+ ! ---------------------------
+ !
+ ! epmach is the largest relative spacing.
+ ! uflow is the smallest positive magnitude.
+ !
+ !***first executable statement dqk15
+ !epmach = d1mach(4)
+ !uflow = d1mach(1)
+
+ call sd1mach(4,epmach,ier)
+ if(ier.eq.9) return
+ call sd1mach(1,uflow,ier)
+ if(ier.eq.9) return
+
+ centr = 0.5_f*(a+b)
+ hlgth = 0.5_f*(b-a)
+ dhlgth = dabs(hlgth)
+ !
+ ! compute the 15-point kronrod approximation to
+ ! the integral, and estimate the absolute error.
+ !
+ fc = fx(centr,fx_vars)
+ resg = fc*wg(4)
+ resk = fc*wgk(8)
+ resabs = dabs(resk)
+ do j=1,3
+ jtw = j*2
+ absc = hlgth*xgk(jtw)
+ fval1 = fx(centr-absc,fx_vars)
+ fval2 = fx(centr+absc,fx_vars)
+ fv1(jtw) = fval1
+ fv2(jtw) = fval2
+ fsum = fval1+fval2
+ resg = resg+wg(j)*fsum
+ resk = resk+wgk(jtw)*fsum
+ resabs = resabs+wgk(jtw)*(dabs(fval1)+dabs(fval2))
+ end do
+ do j = 1,4
+ jtwm1 = j*2-1
+ absc = hlgth*xgk(jtwm1)
+ fval1 = fx(centr-absc,fx_vars)
+ fval2 = fx(centr+absc,fx_vars)
+ fv1(jtwm1) = fval1
+ fv2(jtwm1) = fval2
+ fsum = fval1+fval2
+ resk = resk+wgk(jtwm1)*fsum
+ resabs = resabs+wgk(jtwm1)*(dabs(fval1)+dabs(fval2))
+ end do
+ reskh = resk*0.5_f
+ resasc = wgk(8)*dabs(fc-reskh)
+ do j=1,7
+ resasc = resasc+wgk(j)*(dabs(fv1(j)-reskh)+dabs(fv2(j)-reskh))
+ end do
+ result = resk*hlgth
+ resabs = resabs*dhlgth
+ resasc = resasc*dhlgth
+ abserr = dabs((resk-resg)*hlgth)
+ if(resasc.ne.0.0_f.and.abserr.ne.0.0_f) abserr = resasc*dmin1(0.1e1_f,(0.2e3_f*abserr/resasc)**1.5_f)
+ if(resabs.gt.uflow/(0.5e2_f*epmach)) abserr = dmax1((epmach*0.5e2_f)*resabs,abserr)
+999 return
+ end subroutine dqk15
+
+ !!
+ !!***begin prologue dqk21
+ !!***date written 800101 (yymmdd)
+ !!***revision date 130319 (yymmdd)
+ !!***category no. h2a1a2
+ !!***keywords 21-point gauss-kronrod rules
+ !!***author piessens,robert,appl. math. & progr. div. - k.u.leuven
+ !! de doncker,elise,appl. math. & progr. div. - k.u.leuven
+ !!***purpose to compute i = integral of f over (a,b), with error
+ !! estimate
+ !! j = integral of abs(f) over (a,b)
+ !!***description
+ !!
+ !! integration rules
+ !! standard fortran subroutine
+ !! double precision version
+ !!
+ !! parameters
+ !! on entry
+ !! fx - double precision
+ !! function subprogram defining the integrand
+ !! function f(x). the actual name for f needs to be
+ !! declared e x t e r n a l in the driver program.
+ !!
+ !! fx_vars- structure containing variables need for integration
+ !! specific to fractal meanfield scattering code
+ !! a - double precision
+ !! lower limit of integration
+ !!
+ !! b - double precision
+ !! upper limit of integration
+ !!
+ !! on return
+ !! result - double precision
+ !! approximation to the integral i
+ !! result is computed by applying the 21-point
+ !! kronrod rule (resk) obtained by optimal addition
+ !! of abscissae to the 10-point gauss rule (resg).
+ !!
+ !! abserr - double precision
+ !! estimate of the modulus of the absolute error,
+ !! which should not exceed abs(i-result)
+ !!
+ !! resabs - double precision
+ !! approximation to the integral j
+ !!
+ !! resasc - double precision
+ !! approximation to the integral of abs(f-i/(b-a))
+ !! over (a,b)
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! ier.gt.0 abnormal termination of the routine. the
+ !! estimates for result and error are less
+ !! reliable. it is assumed that the requested
+ !! accuracy has not been achieved.
+ !!
+ !!
+ !!***references (none)
+ !!***routines called sd1mach
+ !!***end prologue dqk21
+ !!
+ subroutine dqk21(fx,fx_vars,a,b,result,abserr,resabs,resasc, ier)
+
+ ! Arguments
+ interface
+ function fx(centr, vars)
+ use carma_precision_mod, only : f
+ use adgaquad_types_mod
+ real(kind=f), intent(in) :: centr
+ type(adgaquad_vars_type), intent(inout) :: vars
+ real(kind=f) :: fx
+ end function fx
+ end interface
+ type(adgaquad_vars_type) :: fx_vars
+ real(kind=f) :: a
+ real(kind=f) :: b
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ real(kind=f) :: resabs
+ real(kind=f) :: resasc
+ integer :: ier
+
+ ! Local declarations
+ real(kind=f) :: absc, centr, dabs, dhlgth, dmax1, dmin1
+ real(kind=f) :: epmach, fc, fsum, fval1, fval2, fv1(10), fv2(10), hlgth
+ real(kind=f) :: resg, resk, reskh, uflow, wg(5), wgk(11),xgk(11)
+ integer :: j,jtw,jtwm1
+
+ !
+ ! the abscissae and weights are given for the interval (-1,1).
+ ! because of symmetry only the positive abscissae and their
+ ! corresponding weights are given.
+ !
+ ! xgk - abscissae of the 21-point kronrod rule
+ ! xgk(2), xgk(4), ... abscissae of the 10-point
+ ! gauss rule
+ ! xgk(1), xgk(3), ... abscissae which are optimally
+ ! added to the 10-point gauss rule
+ !
+ ! wgk - weights of the 21-point kronrod rule
+ !
+ ! wg - weights of the 10-point gauss rule
+ !
+ !
+ ! gauss quadrature weights and kronron quadrature abscissae and weights
+ ! as evaluated with 80 decimal digit arithmetic by l. w. fullerton,
+ ! bell labs, nov. 1981.
+ !
+ data wg ( 1) / 0.066671344308688137593568809893332_f /
+ data wg ( 2) / 0.149451349150580593145776339657697_f /
+ data wg ( 3) / 0.219086362515982043995534934228163_f /
+ data wg ( 4) / 0.269266719309996355091226921569469_f /
+ data wg ( 5) / 0.295524224714752870173892994651338_f /
+
+ data xgk ( 1) / 0.995657163025808080735527280689003_f /
+ data xgk ( 2) / 0.973906528517171720077964012084452_f /
+ data xgk ( 3) / 0.930157491355708226001207180059508_f /
+ data xgk ( 4) / 0.865063366688984510732096688423493_f /
+ data xgk ( 5) / 0.780817726586416897063717578345042_f /
+ data xgk ( 6) / 0.679409568299024406234327365114874_f /
+ data xgk ( 7) / 0.562757134668604683339000099272694_f /
+ data xgk ( 8) / 0.433395394129247190799265943165784_f /
+ data xgk ( 9) / 0.294392862701460198131126603103866_f /
+ data xgk ( 10) / 0.148874338981631210884826001129720_f /
+ data xgk ( 11) / 0.000000000000000000000000000000000_f /
+
+ data wgk ( 1) / 0.011694638867371874278064396062192_f /
+ data wgk ( 2) / 0.032558162307964727478818972459390_f /
+ data wgk ( 3) / 0.054755896574351996031381300244580_f /
+ data wgk ( 4) / 0.075039674810919952767043140916190_f /
+ data wgk ( 5) / 0.093125454583697605535065465083366_f /
+ data wgk ( 6) / 0.109387158802297641899210590325805_f /
+ data wgk ( 7) / 0.123491976262065851077958109831074_f /
+ data wgk ( 8) / 0.134709217311473325928054001771707_f /
+ data wgk ( 9) / 0.142775938577060080797094273138717_f /
+ data wgk ( 10) / 0.147739104901338491374841515972068_f /
+ data wgk ( 11) / 0.149445554002916905664936468389821_f /
+
+ !
+ ! list of major variables
+ ! -----------------------
+ !
+ ! centr - mid point of the interval
+ ! hlgth - half-length of the interval
+ ! absc - abscissa
+ ! fval* - function value
+ ! resg - result of the 10-point gauss formula
+ ! resk - result of the 21-point kronrod formula
+ ! reskh - approximation to the mean value of f over (a,b),
+ ! i.e. to i/(b-a)
+ !
+ !
+ ! machine dependent constants
+ ! ---------------------------
+ !
+ ! epmach is the largest relative spacing.
+ ! uflow is the smallest positive magnitude.
+ !
+ !***first executable statement dqk21
+ !epmach = d1mach(4)
+ !uflow = d1mach(1)
+
+ call sd1mach(4,epmach,ier)
+ if(ier.eq.9) return
+ call sd1mach(1,uflow,ier)
+ if(ier.eq.9) return
+
+ centr = 0.5_f*(a+b)
+ hlgth = 0.5_f*(b-a)
+ dhlgth = dabs(hlgth)
+ !
+ ! compute the 21-point kronrod approximation to
+ ! the integral, and estimate the absolute error.
+ !
+ resg = 0.0_f
+ fc = fx(centr, fx_vars)
+ resk = wgk(11)*fc
+ resabs = dabs(resk)
+ do j=1,5
+ jtw = 2*j
+ absc = hlgth*xgk(jtw)
+ fval1 = fx(centr-absc, fx_vars)
+ fval2 = fx(centr+absc, fx_vars)
+ fv1(jtw) = fval1
+ fv2(jtw) = fval2
+ fsum = fval1+fval2
+ resg = resg+wg(j)*fsum
+ resk = resk+wgk(jtw)*fsum
+ resabs = resabs+wgk(jtw)*(dabs(fval1)+dabs(fval2))
+ end do
+ do j = 1,5
+ jtwm1 = 2*j-1
+ absc = hlgth*xgk(jtwm1)
+ fval1 = fx(centr-absc, fx_vars)
+ fval2 = fx(centr+absc, fx_vars)
+ fv1(jtwm1) = fval1
+ fv2(jtwm1) = fval2
+ fsum = fval1+fval2
+ resk = resk+wgk(jtwm1)*fsum
+ resabs = resabs+wgk(jtwm1)*(dabs(fval1)+dabs(fval2))
+ end do
+ reskh = resk*0.5_f
+ resasc = wgk(11)*dabs(fc-reskh)
+ do j=1,10
+ resasc = resasc+wgk(j)*(dabs(fv1(j)-reskh)+dabs(fv2(j)-reskh))
+ end do
+ result = resk*hlgth
+ resabs = resabs*dhlgth
+ resasc = resasc*dhlgth
+ abserr = dabs((resk-resg)*hlgth)
+ if(resasc.ne.0.0_f.and.abserr.ne.0.0_f) abserr = resasc*dmin1(0.1e1_f,(0.2e3_f*abserr/resasc)**1.5_f)
+ if(resabs.gt.uflow/(0.5e2_f*epmach)) abserr = dmax1((epmach*0.5e2_f)*resabs,abserr)
+999 return
+ end subroutine dqk21
+
+ !!***begin prologue dqk31
+ !!***date written 800101 (yymmdd)
+ !!***revision date 130519 (yymmdd)
+ !!***category no. h2a1a2
+ !!***keywords 31-point gauss-kronrod rules
+ !!***author piessens,robert,appl. math. & progr. div. - k.u.leuven
+ !! de doncker,elise,appl. math. & progr. div. - k.u.leuven
+ !!***purpose to compute i = integral of f over (a,b) with error
+ !! estimate
+ !! j = integral of abs(f) over (a,b)
+ !!***description
+ !!
+ !! integration rules
+ !! standard fortran subroutine
+ !! double precision version
+ !!
+ !! parameters
+ !! on entry
+ !! fx - double precision
+ !! function subprogram defining the integrand
+ !! function f(x). the actual name for f needs to be
+ !! declared e x t e r n a l in the calling program.
+ !!
+ !! fx_vars- structure containing variables need for integration
+ !! specific to fractal meanfield scattering code!
+ !!
+ !! a - double precision
+ !! lower limit of integration
+ !!
+ !! b - double precision
+ !! upper limit of integration
+ !!
+ !! on return
+ !! result - double precision
+ !! approximation to the integral i
+ !! result is computed by applying the 31-point
+ !! gauss-kronrod rule (resk), obtained by optimal
+ !! addition of abscissae to the 15-point gauss
+ !! rule (resg).
+ !!
+ !! abserr - double precison
+ !! estimate of the modulus of the modulus,
+ !! which should not exceed abs(i-result)
+ !!
+ !! resabs - double precision
+ !! approximation to the integral j
+ !!
+ !! resasc - double precision
+ !! approximation to the integral of abs(f-i/(b-a))
+ !! over (a,b)
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! ier.gt.0 abnormal termination of the routine. the
+ !! estimates for result and error are less
+ !! reliable. it is assumed that the requested
+ !! accuracy has not been achieved.
+ !!
+ !!
+ !!***references (none)
+ !!***routines called sd1mach
+ !!***end prologue dqk31
+ subroutine dqk31(fx,fx_vars,a,b,result,abserr,resabs,resasc, ier)
+
+ ! Arguments
+ interface
+ function fx(centr, vars)
+ use carma_precision_mod, only : f
+ use adgaquad_types_mod
+ real(kind=f), intent(in) :: centr
+ type(adgaquad_vars_type), intent(inout) :: vars
+ real(kind=f) :: fx
+ end function fx
+ end interface
+ type(adgaquad_vars_type) :: fx_vars
+ real(kind=f) :: a
+ real(kind=f) :: b
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ real(kind=f) :: resabs
+ real(kind=f) :: resasc
+ integer :: ier
+
+ ! Local declarations
+ real(kind=f) :: absc, centr, dabs, dhlgth, dmax1, dmin1
+ real(kind=f) :: epmach, fc, fsum, fval1, fval2, fv1(15), fv2(15), hlgth
+ real(kind=f) :: resg, resk, reskh, uflow, wg(8), wgk(16), xgk(16)
+ integer :: j,jtw,jtwm1
+
+ !
+ !
+ ! the abscissae and weights are given for the interval (-1,1).
+ ! because of symmetry only the positive abscissae and their
+ ! corresponding weights are given.
+ !
+ ! xgk - abscissae of the 31-point kronrod rule
+ ! xgk(2), xgk(4), ... abscissae of the 15-point
+ ! gauss rule
+ ! xgk(1), xgk(3), ... abscissae which are optimally
+ ! added to the 15-point gauss rule
+ !
+ ! wgk - weights of the 31-point kronrod rule
+ !
+ ! wg - weights of the 15-point gauss rule
+ !
+ !
+ ! gauss quadrature weights and kronron quadrature abscissae and weights
+ ! as evaluated with 80 decimal digit arithmetic by l. w. fullerton,
+ ! bell labs, nov. 1981.
+ !
+ data wg ( 1) / 0.030753241996117268354628393577204_f /
+ data wg ( 2) / 0.070366047488108124709267416450667_f /
+ data wg ( 3) / 0.107159220467171935011869546685869_f /
+ data wg ( 4) / 0.139570677926154314447804794511028_f /
+ data wg ( 5) / 0.166269205816993933553200860481209_f /
+ data wg ( 6) / 0.186161000015562211026800561866423_f /
+ data wg ( 7) / 0.198431485327111576456118326443839_f /
+ data wg ( 8) / 0.202578241925561272880620199967519_f /
+
+ data xgk ( 1) / 0.998002298693397060285172840152271_f /
+ data xgk ( 2) / 0.987992518020485428489565718586613_f /
+ data xgk ( 3) / 0.967739075679139134257347978784337_f /
+ data xgk ( 4) / 0.937273392400705904307758947710209_f /
+ data xgk ( 5) / 0.897264532344081900882509656454496_f /
+ data xgk ( 6) / 0.848206583410427216200648320774217_f /
+ data xgk ( 7) / 0.790418501442465932967649294817947_f /
+ data xgk ( 8) / 0.724417731360170047416186054613938_f /
+ data xgk ( 9) / 0.650996741297416970533735895313275_f /
+ data xgk ( 10) / 0.570972172608538847537226737253911_f /
+ data xgk ( 11) / 0.485081863640239680693655740232351_f /
+ data xgk ( 12) / 0.394151347077563369897207370981045_f /
+ data xgk ( 13) / 0.299180007153168812166780024266389_f /
+ data xgk ( 14) / 0.201194093997434522300628303394596_f /
+ data xgk ( 15) / 0.101142066918717499027074231447392_f /
+ data xgk ( 16) / 0.000000000000000000000000000000000_f /
+
+ data wgk ( 1) / 0.005377479872923348987792051430128_f /
+ data wgk ( 2) / 0.015007947329316122538374763075807_f /
+ data wgk ( 3) / 0.025460847326715320186874001019653_f /
+ data wgk ( 4) / 0.035346360791375846222037948478360_f /
+ data wgk ( 5) / 0.044589751324764876608227299373280_f /
+ data wgk ( 6) / 0.053481524690928087265343147239430_f /
+ data wgk ( 7) / 0.062009567800670640285139230960803_f /
+ data wgk ( 8) / 0.069854121318728258709520077099147_f /
+ data wgk ( 9) / 0.076849680757720378894432777482659_f /
+ data wgk ( 10) / 0.083080502823133021038289247286104_f /
+ data wgk ( 11) / 0.088564443056211770647275443693774_f /
+ data wgk ( 12) / 0.093126598170825321225486872747346_f /
+ data wgk ( 13) / 0.096642726983623678505179907627589_f /
+ data wgk ( 14) / 0.099173598721791959332393173484603_f /
+ data wgk ( 15) / 0.100769845523875595044946662617570_f /
+ data wgk ( 16) / 0.101330007014791549017374792767493_f /
+ !
+ !
+ ! list of major variables
+ ! -----------------------
+ ! centr - mid point of the interval
+ ! hlgth - half-length of the interval
+ ! absc - abscissa
+ ! fval* - function value
+ ! resg - result of the 15-point gauss formula
+ ! resk - result of the 31-point kronrod formula
+ ! reskh - approximation to the mean value of f over (a,b),
+ ! i.e. to i/(b-a)
+ !
+ ! machine dependent constants
+ ! ---------------------------
+ ! epmach is the largest relative spacing.
+ ! uflow is the smallest positive magnitude.
+ !***first executable statement dqk31
+ call sd1mach(4,epmach,ier)
+ if(ier.eq.9) return
+ call sd1mach(1,uflow,ier)
+ if(ier.eq.9) return
+
+ !epmach = d1mach(4)
+ !uflow = d1mach(1)
+
+ centr = 0.5_f*(a+b)
+ hlgth = 0.5_f*(b-a)
+ dhlgth = dabs(hlgth)
+ !
+ ! compute the 31-point kronrod approximation to
+ ! the integral, and estimate the absolute error.
+ !
+ fc = fx(centr, fx_vars)
+ resg = wg(8)*fc
+ resk = wgk(16)*fc
+ resabs = dabs(resk)
+ do j=1,7
+ jtw = j*2
+ absc = hlgth*xgk(jtw)
+ fval1 = fx(centr-absc, fx_vars)
+ fval2 = fx(centr+absc, fx_vars)
+ fv1(jtw) = fval1
+ fv2(jtw) = fval2
+ fsum = fval1+fval2
+ resg = resg+wg(j)*fsum
+ resk = resk+wgk(jtw)*fsum
+ resabs = resabs+wgk(jtw)*(dabs(fval1)+dabs(fval2))
+ end do
+ do j = 1,8
+ jtwm1 = j*2-1
+ absc = hlgth*xgk(jtwm1)
+ fval1 = fx(centr-absc, fx_vars)
+ fval2 = fx(centr+absc, fx_vars)
+ fv1(jtwm1) = fval1
+ fv2(jtwm1) = fval2
+ fsum = fval1+fval2
+ resk = resk+wgk(jtwm1)*fsum
+ resabs = resabs+wgk(jtwm1)*(dabs(fval1)+dabs(fval2))
+ end do
+ reskh = resk*0.5_f
+ resasc = wgk(16)*dabs(fc-reskh)
+ do j=1,15
+ resasc = resasc+wgk(j)*(dabs(fv1(j)-reskh)+dabs(fv2(j)-reskh))
+ end do
+ result = resk*hlgth
+ resabs = resabs*dhlgth
+ resasc = resasc*dhlgth
+ abserr = dabs((resk-resg)*hlgth)
+ if(resasc.ne.0.0_f.and.abserr.ne.0.0_f) abserr = resasc*dmin1(0.1e1_f,(0.2e3_f*abserr/resasc)**1.5_f)
+ if(resabs.gt.uflow/(0.5e2_f*epmach)) abserr = dmax1((epmach*0.5e2_f)*resabs,abserr)
+999 return
+ end subroutine dqk31
+
+
+
+ !!***begin prologue dqk41
+ !!***date written 800101 (yymmdd)
+ !!***revision date 130319 (yymmdd)
+ !!***category no. h2a1a2
+ !!***keywords 41-point gauss-kronrod rules
+ !!***author piessens,robert,appl. math. & progr. div. - k.u.leuven
+ !! de doncker,elise,appl. math. & progr. div. - k.u.leuven
+ !!***purpose to compute i = integral of f over (a,b), with error
+ !! estimate
+ !! j = integral of abs(f) over (a,b)
+ !!***description
+ !!
+ !! integration rules
+ !! standard fortran subroutine
+ !! double precision version
+ !!
+ !! parameters
+ !! on entry
+ !! fx - double precision
+ !! function subprogram defining the integrand
+ !! function f(x). the actual name for f needs to be
+ !! declared e x t e r n a l in the calling program.
+ !!
+ !! fx_vars- structure containing variables need for integration
+ !! specific to fractal meanfield scattering code
+ !!
+ !! a - double precision
+ !! lower limit of integration
+ !!
+ !! b - double precision
+ !! upper limit of integration
+ !!
+ !! on return
+ !! result - double precision
+ !! approximation to the integral i
+ !! result is computed by applying the 41-point
+ !! gauss-kronrod rule (resk) obtained by optimal
+ !! addition of abscissae to the 20-point gauss
+ !! rule (resg).
+ !!
+ !! abserr - double precision
+ !! estimate of the modulus of the absolute error,
+ !! which should not exceed abs(i-result)
+ !!
+ !! resabs - double precision
+ !! approximation to the integral j
+ !!
+ !! resasc - double precision
+ !! approximation to the integal of abs(f-i/(b-a))
+ !! over (a,b)
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! ier.gt.0 abnormal termination of the routine. the
+ !! estimates for result and error are less
+ !! reliable. it is assumed that the requested
+ !! accuracy has not been achieved.
+ !!
+ !!
+ !!***references (none)
+ !!***routines called sd1mach
+ !!***end prologue dqk41
+ !!
+ subroutine dqk41(fx,fx_vars,a,b,result,abserr,resabs,resasc, ier)
+
+ ! Arguments
+ interface
+ function fx(centr, vars)
+ use carma_precision_mod, only : f
+ use adgaquad_types_mod
+ real(kind=f), intent(in) :: centr
+ type(adgaquad_vars_type), intent(inout) :: vars
+ real(kind=f) :: fx
+ end function fx
+ end interface
+ type(adgaquad_vars_type) :: fx_vars
+ real(kind=f) :: a
+ real(kind=f) :: b
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ real(kind=f) :: resabs
+ real(kind=f) :: resasc
+ integer :: ier
+
+ ! Local declarations
+ real(kind=f) :: absc, centr, dabs, dhlgth, dmax1, dmin1
+ real(kind=f) :: epmach, fc, fsum, fval1, fval2, fv1(20), fv2(20), hlgth
+ real(kind=f) :: resg, resk, reskh, uflow, wg(10), wgk(21), xgk(21)
+ integer :: j, jtw, jtwm1
+
+ !
+ ! the abscissae and weights are given for the interval (-1,1).
+ ! because of symmetry only the positive abscissae and their
+ ! corresponding weights are given.
+ !
+ ! xgk - abscissae of the 41-point gauss-kronrod rule
+ ! xgk(2), xgk(4), ... abscissae of the 20-point
+ ! gauss rule
+ ! xgk(1), xgk(3), ... abscissae which are optimally
+ ! added to the 20-point gauss rule
+ !
+ ! wgk - weights of the 41-point gauss-kronrod rule
+ !
+ ! wg - weights of the 20-point gauss rule
+ !
+ !
+ ! gauss quadrature weights and kronron quadrature abscissae and weights
+ ! as evaluated with 80 decimal digit arithmetic by l. w. fullerton,
+ ! bell labs, nov. 1981.
+ !
+ data wg ( 1) / 0.017614007139152118311861962351853_f /
+ data wg ( 2) / 0.040601429800386941331039952274932_f /
+ data wg ( 3) / 0.062672048334109063569506535187042_f /
+ data wg ( 4) / 0.083276741576704748724758143222046_f /
+ data wg ( 5) / 0.101930119817240435036750135480350_f /
+ data wg ( 6) / 0.118194531961518417312377377711382_f /
+ data wg ( 7) / 0.131688638449176626898494499748163_f /
+ data wg ( 8) / 0.142096109318382051329298325067165_f /
+ data wg ( 9) / 0.149172986472603746787828737001969_f /
+ data wg ( 10) / 0.152753387130725850698084331955098_f /
+
+ data xgk ( 1) / 0.998859031588277663838315576545863_f /
+ data xgk ( 2) / 0.993128599185094924786122388471320_f /
+ data xgk ( 3) / 0.981507877450250259193342994720217_f /
+ data xgk ( 4) / 0.963971927277913791267666131197277_f /
+ data xgk ( 5) / 0.940822633831754753519982722212443_f /
+ data xgk ( 6) / 0.912234428251325905867752441203298_f /
+ data xgk ( 7) / 0.878276811252281976077442995113078_f /
+ data xgk ( 8) / 0.839116971822218823394529061701521_f /
+ data xgk ( 9) / 0.795041428837551198350638833272788_f /
+ data xgk ( 10) / 0.746331906460150792614305070355642_f /
+ data xgk ( 11) / 0.693237656334751384805490711845932_f /
+ data xgk ( 12) / 0.636053680726515025452836696226286_f /
+ data xgk ( 13) / 0.575140446819710315342946036586425_f /
+ data xgk ( 14) / 0.510867001950827098004364050955251_f/
+ data xgk ( 15) / 0.443593175238725103199992213492640_f /
+ data xgk ( 16) / 0.373706088715419560672548177024927_f /
+ data xgk ( 17) / 0.301627868114913004320555356858592_f /
+ data xgk ( 18) / 0.227785851141645078080496195368575_f /
+ data xgk ( 19) / 0.152605465240922675505220241022678_f /
+ data xgk ( 20) / 0.076526521133497333754640409398838_f /
+ data xgk ( 21) / 0.000000000000000000000000000000000_f /
+
+ data wgk ( 1) / 0.003073583718520531501218293246031_f /
+ data wgk ( 2) / 0.008600269855642942198661787950102_f /
+ data wgk ( 3) / 0.014626169256971252983787960308868_f /
+ data wgk ( 4) / 0.020388373461266523598010231432755_f /
+ data wgk ( 5) / 0.025882133604951158834505067096153_f /
+ data wgk ( 6) / 0.031287306777032798958543119323801_f /
+ data wgk ( 7) / 0.036600169758200798030557240707211_f /
+ data wgk ( 8) / 0.041668873327973686263788305936895_f /
+ data wgk ( 9) / 0.046434821867497674720231880926108_f /
+ data wgk ( 10) / 0.050944573923728691932707670050345_f /
+ data wgk ( 11) / 0.055195105348285994744832372419777_f /
+ data wgk ( 12) / 0.059111400880639572374967220648594_f /
+ data wgk ( 13) / 0.062653237554781168025870122174255_f /
+ data wgk ( 14) / 0.065834597133618422111563556969398_f /
+ data wgk ( 15) / 0.068648672928521619345623411885368_f /
+ data wgk ( 16) / 0.071054423553444068305790361723210_f /
+ data wgk ( 17) / 0.073030690332786667495189417658913_f /
+ data wgk ( 18) / 0.074582875400499188986581418362488_f /
+ data wgk ( 19) / 0.075704497684556674659542775376617_f /
+ data wgk ( 20) / 0.076377867672080736705502835038061_f /
+ data wgk ( 21) / 0.076600711917999656445049901530102_f /
+
+ !
+ ! list of major variables
+ ! -----------------------
+ !
+ ! centr - mid point of the interval
+ ! hlgth - half-length of the interval
+ ! absc - abscissa
+ ! fval* - function value
+ ! resg - result of the 20-point gauss formula
+ ! resk - result of the 41-point kronrod formula
+ ! reskh - approximation to mean value of f over (a,b), i.e.
+ ! to i/(b-a)
+ !
+ ! machine dependent constants
+ ! ---------------------------
+ !
+ ! epmach is the largest relative spacing.
+ ! uflow is the smallest positive magnitude.
+ !
+ !***first executable statement dqk41
+ call sd1mach(4,epmach,ier)
+ if(ier.eq.9) return
+ call sd1mach(1,uflow,ier)
+ if(ier.eq.9) return
+
+ !epmach = d1mach(4)
+ !uflow = d1mach(1)
+
+ centr = 0.5_f*(a+b)
+ hlgth = 0.5_f*(b-a)
+ dhlgth = dabs(hlgth)
+ !
+ ! compute the 41-point gauss-kronrod approximation to
+ ! the integral, and estimate the absolute error.
+ !
+ resg = 0.0_f
+ fc = fx(centr, fx_vars)
+ resk = wgk(21)*fc
+ resabs = dabs(resk)
+ do j=1,10
+ jtw = j*2
+ absc = hlgth*xgk(jtw)
+ fval1 = fx(centr-absc, fx_vars)
+ fval2 = fx(centr+absc, fx_vars)
+ fv1(jtw) = fval1
+ fv2(jtw) = fval2
+ fsum = fval1+fval2
+ resg = resg+wg(j)*fsum
+ resk = resk+wgk(jtw)*fsum
+ resabs = resabs+wgk(jtw)*(dabs(fval1)+dabs(fval2))
+ end do
+ do j = 1,10
+ jtwm1 = j*2-1
+ absc = hlgth*xgk(jtwm1)
+ fval1 = fx(centr-absc, fx_vars)
+ fval2 = fx(centr+absc, fx_vars)
+ fv1(jtwm1) = fval1
+ fv2(jtwm1) = fval2
+ fsum = fval1+fval2
+ resk = resk+wgk(jtwm1)*fsum
+ resabs = resabs+wgk(jtwm1)*(dabs(fval1)+dabs(fval2))
+ end do
+ reskh = resk*0.5_f
+ resasc = wgk(21)*dabs(fc-reskh)
+ do j=1,20
+ resasc = resasc+wgk(j)*(dabs(fv1(j)-reskh)+dabs(fv2(j)-reskh))
+ end do
+ result = resk*hlgth
+ resabs = resabs*dhlgth
+ resasc = resasc*dhlgth
+ abserr = dabs((resk-resg)*hlgth)
+ if(resasc.ne.0.0_f.and.abserr.ne.0._f) abserr = resasc*dmin1(0.1e1_f,(0.2e3_f*abserr/resasc)**1.5_f)
+ if(resabs.gt.uflow/(0.5e2_f*epmach)) abserr = dmax1((epmach*0.5e2_f)*resabs,abserr)
+999 return
+ end subroutine dqk41
+
+
+ !!***begin prologue dqk51
+ !!***date written 800101 (yymmdd)
+ !!***revision date 130319 (yymmdd)
+ !!***category no. h2a1a2
+ !!***keywords 51-point gauss-kronrod rules
+ !!***author piessens,robert,appl. math. & progr. div. - k.u.leuven
+ !! de doncker,elise,appl. math & progr. div. - k.u.leuven
+ !!***purpose to compute i = integral of f over (a,b) with error
+ !! estimate
+ !! j = integral of abs(f) over (a,b)
+ !!***description
+ !!
+ !! integration rules
+ !! standard fortran subroutine
+ !! double precision version
+ !!
+ !! parameters
+ !! on entry
+ !! fx - double precision
+ !! function subroutine defining the integrand
+ !! function f(x). the actual name for f needs to be
+ !! declared e x t e r n a l in the calling program.
+ !!
+ !! fx_vars- structure containing variables need for integration
+ !! specific to fractal meanfield scattering code
+ !!
+ !! a - double precision
+ !! lower limit of integration
+ !!
+ !! b - double precision
+ !! upper limit of integration
+ !!
+ !! on return
+ !! result - double precision
+ !! approximation to the integral i
+ !! result is computed by applying the 51-point
+ !! kronrod rule (resk) obtained by optimal addition
+ !! of abscissae to the 25-point gauss rule (resg).
+ !!
+ !! abserr - double precision
+ !! estimate of the modulus of the absolute error,
+ !! which should not exceed abs(i-result)
+ !!
+ !! resabs - double precision
+ !! approximation to the integral j
+ !!
+ !! resasc - double precision
+ !! approximation to the integral of abs(f-i/(b-a))
+ !! over (a,b)
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! ier.gt.0 abnormal termination of the routine. the
+ !! estimates for result and error are less
+ !! reliable. it is assumed that the requested
+ !! accuracy has not been achieved.
+ !!
+ !!***references (none)
+ !!***routines called sd1mach
+ !!***end prologue dqk51
+ !!
+ subroutine dqk51(fx,fx_vars,a,b,result,abserr,resabs,resasc,ier)
+
+ ! Arguments
+ interface
+ function fx(centr, vars)
+ use carma_precision_mod, only : f
+ use adgaquad_types_mod
+ real(kind=f), intent(in) :: centr
+ type(adgaquad_vars_type), intent(inout) :: vars
+ real(kind=f) :: fx
+ end function fx
+ end interface
+ type(adgaquad_vars_type) :: fx_vars
+ real(kind=f) :: a
+ real(kind=f) :: b
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ real(kind=f) :: resabs
+ real(kind=f) :: resasc
+ integer :: ier
+
+ ! Local declarations
+ real(kind=f) :: absc, centr, dabs, dhlgth, dmax1, dmin1
+ real(kind=f) :: epmach, fc, fsum, fval1, fval2, fv1(25), fv2(25), hlgth
+ real(kind=f) :: resg, resk, reskh, uflow, wg(13),wgk(26), xgk(26)
+ integer j,jtw,jtwm1
+
+ !
+ ! the abscissae and weights are given for the interval (-1,1).
+ ! because of symmetry only the positive abscissae and their
+ ! corresponding weights are given.
+ !
+ ! xgk - abscissae of the 51-point kronrod rule
+ ! xgk(2), xgk(4), ... abscissae of the 25-point
+ ! gauss rule
+ ! xgk(1), xgk(3), ... abscissae which are optimally
+ ! added to the 25-point gauss rule
+ !
+ ! wgk - weights of the 51-point kronrod rule
+ !
+ ! wg - weights of the 25-point gauss rule
+ !
+ !
+ ! gauss quadrature weights and kronron quadrature abscissae and weights
+ ! as evaluated with 80 decimal digit arithmetic by l. w. fullerton,
+ ! bell labs, nov. 1981.
+ !
+ data wg ( 1) / 0.011393798501026287947902964113235_f /
+ data wg ( 2) / 0.026354986615032137261901815295299_f /
+ data wg ( 3) / 0.040939156701306312655623487711646_f /
+ data wg ( 4) / 0.054904695975835191925936891540473_f /
+ data wg ( 5) / 0.068038333812356917207187185656708_f /
+ data wg ( 6) / 0.080140700335001018013234959669111_f /
+ data wg ( 7) / 0.091028261982963649811497220702892_f /
+ data wg ( 8) / 0.100535949067050644202206890392686_f /
+ data wg ( 9) / 0.108519624474263653116093957050117_f /
+ data wg ( 10) / 0.114858259145711648339325545869556_f /
+ data wg ( 11) / 0.119455763535784772228178126512901_f /
+ data wg ( 12) / 0.122242442990310041688959518945852_f /
+ data wg ( 13) / 0.123176053726715451203902873079050_f /
+
+ data xgk ( 1) / 0.999262104992609834193457486540341_f /
+ data xgk ( 2) / 0.995556969790498097908784946893902_f /
+ data xgk ( 3) / 0.988035794534077247637331014577406_f /
+ data xgk ( 4) / 0.976663921459517511498315386479594_f /
+ data xgk ( 5) / 0.961614986425842512418130033660167_f /
+ data xgk ( 6) / 0.942974571228974339414011169658471_f /
+ data xgk ( 7) / 0.920747115281701561746346084546331_f /
+ data xgk ( 8) / 0.894991997878275368851042006782805_f /
+ data xgk ( 9) / 0.865847065293275595448996969588340_f /
+ data xgk ( 10) / 0.833442628760834001421021108693570_f /
+ data xgk ( 11) / 0.797873797998500059410410904994307_f /
+ data xgk ( 12) / 0.759259263037357630577282865204361_f /
+ data xgk ( 13) / 0.717766406813084388186654079773298_f /
+ data xgk ( 14) / 0.673566368473468364485120633247622_f /
+ data xgk ( 15) / 0.626810099010317412788122681624518_f /
+ data xgk ( 16) / 0.577662930241222967723689841612654_f /
+ data xgk ( 17) / 0.526325284334719182599623778158010_f /
+ data xgk ( 18) / 0.473002731445714960522182115009192_f /
+ data xgk ( 19) / 0.417885382193037748851814394594572_f /
+ data xgk ( 20) / 0.361172305809387837735821730127641_f /
+ data xgk ( 21) / 0.303089538931107830167478909980339_f /
+ data xgk ( 22) / 0.243866883720988432045190362797452_f /
+ data xgk ( 23) / 0.183718939421048892015969888759528_f /
+ data xgk ( 24) / 0.122864692610710396387359818808037_f /
+ data xgk ( 25) / 0.061544483005685078886546392366797_f /
+ data xgk ( 26) / 0.000000000000000000000000000000000_f /
+
+ data wgk ( 1) / 0.001987383892330315926507851882843_f /
+ data wgk ( 2) / 0.005561932135356713758040236901066_f /
+ data wgk ( 3) / 0.009473973386174151607207710523655_f /
+ data wgk ( 4) / 0.013236229195571674813656405846976_f /
+ data wgk ( 5) / 0.016847817709128298231516667536336_f /
+ data wgk ( 6) / 0.020435371145882835456568292235939_f /
+ data wgk ( 7) / 0.024009945606953216220092489164881_f /
+ data wgk ( 8) / 0.027475317587851737802948455517811_f /
+ data wgk ( 9) / 0.030792300167387488891109020215229_f /
+ data wgk ( 10) / 0.034002130274329337836748795229551_f /
+ data wgk ( 11) / 0.037116271483415543560330625367620_f /
+ data wgk ( 12) / 0.040083825504032382074839284467076_f /
+ data wgk ( 13) / 0.042872845020170049476895792439495_f /
+ data wgk ( 14) / 0.045502913049921788909870584752660_f /
+ data wgk ( 15) / 0.047982537138836713906392255756915_f /
+ data wgk ( 16) / 0.050277679080715671963325259433440_f /
+ data wgk ( 17) / 0.052362885806407475864366712137873_f /
+ data wgk ( 18) / 0.054251129888545490144543370459876_f /
+ data wgk ( 19) / 0.055950811220412317308240686382747_f /
+ data wgk ( 20) / 0.057437116361567832853582693939506_f /
+ data wgk ( 21) / 0.058689680022394207961974175856788_f /
+ data wgk ( 22) / 0.059720340324174059979099291932562_f /
+ data wgk ( 23) / 0.060539455376045862945360267517565_f /
+ data wgk ( 24) / 0.061128509717053048305859030416293_f /
+ data wgk ( 25) / 0.061471189871425316661544131965264_f /
+ ! note: wgk (26) was calculated from the values of wgk(1..25)
+ data wgk ( 26) / 0.061580818067832935078759824240066_f /
+
+ !
+ ! list of major variables
+ ! -----------------------
+ !
+ ! centr - mid point of the interval
+ ! hlgth - half-length of the interval
+ ! absc - abscissa
+ ! fval* - function value
+ ! resg - result of the 25-point gauss formula
+ ! resk - result of the 51-point kronrod formula
+ ! reskh - approximation to the mean value of f over (a,b),
+ ! i.e. to i/(b-a)
+ !
+ ! machine dependent constants
+ ! ---------------------------
+ !
+ ! epmach is the largest relative spacing.
+ ! uflow is the smallest positive magnitude.
+ !
+ !***first executable statement dqk51
+ call sd1mach(4,epmach,ier)
+ if(ier.eq.9) return
+ call sd1mach(1,uflow,ier)
+ if(ier.eq.9) return
+
+ !epmach = d1mach(4)
+ !uflow = d1mach(1)
+
+ centr = 0.5_f*(a+b)
+ hlgth = 0.5_f*(b-a)
+ dhlgth = dabs(hlgth)
+ !
+ ! compute the 51-point kronrod approximation to
+ ! the integral, and estimate the absolute error.
+ !
+ fc = fx(centr, fx_vars)
+ resg = wg(13)*fc
+ resk = wgk(26)*fc
+ resabs = dabs(resk)
+ do j=1,12
+ jtw = j*2
+ absc = hlgth*xgk(jtw)
+ fval1 = fx(centr-absc, fx_vars)
+ fval2 = fx(centr+absc, fx_vars)
+ fv1(jtw) = fval1
+ fv2(jtw) = fval2
+ fsum = fval1+fval2
+ resg = resg+wg(j)*fsum
+ resk = resk+wgk(jtw)*fsum
+ resabs = resabs+wgk(jtw)*(dabs(fval1)+dabs(fval2))
+ end do
+ do j = 1,13
+ jtwm1 = j*2-1
+ absc = hlgth*xgk(jtwm1)
+ fval1 = fx(centr-absc, fx_vars)
+ fval2 = fx(centr+absc, fx_vars)
+ fv1(jtwm1) = fval1
+ fv2(jtwm1) = fval2
+ fsum = fval1+fval2
+ resk = resk+wgk(jtwm1)*fsum
+ resabs = resabs+wgk(jtwm1)*(dabs(fval1)+dabs(fval2))
+ end do
+ reskh = resk*0.5_f
+ resasc = wgk(26)*dabs(fc-reskh)
+ do j=1,25
+ resasc = resasc+wgk(j)*(dabs(fv1(j)-reskh)+dabs(fv2(j)-reskh))
+ end do
+ result = resk*hlgth
+ resabs = resabs*dhlgth
+ resasc = resasc*dhlgth
+ abserr = dabs((resk-resg)*hlgth)
+ if(resasc.ne.0.0_f.and.abserr.ne.0.0_f) abserr = resasc*dmin1(0.1e1_f,(0.2e3_f*abserr/resasc)**1.5_f)
+ if(resabs.gt.uflow/(0.5e2_f*epmach)) abserr = dmax1((epmach*0.5e2_f)*resabs,abserr)
+999 return
+ end subroutine dqk51
+
+ !!***begin prologue dqk61
+ !!***date written 800101 (yymmdd)
+ !!***revision date 130319 (yymmdd)
+ !!***category no. h2a1a2
+ !!***keywords 61-point gauss-kronrod rules
+ !!***author piessens,robert,appl. math. & progr. div. - k.u.leuven
+ !! de doncker,elise,appl. math. & progr. div. - k.u.leuven
+ !!***purpose to compute i = integral of f over (a,b) with error
+ !! estimate
+ !! j = integral of dabs(f) over (a,b)
+ !!***description
+ !!
+ !! integration rule
+ !! standard fortran subroutine
+ !! double precision version
+ !!
+ !!
+ !! parameters
+ !! on entry
+ !! fx - double precision
+ !! function subprogram defining the integrand
+ !! function f(x). the actual name for f needs to be
+ !! declared e x t e r n a l in the calling program.
+ !!
+ !! fx_vars- structure containing variables need for integration
+ !! specific to fractal meanfield scattering code
+ !!
+ !! a - double precision
+ !! lower limit of integration
+ !!
+ !! b - double precision
+ !! upper limit of integration
+ !!
+ !! on return
+ !! result - double precision
+ !! approximation to the integral i
+ !! result is computed by applying the 61-point
+ !! kronrod rule (resk) obtained by optimal addition of
+ !! abscissae to the 30-point gauss rule (resg).
+ !!
+ !! abserr - double precision
+ !! estimate of the modulus of the absolute error,
+ !! which should equal or exceed dabs(i-result)
+ !!
+ !! resabs - double precision
+ !! approximation to the integral j
+ !!
+ !! resasc - double precision
+ !! approximation to the integral of dabs(f-i/(b-a))
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! ier.gt.0 abnormal termination of the routine. the
+ !! estimates for result and error are less
+ !! reliable. it is assumed that the requested
+ !! accuracy has not been achieved.
+ !!
+ !!
+ !!***references (none)
+ !!***routines called sd1mach
+ !!***end prologue dqk61
+ !!
+ subroutine dqk61(fx,fx_vars,a,b,result,abserr,resabs,resasc, ier)
+
+ ! Arguments
+ interface
+ function fx(centr, vars)
+ use carma_precision_mod, only : f
+ use adgaquad_types_mod
+ real(kind=f), intent(in) :: centr
+ type(adgaquad_vars_type), intent(inout) :: vars
+ real(kind=f) :: fx
+ end function fx
+ end interface
+ type(adgaquad_vars_type) :: fx_vars
+ real(kind=f) :: a
+ real(kind=f) :: b
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ real(kind=f) :: resabs
+ real(kind=f) :: resasc
+ integer :: ier
+
+ ! Local declartions
+ real(kind=f) :: dabsc, centr, dabs, dhlgth, dmax1, dmin1
+ real(kind=f) :: epmach, fc, fsum, fval1, fval2, fv1(30), fv2(30), hlgth
+ real(kind=f) :: resg, resk, reskh, uflow, wg(15) ,wgk(31), xgk(31)
+ integer :: j, jtw, jtwm1
+
+ !
+ ! the abscissae and weights are given for the
+ ! interval (-1,1). because of symmetry only the positive
+ ! abscissae and their corresponding weights are given.
+ !
+ ! xgk - abscissae of the 61-point kronrod rule
+ ! xgk(2), xgk(4) ... abscissae of the 30-point
+ ! gauss rule
+ ! xgk(1), xgk(3) ... optimally added abscissae
+ ! to the 30-point gauss rule
+ !
+ ! wgk - weights of the 61-point kronrod rule
+ !
+ ! wg - weigths of the 30-point gauss rule
+ !
+ !
+ ! gauss quadrature weights and kronron quadrature abscissae and weights
+ ! as evaluated with 80 decimal digit arithmetic by l. w. fullerton,
+ ! bell labs, nov. 1981.
+ !
+ data wg ( 1) / 0.007968192496166605615465883474674_f /
+ data wg ( 2) / 0.018466468311090959142302131912047_f /
+ data wg ( 3) / 0.028784707883323369349719179611292_f /
+ data wg ( 4) / 0.038799192569627049596801936446348_f /
+ data wg ( 5) / 0.048402672830594052902938140422808_f /
+ data wg ( 6) / 0.057493156217619066481721689402056_f /
+ data wg ( 7) / 0.065974229882180495128128515115962_f /
+ data wg ( 8) / 0.073755974737705206268243850022191_f /
+ data wg ( 9) / 0.080755895229420215354694938460530_f /
+ data wg ( 10) / 0.086899787201082979802387530715126_f /
+ data wg ( 11) / 0.092122522237786128717632707087619_f /
+ data wg ( 12) / 0.096368737174644259639468626351810_f /
+ data wg ( 13) / 0.099593420586795267062780282103569_f /
+ data wg ( 14) / 0.101762389748405504596428952168554_f /
+ data wg ( 15) / 0.102852652893558840341285636705415_f /
+
+ data xgk ( 1) / 0.999484410050490637571325895705811_f /
+ data xgk ( 2) / 0.996893484074649540271630050918695_f /
+ data xgk ( 3) / 0.991630996870404594858628366109486_f /
+ data xgk ( 4) / 0.983668123279747209970032581605663_f /
+ data xgk ( 5) / 0.973116322501126268374693868423707_f /
+ data xgk ( 6) / 0.960021864968307512216871025581798_f /
+ data xgk ( 7) / 0.944374444748559979415831324037439_f /
+ data xgk ( 8) / 0.926200047429274325879324277080474_f /
+ data xgk ( 9) / 0.905573307699907798546522558925958_f /
+ data xgk ( 10) / 0.882560535792052681543116462530226_f /
+ data xgk ( 11) / 0.857205233546061098958658510658944_f /
+ data xgk ( 12) / 0.829565762382768397442898119732502_f /
+ data xgk ( 13) / 0.799727835821839083013668942322683_f /
+ data xgk ( 14) / 0.767777432104826194917977340974503_f /
+ data xgk ( 15) / 0.733790062453226804726171131369528_f /
+ data xgk ( 16) / 0.697850494793315796932292388026640_f /
+ data xgk ( 17) / 0.660061064126626961370053668149271_f /
+ data xgk ( 18) / 0.620526182989242861140477556431189_f /
+ data xgk ( 19) / 0.579345235826361691756024932172540_f /
+ data xgk ( 20) / 0.536624148142019899264169793311073_f /
+ data xgk ( 21) / 0.492480467861778574993693061207709_f /
+ data xgk ( 22) / 0.447033769538089176780609900322854_f /
+ data xgk ( 23) / 0.400401254830394392535476211542661_f /
+ data xgk ( 24) / 0.352704725530878113471037207089374_f /
+ data xgk ( 25) / 0.304073202273625077372677107199257_f /
+ data xgk ( 26) / 0.254636926167889846439805129817805_f /
+ data xgk ( 27) / 0.204525116682309891438957671002025_f /
+ data xgk ( 28) / 0.153869913608583546963794672743256_f /
+ data xgk ( 29) / 0.102806937966737030147096751318001_f /
+ data xgk ( 30) / 0.051471842555317695833025213166723_f /
+ data xgk ( 31) / 0.000000000000000000000000000000000_f /
+
+ data wgk ( 1) / 0.001389013698677007624551591226760_f /
+ data wgk ( 2) / 0.003890461127099884051267201844516_f /
+ data wgk ( 3) / 0.006630703915931292173319826369750_f /
+ data wgk ( 4) / 0.009273279659517763428441146892024_f /
+ data wgk ( 5) / 0.011823015253496341742232898853251_f /
+ data wgk ( 6) / 0.014369729507045804812451432443580_f /
+ data wgk ( 7) / 0.016920889189053272627572289420322_f /
+ data wgk ( 8) / 0.019414141193942381173408951050128_f /
+ data wgk ( 9) / 0.021828035821609192297167485738339_f /
+ data wgk ( 10) / 0.024191162078080601365686370725232_f /
+ data wgk ( 11) / 0.026509954882333101610601709335075_f /
+ data wgk ( 12) / 0.028754048765041292843978785354334_f /
+ data wgk ( 13) / 0.030907257562387762472884252943092_f /
+ data wgk ( 14) / 0.032981447057483726031814191016854_f /
+ data wgk ( 15) / 0.034979338028060024137499670731468_f /
+ data wgk ( 16) / 0.036882364651821229223911065617136_f /
+ data wgk ( 17) / 0.038678945624727592950348651532281_f /
+ data wgk ( 18) / 0.040374538951535959111995279752468_f /
+ data wgk ( 19) / 0.041969810215164246147147541285970_f /
+ data wgk ( 20) / 0.043452539701356069316831728117073_f /
+ data wgk ( 21) / 0.044814800133162663192355551616723_f /
+ data wgk ( 22) / 0.046059238271006988116271735559374_f /
+ data wgk ( 23) / 0.047185546569299153945261478181099_f /
+ data wgk ( 24) / 0.048185861757087129140779492298305_f /
+ data wgk ( 25) / 0.049055434555029778887528165367238_f /
+ data wgk ( 26) / 0.049795683427074206357811569379942_f /
+ data wgk ( 27) / 0.050405921402782346840893085653585_f /
+ data wgk ( 28) / 0.050881795898749606492297473049805_f /
+ data wgk ( 29) / 0.051221547849258772170656282604944_f /
+ data wgk ( 30) / 0.051426128537459025933862879215781_f /
+ data wgk ( 31) / 0.051494729429451567558340433647099_f /
+
+ ! list of major variables
+ ! -----------------------
+ !
+ ! centr - mid point of the interval
+ ! hlgth - half-length of the interval
+ ! dabsc - abscissa
+ ! fval* - function value
+ ! resg - result of the 30-point gauss rule
+ ! resk - result of the 61-point kronrod rule
+ ! reskh - approximation to the mean value of f
+ ! over (a,b), i.e. to i/(b-a)
+ !
+ ! machine dependent constants
+ ! ---------------------------
+ !
+ ! epmach is the largest relative spacing.
+ ! a uflow is the smallest positive magnitude.
+ !
+ call sd1mach(4,epmach,ier)
+ if(ier.eq.9) return
+ call sd1mach(1,uflow,ier)
+ if(ier.eq.9) return
+
+ !epmach = d1mach(4)
+ !uflow = d1mach(1)
+
+ centr = 0.5_f*(b+a)
+ hlgth = 0.5_f*(b-a)
+ dhlgth = dabs(hlgth)
+ !
+ ! compute the 61-point kronrod approximation to the
+ ! integral, and estimate the absolute error.
+ !
+ !***first executable statement dqk61
+ resg = 0.0_f
+ fc = fx(centr, fx_vars)
+ resk = wgk(31)*fc
+ resabs = dabs(resk)
+ do j=1,15
+ jtw = j*2
+ dabsc = hlgth*xgk(jtw)
+ fval1 = fx(centr-dabsc, fx_vars)
+ fval2 = fx(centr+dabsc, fx_vars)
+ fv1(jtw) = fval1
+ fv2(jtw) = fval2
+ fsum = fval1+fval2
+ resg = resg+wg(j)*fsum
+ resk = resk+wgk(jtw)*fsum
+ resabs = resabs+wgk(jtw)*(dabs(fval1)+dabs(fval2))
+ end do
+ do j=1,15
+ jtwm1 = j*2-1
+ dabsc = hlgth*xgk(jtwm1)
+ fval1 = fx(centr-dabsc, fx_vars)
+ fval2 = fx(centr+dabsc, fx_vars)
+ fv1(jtwm1) = fval1
+ fv2(jtwm1) = fval2
+ fsum = fval1+fval2
+ resk = resk+wgk(jtwm1)*fsum
+ resabs = resabs+wgk(jtwm1)*(dabs(fval1)+dabs(fval2))
+ end do
+ reskh = resk*0.5_f
+ resasc = wgk(31)*dabs(fc-reskh)
+ do j=1,30
+ resasc = resasc+wgk(j)*(dabs(fv1(j)-reskh)+dabs(fv2(j)-reskh))
+ end do
+ result = resk*hlgth
+ resabs = resabs*dhlgth
+ resasc = resasc*dhlgth
+ abserr = dabs((resk-resg)*hlgth)
+ if(resasc.ne.0.0_f.and.abserr.ne.0.0_f) abserr = resasc*dmin1(0.1e1_f,(0.2e3_f*abserr/resasc)**1.5_f)
+ if(resabs.gt.uflow/(0.5e2_f*epmach)) abserr = dmax1((epmach*0.5e2_f)*resabs,abserr)
+999 return
+ end subroutine dqk61
+
+ !!
+ !!***begin prologue dqpsrt
+ !!***refer to dqage,dqagie,dqagpe,dqawse
+ !!***routines called (none)
+ !!***revision date 130319 (yymmdd)
+ !!***keywords sequential sorting
+ !!***author piessens,robert,appl. math. & progr. div. - k.u.leuven
+ !! de doncker,elise,appl. math. & progr. div. - k.u.leuven
+ !!***purpose this routine maintains the descending ordering in the
+ !! list of the local error estimated resulting from the
+ !! interval subdivision process. at each call two error
+ !! estimates are inserted using the sequential search
+ !! method, top-down for the largest error estimate and
+ !! bottom-up for the smallest error estimate.
+ !!***description
+ !!
+ !! ordering routine
+ !! standard fortran subroutine
+ !! double precision version
+ !!
+ !! parameters (meaning at output)
+ !! limit - integer
+ !! maximum number of error estimates the list
+ !! can contain
+ !!
+ !! last - integer
+ !! number of error estimates currently in the list
+ !!
+ !! maxerr - integer
+ !! maxerr points to the nrmax-th largest error
+ !! estimate currently in the list
+ !!
+ !! ermax - double precision
+ !! nrmax-th largest error estimate
+ !! ermax = elist(maxerr)
+ !!
+ !! elist - double precision
+ !! vector of dimension last containing
+ !! the error estimates
+ !!
+ !! iord - integer
+ !! vector of dimension last, the first k elements
+ !! of which contain pointers to the error
+ !! estimates, such that
+ !! elist(iord(1)),..., elist(iord(k))
+ !! form a decreasing sequence, with
+ !! k = last if last.le.(limit/2+2), and
+ !! k = limit+1-last otherwise
+ !!
+ !! nrmax - integer
+ !! maxerr = iord(nrmax)
+ !!
+ !!***end prologue dqpsrt
+ !!
+ subroutine dqpsrt(limit,last,maxerr,ermax,elist,iord,nrmax)
+
+ ! Arguments
+ integer :: limit
+ integer :: last
+ integer :: maxerr
+ real(kind=f) :: ermax
+ real(kind=f) :: elist(last)
+ integer :: iord(last)
+ integer :: nrmax
+
+ ! Local declarations
+ real(kind=f) :: errmax, errmin
+ integer :: i, ibeg, ido, isucc, j, jbnd, jupbn, k
+
+ !
+ ! check whether the list contains more than
+ ! two error estimates.
+ !
+ !***first executable statement dqpsrt
+ if(last.gt.2) go to 10
+ iord(1) = 1
+ iord(2) = 2
+ go to 90
+ !
+ ! this part of the routine is only executed if, due to a
+ ! difficult integrand, subdivision increased the error
+ ! estimate. in the normal case the insert procedure should
+ ! start after the nrmax-th largest error estimate.
+ !
+ 10 errmax = elist(maxerr)
+ if(nrmax.eq.1) go to 30
+ ido = nrmax-1
+ do i = 1,ido
+ isucc = iord(nrmax-1)
+ ! ***jump out of do-loop
+ if(errmax.le.elist(isucc)) go to 30
+ iord(nrmax) = isucc
+ nrmax = nrmax-1
+ end do
+ !
+ ! compute the number of elements in the list to be maintained
+ ! in descending order. this number depends on the number of
+ ! subdivisions still allowed.
+ !
+ 30 jupbn = last
+ if(last.gt.(limit/2+2)) jupbn = limit+3-last
+ errmin = elist(last)
+ !
+ ! insert errmax by traversing the list top-down,
+ ! starting comparison from the element elist(iord(nrmax+1)).
+ !
+ jbnd = jupbn-1
+ ibeg = nrmax+1
+ if(ibeg.gt.jbnd) go to 50
+ do i=ibeg,jbnd
+ isucc = iord(i)
+ ! ***jump out of do-loop
+ if(errmax.ge.elist(isucc)) go to 60
+ iord(i-1) = isucc
+ end do
+ 50 iord(jbnd) = maxerr
+ iord(jupbn) = last
+ go to 90
+ !
+ ! insert errmin by traversing the list bottom-up.
+ !
+ 60 iord(i-1) = maxerr
+ k = jbnd
+ do j=i,jbnd
+ isucc = iord(k)
+ ! ***jump out of do-loop
+ if(errmin.lt.elist(isucc)) go to 80
+ iord(k+1) = isucc
+ k = k-1
+ end do
+ iord(i) = last
+ go to 90
+ 80 iord(k+1) = last
+ !
+ ! set maxerr and ermax.
+ !
+ 90 maxerr = iord(nrmax)
+ ermax = elist(maxerr)
+ return
+ end subroutine dqpsrt
+
+ !!
+ !!***begin prologue dqk15i
+ !!***date written 800101 (yymmdd)
+ !!***revision date 130319 (yymmdd)
+ !!***category no. h2a3a2,h2a4a2
+ !!***keywords 15-point transformed gauss-kronrod rules
+ !!***author piessens,robert,appl. math. & progr. div. - k.u.leuven
+ !! de doncker,elise,appl. math. & progr. div. - k.u.leuven
+ !!***purpose the original (infinite integration range is mapped
+ !! onto the interval (0,1) and (a,b) is a part of (0,1).
+ !! it is the purpose to compute
+ !! i = integral of transformed integrand over (a,b),
+ !! j = integral of abs(transformed integrand) over (a,b).
+ !!***description
+ !!
+ !! integration rule
+ !! standard fortran subroutine
+ !! double precision version
+ !!
+ !! parameters
+ !! on entry
+ !! fx - double precision
+ !! fuction subprogram defining the integrand
+ !! function f(x). the actual name for f needs to be
+ !! declared e x t e r n a l in the calling program.
+ !!
+ !! fx_vars- structure containing variables need for integration
+ !! specific to fractal meanfield scattering code!
+ !!
+ !! boun - double precision
+ !! finite bound of original integration
+ !! range (set to zero if inf = +2)
+ !!
+ !! inf - integer
+ !! if inf = -1, the original interval is
+ !! (-infinity,bound),
+ !! if inf = +1, the original interval is
+ !! (bound,+infinity),
+ !! if inf = +2, the original interval is
+ !! (-infinity,+infinity) and
+ !! the integral is computed as the sum of two
+ !! integrals, one over (-infinity,0) and one over
+ !! (0,+infinity).
+ !!
+ !! a - double precision
+ !! lower limit for integration over subrange
+ !! of (0,1)
+ !!
+ !! b - double precision
+ !! upper limit for integration over subrange
+ !! of (0,1)
+ !!
+ !! on return
+ !! result - double precision
+ !! approximation to the integral i
+ !! result is computed by applying the 15-point
+ !! kronrod rule(resk) obtained by optimal addition
+ !! of abscissae to the 7-point gauss rule(resg).
+ !!
+ !! abserr - double precision
+ !! estimate of the modulus of the absolute error,
+ !! which should equal or exceed abs(i-result)
+ !!
+ !! resabs - double precision
+ !! approximation to the integral j
+ !!
+ !! resasc - double precision
+ !! approximation to the integral of
+ !! abs((transformed integrand)-i/(b-a)) over (a,b)
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! ier.gt.0 abnormal termination of the routine. the
+ !! estimates for result and error are less
+ !! reliable. it is assumed that the requested
+ !! accuracy has not been achieved.
+ !!
+ !!***references (none)
+ !!***routines called sd1mach
+ !!***end prologue dqk15i
+ subroutine dqk15i(fx,fx_vars,boun,inf,a,b,result,abserr,resabs,resasc, ier)
+
+ ! Arguments
+ interface
+ function fx(centr, vars)
+ use carma_precision_mod, only : f
+ use adgaquad_types_mod
+ real(kind=f), intent(in) :: centr
+ type(adgaquad_vars_type), intent(inout) :: vars
+ real(kind=f) :: fx
+ end function fx
+ end interface
+ type(adgaquad_vars_type) :: fx_vars
+ real(kind=f) :: boun
+ integer :: inf
+ real(kind=f) :: a
+ real(kind=f) :: b
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ real(kind=f) :: resabs
+ real(kind=f) :: resasc
+ integer :: ier
+
+ ! Local declarations
+ real(kind=f) :: absc, absc1, absc2, centr, dabs, dinf
+ real(kind=f) :: dmax1, dmin1, epmach, fc, fsum, fval1, fval2, fv1(7) ,fv2(7), hlgth
+ real(kind=f) :: resg, resk, reskh, tabsc1, tabsc2, uflow, wg(8), wgk(8), xgk(8)
+ integer :: j
+
+ !
+ ! the abscissae and weights are supplied for the interval
+ ! (-1,1). because of symmetry only the positive abscissae and
+ ! their corresponding weights are given.
+ !
+ ! xgk - abscissae of the 15-point kronrod rule
+ ! xgk(2), xgk(4), ... abscissae of the 7-point
+ ! gauss rule
+ ! xgk(1), xgk(3), ... abscissae which are optimally
+ ! added to the 7-point gauss rule
+ !
+ ! wgk - weights of the 15-point kronrod rule
+ !
+ ! wg - weights of the 7-point gauss rule, corresponding
+ ! to the abscissae xgk(2), xgk(4), ...
+ ! wg(1), wg(3), ... are set to zero.
+ !
+ data wg(1) / 0.0_f /
+ data wg(2) / 0.129484966168869693270611432679082_f /
+ data wg(3) / 0.0_f /
+ data wg(4) / 0.279705391489276667901467771423780_f /
+ data wg(5) / 0.0_f /
+ data wg(6) / 0.381830050505118944950369775488975_f /
+ data wg(7) / 0.0_f /
+ data wg(8) / 0.417959183673469387755102040816327_f /
+
+ data xgk(1) / 0.991455371120812639206854697526329_f /
+ data xgk(2) / 0.949107912342758524526189684047851_f /
+ data xgk(3) / 0.864864423359769072789712788640926_f /
+ data xgk(4) / 0.741531185599394439863864773280788_f /
+ data xgk(5) / 0.586087235467691130294144838258730_f /
+ data xgk(6) / 0.405845151377397166906606412076961_f /
+ data xgk(7) / 0.207784955007898467600689403773245_f /
+ data xgk(8) / 0.000000000000000000000000000000000_f /
+
+ data wgk(1) / 0.022935322010529224963732008058970_f /
+ data wgk(2) / 0.063092092629978553290700663189204_f /
+ data wgk(3) / 0.104790010322250183839876322541518_f /
+ data wgk(4) / 0.140653259715525918745189590510238_f /
+ data wgk(5) / 0.169004726639267902826583426598550_f /
+ data wgk(6) / 0.190350578064785409913256402421014_f /
+ data wgk(7) / 0.204432940075298892414161999234649_f /
+ data wgk(8) / 0.209482141084727828012999174891714_f /
+ !
+ !
+ ! list of major variables
+ ! -----------------------
+ !
+ ! centr - mid point of the interval
+ ! hlgth - half-length of the interval
+ ! absc* - abscissa
+ ! tabsc* - transformed abscissa
+ ! fval* - function value
+ ! resg - result of the 7-point gauss formula
+ ! resk - result of the 15-point kronrod formula
+ ! reskh - approximation to the mean value of the transformed
+ ! integrand over (a,b), i.e. to i/(b-a)
+ !
+ ! machine dependent constants
+ ! ---------------------------
+ !
+ ! epmach is the largest relative spacing.
+ ! uflow is the smallest positive magnitude.
+ !
+ !*** first executable statement dqk15i
+ call sd1mach(4,epmach,ier)
+ if(ier.eq.9) return
+ call sd1mach(1,uflow,ier)
+ if(ier.eq.9) return
+
+ !epmach = d1mach(4)
+ !uflow = d1mach(1)
+ dinf = min0(1,inf)
+
+ centr = 0.5_f*(a+b)
+ hlgth = 0.5_f*(b-a)
+ tabsc1 = boun+dinf*(0.1e1_f-centr)/centr
+ fval1 = fx(tabsc1, fx_vars)
+ if(inf.eq.2) fval1 = fval1+fx(-tabsc1, fx_vars)
+ fc = (fval1/centr)/centr
+ !
+ ! compute the 15-point kronrod approximation to
+ ! the integral, and estimate the error.
+ !
+ resg = wg(8)*fc
+ resk = wgk(8)*fc
+ resabs = dabs(resk)
+ do j=1,7
+ absc = hlgth*xgk(j)
+ absc1 = centr-absc
+ absc2 = centr+absc
+ tabsc1 = boun+dinf*(0.1d+01-absc1)/absc1
+ tabsc2 = boun+dinf*(0.1d+01-absc2)/absc2
+ fval1 = fx(tabsc1, fx_vars)
+ fval2 = fx(tabsc2, fx_vars)
+ if(inf.eq.2) fval1 = fval1+fx(-tabsc1, fx_vars)
+ if(inf.eq.2) fval2 = fval2+fx(-tabsc2, fx_vars)
+ fval1 = (fval1/absc1)/absc1
+ fval2 = (fval2/absc2)/absc2
+ fv1(j) = fval1
+ fv2(j) = fval2
+ fsum = fval1+fval2
+ resg = resg+wg(j)*fsum
+ resk = resk+wgk(j)*fsum
+ resabs = resabs+wgk(j)*(dabs(fval1)+dabs(fval2))
+ end do
+ reskh = resk*0.5_f
+ resasc = wgk(8)*dabs(fc-reskh)
+ do j=1,7
+ resasc = resasc+wgk(j)*(dabs(fv1(j)-reskh)+dabs(fv2(j)-reskh))
+ end do
+ result = resk*hlgth
+ resasc = resasc*hlgth
+ resabs = resabs*hlgth
+ abserr = dabs((resk-resg)*hlgth)
+ if(resasc.ne.0.0_f.and.abserr.ne.0._f) abserr = resasc*dmin1(0.1e1_f,(0.2e3_f*abserr/resasc)**1.5_f)
+ if(resabs.gt.uflow/(0.5e2_f*epmach)) abserr = dmax1((epmach*0.5e2_f)*resabs,abserr)
+999 return
+ end subroutine dqk15i
+
+ !!
+ !!***begin prologue dqelg
+ !!***refer to dqagie,dqagoe,dqagpe,dqagse
+ !!***routines called sd1mach
+ !!***revision date 130319 (yymmdd)
+ !!***keywords epsilon algorithm, convergence acceleration,
+ !! extrapolation
+ !!***author piessens,robert,appl. math. & progr. div. - k.u.leuven
+ !! de doncker,elise,appl. math & progr. div. - k.u.leuven
+ !!***purpose the routine determines the limit of a given sequence of
+ !! approximations, by means of the epsilon algorithm of
+ !! p.wynn. an estimate of the absolute error is also given.
+ !! the condensed epsilon table is computed. only those
+ !! elements needed for the computation of the next diagonal
+ !! are preserved.
+ !!***description
+ !!
+ !! epsilon algorithm
+ !! standard fortran subroutine
+ !! double precision version
+ !!
+ !! parameters
+ !! n - integer
+ !! epstab(n) contains the new element in the
+ !! first column of the epsilon table.
+ !!
+ !! epstab - double precision
+ !! vector of dimension 52 containing the elements
+ !! of the two lower diagonals of the triangular
+ !! epsilon table. the elements are numbered
+ !! starting at the right-hand corner of the
+ !! triangle.
+ !!
+ !! result - double precision
+ !! resulting approximation to the integral
+ !!
+ !! abserr - double precision
+ !! estimate of the absolute error computed from
+ !! result and the 3 previous results
+ !!
+ !! res3la - double precision
+ !! vector of dimension 3 containing the last 3
+ !! results
+ !!
+ !! nres - integer
+ !! number of calls to the routine
+ !! (should be zero at first call)
+ !!
+ !! ier - integer
+ !! ier = 0 normal and reliable termination of the
+ !! routine. it is assumed that the requested
+ !! accuracy has been achieved.
+ !! ier.gt.0 abnormal termination of the routine. the
+ !! estimates for result and error are less
+ !! reliable. it is assumed that the requested
+ !! accuracy has not been achieved.
+ !!
+ !!***end prologue dqelg
+ !!
+ subroutine dqelg(n,epstab,result,abserr,res3la,nres,ier)
+
+ ! Arguments
+ integer :: n
+ real(kind=f) :: epstab(52)
+ real(kind=f) :: result
+ real(kind=f) :: abserr
+ real(kind=f) :: res3la(3)
+ integer :: nres
+ integer :: ier
+
+ ! Local declarations
+ real(kind=f) :: dabs, delta1, delta2, delta3, dmax1
+ real(kind=f) :: epmach, epsinf, error, err1, err2, err3, e0, e1, e1abs, e2, e3
+ real(kind=f) :: oflow, res, ss, tol1, tol2, tol3
+ integer :: i, ib, ib2, ie, indx, k1, k2, k3, limexp, newelm, num
+ !
+ ! list of major variables
+ ! -----------------------
+ !
+ ! e0 - the 4 elements on which the computation of a new
+ ! e1 element in the epsilon table is based
+ ! e2
+ ! e3 e0
+ ! e3 e1 new
+ ! e2
+ ! newelm - number of elements to be computed in the new
+ ! diagonal
+ ! error - error = abs(e1-e0)+abs(e2-e1)+abs(new-e2)
+ ! result - the element in the new diagonal with least value
+ ! of error
+ !
+ ! machine dependent constants
+ ! ---------------------------
+ !
+ ! epmach is the largest relative spacing.
+ ! oflow is the largest positive magnitude.
+ ! limexp is the maximum number of elements the epsilon
+ ! table can contain. if this number is reached, the upper
+ ! diagonal of the epsilon table is deleted.
+ !
+ !***first executable statement dqelg
+ call sd1mach(4,epmach,ier)
+ if(ier.eq.9) return
+ call sd1mach(2,oflow,ier)
+ if(ier.eq.9) return
+
+ !epmach = d1mach(4)
+ !oflow = d1mach(2)
+ nres = nres+1
+ abserr = oflow
+ result = epstab(n)
+ if(n.lt.3) go to 100
+ limexp = 50
+ epstab(n+2) = epstab(n)
+ newelm = (n-1)/2
+ epstab(n) = oflow
+ num = n
+ k1 = n
+ do 40 i = 1,newelm
+ k2 = k1-1
+ k3 = k1-2
+ res = epstab(k1+2)
+ e0 = epstab(k3)
+ e1 = epstab(k2)
+ e2 = res
+ e1abs = dabs(e1)
+ delta2 = e2-e1
+ err2 = dabs(delta2)
+ tol2 = dmax1(dabs(e2),e1abs)*epmach
+ delta3 = e1-e0
+ err3 = dabs(delta3)
+ tol3 = dmax1(e1abs,dabs(e0))*epmach
+ if(err2.gt.tol2.or.err3.gt.tol3) go to 10
+ !
+ ! if e0, e1 and e2 are equal to within machine
+ ! accuracy, convergence is assumed.
+ ! result = e2
+ ! abserr = abs(e1-e0)+abs(e2-e1)
+ !
+ result = res
+ abserr = err2+err3
+ ! ***jump out of do-loop
+ go to 100
+ 10 e3 = epstab(k1)
+ epstab(k1) = e1
+ delta1 = e1-e3
+ err1 = dabs(delta1)
+ tol1 = dmax1(e1abs,dabs(e3))*epmach
+ !
+ ! if two elements are very close to each other, omit
+ ! a part of the table by adjusting the value of n
+ !
+ if(err1.le.tol1.or.err2.le.tol2.or.err3.le.tol3) go to 20
+ ss = 0.1e1_f/delta1+0.1e1_f/delta2-0.1e1_f/delta3
+ epsinf = dabs(ss*e1)
+ !
+ ! test to detect irregular behaviour in the table, and
+ ! eventually omit a part of the table adjusting the value
+ ! of n.
+ !
+ if(epsinf.gt.0.1e-3_f) go to 30
+ 20 n = i+i-1
+ ! ***jump out of do-loop
+ go to 50
+ !
+ ! compute a new element and eventually adjust
+ ! the value of result.
+ !
+ 30 res = e1+0.1e1_f/ss
+ epstab(k1) = res
+ k1 = k1-2
+ error = err2+dabs(res-e2)+err3
+ if(error.gt.abserr) go to 40
+ abserr = error
+ result = res
+ 40 continue
+ !
+ ! shift the table.
+ !
+ 50 if(n.eq.limexp) n = 2*(limexp/2)-1
+ ib = 1
+ if((num/2)*2.eq.num) ib = 2
+ ie = newelm+1
+ do 60 i=1,ie
+ ib2 = ib+2
+ epstab(ib) = epstab(ib2)
+ ib = ib2
+ 60 continue
+ if(num.eq.n) go to 80
+ indx = num-n+1
+ do 70 i = 1,n
+ epstab(i)= epstab(indx)
+ indx = indx+1
+ 70 continue
+ 80 if(nres.ge.4) go to 90
+ res3la(nres) = result
+ abserr = oflow
+ go to 100
+ !
+ ! compute error estimate
+ !
+ 90 abserr = dabs(result-res3la(3))+dabs(result-res3la(2))+dabs(result-res3la(1))
+ res3la(1) = res3la(2)
+ res3la(2) = res3la(3)
+ res3la(3) = result
+100 abserr = dmax1(abserr,0.5e1_f*epmach*dabs(result))
+999 return
+ end subroutine dqelg
+
+ !!
+ !! *********************************************************
+ !! taken from BLAS library
+ !! (http://netlib.bell-labs.com/netlib/blas)
+ !! *********************************************************
+ SUBROUTINE SD1MACH(I,D1MACH_OUT,IER)
+ INTEGER, INTENT(in) :: I
+ REAL(kind=f), INTENT(out) :: D1MACH_OUT
+ INTEGER, INTENT(out) :: IER
+ !
+ ! DOUBLE-PRECISION MACHINE CONSTANTS
+ ! D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.
+ ! D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.
+ ! D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING.
+ ! D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING.
+ ! D1MACH( 5) = LOG10(B)
+ !
+ INTEGER :: SMALL(2)
+ INTEGER :: LARGE(2)
+ INTEGER :: RIGHT(2)
+ INTEGER :: DIVER(2)
+ INTEGER :: LOG10(2)
+ INTEGER :: SC, CRAY1(38), J
+ SAVE SMALL, LARGE, RIGHT, DIVER, LOG10, SC
+ REAL(kind=f) :: DMACH(5)
+ EQUIVALENCE (DMACH(1),SMALL(1))
+ EQUIVALENCE (DMACH(2),LARGE(1))
+ EQUIVALENCE (DMACH(3),RIGHT(1))
+ EQUIVALENCE (DMACH(4),DIVER(1))
+ EQUIVALENCE (DMACH(5),LOG10(1))
+ ! THIS VERSION ADAPTS AUTOMATICALLY TO MOST CURRENT MACHINES.
+ ! R1MACH CAN HANDLE AUTO-DOUBLE COMPILING, BUT THIS VERSION OF
+ ! D1MACH DOES NOT, BECAUSE WE DO NOT HAVE QUAD CONSTANTS FOR
+ ! MANY MACHINES YET.
+ ! TO COMPILE ON OLDER MACHINES, ADD A C IN COLUMN 1
+ ! ON THE NEXT LINE
+ DATA SC/0/
+ ! AND REMOVE THE C FROM COLUMN 1 IN ONE OF THE SECTIONS BELOW.
+ ! CONSTANTS FOR EVEN OLDER MACHINES CAN BE OBTAINED BY
+ ! mail netlib@research.bell-labs.com
+ ! send old1mach from blas
+ ! PLEASE SEND CORRECTIONS TO dmg OR ehg@bell-labs.com.
+ !
+ ! MACHINE CONSTANTS FOR THE HONEYWELL DPS 8/70 SERIES.
+ ! DATA SMALL(1),SMALL(2) / O402400000000, O000000000000 /
+ ! DATA LARGE(1),LARGE(2) / O376777777777, O777777777777 /
+ ! DATA RIGHT(1),RIGHT(2) / O604400000000, O000000000000 /
+ ! DATA DIVER(1),DIVER(2) / O606400000000, O000000000000 /
+ ! DATA LOG10(1),LOG10(2) / O776464202324, O117571775714 /, SC/987/
+ !
+ ! MACHINE CONSTANTS FOR PDP-11 FORTRANS SUPPORTING
+ ! 32-BIT INTEGERS.
+ ! DATA SMALL(1),SMALL(2) / 8388608, 0 /
+ ! DATA LARGE(1),LARGE(2) / 2147483647, -1 /
+ ! DATA RIGHT(1),RIGHT(2) / 612368384, 0 /
+ ! DATA DIVER(1),DIVER(2) / 620756992, 0 /
+ ! DATA LOG10(1),LOG10(2) / 1067065498, -2063872008 /, SC/987/
+ !
+ ! MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES.
+ ! DATA SMALL(1),SMALL(2) / O000040000000, O000000000000 /
+ ! DATA LARGE(1),LARGE(2) / O377777777777, O777777777777 /
+ ! DATA RIGHT(1),RIGHT(2) / O170540000000, O000000000000 /
+ ! DATA DIVER(1),DIVER(2) / O170640000000, O000000000000 /
+ ! DATA LOG10(1),LOG10(2) / O177746420232, O411757177572 /, SC/987/
+ !
+ ! ON FIRST CALL, IF NO DATA UNCOMMENTED, TEST MACHINE TYPES.
+ IER = 0
+ IF (SC .NE. 987) THEN
+ DMACH(1) = 1.e13_f
+ IF ( SMALL(1) .EQ. 1117925532 .AND. SMALL(2) .EQ. -448790528) THEN
+ ! *** IEEE BIG ENDIAN ***
+ SMALL(1) = 1048576
+ SMALL(2) = 0
+ LARGE(1) = 2146435071
+ LARGE(2) = -1
+ RIGHT(1) = 1017118720
+ RIGHT(2) = 0
+ DIVER(1) = 1018167296
+ DIVER(2) = 0
+ LOG10(1) = 1070810131
+ LOG10(2) = 1352628735
+ ELSE IF ( SMALL(2) .EQ. 1117925532 .AND. SMALL(1) .EQ. -448790528) THEN
+ ! *** IEEE LITTLE ENDIAN ***
+ SMALL(2) = 1048576
+ SMALL(1) = 0
+ LARGE(2) = 2146435071
+ LARGE(1) = -1
+ RIGHT(2) = 1017118720
+ RIGHT(1) = 0
+ DIVER(2) = 1018167296
+ DIVER(1) = 0
+ LOG10(2) = 1070810131
+ LOG10(1) = 1352628735
+ ELSE IF ( SMALL(1) .EQ. -2065213935 .AND. SMALL(2) .EQ. 10752) THEN
+ ! *** VAX WITH D_FLOATING ***
+ SMALL(1) = 128
+ SMALL(2) = 0
+ LARGE(1) = -32769
+ LARGE(2) = -1
+ RIGHT(1) = 9344
+ RIGHT(2) = 0
+ DIVER(1) = 9472
+ DIVER(2) = 0
+ LOG10(1) = 546979738
+ LOG10(2) = -805796613
+ ELSE IF ( SMALL(1) .EQ. 1267827943 .AND. SMALL(2) .EQ. 704643072) THEN
+ ! *** IBM MAINFRAME ***
+ SMALL(1) = 1048576
+ SMALL(2) = 0
+ LARGE(1) = 2147483647
+ LARGE(2) = -1
+ RIGHT(1) = 856686592
+ RIGHT(2) = 0
+ DIVER(1) = 873463808
+ DIVER(2) = 0
+ LOG10(1) = 1091781651
+ LOG10(2) = 1352628735
+ ELSE IF ( SMALL(1) .EQ. 1120022684 .AND. SMALL(2) .EQ. -448790528) THEN
+ ! *** CONVEX C-1 ***
+ SMALL(1) = 1048576
+ SMALL(2) = 0
+ LARGE(1) = 2147483647
+ LARGE(2) = -1
+ RIGHT(1) = 1019215872
+ RIGHT(2) = 0
+ DIVER(1) = 1020264448
+ DIVER(2) = 0
+ LOG10(1) = 1072907283
+ LOG10(2) = 1352628735
+ ELSE IF ( SMALL(1) .EQ. 815547074 .AND. SMALL(2) .EQ. 58688) THEN
+ ! *** VAX G-FLOATING ***
+ SMALL(1) = 16
+ SMALL(2) = 0
+ LARGE(1) = -32769
+ LARGE(2) = -1
+ RIGHT(1) = 15552
+ RIGHT(2) = 0
+ DIVER(1) = 15568
+ DIVER(2) = 0
+ LOG10(1) = 1142112243
+ LOG10(2) = 2046775455
+ ELSE
+ DMACH(2) = 1.e27_f + 1
+ DMACH(3) = 1.e27_f
+ LARGE(2) = LARGE(2) - RIGHT(2)
+ IF (LARGE(2) .EQ. 64 .AND. SMALL(2) .EQ. 0) THEN
+ CRAY1(1) = 67291416
+ DO J = 1, 20
+ CRAY1(J+1) = CRAY1(J) + CRAY1(J)
+ END DO
+ CRAY1(22) = CRAY1(21) + 321322
+ DO J = 22, 37
+ CRAY1(J+1) = CRAY1(J) + CRAY1(J)
+ END DO
+ IF (CRAY1(38) .EQ. SMALL(1)) THEN
+ ! *** CRAY ***
+ CALL I1MCRY(SMALL(1), J, 8285, 8388608, 0)
+ SMALL(2) = 0
+ CALL I1MCRY(LARGE(1), J, 24574, 16777215, 16777215)
+ CALL I1MCRY(LARGE(2), J, 0, 16777215, 16777214)
+ CALL I1MCRY(RIGHT(1), J, 16291, 8388608, 0)
+ RIGHT(2) = 0
+ CALL I1MCRY(DIVER(1), J, 16292, 8388608, 0)
+ DIVER(2) = 0
+ CALL I1MCRY(LOG10(1), J, 16383, 10100890, 8715215)
+ CALL I1MCRY(LOG10(2), J, 0, 16226447, 9001388)
+ ELSE
+ IER=9
+ END IF
+ ELSE
+ IER=9
+ END IF
+ END IF
+ SC = 987
+ END IF
+ ! SANITY CHECK
+ IF (DMACH(4) .GE. 1.0D0) IER=9
+ IF (I .LT. 1 .OR. I .GT. 5) THEN
+ IER=9
+ END IF
+ D1MACH_OUT = DMACH(I)
+ RETURN
+ END SUBROUTINE SD1MACH
+
+ SUBROUTINE I1MCRY(A, A1, B, C, D)
+ !*** SPECIAL COMPUTATION FOR OLD CRAY MACHINES ****
+ INTEGER A, A1, B, C, D
+ A1 = 16777216*B + C
+ A = 16777216*A1 + D
+ END SUBROUTINE I1MCRY
+
+
+
+end module adgaquad_mod
diff --git a/src/physics/carma/base/adgaquad_types_mod.F90 b/src/physics/carma/base/adgaquad_types_mod.F90
new file mode 100644
index 0000000000..a4f9dd7e70
--- /dev/null
+++ b/src/physics/carma/base/adgaquad_types_mod.F90
@@ -0,0 +1,39 @@
+module adgaquad_types_mod
+ use carma_precision_mod
+
+ integer, public, parameter :: nf=50 !! Number of factorials in fact table.
+
+
+ !! The the functions that are being integrated may need some extra
+ !! data. In the F77, these were stored in common blocks. To make the
+ !! code thread safe, we need to move them into passed parameters. For
+ !! convenience, we put all of these variables into one structure and
+ !! pass the entire structure to all functions that could be integrated
+ !! by these routines.
+
+ type, public :: adgaquad_vars_type
+
+ ! alpha packing coefficient
+ ! nb number of monomers
+ ! a monomer size
+ ! df fractal dimension
+ ! k absolute value of wavevector = 2*pi/wavelength
+
+ real(kind=f) :: fact(0:nf)
+ integer :: u1
+ integer :: u2
+ integer :: u3
+ integer :: u4
+ integer :: u5
+ integer :: u6
+ integer :: pbes
+ real(kind=f) :: kbes
+ real(kind=f) :: alpha
+ real(kind=f) :: nb
+ real(kind=f) :: a
+ real(kind=f) :: df
+ real(kind=f) :: k
+ real(kind=f) :: zed
+ real(kind=f) :: coeff
+ end type adgaquad_vars_type
+end module
\ No newline at end of file
diff --git a/src/physics/carma/base/bhmie.F90 b/src/physics/carma/base/bhmie.F90
new file mode 100644
index 0000000000..b2cf8de66c
--- /dev/null
+++ b/src/physics/carma/base/bhmie.F90
@@ -0,0 +1,182 @@
+!! See Bohren and Huffman, "Absorption and Scattering of Light by
+!! Small Particles", 1983, pg 480 (in Appendix A).
+!!
+!! Subroutine bhmie calculates amplitude scattering matrix
+!! elements and efficiencies for extinction, total scattering
+!! and backscattering for a given size parameter and
+!! relative refractive index.
+!!
+!! From the main program:
+!! refrel = cmplx(refre,refim) / refmed
+!!
+!! @author Chuck Bardeen
+!! @version 2011
+subroutine bhmie(carma, x, refrel, nang, s1, s2, Qext, Qsca, Qback, gfac, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod, only : RC_ERROR
+ use carma_types_mod, only : carma_type
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ real(kind=f), intent(in) :: x !! radius / wavelength
+ complex(kind=f), intent(in) :: refrel !! refractive index particle / reference refractive index
+ integer, intent(in) :: nang !! number of angles in s1 and s2
+ complex(kind=f), intent(out) :: s1(2*nang-1) !! CORE RADIUS
+ complex(kind=f), intent(out) :: s2(2*nang-1) !! REAL PART OF THE CORE INDEX OF REFRACTION
+ real(kind=f), intent(out) :: Qext !! EFFICIENCY FACTOR FOR EXTINCTION
+ real(kind=f), intent(out) :: Qsca !! EFFICIENCY FACTOR FOR SCATTERING
+ real(kind=f), intent(out) :: Qback !! BACK SCATTER CROSS SECTION.
+ real(kind=f), intent(out) :: gfac !! asymmetry factor
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+
+ real(kind=f) :: amu(100), theta(100), pi(100), tau(100), pi0(100), pi1(100)
+ complex(kind=f) :: y, xi, xi0, xi1, an, bn
+ complex(kind=f), allocatable :: d(:)
+ complex(kind=f) :: ccan, ccbn, anmi1, bnmi1
+ real(kind=f) :: psi0, psi1, psi, dn, dx, chi0, chi1, apsi0, apsi1, g1, g2
+ real(kind=f) :: dang, fn, ffn, apsi, chi, p, t, xstop, ymod
+ integer :: j, jj, n, nn, rn, nmx, nstop
+
+
+ ! Mie x and y values.
+ dx = x
+ y = x * refrel
+
+ ! Series terminated after nstop terms
+ xstop = x + 4._f * x**0.3333_f + 2.0_f
+ nstop = xstop
+
+ ! Will loop over nang angles.
+ ymod = int(abs(y))
+ nmx = max(xstop, ymod) + 15
+ dang = 1.570796327_f / real(nang - 1, kind=f)
+ allocate(d(nmx))
+
+ do j = 1, nang
+ theta(j) = (real(j, kind=f) - 1._f) * dang
+ amu(j) = cos(theta(j))
+ end do
+
+ ! Logarithmic derivative d(j) calculated by downword
+ ! recurrence beginning with initial value 0.0 + i*0.0
+ ! at j = nmx
+ d(nmx) = cmplx(0.0_f, 0.0_f, kind=f)
+ nn = nmx-1
+! write(*,*) 'nmx=',nmx,' d(nmx)=',d(nmx), ' nn=',nn
+
+ do n = 1, nn
+ rn = nmx - n + 1
+ d(nmx-n) = (rn/y) - (1._f / (d(nmx - n + 1) + rn / y))
+
+! write(*,*) 'n=',n,' rn=',rn,' y=', y,' d(nmx-n)=',d(nmx-n)
+! write(*,*) 'rn/y=',rn/y, 'd(nmx-n+1)=',d(nmx-n+1),'(d(nmx-n+1)+rn/y)', &
+! (d(nmx-n+1)+rn/y),'1./(d(nmx-n+1)+rn/y)',1./(d(nmx-n+1)+rn/y)
+ end do
+
+ pi0(1:nang) = 0.0_f
+ pi1(1:nang) = 1.0_f
+
+ nn = 2 * nang-1
+ s1(1:nn) = cmplx(0.0_f, 0.0_f, kind=f)
+ s2(1:nn) = cmplx(0.0_f, 0.0_f, kind=f)
+
+ ! Riccati-Bessel functions with real argument x
+ ! calculated by upward recurrence
+ psi0 = cos(dx)
+ psi1 = sin(dx)
+ chi0 = -sin(x)
+ chi1 = cos(x)
+ apsi0 = psi0
+ apsi1 = psi1
+ xi0 = cmplx(apsi0,-chi0, kind=f)
+ xi1 = cmplx(apsi1,-chi1, kind=f)
+ Qsca = 0.0_f
+ g1 = 0.0_f
+ g2 = 0.0_f
+ n = 1
+
+ ! Loop over the terms n in the Mie series
+ do while (.true.)
+ dn = n
+ rn = n
+ fn = (2._f * rn + 1._f) / (rn * (rn + 1._f))
+ ffn = (rn - 1._f) * (rn + 1._f) / rn
+ psi = (2._f * dn - 1._f) * psi1 / dx - psi0
+ apsi = psi
+ chi = (2._f * rn - 1._f) * chi1 / x - chi0
+ xi = cmplx(apsi, -chi, kind=f)
+! write(*,*) 'n=', n
+! write(*,*) 'd(n)=',d(n),' refrel=',refrel,' rn=',rn, ' x=',x,'apsi=',apsi,' apsi1=',apsi1
+
+ an = (d(n) / refrel + rn / x) * apsi - apsi1
+! write(*,*) 'an=',an,' xi=',xi,' xi1=',xi1
+
+ an = an / ((d(n) / refrel + rn / x) * xi - xi1)
+ bn = (refrel * d(n) + rn / x) * apsi - apsi1
+ bn = bn / ((refrel * d(n) + rn / x) * xi - xi1)
+ ccan = conjg(an)
+ ccbn = conjg(bn)
+ g2 = g2 + fn * real(an * ccbn)
+
+ if (n-1 > 0) then
+ g1 = g1 + ffn * real(anmi1 * ccan + bnmi1 * ccbn)
+ end if
+ Qsca = Qsca + (2._f * rn + 1._f) * (abs(an) * abs(an) + abs(bn) * abs(bn))
+
+ do j = 1, nang
+ jj = 2 * nang-j
+ pi(j) = pi1(j)
+ tau(j) = rn * amu(j) * pi(j) - (rn + 1._f) * pi0(j)
+ p = (-1._f)**(n-1)
+! write(*,*) 'fn=',fn,' an=',an,' bn=',bn,' pi(j)=',pi(j),' tau(j)=',tau(j)
+
+ s1(j) = s1(j) + fn * (an * pi(j) + bn * tau(j))
+ t = (-1._f)**n
+ s2(j) = s2(j) + fn * (an * tau(j) + bn * pi(j))
+
+ if (j.ne.jj) then
+ s1(jj)=s1(jj) + fn*(an*pi(j)*p+bn*tau(j)*t)
+ s2(jj)=s2(jj) + fn*(an*tau(j)*t+bn*pi(j)*p)
+! write(*,*) 'j=',j,' s1(j)=',s1(j),' s2(j)=',s2(j)
+ end if
+ end do
+
+ psi0 = psi1
+ psi1 = psi
+ apsi1 = psi1
+ chi0 = chi1
+ chi1 = chi
+ xi1 = cmplx(apsi1, -chi1, kind=f)
+ n = n+1
+ rn = n
+
+ do j = 1, nang
+ pi1(j) = ((2._f * rn - 1._f) / (rn - 1._f)) * amu(j) * pi(j)
+ pi1(j) = pi1(j) -rn * pi0(j) / (rn - 1._f)
+ pi0(j) = pi(j)
+ end do
+
+ anmi1 = an
+ bnmi1 = bn
+
+ if (n - 1 - nstop >= 0) exit
+
+ end do
+
+ Qsca = (2._f / (x * x)) * Qsca
+ gfac = (4._f / (x * x * Qsca)) * (g1+g2)
+ Qext = (4._f / (x * x)) * real(s1(1))
+ Qback = (4._f / (x * x)) * abs(s1(2 * nang - 1)) * abs(s1(2 * nang - 1))
+
+! write(*,*) 'x',x,' s1(1)=',s1(1),' real(s1(1))=',real(s1(1))
+! write(*,*) 'Qsca=',Qsca,' gfac=',gfac,' Qext=',Qext,'Qback=',Qback
+
+ deallocate(d)
+
+ return
+end subroutine bhmie
diff --git a/src/physics/carma/base/calcrs.F90 b/src/physics/carma/base/calcrs.F90
new file mode 100644
index 0000000000..ae75276a04
--- /dev/null
+++ b/src/physics/carma/base/calcrs.F90
@@ -0,0 +1,111 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+
+!!-----------------------------------------------------------------------
+!!
+!! Purpose: Calculating the surface resistance, using the PBL parameter.
+!!
+!! Method: Zhang(2001), Atmospheric Environment
+!!
+!!
+!! @author Tianyi Fan
+!! @version Nov-2010
+!!
+
+subroutine calcrs(carma, cstate, ustar, tmp, radi, cc, vfall, rs, landidx, rc)
+ use carma_precision_mod
+ use carmastate_mod
+ use carma_enums_mod
+ use carma_types_mod
+ use carma_mod
+ use carma_constants_mod, only: BK, PI, GRAV
+!-----------------------------------------------------------------------
+ implicit none
+!-----------------------------------------------------------------------
+!
+! Arguments:
+!
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(in) :: cstate !! the carma state object
+ real(kind=f), intent(in) :: ustar !! friction velocity [cm/s]
+ real(kind=f), intent(in) :: tmp !! temperature [K]
+ real(kind=f), intent(in) :: radi !! radius of the constitutent [cm]
+ real(kind=f), intent(in) :: cc !! slip correction factor
+ real(kind=f), intent(in) :: vfall !! gravitational settling velocity, [cm/s]
+ real(kind=f), intent(out) :: rs !! surface resistance [s/cm]
+ integer, intent(in) :: landidx !! landscape index, 1=land, 2=ocean, 3=sea ice
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+
+
+! Local variables
+ real(kind=f) :: ebrn ! Brownian diffusion collection efficiency
+ real(kind=f) :: eimp ! Impaction collection efficiency
+ real(kind=f) :: eint ! Interception collection efficiency
+ real(kind=f) :: db ! Brownian diffusivity
+ real(kind=f) :: sc ! Schmidt number
+ real(kind=f) :: st ! Stokes number
+ real(kind=f) :: rhoadry ! dry air density [g/cm3]
+ real(kind=f) :: eta ! kinematic viscosity of air [cm2/s]
+ real(kind=f), parameter :: xkar = 0.4_f ! Von Karman's constant
+ real(kind=f), parameter :: eps0 = 3._f ! empirical constant for rs, 3.0 in [Zhang, 2001], 1.0 in [Seinfeld and Pandis]
+
+ ! exponent in the eb dependence on sc, 2/3 in [Seinfeld and Pandis, 1998], 1/2 in [Lewis and Schwartz, 2004]
+ real(kind=f) :: lam
+
+ integer :: ibot
+
+ if (igridv .eq. I_CART) then
+ ibot = 1
+ else
+ ibot = NZ
+ end if
+
+ ! Unit conversion
+ rhoadry = rhoa(ibot) / zmet(ibot) / xmet(ibot) / ymet(ibot) ! [g/cm3]
+ eta = rmu(ibot) / rhoadry ! rmu, aerodynamic viscosity of air [g/cm/s]
+
+ if (landidx .eq. 1) then
+ lam = 2._f / 3._f
+ else
+ lam = 1._f / 2._f
+ end if
+
+ ! Surface Resistance = Brownian + Impaction + Interception
+
+ ! ** Brownian diffusion
+ db = BK * tmp * cc / (6._f * PI * rmu(ibot) * radi) ! [cm2/s]
+
+ sc = eta / db ! [-]
+ ebrn = sc**(-lam)
+
+ ! ** Impaction
+ st = vfall * ustar**2 / (GRAV * eta) ! [-]
+
+ ! [Slinn, 1982]
+ ! eimp = 10. ** (-3._f/st)
+
+ ! [Peters and Eiden, 1992]
+ eimp = (st / (0.8_f + st))**2
+! eimp = max(eimp, 1.e-10_f)
+
+ ! ** Interception
+ !
+ ! NOTE: Interception is not currently considered for ocean and ice.
+ if (landidx .eq. 1) then
+! eint = 0.3_f * (0.01_f * radi * 1.e-2_f / (radi * 1.e-2_f + 1.e-5_f) + 0.99_f *radi*1.e-2_f / (radi*1.e-2_f + 8.e-4_f))
+ eint = 0.3_f * (0.01_f * radi / (radi + 1.e-3_f) + 0.99_f * radi / (radi + 8.e-2_f))
+ else
+ eint = 0._f
+ end if
+
+ if (ustar > 0._f) then
+ rs = 1._f / (eps0 * ustar * (ebrn + eimp + eint )) ! [s/cm]
+ else
+ rs = 0._f
+ end if
+
+ return
+end subroutine calcrs
diff --git a/src/physics/carma/base/carma_constants_mod.F90 b/src/physics/carma/base/carma_constants_mod.F90
new file mode 100644
index 0000000000..5644f68250
--- /dev/null
+++ b/src/physics/carma/base/carma_constants_mod.F90
@@ -0,0 +1,123 @@
+module carma_constants_mod
+
+ use carma_precision_mod
+
+ implicit none
+
+ !--
+ ! Physical constants
+
+ ! Meter-Kilogram-Second (MKS) convention for units
+ ! This convention is different from CARMA's original
+ ! Centimeter-Gram-Second (CGS) convention. Be wary of
+ ! this conversion to the new convention.
+
+ ! Use the _f for all literal constants, e.g. 1.2e_f.
+ ! If you omit the _f in the initialization, a compiler may cast this
+ ! number into single precision and then store it as _f precision.
+
+ !! Define triple-point temperature (K)
+ real(kind=f), parameter :: T0 = 273.16_f
+
+ ! Define constants for circles and trig
+ real(kind=f), parameter :: PI = 3.14159265358979_f
+ real(kind=f), parameter :: DEG2RAD = PI / 180._f
+ real(kind=f), parameter :: RAD2DEG = 180._f / PI
+
+ !! Acceleration of gravity near Earth surface [ cm/s^2 ]
+ real(kind=f), parameter :: GRAV = 980.6_f
+
+ !! Define planet equatorial radius [ cm ]
+ real(kind=f), parameter :: REARTH = 6.37e+8_f
+
+ !! Define avogadro's number [ # particles / mole ]
+ real(kind=f), parameter :: AVG = 6.02252e+23_f
+
+ !! Define Boltzmann's constant [ erg / deg_K ]
+ real(kind=f), parameter :: BK = 1.38054e-16_f
+
+ !! Define Loschmidt's number [ mole / cm^3, @ STP ]
+ real(kind=f), parameter :: ALOS = 2.68719e+19_f
+
+ !! Define molecular weight of dry air [ g / mole ]
+ real(kind=f), parameter :: WTMOL_AIR = 28.966_f
+
+ !! Define molecular weight of water vaor [ g / mole ]
+ real(kind=f), parameter :: WTMOL_H2O = 18.016_f
+
+ !! Define reference pressure, e.g. for potential temp calcs [ dyne / cm^2 ]
+ real(kind=f), parameter :: PREF = 1000.e+3_f
+
+ !! Define conversion factor for mb to cgs [ dyne / cm^2 ] units
+ real(kind=f), parameter :: RMB2CGS = 1000.e+0_f
+
+ !! Define conversion factor for Pa to cgs [ dyne / cm^2 ] units
+ real(kind=f), parameter :: RPA2CGS = 10.e+0_f
+
+ !! Define conversion factor for m to cgs [ cm ] units
+ real(kind=f), parameter :: RM2CGS = 100.0_f
+
+ !! Define universal gas constant [ erg / deg_K / mole ]
+ real(kind=f), parameter :: RGAS = 8.31430e+07_f
+
+ !! Define gas constant for dry air [ erg / deg_K / mole ]
+ real(kind=f), parameter :: R_AIR = RGAS / WTMOL_AIR
+
+ !! Define number of seconds per the planet's day [ s / d ]
+ real(kind=f), parameter :: SCDAY = 86400._f
+
+ !! Define specific heat at constant pres of dry air [ cm^2 / s^2 / deg_K ]
+ real(kind=f), parameter :: CP = 1.004e7_f
+
+ !! Define ratio of gas constant for dry air and specific heat
+ real(kind=f), parameter :: RKAPPA = R_AIR / CP
+
+ !! Define mass density of liquid water [ g / cm^3 ]
+ real(kind=f), parameter :: RHO_W = 1._f
+
+ !! Define mass density of water ice [ g / cm^3 ]
+ real(kind=f), parameter :: RHO_I = 0.93_f
+
+ !! Latent heat of evaporation for gas [cm^2/s^2]
+ real(kind=f), parameter :: RLHE_CNST = 2.501e10_f
+
+ !! Latent heat of ice melting for gas [cm^2/s^2]
+ real(kind=f), parameter :: RLHM_CNST = 3.337e9_f
+
+ !! The dimension of THETD, ELTRMX, CSTHT, PI, TAU, SI2THT.
+ !! IT must correspond exactly to the second dimension of ELTRMX.
+ integer, parameter :: IT = 1
+
+ !! String length of names
+ integer, parameter :: CARMA_NAME_LEN = 255
+
+ !! String length of short names
+ integer, parameter :: CARMA_SHORT_NAME_LEN = 6
+
+ !! Fill value indicating no value is being returned
+ integer, parameter :: CAM_FILL = -999
+
+
+ !! Define small particle number concentration
+ !! [ # / x_units / y_units / z_units ]
+ real(kind=f), parameter :: SMALL_PC = 1e-50_f
+! real(kind=f), parameter :: SMALL_PC = tiny( ONE )
+
+ !! Define particle number concentration [ # / ? ]
+ !! used to decide whether to bypass microphysical processes.
+ !!
+ !! Set it to SMALL_PC/xmet/ymet/zmet to never bypass the calculations.
+
+ real(kind=f), parameter :: FEW_PC = SMALL_PC * 1e6_f
+! real(kind=f), parameter :: FEW_PC = tiny(ONE) * 1e6_f
+
+ !! Define core fraction (for core mass and second moment) used
+ !! when particle number concentrations are limited to SMALL_PC
+ real(kind=f), parameter :: FIX_COREF = 0.1_f
+
+ !! Minimum Cloud Fraction
+ real(kind=f), parameter :: CLDFRC_MIN = 1e-4_f
+
+ !! Incloud Cloud Fraction Threshold for statistics
+ real(kind=f), parameter :: CLDFRC_INCLOUD = 0.10_f
+end module
diff --git a/src/physics/carma/base/carma_enums_mod.F90 b/src/physics/carma/base/carma_enums_mod.F90
new file mode 100644
index 0000000000..7cdb093ace
--- /dev/null
+++ b/src/physics/carma/base/carma_enums_mod.F90
@@ -0,0 +1,143 @@
+!! This module is part of the CARMA module and contains enumerations that are part of
+!! the CARMA and CARMASTATE objects.
+!!
+!! @author Chuck Bardeen
+!! @ version July-2009
+module carma_enums_mod
+
+ !--
+ ! Index values of CARMA's flags. In a given list, begin with 1
+ ! (instead of 0) so that undefined flags will produce an error.
+ !
+ ! For example:
+ ! if( itype(ielem) .eq. I_INVOLATILE )then
+ !
+ ! If itype(ielem) hasn't been defined (and is still 0), we do not want
+ ! to execute the statements that follow.
+
+ ! Define values of flag used for vertical transport
+ ! boundary conditions (ixxxbnd_pc)
+ integer, public, parameter :: I_FIXED_CONC = 1 !! Fixed Concentration
+ integer, public, parameter :: I_FLUX_SPEC = 2 !! Flux Specification
+
+ ! Define values of flag used for particle element
+ ! type specification (itype).
+ integer, public, parameter :: I_INVOLATILE = 1 !! Involatile particle
+ integer, public, parameter :: I_VOLATILE = 2 !! Volatile particle
+ integer, public, parameter :: I_COREMASS = 3 !! Core Mass
+ integer, public, parameter :: I_VOLCORE = 4 !! Voltile Core
+ integer, public, parameter :: I_CORE2MOM = 5 !! Core Mass - 2 Moments
+
+ !! Define values of flag used for nucleation process
+ !! specification (inucproc).
+ !!
+ !! NOTE: Some of these can be used in combination, so for aerosol freezing this is treated
+ !! as a bit mask. When setting for one (or more) of the Aerosol freezing methods, use:
+ !! IAERFREEZE + I_AF_xxx + I_AF_yyy + ...
+ integer, public, parameter :: I_AF_TABAZADEH_2000 = 1 !! Aerosol Freezing, Tabazadeh[2000]
+ integer, public, parameter :: I_AF_KOOP_2000 = 2 !! Aerosol Freezing, Koop[2000]
+ integer, public, parameter :: I_AF_MOHLER_2010 = 4 !! Aerosol Freezing, Mohler[2010]
+ integer, public, parameter :: I_AF_MURRAY_2010 = 8 !! Glassy Aerosol Freezing, Murray[2010]
+ integer, public, parameter :: I_DROPACT = 256 !! Droplet Activation
+ integer, public, parameter :: I_AERFREEZE = 512 !! Aerosol Freezing
+ integer, public, parameter :: I_DROPFREEZE = 1024 !! Droplet Freezing
+ integer, public, parameter :: I_ICEMELT = 2048 !! Ice Melting
+ integer, public, parameter :: I_HETNUC = 4096 !! Heterogeneous Nucleation
+ integer, public, parameter :: I_HOMNUC = 8192 !! Binary homogeneous gas-to-particle nucleation
+ integer, public, parameter :: I_HETNUCSULF = 16384 !! Binary homogeneous gas-to-particle nucleation
+
+ ! Define values of flag used for collection process (icollec)
+ integer, public, parameter :: I_COLLEC_CONST = 1 !! Constant Collection Efficiency
+ integer, public, parameter :: I_COLLEC_FUCHS = 2 !! Binwise Maxima of Fuchs' and Langmuir's Efficiencies
+ integer, public, parameter :: I_COLLEC_DATA = 3 !! Input Data
+
+ ! Define values of flag used for coagulation operation (icoagop)
+ integer, public, parameter :: I_COAGOP_CONST = 1 !! Constant Coagulation Kernel
+ integer, public, parameter :: I_COAGOP_CALC = 2 !! Calculate Coagulation Kernel
+
+ ! Define values of flag used for particle shape (ishape)
+ integer, public, parameter :: I_SPHERE = 1 !! spherical
+ integer, public, parameter :: I_HEXAGON = 2 !! hexagonal prisms or plates
+ integer, public, parameter :: I_CYLINDER = 3 !! circular disks, cylinders, or spheroids
+
+ ! Define values of flag used for particle swelling parameterization (irhswell)
+ integer, public, parameter :: I_NO_SWELLING = 0 !! No swelling
+ integer, public, parameter :: I_FITZGERALD = 1 !! Fitzgerald
+ integer, public, parameter :: I_GERBER = 2 !! Gerber
+ integer, public, parameter :: I_WTPCT_H2SO4 = 3 !! The weight percent method for sulfate aerosol
+
+ ! Define vallues of flag used for particle swelling composition (Fiztgerald)
+ integer, public, parameter :: I_SWF_NH42SO4 = 1 !! (NH4)2SO4
+ integer, public, parameter :: I_SWF_NH4NO3 = 2 !! NH4NO3
+ integer, public, parameter :: I_SWF_NANO3 = 3 !! NaNO3
+ integer, public, parameter :: I_SWF_NH4CL = 4 !! NH4Cl
+ integer, public, parameter :: I_SWF_CACL2 = 5 !! CaCl2
+ integer, public, parameter :: I_SWF_NABR = 6 !! NaBr
+ integer, public, parameter :: I_SWF_NACL = 7 !! NaCl
+ integer, public, parameter :: I_SWF_MGCL2 = 8 !! MgCl2
+ integer, public, parameter :: I_SWF_LICL = 9 !! LiCl
+
+ ! Define vallues of flag used for particle swelling composition (Gerber)
+ integer, public, parameter :: I_SWG_NH42SO4 = 11 !! (NH4)2SO4
+ integer, public, parameter :: I_SWG_SEA_SALT = 12 !! Sea Salt
+ integer, public, parameter :: I_SWG_URBAN = 13 !! Urban
+ integer, public, parameter :: I_SWG_RURAL = 14 !! Rural
+
+ ! Routines to calculate gas vapor pressures
+ integer, public, parameter :: I_VAPRTN_H2O_BUCK1981 = 1 !! H2O, Buck[1981]
+ integer, public, parameter :: I_VAPRTN_H2O_MURPHY2005 = 2 !! H2O, Murphy & Koop [2005]
+ integer, public, parameter :: I_VAPRTN_H2O_GOFF1946 = 3 !! H2O, Goff & Gratch [1946], used in CAM
+ integer, public, parameter :: I_VAPRTN_H2SO4_AYERS1980 = 4 !! H2SO4, Ayers [1980] & Kumala [1990]
+
+ ! Routines to calculate fall velocities
+ integer, public, parameter :: I_FALLRTN_STD = 1 !! Standard CARMA 2.3 routine (spherical only)
+ integer, public, parameter :: I_FALLRTN_STD_SHAPE = 2 !! Optional CARMA 2.3 routine (supports shapes)
+ integer, public, parameter :: I_FALLRTN_HEYMSFIELD2010 = 3 !! Heymsfield & Westbrook [2010] (ice only)
+
+ ! Routines to calculate mie optical properties
+ integer, public, parameter :: I_MIERTN_TOON1981 = 1 !! Shell/Core, Toon & Ackerman [1981]
+ integer, public, parameter :: I_MIERTN_BOHREN1983 = 2 !! Homogeneous Sphere, Bohren & Huffman [1983]
+ integer, public, parameter :: I_MIERTN_BOTET1997 = 3 !! Fractal mean-field, Botet et al. [1997]
+
+ ! Gas Composition
+ integer, public, parameter :: I_GCOMP_H2O = 1 !! Water Vapor
+ integer, public, parameter :: I_GCOMP_H2SO4 = 2 !! Sulphuric Acid
+ integer, public, parameter :: I_GCOMP_SO2 = 3 !! Sulfer Dioxide
+
+ ! How is the CARMA group represented in the parent model
+ integer, public, parameter :: I_CNSTTYPE_PROGNOSTIC = 1 !! Prognostic, advected constituent for each bin
+ integer, public, parameter :: I_CNSTTYPE_DIAGNOSTIC = 2 !! Diagnostic, bins diagonosed from model state
+
+ ! Return Codes
+ !
+ ! NOTE: Also see error handling macros in globaer.h.
+ integer, public, parameter :: RC_OK = 0 !! Success
+ integer, public, parameter :: RC_ERROR = -1 !! Failure
+ integer, public, parameter :: RC_WARNING = 1 !! Warning
+ integer, public, parameter :: RC_WARNING_RETRY = 2 !! Warning, Retry Suggested
+
+
+ ! Define values of symbols used to specify horizontal & vertical grid type.
+ ! Grid selection is made by defining each of the variables
+ ! and to one of the grid types known to the model.
+ !
+ ! Possible values for igridv:
+ ! I_CART cartesian
+ ! I_SIG sigma
+ ! I_HYBRID hybrid
+ !
+ ! Possible values for igridh:
+ ! I_CART cartesian
+ ! I_LL longitude_latitude
+ ! I_LC lambert_conformal
+ ! I_PS polar_stereographic
+ ! I_ME mercator
+ integer, public, parameter :: I_CART = 1 !! Cartesian
+ integer, public, parameter :: I_SIG = 2 !! Sigma
+ integer, public, parameter :: I_LL = 3 !! Longitude & Latitude
+ integer, public, parameter :: I_LC = 4 !! Lambert Conformal
+ integer, public, parameter :: I_PS = 5 !! Polar Sterographic
+ integer, public, parameter :: I_ME = 6 !! Mercator
+ integer, public, parameter :: I_HYBRID = 7 !! Hybrid
+end module
+
diff --git a/src/physics/carma/base/carma_globaer.h b/src/physics/carma/base/carma_globaer.h
new file mode 100644
index 0000000000..5d4ca14d27
--- /dev/null
+++ b/src/physics/carma/base/carma_globaer.h
@@ -0,0 +1,325 @@
+! CARMA Type aliases
+! ---------------------
+! This file containts shortcut names that map the variable names that
+! were traditionally used in the common blocks by the Fortran 77 version
+! of CARMA (globeaer.h), to the corresponding structure members in the
+! Fortran 90 version of CARMA. This allows the older code to be
+! converted to F90 with minimal changes, but without adding any
+! processing overhead.
+! ---------------------------------------------
+
+! NOTE: Using macros causes some limitations:
+!
+! 1) You can not have another #define as a parameter to a macro. This causes
+! multiple expansions of the parameter. To prevent this, assign the parameter
+! to a varaible and use the variable in the macro.
+!
+! 2) You can not have comments on the same line as a macro. Put comments on the
+! line before the one with the macro.
+!
+! 3) Not all fortran preprocessors support the CPP's handling of recursion for
+! macro names. To work out of the box with the broadest number of fortran
+! compilers this requires making the field name different from the macro
+! or it will recursively try to replace the macro again (or report an
+! error message about recursion. Intel and IBM compilers handle it properly,
+! but Portland Group does not. To work around this problem, fields in the
+! cstate and carma structure are preceeded by f_ to make their names unique.
+
+#define NZ cstate%f_NZ
+#define NZP1 cstate%f_NZP1
+#define NGAS carma%f_NGAS
+#define NBIN carma%f_NBIN
+#define NGROUP carma%f_NGROUP
+#define NELEM carma%f_NELEM
+#define NSOLUTE carma%f_NSOLUTE
+#define NWAVE carma%f_NWAVE
+
+! Model logical units for I/O
+#define LUNOPRT carma%f_LUNOPRT
+
+! Model startup control variables
+#define do_print carma%f_do_print
+
+! Gridding Information
+#define igridv cstate%f_igridv
+#define igridh cstate%f_igridh
+#define xmet cstate%f_xmet
+#define ymet cstate%f_ymet
+#define zmet cstate%f_zmet
+#define zmetl cstate%f_zmetl
+#define xc cstate%f_xc
+#define yc cstate%f_yc
+#define zc cstate%f_zc
+#define dx cstate%f_dx
+#define dy cstate%f_dy
+#define dz cstate%f_dz
+#define zl cstate%f_zl
+#define lon cstate%f_lon
+#define lat cstate%f_lat
+
+! Element object
+#define elemname(ielem) carma%f_element(ielem)%f_name
+#define rhoelem(ibin, ielem) carma%f_element(ielem)%f_rho(ibin)
+#define igelem(ielem) carma%f_element(ielem)%f_igroup
+#define itype(ielem) carma%f_element(ielem)%f_itype
+#define icomp(ielem) carma%f_element(ielem)%f_icomposition
+#define isolelem(ielem) carma%f_element(ielem)%f_isolute
+
+! Gas object
+#define gasname(igas) carma%f_gas(igas)%f_name
+#define gwtmol(igas) carma%f_gas(igas)%f_wtmol
+#define ivaprtn(igas) carma%f_gas(igas)%f_ivaprtn
+#define igcomp(igas) carma%f_gas(igas)%f_icomposition
+#define dgc_threshold(igas) carma%f_gas(igas)%f_dgc_threshold
+#define ds_threshold(igas) carma%f_gas(igas)%f_ds_threshold
+
+! Group object
+#define groupname(igroup) carma%f_group(igroup)%f_name
+#define nelemg(igroup) carma%f_group(igroup)%f_nelem
+#define ncore(igroup) carma%f_group(igroup)%f_ncore
+#define ishape(igroup) carma%f_group(igroup)%f_ishape
+#define ienconc(igroup) carma%f_group(igroup)%f_ienconc
+#define imomelem(igroup) carma%f_group(igroup)%f_imomelem
+#define solfac(igroup) carma%f_group(igroup)%f_solface
+#define scavcoef(igroup) carma%f_group(igroup)%f_scavcoef
+#define if_sec_mom(igroup) carma%f_group(igroup)%f_if_sec_mom
+#define is_grp_fractal(igroup) carma%f_group(igroup)%f_is_fractal
+#define is_grp_ice(igroup) carma%f_group(igroup)%f_is_ice
+#define is_grp_cloud(igroup) carma%f_group(igroup)%f_is_cloud
+#define is_grp_sulfate(igroup) carma%f_group(igroup)%f_is_sulfate
+#define grp_do_vtran(igroup) carma%f_group(igroup)%f_grp_do_vtran
+#define grp_do_drydep(igroup) carma%f_group(igroup)%f_grp_do_drydep
+#define irhswell(igroup) carma%f_group(igroup)%f_irhswell
+#define irhswcomp(igroup) carma%f_group(igroup)%f_irhswcomp
+#define rmrat(igroup) carma%f_group(igroup)%f_rmrat
+#define eshape(igroup) carma%f_group(igroup)%f_eshape
+#define r(ibin,igroup) carma%f_group(igroup)%f_r(ibin)
+#define rmass(ibin,igroup) carma%f_group(igroup)%f_rmass(ibin)
+#define vol(ibin,igroup) carma%f_group(igroup)%f_vol(ibin)
+#define dr(ibin,igroup) carma%f_group(igroup)%f_dr(ibin)
+#define dm(ibin,igroup) carma%f_group(igroup)%f_dm(ibin)
+#define rmassup(ibin,igroup) carma%f_group(igroup)%f_rmassup(ibin)
+#define rmin(igroup) carma%f_group(igroup)%f_rmin
+#define rmassmin(igroup) carma%f_group(igroup)%f_rmassmin
+#define rup(ibin,igroup) carma%f_group(igroup)%f_rup(ibin)
+#define rlow(ibin,igroup) carma%f_group(igroup)%f_rlow(ibin)
+#define icorelem(icore,igroup) carma%f_group(igroup)%f_icorelem(icore)
+#define ifallrtn(igroup) carma%f_group(igroup)%f_ifallrtn
+#define arat(ibin,igroup) carma%f_group(igroup)%f_arat(ibin)
+#define rrat(ibin,igroup) carma%f_group(igroup)%f_rrat(ibin)
+#define rprat(ibin,igroup) carma%f_group(igroup)%f_rprat(ibin)
+#define qext(iwave,ibin,igroup) carma%f_group(igroup)%f_qext(iwave,ibin)
+#define ssa(iwave,ibin,igroup) carma%f_group(igroup)%f_ssa(iwave,ibin)
+#define do_mie(igroup) carma%f_group(igroup)%f_do_mie
+#define imiertn(igroup) carma%f_group(igroup)%f_imiertn
+#define dpc_threshold(igroup) carma%f_group(igroup)%f_dpc_threshold
+#define rmon(igroup) carma%f_group(igroup)%f_rmon
+#define df(ibin,igroup) carma%f_group(igroup)%f_df(ibin)
+#define nmon(ibin,igroup) carma%f_group(igroup)%f_nmon(ibin)
+#define falpha(igroup) carma%f_group(igroup)%f_falpha
+#define neutral_volfrc(igroup) carma%f_group(igroup)%f_neutral_volfrc
+
+! Solute object
+#define solname(isolute) carma%f_solute(isolute)%f_name
+#define sol_ions(isolute) carma%f_solute(isolute)%f_ions
+#define solwtmol(isolute) carma%f_solute(isolute)%f_wtmol
+#define rhosol(isolute) carma%f_solute(isolute)%f_rho
+
+! Optical properties
+#define wave carma%f_wave
+#define dwave carma%f_dwave
+#define do_wave_emit carma%f_do_wave_emit
+
+! Model option & control variables
+#define do_clearsky carma%f_do_clearsky
+#define do_cnst_rlh carma%f_do_cnst_rlh
+#define do_coag carma%f_do_coag
+#define do_detrain carma%f_do_detrain
+#define do_fixedinit carma%f_do_fixedinit
+#define do_grow carma%f_do_grow
+#define do_explised carma%f_do_explised
+#define do_incloud carma%f_do_incloud
+#define do_partialinit carma%f_do_partialinit
+#define do_pheat carma%f_do_pheat
+#define do_pheatatm carma%f_do_pheatatm
+#define do_print_init carma%f_do_print_init
+#define do_step carma%f_do_step
+#define do_substep carma%f_do_substep
+#define do_thermo carma%f_do_thermo
+#define do_vdiff carma%f_do_vdiff
+#define do_vtran carma%f_do_vtran
+#define do_drydep carma%f_do_drydep
+#define if_nuc carma%f_if_nuc
+#define time cstate%f_time
+#define dtime cstate%f_dtime
+#define dtime_orig cstate%f_dtime_orig
+#define nretries cstate%f_nretries
+#define dtmin carma%f_dtmin
+#define dtmax carma%f_dtmax
+#define conmax carma%f_conmax
+#define maxsubsteps carma%f_maxsubsteps
+#define minsubsteps carma%f_minsubsteps
+#define maxretries carma%f_maxretries
+#define ifall carma%f_ifall
+#define icoagop carma%f_icoagop
+#define icollec carma%f_icollec
+#define itbnd_pc carma%f_itbnd_pc
+#define ibbnd_pc carma%f_ibbnd_pc
+#define inucgas carma%f_inucgas
+#define igrowgas carma%f_igrowgas
+#define nnuc2elem carma%f_nnuc2elem
+#define ievp2elem carma%f_ievp2elem
+#define nnucelem carma%f_nnucelem
+#define inucproc carma%f_inucproc
+#define inuc2elem carma%f_inuc2elem
+#define inucelem carma%f_inucelem
+#define inuc2bin carma%f_inuc2bin
+#define ievp2bin carma%f_ievp2bin
+#define nnucbin carma%f_nnucbin
+#define inucbin carma%f_inucbin
+#define dt_threshold carma%f_dt_threshold
+#define igash2o carma%f_igash2o
+#define igash2so4 carma%f_igash2so4
+#define igasso2 carma%f_igasso2
+#define tstick carma%f_tstick
+#define gsticki carma%f_gsticki
+#define gstickl carma%f_gstickl
+#define cstick carma%f_cstick
+
+#define max_nsubstep cstate%f_max_nsubstep
+#define max_nretry cstate%f_max_nretry
+#define nstep cstate%f_nstep
+#define nsubstep cstate%f_nsubstep
+#define nretry cstate%f_nretry
+#define zsubsteps cstate%f_zsubsteps
+
+! Particle grid structure
+#define diffmass carma%f_diffmass
+#define rhop cstate%f_rhop
+#define r_wet cstate%f_r_wet
+#define rlow_wet cstate%f_rlow_wet
+#define rup_wet cstate%f_rup_wet
+#define rhop_wet cstate%f_rhop_wet
+#define r_ref cstate%f_r_ref
+#define rhop_ref cstate%f_rhop_ref
+
+! Atmospheric structure
+#define rhoa cstate%f_rhoa
+#define rhoa_wet cstate%f_rhoa_wet
+#define t cstate%f_t
+#define p cstate%f_p
+#define pl cstate%f_pl
+#define relhum cstate%f_relhum
+#define wtpct cstate%f_wtpct
+#define told cstate%f_told
+#define rmu cstate%f_rmu
+#define thcond cstate%f_thcond
+#define thcondnc cstate%f_thcondnc
+#define dkz cstate%f_dkz
+
+! Model primary vars
+#define pc cstate%f_pc
+#define pcd cstate%f_pcd
+#define pc_surf cstate%f_pc_surf
+#define gc cstate%f_gc
+#define sedimentationflux cstate%f_sedimentationflux
+#define cldfrc cstate%f_cldfrc
+#define rhcrit cstate%f_rhcrit
+
+! Model secondary variables
+#define pcl cstate%f_pcl
+#define gcl cstate%f_gcl
+#define d_gc cstate%f_d_gc
+#define d_t cstate%f_d_t
+#define dpc_sed cstate%f_dpc_sed
+#define pconmax cstate%f_pconmax
+#define coaglg cstate%f_coaglg
+#define coagpe cstate%f_coagpe
+#define rnuclg cstate%f_rnuclg
+#define rnucpe cstate%f_rnucpe
+#define rhompe cstate%f_rhompe
+#define pc_nucl cstate%f_pc_nucl
+#define growpe cstate%f_growpe
+#define evappe cstate%f_evappe
+#define coreavg cstate%f_coreavg
+#define coresig cstate%f_coresig
+#define evdrop cstate%f_evdrop
+#define evcore cstate%f_evcore
+#define growlg cstate%f_growlg
+#define evaplg cstate%f_evaplg
+#define gasprod cstate%f_gasprod
+#define rlheat cstate%f_rlheat
+#define cmf cstate%f_cmf
+#define totevap cstate%f_totevap
+#define pc_topbnd cstate%f_pc_topbnd
+#define pc_botbnd cstate%f_pc_botbnd
+#define ftoppart cstate%f_ftoppart
+#define fbotpart cstate%f_fbotpart
+#define cmf cstate%f_cmf
+#define totevap cstate%f_totevap
+#define too_small cstate%f_too_small
+#define too_big cstate%f_too_big
+#define nuc_small cstate%f_nuc_small
+#define rlprod cstate%f_rlprod
+#define phprod cstate%f_phprod
+
+! Coagulation kernels and bin pair mapping
+#define ck0 carma%f_ck0
+#define grav_e_coll0 carma%f_grav_e_coll0
+#define icoag carma%f_icoag
+#define icoagelem carma%f_icoagelem
+#define icoagelem_cm carma%f_icoagelem_cm
+#define kbin carma%f_kbin
+
+#define ckernel cstate%f_ckernel
+#define pkernel carma%f_pkernel
+
+#define volx carma%f_volx
+#define ilow carma%f_ilow
+#define jlow carma%f_jlow
+#define iup carma%f_iup
+#define jup carma%f_jup
+#define npairl carma%f_npairl
+#define npairu carma%f_npairu
+
+! Coagulation group pair mapping
+#define iglow carma%f_iglow
+#define jglow carma%f_jglow
+#define igup carma%f_igup
+#define jgup carma%f_jgup
+
+! Particle fall velocities, transport rates, and coagulation kernels
+#define bpm cstate%f_bpm
+#define vf cstate%f_vf
+#define re cstate%f_re
+#define vf_const carma%f_vf_const
+#define vd cstate%f_vd
+
+! Condensational growth parameters
+#define diffus cstate%f_diffus
+#define rlhe cstate%f_rlhe
+#define rlhm cstate%f_rlhm
+#define pvapl cstate%f_pvapl
+#define pvapi cstate%f_pvapi
+#define surfctwa cstate%f_surfctwa
+#define surfctiw cstate%f_surfctiw
+#define surfctia cstate%f_surfctia
+#define akelvin cstate%f_akelvin
+#define akelvini cstate%f_akelvini
+#define ft cstate%f_ft
+#define gro cstate%f_gro
+#define gro1 cstate%f_gro1
+#define gro2 cstate%f_gro2
+#define supsatl cstate%f_supsatl
+#define supsati cstate%f_supsati
+#define supsatlold cstate%f_supsatlold
+#define supsatiold cstate%f_supsatiold
+#define scrit cstate%f_scrit
+#define rlh_nuc carma%f_rlh_nuc
+#define radint cstate%f_radint
+#define partheat cstate%f_partheat
+#define dtpart cstate%f_dtpart
+#define pratt carma%f_pratt
+#define prat carma%f_prat
+#define pden1 carma%f_pden1
+#define palr carma%f_palr
diff --git a/src/physics/carma/base/carma_mod.F90 b/src/physics/carma/base/carma_mod.F90
new file mode 100644
index 0000000000..353c6173d2
--- /dev/null
+++ b/src/physics/carma/base/carma_mod.F90
@@ -0,0 +1,1492 @@
+!! The CARMA module contains an interface to the Community Aerosol and Radiation
+!! Model for Atmospheres (CARMA) bin microphysical model [Turco et al. 1979;
+!! Toon et al. 1988]. This implementation has been customized to work within
+!! other model frameworks, so although it can be provided with an array of
+!! columns, it does not do horizontal transport and just does independent 1-D
+!! calculations upon each column.
+!!
+!! The typical usage for the CARMA and CARMASTATE objects within a model would be:
+!!>
+!! ! This first section of code is done during the parent model's initialzation,
+!! ! and there should be a unique CARMA object created for each thread of
+!! ! execution.
+!!
+!! ! Create the CARMA object.
+!! call CARMA_Create(carma, ...)
+!!
+!! ! Define the microphysical components.
+!! call CARMAGROUP_Create(carma, ...) ! One or more calls
+!!
+!! call CARMAELEMENT_Create(carma, ...) ! One or more calls
+!!
+!! call CARMASOLUTE_Create(carma, ...) ! Zero or more calls
+!!
+!! call CARMAGAS_Create(carma, ...) ! Zero or more calls
+!!
+!! ! Define the relationships for the microphysical processes.
+!! call CARMA_AddCoagulation(carma, ...) ! Zero or more calls
+!! call CARMA_AddGrowth(carma, ...) ! Zero or more calls
+!! call CARMA_AddNucleation(carma, ...) ! Zero or more calls
+!!
+!! ! Initialize things that are state and timestep independent.
+!! call CARMA_Initialize(carma, ...)
+!!
+!! ...
+!!
+!! ! This section of code is within the parent model's timing loop.
+!! !
+!! ! NOTE: If using OPEN/MP, then each thread will execute one of
+!! ! of these loops per column of data. To avoid having to destroy
+!! ! the CARMASTATE object, a pool of CARMASTATE objects could be
+!! ! created so that there is one per thread and then the
+!! ! CARMA_Destroy() could be called after all columns have been
+!! ! processed.
+!!
+!! ! Initialize CARMA for this model state and timestep.
+!! call CARMASTATE_Create(cstate, carma, ...)
+!!
+!! ! Set the model state for each bin and gas.
+!! call CARMASTATE_SetBin(cstate, ...) ! One call for each bin
+!! call CARMASTATE_SetGas(cstate, ...) ! One call for each gas
+!!
+!! ! Calculate the new state
+!! call CARMASTATE_Step(cstate, ...)
+!!
+!! ! Get the results to return back to the parent model.
+!! call CARMASTATE_GetBin(cstate, ...) ! One call for each Bin
+!! call CARMASTATE_GetGas(cstate, ...) ! One call for each gas
+!! call CARMASTATE_GetState(cstate, ...) ! Zero or one calls
+!!
+!! ! (optional) Deallocate arrays that are not needed beyond this timestep.
+!! call CARMASTATE_Destroy(cstate)
+!!
+!! ...
+!!
+!! ! This section of code is done during the parent model's cleanup.
+!!
+!! ! Deallocate all arrays.
+!! call CARMA_Destroy(carma)
+!!<
+!!
+!! @version Feb-2009
+!! @author Chuck Bardeen, Pete Colarco, Jamie Smith
+!
+! NOTE: Documentation for this code can be generated automatically using f90doc,
+! which is freely available from:
+! http://erikdemaine.org/software/f90doc/
+! Comment lines with double comment characters are processed by f90doc, and there are
+! some special characters added to the comments to control the documentation process.
+! In addition to the special characters mentioned in the f990doc documentation, html
+! formatting tags (e.g. , , ...) can also be added to the f90doc
+! comments.
+module carma_mod
+
+ ! This module maps the parents models constants into the constants need by CARMA. NOTE: CARMA
+ ! constants are in CGS units, while the parent models are typically in MKS units.
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+
+ ! CARMA explicitly declares all variables.
+ implicit none
+
+ ! All CARMA variables and procedures are private except those explicitly declared to be public.
+ private
+
+ ! Declare the public methods.
+ public CARMA_AddCoagulation
+ public CARMA_AddGrowth
+ public CARMA_AddNucleation
+ public CARMA_Create
+ public CARMA_Destroy
+ public CARMA_Get
+ public CARMA_Initialize
+
+contains
+
+ ! These are the methods that provide the interface between the parent model and the CARMA
+ ! microphysical model. There are many other methods that are not in this file that are
+ ! used to implement the microphysical calculations needed by the CARMA model. These other
+ ! methods are in effect private methods of the CARMA module, but are in individual files
+ ! since that is the way that CARMA has traditionally been structured and where users may
+ ! want to extend or replace code to affect the microphysics.
+
+ !! Creates the CARMA object and allocates arrays to store configuration information
+ !! that will follow from the CARMA_AddXXX() methods. When the CARMA object is no longer
+ !! needed, the CARMA_Destroy() method should be used to clean up any allocations
+ !! that have happened. If LUNOPRT is specified, then the logical unit should be open and
+ !! ready for output. The caller is responsible for closing the LUNOPRT logical unit
+ !! after the CARMA object has been destroyed.
+ !!
+ !! @version Feb-2009
+ !! @author Chuck Bardeen
+ subroutine CARMA_Create(carma, NBIN, NELEM, NGROUP, NSOLUTE, NGAS, NWAVE, rc, &
+ LUNOPRT, wave, dwave, do_wave_emit)
+
+ type(carma_type), intent(out) :: carma !! the carma object
+ integer, intent(in) :: NBIN !! number of radius bins per group
+ integer, intent(in) :: NELEM !! total number of elements
+ integer, intent(in) :: NGROUP !! total number of groups
+ integer, intent(in) :: NSOLUTE !! total number of solutes
+ integer, intent(in) :: NGAS !! total number of gases
+ integer, intent(in) :: NWAVE !! number of wavelengths
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ integer, intent(in), optional :: LUNOPRT !! logical unit number for output
+ real(kind=f), intent(in), optional :: wave(NWAVE) !! wavelength centers (cm)
+ real(kind=f), intent(in), optional :: dwave(NWAVE) !! wavelength width (cm)
+ logical, intent(in), optional :: do_wave_emit(NWAVE) !! do emission in band?
+
+ ! Local Varaibles
+ integer :: ier
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Save off the logic unit used for output if one was provided. If one was provided,
+ ! then assume that CARMA can print output.
+ if (present(LUNOPRT)) then
+ carma%f_LUNOPRT = LUNOPRT
+ carma%f_do_print = .TRUE.
+ end if
+
+ ! Save the defintion of the number of comonents involved in the microphysics.
+ carma%f_NGROUP = NGROUP
+ carma%f_NELEM = NELEM
+ carma%f_NBIN = NBIN
+ carma%f_NGAS = NGAS
+ carma%f_NSOLUTE = NSOLUTE
+ carma%f_NWAVE = NWAVE
+
+
+ ! Allocate tables for the groups.
+ allocate( &
+ carma%f_group(NGROUP), &
+ carma%f_icoag(NGROUP, NGROUP), &
+ carma%f_inucgas(NGROUP), &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating groups, NGROUP=", &
+ carma%f_NGROUP, ", status=", ier
+ rc = RC_ERROR
+ return
+ endif
+
+ ! Initialize
+ carma%f_icoag(:, :) = 0
+ carma%f_inucgas(:) = 0
+
+ ! Allocate tables for the elements.
+ allocate( &
+ carma%f_element(NELEM), &
+ carma%f_igrowgas(NELEM), &
+ carma%f_inuc2elem(NELEM, NELEM), &
+ carma%f_inucproc(NELEM, NELEM), &
+ carma%f_ievp2elem(NELEM), &
+ carma%f_nnuc2elem(NELEM), &
+ carma%f_nnucelem(NELEM), &
+ carma%f_inucelem(NELEM,NELEM*NGROUP), &
+ carma%f_if_nuc(NELEM,NELEM), &
+ carma%f_rlh_nuc(NELEM, NELEM), &
+ carma%f_icoagelem(NELEM, NGROUP), &
+ carma%f_icoagelem_cm(NELEM, NGROUP), &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating elements, NELEM=", &
+ carma%f_NELEM, ", status=", ier
+ rc = RC_ERROR
+ return
+ endif
+
+ ! Initialize
+ carma%f_igrowgas(:) = 0
+ carma%f_inuc2elem(:,:) = 0
+ carma%f_inucproc(:,:) = 0
+ carma%f_ievp2elem(:) = 0
+ carma%f_nnuc2elem(:) = 0
+ carma%f_nnucelem(:) = 0
+ carma%f_inucelem(:,:) = 0
+ carma%f_if_nuc(:,:) = .FALSE.
+ carma%f_rlh_nuc(:,:) = 0._f
+ carma%f_icoagelem(:,:) = 0
+ carma%f_icoagelem_cm(:,:) = 0
+
+
+ ! Allocate tables for the bins.
+ allocate( &
+ carma%f_inuc2bin(NBIN,NGROUP,NGROUP), &
+ carma%f_ievp2bin(NBIN,NGROUP,NGROUP), &
+ carma%f_nnucbin(NGROUP,NBIN,NGROUP), &
+ carma%f_inucbin(NBIN*NGROUP,NGROUP,NBIN,NGROUP), &
+ carma%f_diffmass(NBIN, NGROUP, NBIN, NGROUP), &
+ carma%f_volx(NGROUP,NGROUP,NGROUP,NBIN,NBIN), &
+ carma%f_ilow(NGROUP,NBIN,NBIN*NBIN), &
+ carma%f_jlow(NGROUP,NBIN,NBIN*NBIN), &
+ carma%f_iup(NGROUP,NBIN,NBIN*NBIN), &
+ carma%f_jup(NGROUP,NBIN,NBIN*NBIN), &
+ carma%f_npairl(NGROUP,NBIN), &
+ carma%f_npairu(NGROUP,NBIN), &
+ carma%f_iglow(NGROUP,NBIN,NBIN*NBIN), &
+ carma%f_jglow(NGROUP,NBIN,NBIN*NBIN), &
+ carma%f_igup(NGROUP,NBIN,NBIN*NBIN), &
+ carma%f_jgup(NGROUP,NBIN,NBIN*NBIN), &
+ carma%f_kbin(NGROUP,NGROUP,NGROUP,NBIN,NBIN), &
+ carma%f_pkernel(NBIN,NBIN,NGROUP,NGROUP,NGROUP,6), &
+ carma%f_pratt(3,NBIN,NGROUP), &
+ carma%f_prat(4,NBIN,NGROUP), &
+ carma%f_pden1(NBIN,NGROUP), &
+ carma%f_palr(4,NGROUP), &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating bins, NBIN=", &
+ carma%f_NBIN, ", status=", ier
+ rc = RC_ERROR
+ return
+ endif
+
+ ! Initialize
+ carma%f_inuc2bin(:,:,:) = 0
+ carma%f_ievp2bin(:,:,:) = 0
+ carma%f_nnucbin(:,:,:) = 0
+ carma%f_inucbin(:,:,:,:) = 0
+ carma%f_diffmass(:, :, :, :) = 0._f
+ carma%f_volx(:,:,:,:,:) = 0._f
+ carma%f_ilow(:,:,:) = 0
+ carma%f_jlow(:,:,:) = 0
+ carma%f_iup(:,:,:) = 0
+ carma%f_jup(:,:,:) = 0
+ carma%f_npairl(:,:) = 0
+ carma%f_npairu(:,:) = 0
+ carma%f_iglow(:,:,:) = 0
+ carma%f_jglow(:,:,:) = 0
+ carma%f_igup(:,:,:) = 0
+ carma%f_jgup(:,:,:) = 0
+ carma%f_kbin(:,:,:,:,:) = 0._f
+ carma%f_pkernel(:,:,:,:,:,:) = 0._f
+ carma%f_pratt(:,:,:) = 0._f
+ carma%f_prat(:,:,:) = 0._f
+ carma%f_pden1(:,:) = 0._f
+ carma%f_palr(:,:) = 0._f
+
+
+ ! Allocate tables for solutes, if any are needed.
+ if (NSOLUTE > 0) then
+ allocate( &
+ carma%f_solute(NSOLUTE), &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating solutes, NSOLUTE=", &
+ carma%f_NSOLUTE, ", status=", ier
+ rc = RC_ERROR
+ return
+ endif
+ end if
+
+
+ ! Allocate tables for gases, if any are needed.
+ if (NGAS > 0) then
+ allocate( &
+ carma%f_gas(NGAS), &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating gases, NGAS=", &
+ carma%f_NGAS, ", status=", ier
+ rc = RC_ERROR
+ return
+ endif
+ end if
+
+
+ ! Allocate tables for optical properties, if any are needed.
+ if (NWAVE > 0) then
+ allocate( &
+ carma%f_wave(NWAVE), &
+ carma%f_dwave(NWAVE), &
+ carma%f_do_wave_emit(NWAVE), &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Create: ERROR allocating wavelengths, NWAVE=", &
+ carma%f_NWAVE, ", status=", ier
+ rc = RC_ERROR
+ return
+ endif
+
+ ! Initialize
+ carma%f_do_wave_emit(:) = .TRUE.
+
+ if (present(wave)) carma%f_wave(:) = wave(:)
+ if (present(dwave)) carma%f_dwave(:) = dwave(:)
+ if (present(do_wave_emit)) carma%f_do_wave_emit(:) = do_wave_emit(:)
+ end if
+
+ return
+ end subroutine CARMA_Create
+
+ !! Called after the CARMA object has been created and the microphysics description has been
+ !! configured. The optional flags control which microphysical processes are enabled and all of
+ !! them default to FALSE. For a microphysical process to be active it must have been both
+ !! configured (using a CARMA_AddXXX() method) and enabled here.
+ !!
+ !! NOTE: After initialization, the structure of the particle size bins is determined, and
+ !! the resulting r, dr, rmass and dm can be retrieved with the CARMA_GetGroup() method.
+ !!
+ !! @version Feb-2009
+ !! @author Chuck Bardeen
+ subroutine CARMA_Initialize(carma, rc, do_cnst_rlh, do_coag, do_detrain, do_fixedinit, &
+ do_grow, do_incloud, do_explised, do_print_init, do_substep, do_thermo, do_vdiff, &
+ do_vtran, do_drydep, vf_const, minsubsteps, maxsubsteps, maxretries, conmax, &
+ do_pheat, do_pheatatm, dt_threshold, cstick, gsticki, gstickl, tstick, do_clearsky, &
+ do_partialinit)
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ logical, intent(in), optional :: do_cnst_rlh !! use constant values for latent heats
+ !! (instead of varying with temperature)?
+ logical, intent(in), optional :: do_coag !! do coagulation?
+ logical, intent(in), optional :: do_detrain !! do detrainement?
+ logical, intent(in), optional :: do_fixedinit !! do initialization from reference atm?
+ logical, intent(in), optional :: do_grow !! do nucleation, growth and evaporation?
+ logical, intent(in), optional :: do_incloud !! do incloud growth and coagulation?
+ logical, intent(in), optional :: do_explised !! do sedimentation with substepping
+ logical, intent(in), optional :: do_substep !! do substepping
+ logical, intent(in), optional :: do_print_init !! do prinit initializtion information
+ logical, intent(in), optional :: do_thermo !! do thermodynamics
+ logical, intent(in), optional :: do_vdiff !! do Brownian diffusion
+ logical, intent(in), optional :: do_vtran !! do sedimentation
+ logical, intent(in), optional :: do_drydep !! do dry deposition
+ real(kind=f), intent(in), optional :: vf_const !! if specified and non-zero,
+ !! constant fall velocity for all particles [cm/s]
+ integer, intent(in), optional :: minsubsteps !! minimum number of substeps, default = 1
+ integer, intent(in), optional :: maxsubsteps !! maximum number of substeps, default = 1
+ integer, intent(in), optional :: maxretries !! maximum number of substep retries, default = 5
+ real(kind=f), intent(in), optional :: conmax !! minimum relative concentration to consider, default = 1e-1
+ logical, intent(in), optional :: do_pheat !! do particle heating
+ logical, intent(in), optional :: do_pheatatm !! do particle heating of atmosphere
+ real(kind=f), intent(in), optional :: dt_threshold !! convergence criteria for temperature [fraction]
+ real(kind=f), intent(in), optional :: cstick !! accommodation coefficient - coagulation, default = 1.0
+ real(kind=f), intent(in), optional :: gsticki !! accommodation coefficient - growth (ice), default = 0.93
+ real(kind=f), intent(in), optional :: gstickl !! accommodation coefficient - growth (liquid), default = 1.0
+ real(kind=f), intent(in), optional :: tstick !! accommodation coefficient - temperature, default = 1.0
+ logical, intent(in), optional :: do_clearsky !! do clear sky growth and coagulation?
+ logical, intent(in), optional :: do_partialinit !! do initialization of coagulation from reference atm (requires do_fixedinit)?
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Set default values for control flags.
+ carma%f_do_cnst_rlh = .FALSE.
+ carma%f_do_coag = .FALSE.
+ carma%f_do_detrain = .FALSE.
+ carma%f_do_fixedinit = .FALSE.
+ carma%f_do_grow = .FALSE.
+ carma%f_do_incloud = .FALSE.
+ carma%f_do_explised = .FALSE.
+ carma%f_do_pheat = .FALSE.
+ carma%f_do_pheatatm = .FALSE.
+ carma%f_do_print_init = .FALSE.
+ carma%f_do_substep = .FALSE.
+ carma%f_do_thermo = .FALSE.
+ carma%f_do_vdiff = .FALSE.
+ carma%f_do_vtran = .FALSE.
+ carma%f_do_drydep = .FALSE.
+ carma%f_dt_threshold = 0._f
+ carma%f_cstick = 1._f
+ carma%f_gsticki = 0.93_f
+ carma%f_gstickl = 1._f
+ carma%f_tstick = 1._f
+ carma%f_do_clearsky = .FALSE.
+ carma%f_do_partialinit = .FALSE.
+
+ ! Store off any control flag values that have been supplied.
+ if (present(do_cnst_rlh)) carma%f_do_cnst_rlh = do_cnst_rlh
+ if (present(do_coag)) carma%f_do_coag = do_coag
+ if (present(do_detrain)) carma%f_do_detrain = do_detrain
+ if (present(do_fixedinit)) carma%f_do_fixedinit = do_fixedinit
+ if (present(do_grow)) carma%f_do_grow = do_grow
+ if (present(do_incloud)) carma%f_do_incloud = do_incloud
+ if (present(do_explised)) carma%f_do_explised = do_explised
+ if (present(do_pheat)) carma%f_do_pheat = do_pheat
+ if (present(do_pheatatm)) carma%f_do_pheatatm = do_pheatatm
+ if (present(do_print_init)) carma%f_do_print_init = (do_print_init .and. carma%f_do_print)
+ if (present(do_substep)) carma%f_do_substep = do_substep
+ if (present(do_thermo)) carma%f_do_thermo = do_thermo
+ if (present(do_vdiff)) carma%f_do_vdiff = do_vdiff
+ if (present(do_vtran)) carma%f_do_vtran = do_vtran
+ if (present(do_drydep)) carma%f_do_drydep = do_drydep
+ if (present(dt_threshold)) carma%f_dt_threshold = dt_threshold
+ if (present(cstick)) carma%f_cstick = cstick
+ if (present(gsticki)) carma%f_gsticki = gsticki
+ if (present(gstickl)) carma%f_gstickl = gstickl
+ if (present(tstick)) carma%f_tstick = tstick
+ if (present(do_clearsky)) carma%f_do_clearsky = do_clearsky
+ if (present(do_partialinit)) carma%f_do_partialinit = do_partialinit
+
+
+ ! Setup the bin structure.
+ call setupbins(carma, rc)
+ if (rc < 0) return
+
+ ! Substepping
+ carma%f_minsubsteps = 1 ! minimum number of substeps
+ carma%f_maxsubsteps = 1 ! maximum number of substeps
+ carma%f_maxretries = 1 ! maximum number of retries
+ carma%f_conmax = 1.e-1_f
+
+ if (present(minsubsteps)) carma%f_minsubsteps = minsubsteps
+ if (present(maxsubsteps)) carma%f_maxsubsteps = maxsubsteps
+ if (present(maxretries)) carma%f_maxretries = maxretries
+ if (present(conmax)) carma%f_conmax = conmax
+
+ carma%f_do_step = .TRUE.
+
+ ! Calculate the Optical Properties
+ !
+ ! NOTE: This is only needed by CARMA if particle heating is being used. For
+ ! fractal particle the optics can be very slow, so only do it if necessary,
+ if (carma%f_do_pheat) then
+ call CARMA_InitializeOptics(carma, rc)
+ if (rc < 0) return
+ end if
+
+ ! If any of the processes have initialization that can be done without the state
+ ! information, then perform that now. This will mostly be checking the configuration
+ ! and setting up any tables based upon the configuration.
+ if (carma%f_do_vtran .or. carma%f_do_coag) then
+ call CARMA_InitializeVertical(carma, rc, vf_const)
+ if (rc < 0) return
+ end if
+
+ if (carma%f_do_coag) then
+ call setupcoag(carma, rc)
+ if (rc < 0) return
+ end if
+
+ if (carma%f_do_grow) then
+ call CARMA_InitializeGrowth(carma, rc)
+ if (rc < 0) return
+ end if
+
+ if (carma%f_do_thermo) then
+ call CARMA_InitializeThermo(carma, rc)
+ if (rc < 0) return
+ end if
+
+ return
+ end subroutine CARMA_Initialize
+
+
+ subroutine CARMA_InitializeGrowth(carma, rc)
+ type(carma_type), intent(inout) :: carma
+ integer, intent(out) :: rc
+
+ ! Local Variables
+ integer :: i
+ logical :: bad_grid
+ integer :: igroup ! group index
+ integer :: igas ! gas index
+ integer :: isol ! solute index
+ integer :: ielem ! element index
+ integer :: ibin ! bin index
+ integer :: igfrom
+ integer :: igto
+ integer :: ibto
+ integer :: ieto
+ integer :: ifrom
+ integer :: iefrom
+ integer :: jefrom
+ integer :: ip
+ integer :: jcore
+ integer :: iecore
+ integer :: im
+ integer :: jnucelem
+ integer :: inuc2
+ integer :: neto
+ integer :: jfrom
+ integer :: j
+ integer :: nnucb
+
+ ! Define formats
+ 1 format(a,': ',12i6)
+ 2 format(/,a,': ',i6)
+ 3 format(a,a)
+ 4 format(a,': ',1pe12.3)
+ 5 format(/,'Particle nucleation mapping arrays (setupnuc):')
+ 7 format(/,'Warning: nucleation cannot occur from group',i3, &
+ ' bin',i3,' into group',i3,' ( is zero)')
+
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Compute radius-dependent terms used in PPM advection scheme
+ do igroup = 1, carma%f_NGROUP
+ do i = 2,carma%f_NBIN-1
+ carma%f_pratt(1,i,igroup) = carma%f_group(igroup)%f_dm(i) / &
+ ( carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) )
+ carma%f_pratt(2,i,igroup) = ( 2._f*carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) ) / &
+ ( carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i) )
+ carma%f_pratt(3,i,igroup) = ( 2._f*carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i) ) / &
+ ( carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) )
+ enddo
+
+ do i = 2,carma%f_NBIN-2
+ carma%f_prat(1,i,igroup) = carma%f_group(igroup)%f_dm(i) / &
+ ( carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) )
+ carma%f_prat(2,i,igroup) = 2._f * carma%f_group(igroup)%f_dm(i+1) * carma%f_group(igroup)%f_dm(i) / &
+ ( carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) )
+ carma%f_prat(3,i,igroup) = ( carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) ) / &
+ ( 2._f*carma%f_group(igroup)%f_dm(i) + carma%f_group(igroup)%f_dm(i+1) )
+ carma%f_prat(4,i,igroup) = ( carma%f_group(igroup)%f_dm(i+2) + carma%f_group(igroup)%f_dm(i+1) ) / &
+ ( 2._f*carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i) )
+ carma%f_pden1(i,igroup) = carma%f_group(igroup)%f_dm(i-1) + carma%f_group(igroup)%f_dm(i) + &
+ carma%f_group(igroup)%f_dm(i+1) + carma%f_group(igroup)%f_dm(i+2)
+ enddo
+
+ if( carma%f_NBIN .gt. 1 )then
+ carma%f_palr(1,igroup) = &
+ (carma%f_group(igroup)%f_rmassup(1)-carma%f_group(igroup)%f_rmass(1)) / &
+ (carma%f_group(igroup)%f_rmass(2)-carma%f_group(igroup)%f_rmass(1))
+ carma%f_palr(2,igroup) = &
+ (carma%f_group(igroup)%f_rmassup(1)/carma%f_group(igroup)%f_rmrat-carma%f_group(igroup)%f_rmass(1)) / &
+ (carma%f_group(igroup)%f_rmass(2)-carma%f_group(igroup)%f_rmass(1))
+ carma%f_palr(3,igroup) = &
+ (carma%f_group(igroup)%f_rmassup(carma%f_NBIN-1)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1)) &
+ / (carma%f_group(igroup)%f_rmass(carma%f_NBIN)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1))
+ carma%f_palr(4,igroup) = &
+ (carma%f_group(igroup)%f_rmassup(carma%f_NBIN)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1)) &
+ / (carma%f_group(igroup)%f_rmass(carma%f_NBIN)-carma%f_group(igroup)%f_rmass(carma%f_NBIN-1))
+ endif
+ end do
+
+
+ ! Check the nucleation mapping.
+ !
+ ! NOTE: This code was moved from setupnuc, because it is not dependent on the model's
+ ! state. A small part of setupnuc which deals with scrit is state specific, and that was
+ ! left in setupnuc.
+
+ ! Bin mapping for nucleation : nucleation would transfer mass from particles
+ ! in into target bin in group
+ ! . The target bin is the smallest bin in the target size grid with
+ ! mass exceeding that of nucleated particle.
+ do igfrom = 1,carma%f_NGROUP ! nucleation source group
+ do igto = 1,carma%f_NGROUP ! nucleation target group
+ do ifrom = 1,carma%f_NBIN ! nucleation source bin
+
+ carma%f_inuc2bin(ifrom,igfrom,igto) = 0
+
+ do ibto = carma%f_NBIN,1,-1 ! nucleation target bin
+
+ if( carma%f_group(igto)%f_rmass(ibto) .ge. carma%f_group(igfrom)%f_rmass(ifrom) )then
+ carma%f_inuc2bin(ifrom,igfrom,igto) = ibto
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+
+ ! Mappings for nucleation sources:
+ !
+ ! is the number of particle elements that nucleate to
+ ! particle element .
+ !
+ ! are the particle elements that
+ ! nucleate to particle element , where
+ ! jefrom = 1,nnucelem(ielem).
+ !
+ ! is true if nucleation transfers mass from element
+ ! to element .
+ !
+ ! is the number of particle bins that nucleate
+ ! to particles in bin from group .
+ !
+ ! are the particle bins
+ ! that nucleate to particles in bin , where
+ ! jfrom = 1,nnucbin(igfrom,ibin,igto).
+ !
+ !
+ ! First, calculate and
+ ! based on
+ do iefrom = 1,carma%f_NELEM
+ do ieto = 1,carma%f_NELEM
+ carma%f_if_nuc(iefrom,ieto) = .false.
+ enddo
+ enddo
+
+ do ielem = 1,carma%f_NELEM
+ carma%f_nnuc2elem(ielem) = 0
+
+ do jefrom = 1,carma%f_NGROUP
+ if( carma%f_inuc2elem(jefrom,ielem) .ne. 0 ) then
+ carma%f_nnuc2elem(ielem) = carma%f_nnuc2elem(ielem) + 1
+ carma%f_if_nuc(ielem,carma%f_inuc2elem(jefrom,ielem)) = .true.
+
+
+ ! Also check for cases where neither the source or destinaton don't have cores (e.g.
+ ! melting ice to water drops).
+ if ((carma%f_group(carma%f_element(ielem)%f_igroup)%f_ncore .eq. 0) .and. &
+ (carma%f_group(carma%f_element(carma%f_inuc2elem(jefrom,ielem))%f_igroup)%f_ncore .eq. 0)) then
+
+ ! For particle concentration target elements, only count source elements
+ ! that are also particle concentrations.
+ carma%f_nnucelem(carma%f_inuc2elem(jefrom,ielem)) = carma%f_nnucelem(carma%f_inuc2elem(jefrom,ielem)) + 1
+ carma%f_inucelem(carma%f_nnucelem(carma%f_inuc2elem(jefrom,ielem)),carma%f_inuc2elem(jefrom,ielem)) = ielem
+ end if
+ endif
+ enddo
+ enddo
+
+ ! Next, enumerate and count elements that nucleate to cores.
+ do igroup = 1,carma%f_NGROUP
+
+ ip = carma%f_group(igroup)%f_ienconc ! target particle number concentration element
+
+ do jcore = 1,carma%f_group(igroup)%f_ncore
+
+ iecore = carma%f_group(igroup)%f_icorelem(jcore) ! target core element
+! carma%f_nnucelem(iecore) = 0
+
+ do iefrom = 1,carma%f_NELEM
+
+ if( carma%f_if_nuc(iefrom,iecore) ) then
+ carma%f_nnucelem(iecore) = carma%f_nnucelem(iecore) + 1
+ carma%f_inucelem(carma%f_nnucelem(iecore),iecore) = iefrom
+ endif
+ enddo ! iefrom=1,NELEM
+ enddo ! jcore=1,ncore
+ enddo ! igroup=1,NGROUP
+
+
+ ! Now enumerate and count elements nucleating to particle concentration
+ ! (itype=I_INVOLATILE and itype=I_VOLATILE) and core second moment
+ ! (itype=I_COREMASS). Elements with itype = I_VOLATILE are special because all
+ ! nucleation sources for core elements in same group are also sources
+ ! for the itype = I_VOLATILE element.
+ do igroup = 1,carma%f_NGROUP
+
+ ip = carma%f_group(igroup)%f_ienconc ! target particle number concentration element
+ im = carma%f_group(igroup)%f_imomelem ! target core second moment element
+
+! carma%f_nnucelem(ip) = 0
+! if( im .ne. 0 )then
+! carma%f_nnucelem(im) = 0
+! endif
+
+ do jcore = 1,carma%f_group(igroup)%f_ncore
+
+ iecore = carma%f_group(igroup)%f_icorelem(jcore) ! target core mass element
+
+ do jnucelem = 1,carma%f_nnucelem(iecore) ! elements nucleating to cores
+
+ iefrom = carma%f_inucelem(jnucelem,iecore) ! source
+
+ ! For particle concentration target elements, only count source elements
+ ! that are also particle concentrations.
+ carma%f_nnucelem(ip) = carma%f_nnucelem(ip) + 1
+ carma%f_inucelem(carma%f_nnucelem(ip),ip) = carma%f_group(carma%f_element(iefrom)%f_igroup)%f_ienconc
+
+ if( im .ne. 0 )then
+ carma%f_nnucelem(im) = carma%f_nnucelem(im) + 1
+ carma%f_inucelem(carma%f_nnucelem(im),im) = iefrom
+ endif
+ enddo
+ enddo ! jcore=1,ncore
+ enddo ! igroup=1,NGROUP
+
+
+ ! Now enumerate and count nucleating bins.
+ do igroup = 1,carma%f_NGROUP ! target group
+ do ibin = 1,carma%f_NBIN ! target bin
+ do igfrom = 1,carma%f_NGROUP ! source group
+
+ carma%f_nnucbin(igfrom,ibin,igroup) = 0
+
+ do ifrom = 1,carma%f_NBIN ! source bin
+
+ if( carma%f_inuc2bin(ifrom,igfrom,igroup) .eq. ibin ) then
+ carma%f_nnucbin(igfrom,ibin,igroup) = carma%f_nnucbin(igfrom,ibin,igroup) + 1
+ carma%f_inucbin(carma%f_nnucbin(igfrom,ibin,igroup),igfrom,ibin,igroup) = ifrom
+ endif
+ enddo
+ enddo ! igfrom=1,NGROUP
+ enddo ! ibin=1,NBIN=1,NGROUP
+ enddo ! igroup=1,NGROUP
+
+ if (carma%f_do_print_init) then
+
+ ! Report nucleation mapping arrays (should be 'write' stmts, of course)
+
+ write(carma%f_LUNOPRT,*) ' '
+ write(carma%f_LUNOPRT,*) 'Nucleation mapping arrays (setupnuc):'
+ write(carma%f_LUNOPRT,*) ' '
+ write(carma%f_LUNOPRT,*) 'Elements mapping:'
+
+ do ielem = 1,carma%f_NELEM
+ write(carma%f_LUNOPRT,*) 'ielem,nnucelem=',ielem,carma%f_nnucelem(ielem)
+
+ if(carma%f_nnucelem(ielem) .gt. 0) then
+ do jfrom = 1,carma%f_nnucelem(ielem)
+ write(carma%f_LUNOPRT,*) 'jfrom,inucelem= ',jfrom,carma%f_inucelem(jfrom,ielem)
+ enddo
+ endif
+ enddo
+
+ write(carma%f_LUNOPRT,*) ' '
+ write(carma%f_LUNOPRT,*) 'Bin mapping:'
+
+ do igfrom = 1,carma%f_NGROUP
+ do igroup = 1,carma%f_NGROUP
+ write(carma%f_LUNOPRT,*) ' '
+ write(carma%f_LUNOPRT,*) 'Groups (from, to) = ', igfrom, igroup
+
+ do ibin = 1,carma%f_NBIN
+ nnucb = carma%f_nnucbin(igfrom,ibin,igroup)
+ if(nnucb .eq. 0) write(carma%f_LUNOPRT,*) ' None for bin ',ibin
+ if(nnucb .gt. 0) then
+ write(carma%f_LUNOPRT,*) ' ibin,nnucbin=',ibin,nnucb
+ write(carma%f_LUNOPRT,*) ' inucbin=',(carma%f_inucbin(j,igfrom,ibin,igroup),j=1,nnucb)
+ endif
+ enddo
+ enddo
+ enddo
+ endif
+
+
+ ! Check that values are valid.
+ do ielem = 1, carma%f_NELEM
+
+ if( carma%f_element(ielem)%f_isolute .gt. carma%f_NSOLUTE )then
+ if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - component of isolute > NSOLUTE'
+ rc = RC_ERROR
+ return
+ endif
+
+ if( carma%f_ievp2elem(ielem) .gt. carma%f_NELEM )then
+ if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - component of ievp2elem > NELEM'
+ rc = RC_ERROR
+ return
+ endif
+
+ ! Check that is consistent with .
+ if( carma%f_ievp2elem(ielem) .ne. 0 .and. carma%f_element(ielem)%f_itype .eq. I_COREMASS )then
+ if( carma%f_element(ielem)%f_isolute .ne. carma%f_element(carma%f_ievp2elem(ielem))%f_isolute)then
+ if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - isolute and ievp2elem are inconsistent'
+ rc = RC_ERROR
+ return
+ endif
+ endif
+
+ ! Check that is consistent with .
+! igas = carma%f_inucgas( carma%f_element(ielem)%f_igroup )
+! if( igas .ne. 0 )then
+! if( carma%f_element(ielem)%f_itype .eq. I_COREMASS .and. carma%f_element(ielem)%f_isolute .eq. 0 )then
+! if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - inucgas ne 0 but isolute eq 0'
+! rc = RC_ERROR
+! return
+! endif
+! endif
+ enddo
+
+ do ielem = 1, carma%f_NELEM
+ if( carma%f_nnuc2elem(ielem) .gt. 0 ) then
+ do inuc2 = 1, carma%f_nnuc2elem(ielem)
+ if( carma%f_inuc2elem(inuc2,ielem) .gt. carma%f_NELEM )then
+ if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - component of inuc2elem > NELEM'
+ rc = RC_ERROR
+ return
+ endif
+ enddo
+ endif
+ enddo
+
+ ! Particle grids are incompatible if there is no target bin with enough
+ ! mass to accomodate nucleated particle.
+ bad_grid = .false.
+
+ do iefrom = 1,carma%f_NELEM ! source element
+
+ igfrom = carma%f_element(iefrom)%f_igroup
+ neto = carma%f_nnuc2elem(iefrom)
+
+ if( neto .gt. 0 )then
+
+ do inuc2 = 1,neto
+ ieto = carma%f_inuc2elem(inuc2,iefrom)
+ igto = carma%f_element(ieto)%f_igroup
+
+ do ifrom = 1,carma%f_NBIN ! source bin
+ if( carma%f_inuc2bin(ifrom,igfrom,igto) .eq. 0 )then
+ if ((carma%f_do_print) .and. (carma%f_do_print_init)) write(carma%f_LUNOPRT,7) igfrom,ifrom,igto
+ bad_grid = .true.
+ endif
+ enddo
+ enddo
+ endif
+ enddo
+
+ if (carma%f_do_print_init) then
+
+ if( bad_grid )then
+ if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::Warning - incompatible grids for nucleation'
+ endif
+
+ ! Report some initialization values!
+ write(carma%f_LUNOPRT,5)
+ write(carma%f_LUNOPRT,1) 'inucgas ',(carma%f_inucgas(i),i=1,carma%f_NGROUP)
+ write(carma%f_LUNOPRT,1) 'inuc2elem',(carma%f_inuc2elem(1,i),i=1,carma%f_NELEM)
+ write(carma%f_LUNOPRT,1) 'ievp2elem',(carma%f_ievp2elem(i),i=1,carma%f_NELEM)
+ write(carma%f_LUNOPRT,1) 'isolute ',(carma%f_element(i)%f_isolute,i=1,carma%f_NELEM)
+
+ do isol = 1,carma%f_NSOLUTE
+ write(carma%f_LUNOPRT,2) 'solute number ',isol
+ write(carma%f_LUNOPRT,3) 'solute name: ',carma%f_solute(isol)%f_name
+ write(carma%f_LUNOPRT,4) 'molecular weight',carma%f_solute(isol)%f_wtmol
+ write(carma%f_LUNOPRT,4) 'mass density ',carma%f_solute(isol)%f_rho
+ enddo
+ endif
+
+
+ ! Initialize indexes for the gases and check to make sure if H2SO4 is used
+ ! that it occurs after H2O. This is necessary for supersaturation calculations.
+ carma%f_igash2o = 0
+ carma%f_igash2so4 = 0
+ carma%f_igasso2 = 0
+
+ do igas = 1, carma%f_NGAS
+ if (carma%f_gas(igas)%f_icomposition == I_GCOMP_H2O) then
+ carma%f_igash2o = igas
+ else if (carma%f_gas(igas)%f_icomposition == I_GCOMP_H2SO4) then
+ carma%f_igash2so4 = igas
+ else if (carma%f_gas(igas)%f_icomposition == I_GCOMP_SO2) then
+ carma%f_igasso2 = igas
+ end if
+ end do
+
+ if ((carma%f_igash2so4 /= 0) .and. (carma%f_igash2o > carma%f_igash2so4)) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT,*) 'CARMA_InitializeGrowth::ERROR - H2O gas must come before H2SO4.'
+ rc = RC_ERROR
+ return
+ end if
+
+ return
+ end subroutine CARMA_InitializeGrowth
+
+ !! Calculate the optical properties for each particle bin at each of
+ !! the specified wavelengths. The optical properties include the
+ !! extinction efficiency, the single scattering albedo and the
+ !! asymmetry factor.
+ !!
+ !! NOTE: For these calculations, the particles are assumed to be spheres and
+ !! Mie code is used to calculate the optical properties.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ subroutine CARMA_InitializeOptics(carma, rc)
+ type(carma_type), intent(inout) :: carma
+ integer, intent(out) :: rc
+
+ integer :: igroup ! group index
+ integer :: iwave ! wavelength index
+ integer :: ibin ! bin index
+ real(kind=f) :: Qext
+ real(kind=f) :: Qsca
+ real(kind=f) :: asym
+
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Were any wavelengths specified?
+ do iwave = 1, carma%f_NWAVE
+ do igroup = 1, carma%f_NGROUP
+
+ ! Should we calculate mie properties for this group?
+ if (carma%f_group(igroup)%f_do_mie) then
+
+ do ibin = 1, carma%f_NBIN
+
+ ! Assume the particle is homogeneous (no core).
+ !
+ ! NOTE: The miess does not converge over as broad a
+ ! range of input parameters as bhmie, but it can handle
+ ! coated spheres.
+
+ call mie(carma, &
+ carma%f_group(igroup)%f_imiertn, &
+ carma%f_group(igroup)%f_r(ibin), &
+ carma%f_wave(iwave), &
+ carma%f_group(igroup)%f_nmon(ibin), &
+ carma%f_group(igroup)%f_df(ibin), &
+ carma%f_group(igroup)%f_rmon, &
+ carma%f_group(igroup)%f_falpha, &
+ carma%f_group(igroup)%f_refidx(iwave), &
+ Qext, &
+ Qsca, &
+ asym, &
+ rc)
+
+ if (rc < RC_OK) then
+ if (carma%f_do_print) then
+ write(carma%f_LUNOPRT, *) "CARMA_InitializeOptics::&
+ &Mie failed for (band, wavelength, group, bin)", &
+ iwave, carma%f_wave(iwave), igroup, ibin
+ end if
+ return
+ end if
+
+ carma%f_group(igroup)%f_qext(iwave, ibin) = Qext
+ carma%f_group(igroup)%f_ssa(iwave, ibin) = Qsca / Qext
+ carma%f_group(igroup)%f_asym(iwave, ibin) = asym
+
+ end do
+ end if
+ end do
+ end do
+
+ return
+ end subroutine CARMA_InitializeOptics
+
+ !! Perform initialization of variables related to thermodynamical calculations that
+ !! are not dependent on the model state.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ subroutine CARMA_InitializeThermo(carma, rc)
+ type(carma_type), intent(inout) :: carma
+ integer, intent(out) :: rc
+
+ ! Assume success.
+ rc = RC_OK
+
+ return
+ end subroutine CARMA_InitializeThermo
+
+ !! Perform initialization of variables related to vertical transport that are not dependent
+ !! on the model state.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ subroutine CARMA_InitializeVertical(carma, rc, vf_const)
+ type(carma_type), intent(inout) :: carma
+ integer, intent(out) :: rc
+ real(kind=f), intent(in), optional :: vf_const
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Was a constant vertical velocity specified?
+ carma%f_ifall = 1
+ carma%f_vf_const = 0._f
+
+ if (present(vf_const)) then
+ if (vf_const /= 0._f) then
+ carma%f_ifall = 0
+ carma%f_vf_const = vf_const
+ end if
+ end if
+
+ ! Specify the boundary conditions for vertical transport.
+ carma%f_itbnd_pc = I_FIXED_CONC
+ carma%f_ibbnd_pc = I_FIXED_CONC
+
+ return
+ end subroutine CARMA_InitializeVertical
+
+ !! The routine should be called when the carma object is no longer needed. It deallocates
+ !! any memory allocations made by CARMA (during CARMA_Create()), and failure to call this
+ !!routine could result in memory leaks.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMA_Create
+ subroutine CARMA_Destroy(carma, rc)
+ use carmaelement_mod
+ use carmagas_mod
+ use carmagroup_mod
+ use carmasolute_mod
+
+ type(carma_type), intent(inout) :: carma
+ integer, intent(out) :: rc
+
+ ! Local variables
+ integer :: ier
+ integer :: igroup
+ integer :: ielem
+ integer :: isolute
+ integer :: igas
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! If allocated, deallocate all the variables that were allocated in the Create() method.
+ if (allocated(carma%f_group)) then
+ do igroup = 1, carma%f_NGROUP
+ call CARMAGROUP_Destroy(carma, igroup, rc)
+ if (rc < 0) return
+ end do
+
+ deallocate( &
+ carma%f_group, &
+ carma%f_icoag, &
+ carma%f_inucgas, &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating groups, status=", ier
+ rc = RC_ERROR
+ endif
+ endif
+
+ if (allocated(carma%f_element)) then
+ do ielem = 1, carma%f_NELEM
+ call CARMAELEMENT_Destroy(carma, ielem, rc)
+ if (rc < RC_OK) return
+ end do
+
+ deallocate( &
+ carma%f_element, &
+ carma%f_igrowgas, &
+ carma%f_inuc2elem, &
+ carma%f_inucproc, &
+ carma%f_ievp2elem, &
+ carma%f_nnuc2elem, &
+ carma%f_nnucelem, &
+ carma%f_inucelem, &
+ carma%f_if_nuc, &
+ carma%f_rlh_nuc, &
+ carma%f_icoagelem, &
+ carma%f_icoagelem_cm, &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating elements, status=", ier
+ rc = RC_ERROR
+ endif
+ endif
+
+ if (allocated(carma%f_inuc2bin)) then
+ deallocate( &
+ carma%f_inuc2bin, &
+ carma%f_ievp2bin, &
+ carma%f_nnucbin, &
+ carma%f_inucbin, &
+ carma%f_diffmass, &
+ carma%f_volx, &
+ carma%f_ilow, &
+ carma%f_jlow, &
+ carma%f_iup, &
+ carma%f_jup, &
+ carma%f_npairl, &
+ carma%f_npairu, &
+ carma%f_iglow, &
+ carma%f_jglow, &
+ carma%f_igup, &
+ carma%f_jgup, &
+ carma%f_kbin, &
+ carma%f_pkernel, &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating bins, status=", ier
+ rc = RC_ERROR
+ endif
+ endif
+
+ if (carma%f_NSOLUTE > 0) then
+ do isolute = 1, carma%f_NSOLUTE
+ call CARMASOLUTE_Destroy(carma, isolute, rc)
+ if (rc < RC_OK) return
+ end do
+
+ if (allocated(carma%f_solute)) then
+ deallocate( &
+ carma%f_solute, &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating solutes, status=", ier
+ rc = RC_ERROR
+ endif
+ endif
+ end if
+
+ if (carma%f_NGAS > 0) then
+ do igas = 1, carma%f_NGAS
+ call CARMAGAS_Destroy(carma, igas, rc)
+ if (rc < RC_OK) return
+ end do
+
+ if (allocated(carma%f_gas)) then
+ deallocate( &
+ carma%f_gas, &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating gases, status=", ier
+ rc = RC_ERROR
+ endif
+ endif
+ end if
+
+ if (carma%f_NWAVE > 0) then
+ if (allocated(carma%f_wave)) then
+ deallocate( &
+ carma%f_wave, &
+ carma%f_dwave, &
+ carma%f_do_wave_emit, &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_Destroy: ERROR deallocating wavelengths, status=", ier
+ rc = RC_ERROR
+ return
+ endif
+ endif
+ endif
+
+ return
+ end subroutine CARMA_Destroy
+
+ ! Configuration
+
+ !! Add a coagulation process between two groups (igroup1 and igroup2), with the resulting
+ !! particle being in the destination group (igroup3). If ck0 is specifed, then a constant
+ !! coagulation kernel will be used.
+ subroutine CARMA_AddCoagulation(carma, igroup1, igroup2, igroup3, icollec, rc, ck0, grav_e_coll0)
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: igroup1 !! first source group
+ integer, intent(in) :: igroup2 !! second source group
+ integer, intent(in) :: igroup3 !! destination group
+ integer, intent(in) :: icollec !! collection technique [I_COLLEC_CONST | I_COLLEC_FUCHS | I_COLLEC_DATA]
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ real(kind=f), intent(in), optional :: ck0 !! if specified, forces a constant coagulation kernel
+ real(kind=f), intent(in), optional :: grav_e_coll0 !! if icollec is I_COLLEC_CONST
+ !! the constant gravitational collection efficiency
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure the groups exists.
+ if (igroup1 > carma%f_NGROUP) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed group (", &
+ igroup1, ") is larger than the number of groups (", carma%f_NGROUP, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ if (igroup2 > carma%f_NGROUP) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed group (", &
+ igroup2, ") is larger than the number of groups (", carma%f_NGROUP, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ if (igroup3 > carma%f_NGROUP) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed group (", &
+ igroup3, ") is larger than the number of groups (", carma%f_NGROUP, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Indicate that the groups coagulate together.
+ carma%f_icoag(igroup1, igroup2) = igroup3
+
+ ! If ck0 was specified, then we use a fixed coagulation rate of ck0.
+ if (present(ck0)) then
+ carma%f_ck0 = ck0
+ carma%f_icoagop = I_COAGOP_CONST
+ else
+ carma%f_icoagop = I_COAGOP_CALC
+ end if
+
+ ! What collection technique is specified.
+ if (icollec > I_COLLEC_DATA) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, '(a,i3,a)') "CARMA_AddCoagulation:: ERROR - The specifed collection method (", &
+ icollec, ") is unknown."
+ rc = RC_ERROR
+ return
+ end if
+
+ if (icollec == I_COLLEC_CONST) then
+ if (present(grav_e_coll0)) then
+ carma%f_grav_e_coll0 = grav_e_coll0
+ else
+ if (carma%f_do_print) then
+ write(carma%f_LUNOPRT, *) "CARMA_AddCoagulation::&
+ &ERROR - A constant gravitational collection was requests, &
+ &but grav_e_coll0 was not provided."
+ end if
+ rc = RC_ERROR
+ return
+ end if
+ end if
+
+ carma%f_icollec = icollec
+
+ return
+ end subroutine CARMA_AddCoagulation
+
+ !! Add a growth process between the element (ielem) and gas (igas) specifed. The element
+ !! and gas should have already been defined using CARMA_AddElement() and CARMA_AddGas().
+ !!
+ !! NOTE: Each element can only have one volatile component.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMA_AddElement
+ !! @see CARMA_AddGas
+ subroutine CARMA_AddGrowth(carma, ielem, igas, rc)
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: ielem !! the element index
+ integer, intent(in) :: igas !! the gas index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure the element exists.
+ if (ielem > carma%f_NELEM) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddGrowth:: ERROR - The specifed element (", &
+ ielem, ") is larger than the number of elements (", carma%f_NELEM, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Make sure there are enough gases allocated.
+ if (igas > carma%f_NGAS) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddGrowth:: ERROR - The specifed gas (", &
+ igas, ") is larger than the number of gases (", carma%f_NGAS, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! If not already defined, indicate that the element can grow with the specified gas.
+ if (carma%f_igrowgas(ielem) /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddGrowth:: ERROR - The specifed element (", &
+ ielem, ") already has gas (", carma%f_igrowgas(ielem), ") condensing on it."
+ rc = RC_ERROR
+ return
+ else
+ carma%f_igrowgas(ielem) = igas
+ end if
+
+ return
+ end subroutine CARMA_AddGrowth
+
+ !! Add a nucleation process that nucleates one element (elemfrom) to another element (elemto)
+ !! using the specified gas (igas). The elements and gas should have already been defined
+ !! using CARMA_AddElement() and CARMA_AddGas(). The nucleation scheme is indicated by
+ !! inucproc, and can be one of:
+ !!
+ !! - I_DROPACT
+ !! - I_AERFREEZE
+ !! - I_DROPFREEZE
+ !! - I_ICEMELT
+ !! - I_HETNUC
+ !! - I_HOMNUC
+ !!
+ !! There are multiple parameterizations for I_AERFREEZE, so when that is selected the
+ !! particular parameterization needs to be indicated by adding it to I_AERFREEZE. The
+ !! specific routines are:
+ !!
+ !! - I_AF_TABAZADEH_2000
+ !! - I_AF_KOOP_2000
+ !! - I_AF_MOHLER_2010
+ !! - I_AF_MURRAY_2010
+ !!
+ !! One or more of these routines may be selected, but in general one of the first
+ !! three should be selected and then it can optionally be combined with the glassy
+ !! aerosols (I_AF_MURRAY_2010).
+ !!
+ !! Total evaporation transfers particle mass from the destination element back to the
+ !! element indicated by ievp2elem. This relationship is not automatically generated,
+ !! because multiple elements can nucleate to a particular element and therefore the
+ !! reverse mapping is not unique.
+ !!
+ !! NOTE: The gas used for nucleation must be the same for all nucleation defined from
+ !! elements of the same group.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ !! @see I_DROPACT
+ !! @see I_AERFREEZE
+ !! @see I_DROPFREEZE
+ !! @see I_ICEMELT
+ !! @see I_HETNUC
+ !! @see I_HOMNUC
+ !! @see I_AF_TABAZADEH_2000
+ !! @see I_AF_KOOP_2000
+ !! @see I_AF_MOHLER_2010
+ !! @see I_AF_MURRAY_2010
+ !! @see CARMA_AddElement
+ !! @see CARMA_AddGas
+ subroutine CARMA_AddNucleation(carma, ielemfrom, ielemto, inucproc, &
+ rlh_nuc, rc, igas, ievp2elem)
+
+ use carmaelement_mod, only : CARMAELEMENT_Get
+
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: ielemfrom !! the source element
+ integer, intent(in) :: ielemto !! the destination element
+ integer, intent(in) :: inucproc !! the nucleation process
+ !! [I_DROPACT | I_AERFREEZE | I_ICEMELT | I_HETNUC | I_HOMNUC]
+ real(kind=f), intent(in) :: rlh_nuc !! the latent heat of nucleation [cm2/s2]
+ integer, intent(out) :: rc !! return code, negative indicated failure
+ integer, optional, intent(in) :: igas !! the gas
+ integer, optional, intent(in) :: ievp2elem !! the element created upon evaporation
+
+ integer :: igroup !! group for source element
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure the elements exist.
+ if (ielemfrom > carma%f_NELEM) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed element (", &
+ ielemfrom, ") is larger than the number of elements (", carma%f_NELEM, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ if (ielemto > carma%f_NELEM) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed element (", &
+ ielemto, ") is larger than the number of elements (", carma%f_NELEM, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ if (present(ievp2elem)) then
+ if (ievp2elem > carma%f_NELEM) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed element (", &
+ ievp2elem, ") is larger than the number of elements (", carma%f_NELEM, ")."
+ rc = RC_ERROR
+ return
+ end if
+ end if
+
+
+ ! Make sure there are enough gases allocated.
+ if (present(igas)) then
+ if (igas > carma%f_NGAS) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMA_AddNucleation:: ERROR - The specifed gas (", &
+ igas, ") is larger than the number of gases (", carma%f_NGAS, ")."
+ rc = RC_ERROR
+ return
+ end if
+ end if
+
+
+ ! If aerosol freezing is selected, but no I_AF_xxx sub-method is selected, then indicate an error.
+ if (inucproc == I_AERFREEZE) then
+ if (carma%f_do_print) then
+ write(carma%f_LUNOPRT, *) "CARMA_AddNucleation::&
+ &ERROR - I_AERFREEZE was specified without an I_AF_xxx value."
+ end if
+ return
+ end if
+
+
+ ! Array maps a particle group to its associated gas for nucleation:
+ ! Nucleation from group is associated with gas
+ ! Set to zero if particles are not subject to nucleation.
+ if (present(igas)) then
+ call CARMAELEMENT_Get(carma, ielemfrom, rc, igroup=igroup)
+
+ if (rc >= RC_OK) then
+ carma%f_inucgas(igroup) = igas
+ end if
+ end if
+
+
+ ! Nucleation transfers particle mass from element to element
+ ! , where ranges from 0 to the number of elements
+ ! nucleating from .
+! carma%f_nnucelem(ielemto) = carma%f_nnucelem(ielemto) + 1
+! carma%f_inucelem(carma%f_nnucelem(ielemto), ielemto) = ielemfrom
+ carma%f_nnuc2elem(ielemfrom) = carma%f_nnuc2elem(ielemfrom) + 1
+ carma%f_inuc2elem(carma%f_nnuc2elem(ielemfrom), ielemfrom) = ielemto
+! carma%f_if_nuc(ielemfrom,carma%f_inuc2elem(carma%f_nnuc2elem(ielemfrom), ielemfrom)) = .true.
+
+ ! specifies what nucleation process nucleates
+ ! particles from element to element :
+ ! I_DROPACT: Aerosol activation to droplets
+ ! I_AERFREEZE: Aerosol homogeneous freezing
+ ! I_DROPFREEZE: Droplet homogeneous freezing
+ ! I_GLFREEZE: Glassy Aerosol heteroogeneous freezing
+ ! I_GLAERFREEZE: Glassy & Aerosol freezing
+ carma%f_inucproc(ielemfrom, ielemto) = inucproc
+
+
+ ! Total evaporation mapping: total evaporation transfers particle mass from
+ ! element to element .
+ !
+ ! NOTE: This array is not automatically derived from because multiple
+ ! elements can nucleate to a particular element (reverse mapping is not
+ ! unique).
+ if (present(ievp2elem)) carma%f_ievp2elem(ielemto) = ievp2elem
+
+
+ ! is the latent heat released by nucleation
+ ! from element to element [cm^2/s^2].
+ carma%f_rlh_nuc(ielemfrom,ielemto) = rlh_nuc
+
+ return
+ end subroutine
+
+
+ ! Query, Control and State I/O
+
+ !! Gets the information about the carma object.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMA_Create
+ subroutine CARMA_Get(carma, rc, LUNOPRT, NBIN, NELEM, NGAS, NGROUP, NSOLUTE, NWAVE, do_detrain, &
+ do_drydep, do_fixedinit, do_grow, do_print, do_print_init, do_thermo, wave, dwave, do_wave_emit, &
+ do_partialinit)
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ integer, optional, intent(out) :: NBIN !! number of radius bins per group
+ integer, optional, intent(out) :: NELEM !! total number of elements
+ integer, optional, intent(out) :: NGROUP !! total number of groups
+ integer, optional, intent(out) :: NSOLUTE !! total number of solutes
+ integer, optional, intent(out) :: NGAS !! total number of gases
+ integer, optional, intent(out) :: NWAVE !! number of wavelengths
+ integer, optional, intent(out) :: LUNOPRT !! logical unit number for output
+ logical, optional, intent(out) :: do_detrain !! do detrainement?
+ logical, optional, intent(out) :: do_drydep !! do dry deposition?
+ logical, optional, intent(out) :: do_fixedinit !! do initialization from reference atm?
+ logical, optional, intent(out) :: do_grow !! do condensational growth?
+ logical, optional, intent(out) :: do_partialinit !! do initialization of coagulation from reference atm?
+ logical, optional, intent(out) :: do_print !! do print output?
+ logical, optional, intent(out) :: do_print_init !! do print initialization output?
+ logical, optional, intent(out) :: do_thermo !! do thermodynamics?
+ real(kind=f), optional, intent(out) :: wave(carma%f_NWAVE) !! the wavelengths centers (cm)
+ real(kind=f), optional, intent(out) :: dwave(carma%f_NWAVE) !! the wavelengths widths (cm)
+ logical, optional, intent(out) :: do_wave_emit(carma%f_NWAVE) !! do emission in this band?
+
+ ! Assume success.
+ rc = RC_OK
+
+ if (present(LUNOPRT)) LUNOPRT = carma%f_LUNOPRT
+ if (present(NBIN)) NBIN = carma%f_NBIN
+ if (present(NELEM)) NELEM = carma%f_NELEM
+ if (present(NGAS)) NGAS = carma%f_NGAS
+ if (present(NGROUP)) NGROUP = carma%f_NGROUP
+ if (present(NSOLUTE)) NSOLUTE = carma%f_NSOLUTE
+ if (present(NWAVE)) NWAVE = carma%f_NWAVE
+
+ if (present(do_detrain)) do_detrain = carma%f_do_detrain
+ if (present(do_drydep)) do_drydep = carma%f_do_drydep
+ if (present(do_grow)) do_grow = carma%f_do_grow
+ if (present(do_fixedinit)) do_fixedinit = carma%f_do_fixedinit
+ if (present(do_partialinit)) do_partialinit = carma%f_do_partialinit
+ if (present(do_print)) do_print = carma%f_do_print
+ if (present(do_print_init)) do_print_init = carma%f_do_print_init
+ if (present(do_thermo)) do_thermo = carma%f_do_thermo
+
+ if (present(wave)) wave(:) = carma%f_wave(:)
+ if (present(dwave)) dwave(:) = carma%f_dwave(:)
+ if (present(do_wave_emit)) do_wave_emit(:) = carma%f_do_wave_emit(:)
+
+ return
+ end subroutine CARMA_Get
+
+end module
diff --git a/src/physics/carma/base/carma_precision_mod.F90 b/src/physics/carma/base/carma_precision_mod.F90
new file mode 100644
index 0000000000..a8835982c7
--- /dev/null
+++ b/src/physics/carma/base/carma_precision_mod.F90
@@ -0,0 +1,47 @@
+module carma_precision_mod
+
+ implicit none
+
+#ifdef SINGLE
+
+ ! For floats commonly referred to as 'real'
+ ! -at least 6 places of precision past the decimal
+ ! -must span at least 10**(-37) to 10**(37)
+ integer, parameter :: f = selected_real_kind(6,37)
+ real(kind=f), parameter :: powmax = 85._f
+
+#else
+
+ ! For floats commonly referred to as 'double precision'
+ ! -at least 15 places of precision past the decimal
+ ! -must span at least 10**(-307) to 10**(307)
+
+ integer, parameter :: f = selected_real_kind(15,307)
+ real(kind=f), parameter :: powmax = 706._f
+
+#endif
+
+ ! Precision control strategy
+ ! JAS CU-Boulder June 8, 2006
+ !
+ ! I imagine using these statements bracketed with some CPP statements
+ ! to control the overall precision of a model. All variables would be
+ ! declared as real(f). All physical constants would have a
+ ! a suffix of _f, e.g. 2._f, to force them into the proper precision.
+ !
+ ! I do wonder if it would be more accurate to declare variables as
+ ! real( kind=f ), but real(f) is how Chivers and Sleightholme
+ ! declare in their F90 text.
+ !
+ ! Both real(f) and real( kind=f ) seem to work, but I'm more comfortable
+ ! with real( kind=f ), so I'm using that in all declarations.
+
+ !--
+ ! Numerical constants
+ !! Define 1 in the specified precision.
+ real(kind=f), parameter :: ONE = 1._f
+
+ !! Define smallest possible number such that ONE + ALMOST_ZERO > ONE
+ real(kind=f), parameter :: ALMOST_ZERO = epsilon( ONE )
+ real(kind=f), parameter :: ALMOST_ONE = ONE - ALMOST_ZERO
+end module
diff --git a/src/physics/carma/base/carma_types_mod.F90 b/src/physics/carma/base/carma_types_mod.F90
new file mode 100644
index 0000000000..d264e627a8
--- /dev/null
+++ b/src/physics/carma/base/carma_types_mod.F90
@@ -0,0 +1,820 @@
+!! This module defines types used in the CARMA module. The types need to be defined here
+!! to avoid circular references between different modules (e.g. carma_mod and
+!! carmastate_mod).
+!!
+!! NOTE: All the field members are prefixed by f_. This is done because of the macros that
+!! are used to map between the older F77 common block names for variables to the newer F90
+!! structure member names for the fields. This is done in carma_globaer.h to keep the core
+!! CARMA code looking similar to the F77 code to make it easier for scientists with CARMA
+!! experience to port their code. Some compilers (e.g Portland Group) have preprocessors
+!! that will fail to handle the macros in carma_globaer.h properly resulting in recursion
+!! errors during compiling. By making the field member name different, the recursion
+!! problems should be avoided.
+!!
+!! @version July-2009
+!! @author Chuck Bardeen
+module carma_types_mod
+ use carma_precision_mod
+ use carma_constants_mod
+
+ !! The CARMAELEMENT data type represents one of the components of a cloud or aerosol particle.
+ !!
+ !! The procedure for adding a variable to the CARMAELEMENT data type is:
+ !! - Add the variable as a scalar or allocatable in the type definition.
+ !! - If the new variable is dynamic,
+ !! - Allocate the variable in the appropriate create or initialization routine.
+ !! - Deallocate the variable in the approprate finalize and destroy routines.
+ !! - Add an alias for the variable to carma_globaer.h and associate it with the variable
+ !! in this typedef.
+ !!
+ !! NOTE: While the carmaelement_type is public, routines outside of the CARMA module should not look
+ !! at or manuipulate fields of this structure directly. There should be CARMAELEMENT_XXX methods
+ !! to do anything that is needed with this structure, and use of these methods will allow
+ !! the CARMAELEMENT data type structure to evolve without impacting code in the parent model.
+ !! The contents of the structure had to be made public, since the CARMA microphysics
+ !! routines are implemented in separate files outside of this model; however, logically
+ !! they are part of the model and are the only routines outside of this module that should
+ !! access fields of this structure directly.
+ type, public :: carmaelement_type
+
+ ! name Name of the element
+ ! shortname Short name of the element
+ ! rho Mass density of particle element [g/cm^3]
+ ! igroup Group to which the element belongs
+ ! itype Particle type specification
+ ! icomposition Particle compound specification
+ ! isolute Index of solute for the particle element
+ !
+ character(len=CARMA_NAME_LEN) :: f_name
+ character(len=CARMA_SHORT_NAME_LEN) :: f_shortname
+ real(kind=f), allocatable, dimension(:) :: f_rho ! (NBIN)
+ integer :: f_igroup
+ integer :: f_itype
+ integer :: f_icomposition
+ integer :: f_isolute
+ end type carmaelement_type
+
+
+ !! The CARMAGAS data type represents a gas.
+ !!
+ !! The procedure for adding a variable to the CARMAGAS data type is:
+ !! - Add the variable as a scalar or allocatable in the type definition.
+ !! - If the new variable is dynamic,
+ !! - Allocate the variable in the appropriate create or initialization routine.
+ !! - Deallocate the variable in the approprate finalize and destroy routines.
+ !! - Add an alias for the variable to carma_globaer.h and associate it with the variable
+ !! in this typedef.
+ !!
+ !! NOTE: While the carmagas_type is public, routines outside of the CARMA module should not look
+ !! at or manuipulate fields of this structure directly. There should be CARMAGAS_XXX methods
+ !! to do anything that is needed with this structure, and use of these methods will allow
+ !! the CARMAGAS data type structure to evolve without impacting code in the parent model.
+ !! The contents of the structure had to be made public, since the CARMA microphysics
+ !! routines are implemented in separate files outside of this model; however, logically
+ !! they are part of the model and are the only routines outside of this module that should
+ !! access fields of this structure directly.
+ type, public :: carmagas_type
+
+ ! name Name of the gas
+ ! shortname Short name of the gas
+ ! wtmol Molecular weight for the gas [g/mol]
+ ! ivaprtn vapor pressure routine for the gas
+ ! dgc_threshold convergence criteria for gas concentration [fraction]
+ ! ds_threshold convergence criteria for gas saturation [fraction]
+ !
+ character(len=CARMA_NAME_LEN) :: f_name
+ character(len=CARMA_SHORT_NAME_LEN) :: f_shortname
+ real(kind=f) :: f_wtmol
+ integer :: f_ivaprtn
+ integer :: f_icomposition
+ real(kind=f) :: f_dgc_threshold
+ real(kind=f) :: f_ds_threshold
+ end type carmagas_type
+
+
+ !! The CARMAGROUP data type represents a cloud or aerosol partcile.
+ !!
+ !! The procedure for adding a variable to the CARMAGROUP data type is:
+ !! - Add the variable as a scalar or allocatable in the type definition.
+ !! - If the new variable is dynamic,
+ !! - Allocate the variable in the appropriate create or initialization routine.
+ !! - Deallocate the variable in the approprate finalize and destroy routines.
+ !! - Add an alias for the variable to carma_globaer.h and associate it with the variable
+ !! in this typedef.
+ !!
+ !! NOTE: While the carmagroup_type is public, routines outside of the CARMA module should not look
+ !! at or manuipulate fields of this structure directly. There should be CARMAGROUP_XXX methods
+ !! to do anything that is needed with this structure, and use of these methods will allow
+ !! the CARMAGROUP data type structure to evolve without impacting code in the parent model.
+ !! The contents of the structure had to be made public, since the CARMA microphysics
+ !! routines are implemented in separate files outside of this model; however, logically
+ !! they are part of the model and are the only routines outside of this module that should
+ !! access fields of this structure directly.
+ type, public :: carmagroup_type
+
+ ! name Name of the particle
+ ! shortname Short name of the particle
+ ! cnsttype constituent type [I_CNSTTYPE_PROGNOSTIC | I_CNSTTYPE_DIAGNOSTIC]
+ ! maxbin the last prognostic bin in the group
+ ! nelem Number of elements in group
+ ! ncore Number of core elements (itype = 2) in group
+ ! ishape Describes particle shape for group
+ ! ienconc Particle number conc. element for group
+ ! imomelem Scondary moment element for group
+ ! icorelem Core elements (itype = 2) in group
+ ! solfac Solubility factor for wet deposition
+ ! is_fractal If .true. then particle is fractal
+ ! is_ice If .true. then ice particle
+ ! is_cloud If .true. then cloud particle
+ ! is_sulfate If .true. then sulfate particle
+ ! do_mie If .true. then do mie calculations
+ ! do_wetdep If .true. then do wet deposition
+ ! grp_do_drydep If .true. then do dry deposition
+ ! grp_do_vtran If .true. then do sedimentation
+ ! scavcoef Scavenging coefficient for wet deopistion (1/mm)
+ ! if_sec_mom If .true. then core second moment (itype = 3) used {setupgrow}
+ ! irhswell Indicates method for swelling particles from RH
+ ! irhswcomp Indicates composition for swelling particles from RH
+ ! rmin Radius of particle in first bin [cm]
+ ! rmassmin Mass of particle in first bin [g]
+ ! rmrat Ratio of masses of particles in consecutive bins
+ ! eshape Ratio of particle length / diameter
+ ! r Radius bins [cm]
+ ! rmass Mass bins [g]
+ ! rrat Ratio of maximum diameter to diameter of equivalent sphere
+ ! rprat Ratio of mobility diameter of a porous particle to diameter of equivlent sphere
+ ! arat Ratio of projected area to projected area of containing sphere
+ ! vol Particle volume [cm^3]
+ ! dr Width of bins in radius space [cm]
+ ! dm Width of bins in mass space [g]
+ ! rmassup Upper bin boundary mass [g]
+ ! rup Upper bin boundary radius [cm]
+ ! rlow Lower bin boundary radius [cm]
+ ! refidx refractive index
+ ! qext extinction efficiency
+ ! ssa single scattering albedo
+ ! asym asymmetry factor
+ ! ifallrtn routine to use to calculate fall velocity [I_FALLRTN_...]
+ ! imiertn mie routine for optical properties [I_MIERTN_...]
+ ! dpc_threshold convergence criteria for particle concentration [fraction]
+ ! rmon monomer radius of fractal particles [cm]
+ ! df fractal dimension for fractal particles
+ ! nmon number of monomers per particle
+ ! falpha fractal packing coefficient
+ ! neutral_volfrc volume fraction of core mass to neutralize the particle
+
+ character(len=CARMA_NAME_LEN) :: f_name
+ character(len=CARMA_SHORT_NAME_LEN) :: f_shortname
+ integer :: f_cnsttype
+ integer :: f_maxbin
+ integer :: f_nelem
+ integer :: f_ncore
+ integer :: f_ishape
+ integer :: f_ienconc
+ integer :: f_imomelem
+ real(kind=f) :: f_solfac
+ real(kind=f) :: f_scavcoef
+ logical :: f_if_sec_mom
+ logical :: f_is_fractal
+ logical :: f_is_ice
+ logical :: f_is_cloud
+ logical :: f_is_sulfate
+ logical :: f_do_mie
+ logical :: f_do_wetdep
+ logical :: f_grp_do_drydep
+ logical :: f_grp_do_vtran
+ integer :: f_irhswell
+ integer :: f_irhswcomp
+ integer :: f_ifallrtn
+ integer :: f_imiertn
+ real(kind=f) :: f_rmin
+ real(kind=f) :: f_rmassmin
+ real(kind=f) :: f_rmrat
+ real(kind=f) :: f_eshape
+ real(kind=f), allocatable, dimension(:) :: f_r ! (NBIN)
+ real(kind=f), allocatable, dimension(:) :: f_rmass ! (NBIN)
+ real(kind=f), allocatable, dimension(:) :: f_vol ! (NBIN)
+ real(kind=f), allocatable, dimension(:) :: f_dr ! (NBIN)
+ real(kind=f), allocatable, dimension(:) :: f_dm ! (NBIN)
+ real(kind=f), allocatable, dimension(:) :: f_rmassup ! (NBIN)
+ real(kind=f), allocatable, dimension(:) :: f_rup ! (NBIN)
+ real(kind=f), allocatable, dimension(:) :: f_rlow ! (NBIN)
+ complex(kind=f), allocatable, dimension(:) :: f_refidx ! (NWAVE)
+ real(kind=f), allocatable, dimension(:,:) :: f_qext ! (NWAVE,NBIN)
+ real(kind=f), allocatable, dimension(:,:) :: f_ssa ! (NWAVE,NBIN)
+ real(kind=f), allocatable, dimension(:,:) :: f_asym ! (NWAVE,NBIN)
+ integer, allocatable, dimension(:) :: f_icorelem ! (NELEM)
+ real(kind=f), allocatable, dimension(:) :: f_arat ! (NBIN)
+ real(kind=f), allocatable, dimension(:) :: f_rrat ! (NBIN)
+ real(kind=f), allocatable, dimension(:) :: f_rprat ! (NBIN)
+ real(kind=f) :: f_dpc_threshold
+ real(kind=f) :: f_rmon
+ real(kind=f), allocatable, dimension(:) :: f_df ! (NBIN)
+ real(kind=f), allocatable, dimension(:) :: f_nmon ! (NBIN)
+ real(kind=f) :: f_falpha
+ real(kind=f) :: f_neutral_volfrc
+ end type carmagroup_type
+
+
+ !! The CARMASOLUTE data type represents a gas.
+ !!
+ !! The procedure for adding a variable to the CARMASOLUTE data type is:
+ !! - Add the variable as a scalar or allocatable in the type definition.
+ !! - If the new variable is dynamic,
+ !! - Allocate the variable in the appropriate create or initialization routine.
+ !! - Deallocate the variable in the approprate finalize and destroy routines.
+ !! - Add an alias for the variable to carma_globaer.h and associate it with the variable
+ !! in this typedef.
+ !!
+ !! NOTE: While the carmagas_type is public, routines outside of the CARMA module should not look
+ !! at or manuipulate fields of this structure directly. There should be CARMASOLUTE_XXX methods
+ !! to do anything that is needed with this structure, and use of these methods will allow
+ !! the CARMASOLUTE data type structure to evolve without impacting code in the parent model.
+ !! The contents of the structure had to be made public, since the CARMA microphysics
+ !! routines are implemented in separate files outside of this model; however, logically
+ !! they are part of the model and are the only routines outside of this module that should
+ !! access fields of this structure directly.
+ type, public :: carmasolute_type
+
+ ! name Name of the solute
+ ! shortname Short name of the solute
+ ! ions Number of ions solute dissociates into
+ ! wtmol Molecular weight of solute
+ ! rho Mass density of solute
+ !
+ character(len=CARMA_NAME_LEN) :: f_name
+ character(len=CARMA_SHORT_NAME_LEN) :: f_shortname
+ integer :: f_ions
+ real(kind=f) :: f_wtmol
+ real(kind=f) :: f_rho
+ end type carmasolute_type
+
+
+ !! The CARMA data type replaces the common blocks that were used in the F77 version of
+ !! CARMA. This allows the code to be written to allow for multiple threads to call CARMA
+ !! routines simulataneously. This thread safety is necessary for to run CARMA under OPEN/MP.
+ !!
+ !! The procedure for adding a variable to the CARMA data type is:
+ !! - Add the variable as a scalar or allocatable in the type definition.
+ !! - If the new variable is dynamic,
+ !! - Allocate the variable in the appropriate create or initialization routine.
+ !! - Deallocate the variable in the approprate finalize and destroy routines.
+ !! - Add an alias for the variable to carma_globaer.h and associate it with the variable
+ !! in this typedef.
+ !!
+ !! NOTE: While the carmatype is public, routines outside of the CARMA module should not look
+ !! at or manuipulate fields of this structure directly. There should be CARMA_XXX methods
+ !! to do anything that is needed with this structure, and use of these methods will allow
+ !! the CARMA data type structure to evolve without impacting code in the parent model.
+ !! The contents of the structure had to be made public, since the CARMA microphysics
+ !! rountines are implemented in separate files outside of this model; however, logically
+ !! they are part of the model and are the only routines outside of this module that should
+ !! access fields of this structure directly.
+ type, public :: carma_type
+
+ ! Model Dimensions
+ !
+ ! NGROUP number of particle groups
+ ! NELEM number of particle components (elements)
+ ! NBIN number of size bins per element
+ ! NGAS number of gases (may be 0)
+ ! NSOLUTE number of solutes (may be 0)
+ ! NWAVE number of wavelength bands (may be 0)
+ !
+ integer :: f_NGROUP
+ integer :: f_NELEM
+ integer :: f_NBIN
+ integer :: f_NGAS
+ integer :: f_NSOLUTE
+ integer :: f_NWAVE
+
+ ! Output logical unit numbers
+ !
+ ! NOTE: CARMA will not directly access files or keep track of file names. It is the
+ ! parent model's responsibility to provide the logical unit number to be used for
+ ! model output.
+ !
+ integer :: f_LUNOPRT ! output print file
+
+ ! Model startup control variables
+ !
+ ! do_print .t. if print output is desired
+ !
+ logical :: f_do_print
+
+
+ ! Configuration Objects
+ !
+ ! These are all other objects that are parts of the CARMA model. This is
+ ! an attempt to break up the large common block that has historically been
+ ! the structure of CARMA so the code is easier to understand and to
+ ! maintain.
+ !
+ ! element Particle component
+ ! gas Gas
+ ! group Particle
+ ! solute Element solute
+ !
+ ! NOTE: In the future, it may make sense to create objects that represent
+ ! the CARMA processes. This would encapsulate all the variables related to
+ ! a particular process into one structure. Candidate processes include:
+ ! transport, growth, nucleation, coagulation, ...
+ !
+ type(carmaelement_type), allocatable, dimension(:) :: f_element ! (NELEM)
+ type(carmagas_type), allocatable, dimension(:) :: f_gas ! (NGAS)
+ type(carmagroup_type), allocatable, dimension(:) :: f_group ! (NGROUP)
+ type(carmasolute_type), allocatable, dimension(:) :: f_solute ! (NSOLUTE)
+
+
+
+ ! Model option & control variables
+ !
+ ! conmax Minumum relative concentration to consider in varstep {prestep}
+ ! icoag Coagulation mapping array {setupcoag}
+ ! icoagelem Coagulation element mapping array {setupcoag}
+ ! icoagelem_cm Coagulation element mapping array for second mom {setupcoag}
+ ! ifall Fall velocity options {setupvfall}
+ ! icoagop Coagulation kernel options {setupckern}
+ ! icollec Gravitational collection options {setupckern}
+ ! itbnd_pc Top boundary condition flag for particles {init}
+ ! ibbnd_pc Bottom boundary condition flag for particles {init}
+ ! do_vdiff If .true. then do Brownian diffusion {init}
+ ! do_coag If .true. then do coagulation {init}
+ ! do_detrain If .true. then do detrainment {init}
+ ! do_drydep If .true. then do dry deposition {init}
+ ! do_fixedinitIf .true. then do initialize from reference atm {init}
+ ! do_grow If .true. then do condensational growth and evap. {init}
+ ! do_clearsky If .true. then do clear sky growth and coagulation {init}
+ ! do_incloud If .true. then do incloud growth and coagulation {init}
+ ! do_explised If .true. then do sedimentation with substepping {init}
+ ! do_partialinit If .true. then do initialize coagulation from reference atm {init}
+ ! do_pheat If .true. then do particle heating for growth rates {init}
+ ! do_pheatatm If .true. then do particle heating on atmosphere {init}
+ ! do_print_init If .true. then do print initializtion info {init}
+ ! do_step if .true. then varstepping succeeded {init}
+ ! do_substep if .true. then use substepping {init}
+ ! do_thermo if .true. then do solve thermodynamic equation {init}
+ ! do_vdiff If .true. then do Brownian diffusion {init}
+ ! do_vtran If .true. then do vertical transport {init}
+ ! do_cnst_rlh If .true. then uses constants for rlhe and rlhm {setupgrow}
+ ! igrowgas Gas that condenses into a particle element {setupgrow}
+ ! inucgas Gas that nucleates a particle group {setupnuc}
+ ! if_nuc Nucleation conditional array {setupaer}
+ ! inucproc Nucleation conditional array {setupaer}
+ ! nnuc2elem Number of elements that nucleate to element {setupnuc}
+ ! inuc2elem Nucleation transfers particles into element inuc2elem {setupnuc}
+ ! ievp2elem Total evap. transfers particles into group ievp2elem {setupnuc}
+ ! ievp2bin Total evap. transfers particles into bin ievp2bin {setupnuc}
+ ! inuc2bin Nucleation transfers particles into bin inuc2bin {setupnuc}
+ ! maxsubsteps Maximum number of time substeps allowed
+ ! minsubsteps Maximum number of time substeps allowed
+ ! maxretries Maximum number of substepping retries allowed
+ ! igash2o gas index for H2O
+ ! igash2so4 gas index for H2SO4
+ ! igasso2 gas index for SO2
+ ! dt_threshold convergence criteria for temperature [fraction]
+ ! cstick accommodation coefficient - coagulation
+ ! gsticki accommodation coefficient - growth (ice), default = 0.93
+ ! gstickl accommodation coefficient - growth (liquid), default = 1.0
+ ! tstick accommodation coefficient - temperature, default = 1.0
+ !
+ logical :: f_do_vdiff
+ logical :: f_do_drydep
+ logical :: f_do_coag
+ logical :: f_do_detrain
+ logical :: f_do_fixedinit
+ logical :: f_do_grow
+ logical :: f_do_clearsky
+ logical :: f_do_incloud
+ logical :: f_do_vtran
+ logical :: f_do_explised
+ logical :: f_do_partialinit
+ logical :: f_do_pheat
+ logical :: f_do_pheatatm
+ logical :: f_do_print_init
+ logical :: f_do_step
+ logical :: f_do_substep
+ logical :: f_do_thermo
+ logical :: f_do_cnst_rlh
+ logical, allocatable, dimension(:,:) :: f_if_nuc !(NELEM,NELEM)
+ real(kind=f) :: f_conmax
+ integer :: f_igash2o
+ integer :: f_igash2so4
+ integer :: f_igasso2
+ integer :: f_maxsubsteps
+ integer :: f_minsubsteps
+ integer :: f_maxretries
+ integer :: f_ifall
+ integer :: f_icoagop
+ integer :: f_icollec
+ integer :: f_itbnd_pc
+ integer :: f_ibbnd_pc
+ integer, allocatable, dimension(:) :: f_inucgas ! NGROUP
+ integer, allocatable, dimension(:) :: f_igrowgas ! NELEM
+ integer, allocatable, dimension(:) :: f_nnuc2elem ! NELEM
+ integer, allocatable, dimension(:) :: f_ievp2elem ! NELEM
+ integer, allocatable, dimension(:) :: f_nnucelem ! NELEM
+ integer, allocatable, dimension(:,:) :: f_icoag ! (NGROUP,NGROUP)
+ integer, allocatable, dimension(:,:) :: f_inucproc ! (NELEM,NELEM)
+ integer, allocatable, dimension(:,:) :: f_inuc2elem ! (NELEM,NELEM)
+ integer, allocatable, dimension(:,:) :: f_icoagelem ! (NELEM,NGROUP)
+ integer, allocatable, dimension(:,:) :: f_icoagelem_cm ! (NELEM,NGROUP)
+ integer, allocatable, dimension(:,:) :: f_inucelem ! (NELEM,NELEM*NGROUP)
+ integer, allocatable, dimension(:,:,:) :: f_inuc2bin ! (NBIN,NGROUP,NGROUP)
+ integer, allocatable, dimension(:,:,:) :: f_ievp2bin ! (NBIN,NGROUP,NGROUP)
+ integer, allocatable, dimension(:,:,:) :: f_nnucbin ! (NGROUP,NBIN,NGROUP)
+ integer, allocatable, dimension(:,:,:,:) :: f_inucbin ! (NBIN*NGROUP,NGROUP,NBIN,NGROUP)
+ real(kind=f) :: f_dt_threshold
+ real(kind=f) :: f_tstick
+ real(kind=f) :: f_gsticki
+ real(kind=f) :: f_gstickl
+ real(kind=f) :: f_cstick
+
+
+ ! Particle bin structure
+ !
+ ! diffmass Difference between values
+ !
+ real(kind=f), allocatable, dimension(:,:,:,:) :: f_diffmass ! (NBIN,NGROUP,NBIN,NGROUP)
+
+ ! Coagulation kernels and bin pair mapping
+ !
+ ! ck0 Constant coagulation kernel {setupaer}
+ ! grav_e_coll0 Constant value for collection effic. {setupaer}
+ ! volx Coagulation subdivision variable {setupcoag}
+ ! ilow Bin pairs for coagulation production {setupcoag}
+ ! jlow Bin pairs for coagulation production {setupcoag}
+ ! iup Bin pairs for coagulation production {setupcoag}
+ ! jup Bin pairs for coagulation production {setupcoag}
+ ! npairl Bin pair indices {setupcoag}
+ ! npairu Bin pair indices {setupcoag}
+ ! kbin lower bin for coagulation {setupcoag}
+ ! pkernel Coagulation production variables {setupcoag}
+ !
+ real(kind=f) :: f_ck0
+ real(kind=f) :: f_grav_e_coll0
+ real(kind=f), allocatable, dimension(:,:,:,:,:) :: f_volx ! (NGROUP,NGROUP,NGROUP,NBIN,NBIN)
+ integer, allocatable, dimension(:,:,:) :: f_ilow ! (NGROUP,NBIN,NBIN*NBIN)
+ integer, allocatable, dimension(:,:,:) :: f_jlow ! (NGROUP,NBIN,NBIN*NBIN)
+ integer, allocatable, dimension(:,:,:) :: f_iup ! (NGROUP,NBIN,NBIN*NBIN)
+ integer, allocatable, dimension(:,:,:) :: f_jup ! (NGROUP,NBIN,NBIN*NBIN)
+ integer, allocatable, dimension(:,:) :: f_npairl ! (NGROUP,NBIN)
+ integer, allocatable, dimension(:,:) :: f_npairu ! (NGROUP,NBIN)
+ integer, allocatable, dimension(:,:,:,:,:) :: f_kbin ! (NGROUP,NGROUP,NGROUP,NBIN,NBIN)
+ real(kind=f), allocatable, dimension(:,:,:,:,:,:) :: f_pkernel ! (NBIN,NBIN,NGROUP,NGROUP,NGROUP,6)
+
+ ! Coagulation group pair mapping
+ !
+ ! iglow Group pairs for coagulation production {setupcoag}
+ ! jglow Group pairs for coagulation production {setupcoag}
+ ! igup Group pairs for coagulation production {setupcoag}
+ ! jgup Group pairs for coagulation production {setupcoag}
+ !
+ integer, allocatable, dimension(:,:,:) :: f_iglow ! (NGROUP,NBIN,NBIN*NBIN)
+ integer, allocatable, dimension(:,:,:) :: f_jglow ! (NGROUP,NBIN,NBIN*NBIN)
+ integer, allocatable, dimension(:,:,:) :: f_igup ! (NGROUP,NBIN,NBIN*NBIN)
+ integer, allocatable, dimension(:,:,:) :: f_jgup ! (NGROUP,NBIN,NBIN*NBIN)
+
+ ! Particle fall velocities
+ !
+ ! vf_const Constant vertical fall velocity when ifall=0 {setupaer}
+ !
+ real(kind=f) :: f_vf_const
+
+
+ ! Condensational growth parameters
+ !
+ ! NOTE: Some of these variables are used for storing intermediate values in
+ ! the calculations. They may no longer be necessary, when the code is
+ ! implemented as F90 and values as passed as parameters between subroutines.
+ !
+ ! rlh_nuc Latent heat released by nucleation [cm^2/s^2] {setupaer}
+ ! pratt Terms in PPM advection scheme for condensation {setupgkern}
+ ! prat
+ ! pden1
+ ! palr
+ real(kind=f), allocatable, dimension(:,:) :: f_rlh_nuc ! (NELEM,NELEM)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_pratt ! (3,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_prat ! (4,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:) :: f_pden1 ! (NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:) :: f_palr ! (4,NGROUP)
+
+ ! Optical Properties
+ ! wave Bin-center wavelengths [cm]
+ ! dwave width of radiation bands [cm]
+ ! do_wave_emit If true, emission should be calculated the band
+ !
+ real(kind=f), allocatable, dimension(:) :: f_wave ! (NWAVE)
+ real(kind=f), allocatable, dimension(:) :: f_dwave ! (NWAVE)
+ logical, allocatable, dimension(:) :: f_do_wave_emit ! (NWAVE)
+ end type carma_type
+
+
+ !! The cstate data type replaces portions of the common blocks that were used
+ !! in the F77 version of CARMA. This allows the code to be written to allow for
+ !! multiple threads to call CARMA routines simulataneously. This thread safety is
+ !! necessary for to run CARMA under OPEN/MP.
+ !!
+ !! The procedure for adding a variable to the cstate data type is:
+ !! - Add the variable as a scalar or allocatable in the type definition.
+ !! - If the new variable is dynamic,
+ !! - Allocate the variable in the create routine.
+ !! - Deallocate the variable in the destroy routines.
+ !! - Add an alias for the variable to cstate.h and associate it with the
+ !! variable in this typedef.
+ !!
+ !! NOTE: While the carmastate_type is public, routines outside of the CARMA module
+ !! should not look at or manuipulate fields of this structure directly. There should
+ !! be CARMASTATE_XXX methods to do anything that is needed with this structure, and
+ !! use of these methods will allow the cstate data type structure to evolve without
+ !! impacting code in the parent model. The contents of the structure had to be made
+ !! public, since the CARMA microphysics rountines are implemented in separate files
+ !! outside of this model; however, logically they are part of the model and are the
+ !! only routines outside of this module that should access fields of this structure
+ !! directly.
+ type, public :: carmastate_type
+
+ ! Parent CARMA object
+ type(carma_type), pointer :: f_carma
+
+ ! Model Dimensions
+ !
+ ! NZ number of grid points in the column
+ ! NZP1 NZ+1
+ ! NGROUP number of particle groups
+ ! NELEM number of particle components (elements)
+ ! NBIN number of size bins per element
+ ! NGAS number of gases (may be 0)
+ !
+ integer :: f_NZ
+ integer :: f_NZP1
+
+ ! Model option & control variables
+ !
+ ! time Simulation time at end of current timestep [s]
+ ! dtime Substep Timestep size [s]
+ ! dtime_orig Original Timestep size [s]
+ ! nretries Number of substepping retries attempted
+ real(kind=f) :: f_time
+ real(kind=f) :: f_dtime
+ real(kind=f) :: f_dtime_orig
+ real(kind=f) :: f_nretries
+
+ ! max_nretry Maximum number of retries in a step
+ ! nstep Total number of steps taken
+ ! nsubstep Total number of substeps taken
+ ! nretry Total number of retries taken
+ integer :: f_max_nsubstep
+ real(kind=f) :: f_max_nretry
+ real(kind=f) :: f_nstep
+ integer :: f_nsubstep
+ real(kind=f) :: f_nretry
+
+ real(kind=f), allocatable, dimension(:) :: f_zsubsteps ! (NZ)
+
+
+ ! Model Grid
+ !
+ ! igridv flag to specify desired vertical grid coord system {initatm}
+ ! igridh flag to specify desired horizontal grid coord system {initatm}
+ ! xmet Horizontal ds/dx (ds is metric distance) {initatm}
+ ! ymet Horizontal ds/dy (ds is metric distance) {initatm}
+ ! zmet Vertical ds/dz (ds is metric distance) {initatm}
+ ! zmetl Vertical ds/dz at edges (ds is metric distance) {initatm}
+ ! xc Horizontal position at center of box {initatm}
+ ! yc Horizontal position at center of box {initatm}
+ ! zc Altitude at layer mid-point {initatm}
+ ! dx Horizontal grid spacing {initatm}
+ ! dy Horizontal grid spacing {initatm}
+ ! dz Thickness of vertical layers {initatm}
+ ! zl Altitude at top of layer {initatm}
+ ! lon Longitude [deg] at xc, yc {initatm}
+ ! lat Latitude [deg] at xc, yc {initatm}
+ !
+ integer :: f_igridv
+ integer :: f_igridh
+ real(kind=f), allocatable, dimension(:) :: f_xmet ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_ymet ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_zmet ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_zmetl ! (NZP1)
+ real(kind=f), allocatable, dimension(:) :: f_xc ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_yc ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_zc ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_dx ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_dy ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_dz ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_zl ! (NZP1)
+ real(kind=f) :: f_lon
+ real(kind=f) :: f_lat
+
+ ! Particle bin structure
+ !
+ ! rhop Mass density of particle groups [g/cm^3]
+ ! r_wet Wet particle radius from RH swelling [cm] {setupvfall}
+ ! rlow_wet Wet particle radius (lower bound) from RH swelling [cm] {setupvfall}
+ ! rup_wet Wet particle radius (upper bound) from RH swelling [cm] {setupvfall}
+ ! rhop_wet Wet Mass density of particle groups [g/cm^3]
+ ! r_ref Reference wet particle radius from RH swelling [cm] {setupvfall}
+ ! rhop_ref Reference wet Mass density of particle groups [g/cm^3]
+ !
+ real(kind=f), allocatable, dimension(:,:,:) :: f_rhop ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_rhop_wet ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_r_wet ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_rlow_wet ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_rup_wet ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_r_ref ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_rhop_ref ! (NZ,NBIN,NGROUP)
+
+ ! Primary model state variables
+ !
+ ! pc Particle concentration [/x_units/y_units/z_units] {initaer}
+ ! pcd Detrained particle concentration [/x_units/y_units/z_units] {initaer}
+ ! pc_surf Particles on surface [/cm2] {initaer}
+ ! sedimentationflux Particles sedimented to surface [/cm2/s] {initaer}
+ ! gc Gas concentration [g/x_units/y_units/z_units] {initgas}
+ ! cldfrc Cloud fraction [fraction]
+ ! rhcrit Relative humidity for onset of liquid clouds [fraction]
+ !
+ real(kind=f), allocatable, dimension(:,:,:) :: f_pc ! (NZ,NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_pcd ! (NZ,NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_pc_surf ! (NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_sedimentationflux ! (NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_gc ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:) :: f_cldfrc ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_rhcrit ! (NZ)
+
+ ! Secondary model variables
+ !
+ ! NOTE: Some of these variables are used for storing intermediate values in
+ ! the calculations. They may no longer be necessary, when the code is
+ ! implemented as F90 and values as passed as parameters between subroutines.
+ !
+ ! pcl Particle concentration at beginning of time-step
+ ! pconmax Maximum particle concentration for each grid point
+ ! gcl Gas concentration at beginning of time-step
+ ! d_gc Change in gas concentration due to transport
+ ! d_t Change in temperature due to transport
+ ! dpc_sed Change in particle concentration due to sedimentation
+ ! coaglg Total particle loss rate due to coagulation for group
+ ! coagpe Particle production due to coagulation
+ ! rnuclg Total particle loss rate due to nucleation for group
+ ! rnucpe Particle production due to nucleation
+ ! rhompe Particle production due to homogeneous nucleation
+ ! pc_nucl Particles produced due to nucleation (for the whole step, not just the substep)
+ ! growlg Total particle loss rate due to growth for group
+ ! growle Partial particle loss rate due to growth for element
+ ! growpe Particle production due to growth
+ ! evaplg Total particle loss rate due to evaporation for group
+ ! evapls Partial particle loss rate due to evaporation for element
+ ! evappe Particle production due to evaporation
+ ! coreavg Average total core mass in bin
+ ! coresig logarithm^2 of std dev of core distribution
+ ! evdrop Particle production of droplet number
+ ! evcore Particle production of core elements
+ ! gasprod Gas production term
+ ! rlheat Latent heating rate (per step) [deg_K/s]
+ ! ftoppart Downward particle flux across top boundary of model
+ ! fbotpart Upward flux particle across bottom boundary of model
+ ! pc_topbnd Particle concentration assumed just above the top boundary
+ ! pc_botbnd Particle concentration assumed just below the bottom boundary
+ ! cmf Core mass fraction in a droplet
+ ! totevap .true. if droplets are totally evaporating to CN
+ ! too_small .true. if cores are smaller than smallest CN
+ ! too_big .true. if cores are larger than largest CN
+ ! nuc_small .true. if cores are smaller than smallest nucleated CN
+ ! rlprod Latent heat production (per substep) (K/s)
+ !
+ real(kind=f), allocatable, dimension(:,:,:) :: f_pcl ! (NZ,NBIN,NELEM
+ real(kind=f), allocatable, dimension(:,:) :: f_gcl ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:,:) :: f_d_gc ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:) :: f_d_t ! (NZ)
+ real(kind=f), allocatable, dimension(:,:) :: f_dpc_sed ! (NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_pconmax ! (NZ,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_coaglg ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_coagpe ! (NZ,NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_rnuclg ! (NBIN,NGROUP,NGROUP)
+ real(kind=f), allocatable, dimension(:,:) :: f_rnucpe ! (NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_rhompe ! (NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_pc_nucl ! (NZ,NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_growpe ! (NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_evappe ! (NBIN,NELEM)
+ real(kind=f) :: f_coreavg
+ real(kind=f) :: f_coresig
+ real(kind=f) :: f_evdrop
+ real(kind=f), allocatable, dimension(:) :: f_evcore ! (NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_growlg ! (NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:) :: f_evaplg ! (NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:) :: f_gasprod ! (NGAS)
+ real(kind=f), allocatable, dimension(:) :: f_rlheat ! (NZ)
+ real(kind=f), allocatable, dimension(:,:) :: f_ftoppart ! (NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_fbotpart ! (NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_pc_topbnd ! (NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_pc_botbnd ! (NBIN,NELEM)
+ real(kind=f), allocatable, dimension(:,:) :: f_cmf ! (NBIN,NGROUP)
+ logical, allocatable, dimension(:,:) :: f_totevap ! (NBIN,NGROUP)
+ logical :: f_too_small
+ logical :: f_too_big
+ logical :: f_nuc_small
+ real(kind=f) :: f_rlprod
+
+ ! Coagulation kernels and bin pair mapping
+ !
+ ! ckernel Coagulation kernels [cm^3/s] {setupckern}
+ !
+ real(kind=f), allocatable, dimension(:,:,:,:,:) :: f_ckernel ! (NZ,NBIN,NBIN,NGROUP,NGROUP)
+
+ ! Particle fall velocities and diffusivities
+ !
+ ! bpm Corrects for non-sphericity and non-continuum effects {setupvfall}
+ ! vf Fall velocities at layer endge {setupvfall}
+ ! re Reynolds' number based on {setupvfall}
+ ! dkz Vert Brownian diffusion coef at layer boundary [z_units^2/s] {setupbdif}
+ ! vd Particle dry deposition velocity [z_units/s] {setupvdry}
+ !
+ real(kind=f), allocatable, dimension(:,:,:) :: f_bpm ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_vf ! (NZP1,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_re ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_dkz ! (NZP1,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:) :: f_vd ! (NBIN,NGROUP)
+
+ ! Atmospheric Structure
+ !
+ ! rhoa Air density at layer mid-pt [g/x_units/y_units/z_units] {initatm}
+ ! rhoa_wet Wet Air density averaged over grid box [g/x_units/y_units/z_units] {initatm}
+ ! t Air temperature at layer mid-pt [deg_K] {initatm}
+ ! p Atmospheric pressure at layer mid-pt [dyne/cm^2] {initatm}
+ ! pl Atmospheric pressure at layer edge [dyne/cm^2] {initatm}
+ ! rmu Air viscosity at layer mid-pt [g/cm/s] {initatm}
+ ! thcond Thermal conductivity of dry air [erg/cm/sec/deg_K] {initatm}
+ ! thcondnc Adjusted thermal conductivity of dry air [erg/cm/sec/deg_K] {initatm}
+ ! told Temperature at beginning of time-step
+ ! relhum Hacked in relative humidity from hostmodel
+ ! wtpct Sulfate weight percent
+ !
+ real(kind=f), allocatable, dimension(:) :: f_rhoa ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_rhoa_wet ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_t ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_p ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_pl ! (NZP1)
+ real(kind=f), allocatable, dimension(:) :: f_rmu ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_thcond ! (NZ)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_thcondnc ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:) :: f_told ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_relhum ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_wtpct ! (NZ)
+
+ ! Condensational growth parameters
+ !
+ ! NOTE: Some of these variables are used for storing intermediate values in
+ ! the calculations. They may no longer be necessary, when the code is
+ ! implemented as F90 and values as passed as parameters between subroutines.
+ !
+ ! diffus Diffusivity of gas in air [cm^2/s] {setupgrow}
+ ! rlhe Latent heat of evaporation for gas [cm^2/s^2] {setupgrow}
+ ! rlhm Latent heat of ice melting for gas [cm^2/s^2] {setupgrow}
+ ! pvapl Saturation vapor pressure over water [dyne/cm^2] {vaporp}
+ ! pvapi Saturation vapor pressure over ice [dyne/cm^2] {vaporp}
+ ! surfctwa Surface tension of water-air interface {setupgkern}
+ ! surfctiw Surface tension of water-ice interface {setupgkern}
+ ! surfctia Surface tension of ice-air interface {setupgkern}
+ ! akelvin Exponential arg. in curvature term for growth {setupgkern}
+ ! akelvini Curvature term for ice {setupgkern}
+ ! ft Ventilation factor {setupgkern}
+ ! gro Growth kernel [UNITS?] {setupgkern}
+ ! gro1 Growth kernel conduction term [UNITS?] {setupgkern}
+ ! gro2 Growth kernel radiation term [UNITS?] {setupgkern}
+ ! supsatl Supersaturation of vapor w.r.t. liquid water [dimless]
+ ! supsati Supersaturation of vapor w.r.t. ice [dimless]
+ ! supsatlold Supersaturation (liquid) before time-step {prestep}
+ ! supsatiold Supersaturation (ice) before time-step {prestep}
+ ! scrit Critical supersaturation for nucleation [dimless] {setupnuc}
+ ! radint Incoming radiative intensity [erg/cm2/sr/s/um]
+ ! partheat Diffusional heating from particles (step) [K/s]
+ ! dtpart Delta particle temperature [K]
+ ! phprod Particle heating production (substep) [K/s]
+ !
+ real(kind=f), allocatable, dimension(:,:) :: f_diffus ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:,:) :: f_rlhe ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:,:) :: f_rlhm ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:,:) :: f_pvapl ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:,:) :: f_pvapi ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:) :: f_surfctwa ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_surfctiw ! (NZ)
+ real(kind=f), allocatable, dimension(:) :: f_surfctia ! (NZ)
+ real(kind=f), allocatable, dimension(:,:) :: f_akelvin ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:,:) :: f_akelvini ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_ft ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_gro ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_gro1 ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:) :: f_gro2 ! (NZ,NGROUP)
+ real(kind=f), allocatable, dimension(:,:) :: f_supsatl ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:,:) :: f_supsati ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:,:) :: f_supsatlold ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:,:) :: f_supsatiold ! (NZ,NGAS)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_scrit ! (NZ,NBIN,NGROUP)
+ real(kind=f), allocatable, dimension(:,:) :: f_radint ! (NZ,NWAVE)
+ real(kind=f), allocatable, dimension(:) :: f_partheat ! (NZ)
+ real(kind=f), allocatable, dimension(:,:,:) :: f_dtpart ! (NZ,NBIN,NGROUP)
+ real(kind=f) :: f_phprod
+ end type carmastate_type
+end module
\ No newline at end of file
diff --git a/src/physics/carma/base/carmaelement_mod.F90 b/src/physics/carma/base/carmaelement_mod.F90
new file mode 100644
index 0000000000..b1ef11f034
--- /dev/null
+++ b/src/physics/carma/base/carmaelement_mod.F90
@@ -0,0 +1,267 @@
+!! The CARMAELEMENT module contains configuration information about a particle
+!! element used by CARMA.
+!!
+!! @version March-2010
+!! @author Chuck Bardeen
+module CARMAELEMENT_mod
+
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+
+ ! CARMA explicitly declares all variables.
+ implicit none
+
+ ! All CARMA variables and procedures are private except those explicitly declared to be public.
+ private
+
+ ! Declare the public methods.
+ public CARMAELEMENT_Create
+ public CARMAELEMENT_Destroy
+ public CARMAELEMENT_Get
+ public CARMAELEMENT_Print
+
+contains
+
+ !! Defines a gas used by CARMA for nucleation and growth of cloud and
+ !! aerosol particles.
+ !!
+ !! NOTE: The element density can be specifeid per bin using rhobin; however,
+ !! if only the bulk density is provided (rho) then the same value will be used
+ !! for all bins. The bulk density allows for backward compatability and ease of
+ !! configuration. If rhobin is provided, then rho is ignored.
+ !!
+ !! @author Chuck Bardeen
+ !! @version March-2010
+ !!
+ !! @see CARMA_AddGas
+ !! @see CARMAELEMENT_Destroy
+ subroutine CARMAELEMENT_Create(carma, ielement, igroup, name, rho, itype, icomposition, rc, &
+ shortname, isolute, rhobin, arat)
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: ielement !! the element index
+ integer, intent(in) :: igroup !! Group to which the element belongs
+ character(*), intent(in) :: name !! the element name, maximum of 255 characters
+ real(kind=f), intent(in) :: rho !! bulk mass density of particle element [g/cm^3]
+ integer, intent(in) :: itype !! Particle type specification
+ integer, intent(in) :: icomposition !! Particle compound specification
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ character(*), optional, intent(in) :: shortname !! the element shortname, maximum of 6 characters
+ integer, optional, intent(in) :: isolute !! Index of solute for the particle element
+ real(kind=f), optional, intent(in) :: rhobin(carma%f_NBIN) !! mass density per bin of particle element [g/cm^3]
+ real(kind=f), optional, intent(in) :: arat(carma%f_NBIN) !! projected area ratio
+
+ ! Local variables
+ integer :: ier
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough elements allocated.
+ if (ielement > carma%f_NELEM) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAELEMENT_Create:: ERROR - The specifed element (", &
+ ielement, ") is larger than the number of elements (", carma%f_NELEM, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Make sure there are enough groups allocated.
+ if (igroup > carma%f_NGROUP) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAELEMENT_Create:: ERROR - The specifed group (", &
+ igroup, ") is larger than the number of groups (", carma%f_NGROUP, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ allocate( &
+ carma%f_element(ielement)%f_rho(carma%f_NBIN), &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAELEMENT_Add: ERROR allocating, status=", ier
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Save off the settings.
+ carma%f_element(ielement)%f_igroup = igroup
+ carma%f_element(ielement)%f_name = name
+ carma%f_element(ielement)%f_rho(:) = rho
+ carma%f_element(ielement)%f_itype = itype
+ carma%f_element(ielement)%f_icomposition = icomposition
+
+
+ ! Defaults for optional parameters
+ carma%f_element(ielement)%f_shortname = ""
+ carma%f_element(ielement)%f_isolute = 0
+
+ ! Set optional parameters.
+ if (present(shortname)) carma%f_element(ielement)%f_shortname = shortname
+ if (present(isolute)) then
+
+ ! Make sure there are enough solutes allocated.
+ if (isolute > carma%f_NSOLUTE) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAELEMENT_Create:: ERROR - The specifed solute (", &
+ isolute, ") is larger than the number of solutes (", carma%f_NSOLUTE, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ carma%f_element(ielement)%f_isolute = isolute
+ end if
+ if (present(rhobin)) carma%f_element(ielement)%f_rho(:) = rhobin(:)
+
+ ! If the area ratio is specfied (usually along with rhobin), then set this
+ ! for the group.
+ if (present(arat)) carma%f_group(igroup)%f_arat(:) = arat(:)
+
+ ! Keep track of the fact that another element has been added to the group.
+ carma%f_group(igroup)%f_nelem = carma%f_group(igroup)%f_nelem + 1
+
+ return
+ end subroutine CARMAELEMENT_Create
+
+
+ !! Deallocates the memory associated with a CARMAELEMENT object.
+ !!
+ !! @author Chuck Bardeen
+ !! @version March-2010
+ !!
+ !! @see CARMAELEMENT_Create
+ subroutine CARMAELEMENT_Destroy(carma, ielement, rc)
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: ielement !! the element index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+
+ ! Local variables
+ integer :: ier
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough elements allocated.
+ if (ielement > carma%f_NELEM) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAELEMENT_Destroy:: ERROR - The specifed element (", &
+ ielement, ") is larger than the number of elements (", carma%f_NELEM, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ if (allocated(carma%f_element(ielement)%f_rho)) then
+ deallocate( &
+ carma%f_element(ielement)%f_rho, &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAELEMENT_Destroy: ERROR deallocating, status=", ier
+ rc = RC_ERROR
+ return
+ endif
+ endif
+
+ return
+ end subroutine CARMAELEMENT_Destroy
+
+
+ !! Gets information about a particle element.
+ !!
+ !! The group name and other properties are available after a call to
+ !! CARMAELEMENT_Create().
+ !!
+ !! @author Chuck Bardeen
+ !! @version March-2010
+ !!
+ !! @see CARMAELEMENT_Create
+ !! @see CARMA_GetElement
+ subroutine CARMAELEMENT_Get(carma, ielement, rc, igroup, name, shortname, rho, itype, icomposition, isolute)
+ type(carma_type), intent(in) :: carma !! the carma object
+ integer, intent(in) :: ielement !! the element index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ integer, optional, intent(out) :: igroup !! Group to which the element belongs
+ character(len=*), optional, intent(out) :: name !! the element name
+ character(len=*), optional, intent(out) :: shortname !! the element short name
+ real(kind=f), optional, intent(out) :: rho(carma%f_NBIN) !! Mass density of particle element [g/cm^3]
+ integer, optional, intent(out) :: itype !! Particle type specification
+ integer, optional, intent(out) :: icomposition !! Particle compound specification
+ integer, optional, intent(out) :: isolute !! Index of solute for the particle element
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough elements allocated.
+ if (ielement > carma%f_NELEM) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAELEMENT_Get:: ERROR - The specifed element (", &
+ ielement, ") is larger than the number of elements (", carma%f_NELEM, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Return any requested properties of the group.
+ if (present(igroup)) igroup = carma%f_element(ielement)%f_igroup
+ if (present(name)) name = carma%f_element(ielement)%f_name
+ if (present(shortname)) shortname = carma%f_element(ielement)%f_shortname
+ if (present(rho)) rho(:) = carma%f_element(ielement)%f_rho(:)
+ if (present(itype)) itype = carma%f_element(ielement)%f_itype
+ if (present(icomposition)) icomposition = carma%f_element(ielement)%f_icomposition
+ if (present(isolute)) isolute = carma%f_element(ielement)%f_isolute
+
+ return
+ end subroutine CARMAELEMENT_Get
+
+
+ !! Prints information about an element.
+ !!
+ !! @author Chuck Bardeen
+ !! @version March-2010
+ !!
+ !! @see CARMAELEMENT_Get
+ subroutine CARMAELEMENT_Print(carma, ielement, rc)
+ type(carma_type), intent(in) :: carma !! the carma object
+ integer, intent(in) :: ielement !! the element index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+
+ ! Local variables
+ character(len=CARMA_NAME_LEN) :: name ! name
+ character(len=CARMA_SHORT_NAME_LEN) :: shortname ! shortname
+ real(kind=f) :: rho(carma%f_NBIN) ! density (g/cm3)
+ integer :: igroup ! Group to which the element belongs
+ integer :: itype ! Particle type specification
+ integer :: icomposition ! Particle compound specification
+ integer :: isolute ! Index of solute for the particle element
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Test out the Get method.
+ if (carma%f_do_print) then
+ call CARMAELEMENT_Get(carma, ielement, rc, name=name, shortname=shortname, igroup=igroup, &
+ itype=itype, icomposition=icomposition, rho=rho, isolute=isolute)
+ if (rc < 0) return
+
+
+ write(carma%f_LUNOPRT,*) " name : ", trim(name)
+ write(carma%f_LUNOPRT,*) " igroup : ", igroup
+ write(carma%f_LUNOPRT,*) " shortname : ", trim(shortname)
+ write(carma%f_LUNOPRT,*) " rho : ", rho, " (g/cm3)"
+
+ select case(itype)
+ case (I_INVOLATILE)
+ write(carma%f_LUNOPRT,*) " itype : involatile"
+ case (I_VOLATILE)
+ write(carma%f_LUNOPRT,*) " itype : volatile"
+ case (I_COREMASS)
+ write(carma%f_LUNOPRT,*) " itype : core mass"
+ case (I_VOLCORE)
+ write(carma%f_LUNOPRT,*) " itype : volatile core"
+ case (I_CORE2MOM)
+ write(carma%f_LUNOPRT,*) " itype : core mass - second moment"
+ case default
+ write(carma%f_LUNOPRT,*) " itype : unknown, ", itype
+ end select
+
+ write(carma%f_LUNOPRT,*) " icomposition : ", icomposition
+ write(carma%f_LUNOPRT,*) " isolute : ", isolute
+ end if
+
+ return
+ end subroutine CARMAELEMENT_Print
+end module
diff --git a/src/physics/carma/base/carmagas_mod.F90 b/src/physics/carma/base/carmagas_mod.F90
new file mode 100644
index 0000000000..e446db01ad
--- /dev/null
+++ b/src/physics/carma/base/carmagas_mod.F90
@@ -0,0 +1,208 @@
+!! The CARMAGAS module contains configuration information about a gas used by CARMA.
+!!
+!! @version May-2009
+!! @author Chuck Bardeen
+module carmagas_mod
+
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+
+ ! CARMA explicitly declares all variables.
+ implicit none
+
+ ! All CARMA variables and procedures are private except those explicitly declared to be public.
+ private
+
+ ! Declare the public methods.
+ public CARMAGAS_Create
+ public CARMAGAS_Destroy
+ public CARMAGAS_Get
+ public CARMAGAS_Print
+
+contains
+
+ !! Defines a gas used by CARMA for nucleation and growth of cloud and
+ !! aerosol particles.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMA_AddGas
+ !! @see CARMAGAS_Destroy
+ subroutine CARMAGAS_Create(carma, igas, name, wtmol, ivaprtn, icomposition, &
+ rc, shortname, dgc_threshold, ds_threshold)
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: igas !! the gas index
+ character(*), intent(in) :: name !! the gas name, maximum of 255 characters
+ real(kind=f), intent(in) :: wtmol !! the gas molecular weight [g/mol]
+ integer, intent(in) :: ivaprtn !! vapor pressure routine for this gas
+ integer, intent(in) :: icomposition !! gas compound specification
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ character(*), optional, intent(in) :: shortname !! the gas shortname, maximum of 6 characters
+ real(kind=f), optional, intent(in) :: dgc_threshold !! convergence criteria for gas concentration
+ !! [0 : off; > 0 : percentage change]
+ real(kind=f), optional, intent(in) :: ds_threshold !! convergence criteria for gas saturation
+ !! [0 : off; > 0 : percentage change; < 0 : amount past 0 crossing]
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough gases allocated.
+ if (igas > carma%f_NGAS) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGAS_GetCreate:: ERROR - The specifed gas (", &
+ igas, ") is larger than the number of gases (", carma%f_NGAS, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Save off the settings.
+ carma%f_gas(igas)%f_name = name
+ carma%f_gas(igas)%f_wtmol = wtmol
+ carma%f_gas(igas)%f_ivaprtn = ivaprtn
+ carma%f_gas(igas)%f_icomposition = icomposition
+
+
+ ! Defaults for optional parameters
+ carma%f_gas(igas)%f_shortname = ""
+ carma%f_gas(igas)%f_dgc_threshold = 0._f
+ carma%f_gas(igas)%f_ds_threshold = 0._f
+
+ ! Set optional parameters.
+ if (present(shortname)) carma%f_gas(igas)%f_shortname = shortname
+ if (present(dgc_threshold)) carma%f_gas(igas)%f_dgc_threshold = dgc_threshold
+ if (present(ds_threshold)) carma%f_gas(igas)%f_ds_threshold = ds_threshold
+
+ return
+ end subroutine CARMAGAS_Create
+
+
+ !! Deallocates the memory associated with a CARMAGAS object.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMAGAS_Create
+ subroutine CARMAGAS_Destroy(carma, igas, rc)
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: igas !! the gas index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough gases allocated.
+ if (igas > carma%f_NGAS) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGAS_Destroy:: ERROR - The specifed gas (", &
+ igas, ") is larger than the number of gases (", carma%f_NGAS, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ return
+ end subroutine CARMAGAS_Destroy
+
+
+ !! Gets information about a gas.
+ !!
+ !! The group name and other properties are available after a call to
+ !! CARMAGAS_Create().
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMAGAS_Create
+ !! @see CARMA_GetGas
+ subroutine CARMAGAS_Get(carma, igas, rc, name, shortname, wtmol, ivaprtn, icomposition, dgc_threshold, ds_threshold)
+ type(carma_type), intent(in) :: carma !! the carma object
+ integer, intent(in) :: igas !! the gas index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ character(len=*), optional, intent(out) :: name !! the gas name
+ character(len=*), optional, intent(out) :: shortname !! the gas short name
+ real(kind=f), optional, intent(out) :: wtmol !! the gas molecular weight [g/mol]
+ integer, optional, intent(out) :: ivaprtn !! vapor pressure routine for this gas
+ integer, optional, intent(out) :: icomposition !! gas compound specification
+ real(kind=f), optional, intent(out) :: dgc_threshold !! convergence criteria for gas concentration [fraction]
+ real(kind=f), optional, intent(out) :: ds_threshold !! convergence criteria for gas saturation [fraction]
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough gases allocated.
+ if (igas > carma%f_NGAS) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGAS_Get:: ERROR - The specifed gas (", &
+ igas, ") is larger than the number of gases (", carma%f_NGAS, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Return any requested properties of the group.
+ if (present(name)) name = carma%f_gas(igas)%f_name
+ if (present(shortname)) shortname = carma%f_gas(igas)%f_shortname
+ if (present(wtmol)) wtmol = carma%f_gas(igas)%f_wtmol
+ if (present(ivaprtn)) ivaprtn = carma%f_gas(igas)%f_ivaprtn
+ if (present(icomposition)) icomposition = carma%f_gas(igas)%f_icomposition
+ if (present(dgc_threshold)) dgc_threshold = carma%f_gas(igas)%f_dgc_threshold
+ if (present(ds_threshold)) ds_threshold = carma%f_gas(igas)%f_ds_threshold
+
+ return
+ end subroutine CARMAGAS_Get
+
+
+ !! Prints information about a gas.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMAGAS_Get
+ subroutine CARMAGAS_Print(carma, igas, rc)
+ type(carma_type), intent(in) :: carma !! the carma object
+ integer, intent(in) :: igas !! the gas index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+
+ ! Local variables
+ character(len=CARMA_NAME_LEN) :: name !! name
+ character(len=CARMA_SHORT_NAME_LEN) :: shortname !! shortname
+ real(kind=f) :: wtmol !! molecular weight (g/mol)
+ integer :: ivaprtn !! vapor pressure routine for this gas
+ integer :: icomposition !! gas compound specification
+ real(kind=f) :: dgc_threshold !! convergence criteria for gas concentration [fraction]
+ real(kind=f) :: ds_threshold !! convergence criteria for gas saturation [fraction]
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Test out the Get method.
+ if (carma%f_do_print) then
+ call CARMAGAS_Get(carma, igas, rc, name=name, shortname=shortname, wtmol=wtmol, &
+ ivaprtn=ivaprtn, icomposition=icomposition)
+ if (rc < RC_OK) return
+
+
+ write(carma%f_LUNOPRT,*) " name : ", trim(name)
+ write(carma%f_LUNOPRT,*) " shortname : ", trim(shortname)
+ write(carma%f_LUNOPRT,*) " wtmol : ", wtmol, " (g/mol)"
+ write(carma%f_LUNOPRT,*) " dgc_threshold : ", dgc_threshold
+ write(carma%f_LUNOPRT,*) " ds_threshold : ", ds_threshold
+
+ select case(ivaprtn)
+ case (I_VAPRTN_H2O_BUCK1981)
+ write(carma%f_LUNOPRT,*) " ivaprtn : Buck [1981]"
+ case (I_VAPRTN_H2O_MURPHY2005)
+ write(carma%f_LUNOPRT,*) " ivaprtn : Murphy & Koop [2005]"
+ case default
+ write(carma%f_LUNOPRT,*) " ivaprtn : unknown, ", ivaprtn
+ end select
+
+ select case(icomposition)
+ case (I_GCOMP_H2O)
+ write(carma%f_LUNOPRT,*) " icomposition : H2O"
+ case default
+ write(carma%f_LUNOPRT,*) " icomposition : unknown, ", icomposition
+ end select
+ end if
+
+ return
+ end subroutine CARMAGAS_Print
+end module
diff --git a/src/physics/carma/base/carmagroup_mod.F90 b/src/physics/carma/base/carmagroup_mod.F90
new file mode 100644
index 0000000000..b1e4f77d13
--- /dev/null
+++ b/src/physics/carma/base/carmagroup_mod.F90
@@ -0,0 +1,731 @@
+!! The CARMAGROUP module contains configuration information about a CARMA partcile.
+!!
+!! NOTE: Because of the way Fortran handles pointers and allocations, it is much
+!! simpiler to have these methods directly access the group array that is in the
+!! CARMA object rather than having this as its own objects. Some compilers (like
+!! IBM on AIX do not by default automatically deallocate automatically created
+!! derived types that contain allocations. This can result in memory leaks that
+!! are difficult to find.
+!!
+!! These calls are written like they are part of CARMA, but they are called
+!! CARMAGROUP and kept by themselves in their own file to make it easier to keep
+!! track of what is required when adding an attribute to a group.
+!!
+!! @version July-2009
+!! @author Chuck Bardeen
+module carmagroup_mod
+
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+
+ ! CARMA explicitly declares all variables.
+ implicit none
+
+ ! All CARMA variables and procedures are private except those explicitly declared to be public.
+ private
+
+ ! Declare the public methods.
+ public CARMAGROUP_Create
+ public CARMAGROUP_Destroy
+ public CARMAGROUP_Get
+ public CARMAGROUP_Print
+
+contains
+
+ subroutine CARMAGROUP_Create(carma, igroup, name, rmin, rmrat, ishape, eshape, is_ice, rc, is_fractal, &
+ irhswell, irhswcomp, refidx, do_mie, do_wetdep, do_drydep, do_vtran, solfac, scavcoef, shortname, &
+ cnsttype, maxbin, ifallrtn, is_cloud, rmassmin, imiertn, is_sulfate, dpc_threshold, rmon, df, falpha, &
+ neutral_volfrc)
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: igroup !! the group index
+ character(*), intent(in) :: name !! the group name, maximum of 255 characters
+ real(kind=f), intent(in) :: rmin !! the minimum radius, can be specified [cm]
+ real(kind=f), intent(in) :: rmrat !! the volume ratio between bins
+ integer, intent(in) :: ishape !! the type of the particle shape
+ !! [I_SPHERE | I_HEXAGON | I_CYLINDER]
+ real(kind=f), intent(in) :: eshape !! the aspect ratio of the particle shape (length/diameter)
+ logical, intent(in) :: is_ice !! is this an ice particle?
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ logical, optional, intent(in) :: is_fractal !! is this a fractal particle?
+ integer, optional, intent(in) :: irhswell !! the parameterization for particle swelling
+ !! from relative humidity [I_FITZGERALD | I_GERBER]
+ integer, optional, intent(in) :: irhswcomp !! the composition for particle swelling
+ !! from relative humidity [I_FITZGERALD | I_GERBER]
+ complex(kind=f), optional, intent(in) :: refidx(carma%f_NWAVE) !! refractive index for the particle
+ logical, optional, intent(in) :: do_mie !! do mie calculations?
+ logical, optional, intent(in) :: do_wetdep !! do wet deposition for this particle?
+ logical, optional, intent(in) :: do_drydep !! do dry deposition for this particle?
+ logical, optional, intent(in) :: do_vtran !! do sedimentation for this particle?
+ real(kind=f), intent(in), optional :: solfac !! the solubility factor for wet deposition
+ real(kind=f), intent(in), optional :: scavcoef !! the scavenging coefficient for wet deposition
+ character(*), optional, intent(in) :: shortname !! the group shortname, maximum of 6 characters
+ integer, optional, intent(in) :: cnsttype !! constituent type in parent model
+ !! [I_CNSTTYPE_PROGNOSTIC | I_CNSTTYPE_DIAGNOSTIC]
+ integer, optional, intent(in) :: maxbin !! bin number of the last prognostic bin
+ !! the remaining bins are diagnostic
+ integer, optional, intent(in) :: ifallrtn !! fall velocity routine [I_FALLRTN_STD
+ !! | I_FALLRTN_STD_SHAPE | I_FALLRTN_HEYMSFIELD2010
+ !! | I_FALLRTN_ACKERMAN_DROP | I_FALLRTN_ACKERMAN_ICE]
+ logical, optional, intent(in) :: is_cloud !! is this a cloud particle?
+ real(kind=f), optional, intent(in) :: rmassmin !! the minimum mass, when used overrides rmin[g]
+ integer, optional, intent(in) :: imiertn !! mie routine [I_MIERTN_TOON1981 | I_MIERTN_BOHREN1983
+ !! | I_MIERTN_BOTET1997]
+ logical, optional, intent(in) :: is_sulfate !! is this a sulfate particle?
+ real(kind=f), optional, intent(in) :: dpc_threshold !! convergence criteria for particle concentration
+ !! [fraction]
+ real(kind=f), optional, intent(in) :: rmon !! monomer radius for fractal particles [cm]
+ real(kind=f), optional, intent(in) :: df(carma%f_NBIN) !! fractal dimension
+ real(kind=f), optional, intent(in) :: falpha !! fractal packing coefficient
+ real(kind=f), optional, intent(in) :: neutral_volfrc !! volume fraction of core mass for neutralization
+
+ ! Local variables
+ integer :: ier
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough groups allocated.
+ if (igroup > carma%f_NGROUP) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Add:: ERROR - The specifed group (", &
+ igroup, ") is larger than the number of groups (", carma%f_NGROUP, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ allocate( &
+ carma%f_group(igroup)%f_r(carma%f_NBIN), &
+ carma%f_group(igroup)%f_rmass(carma%f_NBIN), &
+ carma%f_group(igroup)%f_vol(carma%f_NBIN), &
+ carma%f_group(igroup)%f_dr(carma%f_NBIN), &
+ carma%f_group(igroup)%f_dm(carma%f_NBIN), &
+ carma%f_group(igroup)%f_rmassup(carma%f_NBIN), &
+ carma%f_group(igroup)%f_rup(carma%f_NBIN), &
+ carma%f_group(igroup)%f_rlow(carma%f_NBIN), &
+ carma%f_group(igroup)%f_icorelem(carma%f_NELEM), &
+ carma%f_group(igroup)%f_arat(carma%f_NBIN), &
+ carma%f_group(igroup)%f_rrat(carma%f_NBIN), &
+ carma%f_group(igroup)%f_rprat(carma%f_NBIN), &
+ carma%f_group(igroup)%f_df(carma%f_NBIN), &
+ carma%f_group(igroup)%f_nmon(carma%f_NBIN), &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Add: ERROR allocating, status=", ier
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Initialize
+ carma%f_group(igroup)%f_r(:) = 0._f
+ carma%f_group(igroup)%f_rmass(:) = 0._f
+ carma%f_group(igroup)%f_vol(:) = 0._f
+ carma%f_group(igroup)%f_dr(:) = 0._f
+ carma%f_group(igroup)%f_dm(:) = 0._f
+ carma%f_group(igroup)%f_rmassup(:) = 0._f
+ carma%f_group(igroup)%f_rup(:) = 0._f
+ carma%f_group(igroup)%f_rlow(:) = 0._f
+ carma%f_group(igroup)%f_icorelem(:) = 0
+ carma%f_group(igroup)%f_ifallrtn = I_FALLRTN_STD
+ carma%f_group(igroup)%f_imiertn = I_MIERTN_TOON1981
+ carma%f_group(igroup)%f_is_fractal = .false.
+ carma%f_group(igroup)%f_is_cloud = .false.
+ carma%f_group(igroup)%f_is_sulfate = .false.
+ carma%f_group(igroup)%f_dpc_threshold = 0._f
+ carma%f_group(igroup)%f_rmon = 0._f
+ carma%f_group(igroup)%f_df(:) = 3.0_f
+ carma%f_group(igroup)%f_nmon(:) = 1.0_f
+ carma%f_group(igroup)%f_falpha = 1.0_f
+ carma%f_group(igroup)%f_neutral_volfrc = 0.0_f
+
+ ! Any optical properties?
+ if (carma%f_NWAVE > 0) then
+ allocate( &
+ carma%f_group(igroup)%f_refidx(carma%f_NWAVE), &
+ carma%f_group(igroup)%f_qext(carma%f_NWAVE,carma%f_NBIN), &
+ carma%f_group(igroup)%f_ssa(carma%f_NWAVE,carma%f_NBIN), &
+ carma%f_group(igroup)%f_asym(carma%f_NWAVE,carma%f_NBIN), &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Add: ERROR allocating, status=", ier
+ rc = RC_ERROR
+ return
+ endif
+
+ ! Initialize
+ carma%f_group(igroup)%f_refidx(:) = (0._f, 0._f)
+ carma%f_group(igroup)%f_qext(:,:) = 0._f
+ carma%f_group(igroup)%f_ssa(:,:) = 0._f
+ carma%f_group(igroup)%f_asym(:,:) = 0._f
+ end if
+
+
+ ! Save off the settings.
+ carma%f_group(igroup)%f_name = name
+ carma%f_group(igroup)%f_rmin = rmin
+ carma%f_group(igroup)%f_rmrat = rmrat
+ carma%f_group(igroup)%f_ishape = ishape
+ carma%f_group(igroup)%f_eshape = eshape
+ carma%f_group(igroup)%f_is_ice = is_ice
+
+
+ ! Defaults for optional parameters
+ carma%f_group(igroup)%f_irhswell = 0
+ carma%f_group(igroup)%f_do_mie = .false.
+ carma%f_group(igroup)%f_do_wetdep = .false.
+ carma%f_group(igroup)%f_grp_do_drydep = .false.
+ carma%f_group(igroup)%f_grp_do_vtran = .true.
+ carma%f_group(igroup)%f_solfac = 0.3_f
+ carma%f_group(igroup)%f_scavcoef = 0.1_f
+ carma%f_group(igroup)%f_shortname = ""
+ carma%f_group(igroup)%f_cnsttype = I_CNSTTYPE_PROGNOSTIC
+ carma%f_group(igroup)%f_maxbin = carma%f_NBIN
+ carma%f_group(igroup)%f_rmassmin = 0.0_f
+
+ ! Set optional parameters.
+ if (present(irhswell)) carma%f_group(igroup)%f_irhswell = irhswell
+ if (present(irhswcomp)) carma%f_group(igroup)%f_irhswcomp = irhswcomp
+ if (present(refidx)) carma%f_group(igroup)%f_refidx(:) = refidx(:)
+ if (present(do_mie)) carma%f_group(igroup)%f_do_mie = do_mie
+ if (present(do_wetdep)) carma%f_group(igroup)%f_do_wetdep = do_wetdep
+ if (present(do_drydep)) carma%f_group(igroup)%f_grp_do_drydep = do_drydep
+ if (present(do_vtran)) carma%f_group(igroup)%f_grp_do_vtran = do_vtran
+ if (present(solfac)) carma%f_group(igroup)%f_solfac = solfac
+ if (present(scavcoef)) carma%f_group(igroup)%f_scavcoef = scavcoef
+ if (present(shortname)) carma%f_group(igroup)%f_shortname = shortname
+ if (present(cnsttype)) carma%f_group(igroup)%f_cnsttype = cnsttype
+ if (present(maxbin)) carma%f_group(igroup)%f_maxbin = maxbin
+ if (present(ifallrtn)) carma%f_group(igroup)%f_ifallrtn = ifallrtn
+ if (present(is_cloud)) carma%f_group(igroup)%f_is_cloud = is_cloud
+ if (present(is_fractal)) carma%f_group(igroup)%f_is_fractal = is_fractal
+ if (present(rmassmin)) carma%f_group(igroup)%f_rmassmin = rmassmin
+ if (present(imiertn)) carma%f_group(igroup)%f_imiertn = imiertn
+ if (present(is_sulfate)) carma%f_group(igroup)%f_is_sulfate = is_sulfate
+ if (present(dpc_threshold)) carma%f_group(igroup)%f_dpc_threshold = dpc_threshold
+ if (present(rmon)) carma%f_group(igroup)%f_rmon = rmon
+ if (present(df)) carma%f_group(igroup)%f_df(:) = df(:)
+ if (present(falpha)) carma%f_group(igroup)%f_falpha = falpha
+ if (present(neutral_volfrc)) carma%f_group(igroup)%f_neutral_volfrc = neutral_volfrc
+
+ ! Initialize other properties.
+ carma%f_group(igroup)%f_nelem = 0
+ carma%f_group(igroup)%f_if_sec_mom = .FALSE.
+ carma%f_group(igroup)%f_ncore = 0
+ carma%f_group(igroup)%f_ienconc = 0
+ carma%f_group(igroup)%f_imomelem = 0
+
+
+ ! The area ratio is the ratio of the area of the shape to the area of the
+ ! circumscribing circle. The radius ratio is the ratio between the radius
+ ! of the longest dimension and the radius of the enclosing sphere.
+ if (ishape .eq. I_HEXAGON) then
+ carma%f_group(igroup)%f_arat(:) = 3._f * sqrt(3._f) / 2._f / PI
+ carma%f_group(igroup)%f_rrat(:) = ((4._f * PI / 9._f / sqrt(3._f)) ** (1._f / 3._f)) * eshape**(-1._f / 3._f)
+ else if (ishape .eq. I_CYLINDER) then
+ carma%f_group(igroup)%f_arat(:) = 1.0_f
+ carma%f_group(igroup)%f_rrat(:) = ((2._f / 3._f) ** (1._f / 3._f)) * eshape**(-1._f / 3._f)
+ else
+
+ ! Default to a sphere.
+ !
+ ! NOTE: Should add code here to handle oblate and prolate spheroids.
+ carma%f_group(igroup)%f_arat(:) = 1.0_f
+ carma%f_group(igroup)%f_rrat(:) = 1.0_f
+ end if
+
+ carma%f_group(igroup)%f_rprat(:) = 1.0_f
+
+ !! Dry fractal aggregate aerosols composed of nmon identical spheres of radius rmon
+ !! can be treated by enabling the switch is_fractal = .true. Optical properties of dry
+ !! fractal aggregates can be computed using option imiertn = I_MIERTN_FRACTAL.
+ !! To use either of these options, the user must define the fractal dimension, df(NBIN),
+ !! monomer size (rmon), and packing coefficient (falpha) when creating the CARMA group.
+ !!
+ !! For aerosol particles fractal dimensions (df) are typically near 2.0, but can vary as a function
+ !! of size/number of monomers contained withing. The packing coefficient (falpha) is expected to be near
+ !! unity. falpha > 1 implies a more tightly packed fractal aggregate and vice-versa.
+ !!
+ !! If the user desires to use fractal optical properties calculation (I_MIERTN_BOTET1997), then
+ !! the user must also have fractal microphysics enabled (is_fractal = .true.). However, note that
+ !! if fractal microphysics are enabled, the user is free to select a standard Mie optical property calculation.
+ !!
+ !
+ ! Check consistency for fractal optical property calculation
+ if ((carma%f_group(igroup)%f_imiertn == I_MIERTN_BOTET1997) .and. &
+ .not. carma%f_group(igroup)%f_is_fractal) then
+ if (carma%f_do_print) then
+ write(carma%f_LUNOPRT, *) "CARMAGROUP_Create:&
+ &ERROR, fractal optics selected without fractal microphysics enabled."
+ end if
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Check input consistency for fractal physics
+ if (carma%f_group(igroup)%f_is_fractal .or. &
+ (carma%f_group(igroup)%f_imiertn == I_MIERTN_BOTET1997)) then
+ if (.not. (present(rmon) .and. present(df) .and. present(falpha))) then
+ if (carma%f_do_print) then
+ write(carma%f_LUNOPRT, *) "CARMAGROUP_Create:&
+ &ERROR, for fractal physics must set rmon,df,falpha"
+ end if
+ rc = RC_ERROR
+ return
+ end if
+ end if
+
+ return
+ end subroutine CARMAGROUP_Create
+
+
+ !! Deallocates the memory associated with a CARMAGROUP object.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMAGROUP_Create
+ subroutine CARMAGROUP_Destroy(carma, igroup, rc)
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: igroup !! the group index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+
+ ! Local variables
+ integer :: ier
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough groups allocated.
+ if (igroup > carma%f_NGROUP) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Destroy:: ERROR - The specifed group (", &
+ igroup, ") is larger than the number of groups (", carma%f_NGROUP, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ if (allocated(carma%f_group(igroup)%f_refidx)) then
+ deallocate( &
+ carma%f_group(igroup)%f_refidx, &
+ carma%f_group(igroup)%f_qext, &
+ carma%f_group(igroup)%f_ssa, &
+ carma%f_group(igroup)%f_asym, &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Destroy: ERROR deallocating, status=", ier
+ rc = RC_ERROR
+ return
+ endif
+ endif
+
+ ! Allocate dynamic data.
+ if (allocated(carma%f_group(igroup)%f_r)) then
+ deallocate( &
+ carma%f_group(igroup)%f_r, &
+ carma%f_group(igroup)%f_rmass, &
+ carma%f_group(igroup)%f_vol, &
+ carma%f_group(igroup)%f_dr, &
+ carma%f_group(igroup)%f_dm, &
+ carma%f_group(igroup)%f_rmassup, &
+ carma%f_group(igroup)%f_rup, &
+ carma%f_group(igroup)%f_rlow, &
+ carma%f_group(igroup)%f_icorelem, &
+ carma%f_group(igroup)%f_arat, &
+ carma%f_group(igroup)%f_rrat, &
+ carma%f_group(igroup)%f_rprat, &
+ carma%f_group(igroup)%f_df, &
+ carma%f_group(igroup)%f_nmon, &
+ stat=ier)
+ if(ier /= 0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Destroy: ERROR deallocating, status=", ier
+ rc = RC_ERROR
+ return
+ endif
+ endif
+
+ return
+ end subroutine CARMAGROUP_Destroy
+
+
+ !! Gets information about a group.
+ !!
+ !! The group name and most other properties are available after a call to
+ !! CARMAGROUP_Create(). After a call to CARMA_Initialize(), the bin
+ !! dimensions and optical properties can be retrieved.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMAGROUP_Create
+ !! @see CARMA_GetGroup
+ !! @see CARMA_Initialize
+ subroutine CARMAGROUP_Get(carma, igroup, rc, name, shortname, rmin, rmrat, ishape, eshape, is_ice, is_fractal, &
+ irhswell, irhswcomp, cnsttype, r, rlow, rup, dr, rmass, dm, vol, qext, ssa, asym, do_mie, &
+ do_wetdep, do_drydep, do_vtran, solfac, scavcoef, ienconc, refidx, ncore, icorelem, maxbin, &
+ ifallrtn, is_cloud, rmassmin, arat, rrat, rprat, imiertn, is_sulfate, dpc_threshold, rmon, df, &
+ nmon, falpha, neutral_volfrc)
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ integer, intent(in) :: igroup !! the group index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ character(len=*), optional, intent(out) :: name !! the group name
+ character(len=*), optional, intent(out) :: shortname !! the group short name
+ real(kind=f), optional, intent(out) :: rmin !! the minimum radius [cm]
+ real(kind=f), optional, intent(out) :: rmrat !! the volume ratio between bins
+ integer, optional, intent(out) :: ishape !! the type of the particle shape
+ real(kind=f), optional, intent(out) :: eshape !! the aspect ratio of the particle shape
+ logical, optional, intent(out) :: is_ice !! is this an ice particle?
+ logical, optional, intent(out) :: is_fractal !! is this a fractal?
+ integer, optional, intent(out) :: irhswell !! the parameterization for particle swelling
+ !! from relative humidity
+ integer, optional, intent(out) :: irhswcomp !! the composition for particle swelling
+ !! from relative humidity
+ integer, optional, intent(out) :: cnsttype !! constituent type in the parent model
+ real(kind=f), intent(out), optional :: r(carma%f_NBIN) !! the bin radius [cm]
+ real(kind=f), intent(out), optional :: rlow(carma%f_NBIN) !! the bin radius lower bound [cm]
+ real(kind=f), intent(out), optional :: rup(carma%f_NBIN) !! the bin radius upper bound [cm]
+ real(kind=f), intent(out), optional :: dr(carma%f_NBIN) !! the bin width in radius space [cm]
+ real(kind=f), intent(out), optional :: rmass(carma%f_NBIN) !! the bin mass [g]
+ real(kind=f), intent(out), optional :: dm(carma%f_NBIN) !! the bin width in mass space [g]
+ real(kind=f), intent(out), optional :: vol(carma%f_NBIN) !! the bin volume [cm3]
+ real(kind=f), intent(out), optional :: arat(carma%f_NBIN) !! the projected area ratio
+ !! (area / area enclosing sphere)
+ real(kind=f), intent(out), optional :: rrat(carma%f_NBIN) !! the radius ratio
+ !! (maximum dimension / radius of enclosing sphere)
+ real(kind=f), intent(out), optional :: rprat(carma%f_NBIN) !! the porusity radius ratio
+ !! (scaled porosity radius / equiv. sphere)
+ complex(kind=f), intent(out), optional :: refidx(carma%f_NWAVE) !! the refractive index at each wavelength
+ real(kind=f), intent(out), optional :: qext(carma%f_NWAVE,carma%f_NBIN) !! extinction efficiency
+ real(kind=f), intent(out), optional :: ssa(carma%f_NWAVE,carma%f_NBIN) !! single scattering albedo
+ real(kind=f), intent(out), optional :: asym(carma%f_NWAVE,carma%f_NBIN) !! asymmetry factor
+ logical, optional, intent(out) :: do_mie !! do mie calculations?
+ logical, optional, intent(out) :: do_wetdep !! do wet deposition for this particle?
+ logical, optional, intent(out) :: do_drydep !! do dry deposition for this particle?
+ logical, optional, intent(out) :: do_vtran !! do sedimentation for this particle?
+ real(kind=f), intent(out), optional :: solfac !! the solubility factor for wet deposition
+ real(kind=f), intent(out), optional :: scavcoef !! the scavenging coefficient for wet deposition
+ integer, intent(out), optional :: ienconc !! Particle number conc. element for group
+ integer, intent(out), optional :: ncore !! Number of core mass elements for group
+ integer, intent(out), optional :: icorelem(carma%f_NELEM) !! Element index of core mass elements for group
+ integer, optional, intent(out) :: maxbin !! the last prognostic bin in the group
+ integer, optional, intent(out) :: ifallrtn !! fall velocity routine [I_FALLRTN_STD
+ !! | I_FALLRTN_STD_SHAPE | I_FALLRTN_HEYMSFIELD2010
+ !! | I_FALLRTN_ACKERMAN_DROP
+ !! | I_FALLRTN_ACKERMAN_ICE]
+ logical, optional, intent(out) :: is_cloud !! is this a cloud particle?
+ real(kind=f), optional, intent(out) :: rmassmin !! the minimum mass [g]
+ integer, optional, intent(out) :: imiertn !! mie routine [I_MIERTN_TOON1981
+ !! | I_MIERTN_BOHREN1983 | I_MIERTN_BOTET1997]
+ logical, optional, intent(out) :: is_sulfate !! is this a sulfate particle?
+ real(kind=f), optional, intent(out) :: dpc_threshold !! convergence criteria for particle concentration
+ !! [fraction]
+ real(kind=f), optional, intent(out) :: rmon !! monomer radius for fractal particles
+ real(kind=f), optional, intent(out) :: df(carma%f_NBIN) !! fractal dimension
+ real(kind=f), optional, intent(out) :: nmon(carma%f_NBIN) !! number of monomers per
+ real(kind=f), optional, intent(out) :: falpha !! fractal packing coefficient
+ real(kind=f), optional, intent(out) :: neutral_volfrc !! volume fraction of core mass for neutralization
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough groups allocated.
+ if (igroup > carma%f_NGROUP) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Get:: ERROR - The specifed group (", &
+ igroup, ") is larger than the number of groups (", carma%f_NGROUP, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Return any requested properties of the group.
+ if (present(name)) name = carma%f_group(igroup)%f_name
+ if (present(shortname)) shortname = carma%f_group(igroup)%f_shortname
+ if (present(rmin)) rmin = carma%f_group(igroup)%f_rmin
+ if (present(rmrat)) rmrat = carma%f_group(igroup)%f_rmrat
+ if (present(ishape)) ishape = carma%f_group(igroup)%f_ishape
+ if (present(eshape)) eshape = carma%f_group(igroup)%f_eshape
+ if (present(is_ice)) is_ice = carma%f_group(igroup)%f_is_ice
+ if (present(is_fractal)) is_fractal = carma%f_group(igroup)%f_is_fractal
+ if (present(irhswell)) irhswell = carma%f_group(igroup)%f_irhswell
+ if (present(irhswcomp)) irhswcomp = carma%f_group(igroup)%f_irhswcomp
+ if (present(cnsttype)) cnsttype = carma%f_group(igroup)%f_cnsttype
+ if (present(r)) r(:) = carma%f_group(igroup)%f_r(:)
+ if (present(rlow)) rlow(:) = carma%f_group(igroup)%f_rlow(:)
+ if (present(rup)) rup(:) = carma%f_group(igroup)%f_rup(:)
+ if (present(dr)) dr(:) = carma%f_group(igroup)%f_dr(:)
+ if (present(rmass)) rmass(:) = carma%f_group(igroup)%f_rmass(:)
+ if (present(rrat)) rrat(:) = carma%f_group(igroup)%f_rrat(:)
+ if (present(arat)) arat(:) = carma%f_group(igroup)%f_arat(:)
+ if (present(rprat)) rprat(:) = carma%f_group(igroup)%f_rprat(:)
+ if (present(dm)) dm(:) = carma%f_group(igroup)%f_dm(:)
+ if (present(vol)) vol(:) = carma%f_group(igroup)%f_vol(:)
+ if (present(do_mie)) do_mie = carma%f_group(igroup)%f_do_mie
+ if (present(do_wetdep)) do_wetdep = carma%f_group(igroup)%f_do_wetdep
+ if (present(do_drydep)) do_drydep = carma%f_group(igroup)%f_grp_do_drydep
+ if (present(do_vtran)) do_vtran = carma%f_group(igroup)%f_grp_do_vtran
+ if (present(solfac)) solfac = carma%f_group(igroup)%f_solfac
+ if (present(scavcoef)) scavcoef = carma%f_group(igroup)%f_scavcoef
+ if (present(ienconc)) ienconc = carma%f_group(igroup)%f_ienconc
+ if (present(ncore)) ncore = carma%f_group(igroup)%f_ncore
+ if (present(icorelem)) icorelem = carma%f_group(igroup)%f_icorelem(:)
+ if (present(maxbin)) maxbin = carma%f_group(igroup)%f_maxbin
+ if (present(ifallrtn)) ifallrtn = carma%f_group(igroup)%f_ifallrtn
+ if (present(is_cloud)) is_cloud = carma%f_group(igroup)%f_is_cloud
+ if (present(rmassmin)) rmassmin = carma%f_group(igroup)%f_rmassmin
+ if (present(imiertn)) imiertn = carma%f_group(igroup)%f_imiertn
+ if (present(is_sulfate)) is_sulfate = carma%f_group(igroup)%f_is_sulfate
+ if (present(dpc_threshold)) dpc_threshold = carma%f_group(igroup)%f_dpc_threshold
+ if (present(rmon)) rmon = carma%f_group(igroup)%f_rmon
+ if (present(df)) df(:) = carma%f_group(igroup)%f_df(:)
+ if (present(nmon)) nmon(:) = carma%f_group(igroup)%f_nmon(:)
+ if (present(falpha)) falpha = carma%f_group(igroup)%f_falpha
+ if (present(neutral_volfrc)) neutral_volfrc = carma%f_group(igroup)%f_neutral_volfrc
+
+ if (carma%f_NWAVE == 0) then
+ if (present(refidx) .or. present(qext) .or. present(ssa) .or. present(asym)) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Get: ERROR no optical properties defined."
+ rc = RC_ERROR
+ return
+ end if
+ else
+ if (present(refidx)) refidx(:) = carma%f_group(igroup)%f_refidx(:)
+ if (present(qext)) qext(:,:) = carma%f_group(igroup)%f_qext(:,:)
+ if (present(ssa)) ssa(:,:) = carma%f_group(igroup)%f_ssa(:,:)
+ if (present(asym)) asym(:,:) = carma%f_group(igroup)%f_asym(:,:)
+ end if
+
+ return
+ end subroutine CARMAGROUP_Get
+
+
+
+ !! Prints information about a group.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMAGROUP_Get
+ subroutine CARMAGROUP_Print(carma, igroup, rc)
+ type(carma_type), intent(in) :: carma !! the carma object
+ integer, intent(in) :: igroup !! the group index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+
+ ! Local variables
+ integer :: i
+ character(len=CARMA_NAME_LEN) :: name ! name
+ character(len=CARMA_SHORT_NAME_LEN) :: shortname ! shortname
+ real(kind=f) :: rmin ! the minimum radius [cm]
+ real(kind=f) :: rmrat ! the volume ratio between bins
+ integer :: ishape ! the type of the particle shape
+ real(kind=f) :: eshape ! the aspect ratio of the particle shape
+ logical :: is_ice ! is this an ice particle?
+ logical :: is_fractal ! is this a fractal?
+ integer :: irhswell ! the parameterization for particle swelling
+ ! from relative humidity
+ integer :: irhswcomp ! the composition for particle swelling
+ ! from relative humidity
+ integer :: cnsttype ! constituent type in the parent model
+ real(kind=f) :: r(carma%f_NBIN) ! the bin radius [m]
+ real(kind=f) :: dr(carma%f_NBIN) ! the bin width in radius space [m]
+ real(kind=f) :: rmass(carma%f_NBIN) ! the bin mass [kg]
+ real(kind=f) :: dm(carma%f_NBIN) ! the bin width in mass space [kg]
+ real(kind=f) :: vol(carma%f_NBIN) ! the bin volume [m3]
+ integer :: ifallrtn ! fall velocity routine [I_FALLRTN_STD
+ ! | I_FALLRTN_STD_SHAPE | I_FALLRTN_HEYMSFIELD2010
+ ! | I_FALLRTN_ACKERMAN_DROP | I_FALLRTN_ACKERMAN_ICE]
+ logical :: is_cloud ! is this a cloud particle?
+ real(kind=f) :: rmassmin ! the minimum mass [g]
+ logical :: do_mie ! do mie calculations?
+ logical :: do_wetdep ! do wet deposition for this particle?
+ logical :: do_drydep ! do dry deposition for this particle?
+ logical :: do_vtran ! do sedimentation for this particle?
+ integer :: imiertn ! mie scattering routine
+ logical :: is_sulfate ! is this a sulfate particle?
+ real(kind=f) :: dpc_threshold ! convergence criteria for particle concentration
+ ! [fraction]
+ real(kind=f) :: neutral_volfrc ! volume fraction of core mass for neutralization
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Test out the Get method.
+ if (carma%f_do_print) then
+ call CARMAGROUP_Get(carma, igroup, rc, name=name, shortname=shortname, &
+ rmin=rmin, rmrat=rmrat, ishape=ishape, eshape=eshape, &
+ is_ice=is_ice, is_fractal=is_fractal, is_cloud=is_cloud, &
+ irhswell=irhswell, irhswcomp=irhswcomp, cnsttype=cnsttype, &
+ r=r, dr=dr, rmass=rmass, dm=dm, vol=vol, ifallrtn=ifallrtn, &
+ rmassmin=rmassmin, do_mie=do_mie, do_wetdep=do_wetdep, &
+ do_drydep=do_drydep, do_vtran=do_vtran, imiertn=imiertn, &
+ neutral_volfrc=neutral_volfrc)
+ if (rc < 0) return
+
+
+ write(carma%f_LUNOPRT,*) " name : ", trim(name)
+ write(carma%f_LUNOPRT,*) " shortname : ", trim(shortname)
+ write(carma%f_LUNOPRT,*) " rmin : ", rmin, " (cm)"
+ write(carma%f_LUNOPRT,*) " rmassmin : ", rmassmin, " (g)"
+ write(carma%f_LUNOPRT,*) " rmrat : ", rmrat
+ write(carma%f_LUNOPRT,*) " dpc_threshold : ", dpc_threshold
+
+ select case(ishape)
+ case (I_SPHERE)
+ write(carma%f_LUNOPRT,*) " ishape : spherical"
+ case (I_HEXAGON)
+ write(carma%f_LUNOPRT,*) " ishape : hexagonal"
+ case (I_CYLINDER)
+ write(carma%f_LUNOPRT,*) " ishape : cylindrical"
+ case default
+ write(carma%f_LUNOPRT,*) " ishape : unknown, ", ishape
+ end select
+
+ write(carma%f_LUNOPRT,*) " eshape : ", eshape
+ write(carma%f_LUNOPRT,*) " is_ice : ", is_ice
+ write(carma%f_LUNOPRT,*) " is_fractal : ", is_fractal
+ write(carma%f_LUNOPRT,*) " is_cloud : ", is_cloud
+ write(carma%f_LUNOPRT,*) " is_sulfate : ", is_sulfate
+
+ write(carma%f_LUNOPRT,*) " do_drydep : ", do_drydep
+ write(carma%f_LUNOPRT,*) " do_mie : ", do_mie
+ write(carma%f_LUNOPRT,*) " do_vtran : ", do_vtran
+ write(carma%f_LUNOPRT,*) " do_wetdep : ", do_wetdep
+ write(carma%f_LUNOPRT,*) " neutral_volfrc: ", neutral_volfrc
+
+ select case(irhswell)
+ case (0)
+ write(carma%f_LUNOPRT,*) " irhswell : none"
+ case (I_FITZGERALD)
+ write(carma%f_LUNOPRT,*) " irhswell : Fitzgerald"
+ case (I_GERBER)
+ write(carma%f_LUNOPRT,*) " irhswell : Gerber"
+ case default
+ write(carma%f_LUNOPRT,*) " irhswell : unknown, ", irhswell
+ end select
+
+ select case(irhswcomp)
+ case (0)
+ write(carma%f_LUNOPRT,*) " irhswcomp : none"
+
+ case (I_SWF_NH42SO4)
+ write(carma%f_LUNOPRT,*) " irhswcomp : (NH4)2SO4 (Fitzgerald)"
+ case (I_SWF_NH4NO3)
+ write(carma%f_LUNOPRT,*) " irhswcomp : NH4NO3 (Fitzgerald)"
+ case (I_SWF_NANO3)
+ write(carma%f_LUNOPRT,*) " irhswcomp : NaNO3 (Fitzgerald)"
+ case (I_SWF_NH4CL)
+ write(carma%f_LUNOPRT,*) " irhswcomp : NH4Cl (Fitzgerald)"
+ case (I_SWF_CACL2)
+ write(carma%f_LUNOPRT,*) " irhswcomp : CaCl2 (Fitzgerald)"
+ case (I_SWF_NABR)
+ write(carma%f_LUNOPRT,*) " irhswcomp : NaBr (Fitzgerald)"
+ case (I_SWF_NACL)
+ write(carma%f_LUNOPRT,*) " irhswcomp : NaCl (Fitzgerald)"
+ case (I_SWF_MGCL2)
+ write(carma%f_LUNOPRT,*) " irhswcomp : MgCl2 (Fitzgerald)"
+ case (I_SWF_LICL)
+ write(carma%f_LUNOPRT,*) " irhswcomp : LiCl (Fitzgerald)"
+
+ case (I_SWG_NH42SO4)
+ write(carma%f_LUNOPRT,*) " irhswcomp : (NH4)2SO4 (Gerber)"
+ case (I_SWG_RURAL)
+ write(carma%f_LUNOPRT,*) " irhswcomp : Rural (Gerber)"
+ case (I_SWG_SEA_SALT)
+ write(carma%f_LUNOPRT,*) " irhswcomp : Sea Salt (Gerber)"
+ case (I_SWG_URBAN)
+ write(carma%f_LUNOPRT,*) " irhswcomp : Urban (Gerber)"
+
+ case default
+ write(carma%f_LUNOPRT,*) " irhswell : unknown, ", irhswcomp
+ end select
+
+ select case(cnsttype)
+ case (0)
+ write(carma%f_LUNOPRT,*) " cnsttype : none"
+ case (I_CNSTTYPE_PROGNOSTIC)
+ write(carma%f_LUNOPRT,*) " cnsttype : prognostic"
+ case (I_CNSTTYPE_DIAGNOSTIC)
+ write(carma%f_LUNOPRT,*) " cnsttype : diagnostic"
+ case default
+ write(carma%f_LUNOPRT,*) " cnsttype : unknown, ", cnsttype
+ end select
+
+ select case(ifallrtn)
+ case (I_FALLRTN_STD)
+ write(carma%f_LUNOPRT,*) " ifallrtn : standard"
+ case (I_FALLRTN_STD_SHAPE)
+ write(carma%f_LUNOPRT,*) " ifallrtn : standard (shape)"
+ case (I_FALLRTN_HEYMSFIELD2010)
+ write(carma%f_LUNOPRT,*) " ifallrtn : Heymsfield & Westbrook, 2010"
+ case default
+ write(carma%f_LUNOPRT,*) " ifallrtn : unknown, ", ifallrtn
+ end select
+
+ select case(imiertn)
+ case (I_MIERTN_TOON1981)
+ write(carma%f_LUNOPRT,*) " imiertn : Toon & Ackerman, 1981"
+ case (I_MIERTN_BOHREN1983)
+ write(carma%f_LUNOPRT,*) " imiertn : Bohren & Huffman, 1983"
+ case (I_MIERTN_BOTET1997)
+ write(carma%f_LUNOPRT,*) " imiertn : Botet, Rannou & Cabane, 1997"
+ case default
+ write(carma%f_LUNOPRT,*) " imiertn : unknown, ", imiertn
+ end select
+
+ write(carma%f_LUNOPRT,*)
+ write(carma%f_LUNOPRT,"(' ', a4, 5a12)") "bin", "r", "dr", "rmass", "dm", "vol"
+ write(carma%f_LUNOPRT,"(' ', a4, 5a12)") "", "(cm)", "(cm)", "(g)", "(g)", "(cm3)"
+
+ do i = 1, carma%f_NBIN
+ write(carma%f_LUNOPRT, "(' ', i4, 5g12.3)") i, r(i), dr(i), rmass(i), dm(i), vol(i)
+ end do
+ end if
+
+ return
+ end subroutine CARMAGROUP_Print
+
+ !! Sets information about a group.
+ !!
+ !! Group optical properties may not be set by the CARMA initialization and
+ !! may instead be specified by an outside source (e.g. read in from a file).
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2013
+ !!
+ !! @see CARMAGROUP_Create
+ !! @see CARMA_GetGroup
+ !! @see CARMA_Initialize
+ subroutine CARMAGROUP_Set(carma, igroup, rc, qext, ssa, asym)
+
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: igroup !! the group index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ real(kind=f), intent(in), optional :: qext(carma%f_NWAVE,carma%f_NBIN) !! extinction efficiency
+ real(kind=f), intent(in), optional :: ssa(carma%f_NWAVE,carma%f_NBIN) !! single scattering albedo
+ real(kind=f), intent(in), optional :: asym(carma%f_NWAVE,carma%f_NBIN) !! asymmetry factor
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough groups allocated.
+ if (igroup > carma%f_NGROUP) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Set:: ERROR - The specifed group (", &
+ igroup, ") is larger than the number of groups (", carma%f_NGROUP, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Set any requested properties of the group.
+ if (carma%f_NWAVE == 0) then
+ if (present(qext) .or. present(ssa) .or. present(asym)) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMAGROUP_Get: ERROR no optical properties defined."
+ rc = RC_ERROR
+ return
+ end if
+ else
+ if (present(qext)) carma%f_group(igroup)%f_qext(:,:) = qext(:,:)
+ if (present(ssa)) carma%f_group(igroup)%f_ssa(:,:) = ssa(:,:)
+ if (present(asym)) carma%f_group(igroup)%f_asym(:,:) = asym(:,:)
+ end if
+
+ return
+ end subroutine CARMAGROUP_Set
+
+end module
diff --git a/src/physics/carma/base/carmasolute_mod.F90 b/src/physics/carma/base/carmasolute_mod.F90
new file mode 100644
index 0000000000..17274f579b
--- /dev/null
+++ b/src/physics/carma/base/carmasolute_mod.F90
@@ -0,0 +1,176 @@
+!! The CARMASOLUTE module contains configuration information about a solute used by CARMA.
+!!
+!! @version May-2009
+!! @author Chuck Bardeen
+module carmasolute_mod
+
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+
+ ! CARMA explicitly declares all variables.
+ implicit none
+
+ ! All CARMA variables and procedures are private except those explicitly declared to be public.
+ private
+
+ ! Declare the public methods.
+ public CARMASOLUTE_Create
+ public CARMASOLUTE_Destroy
+ public CARMASOLUTE_Get
+ public CARMASOLUTE_Print
+
+contains
+
+ !! Defines a solute used by CARMA for nucleation and growth of cloud and
+ !! aerosol particles.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMA_AddGas
+ !! @see CARMASOLUTE_Destroy
+ subroutine CARMASOLUTE_Create(carma, isolute, name, ions, wtmol, rho, rc, shortname)
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: isolute !! the solute index
+ character(*), intent(in) :: name !! the solute name, maximum of 255 characters
+ integer, intent(in) :: ions !! Number of ions solute dissociates into
+ real(kind=f), intent(in) :: wtmol !! the solute molecular weight [g/mol]
+ real(kind=f), intent(in) :: rho !! Mass density of solute
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ character(*), optional, intent(in) :: shortname !! the solute shortname, maximum of 6 characters
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough solutes allocated.
+ if (isolute > carma%f_NSOLUTE) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMASOLUTE_Create:: ERROR - The specifed solute (", &
+ isolute, ") is larger than the number of solutes (", carma%f_NSOLUTE, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Save off the settings.
+ carma%f_solute(isolute)%f_name = name
+ carma%f_solute(isolute)%f_ions = ions
+ carma%f_solute(isolute)%f_wtmol = wtmol
+ carma%f_solute(isolute)%f_rho = rho
+
+
+ ! Defaults for optional parameters
+ carma%f_solute(isolute)%f_shortname = ""
+
+ ! Set optional parameters.
+ if (present(shortname)) carma%f_solute(isolute)%f_shortname = shortname
+
+ return
+ end subroutine CARMASOLUTE_Create
+
+
+ !! Deallocates the memory associated with a CARMASOLUTE object.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMASOLUTE_Create
+ subroutine CARMASOLUTE_Destroy(carma, isolute, rc)
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(in) :: isolute !! the solute index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough solutes allocated.
+ if (isolute > carma%f_NSOLUTE) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMASOLUTE_Destroy:: ERROR - The specifed solute (", &
+ isolute, ") is larger than the number of solutes (", carma%f_NSOLUTE, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ return
+ end subroutine CARMASOLUTE_Destroy
+
+
+ !! Gets information about a solute.
+ !!
+ !! The group name and other properties are available after a call to
+ !! CARMASOLUTE_Create().
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMASOLUTE_Create
+ !! @see CARMA_GetGas
+ subroutine CARMASOLUTE_Get(carma, isolute, rc, name, shortname, ions, wtmol, rho)
+ type(carma_type), intent(in) :: carma !! the carma object
+ integer, intent(in) :: isolute !! the solute index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ character(len=*), optional, intent(out) :: name !! the solute name
+ character(len=*), optional, intent(out) :: shortname !! the solute short name
+ integer, optional, intent(out) :: ions !! Number of ions solute dissociates into
+ real(kind=f), optional, intent(out) :: wtmol !! the solute molecular weight [g/mol]
+ real(kind=f), optional, intent(out) :: rho !! Mass density of solute
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough solutes allocated.
+ if (isolute > carma%f_NSOLUTE) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "CARMASOLUTE_Get:: ERROR - The specifed solute (", &
+ isolute, ") is larger than the number of solutes (", carma%f_NSOLUTE, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Return any requested properties of the group.
+ if (present(name)) name = carma%f_solute(isolute)%f_name
+ if (present(shortname)) shortname = carma%f_solute(isolute)%f_shortname
+ if (present(ions)) ions = carma%f_solute(isolute)%f_ions
+ if (present(wtmol)) wtmol = carma%f_solute(isolute)%f_wtmol
+ if (present(rho)) rho = carma%f_solute(isolute)%f_rho
+
+ return
+ end subroutine CARMASOLUTE_Get
+
+
+ !! Prints information about a solute.
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2009
+ !!
+ !! @see CARMASOLUTE_Get
+ subroutine CARMASOLUTE_Print(carma, isolute, rc)
+ type(carma_type), intent(in) :: carma !! the carma object
+ integer, intent(in) :: isolute !! the solute index
+ integer, intent(out) :: rc !! return code, negative indicates failure
+
+ ! Local variables
+ character(len=CARMA_NAME_LEN) :: name !! name
+ character(len=CARMA_SHORT_NAME_LEN) :: shortname !! shortname
+ integer :: ions !! Number of ions solute dissociates into
+ real(kind=f) :: wtmol !! the solute molecular weight [g/mol]
+ real(kind=f) :: rho !! Mass density of solute
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Test out the Get method.
+ if (carma%f_do_print) then
+ call CARMASOLUTE_Get(carma, isolute, rc, name=name, shortname=shortname, ions=ions, wtmol=wtmol, rho=rho)
+ if (rc < 0) return
+
+
+ write(carma%f_LUNOPRT,*) " name : ", trim(name)
+ write(carma%f_LUNOPRT,*) " shortname : ", trim(shortname)
+ write(carma%f_LUNOPRT,*) " ions : ", ions
+ write(carma%f_LUNOPRT,*) " wtmol : ", wtmol, " (g/mol)"
+ write(carma%f_LUNOPRT,*) " rho : ", rho, " (g/cm3)"
+ end if
+
+ return
+ end subroutine CARMASOLUTE_Print
+end module
diff --git a/src/physics/carma/base/carmastate_mod.F90 b/src/physics/carma/base/carmastate_mod.F90
new file mode 100644
index 0000000000..0ce0a4438b
--- /dev/null
+++ b/src/physics/carma/base/carmastate_mod.F90
@@ -0,0 +1,1672 @@
+!! The CARMA state module contains the atmospheric data for use with the CARMA
+!! module. This implementation has been customized to work within other model
+!! frameworks. CARMA adds a lot of extra state information (atmospheric
+!! properties, fall velocities, coagulation kernels, growth kernels, ...) and
+!! thus has a large memory footprint. Because only one column will be operated
+!! upon at a time per thread, only one cstate object needs to be instantiated
+!! at a time and each cstate object only represents one column. This keeps
+!! the memory requirements of CARMA to a minimum.
+!!
+!! @version Feb-2009
+!! @author Chuck Bardeen, Pete Colarco, Jamie Smith
+!
+! NOTE: Documentation for this code can be generated automatically using f90doc,
+! which is freely available from:
+! http://erikdemaine.org/software/f90doc/
+! Comment lines with double comment characters are processed by f90doc, and there are
+! some special characters added to the comments to control the documentation process.
+! In addition to the special characters mentioned in the f990doc documentation, html
+! formatting tags (e.g. , , ...) can also be added to the f90doc
+! comments.
+module carmastate_mod
+
+ ! This module maps the parents models constants into the constants need by CARMA.
+ ! NOTE: CARMA constants are in CGS units, while the parent models are typically in
+ ! MKS units.
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+
+ ! cstate explicitly declares all variables.
+ implicit none
+
+ ! All cstate variables and procedures are private except those explicitly
+ ! declared to be public.
+ private
+
+ ! Declare the public methods.
+ public CARMASTATE_Create
+ public CARMASTATE_CreateFromReference
+ public CARMASTATE_Destroy
+ public CARMASTATE_Get
+ public CARMASTATE_GetBin
+ public CARMASTATE_GetDetrain
+ public CARMASTATE_GetGas
+ public CARMASTATE_GetState
+ public CARMASTATE_SetBin
+ public CARMASTATE_SetDetrain
+ public CARMASTATE_SetGas
+ public CARMASTATE_SetState
+ public CARMASTATE_Step
+
+contains
+
+ ! These are the methods that provide the interface between the parent model and
+ ! the atmospheric state data of the CARMA microphysical model. There are many other
+ ! methods that are not in this file that are used to implement the microphysical
+ ! calculations needed by the CARMA model. These other methods are in effect private
+ ! methods of the CARMA module, but are in individual files since that is the way that
+ ! CARMA has traditionally been structured and where users may want to extend or
+ ! replace code to affect the microphysics.
+
+ !! Create the CARMASTATE object, which contains information about the
+ !! atmospheric state. Internally, CARMA uses CGS units, but this interface uses
+ !! MKS units which are more commonly used in parent models. The units and grid
+ !! orientation depend on the grid type:
+ !!
+ !! - igridh
+ !! - I_CART : Cartesian coordinates, units in [m]
+ !! - I_LL : Lat/Lon coordinates, units in [degrees]
+ !!
+ !! - igridv
+ !! - I_CART : Cartesian coordinates, units in [m], bottom at NZ=1
+ !! - I_SIG : Sigma coordinates, unitless [P/P0], top at NZ=1
+ !! - I_HYBRID : Hybrid coordinates, unitless [~P/P0], top at NZ=1
+ !!
+ !! NOTE: The supplied CARMA object should already have been created, configured,
+ !! and initialized.
+ !!
+ !! NOTE: The relative humidity is optional, but needs to be supplied if particles
+ !! are subject to swelling based upon relative humidity. The specific humdity can
+ !! can be specified instead. If both are specified, then the realtive humidity is
+ !! used.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ !! @see CARMA_Create
+ !! @see CARMA_Initialize
+ !! @see CARMASTATE_Destroy
+ subroutine CARMASTATE_Create(cstate, carma_ptr, time, dtime, NZ, igridv, igridh, &
+ lat, lon, xc, dx, yc, dy, zc, zl, p, pl, t, rc, qh2o, relhum, told, radint)
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ type(carma_type), pointer, intent(in) :: carma_ptr !! (in) the carma object
+ real(kind=f), intent(in) :: time !! the model time [s]
+ real(kind=f), intent(in) :: dtime !! the timestep size [s]
+ integer, intent(in) :: NZ !! the number of vertical grid points
+ integer, intent(in) :: igridv !! vertical grid type
+ integer, intent(in) :: igridh !! horizontal grid type
+ real(kind=f), intent(in) :: lat !! latitude at center [degrees north]
+ real(kind=f), intent(in) :: lon !! longitude at center [degrees east]
+ real(kind=f), intent(in) :: xc(NZ) !! x at center
+ real(kind=f), intent(in) :: dx(NZ) !! ix width
+ real(kind=f), intent(in) :: yc(NZ) !! y at center
+ real(kind=f), intent(in) :: dy(NZ) !! y width
+ real(kind=f), intent(in) :: zc(NZ) !! z at center
+ real(kind=f), intent(in) :: zl(NZ+1) !! z at edge
+ real(kind=f), intent(in) :: p(NZ) !! pressure at center [Pa]
+ real(kind=f), intent(in) :: pl(NZ+1) !! presssure at edge [Pa]
+ real(kind=f), intent(in) :: t(NZ) !! temperature at center [K]
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ real(kind=f), intent(in) , optional :: qh2o(NZ) !! specific humidity at center [mmr]
+ real(kind=f), intent(in) , optional :: relhum(NZ) !! relative humidity at center [fraction]
+ real(kind=f), intent(in) , optional :: told(NZ) !! previous temperature at center [K]
+ real(kind=f), intent(in) , optional :: radint(NZ,carma_ptr%f_NWAVE) !! radiative intensity [W/m2/sr/cm]
+
+ integer :: iz
+ real(kind=f) :: rvap
+ real(kind=f) :: pvap_liq
+ real(kind=f) :: pvap_ice
+ real(kind=f) :: gc_cgs
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Save the defintion of the number of comonents involved in the microphysics.
+ cstate%f_carma => carma_ptr
+
+ ! Save the model timing.
+ cstate%f_time = time
+ cstate%f_dtime_orig = dtime
+ cstate%f_dtime = dtime
+ cstate%f_nretries = 0
+
+ ! Save the grid dimensions.
+ cstate%f_NZ = NZ
+ cstate%f_NZP1 = NZ+1
+
+ ! Save the grid definition.
+ cstate%f_igridv = igridv
+ cstate%f_igridh = igridh
+
+ ! Store away the grid location information.
+ cstate%f_lat = lat
+ cstate%f_lon = lon
+
+ ! Allocate all the dynamic variables related to state.
+ call CARMASTATE_Allocate(cstate, rc)
+ if (rc < 0) return
+
+ cstate%f_xc(:) = xc(:)
+ cstate%f_dx(:) = dx(:)
+ cstate%f_yc(:) = yc(:)
+ cstate%f_dy(:) = dy(:)
+ cstate%f_zc(:) = zc(:)
+ cstate%f_zl(:) = zl(:)
+
+ ! Store away the grid state, doing any necessary unit conversions from MKS to CGS.
+ cstate%f_p(:) = p(:) * RPA2CGS
+ cstate%f_pl(:) = pl(:) * RPA2CGS
+ cstate%f_t(:) = t(:)
+
+ cstate%f_pcd(:,:,:) = 0._f
+
+ if (carma_ptr%f_do_substep) then
+ if (present(told)) then
+ cstate%f_told(:) = told
+ else
+ if (carma_ptr%f_do_print) write(carma_ptr%f_LUNOPRT,*) "CARMASTATE_Create: Error - Need to specify told when substepping."
+ rc = RC_ERROR
+
+ return
+ end if
+ end if
+
+ ! Calculate the metrics, ...
+ ! if Cartesian coordinates were specifed, then the units need to be converted
+ ! from MKS to CGS.
+ if (cstate%f_igridh == I_CART) then
+ cstate%f_xc = cstate%f_xc * RM2CGS
+ cstate%f_dx = cstate%f_dx * RM2CGS
+ cstate%f_yc = cstate%f_yc * RM2CGS
+ cstate%f_dy = cstate%f_dy * RM2CGS
+ end if
+
+ if (cstate%f_igridv == I_CART) then
+ cstate%f_zc = cstate%f_zc * RM2CGS
+ cstate%f_zl = cstate%f_zl * RM2CGS
+ end if
+
+ ! Initialize the state of the atmosphere.
+ call setupatm(carma_ptr, cstate, carma_ptr%f_do_fixedinit, rc)
+ if (rc < 0) return
+
+ ! Set the realtive humidity. If necessary, it will be calculated from
+ ! the specific humidity.
+ if (present(relhum)) then
+ cstate%f_relhum(:) = relhum(:)
+ else if (present(qh2o)) then
+
+ ! Define gas constant for this gas
+ rvap = RGAS/WTMOL_H2O
+
+ ! Calculate relative humidity
+ do iz = 1, NZ
+ call vaporp_h2o_murphy2005(carma_ptr, cstate, iz, rc, pvap_liq, pvap_ice)
+ if (rc < 0) return
+
+ gc_cgs = qh2o(iz)*cstate%f_rhoa_wet(iz) / (cstate%f_zmet(iz)*cstate%f_xmet(iz)*cstate%f_ymet(iz))
+ cstate%f_relhum(iz) = ( gc_cgs * rvap * t(iz)) / pvap_liq
+ enddo
+ end if
+
+ ! Need for vertical transport.
+ !
+ ! NOTE: How should these be set? Optional parameters?
+ if (carma_ptr%f_do_vtran) then
+ cstate%f_ftoppart(:,:) = 0._f
+ cstate%f_fbotpart(:,:) = 0._f
+ cstate%f_pc_topbnd(:,:) = 0._f
+ cstate%f_pc_botbnd(:,:) = 0._f
+ end if
+
+ ! Radiative intensity for particle heating.
+ !
+ ! W/m2/sr/cm -> erg/s/cm2/sr/cm
+ if (carma_ptr%f_do_grow) then
+ if (present(radint)) cstate%f_radint(:,:) = radint(:,:) * 1e7_f / 1e4_f
+ end if
+
+ return
+ end subroutine CARMASTATE_Create
+
+
+ !! Create the CARMASTATE object, which contains information about the
+ !! atmospheric state.
+ !!
+ !! This call is similar to CARMASTATE_Create, but differs in that all the
+ !! initialization happens here based on the the fixed state information provided rather
+ !! than occurring in CARMASTATE_Step.
+ !!
+ !! This call should be done before CARMASTATE_Create when do_fixedinit has been
+ !! specified. The temperatures and pressures specified here should be the reference
+ !! state used for all columns, not an actual column from the model.
+ !!
+ !! A water vapor profile is optional, but is used whenever either qh2o (preferred)
+ !! or relhum have been provided. If this is not provided, then initialization will
+ !! be done on a dry profile. If particle swelling occurs, initialization will be
+ !! done on the wet radius; however, most of the initialized values will not get
+ !! recalculated as the wet radius changes.
+ !!
+ !! CARMASTATE_Create should still be called again after this call with the actual
+ !! column of state information from the model. The initialization will be done once
+ !! from the reference state, but the microphysical calculations will be done on the
+ !! model state. Multiple CARMASTATE_Create ... CARMASTATE_Step calls can be done
+ !! before a CARMASTATE_Destroy. This reduces the amount of memory allocations and
+ !! when used with do_fixedinit, reduces the amount of time spent initializing.
+ !!
+ !! @author Chuck Bardeen
+ !! @version June-2010
+ !! @see CARMA_Create
+ !! @see CARMA_Initialize
+ !! @see CARMASTATE_Destroy
+ subroutine CARMASTATE_CreateFromReference(cstate, carma_ptr, time, dtime, NZ, igridv, igridh, &
+ lat, lon, xc, dx, yc, dy, zc, zl, p, pl, t, rc, qh2o, relhum, qh2so4)
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ type(carma_type), pointer, intent(in) :: carma_ptr !! (in) the carma object
+ real(kind=f), intent(in) :: time !! the model time [s]
+ real(kind=f), intent(in) :: dtime !! the timestep size [s]
+ integer, intent(in) :: NZ !! the number of vertical grid points
+ integer, intent(in) :: igridv !! vertical grid type
+ integer, intent(in) :: igridh !! horizontal grid type
+ real(kind=f), intent(in) :: lat !! latitude at center [degrees north]
+ real(kind=f), intent(in) :: lon !! longitude at center [degrees east]
+ real(kind=f), intent(in) :: xc(NZ) !! x at center
+ real(kind=f), intent(in) :: dx(NZ) !! ix width
+ real(kind=f), intent(in) :: yc(NZ) !! y at center
+ real(kind=f), intent(in) :: dy(NZ) !! y width
+ real(kind=f), intent(in) :: zc(NZ) !! z at center
+ real(kind=f), intent(in) :: zl(NZ+1) !! z at edge
+ real(kind=f), intent(in) :: p(NZ) !! pressure at center [Pa]
+ real(kind=f), intent(in) :: pl(NZ+1) !! presssure at edge [Pa]
+ real(kind=f), intent(in) :: t(NZ) !! temperature at center [K]
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ real(kind=f), intent(in) , optional :: qh2o(NZ) !! specific humidity at center [mmr]
+ real(kind=f), intent(in) , optional :: relhum(NZ) !! relative humidity at center [fraction]
+ real(kind=f), intent(in) , optional :: qh2so4(NZ) !! H2SO4 mass mixing ratio at center [mmr]
+
+ integer :: iz
+ integer :: igas
+ real(kind=f) :: rvap
+ real(kind=f) :: pvap_liq
+ real(kind=f) :: pvap_ice
+ real(kind=f) :: gc_cgs
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Save the defintion of the number of comonents involved in the microphysics.
+ cstate%f_carma => carma_ptr
+
+ ! Save the model timing.
+ cstate%f_time = time
+ cstate%f_dtime_orig = dtime
+ cstate%f_dtime = dtime
+ cstate%f_nretries = 0
+
+ ! Save the grid dimensions.
+ cstate%f_NZ = NZ
+ cstate%f_NZP1 = NZ+1
+
+ ! Save the grid definition.
+ cstate%f_igridv = igridv
+ cstate%f_igridh = igridh
+
+ ! Store away the grid location information.
+ cstate%f_lat = lat
+ cstate%f_lon = lon
+
+ ! Allocate all the dynamic variables related to state.
+ call CARMASTATE_Allocate(cstate, rc)
+ if (rc < 0) return
+
+ cstate%f_xc(:) = xc(:)
+ cstate%f_dx(:) = dx(:)
+ cstate%f_yc(:) = yc(:)
+ cstate%f_dy(:) = dy(:)
+ cstate%f_zc(:) = zc(:)
+ cstate%f_zl(:) = zl(:)
+
+ ! Store away the grid state, doing any necessary unit conversions from MKS to CGS.
+ cstate%f_p(:) = p(:) * RPA2CGS
+ cstate%f_pl(:) = pl(:) * RPA2CGS
+ cstate%f_t(:) = t(:)
+
+ cstate%f_pcd(:,:,:) = 0._f
+
+ ! Calculate the metrics, ...
+ ! if Cartesian coordinates were specifed, then the units need to be converted
+ ! from MKS to CGS.
+ if (cstate%f_igridh == I_CART) then
+ cstate%f_xc = cstate%f_xc * RM2CGS
+ cstate%f_dx = cstate%f_dx * RM2CGS
+ cstate%f_yc = cstate%f_yc * RM2CGS
+ cstate%f_dy = cstate%f_dy * RM2CGS
+ end if
+
+ if (cstate%f_igridv == I_CART) then
+ cstate%f_zc = cstate%f_zc * RM2CGS
+ cstate%f_zl = cstate%f_zl * RM2CGS
+ end if
+
+ ! Initialize the state of the atmosphere.
+ call setupatm(carma_ptr, cstate, .false., rc)
+ if (rc < 0) return
+
+ ! If the model uses a gas, then set the relative and
+ ! specific humidities.
+ if (carma_ptr%f_igash2o /= 0) then
+
+ if (present(qh2o)) then
+ cstate%f_gc(:, carma_ptr%f_igash2o) = qh2o(:) * cstate%f_rhoa_wet(:)
+
+ ! Define gas constant for this gas
+ rvap = RGAS/WTMOL_H2O
+
+ ! Calculate relative humidity
+ do iz = 1, NZ
+ call vaporp_h2o_murphy2005(carma_ptr, cstate, iz, rc, pvap_liq, pvap_ice)
+ if (rc < 0) return
+
+ gc_cgs = qh2o(iz) * cstate%f_rhoa_wet(iz) / (cstate%f_zmet(iz)*cstate%f_xmet(iz)*cstate%f_ymet(iz))
+ cstate%f_relhum(iz) = (gc_cgs * rvap * t(iz)) / pvap_liq
+ enddo
+
+ else if (present(relhum)) then
+ cstate%f_relhum(:) = relhum
+
+ ! Define gas constant for this gas
+ rvap = RGAS/WTMOL_H2O
+
+ ! Calculate specific humidity
+ do iz = 1, NZ
+ call vaporp_h2o_murphy2005(carma_ptr, cstate, iz, rc, pvap_liq, pvap_ice)
+ if (rc < 0) return
+
+ gc_cgs = (rvap * t(iz)) / (pvap_liq * relhum(iz))
+ cstate%f_gc(iz, carma_ptr%f_igash2o) = gc_cgs * &
+ (cstate%f_zmet(iz)*cstate%f_xmet(iz)*cstate%f_ymet(iz)) / &
+ cstate%f_rhoa_wet(iz)
+ enddo
+ end if
+ end if
+
+ ! If the model uses sulfuric acid, then set that gas concentration.
+ if (carma_ptr%f_igash2so4 /= 0) then
+ if (present(qh2so4)) then
+ cstate%f_gc(:, carma_ptr%f_igash2so4) = qh2so4(:) * cstate%f_rhoa_wet(:)
+ end if
+ end if
+
+ ! Determine the gas supersaturations.
+ do iz = 1, cstate%f_NZ
+ do igas = 1, cstate%f_carma%f_NGAS
+ call supersat(cstate%f_carma, cstate, iz, igas, rc)
+ if (rc < 0) return
+ end do
+ end do
+
+ ! Need for vertical transport.
+ !
+ ! NOTE: How should these be set? Optional parameters?
+ if (carma_ptr%f_do_vtran) then
+ cstate%f_ftoppart(:,:) = 0._f
+ cstate%f_fbotpart(:,:) = 0._f
+ cstate%f_pc_topbnd(:,:) = 0._f
+ cstate%f_pc_botbnd(:,:) = 0._f
+ end if
+
+
+ ! Now do the initialization that is normally done in CARMASTATE_Step. However
+ ! here it is done using the reference atmosphere.
+
+ ! Determine the particle densities.
+ call rhopart(cstate%f_carma, cstate, rc)
+ if (rc < 0) return
+
+ ! Save off the wet radius and wet density as reference values to be used
+ ! later to scale process rates based upon changes to the wet radius and
+ ! wet density when particle swelling is used.
+ cstate%f_r_ref(:,:,:) = cstate%f_r_wet(:,:,:)
+ cstate%f_rhop_ref(:,:,:) = cstate%f_rhop_wet(:,:,:)
+
+ ! If configured for fixed initialization, then we will lose some accuracy
+ ! in the calculation of the fall velocities, growth kernels, ... and in return
+ ! will gain a significant performance by not having to initialize as often.
+
+ ! Initialize the vertical transport.
+ if (cstate%f_carma%f_do_vtran .or. cstate%f_carma%f_do_coag .or. cstate%f_carma%f_do_grow) then
+ call setupvf(cstate%f_carma, cstate, rc)
+
+ if (cstate%f_carma%f_do_vdiff) then
+ call setupbdif(cstate%f_carma, cstate, rc)
+ end if
+ end if
+
+ ! Intialize the nucleation, growth and evaporation.
+ if (cstate%f_carma%f_do_grow) then
+ call setupgrow(cstate%f_carma, cstate, rc)
+ if (rc < 0) return
+
+ call setupgkern(cstate%f_carma, cstate, rc)
+ if (rc < 0) return
+
+ call setupnuc(cstate%f_carma, cstate, rc)
+ if (rc < 0) return
+ end if
+
+ ! Initialize the coagulation.
+ if (cstate%f_carma%f_do_coag) then
+ call setupckern(cstate%f_carma, cstate, rc)
+ if (rc < 0) return
+ end if
+
+ return
+ end subroutine CARMASTATE_CreateFromReference
+
+
+ subroutine CARMASTATE_Allocate(cstate, rc)
+ type(carmastate_type), intent(inout) :: cstate
+ integer, intent(out) :: rc
+
+ ! Local Variables
+ integer :: ier
+ integer :: NZ
+ integer :: NZP1
+ integer :: NGROUP
+ integer :: NELEM
+ integer :: NBIN
+ integer :: NGAS
+ integer :: NWAVE
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Check to see if the arrays are already allocated. If so, just reuse the
+ ! existing allocations.
+
+ ! Allocate the variables needed for setupatm.
+ if (.not. (allocated(cstate%f_xmet))) then
+
+ NZ = cstate%f_NZ
+ NZP1 = cstate%f_NZP1
+ NGROUP = cstate%f_carma%f_NGROUP
+ NELEM = cstate%f_carma%f_NELEM
+ NBIN = cstate%f_carma%f_NBIN
+ NGAS = cstate%f_carma%f_NGAS
+ NWAVE = cstate%f_carma%f_NWAVE
+
+ allocate( &
+ cstate%f_xmet(NZ), &
+ cstate%f_ymet(NZ), &
+ cstate%f_zmet(NZ), &
+ cstate%f_zmetl(NZP1), &
+ cstate%f_xc(NZ), &
+ cstate%f_yc(NZ), &
+ cstate%f_zc(NZ), &
+ cstate%f_dx(NZ), &
+ cstate%f_dy(NZ), &
+ cstate%f_dz(NZ), &
+ cstate%f_zl(NZP1), &
+ cstate%f_pc(NZ,NBIN,NELEM), &
+ cstate%f_pcd(NZ,NBIN,NELEM), &
+ cstate%f_pc_surf(NBIN,NELEM), &
+ cstate%f_sedimentationflux(NBIN,NELEM), &
+ cstate%f_gc(NZ,NGAS), &
+ cstate%f_cldfrc(NZ), &
+ cstate%f_rhcrit(NZ), &
+ cstate%f_rhop(NZ,NBIN,NGROUP), &
+ cstate%f_r_wet(NZ,NBIN,NGROUP), &
+ cstate%f_rlow_wet(NZ,NBIN,NGROUP), &
+ cstate%f_rup_wet(NZ,NBIN,NGROUP), &
+ cstate%f_rhop_wet(NZ,NBIN,NGROUP), &
+ cstate%f_r_ref(NZ,NBIN,NGROUP), &
+ cstate%f_rhop_ref(NZ,NBIN,NGROUP), &
+ cstate%f_rhoa(NZ), &
+ cstate%f_rhoa_wet(NZ), &
+ cstate%f_t(NZ), &
+ cstate%f_p(NZ), &
+ cstate%f_pl(NZP1), &
+ cstate%f_relhum(NZ), &
+ cstate%f_wtpct(NZ), &
+ cstate%f_rmu(NZ), &
+ cstate%f_thcond(NZ), &
+ cstate%f_thcondnc(NZ,NBIN,NGROUP), &
+ cstate%f_dpc_sed(NBIN,NELEM), &
+ cstate%f_pconmax(NZ,NGROUP), &
+ cstate%f_pcl(NZ,NBIN,NELEM), &
+ stat=ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Allocate::&
+ &ERROR allocating atmosphere arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ end if
+
+ cstate%f_relhum(:) = 0._f
+ cstate%f_pc(:,:,:) = 0._f
+ cstate%f_pcd(:,:,:) = 0._f
+ cstate%f_pc_surf(:,:) = 0._f
+ cstate%f_sedimentationflux(:,:) = 0._f
+ cstate%f_cldfrc(:) = 1._f
+ cstate%f_rhcrit(:) = 1._f
+
+ ! Allocate the last fields if they are needed for substepping.
+ if (cstate%f_carma%f_do_substep) then
+ allocate( &
+ cstate%f_gcl(NZ,NGAS), &
+ cstate%f_d_gc(NZ,NGAS), &
+ cstate%f_told(NZ), &
+ cstate%f_d_t(NZ), &
+ cstate%f_zsubsteps(NZ), &
+ stat=ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Allocate::&
+ &ERROR allocating stepping arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ endif
+
+ ! Initialize
+ cstate%f_gcl(:,:) = 0._f
+ cstate%f_d_gc(:,:) = 0._f
+ cstate%f_told(:) = 0._f
+ cstate%f_d_t(:) = 0._f
+ cstate%f_zsubsteps(:) = 0._f
+
+ ! When substepping is enabled, we want to initialize these statistics once for
+ ! the life of the object.
+ cstate%f_max_nsubstep = 0
+ cstate%f_max_nretry = 0._f
+ cstate%f_nstep = 0._f
+ cstate%f_nsubstep = 0
+ cstate%f_nretry = 0._f
+ endif
+
+
+ ! Allocate the variables needed for setupvf.
+ !
+ ! NOTE: Coagulation and dry deposition also need bpm, vf and re.
+ if (cstate%f_carma%f_do_vtran .or. cstate%f_carma%f_do_coag .or. &
+ cstate%f_carma%f_do_grow .or. cstate%f_carma%f_do_drydep) then
+ allocate( &
+ cstate%f_bpm(NZ,NBIN,NGROUP), &
+ cstate%f_vf(NZP1,NBIN,NGROUP), &
+ cstate%f_re(NZ,NBIN,NGROUP), &
+ cstate%f_dkz(NZP1,NBIN,NGROUP), &
+ cstate%f_ftoppart(NBIN,NELEM), &
+ cstate%f_fbotpart(NBIN,NELEM), &
+ cstate%f_pc_topbnd(NBIN,NELEM), &
+ cstate%f_pc_botbnd(NBIN,NELEM), &
+ cstate%f_vd(NBIN, NGROUP), &
+ stat=ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Allocate::&
+ &ERROR allocating vertical transport arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ endif
+
+ ! Initialize
+ cstate%f_bpm(:,:,:) = 0._f
+ cstate%f_vf(:,:,:) = 0._f
+ cstate%f_re(:,:,:) = 0._f
+ cstate%f_dkz(:,:,:) = 0._f
+ cstate%f_ftoppart(:,:) = 0._f
+ cstate%f_fbotpart(:,:) = 0._f
+ cstate%f_pc_topbnd(:,:) = 0._f
+ cstate%f_pc_botbnd(:,:) = 0._f
+ cstate%f_vd(:, :) = 0._f
+ end if
+
+
+
+ if (cstate%f_carma%f_NGAS > 0) then
+ allocate( &
+ cstate%f_pvapl(NZ,NGAS), &
+ cstate%f_pvapi(NZ,NGAS), &
+ cstate%f_supsatl(NZ,NGAS), &
+ cstate%f_supsati(NZ,NGAS), &
+ cstate%f_supsatlold(NZ,NGAS), &
+ cstate%f_supsatiold(NZ,NGAS), &
+ stat=ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Allocate::&
+ ERROR allocating gas arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ endif
+ end if
+
+
+ if (cstate%f_carma%f_do_grow) then
+ allocate( &
+ cstate%f_diffus(NZ,NGAS), &
+ cstate%f_rlhe(NZ,NGAS), &
+ cstate%f_rlhm(NZ,NGAS), &
+ cstate%f_surfctwa(NZ), &
+ cstate%f_surfctiw(NZ), &
+ cstate%f_surfctia(NZ), &
+ cstate%f_akelvin(NZ,NGAS), &
+ cstate%f_akelvini(NZ,NGAS), &
+ cstate%f_ft(NZ,NBIN,NGROUP), &
+ cstate%f_gro(NZ,NBIN,NGROUP), &
+ cstate%f_gro1(NZ,NBIN,NGROUP), &
+ cstate%f_gro2(NZ,NGROUP), &
+ cstate%f_scrit(NZ,NBIN,NGROUP), &
+ cstate%f_rnuclg(NBIN,NGROUP,NGROUP),&
+ cstate%f_rhompe(NBIN,NELEM), &
+ cstate%f_rnucpe(NBIN,NELEM), &
+ cstate%f_pc_nucl(NZ,NBIN,NELEM), &
+ cstate%f_growpe(NBIN,NELEM), &
+ cstate%f_evappe(NBIN,NELEM), &
+ cstate%f_evcore(NELEM), &
+ cstate%f_growlg(NBIN,NGROUP), &
+ cstate%f_evaplg(NBIN,NGROUP), &
+ cstate%f_gasprod(NGAS), &
+ cstate%f_rlheat(NZ), &
+ cstate%f_radint(NZ,NWAVE), &
+ cstate%f_partheat(NZ), &
+ cstate%f_dtpart(NZ,NBIN,NGROUP), &
+ cstate%f_cmf(NBIN,NGROUP), &
+ cstate%f_totevap(NBIN,NGROUP), &
+ stat=ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Allocate::&
+ &ERROR allocating growth arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ endif
+
+ cstate%f_radint(:,:) = 0._f
+ end if
+
+ if (cstate%f_carma%f_do_coag) then
+ allocate( &
+ cstate%f_coaglg(NZ,NBIN,NGROUP), &
+ cstate%f_coagpe(NZ,NBIN,NELEM), &
+ cstate%f_ckernel(NZ,NBIN,NBIN,NGROUP,NGROUP), &
+ stat = ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Allocate::&
+ &ERROR allocating coag arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Initialize
+ cstate%f_coaglg(:,:,:) = 0._f
+ cstate%f_coagpe(:,:,:) = 0._f
+ cstate%f_ckernel(:,:,:,:,:) = 0._f
+ end if
+ end if
+
+ return
+ end subroutine CARMASTATE_Allocate
+
+
+ !! The routine should be called when the carma state object is no longer needed.
+ !! It deallocates any memory allocations made by CARMA during CARMASTATE_Create(),
+ !! and failure to call this routine could result in memory leaks.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ !! @see CARMASTATE_Create
+ subroutine CARMASTATE_Destroy(cstate, rc)
+ type(carmastate_type), intent(inout) :: cstate
+ integer, intent(out) :: rc
+
+ ! Local variables
+ integer :: ier
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Check to see if the arrays are already allocated. If so, deallocate them.
+
+ ! Allocate the variables needed for setupatm.
+ if (allocated(cstate%f_xmet)) then
+
+ deallocate( &
+ cstate%f_xmet, &
+ cstate%f_ymet, &
+ cstate%f_zmet, &
+ cstate%f_zmetl, &
+ cstate%f_xc, &
+ cstate%f_yc, &
+ cstate%f_zc, &
+ cstate%f_dx, &
+ cstate%f_dy, &
+ cstate%f_dz, &
+ cstate%f_zl, &
+ cstate%f_pc, &
+ cstate%f_pcd, &
+ cstate%f_pc_surf, &
+ cstate%f_sedimentationflux, &
+ cstate%f_gc, &
+ cstate%f_cldfrc, &
+ cstate%f_rhcrit, &
+ cstate%f_rhop, &
+ cstate%f_r_wet, &
+ cstate%f_rlow_wet, &
+ cstate%f_rup_wet, &
+ cstate%f_rhop_wet, &
+ cstate%f_r_ref, &
+ cstate%f_rhop_ref, &
+ cstate%f_rhoa, &
+ cstate%f_rhoa_wet, &
+ cstate%f_t, &
+ cstate%f_p, &
+ cstate%f_pl, &
+ cstate%f_relhum, &
+ cstate%f_wtpct, &
+ cstate%f_rmu, &
+ cstate%f_thcond, &
+ cstate%f_thcondnc, &
+ cstate%f_dpc_sed, &
+ cstate%f_pconmax, &
+ cstate%f_pcl, &
+ stat=ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Destroy::&
+ &ERROR deallocating atmosphere arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Allocate the last fields if they are needed for substepping stepping.
+ if (allocated(cstate%f_gcl)) then
+ deallocate( &
+ cstate%f_gcl, &
+ cstate%f_d_gc, &
+ cstate%f_told, &
+ cstate%f_d_t, &
+ cstate%f_zsubsteps, &
+ stat=ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Destroy::&
+ &ERROR deallocating stepping arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ endif
+ endif
+
+ ! Allocate the variables needed for setupvf.
+ !
+ ! NOTE: Coagulation also needs bpm, vf and re.
+ if (allocated(cstate%f_bpm)) then
+ deallocate( &
+ cstate%f_bpm, &
+ cstate%f_vf, &
+ cstate%f_re, &
+ cstate%f_dkz, &
+ cstate%f_ftoppart, &
+ cstate%f_fbotpart, &
+ cstate%f_pc_topbnd, &
+ cstate%f_pc_botbnd, &
+ cstate%f_vd, &
+ stat=ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Destroy::&
+ &ERROR deallocating vertical transport arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ endif
+ end if
+
+ if (allocated(cstate%f_diffus)) then
+ deallocate( &
+ cstate%f_diffus, &
+ cstate%f_rlhe, &
+ cstate%f_rlhm, &
+ cstate%f_surfctwa, &
+ cstate%f_surfctiw, &
+ cstate%f_surfctia, &
+ cstate%f_akelvin, &
+ cstate%f_akelvini, &
+ cstate%f_ft, &
+ cstate%f_gro, &
+ cstate%f_gro1, &
+ cstate%f_gro2, &
+ cstate%f_scrit, &
+ cstate%f_rnuclg,&
+ cstate%f_rnucpe, &
+ cstate%f_rhompe, &
+ cstate%f_pc_nucl, &
+ cstate%f_growpe, &
+ cstate%f_evappe, &
+ cstate%f_evcore, &
+ cstate%f_growlg, &
+ cstate%f_evaplg, &
+ cstate%f_gasprod, &
+ cstate%f_rlheat, &
+ cstate%f_radint, &
+ cstate%f_partheat, &
+ cstate%f_dtpart, &
+ cstate%f_cmf, &
+ cstate%f_totevap, &
+ stat=ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Destroy::&
+ &ERROR deallocating growth arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ endif
+ end if
+
+ if (allocated(cstate%f_pvapl)) then
+ deallocate( &
+ cstate%f_pvapl, &
+ cstate%f_pvapi, &
+ cstate%f_supsatl, &
+ cstate%f_supsati, &
+ cstate%f_supsatlold, &
+ cstate%f_supsatiold, &
+ stat=ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Destroy::&
+ &ERROR deallocating gas arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ endif
+ end if
+
+ if (allocated(cstate%f_coaglg)) then
+ deallocate( &
+ cstate%f_coaglg, &
+ cstate%f_coagpe, &
+ cstate%f_ckernel, &
+ stat = ier)
+ if (ier /= 0) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Destroy::&
+ &ERROR deallocating coag arrays, status=", ier
+ end if
+ rc = RC_ERROR
+ return
+ end if
+ end if
+ end if
+
+ return
+ end subroutine CARMASTATE_Destroy
+
+
+ !! The routine performs the main CARMA processing for one timestep of
+ !! the parent model. The state variables should have all been set before
+ !! calling CARMASTATE_Step(). When this routine returns, the state will
+ !! have been updated to reflect the changes from the CARMA microphysics.
+ !! If tendencies are desired, then the difference between the final and
+ !! initial state will need to be computed by the caller.
+ !!
+ !! NIOTE: xxxfv, xxxram and xxxfrac need to be specified for dry deposition.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ subroutine CARMASTATE_Step(cstate, rc, cldfrc, rhcrit, lndfv, ocnfv, icefv, lndram, ocnram, iceram, lndfrac, ocnfrac, icefrac)
+ type(carmastate_type), intent(inout) :: cstate
+ integer, intent(out) :: rc
+ real(kind=f), intent(in), optional :: cldfrc(cstate%f_NZ) !! cloud fraction [fraction]
+ real(kind=f), intent(in), optional :: rhcrit(cstate%f_NZ) !! relative humidity for onset of liquid clouds [fraction]
+ real(kind=f), intent(in), optional :: lndfv !! the surface friction velocity over land [m/s]
+ real(kind=f), intent(in), optional :: ocnfv !! the surface friction velocity over ocean [m/s]
+ real(kind=f), intent(in), optional :: icefv !! the surface friction velocity over ice [m/s]
+ real(kind=f), intent(in), optional :: lndram !! the aerodynamic resistance over land [s/m]
+ real(kind=f), intent(in), optional :: ocnram !! the aerodynamic resistance over ocean [s/m]
+ real(kind=f), intent(in), optional :: iceram !! the aerodynamic resistance over ice [s/m]
+ real(kind=f), intent(in), optional :: lndfrac !! land fraction
+ real(kind=f), intent(in), optional :: ocnfrac !! ocn fraction
+ real(kind=f), intent(in), optional :: icefrac !! ice fraction
+
+
+ integer :: iz ! vertical index
+ integer :: igas ! gas index
+ integer :: ielem
+ integer :: ibin
+ integer :: igroup
+ logical :: swelling ! Do any groups undergo partcile swelling?
+ integer :: i1, i2, j1, j2
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Store the cloud fraction if specified
+ cstate%f_cldfrc(:) = 1._f
+ cstate%f_rhcrit(:) = 1._f
+
+ if (present(cldfrc)) cstate%f_cldfrc(:) = cldfrc(:)
+ if (present(rhcrit)) cstate%f_rhcrit(:) = rhcrit(:)
+
+ ! Determine the gas supersaturations.
+ do iz = 1, cstate%f_NZ
+ do igas = 1, cstate%f_carma%f_NGAS
+ call supersat(cstate%f_carma, cstate, iz, igas, rc)
+ if (rc < 0) return
+ end do
+ end do
+
+ ! Determine the particle densities.
+ call rhopart(cstate%f_carma, cstate, rc)
+ if (rc < 0) return
+
+
+ ! We have to hold off initialization until now, because the particle density
+ ! (rhop) can not be determined until the particle masses are known (i.e. after
+ ! CARMASTATE_SetBin), because rhop is used to determine the fall velocity.
+ !
+ ! NOTE: If configured for fixed initialization, then we will lose some accuracy
+ ! in the calculation of the fall velocities, growth kernels, ... and in return
+ ! will gain a significant performance by not having to initialize as often.
+ !
+ ! NOTE: If configured for partial initialized in conjunction with fixed
+ ! initialization, then do the fall velocity (and growth) initialization which
+ ! is relatively quick, but skip the recalculation of the coagulation kernels
+ ! which is relatively expensive. This could be useful for particles that have
+ ! a wet radius that is different from the dry radius or where there are large
+ ! changes from the average conditions (temperature, water vapor, ...) used in
+ ! the fixed initialization.
+ if ((.not. cstate%f_carma%f_do_fixedinit) .or. &
+ (cstate%f_carma%f_do_partialinit)) then
+
+ ! Initialize the vertical transport.
+ if (cstate%f_carma%f_do_vtran .or. cstate%f_carma%f_do_coag .or. cstate%f_carma%f_do_grow) then
+ call setupvf(cstate%f_carma, cstate, rc)
+
+ if (cstate%f_carma%f_do_vdiff) then
+ call setupbdif(cstate%f_carma, cstate, rc)
+ end if
+ end if
+
+ ! Initialize the nucleation, growth and evaporation.
+ if (cstate%f_carma%f_do_grow) then
+ call setupgrow(cstate%f_carma, cstate, rc)
+ if (rc < RC_OK) return
+
+ call setupgkern(cstate%f_carma, cstate, rc)
+ if (rc < RC_OK) return
+
+ call setupnuc(cstate%f_carma, cstate, rc)
+ if (rc < RC_OK) return
+ end if
+
+ ! Initialize the coagulation.
+ if (cstate%f_carma%f_do_coag .and. &
+ (.not. cstate%f_carma%f_do_fixedinit)) then
+ call setupckern(cstate%f_carma, cstate, rc)
+ if (rc < RC_OK) return
+ end if
+ end if
+
+ ! Initialize the dry deposition
+ !
+ ! NOTE: This is tied to the surface fields that vary from column to column,
+ ! so it needs to get calculated here whether using fixed or full initialization.
+ if (cstate%f_carma%f_do_drydep) then
+ if (present(lndfv) .and. present(lndram) .and. present(lndfrac) .and. &
+ present(ocnfv) .and. present(ocnram) .and. present(ocnfrac) .and. &
+ present(icefv) .and. present(iceram) .and. present(icefrac)) then
+
+ ! NOTE: Need to convert surfric and ram from mks to cgs units.
+ call setupvdry(cstate%f_carma, cstate, &
+ lndfv * 100._f, ocnfv * 100._f, icefv * 100._f, &
+ lndram / 100._f, ocnram / 100._f, iceram / 100._f, &
+ lndfrac, ocnfrac, icefrac, rc)
+ if (rc < RC_OK) return
+ else
+ write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_Step: &
+ &do_drydep requires that the optional inputs xxxfv, xxxram &
+ &and xxxfrac be provided."
+ rc = RC_ERROR
+ return
+ end if
+ end if
+
+ ! Calculate the impact of microphysics upon the state.
+ call step(cstate%f_carma, cstate, rc)
+
+ return
+ end subroutine CARMASTATE_Step
+
+
+ ! Query, Control and State I/O
+
+ !! Gets the mass mixing ratio for the gas (igas). After a call to CARMA_Step(),
+ !! the new mass mixing ratio of the gas can be retrieved.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ !! @see CARMA_AddGas
+ !! @see CARMA_GetGas
+ !! @see CARMA_Step
+ !! @see CARMASTATE_SetGas
+ subroutine CARMASTATE_Get(cstate, rc, max_nsubstep, max_nretry, nstep, nsubstep, nretry, zsubsteps, lat, lon)
+ type(carmastate_type), intent(in) :: cstate !! the carma state object
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ integer, optional, intent(out) :: max_nsubstep !! maximum number of substeps in a step
+ real(kind=f), optional, intent(out) :: max_nretry !! maximum number of retries in a step
+ real(kind=f), optional, intent(out) :: nstep !! total number of steps taken
+ integer, optional, intent(out) :: nsubstep !! total number of substeps taken
+ real(kind=f), optional, intent(out) :: nretry !! total number of retries taken
+ real(kind=f), optional, intent(out) :: zsubsteps(cstate%f_NZ) !! number of substeps taken per vertical grid point
+ real(kind=f), optional, intent(out) :: lat !! grid center latitude [deg]
+ real(kind=f), optional, intent(out) :: lon !! grid center longitude [deg]
+
+ ! Assume success.
+ rc = RC_OK
+
+ if (present(max_nsubstep)) max_nsubstep = cstate%f_max_nsubstep
+ if (present(max_nretry)) max_nretry = cstate%f_max_nretry
+ if (present(nstep)) nstep = cstate%f_nstep
+ if (present(nsubstep)) nsubstep = cstate%f_nsubstep
+ if (present(nretry)) nretry = cstate%f_nretry
+ if (present(zsubsteps)) zsubsteps = cstate%f_zsubsteps
+ if (present(lat)) lat = cstate%f_lat
+ if (present(lon)) lon = cstate%f_lon
+
+ return
+ end subroutine CARMASTATE_Get
+
+
+ !! Gets the mass of the bins (ibin) for each particle element (ielem). After the
+ !! CARMA_Step() call, new particle concentrations are determined. The number density
+ !! and the nucleation rate are only calculated if the element is the number density
+ !! element for the group.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ !! @see CARMA_AddElement
+ !! @see CARMA_AddGroup
+ !! @see CARMA_Step
+ !! @see CARMASTATE_SetBin
+ subroutine CARMASTATE_GetBin(cstate, ielem, ibin, mmr, rc, &
+ nmr, numberDensity, nucleationRate, r_wet, rhop_wet, &
+ surface, sedimentationflux, vf, vd, dtpart)
+ type(carmastate_type), intent(in) :: cstate !! the carma state object
+ integer, intent(in) :: ielem !! the element index
+ integer, intent(in) :: ibin !! the bin index
+ real(kind=f), intent(out) :: mmr(cstate%f_NZ) !! the bin mass mixing ratio [kg/kg]
+ integer, intent(out) :: rc !! return code negative indicates failure
+ real(kind=f), optional, intent(out) :: nmr(cstate%f_NZ) !! number mixing ratio [#/kg]
+ real(kind=f), optional, intent(out) :: numberDensity(cstate%f_NZ) !! number density [#/cm3]
+ real(kind=f), optional, intent(out) :: nucleationRate(cstate%f_NZ) !! nucleation rate [1/cm3/s]
+ real(kind=f), optional, intent(out) :: r_wet(cstate%f_NZ) !! wet particle radius [cm]
+ real(kind=f), optional, intent(out) :: rhop_wet(cstate%f_NZ) !! wet particle density [g/cm3]
+ real(kind=f), optional, intent(out) :: surface !! particle mass on the surface [kg/m2]
+ real(kind=f), optional, intent(out) :: sedimentationflux !! particle sedimentation mass flux to surface [kg/m2/s]
+ real(kind=f), optional, intent(out) :: vf(cstate%f_NZ+1) !! fall velocity [cm/s]
+ real(kind=f), optional, intent(out) :: vd !! deposition velocity [cm/s]
+ real(kind=f), optional, intent(out) :: dtpart(cstate%f_NZ) !! delta particle temperature [K]
+
+ integer :: ienconc !! index of element that is the particle concentration for the group
+ integer :: igroup ! Group containing this bin
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Determine the particle group for the bin.
+ igroup = cstate%f_carma%f_element(ielem)%f_igroup
+
+ ! Make sure there are enough elements allocated.
+ if (ielem > cstate%f_carma%f_NELEM) then
+ if (cstate%f_carma%f_do_print) write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_SetBin:: ERROR - The specifed element (", &
+ ielem, ") is larger than the number of elements (", cstate%f_carma%f_NELEM, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Make sure there are enough bins allocated.
+ if (ibin > cstate%f_carma%f_NBIN) then
+ if (cstate%f_carma%f_do_print) write(cstate%f_carma%f_LUNOPRT, *) "CARMA_SetBin:: ERROR - The specifed bin (", &
+ ibin, ") is larger than the number of bins (", cstate%f_carma%f_NBIN, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+
+ ! Use the specified mass mixing ratio and the air density to determine the mass
+ ! of the particles in g/x/y/z.
+ mmr(:) = cstate%f_pc(:, ibin, ielem) / cstate%f_rhoa_wet(:)
+
+
+ ! Handle the special cases for different types of elements ...
+ if ((cstate%f_carma%f_element(ielem)%f_itype == I_INVOLATILE) .or. &
+ (cstate%f_carma%f_element(ielem)%f_itype == I_VOLATILE)) then
+ mmr(:) = mmr(:) * cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ else if (cstate%f_carma%f_element(ielem)%f_itype == I_CORE2MOM) then
+ mmr(:) = mmr(:) / cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ end if
+
+ ! If the number of particles in the group is less than the minimum value represented
+ ! by CARMA, then return and mmr of 0.0 for all elements.
+ ienconc = cstate%f_carma%f_group(igroup)%f_ienconc
+! where (cstate%f_pc(:, ibin, ienconc) <= SMALL_PC) mmr(:) = 0.0_f
+
+
+ ! Do they also want the mass concentration of particles at the surface?
+ if (present(surface)) then
+
+ ! Convert from g/cm2 to kg/m2
+ surface = cstate%f_pc_surf(ibin, ielem) * 1e4_f / 1e3_f
+
+ ! Handle the special cases for different types of elements ...
+ if ((cstate%f_carma%f_element(ielem)%f_itype == I_INVOLATILE) .or. &
+ (cstate%f_carma%f_element(ielem)%f_itype == I_VOLATILE)) then
+ surface = surface * cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ else if (cstate%f_carma%f_element(ielem)%f_itype == I_CORE2MOM) then
+ surface = surface / cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ end if
+ end if
+
+ ! Do they also want the mass flux of particles that sediment to the surface?
+ if (present(sedimentationflux)) then
+
+ ! Convert from g/cm2 to kg/m2
+ sedimentationflux = cstate%f_sedimentationflux(ibin, ielem) * 1e4_f / 1e3_f
+
+ ! Handle the special cases for different types of elements ...
+ if ((cstate%f_carma%f_element(ielem)%f_itype == I_INVOLATILE) .or. &
+ (cstate%f_carma%f_element(ielem)%f_itype == I_VOLATILE)) then
+ sedimentationflux = sedimentationflux * cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ else if (cstate%f_carma%f_element(ielem)%f_itype == I_CORE2MOM) then
+ sedimentationflux = sedimentationflux / cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ end if
+ end if
+
+ ! If this is the partcile # element, then determine some other statistics.
+ if (ienconc == ielem) then
+ if (present(nmr)) nmr(:) = (cstate%f_pc(:, ibin, ielem) / cstate%f_rhoa_wet(:)) * 1000._f
+ if (present(numberDensity)) numberDensity(:) = cstate%f_pc(:, ibin, ielem) / &
+ (cstate%f_xmet(:)*cstate%f_ymet(:)*cstate%f_zmet(:))
+ if (present(r_wet)) r_wet(:) = cstate%f_r_wet(:, ibin, igroup)
+ if (present(rhop_wet)) rhop_wet(:) = cstate%f_rhop_wet(:, ibin, igroup)
+
+ if (cstate%f_carma%f_do_vtran) then
+ if (present(vf)) vf(:) = cstate%f_vf(:, ibin, igroup) * cstate%f_zmetl(:)
+ else
+ if (present(vf)) vf(:) = CAM_FILL
+ end if
+
+ if (cstate%f_carma%f_do_drydep) then
+ if (present(vd)) then
+ if (cstate%f_igridv .eq. I_CART) then
+ vd = cstate%f_vd(ibin, igroup) * cstate%f_zmetl(1)
+ else
+ vd = cstate%f_vd(ibin, igroup) * cstate%f_zmetl(cstate%f_NZP1)
+ end if
+ end if
+ else
+ if (present(vd)) vd = CAM_FILL
+ end if
+
+ if (cstate%f_carma%f_do_grow) then
+ if (present(nucleationRate)) nucleationRate(:) = cstate%f_pc_nucl(:, ibin, ielem) / &
+ (cstate%f_xmet(:)*cstate%f_ymet(:)*cstate%f_zmet(:)) / cstate%f_dtime
+ else
+ if (present(nucleationRate)) nucleationRate(:) = CAM_FILL
+ end if
+
+ if (cstate%f_carma%f_do_pheat) then
+ if (present(dtpart)) dtpart(:) = cstate%f_dtpart(:, ibin, igroup)
+ else
+ if (present(dtpart)) dtpart(:) = CAM_FILL
+ end if
+ else
+ if (present(nmr)) nmr(:) = CAM_FILL
+ if (present(numberDensity)) numberDensity(:) = CAM_FILL
+ if (present(nucleationRate)) nucleationRate(:) = CAM_FILL
+ if (present(r_wet)) r_wet(:) = CAM_FILL
+ if (present(rhop_wet)) rhop_wet(:) = CAM_FILL
+ if (present(dtpart)) dtpart(:) = CAM_FILL
+ if (present(vf)) vf(:) = CAM_FILL
+ if (present(vd)) vd = CAM_FILL
+ end if
+
+ return
+ end subroutine CARMASTATE_GetBin
+
+
+ !! Gets the mass of the detrained condensate for the bins (ibin) for each particle
+ !! element (ielem) in the grid.
+ !!
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ !! @see CARMA_AddElement
+ !! @see CARMA_AddGroup
+ !! @see CARMA_Step
+ !! @see CARMASTATE_SetDetrain
+ subroutine CARMASTATE_GetDetrain(cstate, ielem, ibin, mmr, rc, nmr, numberDensity, r_wet, rhop_wet)
+ type(carmastate_type), intent(in) :: cstate !! the carma state object
+ integer, intent(in) :: ielem !! the element index
+ integer, intent(in) :: ibin !! the bin index
+ real(kind=f), intent(out) :: mmr(cstate%f_NZ) !! the bin mass mixing ratio [kg/kg]
+ integer, intent(out) :: rc !! return code negative indicates failure
+ real(kind=f), optional, intent(out) :: nmr(cstate%f_NZ) !! number mixing ratio [#/kg]
+ real(kind=f), optional, intent(out) :: numberDensity(cstate%f_NZ) !! number density [#/cm3]
+ real(kind=f), optional, intent(out) :: r_wet(cstate%f_NZ) !! wet particle radius [cm]
+ real(kind=f), optional, intent(out) :: rhop_wet(cstate%f_NZ) !! wet particle density [g/cm3]
+
+ integer :: ienconc !! index of element that is the particle concentration for the group
+ integer :: igroup ! Group containing this bin
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Determine the particle group for the bin.
+ igroup = cstate%f_carma%f_element(ielem)%f_igroup
+
+ ! Make sure there are enough elements allocated.
+ if (ielem > cstate%f_carma%f_NELEM) then
+ if (cstate%f_carma%f_do_print) write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_SetDetrain:: ERROR - The specifed element (", &
+ ielem, ") is larger than the number of elements (", cstate%f_carma%f_NELEM, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Make sure there are enough bins allocated.
+ if (ibin > cstate%f_carma%f_NBIN) then
+ if (cstate%f_carma%f_do_print) write(cstate%f_carma%f_LUNOPRT, *) "CARMA_SetDetrainin:: ERROR - The specifed bin (", &
+ ibin, ") is larger than the number of bins (", cstate%f_carma%f_NBIN, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+
+ ! Use the specified mass mixing ratio and the air density to determine the mass
+ ! of the particles in g/x/y/z.
+ mmr(:) = cstate%f_pcd(:, ibin, ielem) / cstate%f_rhoa_wet(:)
+
+
+ ! Handle the special cases for different types of elements ...
+ if ((cstate%f_carma%f_element(ielem)%f_itype == I_INVOLATILE) .or. &
+ (cstate%f_carma%f_element(ielem)%f_itype == I_VOLATILE)) then
+ mmr(:) = mmr(:) * cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ else if (cstate%f_carma%f_element(ielem)%f_itype == I_CORE2MOM) then
+ mmr(:) = mmr(:) / cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ end if
+
+ ! If this is the partcile # element, then determine some other statistics.
+ ienconc = cstate%f_carma%f_group(igroup)%f_ienconc
+ if (ienconc == ielem) then
+ if (present(nmr)) nmr(:) = (cstate%f_pcd(:, ibin, ielem) / cstate%f_rhoa_wet(:)) * 1000._f
+ if (present(numberDensity)) numberDensity(:) = cstate%f_pcd(:, ibin, ielem) / &
+ (cstate%f_xmet(:)*cstate%f_ymet(:)*cstate%f_zmet(:))
+ if (present(r_wet)) r_wet(:) = cstate%f_r_wet(:, ibin, igroup)
+ if (present(rhop_wet)) rhop_wet(:) = cstate%f_rhop_wet(:, ibin, igroup)
+ else
+ if (present(nmr)) nmr(:) = CAM_FILL
+ if (present(numberDensity)) numberDensity(:) = CAM_FILL
+ end if
+
+ return
+ end subroutine CARMASTATE_GetDetrain
+
+
+ !! Gets the mass mixing ratio for the gas (igas). After a call to CARMA_Step(),
+ !! the new mass mixing ratio of the gas can be retrieved.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ !! @see CARMA_AddGas
+ !! @see CARMA_GetGas
+ !! @see CARMA_Step
+ !! @see CARMASTATE_SetGas
+ subroutine CARMASTATE_GetGas(cstate, igas, mmr, rc, satice, satliq, eqice, eqliq, wtpct)
+ type(carmastate_type), intent(in) :: cstate !! the carma state object
+ integer, intent(in) :: igas !! the gas index
+ real(kind=f), intent(out) :: mmr(cstate%f_NZ) !! the gas mass mixing ratio [kg/kg]
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ real(kind=f), optional, intent(out) :: satice(cstate%f_NZ) !! the gas saturation wrt ice
+ real(kind=f), optional, intent(out) :: satliq(cstate%f_NZ) !! the gas saturation wrt liquid
+ real(kind=f), optional, intent(out) :: eqice(cstate%f_NZ) !! the gas vapor pressure wrt ice
+ real(kind=f), optional, intent(out) :: eqliq(cstate%f_NZ) !! the gas vapor pressure wrt liquid
+ real(kind=f), optional, intent(out) :: wtpct(cstate%f_NZ) !! weight percent aerosol composition
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough gases allocated.
+ if (igas > cstate%f_carma%f_NGAS) then
+ if (cstate%f_carma%f_do_print) write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_GetGas:: ERROR - The specifed gas (", &
+ igas, ") is larger than the number of gases (", cstate%f_carma%f_NGAS, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Use the specified mass mixing ratio and the air density to determine the mass
+ ! of the gas in g/x/y/z.
+ mmr(:) = cstate%f_gc(:, igas) / cstate%f_rhoa_wet(:)
+
+ if (present(satice)) satice(:) = cstate%f_supsati(:, igas) + 1._f
+ if (present(satliq)) satliq(:) = cstate%f_supsatl(:, igas) + 1._f
+ if (present(eqice)) eqice(:) = cstate%f_pvapi(:, igas) / cstate%f_p(:)
+ if (present(eqliq)) eqliq(:) = cstate%f_pvapl(:, igas) / cstate%f_p(:)
+ if (present(wtpct)) wtpct(:) = cstate%f_wtpct(:)
+
+ return
+ end subroutine CARMASTATE_GetGas
+
+
+ !! Gets information about the state of the atmosphere. After the CARMA_Step() call,
+ !! a new atmospheric state is determined.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ !! @see CARMA_Step
+ !! @see CARMASTATE_Create
+ subroutine CARMASTATE_GetState(cstate, rc, t, p, rhoa_wet, rlheat)
+ type(carmastate_type), intent(in) :: cstate !! the carma state object
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ real(kind=f), optional, intent(out) :: t(cstate%f_NZ) !! the air temperature [K]
+ real(kind=f), optional, intent(out) :: p(cstate%f_NZ) !! the air pressure [Pa]
+ real(kind=f), optional, intent(out) :: rhoa_wet(cstate%f_NZ) !! air density [kg m-3]
+ real(kind=f), optional, intent(out) :: rlheat(cstate%f_NZ) !! latent heat [K/s]
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Return the temperature, pressure, and/or density.
+ if (present(t)) t(:) = cstate%f_t(:)
+
+ ! DYNE -> Pa
+ if (present(p)) p(:) = cstate%f_p(:) / RPA2CGS
+
+ ! Convert rhoa from the scaled units to mks.
+ if (present(rhoa_wet)) rhoa_wet(:) = (cstate%f_rhoa_wet(:) / &
+ (cstate%f_zmet(:)*cstate%f_xmet(:)*cstate%f_ymet(:))) * 1e6_f / 1e3_f
+
+ if (present(rlheat)) rlheat(:) = cstate%f_rlheat(:)
+
+ return
+ end subroutine CARMASTATE_GetState
+
+
+ !! Sets the mass of the bins (ibin) for each particle element (ielem) in the grid.
+ !! This call should be made after CARMASTATE_Create() and before CARMA_Step().
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ !! @see CARMA_AddBin
+ !! @see CARMA_Step
+ !! @see CARMASTATE_GetBin
+ subroutine CARMASTATE_SetBin(cstate, ielem, ibin, mmr, rc, surface)
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: ielem !! the element index
+ integer, intent(in) :: ibin !! the bin index
+ real(kind=f), intent(in) :: mmr(cstate%f_NZ) !! the bin mass mixing ratio [kg/kg]
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ real(kind=f), optional, intent(in) :: surface !! particles mass on the surface [kg/m2]
+
+ integer :: igroup ! Group containing this bin
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Determine the particle group for the bin.
+ igroup = cstate%f_carma%f_element(ielem)%f_igroup
+
+ ! Make sure there are enough elements allocated.
+ if (ielem > cstate%f_carma%f_NELEM) then
+ if (cstate%f_carma%f_do_print) write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_SetBin:: ERROR - The specifed element (", &
+ ielem, ") is larger than the number of elements (", cstate%f_carma%f_NELEM, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Make sure there are enough bins allocated.
+ if (ibin > cstate%f_carma%f_NBIN) then
+ if (cstate%f_carma%f_do_print) write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_SetBin:: ERROR - The specifed bin (", &
+ ibin, ") is larger than the number of bins (", cstate%f_carma%f_NBIN, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Use the specified mass mixing ratio and the air density to determine the mass
+ ! of the particles in g/x/y/z.
+ cstate%f_pc(:, ibin, ielem) = mmr(:) * cstate%f_rhoa_wet(:)
+
+ ! Handle the special cases for different types of elements ...
+ if ((cstate%f_carma%f_element(ielem)%f_itype == I_INVOLATILE) .or. &
+ (cstate%f_carma%f_element(ielem)%f_itype == I_VOLATILE)) then
+ cstate%f_pc(:, ibin, ielem) = cstate%f_pc(:, ibin, ielem) / cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ else if (cstate%f_carma%f_element(ielem)%f_itype == I_CORE2MOM) then
+ cstate%f_pc(:, ibin, ielem) = cstate%f_pc(:, ibin, ielem) * cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ end if
+
+ ! If they specified an initial mass of particles on the surface, then use that
+ ! value.
+ if (present(surface)) then
+
+ ! Convert from g/cm2 to kg/m2
+ cstate%f_pc_surf(ibin, ielem) = surface / 1e4_f * 1e3_f
+
+ ! Handle the special cases for different types of elements ...
+ if ((cstate%f_carma%f_element(ielem)%f_itype == I_INVOLATILE) .or. &
+ (cstate%f_carma%f_element(ielem)%f_itype == I_VOLATILE)) then
+ cstate%f_pc_surf(ibin, ielem) = cstate%f_pc_surf(ibin, ielem) / cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ else if (cstate%f_carma%f_element(ielem)%f_itype == I_CORE2MOM) then
+ cstate%f_pc_surf(ibin, ielem) = cstate%f_pc_surf(ibin, ielem) * cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ end if
+ else
+ cstate%f_pc_surf(ibin, ielem) = 0.0_f
+ end if
+
+ return
+ end subroutine CARMASTATE_SetBin
+
+
+ !! Sets the mass of the detrained condensate for the bins (ibin) for each particle
+ !! element (ielem) in the grid. This call should be made after CARMASTATE_Create()
+ !! and before CARMA_Step().
+ !!
+ !! @author Chuck Bardeen
+ !! @version May-2010
+ !! @see CARMA_AddBin
+ !! @see CARMA_Step
+ !! @see CARMASTATE_GetDetrain
+ subroutine CARMASTATE_SetDetrain(cstate, ielem, ibin, mmr, rc)
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: ielem !! the element index
+ integer, intent(in) :: ibin !! the bin index
+ real(kind=f), intent(in) :: mmr(cstate%f_NZ) !! the bin mass mixing ratio [kg/kg]
+ integer, intent(out) :: rc !! return code, negative indicates failure
+
+ integer :: igroup ! Group containing this bin
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Determine the particle group for the bin.
+ igroup = cstate%f_carma%f_element(ielem)%f_igroup
+
+ ! Make sure there are enough elements allocated.
+ if (ielem > cstate%f_carma%f_NELEM) then
+ if (cstate%f_carma%f_do_print) write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_SetDetrain:: ERROR - The specifed element (", &
+ ielem, ") is larger than the number of elements (", cstate%f_carma%f_NELEM, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Make sure there are enough bins allocated.
+ if (ibin > cstate%f_carma%f_NBIN) then
+ if (cstate%f_carma%f_do_print) write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_SetDetrain:: ERROR - The specifed bin (", &
+ ibin, ") is larger than the number of bins (", cstate%f_carma%f_NBIN, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Use the specified mass mixing ratio and the air density to determine the mass
+ ! of the particles in g/x/y/z.
+ cstate%f_pcd(:, ibin, ielem) = mmr(:) * cstate%f_rhoa_wet(:)
+
+ ! Handle the special cases for different types of elements ...
+ if ((cstate%f_carma%f_element(ielem)%f_itype == I_INVOLATILE) .or. &
+ (cstate%f_carma%f_element(ielem)%f_itype == I_VOLATILE)) then
+ cstate%f_pcd(:, ibin, ielem) = cstate%f_pcd(:, ibin, ielem) / cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ else if (cstate%f_carma%f_element(ielem)%f_itype == I_CORE2MOM) then
+ cstate%f_pcd(:, ibin, ielem) = cstate%f_pcd(:, ibin, ielem) * cstate%f_carma%f_group(igroup)%f_rmass(ibin)
+ end if
+
+ return
+ end subroutine CARMASTATE_SetDetrain
+
+
+
+ !! Sets the mass of the gas (igas) in the grid. This call should be made after
+ !! CARMASTATE_Create() and before CARMA_Step().
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ !! @see CARMA_AddGas
+ !! @see CARMA_GetGas
+ !! @see CARMA_InitializeStep
+ !! @see CARMA_Step
+ subroutine CARMASTATE_SetGas(cstate, igas, mmr, rc, mmr_old, satice_old, satliq_old)
+ type(carmastate_type), intent(inout) :: cstate !! the carma object
+ integer, intent(in) :: igas !! the gas index
+ real(kind=f), intent(in) :: mmr(cstate%f_NZ) !! the gas mass mixing ratio [kg/kg]
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ real(kind=f), intent(in), optional :: mmr_old(cstate%f_NZ) !! the previous gas mass mixing ratio [kg/kg]
+ real(kind=f), intent(inout), optional :: satice_old(cstate%f_NZ) !! the previous gas saturation wrt ice, calculates if -1
+ real(kind=f), intent(inout), optional :: satliq_old(cstate%f_NZ) !! the previous gas saturation wrt liquid, calculates if -1
+
+ real(kind=f) :: tnew(cstate%f_NZ)
+ integer :: iz
+ logical :: calculateOld
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Make sure there are enough gases allocated.
+ if (igas > cstate%f_carma%f_NGAS) then
+ if (cstate%f_carma%f_do_print) write(cstate%f_carma%f_LUNOPRT, *) "CARMASTATE_SetGas:: ERROR - The specifed gas (", &
+ igas, ") is larger than the number of gases (", cstate%f_carma%f_NGAS, ")."
+ rc = RC_ERROR
+ return
+ end if
+
+ if (cstate%f_carma%f_do_substep) then
+ if (.not. present(mmr_old)) then
+ if (cstate%f_carma%f_do_print) then
+ write(cstate%f_carma%f_LUNOPRT,*) "CARMASTATE_SetGas: &
+ &Error - Need to specify mmr_old, satic_old, satliq_old when substepping."
+ end if
+ rc = RC_ERROR
+
+ return
+
+ else
+ cstate%f_gcl(:, igas) = mmr_old(:) * cstate%f_rhoa_wet(:) * cstate%f_t(:) / cstate%f_told(:)
+
+ ! A value of -1 for the saturation ratio means that it needs to be calculated from the old temperature
+ ! and the old gc.
+ !
+ ! NOTE: This is typically just a problem for the first step, so we just need to get close.
+ calculateOld = .false.
+ if (present(satice_old) .and. present(satliq_old)) then
+ if (any(satice_old(:) == -1._f) .or. any(satliq_old(:) == -1._f)) calculateOld = .true.
+ else
+ calculateOld = .true.
+ end if
+
+ if (calculateOld) then
+
+ ! This is a bit of a hack, because of the way CARMA has the vapor pressure and saturation
+ ! routines implemented.
+
+ ! Temporarily set the temperature and gc of to the old state
+
+ tnew(:) = cstate%f_t(:)
+ cstate%f_t(:) = cstate%f_told(:)
+
+ cstate%f_gc(:, igas) = mmr_old(:) * cstate%f_rhoa_wet(:)
+
+ do iz = 1, cstate%f_NZ
+ call supersat(cstate%f_carma, cstate, iz, igas, rc)
+ if (rc < RC_OK) return
+
+ if (present(satice_old)) then
+ if (satice_old(iz) == -1._f) then
+ cstate%f_supsatiold(iz, igas) = cstate%f_supsati(iz, igas)
+ else
+ cstate%f_supsatiold(iz, igas) = satice_old(iz) - 1._f
+ endif
+ else
+ cstate%f_supsatiold(iz, igas) = cstate%f_supsati(iz, igas)
+ end if
+
+ if (present(satliq_old)) then
+ if (satliq_old(iz) == -1._f) then
+ cstate%f_supsatlold(iz, igas) = cstate%f_supsatl(iz, igas)
+ else
+ cstate%f_supsatlold(iz, igas) = satliq_old(iz) - 1._f
+ endif
+ else
+ cstate%f_supsatlold(iz, igas) = cstate%f_supsatl(iz, igas)
+ end if
+ end do
+
+ cstate%f_t(:) = tnew(:)
+
+ else
+ cstate%f_supsatiold(:, igas) = satice_old(:) - 1._f
+ cstate%f_supsatlold(:, igas) = satliq_old(:) - 1._f
+ end if
+ end if
+ end if
+
+ ! Use the specified mass mixing ratio and the air density to determine the mass
+ ! of the gas in g/x/y/z.
+ cstate%f_gc(:, igas) = mmr(:) * cstate%f_rhoa_wet(:)
+
+ return
+ end subroutine CARMASTATE_SetGas
+
+
+ !! Sets information about the state of the atmosphere.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Feb-2009
+ !! @see CARMA_Step
+ !! @see CARMASTATE_Create
+ subroutine CARMASTATE_SetState(cstate, rc, t, rhoa_wet)
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(out) :: rc !! return code, negative indicates failure
+ real(kind=f), optional, intent(in) :: t(cstate%f_NZ) !! the air temperature [K]
+ real(kind=f), optional, intent(in) :: rhoa_wet(cstate%f_NZ) !! air density [kg m-3]
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Return the temperature or density.
+ if (present(t)) cstate%f_t(:) = t(:)
+
+ ! Convert rhoa from mks to the scaled units.
+ if (present(rhoa_wet)) cstate%f_rhoa_wet(:) = (rhoa_wet(:) * &
+ (cstate%f_zmet(:)*cstate%f_xmet(:)*cstate%f_ymet(:))) / 1e6_f * 1e3_f
+
+ return
+ end subroutine CARMASTATE_SetState
+end module
diff --git a/src/physics/carma/base/coagl.F90 b/src/physics/carma/base/coagl.F90
new file mode 100644
index 0000000000..4362a3f527
--- /dev/null
+++ b/src/physics/carma/base/coagl.F90
@@ -0,0 +1,105 @@
+#include "carma_globaer.h"
+
+!! This routine calculates coagulation loss rates .
+!! See [Jacobson, et al., Atmos. Env., 28, 1327, 1994] for details
+!! on the coagulation algorithm.
+!!
+!! The loss rates for all particle elements in a particle group are equal.
+!!
+!! @author Eric Jensen
+!! @version Oct-1995
+subroutine coagl(carma, cstate, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local Variables
+ integer :: ig
+ integer :: jg
+ integer :: je
+ integer :: igrp
+ integer :: iz
+ integer :: i
+ integer :: j
+
+
+ ! Loop over particle groups for which coagulation loss is being
+ ! calculated.
+ do ig = 1,NGROUP
+
+ ! Loop over particle groups that particle in group ig might
+ ! collide with.
+ do jg = 1,NGROUP
+
+ ! Element corresponding to particle number concentration
+ je = ienconc(jg)
+
+ ! Particle resulting from coagulation between groups and goes
+ ! to group
+ igrp = icoag(ig,jg)
+
+ ! Resulting particle is in same group as particle under consideration --
+ ! partial loss (muliplies ).
+ if( igrp .eq. ig )then
+
+ ! Loop over the column
+ do iz = 1, NZ
+
+ if( pconmax(iz,jg) .gt. FEW_PC .and. &
+ pconmax(iz,ig) .gt. FEW_PC )then
+
+ do i = 1, NBIN-1
+ do j = 1, NBIN
+
+ coaglg(iz,i,ig) = coaglg(iz,i,ig) &
+ + ckernel(iz,i,j,ig,jg) * &
+ pcl(iz,j,je) * volx(igrp,ig,jg,i,j)
+ enddo
+ enddo
+ endif
+ enddo ! iz
+
+ ! Resulting particle is in a different group -- complete loss (no ).
+ else if( igrp .ne. ig .and. igrp .ne. 0 )then
+
+ ! Loop over the column
+ do iz = 1, NZ
+
+ ! Bypass calculation if few particles present
+
+ if( pconmax(iz,jg) .gt. FEW_PC .and. &
+ pconmax(iz,ig) .gt. FEW_PC )then
+
+ do i = 1, NBIN
+ do j = 1, NBIN
+
+ coaglg(iz,i,ig) = coaglg(iz,i,ig) &
+ + ckernel(iz,i,j,ig,jg) * &
+ pcl(iz,j,je)
+
+ enddo
+ enddo
+ endif ! pconmax(ig) * pconmax(jg) > FEW_PC ** 2
+ enddo ! iz
+ endif ! igrp .eq. ig ?
+ enddo ! jg
+ enddo ! ig
+
+ ! Boundary condition: Particles from bin are only lost by
+ ! coagulating into other elements. (This is taken care of by -1
+ ! limit above)
+
+ ! Return to caller with particle loss rates due to coagulation evaluated.
+ return
+end
diff --git a/src/physics/carma/base/coagp.F90 b/src/physics/carma/base/coagp.F90
new file mode 100644
index 0000000000..a21eff9367
--- /dev/null
+++ b/src/physics/carma/base/coagp.F90
@@ -0,0 +1,266 @@
+#include "carma_globaer.h"
+
+!! This routine calculates coagulation production terms .
+!! See [Jacobson, et al., Atmos. Env., 28, 1327, 1994] for details
+!! on the coagulation algorithm.
+!!
+!! @author Eric Jensen
+!! @version Oct-1995
+subroutine coagp(carma, cstate, ibin, ielem, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: ibin !! bin index
+ integer, intent(in) :: ielem !! element index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local Variables
+ integer :: iz
+ integer :: igrp
+ integer :: i_pkern
+ integer :: iquad
+ integer :: ig
+ integer :: jg
+ integer :: i
+ integer :: j
+ integer :: iefrom
+ integer :: iefrom_cm
+ integer :: je
+ integer :: je_cm
+ integer :: ic
+ integer :: iecore
+ real(kind=f) :: totmass
+ real(kind=f) :: rmasscore
+ real(kind=f) :: fracmass
+ real(kind=f) :: elemass
+ real(kind=f) :: rmi
+ real(kind=f) :: rmj
+
+
+ ! Definition of i,j,k,n used in comments: colision between i and j bins
+ ! yields particle between bins k and k+1. Production in bin n is calculated.
+
+
+ ! Determine group that particles are produced in
+ igrp = igelem(ielem)
+
+ ! Particle number production
+ !
+ ! Coagulation between particle in group bin with particle in
+ ! group bin results in particle with mass between bins k and k+1.
+ ! First, loop over group-bin quads resulting in production in
+ ! bin = k+1. The set of quads is
+ ! defined in setupcoag.
+
+ do iquad = 1, npairu(igrp,ibin)
+
+ ig = igup(igrp,ibin,iquad) ! source group
+ jg = jgup(igrp,ibin,iquad) ! source group
+ i = iup(igrp,ibin,iquad) ! source bin
+ j = jup(igrp,ibin,iquad) ! source bin
+
+ iefrom = icoagelem(ielem,ig) ! source element for particle
+
+ if( if_sec_mom(igrp) )then
+ iefrom_cm = icoagelem_cm(ielem,ig) ! core mass moment source element
+ endif
+
+ ! If = 0 then there is no contribution to production
+ if( iefrom .ne. 0 ) then
+
+ je = ienconc(jg) ! source element for particle
+
+ if( if_sec_mom(igrp) )then
+ je_cm = icoagelem_cm(ielem,jg) ! core mass moment source element
+ endif
+
+ ! If ielem is core mass type and is a CN type and is different
+ ! from , then we must multiply production by mass
+ ! per particle () of element . (this is for all source
+ ! elements except particle number concentration in a multicomponent CN group).
+ do iz = 1, NZ
+
+ ! Bypass calculation if few source particles present
+ if( pconmax(iz,ig) .gt. FEW_PC .and. &
+ pconmax(iz,jg) .gt. FEW_PC )then
+
+ rmi = 1._f
+ i_pkern = 1
+
+ if( itype(ielem) .eq. I_COREMASS .or. &
+ itype(ielem) .eq. I_VOLCORE )then ! core mass
+
+ i_pkern = 3 ! Use different kernel for core mass prod.
+
+ if( ( itype(ienconc(ig)) .eq. I_INVOLATILE .or. &
+ itype(ienconc(ig)) .eq. I_VOLATILE ) &
+ .and. ig .ne. igrp ) then
+
+ ! CN source and ig different from igrp
+
+ if( ncore(ig) .eq. 0 )then ! No cores in source group
+
+ if(icomp(ienconc(ig)) .eq. icomp(ielem)) then
+ rmi = rmass(i,ig)
+ else
+ rmi = 0._f
+ endif
+
+ elseif( itype(iefrom) .eq. I_INVOLATILE .or. &
+ itype(iefrom) .eq. I_VOLATILE ) then
+
+ ! Source element is number concentration elem of mixed CN group
+ totmass = pc(iz,i,iefrom) * rmass(i,ig)
+ rmasscore = pc(iz,i,icorelem(1,ig))
+
+ do ic = 2,ncore(ig)
+ iecore = icorelem(ic,ig)
+ rmasscore = rmasscore + pc(iz,i,iecore)
+ enddo
+
+ fracmass = 1._f - rmasscore/totmass
+ elemass = fracmass * rmass(i,ig)
+ rmi = elemass
+ endif
+ endif ! ig is a CCN and not igrp
+
+ elseif( itype(ielem) .eq. I_CORE2MOM )then ! core mass^2
+
+ i_pkern = 5 ! Use different kernel for core mass^2 production
+ rmj = 1._f
+
+ if( itype(ienconc(ig)) .eq. I_INVOLATILE ) then
+ rmi = rmass(i,ig)
+ rmj = rmass(j,jg)
+ endif
+
+ endif ! itype(ielem) is a coremass or core2mom
+
+ ! For each spatial grid point, sum up coagulation production
+ ! contributions from each quad.
+ if( itype(ielem) .ne. I_CORE2MOM )then
+ coagpe(iz,ibin,ielem) = coagpe(iz,ibin,ielem) + &
+ pc(iz,i,iefrom)*pcl(iz,j,je)*rmi * &
+ ckernel(iz,i,j,ig,jg) * &
+ pkernel(i,j,ig,jg,igrp,i_pkern)
+ else
+ coagpe(iz,ibin,ielem) = coagpe(iz,ibin,ielem) + &
+ ( pc(iz,i,iefrom)*pcl(iz,j,je)*rmi**2 + &
+ pc(iz,i,iefrom_cm)*rmi* &
+ pcl(iz,j,je_cm)*rmj ) * &
+ ckernel(iz,i,j,ig,jg) * &
+ pkernel(i,j,ig,jg,igrp,i_pkern)
+ endif
+ endif ! end of ( pconmax .gt. FEW_PC )
+ enddo ! iz = 1, NZ
+ endif ! iefrom .ne. 0
+ enddo ! iquad
+
+ ! Next, loop over group-bin quads for production in bin = k from
+ ! bin due to collision between bins and .
+ ! Production will only occur if either k != or igrp !=
+ do iquad = 1, npairl(igrp,ibin)
+
+ ig = iglow(igrp,ibin,iquad)
+ jg = jglow(igrp,ibin,iquad)
+ i = ilow(igrp,ibin,iquad)
+ j = jlow(igrp,ibin,iquad)
+
+ iefrom = icoagelem(ielem,ig) ! source element for particle
+
+ if( if_sec_mom(igrp) )then
+ iefrom_cm = icoagelem_cm(ielem,ig) ! core mass moment source element
+ endif
+
+ if( iefrom .ne. 0 ) then
+
+ je = ienconc(jg) ! source element for particle
+
+ if( if_sec_mom(igrp) )then
+ je_cm = icoagelem_cm(ielem,jg) ! core mass moment source element
+ endif
+
+ do iz = 1, NZ
+
+ ! Bypass calculation if few particles present
+ if( pconmax(iz,ig) .gt. FEW_PC .and. &
+ pconmax(iz,jg) .gt. FEW_PC )then
+
+ rmi = 1._f
+ i_pkern = 2
+
+ if( itype(ielem) .eq. I_COREMASS .or. &
+ itype(ielem) .eq. I_VOLCORE )then ! core mass
+
+ i_pkern = 4 ! Use different kernel for core mass production
+
+ if( ( itype(ienconc(ig)) .eq. I_INVOLATILE .or. &
+ itype(ienconc(ig)) .eq. I_VOLATILE ) &
+ .and. ig .ne. igrp ) then
+
+ ! CN source and ig different from igrp
+
+ if( ncore(ig) .eq. 0 )then ! No cores in source group
+ rmi = rmass(i,ig)
+
+ elseif( itype(iefrom) .eq. I_INVOLATILE .or. &
+ itype(iefrom) .eq. I_VOLATILE ) then
+
+ ! Source element is number concentration elem of mixed CN group
+
+ totmass = pc(iz,i,iefrom) * rmass(i,ig)
+ rmasscore = pc(iz,i,icorelem(1,ig))
+ do ic = 2,ncore(ig)
+ iecore = icorelem(ic,ig)
+ rmasscore = rmasscore + pc(iz,i,iecore)
+ enddo
+ fracmass = 1._f - rmasscore/totmass
+ elemass = fracmass * rmass(i,ig)
+ rmi = elemass
+
+ endif ! pure CN group or CN group w/ cores
+
+ endif ! src group is CN and different from the target group
+
+ elseif( itype(ielem) .eq. I_CORE2MOM )then ! core mass^2
+
+ i_pkern = 6 ! Use different kernel for core mass^2 production
+ rmj = 1._f
+ if( itype(ienconc(ig)) .eq. I_INVOLATILE ) then
+ rmi = rmass(i,ig)
+ rmj = rmass(j,jg)
+ endif
+ endif ! itype(ielem)
+
+ if( itype(ielem) .ne. I_CORE2MOM )then
+ coagpe(iz,ibin,ielem) = coagpe(iz,ibin,ielem) + &
+ pc(iz,i,iefrom)*pcl(iz,j,je)*rmi * &
+ ckernel(iz,i,j,ig,jg) * &
+ pkernel(i,j,ig,jg,igrp,i_pkern)
+ else
+ coagpe(iz,ibin,ielem) = coagpe(iz,ibin,ielem) + &
+ ( pc(iz,i,iefrom)*pcl(iz,j,je)*rmi**2 + &
+ pc(iz,i,iefrom_cm)*rmi* &
+ pcl(iz,j,je_cm)*rmj ) * &
+ ckernel(iz,i,j,ig,jg) * &
+ pkernel(i,j,ig,jg,igrp,i_pkern)
+ endif
+ endif ! end of ( pconmax .gt. FEW_PC )
+ enddo ! iz = 1, NZ
+ endif ! end of (iefrom .ne. 0)
+ enddo ! iquad
+
+ ! Return to caller with coagulation production terms evaluated.
+
+ return
+end
diff --git a/src/physics/carma/base/csolve.F90 b/src/physics/carma/base/csolve.F90
new file mode 100644
index 0000000000..c287742f4e
--- /dev/null
+++ b/src/physics/carma/base/csolve.F90
@@ -0,0 +1,61 @@
+#include "carma_globaer.h"
+
+!! This routine calculates new particle concentrations from coagulation
+!! microphysical processes.
+!!
+!! The basic form from which the solution is derived is:
+!!
+!! ( new_value - old_value ) / dtime = source_term - loss_rate*new_value
+!!
+!! This routine derived from psolve.f code, in which particle concentrations
+!! due to coagulation were formerly included, before the relatively slow
+!! coagulation calcs were separated from the other microphysical processes
+!! so that time splitting could be applied to these fast & slow calcs.
+!!
+!! @author Bill McKie
+!! @version Sep-1997
+subroutine csolve(carma, cstate, ibin, ielem, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: ibin !! bin index
+ integer, intent(in) :: ielem !! element index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local Variables
+ integer :: igroup
+ real(kind=f) :: xyzmet(NZ)
+ real(kind=f) :: ppd(NZ)
+ real(kind=f) :: pls(NZ)
+
+
+ ! Define current group & particle number concentration element indices
+ igroup = igelem(ielem) ! particle group
+
+ ! Metric scaling factor
+ xyzmet = xmet(:) * ymet(:) * zmet(:)
+
+ ! Compute total production rate due to coagulation
+ ppd = coagpe(:,ibin,ielem) / xyzmet(:)
+
+ ! Compute total loss rate due to coagulation
+ pls = coaglg(:,ibin,igroup) / xyzmet(:)
+
+ ! Update net particle number concentration during current timestep
+ ! due to production and loss rates for coagulation
+ pc(:,ibin,ielem) = ( pc(:,ibin,ielem) &
+ + dtime * ppd(:) ) &
+ / ( ONE + pls(:) * dtime )
+
+ return
+end
diff --git a/src/physics/carma/base/detrain.F90 b/src/physics/carma/base/detrain.F90
new file mode 100644
index 0000000000..129152ce1c
--- /dev/null
+++ b/src/physics/carma/base/detrain.F90
@@ -0,0 +1,51 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine moves condensate from the detrained bins (pcd) to the
+!! particle bins.
+!!
+!! @author Chuck Bardeen
+!! @version May 2010
+subroutine detrain(carma, cstate, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: iz ! z index
+ integer :: ibin ! bin index
+ integer :: ielem ! element index
+
+ rc = RC_OK
+
+ ! Add the detrained condensate to the particle bins.
+ !
+ ! NOTE: For now, do this all prior to the fast microphysics, but eventually it may
+ ! be better to move it into microfast and substep the detrained condensate.
+ pc(:,:,:) = pc(:,:,:) + pcd(:,:,:)
+ pcd(:,:,:) = 0._f
+
+ ! Prevent particle concentrations from dropping below SMALL_PC
+ do iz = 1, NZ
+ do ibin = 1, NBIN
+ do ielem = 1, NELEM
+ call smallconc(carma, cstate, iz, ibin, ielem, rc)
+ end do
+ end do
+ end do
+
+ ! Return to caller with new particle number concentrations.
+ return
+end
diff --git a/src/physics/carma/base/downgevapply.F90 b/src/physics/carma/base/downgevapply.F90
new file mode 100644
index 0000000000..83dbb27381
--- /dev/null
+++ b/src/physics/carma/base/downgevapply.F90
@@ -0,0 +1,52 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine applies evaporation and nucleation production terms to
+!! particle concentrations.
+!!
+!! @author Andy Ackerman
+!! @version Dec-1995
+subroutine downgevapply(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: ibin !! bin index
+ integer :: ielem !! element index
+
+
+ ! Visit each radius bin for each element to compute particle production
+ ! due to evaporation and element transfer processes for which the source
+ ! element number is greater than the target element number
+ do ielem = 1,NELEM
+ do ibin = 1,NBIN
+
+ pc(iz,ibin,ielem) = pc(iz,ibin,ielem) + &
+ dtime * ( evappe(ibin,ielem) + &
+ rnucpe(ibin,ielem) )
+
+ ! Prevent particle concentrations from dropping below SMALL_PC
+ call smallconc(carma, cstate, iz, ibin, ielem, rc)
+
+ enddo
+ enddo
+
+
+ ! Return to caller with evaporation and down-grid element transfer
+ ! production terms applied to particle concentrations.
+ return
+end
diff --git a/src/physics/carma/base/downgxfer.F90 b/src/physics/carma/base/downgxfer.F90
new file mode 100644
index 0000000000..fedcfb500a
--- /dev/null
+++ b/src/physics/carma/base/downgxfer.F90
@@ -0,0 +1,146 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates particle source terms due to particle
+!! element transfer processes for which the source element number is larger
+!! than the target element number.
+!!
+!! @author Andy Ackerman
+!! @version Dec-1995
+subroutine downgxfer(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: igroup ! group index
+ integer :: iepart
+ integer :: ibin !! bin index
+ integer :: ielem !! element index
+ integer :: i
+ integer :: jefrom
+ integer :: iefrom
+ integer :: igfrom
+ integer :: ipow_from
+ integer :: ipow_to
+ integer :: ipow
+ integer :: jfrom
+ integer :: ifrom
+ integer :: ic
+ integer :: iecore
+ real(kind=f) :: elemass
+ real(kind=f) :: totmass
+ real(kind=f) :: rmasscore
+ real(kind=f) :: fracmass
+ real(kind=f) :: rnucprod
+
+
+ ! Calculate nucleation source terms for which the source element
+ ! number is greater than the target element number
+
+ ! Set nucleation production rates to zero to avoid double-application
+ ! of rates calculated in upgxfer.f
+ rnucpe(:,:) = 0._f
+
+ ! Loop over particle elements and bins
+ do ielem = 1, NELEM
+ do ibin = 1, NBIN
+
+ ! Define group & particle # concentration indices for current element
+ igroup = igelem(ielem) ! target particle group
+ iepart = ienconc(igroup) ! target particle number concentration element
+
+ ! First calculate production terms due to nucleation .
+
+ ! Loop over elements that nucleate to element .
+ do jefrom = 1,nnucelem(ielem)
+
+ iefrom = inucelem(jefrom,ielem) ! source particle element
+
+ ! Only calculate production rates here if is less than
+ ! . Otherwise, production is calculated in upgxfer.f
+ if( ielem .lt. iefrom ) then
+ igfrom = igelem(iefrom) ! source particle group
+
+ ! is the power to which the source particle mass must be taken
+ ! to match the type of the target element. This ugliness could be
+ ! handled much more slickly in setupnuc()
+ if( itype(iefrom) .eq. I_INVOLATILE .or. itype(iefrom) .eq. I_VOLATILE )then
+ ipow_from = 0
+ elseif ( itype(iefrom) .eq. I_COREMASS .or. itype(iefrom) .eq. I_VOLCORE )then
+ ipow_from = 1
+ else
+ ipow_from = 2
+ endif
+
+ if( itype(ielem) .eq. I_INVOLATILE .or. itype(ielem) .eq. I_VOLATILE )then
+ ipow_to = 0
+ elseif ( itype(ielem) .eq. I_COREMASS .or. itype(ielem) .eq. I_VOLCORE )then
+ ipow_to = 1
+ else
+ ipow_to = 2
+ endif
+
+ ipow = ipow_to - ipow_from
+
+ ! Loop over bins that nucleate to bin .
+ do jfrom = 1,nnucbin(igfrom,ibin,igroup)
+
+ ifrom = inucbin(jfrom,igfrom,ibin,igroup) ! bin of source
+
+ ! Bypass calculation if few source particles are present
+ if( pconmax(iz,igfrom) .gt. FEW_PC )then
+ if( rnuclg(ifrom,igfrom,igroup) .gt. 0._f )then
+
+ ! First calculate mass associated with the source element
+ ! (this is for all source elements except particle number
+ ! concentration in a multicomponent particle group).
+ if( ncore(igfrom) .eq. 0 .or. itype(iefrom) .gt. I_VOLATILE )then
+ elemass = rmass(ifrom,igfrom)
+ else
+ totmass = pc(iz,ifrom,iefrom) * rmass(ifrom,igfrom)
+ rmasscore = pc(iz,ifrom,icorelem(1,igfrom))
+
+ do ic = 2,ncore(igfrom)
+ iecore = icorelem(ic,igfrom)
+ rmasscore = rmasscore + pc(iz,ifrom,iecore)
+ enddo
+
+ fracmass = 1._f - rmasscore/totmass
+ elemass = fracmass * rmass(ifrom,igfrom)
+ endif
+
+ rnucprod = rnuclg(ifrom,igfrom,igroup) * &
+ pc(iz,ifrom,iefrom) * elemass**ipow
+
+ rnucpe(ibin,ielem) = rnucpe(ibin,ielem) + rnucprod
+
+ ! Calculate latent heat associated with nucleation to
+ ! from
+! rlprod = rlprod + rnucprod * rlh_nuc(iefrom,ielem) / &
+! (CP * rhoa(iz)) * elemass
+
+ endif ! (rnuclg > 0.)
+ endif ! (pconmax > FEW_PC)
+ enddo ! (jfrom = 1,nnucbin)
+ endif ! (ielem < iefrom)
+ enddo ! (jefrom = 1,nnucelem)
+ enddo ! (ibin = 1, NBIN)
+ enddo ! (ielem = 1, NELEM)
+
+ ! Return to caller with down-grid production terms evaluated.
+ return
+end
diff --git a/src/physics/carma/base/evap_ingrp.F90 b/src/physics/carma/base/evap_ingrp.F90
new file mode 100644
index 0000000000..a9fda41df9
--- /dev/null
+++ b/src/physics/carma/base/evap_ingrp.F90
@@ -0,0 +1,53 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates particle source terms of droplets
+!! evaporating within a particle group.
+!!
+!! Distinct evaporation of cores has not been treated.
+!!
+!! @author Andy Ackerman
+!! @version Aug-2001
+subroutine evap_ingrp(carma,cstate,iz,ibin,ig,ip,rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(in) :: ibin !! bin index
+ integer, intent(in) :: ig !! group index
+ integer, intent(in) :: ip
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: ie
+ integer :: isub
+
+
+ ! For a single group, the core mass fraction is 0.
+ cmf(ibin,ig) = 0.0_f
+
+ ! The smallest bin cannot be a source to smaller bins in same group
+ if( ibin .eq. 1 )then
+ return
+ endif
+
+ ! Evaluate evaporation source term for all elements in group
+ do isub = 1, nelemg(ig)
+ ie = ip + isub - 1
+ evappe(ibin-1,ie) = evappe(ibin-1,ie) + &
+ pc(iz,ibin,ie)*evaplg(ibin,ig)
+ enddo
+
+ return
+end
diff --git a/src/physics/carma/base/evap_mono.F90 b/src/physics/carma/base/evap_mono.F90
new file mode 100644
index 0000000000..bf08e8b9fa
--- /dev/null
+++ b/src/physics/carma/base/evap_mono.F90
@@ -0,0 +1,109 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates particle source terms due to total
+!! evaporation from bin group into a monodisperse
+!! distribution.
+!!
+!! Distinct evaporation of cores has not been treated.
+!!
+!! @author Andy Ackerman
+!! @version Aug-2001
+subroutine evap_mono(carma,cstate,iz,ibin,ig,iavg,ieto,igto,rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(in) :: ibin !! bin index
+ integer, intent(in) :: ig !! group index
+ integer, intent(in) :: iavg
+ integer, intent(in) :: ieto
+ integer, intent(in) :: igto
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: ic
+ integer :: iecore
+ integer :: ie2cn
+ integer :: jbin
+ logical :: conserve_mass
+ real(kind=f) :: factor
+ real(kind=f) :: fracmass
+
+
+ ! Define option to conserve mass or number when a choice must be made
+ ! during monodisperse total evaporation beyond CN grid -- should be done in setupaer()
+ conserve_mass = .true.
+
+ ! Set automatic flag for total evaporation used in gasexchange()
+ totevap(ibin,ig) = .true.
+
+ ! Possibly put all of core mass into largest, smallest, or
+ ! smallest nucelated CN bin
+ if( too_big .or. too_small .or. nuc_small )then
+
+ if( too_big )then
+ jbin = NBIN
+ elseif( too_small )then
+ jbin = 1
+ else
+ jbin = 1
+ endif
+
+ if( conserve_mass )then
+ factor = coreavg/rmass(jbin,igto)
+ else
+ factor = ONE
+ endif
+
+ ! First the CN number concentration element
+ evappe(jbin,ieto) = evappe(jbin,ieto) + factor*evdrop
+
+ ! Now the CN cores
+ do ic = 2, ncore(ig)
+ iecore = icorelem(ic,ig)
+ ie2cn = ievp2elem(iecore)
+ evappe(jbin,ie2cn) = evappe(jbin,ie2cn) + &
+ factor*evcore(ic)*rmass(jbin,igto)
+ enddo
+ else
+
+ ! Partition core mass between two CN bins, conserving total core mass
+ ! and number. The number will be subdivided into bins and -1.
+ if( iavg .le. 1 .or. iavg .gt. NBIN )then
+ if (do_print) write(LUNOPRT, *) "evap_mono: bad iavg = , ", iavg
+ rc = RC_ERROR
+ return
+ endif
+
+ fracmass = ( rmass(iavg,igto) - coreavg ) / diffmass(iavg,igto,iavg-1,igto)
+! fracmass = max( 0._f, min( ONE, fracmass ) )
+
+ ! First the CN number concentration element
+ evappe(iavg-1,ieto) = evappe(iavg-1,ieto) + evdrop*fracmass
+ evappe(iavg,ieto) = evappe(iavg,ieto) + evdrop*( ONE - fracmass )
+
+ ! Now the cores
+ do ic = 2, ncore(ig)
+ iecore = icorelem(ic,ig)
+ ie2cn = ievp2elem(iecore)
+ evappe(iavg-1,ie2cn) = evappe(iavg-1,ie2cn) + &
+ rmass(iavg-1,igto)*evcore(ic)*fracmass
+ evappe(iavg,ie2cn) = evappe(iavg,ie2cn) + &
+ rmass(iavg,igto)*evcore(ic)*( ONE - fracmass )
+ enddo
+ endif
+
+ return
+end
diff --git a/src/physics/carma/base/evap_poly.F90 b/src/physics/carma/base/evap_poly.F90
new file mode 100644
index 0000000000..1eb7117a7b
--- /dev/null
+++ b/src/physics/carma/base/evap_poly.F90
@@ -0,0 +1,141 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates particle source terms due to
+!! total evaporation into a polydisperse CN distribution by assuming
+!! that the pdf of core mass is log-normal skewed by mass raised to
+!! the -3/2 power (which guarantees average core mass from pdf is the
+!! same as average core mass).
+!!
+!! Distinct evaporation of cores has not been treated.
+!!
+!! @author Andy Ackerman
+!! @version Aug-2001
+subroutine evap_poly(carma,cstate,iz,ibin,ig,iavg,ieto,igto,rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(in) :: ibin !! bin index
+ integer, intent(in) :: ig !! group index
+ integer, intent(in) :: iavg
+ integer, intent(in) :: ieto
+ integer, intent(in) :: igto
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: ic
+ integer :: ito
+ integer :: kount_s
+ integer :: kount_l
+ integer :: iecore
+ integer :: ie2cn
+ real(kind=f) :: prob(NBIN)
+ real(kind=f) :: rn_norms
+ real(kind=f) :: rn_norml
+ real(kind=f) :: rm_norms
+ real(kind=f) :: rm_norml
+ real(kind=f) :: expon
+ real(kind=f) :: rmassto
+ real(kind=f) :: dmto
+ real(kind=f) :: weightl
+ real(kind=f) :: weights
+
+
+ ! Treat total evaporation from a polydisperse core mass distribution:
+ ! assume a log-normal CN size distribution and conserve number and mass as
+ ! described by Turco (NASA Technical Paper 1362).
+ !
+ ! Set automatic flag for total evaporation used in gasexchange()
+ totevap(ibin,ig) = .true.
+
+ ! Calculate number and mass
+ ! normalization factors for cores smaller and larger than .
+ rn_norms = 0._f
+ rn_norml = 0._f
+ rm_norms = 0._f
+ rm_norml = 0._f
+ kount_s = 0
+ kount_l = 0
+
+ do ito = 1, NBIN
+
+ rmassto = rmass(ito,igto)
+ dmto = dm(ito,igto)
+
+ ! is probability that core mass is in CN bin .
+ if( coreavg .gt. 0._f .and. coresig .gt. 0._f )then
+ expon = -log( rmassto/coreavg )**2 / ( 2.*coresig )
+ expon = max(-POWMAX, expon)
+ else
+ expon = 0._f
+ endif
+
+ prob(ito) = rmassto**(-1.5_f) * exp( expon )
+
+ if( ito .lt. iavg )then
+ rn_norms = rn_norms + prob(ito)*dmto
+ rm_norms = rm_norms + prob(ito)*dmto*rmassto
+ kount_s = kount_s + 1
+ else
+ rn_norml = rn_norml + prob(ito)*dmto
+ rm_norml = rm_norml + prob(ito)*dmto*rmassto
+ kount_l = kount_l + 1
+ endif
+ enddo
+
+ ! Calculate mass weighting factors for small and
+ ! large cores.
+ if( kount_s .eq. 0 )then
+ weightl = ONE
+ elseif( kount_l .eq. 0 )then
+ weightl = 0._f
+ else
+ rm_norms = rm_norms/rn_norms
+ rm_norml = rm_norml/rn_norml
+ weightl = (coreavg - rm_norms) / (rm_norml - rm_norms)
+ if( weightl .gt. ALMOST_ONE )then
+ weightl = ONE
+ elseif( weightl .lt. ALMOST_ZERO )then
+ weightl = 0._f
+ endif
+ endif
+
+ weights = ONE - weightl
+
+ ! Renormalize probability distribution function and evaluate the CN
+ ! evaporation source term .
+ do ito = 1, NBIN
+
+! if( ito .le. iavg )then
+ if( ito .lt. iavg )then ! Kevin M
+ prob(ito) = prob(ito)*weights/rn_norms
+ else
+ prob(ito) = prob(ito)*weightl/rn_norml
+ endif
+
+ ! First the CN number concentration element
+ evappe(ito,ieto) = evappe(ito,ieto) + evdrop*prob(ito)*dm(ito,igto)
+
+ ! Now the CN core elements
+ do ic = 2, ncore(ig)
+ iecore = icorelem(ic,ig)
+ ie2cn = ievp2elem(iecore)
+ evappe(ito,ie2cn) = evappe(ito,ie2cn) + &
+ rmass(ito,igto)*evcore(ic)*prob(ito)*dm(ito,igto)
+ enddo
+ enddo
+
+ return
+end
diff --git a/src/physics/carma/base/evapp.F90 b/src/physics/carma/base/evapp.F90
new file mode 100644
index 0000000000..64bad71d7f
--- /dev/null
+++ b/src/physics/carma/base/evapp.F90
@@ -0,0 +1,199 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates particle source terms due to evaporation .
+!!
+!! @author Andy Ackerman
+!! @version Aug-2001
+subroutine evapp(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: ibin !! bin index
+ integer :: ielem !! element index
+ integer :: ig !! source group index
+ integer :: ip !! source number concentration element
+ integer :: ic
+ integer :: ic1 !! element of first core mass in group
+ integer :: iecore
+ integer :: ieto
+ integer :: igto
+ integer :: iavg
+ logical :: evap_total
+ real(kind=f) :: sig_mono
+ real(kind=f) :: coretot
+ real(kind=f) :: coremom
+ real(kind=f) :: smf
+ integer :: nbin
+
+
+ ! Define criterion for monodisperse core mass distributions
+ sig_mono = sqrt( ALMOST_ZERO )
+
+ ! Loop over source groups (from which evaporation is being treated)
+ do ig = 1, NGROUP
+
+ ip = ienconc(ig)
+
+ ! No evaporation unless particles are volatile
+ if( itype(ip) .eq. I_VOLATILE )then
+
+ ! Make sure that these always get intializaed, since they can
+ ! cause problems in other parts of the code if they aren't.
+ totevap(:,ig) = .false.
+ cmf(:,ig) = 0._f
+
+ if (pconmax(iz, ig) > FEW_PC) then
+
+ ic1 = icorelem(1,ig)
+
+ ! Loop over source bins and calculate temporary evaporation source
+ ! for droplets in next smaller bin assuming no total evaporation
+ do ibin = 1, NBIN
+ evdrop = pc(iz,ibin,ip)*evaplg(ibin,ig)
+
+ ! Check for evaporation of a sufficient number of droplets
+! if( evdrop .gt. 0._f .and. pc(iz,ibin,ip) .gt. SMALL_PC )then
+ if( evdrop .gt. 0._f )then
+
+ ! No cores: transfer droplets within group
+ if( ic1 .eq. 0 )then
+ call evap_ingrp(carma,cstate,iz,ibin,ig,ip,rc)
+ else
+
+ ! First core is not involatile (therefore none are)
+ ! -- this is a hack until enforced/checked in setupbins() --
+ ! transfer droplets within group
+ !
+ if( itype(ic1) .ne. I_COREMASS )then
+ call evap_ingrp(carma,cstate,iz,ibin,ig,ip,rc)
+ else
+
+ ! Have cores: calculate the amount of the source term
+ ! by number associated with total evaporation of secondary cores
+ coretot = pc(iz,ibin,ic1)
+ do ic = 2, ncore(ig)
+ iecore = icorelem(ic,ig)
+ if( itype(iecore) .eq. I_COREMASS )then
+ coretot = coretot + pc(iz,ibin,iecore)
+ endif
+ enddo
+ do ic = 2, ncore(ig)
+ iecore = icorelem(ic,ig)
+ if( itype(iecore) .eq. I_COREMASS )then
+ evcore(ic) = evdrop*pc(iz,ibin,iecore)/coretot
+ endif
+ enddo
+
+ ! Calculate average particle core mass and fraction
+ coreavg = coretot / pc(iz,ibin,ip)
+ coreavg = min( rmass(ibin,ig), coreavg )
+ cmf(ibin,ig) = coreavg / rmass(ibin,ig)
+ ! cmf(ibin,ig) = max( 0., min( ONE, cmf(ibin,ig) ) )
+
+ ! Get target number concentration element and group for total evaporation
+ ! and evaluate logical flags regarding position on CN bin and index of
+ ! target CN bin
+ ieto = ievp2elem(ic1)
+
+ ! To treat internal mixtures, it is possible for the condensate to
+ ! totally evaporate and have core mass, but for there not to be another
+ ! group to which the core mass should go. So allow no evp2elem, but
+ ! always use the in group evaporation.
+ if (ieto == 0) then
+ nuc_small = .false.
+ else
+ igto = igelem(ieto)
+
+ too_small = coreavg .lt. rmass(1,igto)
+ nbin = NBIN
+ too_big = coreavg .gt. rmass(nbin,igto)
+
+ if( .not. (too_small .or. too_big) )then
+ iavg = log( coreavg / rmassmin(igto) ) / &
+ log( rmrat(igto) ) + 2
+ iavg = min( iavg, NBIN )
+ endif
+
+ ! Only consider size of evaporating cores relative to nuc_small
+ ! when treating core second moment for this particle group
+ if( if_sec_mom(ig) )then
+ nuc_small = coreavg .lt. rmass(1,igto)
+ else
+ nuc_small = .false.
+ endif
+ end if
+
+ ! Want total evaporation when
+ ! cores smaller than smallest nucleated
+ ! OR evaporating droplets are in bin 1
+ ! OR droplets will be created with core mass fraction > 1
+ evap_total = nuc_small .or. ibin .eq. 1 .or. &
+ rmrat(ig)*cmf(ibin,ig) .gt. ONE
+
+ ! No core second moment: evaporate to monodisperse CN cores or within group.!
+ if( .not. if_sec_mom(ig) )then
+
+ if( evap_total .and. (ieto /= 0) )then
+ call evap_mono(carma,cstate,iz,ibin,ig,iavg,ieto,igto,rc)
+ else
+ call evap_ingrp(carma,cstate,iz,ibin,ig,ip,rc)
+ endif
+
+ ! Have core second moments: evaporate to mono- or polydisperse CN cores
+ ! or within group. First calculate average core second moment ,
+ ! second moment fraction , and square of the logarithm of the geometric
+ ! standard deviation of the assumed core mass distribution .
+ else
+
+ coremom = pc(iz,ibin,imomelem(ig)) / pc(iz,ibin,ip)
+ smf = coremom / rmass(ibin,ig)**2
+ coresig = log( smf / cmf(ibin,ig)**2 )
+
+ ! Want total evaporation for above reasons
+ ! OR droplets will be created with core moment fraction > 1
+ evap_total = evap_total .or. rmrat(ig)**2*smf .gt. ONE
+
+ if( evap_total .and. (ieto /= 0) )then
+
+ ! Want monodisperse total evaporation when
+ ! cores smaller than smallest nucleated
+ ! OR evaporating core distribution is narrow
+ ! Otherwise want polydisperse total evaporation
+ if( nuc_small .or. coresig .le. sig_mono )then
+ call evap_mono(carma,cstate,iz,ibin,ig,iavg,ieto,igto,rc)
+ else
+ call evap_poly(carma,cstate,iz,ibin,ig,iavg,ieto,igto,rc)
+ endif
+
+ ! Droplet evaporation within group
+ else
+ call evap_ingrp(carma,cstate,iz,ibin,ig,ip,rc)
+ endif
+ endif ! if_sec_mom(ig)
+ endif ! itype(ic1)
+ endif ! ic1=0
+ endif ! evaplg > 0
+ enddo ! ibin=1,NBIN
+ endif ! enough particles
+ endif ! volatile particles
+ enddo ! ig=1,NGROUP
+
+ ! Return to caller with evaporation production terms evaluated.
+ return
+end
diff --git a/src/physics/carma/base/fractal_meanfield_mod.F90 b/src/physics/carma/base/fractal_meanfield_mod.F90
new file mode 100644
index 0000000000..5139fcd0fc
--- /dev/null
+++ b/src/physics/carma/base/fractal_meanfield_mod.F90
@@ -0,0 +1,1475 @@
+!! This module (fractal_meanfield_mod.F90) contains the main routines
+!! necessary to calculate the solution of the mean field approximation
+!! for a dry fractal particle composed of identical spherical monomers.
+!! This is used to generate optical properties for these paticles in CARMA.
+!!
+!! See Botet et al. 1997 "Mean-field approximation of Mie
+!! scattering by fractal aggregates of identical spheres."
+!! Applied Optics 36(33) 8791-8797
+!!
+!! Original code from P. Rannou and R. Botet.
+!! Translated to F90 and ported into CARMA by E. Wolf
+!!
+!! master: fractal_meanfield calling: cmie,ludcmpc,lubksbc,dqagi
+!!
+!! calculating the monomer Mie scattering
+!! - SUBROUTINE cmie() calling: intmie()
+!! - SUBROUTINE intmie() calling: intmie()
+!!
+!! calculating the matrix elements
+!! - FUNCTION funa() calling: dqag,fpl
+!! - FUNCTION fpl() calling: plgndr
+!! - FUNCTION plgndr()
+!! - FUNCTION funb_n()
+!! - FUNCTION funs_n() calling: dq2agi,xfreal_n,xfimag_n
+!! - FUNCTION xfreal_n() calling: besseljy,phi
+!! - FUNCTION xfimag_n() calling: besseljy,phi
+!! - FUNCTION BESSELJY()
+!!
+!! Routines to calculate the scattered wave
+!! of monomer:
+!! - FUNCTION fpi() calling: plgndr()
+!! - FUNCTION ftau() calling: plgndr()
+!! of agglomerate/cluster:
+!! - FUNCTION fp1()
+!!
+!! Routines related to the probability distribution:
+!! - FUNCTION anorm() calling: dqdagi,fdval
+!! - FUNCTION fdval()
+!! - FUNCTION phi() calling: fdval
+!! - FUNCTION fco() calling: fdval
+!!
+!! @author P. Rannou, R. Botet, Eric Wolf
+!! version March 2013
+module fractal_meanfield_mod
+
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carma_mod
+
+ use adgaquad_types_mod
+ use adgaquad_mod
+ use lusolvec_mod
+
+ implicit none
+
+ private
+
+ public :: fractal_meanfield
+
+ ! Private module varibles: Moved from COMMON blocks
+ integer, parameter :: nmi=40
+ integer, parameter :: n2m = 2*nmi
+
+ contains
+
+ !!
+ !! Generate optical properties for CARMA fractal particles.
+ !!
+ !! See Botet et al. 1997 "Mean-field approximation of Mie
+ !! scattering by fractal aggregates of identical spheres."
+ !! Applied Optics 36(33) 8791-8797
+ !!
+ !! @author P.Rannou, R.Botet, Eric Wolf
+ !! @version March 2013
+ subroutine fractal_meanfield(carma, xl_in, xk_in, xn_in, nb_in, alpha_in, &
+ df_in, rmon,xv, ang, Qext, Qsca, gfac, rc)
+
+ ! some of these may be included in carma object
+ type(carma_type), intent(in) :: carma !! the carma object
+ real(kind=f),intent(in) :: xl_in !! Wavelength [microns]
+ real(kind=f),intent(in) :: xk_in !! imaginary index of refraction
+ real(kind=f),intent(in) :: xn_in !! real index of refraction
+ real(kind=f),intent(in) :: nb_in !! number of monomers
+ real(kind=f),intent(in) :: alpha_in !! Packing coefficient
+ real(kind=f),intent(in) :: df_in !! Fractal dimension
+ real(kind=f),intent(in) :: rmon !! monomer size [microns]
+ real(kind=f),intent(in) :: xv !! set to 1
+ real(kind=f),intent(in) :: ang !! angle set to zero
+ real(kind=f),intent(out) :: Qext !! EFFICIENCY FACTOR FOR EXTINCTION
+ real(kind=f),intent(out) :: Qsca !! EFFICIENCY FACTOR FOR SCATTERING
+ real(kind=f),intent(out) :: gfac !! asymmetry factor
+ integer,intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer, parameter :: nth = 10001
+ integer, parameter :: maxsub = 50000
+ integer, parameter :: lenw = 200000
+ integer :: nstop ! index with the last mie-coefficient
+ integer :: n1stop
+ integer :: pp,tt,mm
+ real(kind=f) :: krg,rg ! Particle structure
+ real(kind=f) :: sigmas,sigmae,nc1
+ real(kind=f) :: sigext ! extinction cross section
+ real(kind=f) :: sigsca ! scattering cross section
+ real(kind=f) :: sigabs ! absorption cross section
+ real(kind=f) :: totg ! asymmetry parameter
+ real(kind=f) :: sigext2,sigext3
+ real(kind=f) :: rems ! radius of equivalent mass sphere
+ real(kind=f) :: gems ! geometric cross-section of equivalent mass sphere
+ real(kind=f) :: dthetar,angler,weight
+ real(kind=f) :: sumsca
+ real(kind=f) :: lbd,beta ! optical characteristics
+ real(kind=f) :: sstest(0:nf)
+ real(kind=f) :: setest(0:nf)
+ real(kind=f) :: xl(39) ! place holder for wavelength
+ real(kind=f) :: xn(39) ! place holder for real index of refraction
+ real(kind=f) :: xk(39) ! place holder for imaginary index of refraction
+ real(kind=f) :: val
+ real(kind=f) :: funca(nmi,nmi,0:n2m) ! for storage of funa(nu,n;p)
+ complex(kind=f) :: res ! for storage of funs_n
+ complex(kind=f) :: funcs(0:n2m)
+ real(kind=f) :: s11(0:nth-1)
+ real(kind=f) :: s11_n(0:nth-1)
+ real(kind=f) :: xint(0:nth-1)
+ real(kind=f) :: wom
+ real(kind=f) :: pol(0:nth-1)
+ complex(kind=f) :: s01,s02
+ complex(kind=f) :: s1(0:nth-1)
+ complex(kind=f) :: s2(0:nth-1)
+ complex(kind=f) :: ajt
+ complex(kind=f) :: an(nf)
+ complex(kind=f) :: bn(nf)
+ complex(kind=f) :: ni,i,id,onec,zeroc
+ complex(kind=f) :: d1(nmi)
+ complex(kind=f) :: d2(nmi)
+ complex(kind=f) :: Ap1(nmi,nmi)
+ complex(kind=f) :: Bp1(nmi,nmi)
+ complex(kind=f) :: dvec(n2m) ! For matrix eqn of order 2N
+ complex(kind=f) :: cvec(n2m)
+ complex(kind=f) :: EpABC(n2m,n2m)
+ integer :: luindx(n2m) ! For LU decomposition
+ real(kind=f) :: dlu
+ integer :: ifail
+ integer :: iwork(maxsub)
+ integer :: neval,nsubin
+ real(kind=f) :: work(lenw)
+
+ ! Previously these were implicitly defined
+ real(kind=f) :: angle, pi, rn, ri
+ real(kind=f) :: deltas, deltae, xfact
+ real(kind=f) :: bound, errrel, p1, dp1
+ real(kind=f) :: errabs, total
+ integer :: n2stop, n3stop, ntheta, ii, kk, nn, jj, iy, ir, q, interv
+ real(kind=f) :: a0, c0, a1, c1, a2, c2
+ real(kind=f) :: qabs
+
+ ! Previously these were globals, which wouldn't be thread safe.
+ type(adgaquad_vars_type) :: fx_vars
+
+ ! Set the return code to default to okay.
+ rc = RC_OK
+
+ ! *** Set from input arguments
+ fx_vars%nb = nb_in
+ fx_vars%df = df_in
+ fx_vars%alpha = alpha_in
+ xl(1) = xl_in
+ xk(1) = xk_in
+ xn(1) = xn_in
+
+ ! *** Complex constants 1, 1, identity(1,1), zero(0,0) :
+ i = cmplx(0._f,1._f,kind=f)
+ onec = cmplx(1._f,0._f,kind=f)
+ id = cmplx(1._f,1._f,kind=f)
+ zeroc = cmplx(0._f,0._f,kind=f)
+
+ ! Other initializations
+ funca(:,:,:) = 0.0_f
+ fx_vars%a = rmon *1.e-2_f ! a = r_monomer in m
+ beta=ang*(3.1415926_f / 180._f) ! =0 when ang=0
+ Ap1(:,:) = zeroc
+ Bp1(:,:) = zeroc
+ sstest(:) = 0.0_f
+ setest(:) = 0.0_f
+
+ ! ****************************************************************
+ ! *** Definition and calculation of factorials 0 - nf
+ ! *** (nf set in adgaqaud_types_mod.F90)
+ ! *** and storage [ real*8 fact() (double prec.) ]
+ ! ****************************************************************
+
+ fx_vars%fact(0)=1._f ! factorials fact(n)=n!
+ do ii=1,nf
+ fx_vars%fact(ii) = fx_vars%fact(ii-1)*ii*1._f
+ end do
+
+ pi=4._f*atan(1._f) ! 3.1415926535
+ fx_vars%coeff=anorm(carma,fx_vars,rc)
+ if (rc < 0) return
+
+ ! ****************************************************************
+ ! anorm() integrated INT_0^inf[ x**(df-1.)*exp(-x**df/2._f) dx ]
+ ! and occupied
+ ! anorm := 4 pi * INT_0^inf[ x**(df-1.)*exp(-x**df/2._f) dx ]
+ ! == geometric scalingfactor Eq.(10) in [Botet et al, 1995]
+ ! c := 0.5
+ ! ****************************************************************
+
+ kk=1
+ ni=xn(kk)*1._f+i*xk(kk)*xv*1._f ! ni := complex index of refraction of monomer
+ ! (xv := 1 ; input parameter in file "calpha")
+ lbd=xl(kk)*1.e-6_f ! lbd := wavelength in m
+ ! (in matrix medium / material !)
+ fx_vars%k=2._f*pi/lbd ! k := abs.val. of wavevector in m^-1
+ ! (in matrix medium / material !)
+
+ ! *** ******************************************************************
+ ! *** Calculation of Mie coefficients for monomer scattering
+ ! *** up to a maximum order of nf=50
+ ! *** ******************************************************************
+
+ do ii=1,nf
+ an(ii) = zeroc
+ bn(ii) = zeroc
+ end do
+
+ rn=xn(kk) ! Re(relative_n_complex,monomer)
+ ri=xk(kk)*xv ! Im(relative_n_complex,monomer)
+ ! xv should be set to 1 (sse above)
+ ! a = monomer sphere radius
+ ! lbd = wavelength in matrix medium
+
+ ! Call Mie routine
+ call cmie(lbd,rn,ri,fx_vars%a,an,bn,nstop)
+
+ do ii=1,nf
+ if (an(ii).ne.0._f) nstop=ii
+ end do
+
+ ! nstop is now the index with the last mie-coefficient
+ ! (highest index i) an(i) not equal zero.
+ ! since all the an were set to zero before calling
+ ! cmie(), nstop is the termination index used in cmie()
+ ! or in intmie(). Usually, a termination index
+ ! nstop = INT( 2 + x + 4 x^(1/3) ) is used; in intmie(),
+ ! however, a value of
+ ! nstop := MAX( INT(...), |m*x| )+15 is used !???
+
+ sigmas=0._f
+ sigmae=0._f
+
+ do nn=1,nstop
+ nc1=abs(an(nn))**2._f+abs(bn(nn))**2._f
+ nc1=nc1*(2._f*nn+1._f)
+ sigmas=sigmas+nc1*(2._f*3.14159265_f)/(fx_vars%k**2._f)
+ nc1=real(an(nn)+bn(nn))
+ nc1=nc1*(2._f*nn+1._f)
+ sigmae=sigmae+nc1*(2._f*3.14159265_f)/(fx_vars%k**2._f)
+ sstest(nn)=sigmas
+ setest(nn)=sigmae
+ deltas=abs(sstest(nn-1)-sstest(nn))/sstest(nn)
+ deltae=abs(setest(nn-1)-setest(nn))/setest(nn)
+ if(deltas.gt.1.e-6_f) n2stop=nn
+ if(deltae.gt.1.e-6_f) n3stop=nn
+ end do
+
+ n1stop=n2stop
+ if (n3stop.gt.n2stop) n1stop=n3stop
+ ! The order of the set of linear equations is chosen
+ ! as the number of mie coefficients where the sum yielding
+ ! the monomer ext./scatt. cross sections do not change more
+ ! than 1.D-3 compared to the values with one summand less.
+
+ rg=fx_vars%alpha*fx_vars%nb**(1._f/fx_vars%df)*fx_vars%a ! rg := radius of gyration
+ krg=fx_vars%k*rg
+ ntheta=7800 !180-int(krg**.5*28*log10(dxk(kk)))
+ if (ntheta*0.5_f .eq. (ntheta/2)*1._f) ntheta=ntheta+1
+
+ ! *** ******************************************************************
+ ! *** FIRST PART: Solution of self consistent mean field equation,
+ ! *** i.e. the set of linear equations (SLE) defining the
+ ! *** mean field coefficients d^1_1,n and d^2_1,n
+ ! *** according to Eq.(12) of (Botet 1997)
+ ! *** To do so,
+ ! *** - matrix elements A^1,nu_1,n and B^1,nu_1,n
+ ! *** are calculated with Eq.(13), using Eqns.(14)-(16)
+ ! *** - the set of lin. Eqns. is solved yielding the d's
+ ! *** ******************************************************************
+ ! *** Eq.(12) of Botet et al 1997 defines a matrix eqn. of order 2N :
+ ! *** (since N=n1stop, 2N = 2 * n1stop = order of SLE)
+ ! ***
+ ! *** EpABC * dvec = cvec with
+ ! ***
+ ! *** dvec and cvec being the 2N-vectors
+ ! ***
+ ! *** ( d^(1)_1,1 ) ( a_1 )
+ ! *** ( d^(1)_1,2 ) ( a_2 )
+ ! *** ( ... ) ( ... )
+ ! *** ( d^(1)_1,n ) ( a_n )
+ ! *** dvec := ( d^(2)_1,1 ) and cvec := ( b_1 ) and further
+ ! *** ( d^(2)_1,2 ) ( b_2 )
+ ! *** ( ... ) ( ... )
+ ! *** ( d^(2)_1,n ) ( b_n )
+ ! ***
+ ! ***
+ ! *** EpABC := 1 + AB * C where AB, 1, C are the 2N*2N - matrices
+ ! ***
+ ! *** ( a_1 0 0 ... ... 0 )
+ ! *** ( 0 a_2 0 ... ... 0 )
+ ! *** AB := ( 0 0 ... 0 0 0 ... 0 ) 1 := 2N*2N unity matrix
+ ! *** ( 0 0 ... a_n 0 0 ... 0 )
+ ! *** ( 0 0 ... 0 b_1 0 ... 0 )
+ ! *** ( ... ... ... 0 )
+ ! *** ( ... ... 0 b_n-1 0 )
+ ! *** ( 0 0 ... ... 0 0 b_n)
+ ! ***
+ ! *** and ( A B )
+ ! *** C := ( ) where A and B are the two N*N matrices
+ ! *** ( B A ) given by Eq.(13),
+ ! *** including the factor (N_monomers - 1):
+ ! ***
+ ! *** A_n,nu := (N_m-1) * A_(1,n)^(1,nu) and
+ ! *** B_n,nu := (N_m-1) * B_(1,n)^(1,nu)
+ ! ***
+ ! *** (A_(1,n... and B_(1,n... according to Eq.(13) of Botet 1997)
+ ! *** ******************************************************************
+
+ n2stop = 2 * n1stop ! n2stop = order of SLE
+
+ ! *** ******************************************************************
+ ! *** Error handling moved from xfreal_n, xfimag_n. Calculations fail
+ ! *** in integration package when n2stop > 48. n2stop is related to the
+ ! *** number of complex mie scattering coefficients used in teh calculation
+ ! *** which is in turn related to the size parameter of monomers.
+ ! *** If nstop>48 end calculation here instead of continuing.
+
+ if (n2stop.gt.48) then
+ if (carma%f_do_print) then
+ write(carma%f_LUNOPRT, *) "fractal_meanfield_mod::n2stop greater &
+ &than 48. Size parameter (2*pi*rmon/lambda): ", &
+ 2._f*3.14159265_f*fx_vars%a/lbd, "Monomer Size parameter &
+ &must be less than ~17."
+ end if
+ rc = RC_ERROR
+ return
+ endif
+
+
+ ! *** ******************************************************************
+ do ii=1,n1stop
+ cvec(ii) = an(ii) ! right hand side vector
+ cvec(n1stop+ii) = bn(ii)
+ dvec(ii) = zeroc ! solution vector d
+ dvec(n1stop+ii) = zeroc
+ end do
+
+ do pp=0,n2stop !variable p
+ res = funs_n(carma,fx_vars,pp,rc) ! Eq.(16) S_p(k R_g)
+ if (rc < 0) return
+ funcs(pp) = res
+ end do
+
+ ! Calculate terms A and B
+
+ ! *** loops over indices nu,n,p :
+ do ii=1,n1stop !variable n
+ do jj=1,n1stop !variable nu
+ mm = IABS(ii-jj)
+ tt = ii+jj
+
+ ! *** ******************************************************************
+ ! calculation of A_(1,n)^(1,nu) according to Eq.(13)
+ ! *** ******************************************************************
+ do pp=mm,tt
+
+ funca(jj,ii,pp) = funa(carma,fx_vars,jj,ii,pp,rc) ! Eq.(14) a(nu,n;p)a
+ if (rc < 0) return
+
+ Ap1(ii,jj) = Ap1(ii,jj) + &
+ ( onec * (ii*(ii+1)+jj*(jj+1)-pp*(pp+1)) ) &
+ * funca(jj,ii,pp) * funcs(pp)
+ end do ! loop over pp (variable p)
+
+ ! scaling factors of eq.(13), factor (N_mon-1) from eq.(12)
+ Ap1(ii,jj) = Ap1(ii,jj) * (2._f*jj+1._f)/(jj*(jj*1._f+1._f))
+ Ap1(ii,jj) = Ap1(ii,jj) * (fx_vars%nb-1._f) / (ii*(ii*1._f+1._f))
+
+ ! *** ******************************************************************
+ ! calculation of B_(1,n)^(1,nu) according to Eq.(13)
+ ! *** ******************************************************************
+ do pp=mm,tt
+ Bp1(ii,jj) = Bp1(ii,jj) + funb_n(jj,ii,pp,funca) * funcs(pp)
+ end do ! loop over pp (variable p)
+
+ ! scaling factors of eq.(13), factor (N_mon-1) from eq.(12)
+ Bp1(ii,jj) = Bp1(ii,jj) * (2._f*jj+1._f)/(jj*(jj*1._f+1._f))
+ Bp1(ii,jj) = Bp1(ii,jj) * (fx_vars%nb-1._f) * 2._f/(ii*(ii*1._f+1._f))
+ end do ! loop over jj=1,n1stop (variable nu)
+ end do ! loop over ii=1,n1stop (variable n)
+
+ ! *** ******************************************************************
+ ! End of Calculation of terms A and B
+
+ ! *** ******************************************************************
+ ! *** Setup and solution of matrix equation of order 2N ( = n2stop )
+ ! *** constituted by eq.(12)
+ ! *** ******************************************************************
+ ! *** matrix product (AB * C) (definitions see above)
+ do ii=1,n1stop
+ do jj=1,n1stop
+ EpABC(ii,jj) = an(ii) * Ap1(ii,jj)
+ EpABC(ii,jj+n1stop) = an(ii) * Bp1(ii,jj)
+ EpABC(ii+n1stop,jj) = bn(ii) * Bp1(ii,jj)
+ EpABC(ii+n1stop,jj+n1stop) = bn(ii) * Ap1(ii,jj)
+ end do
+ end do
+
+ ! *** ******************************************************************
+ ! *** add 2N*2N unity matrix
+ do ii=1,n1stop
+ EpABC(ii,ii) = EpABC(ii,ii) + onec
+ EpABC(ii+n1stop,ii+n1stop) = EpABC(ii+n1stop,ii+n1stop) + onec
+ end do
+
+ ! ======================================================================
+ ! *** solve matrix equation using external routines (LU decomposition)
+ CALL LUDCMPC(EpABC,n2stop,n2m,luindx,dlu)
+ CALL LUBKSBC(EpABC,n2stop,n2m,luindx,cvec)
+ do ii=1,n1stop
+ d1(ii) = cvec(ii)
+ d2(ii) = cvec(ii+n1stop)
+ end do
+
+ ! *** ******************************************************************
+ ! *** SECOND PART: Recomposition of the total wave scattered by
+ ! *** the entire agglomerate/cluster by adding the
+ ! *** waves scattered by each monomer taking into
+ ! *** account the respective phase of the single waves.
+ ! *** ******************************************************************
+
+ ! *** ******************************************************************
+ ! ----------------------------------------------------------------------
+ ! 1) Calculate the amplitude functions |S1^j(th)| et |S2^j(th)|
+ ! of one monomer of the agglomerate/cluster:
+ ! ( see e.g. Bohren, Huffman (1983) p.112, Eq.(4.74) with the
+ ! substitutions a_n -> d^1_1,n and b_n -> d^2_1,n
+ ! or Rannou (1999) Eq.(1)-(6) )
+ ! ----------------------------------------------------------------------
+ ! *** ******************************************************************
+
+ do iy=0,ntheta-1,1 ! loop over angles
+ angle=iy*180._f/(ntheta-1)
+ s1(iy)=0._f
+ s2(iy)=0._f
+ wom=cos(angle*3.1415926353_f/180._f)
+
+ do ir=1,n1stop ! loop over Mie - indices
+ xfact=2._f*(2._f*ir+1._f)/(ir*1._f*(ir*1._f+1._f))
+ ajt=d1(ir)*fpi(ir,wom,fx_vars)+d2(ir)*tau(ir,wom,fx_vars)
+ s1(iy)=s1(iy)+xfact*ajt
+ ajt=d1(ir)*tau(ir,wom,fx_vars)+d2(ir)*fpi(ir,wom,fx_vars)
+ s2(iy)=s2(iy)+xfact*ajt
+ end do
+
+ s11(iy)=abs(s1(iy))**2._f+abs(s2(iy))**2._f
+ pol(iy)=abs(s1(iy))**2._f-abs(s2(iy))**2._f
+ pol(iy)=pol(iy)/(abs(s1(iy))**2_f+abs(s2(iy))**2._f)
+ ! *** S_11(theta) = 1/2 * ( |S_1|^2 + |S_2|^2 )
+ ! *** above, s1(theta) = 2 * S_1(theta)
+ ! *** =>S_11(theta) = 1/2 * ( |1/2*s1|^2 + |1/2*s2|^2 )
+ ! = 1/8 * ( |s1|^2 + |s2|^2 )
+ s11_n(iy)=.125_f*(abs(s1(iy))**2._f+abs(s2(iy))**2._f)
+ end do
+
+ s01=s1(0)
+ s02=s2(0)
+
+ ! *** Extinction cross section sigext( d^1_1,n , d^2_1,n ) ***
+ sigext=0._f
+ do ir=1,n1stop ! loop (sum) over Mie-indices
+ sigext=sigext+(2._f*ir+1._f)*REAL(d1(ir)+d2(ir))
+ end do
+ sigext = fx_vars%nb * 2._f*pi/fx_vars%k**2._f * sigext ! Eq.(27)
+
+ ! *** Alternatively (in a test, all values agreed with rel.acc. 1e-6),
+ ! *** Extinction cross section sigext( S(0 deg) ) (optical theorem) ***
+ ! *** (see e.g. Bohren, Huffman (1983), Eq. (4.76))
+ ! *** S(0)=S_1(0)=S_2(0); sigma_ext = 4 pi / k^2 * Re(S(0))
+ ! *** above, s1(theta) = 2 * S_1(theta) (factor 2 in 'xfact')
+ ! sigext2 = nb * 4._f*pi/k**2._f * 0.5_f*REAL(s01)
+ ! sigext3 = nb * 4._f*pi/k**2._f * 0.5_f*REAL(s02)
+ ! *** ******************************************************************
+
+ ! *** ******************************************************************
+ ! ----------------------------------------------------------------------
+ ! 2) Calculate the phase integral in Eq.(26) with P(r) already
+ ! substituted ( compare Eq.(10) and (Botet 1995) ) :
+ ! INT(0;infinity)[ sin(2XuZ) u^(d-2) f_co(u) du ]
+ ! taking into account the different phases of the single
+ ! scattered waves.
+ ! ----------------------------------------------------------------------
+ ! *** ******************************************************************
+ do q=0,ntheta-1,1
+ angle=q*180._f/(ntheta-1)
+ if (angle .eq. 0._f) angle=0.001_f
+ if (angle .eq. 180._f) angle=179.999_f
+ fx_vars%zed=sin(angle*3.1415928353_f/180._f/2._f)
+
+ bound=0._f
+ interv=1
+ errrel=1e-5_f
+ p1=0._f
+ dp1=0._f
+
+ !======================================================================
+ !--- Version using the QUADPACK - routine :
+ !----------------------------------------------------------------------
+ ifail = 0
+ CALL dqagi(fp1,fx_vars,bound,interv,errabs,errrel,p1,dp1,neval,ifail,maxsub,lenw,nsubin,iwork,work)
+ if(ifail.ne.0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "fractal_meanfield_mod::ifail=",ifail," returned by dqagi()!"
+ rc = RC_ERROR
+ return
+ endif
+ !======================================================================
+
+ p1=2._f*pi * (fx_vars%nb-1._f) / (fx_vars%coeff*fx_vars%zed*krg)*p1 + 1._f
+ xint(q)=p1
+ end do
+
+ ! *** now, xint(theta) contains the square bracket terms in
+ ! *** Botet (1997) Eq.(26) or Rannou (1999) Eq.(1)
+
+ ! *** ******************************************************************
+ ! ----------------------------------------------------------------------
+ ! 3) Calculation of the phase function, calculation of the optical
+ ! properties (asymmetrie factor g, scatt. cross section sigma_s)
+ ! by angular integration: INT_0^180[ ... d_theta ]
+ ! ----------------------------------------------------------------------
+ ! *** ******************************************************************
+
+ total=0._f
+ totg=0._f
+
+ do q=1,ntheta-2,2
+ angle=(q-1)*180._f/(ntheta-1) ! angle in deg
+ a0=fx_vars%nb*xint(q-1)*s11(q-1)*sin(angle*3.1415926353_f/180._f)
+ c0=cos(angle*3.1415926353_f/180._f)
+
+ angle=q*180._f/(ntheta-1)
+ a1=fx_vars%nb*xint(q)*s11(q)*sin(angle*3.1415926353_f/180._f)
+ c1=cos(angle*3.1415926353_f/180._f)
+
+ angle=(q+1)*180._f/(ntheta-1)
+ a2=fx_vars%nb*xint(q+1)*s11(q+1)*sin(angle*3.1415926353_f/180._f)
+ c2=cos(angle*3.1415926353_f/180._f)
+
+ total=total+2._f/6._f*3.1415926353_f/(ntheta-1)*(a0+4._f*a1+a2)
+ totg=totg+2._f/6._f*3.1415926353_f/(ntheta-1)*(a0*c0+4._f*a1*c1+a2*c2)
+ end do
+ totg=totg/total
+
+ ! *** ******************************************************************
+ ! *** angular integration of I(theta) according to
+ ! *** Botet (1997) Eq.(26) or Rannou (1999) Eq.(1)
+ ! *** I(theta) = N 2pi/k^2 * S(theta) * [ phase integral ]
+ ! *** with
+ ! *** S(theta) = s11_n(i)
+ ! *** [ phase i. ] = xint(i)
+ ! *** Perfom integration using the following rule:
+ ! *** Integral_0^pi[ I(theta) sin(theta) d_theta ]
+ ! ***
+ ! *** = Sum_q=1^ntheta-1{ Integral_th_(i-1)^th_i [
+ ! ***
+ ! *** 1/2(I(th_(i-1))+I(th_i)) * sin(th) d_th ] }
+ ! ***
+ ! *** = sin(delta_theta/2) * Sum_q=1^ntheta-1{
+ ! ***
+ ! *** ( I(th_(i-1)) + I(th_i) ) * sin(th_middle) }
+ ! ***
+ ! *** ******************************************************************
+
+ !dthetad = 180._f / (ntheta-1) ! angular interval in deg
+ dthetar = pi / (ntheta-1) ! angular interval in rad
+ sumsca = 0._f
+ do q=1,ntheta-1,1
+ angler = (DBLE(q)-.5_f)*dthetar ! middle of interval in rad
+ weight = SIN(angler) ! integration weight
+ val = s11_n(q-1)*xint(q-1) + s11_n(q)*xint(q)
+ sumsca = sumsca + val*weight
+ end do
+
+ sumsca = sin(.5_f*dthetar) * sumsca ! interval width factor
+ ! *** Scattering cross section
+ sigsca = 2._f * pi / fx_vars%k**2._f * DBLE(fx_vars%nb) * sumsca
+ ! Warning! sigabs is well computed using this approximation
+ sigabs=fx_vars%nb*(sigmae-sigmas)
+ ! sigext=sigabs+sigsca is better than the mean-field value
+ ! previously defined. This is used hereafter. (P.Rannou)
+
+ ! *** Radius of equivalent mass sphere
+ rems = fx_vars%a * fx_vars%nb**(1._f/3._f)
+
+ ! *** reference area in definition of efficiencies is the geometrical
+ ! *** cross section of equivalent mass sphere
+ gems = pi * rems**2._f
+
+ ! *** Extinction and scattering efficiencies:
+ qsca = sigsca / gems
+ qabs = sigabs / gems
+ qext = qabs + qsca
+
+ gfac = totg
+
+ end subroutine fractal_meanfield
+
+ !!
+ !! Mie-scattering routine calling interface
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ subroutine cmie(lambda,xn,xk,rad,an,bn,nstop)
+
+ ! Arguments
+ real(kind=f), intent(in) :: lambda !! wavelength (microns)
+ real(kind=f), intent(in) :: xn !! real index of refraction
+ real(kind=f), intent(in) :: xk !! imaginary index of refraction
+ real(kind=f), intent(in) :: rad !! monomer radius (meters)
+ complex(kind=f), intent(out) :: an(50) !! Mie wave coefficient an
+ complex(kind=f), intent(out) :: bn(50) !! Mie wave coefficient bn
+ integer, intent(out) :: nstop !! index of last mie-coefficent
+
+ ! Local declarations
+ integer, parameter :: nang = 451 ! number of angles
+ complex(kind=f) :: refrel ! complex index of refraction
+ real(kind=f) :: theta(10000)
+ real(kind=f) :: x,dang
+
+ refrel=cmplx(xn,xk,kind=f)
+ x=2._f*3.14159265_f*rad/lambda ! size parameter of monomer
+ dang=1.570796327_f/real(nang-1,kind=f)
+
+ call intmie(x,refrel,nang,an,bn,nstop)
+
+ return
+ end subroutine cmie
+
+ !!
+ !! Mie scattering calculations
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ SUBROUTINE intmie(x,refrel,nang,an,bn,nstop)
+
+ ! Arguments
+ real(kind=f), intent(in) :: x !! size parameter of monomer
+ complex(kind=f), intent(in) :: refrel !! complex index of refraction
+ integer, intent(in) :: nang !! number of angles
+ complex(kind=f), intent(out) :: an(nf) !! Mie wave coefficient an
+ complex(kind=f), intent(out) :: bn(nf) !! Mie wave coefficient an
+ integer, intent(out) :: nstop !! index of last mie-coefficent
+
+ ! Local declarations
+ real(kind=f) :: amu(10000),pi(10000)
+ real(kind=f) :: pi0(10000),pi1(10000)
+ complex(kind=f) :: d(3000),y,xi,xi0,xi1
+ complex(kind=f) :: s1(2000),s2(2000)
+ real(kind=f) psi0,psi1,psi,dn,dx
+ integer :: nmx,nn,n,j
+ real(kind=f) :: rn, xstop, dang, ymod, chi0, chi1, apsi0, apsi1, fn, chi, apsi
+
+ dx=x
+ y=x*refrel
+
+ xstop=x+4._f*x**.3333_f+2._f
+ nstop=xstop
+ ymod=abs(y)
+ nmx=dmax1(xstop,ymod)+15
+ dang=1.570796327_f/real(nang-1,kind=f)
+
+ ! Initializations
+ pi0(:) = 0._f
+ pi1(:) = 0._f
+ s1(:) = cmplx(0._f,0._f,kind=f)
+ s2(:) = cmplx(0._f,0._f,kind=f)
+ amu(:) = 0.0_f
+ pi(:) = 0.0_f
+
+ d(:) = cmplx(0._f,0._f,kind=f)
+ nn=nmx-1
+
+ do n=1,nn
+ rn=nmx-n+1
+ d(nmx-n)=(rn/y)-(1._f/(d(nmx-n+1)+rn/y))
+ end do
+
+ do j=1,nang
+ pi0(j)=0._f ! Legendre functions
+ pi1(j)=1._f
+ end do
+
+ nn=2*nang-1
+
+ do j=1,nn
+ s1(j)=cmplx(0._f,0._f,kind=f)
+ s2(j)=cmplx(0._f,0._f,kind=f)
+ end do
+
+ psi0=cos(dx) ! Initialize Bessel functions
+ psi1=sin(dx)
+ chi0=-sin(x)
+ chi1=cos(x)
+
+ apsi0=psi0
+ apsi1=psi1
+
+ xi0=cmplx(apsi0,-chi0,kind=f)
+ xi1=cmplx(apsi1,-chi1,kind=f)
+
+ n=1
+
+ ! ************* iterate over index n *************
+200 dn=n
+ rn=n
+ fn=(2._f*rn+1._f)/(rn*(rn+1._f))
+
+ psi=(2._f*dn-1._f)*psi1/dx-psi0 ! calculate Bessel functions
+ chi=(2._f*rn-1._f)*chi1/x-chi0
+ apsi=psi
+ xi=cmplx(apsi,-chi,kind=f)
+
+ an(n)=(d(n)/refrel+rn/x)*apsi-apsi1
+ an(n)=an(n)/((d(n)/refrel+rn/x)*xi-xi1)
+ bn(n)=(refrel*d(n)+rn/x)*apsi-apsi1
+ bn(n)=bn(n)/((refrel*d(n)+rn/x)*xi-xi1)
+
+ psi0=psi1
+ psi1=psi
+ apsi1=psi1
+
+ chi0=chi1
+ chi1=chi
+ xi1=cmplx(apsi1,-chi1,kind=f)
+
+ n=n+1
+ rn=n
+
+ do 999 j=1,nang
+ pi1(j)=((2._f*rn-1._f)/(rn-1._f))*amu(j)*pi(j)
+ pi1(j)=pi1(j)-rn*pi0(j)/(rn-1._f)
+999 pi0(j)=pi(j)
+
+ if (n-1-nstop) 200,300,300
+300 continue
+
+ return
+ END SUBROUTINE intmie
+
+ !!
+ !!
+ !! CALLS: FUNCTION dqag/dqdag/DADAPT_() Integration
+ !! FUNCTION fpl() Integrand
+ !!
+ !! Integral in eq. 14, Botet et al. 1997
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ function funa(carma,fx_vars,nu,n,p,rc)
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! varaibles for functions being integrated
+ integer, intent(in) :: n !! indices
+ integer, intent(in) :: nu !! indices
+ integer, intent(in) :: p !! indices
+ integer, intent(inout) :: rc !! return code
+ real(kind=f) :: funa !!
+
+ ! Local declarations
+ integer, parameter :: maxsub=1000
+ real(kind=f) :: r,xa,xb,era,erl
+ integer :: interv
+ integer :: ifail
+ integer, parameter :: lenw=4000 ! .ge. 4*maxsub
+ integer :: iwork(maxsub),neval,nsubin ! nsubin=last
+ real(kind=f) :: work(lenw)
+ real(kind=f) :: bound, rres, rerr
+
+ ! Set return code assuming success.
+ rc = RC_OK
+
+ ! Initializations
+ funa=0._f
+ fx_vars%u1=n
+ fx_vars%u2=1
+ fx_vars%u3=nu
+ fx_vars%u4=1
+ fx_vars%u5=p
+ fx_vars%u6=0
+ xa=-1._f
+ xb=1._f
+ bound=0._f
+ interv=1
+ era=0._f
+ erl=1.e-4_f
+ rres=0._f
+ rerr=0._f
+
+ !======================================================================
+ !--- Version using the QUADPACK - routine :
+ !----------------------------------------------------------------------
+ ifail = 0
+
+ call dqag(fpl,fx_vars,xa,xb,era,erl,3,rres,rerr,neval,ifail,maxsub,lenw,nsubin,iwork,work)
+
+ if (ifail.ne.0) then
+ if (carma%f_do_print) then
+ write(carma%f_LUNOPRT, *) "funa::ifail=",ifail, &
+ " returned by dqag() during call of funa(",nu,",",n,",",p,")"
+ end if
+ rc = RC_ERROR
+ return
+ endif
+
+ rres=rres-2._f ! ceci est un artifice pour eviter que
+ ! la routine se plante quand la fonction
+ ! est paire (res=0.;err=1.d-3 impossible
+ ! a atteindre!! j'ai fpl'=fpl+1....d'ou
+ ! int(fpl)=int(fpl')-2. integr de -1 a 1!
+
+ r = (2._f*p+1._f)/2._f
+ funa = r * rres
+
+ return
+ END FUNCTION funa
+
+ !!
+ !! CALLS: FUNCTION plgndr() Legendre-Functions
+ !!
+ !! Used in funa. Integrand of eq. 14, Botet et al. 1997
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ FUNCTION fpl(x, fx_vars)
+
+ ! Arguments
+ real(kind=f),intent(in) :: x !!
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! varaibles for functions being integrated
+
+ ! Local declarations
+ real(kind=f) :: fpl
+ integer :: m,n,mu,nu,p,pmu
+ real(kind=f) :: c1,c2,c3
+
+ c1=plgndr(fx_vars%u1,fx_vars%u2,x,fx_vars)
+ c2=plgndr(fx_vars%u3,fx_vars%u4,x,fx_vars)
+ c3=plgndr(fx_vars%u5,fx_vars%u6,x,fx_vars)
+
+ fpl=c1*c2*c3+1._f !this is a trick!
+
+ return
+ END FUNCTION fpl
+
+ !!
+ !! Adapted from FUNCTION plgndr() in: Press, Teukolsky, Vetterling, Flannery
+ !! "Numerical Recipes in ???" (e.g. Num.Rec.in C, 2nd Ed., Cambridge Univ.Press, 1992, page 254)
+ !!
+ !! Calculate Legendre Polynomials, used in eq. 14 Botet et al. 1997
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ FUNCTION plgndr(l,m,x,fx_vars)
+
+ ! Arguments
+ integer, intent(in) :: l !! indices
+ integer, intent(in) :: m !! indices
+ real(kind=f), intent(in) :: x !! return result
+ type(adgaquad_vars_type), intent(in) :: fx_vars !! variables for functions being integrated
+
+ ! Local declarations
+ real(kind=f) :: plgndr
+ integer ::lbl
+ real(kind=f) :: pll, pmm, somx2, pmmp1
+ integer :: i, ll
+ real(kind=f) :: fact1
+ integer :: mstar
+
+ mstar=m
+
+ lbl=0
+ plgndr=0._f
+
+ if (mstar.lt.0)then
+ mstar=-m
+ lbl=1
+ endif
+
+ if (mstar.gt.l) then
+ pll=0._f
+ plgndr=0._f
+ return ! si m>l, Pl,m=0 !
+ endif
+
+ pmm=1._f
+
+ if(mstar.gt.0) then
+ somx2=sqrt((1._f-x)*(1._f+x))
+ fact1=1._f
+ do i=1,mstar
+ pmm=+pmm*fact1*somx2 !cghmt - en + !!
+ fact1=fact1+2._f
+ end do
+ endif
+
+ if(l.eq.mstar) then
+ plgndr=pmm
+ else
+ pmmp1=x*(2*mstar+1)*pmm
+
+ if(l.eq.mstar+1) then
+ plgndr=pmmp1
+ else
+ do ll=mstar+2,l
+ pll=(x*(2*ll-1)*pmmp1-(ll+mstar-1)*pmm)/(ll-mstar)
+ pmm=pmmp1
+ pmmp1=pll
+ end do
+ plgndr=pll
+ endif
+ endif
+
+ if (lbl.eq.1) then
+ plgndr=(-1)**mstar*(fx_vars%fact(l-mstar)/fx_vars%fact(l+mstar))*plgndr
+ mstar=-m !restitution du parametre m!!!!!
+ endif
+
+ return
+ END FUNCTION plgndr
+
+ !!
+ !! replaces funb(nu,n,p) in original code,
+ !! saving n*n re-calculations of funa(nu,n,p).
+ !!
+ !! Calculates eq. 15, Botet et al. 1997
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ FUNCTION funb_n(nu,n,p,funca)
+
+ ! Arguments
+ integer, intent(in) :: nu !! indices
+ integer, intent(in) :: n !! indices
+ integer, intent(in) :: p !! indices
+ real(kind=f), intent(in) :: funca(nmi,nmi,0:n2m) !! return result
+
+ ! Local Declarations
+ real(kind=f) :: funb_n
+ integer :: i, l, j
+ real(kind=f) :: var
+
+ funb_n = 0._f
+ i = int((p*1._f-1._f-abs(n*1._f-nu*1._f))*1._f/2._f)
+ !print*,nu,n,p,i
+
+ do l=0,i
+ j = p-2*l-1
+
+ ! omit j = -1 (when nu=n and p=l=i=0)
+ IF (j .GE. 0) THEN
+
+ var = funca(nu,n,j) ! in main, a(nu,n,p) was stored in
+ ! funca(nu,n;p)
+ funb_n = funb_n + var
+ ENDIF
+
+ end do
+ funb_n = (2._f*p+1._f) * funb_n
+ return
+ END FUNCTION funb_n
+
+ !! Replaces funs(pp,k) in original code
+ !!
+ !! CALLS:
+ !! FUNCTION dqagi/dq2agi/DADAPT_() Integration
+ !! FUNCTION xfreal_n() Integrand
+ !! FUNCTION xfimag_n() Integrand
+ !!
+ !! Calculates eq. 16 , Botet et al. 1997
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version Mar 2013
+ function funs_n(carma,fx_vars,pp,rc)
+
+ ! Arguments
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! varaibles for functions being integrated
+ integer, intent(in) :: pp !! indices
+ integer, intent(inout) :: rc !! return code
+
+ ! Local Declarations
+ integer, parameter :: maxsub=50000
+ complex(kind=f) :: rcomplex,funs_n
+ real(kind=f) :: rres,ires,rerr,ierr,afun
+ real(kind=f) :: xa,xb
+ integer :: ifail
+ integer, parameter :: lenw=200000 ! .ge. 4*maxsub
+ integer :: iwork(maxsub),neval,nsubin ! nsubin=last
+ real(kind=f) :: work(lenw)
+ real(kind=f) :: rg, bound, errabs, errrel
+ integer :: interv
+
+ rc = RC_OK
+
+ rg=fx_vars%alpha*fx_vars%nb**(1._f/fx_vars%df)*fx_vars%a
+
+ afun=(2._f*3.1415926_f)/(fx_vars%k**3._f)
+
+
+ fx_vars%pbes=pp
+ fx_vars%kbes=fx_vars%k
+
+ bound=0._f
+ interv=1
+
+ errabs=0._f
+ errrel=1.e-3_f
+
+ rres=0._f
+ !trres=0._f
+ rerr=0._f
+ !trerr=0._f
+ xa=0._f
+ xb=5._f*fx_vars%k*rg
+
+ !======================================================================
+ !--- Version using the QUADPACK - routine :
+ !----------------------------------------------------------------------
+ ifail = 0
+ CALL dqagi(xfreal_n,fx_vars,bound,interv,errabs,errrel,rres,rerr,neval,ifail,maxsub,lenw,nsubin,iwork,work)
+ if (ifail.ne.0) then
+ if (carma%f_do_print) then
+ write(carma%f_LUNOPRT, *) "funs_n::ifail=",ifail, &
+ " returned by dqag() during call of funs(",pp, &
+ ") while integrating xfreal_n()"
+ end if
+ rc = RC_ERROR
+ return
+ endif
+
+ bound=0._f
+ interv=1
+
+ ires=0._f
+ ierr=0._f
+ xa=0._f
+ xb=5._f*fx_vars%k*rg
+
+ !======================================================================
+ !--- Version using the QUADPACK - routine :
+ !----------------------------------------------------------------------
+ ifail = 0
+ CALL dqagi(xfimag_n,fx_vars,bound,interv,errabs,errrel,ires,ierr,neval,ifail,maxsub,lenw,nsubin,iwork,work)
+ if(ifail.ne.0) then
+ if (carma%f_do_print) then
+ write(carma%f_LUNOPRT, *) "funs_n::ifail=",ifail, &
+ " returned by dqagi() during call of funs(",pp, &
+ ") while integrating xfimag_n()"
+ end if
+ rc = RC_ERROR
+ return
+ endif
+
+ rcomplex = cmplx(1._f,0._f,kind=f)*rres + cmplx(0._f,1._f,kind=f)*ires
+
+ funs_n = afun * rcomplex
+
+ continue
+ return
+ END FUNCTION funs_n
+
+ !!
+ !! replaces xfreel(xx) in original code
+ !! CALLS: FUNCTION BESSELJY() Spherical Bessel functions
+ !! FUNCTION phi() Probability distrib.
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version Mar 2013
+ FUNCTION xfreal_n(xx, fx_vars)
+
+ ! Arguments
+ real(kind=f), intent(in) :: xx
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! varaibles for functions being integrated
+
+ ! Local Declarations
+ complex(kind=f) :: z,xj(0:nf),xjp(0:nf),xy(0:nf),xyp(0:nf)
+ complex(kind=f) :: jsol,ysol,hsol,hpsol
+ real(kind=f) :: x,r,xfreal_n
+ integer :: ifail,p,pc
+ real(kind=f) :: rg
+
+ ifail = 0
+ rg = fx_vars%alpha*fx_vars%nb**(1._f/fx_vars%df)*fx_vars%a
+ x = xx
+ if (x.GT.3000._f) x=3000._f
+ z = x*cmplx(1._f,0._f,kind=f)
+
+ pc = fx_vars%pbes
+ if( fx_vars%pbes .eq. 0 ) pc = fx_vars%pbes + 1
+
+ CALL BESSELJY(z,pc,xj,xjp,xy,xyp,ifail)
+
+ r=x/fx_vars%kbes
+
+ xfreal_n = real( z*z*xj(fx_vars%pbes)*xj(fx_vars%pbes) * phi(r,fx_vars) )
+
+ return
+ END FUNCTION xfreal_n
+
+ !!
+ !! replaces xfima(xx) in original code
+ !! CALLS: FUNCTION BESSELJY() Spherical Bessel functions
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version Mar 2013
+ FUNCTION xfimag_n(xx, fx_vars)
+
+ ! Arguments
+ real(kind=f), intent(in) :: xx
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! variables for functions being integrated
+
+ ! Local Declarations
+ complex(kind=f) :: z,xj(0:nf),xjp(0:nf),xy(0:nf),xyp(0:nf)
+ real(kind=f) :: x,r,xfimag_n
+ integer :: ifail,p,pc
+ real(kind=f) :: rg
+
+ rg = fx_vars%alpha*fx_vars%nb**(1._f/fx_vars%df)*fx_vars%a
+ x = xx
+ if (x.gt.3000._f) x=3000._f
+ ifail = 0
+ z = x*cmplx(1._f,0._f,kind=f)
+
+ pc = fx_vars%pbes
+ if( fx_vars%pbes .eq. 0 ) pc = fx_vars%pbes + 1
+
+ CALL BESSELJY(z,pc,xj,xjp,xy,xyp,ifail)
+
+ r=x/fx_vars%kbes
+
+ xfimag_n = real( z*z*xj(fx_vars%pbes)*xy(fx_vars%pbes) * phi(r,fx_vars) )
+
+ return
+ END FUNCTION xfimag_n
+
+
+ !! Spherical Bessel functions j_n(z) and y_n(z) of complex
+ !! argument to desired accuracy,
+ !! and their derivatives, up to a maximal order n=LMAX.
+ !! j_n(z) = SQRT(pi/2 / z) * J_(n + 1/2)(z)
+ !! y_n(z) = SQRT(pi/2 / z) * Y_(n + 1/2)(z)
+ !! Adapted from:
+ !! I.J.Thompson, A.R.Barnett
+ !! "Modified Bessel Funkctions I_v(z) and K_v(z)
+ !! of Real Order and Complex Argument, to Selected
+ !! Accuracy"
+ !! COMP.PHYS.COMMUN. 47 (1987) 245-57
+ !! (Source code printed on page 249)
+ !! ******************************************************************
+ !! INPUTS:
+ !! X argument z, dble cmplx
+ !! z in the upper half plane, Im(z) > -3
+ !! LMAX largest desired order of Bessel functions, int
+ !! j_n,y_n,j_n',y_n' are calculated for n=0 to n=LMAX
+ !! Dimension of arrays xj,xjp,xy,xyp at least (0:LMAX)
+ !! XJ(M) Spher. Bessel function j_m(z), dble cmplx
+ !! XJP(M) Derivative of Spher. Bessel function d/dz [ j_m(z) ],
+ !! dble cmplx
+ !! XY(M) Spher. Bessel function y_m(z), dble cmplx
+ !! XYP(M) Derivative of Spher. Bessel function d/dz [ y_m(z) ],
+ !! dble cmplx
+ !! IFAIL error flag, int
+ !! = 0 if all results are satisfactory
+ !! = -1 for arguments out of range
+ !! = > 0 for results ok up to and including the
+ !! function of order LMAX-IFAIL
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version Mar 2013
+ SUBROUTINE BESSELJY (X, LMAX, XJ, XJP, XY, XYP, IFAIL)
+
+ ! Arguments
+ complex(kind=f), intent(in) :: X
+ integer, intent(in) :: LMAX
+ complex(kind=f), intent(out) :: XJ(0:LMAX)
+ complex(kind=f), intent(out) :: XJP(0:LMAX)
+ complex(kind=f), intent(out) :: XY(0:LMAX)
+ complex(kind=f), intent(out) :: XYP(0:LMAX)
+ integer, intent(out) :: IFAIL
+
+ ! Local Declarations
+ INTEGER, PARAMETER :: LIMIT = 20000
+ REAL(kind=f),parameter :: ZERO = 0._f
+ REAL(kind=f),parameter :: ONE = 1._f
+ REAL(kind=f),parameter :: ACCUR = 1e-12_f
+ REAL(kind=f),parameter :: TM30 = 1e-30_f
+ COMPLEX(kind=f), parameter :: CI = (0._f, 1._f)
+ complex(kind=f) :: XI, W, PL, B, D, FF, DEL, C, XJ0, XH1, XH1P, XTEMP
+ integer :: L
+
+ IF (ABS(X).LT.ACCUR .OR. AIMAG(X) .LT. -3.d0) THEN
+ IFAIL=-1
+ GOTO 5
+ END IF
+
+ ! *** Lentz - Algorithmus (?) :
+ XI = ONE/X
+ W = XI + XI
+ PL = LMAX * XI
+ FF = PL + XI
+ B = FF + FF + XI
+ D = ZERO
+ C = FF
+ DO 1 L=1,LIMIT
+ D = B - D
+ C = B - ONE/C
+ IF(ABS(D).LT. TM30) D = TM30
+ IF(ABS(C).LT. TM30) C = TM30
+ D = ONE / D
+ DEL = D * C
+ FF = FF * DEL
+ B = B + W
+1 IF(ABS(DEL-ONE).LT.ACCUR) GOTO 2
+ IFAIL = -2
+ GOTO 5
+
+2 XJ(LMAX) = TM30
+ XJP(LMAX) = FF * XJ(LMAX)
+
+ ! *** Abwaertsrekursion
+ DO 3 L = LMAX-1,0,-1
+ XJ(L) = PL * XJ(L+1) + XJP(L+1)
+ XJP(L) = PL * XJ(L) - XJ(L+1)
+3 PL = PL - XI
+
+ ! *** Calculate the l=0 Besselfunktionen
+ XJ0 = XI * SIN(X)
+ XY(0) = - XI * COS(X)
+ XH1 = EXP(CI * X) * XI * (-CI)
+ XH1P = XH1 * (CI - XI)
+ B = XH1P
+
+ ! *** Rescale XJ, XJP, converting to spherical Bessels
+ ! *** Recur XH1,XH1P as sperical Bessels
+ W = ONE / XJ(0)
+ PL = XI
+ DO 4 L = 0,LMAX
+ XJ(L) = XJ0 * (W*XJ(L))
+ XJP(L) = XJ0 * (W*XJP(L)) - XI * XJ(L)
+ IF (L.EQ.0) GOTO 4
+ XTEMP = XH1
+ XH1 = (PL-XI) * XTEMP - XH1P
+ PL = PL + XI
+ XH1P = - PL * XH1 + XTEMP
+ XY(L) = CI * (XJ(L) - XH1) ! y_n = i * ( j_n - h^1_n )
+ XYP(L) = CI * (XJP(L) - XH1P) ! und dito fuer Ableitungen
+4 CONTINUE
+ XYP(0) = CI * (XJP(0) - B)
+ RETURN
+
+5 WRITE(*,10) IFAIL
+10 FORMAT( 'ERROR in SUBR BESSELJY() : IFAIL = ', I4)
+ RETURN
+ END SUBROUTINE BESSELJY
+
+ !!
+ !! Angular function pi_l( x=cos(theta) )
+ !! e.g. Bohren,Huffman (1983)
+ !! pp.94 ff Eq.(4.46)-(4.49)
+ !! p.112
+ !! CALLS: FUNCTION plgndr() Legendre-Functions
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version Mar 2013
+ FUNCTION fpi(l,x,fx_vars)
+
+ ! Arguments
+ integer, intent(in) :: l
+ real(kind=f), intent(in) :: x
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! varaibles for functions being integrated
+
+ ! Local declarations
+ real(kind=f) :: fpi
+ real(kind=f) :: y
+ real(kind=f) :: flag
+
+ y=x
+ if (x.eq.1._f) y=1._f-1.e-6_f
+ ! alternatively, one could use Bohren,Huffman
+ ! p.112: pi_n(1)=tau_n(1)= 1/2 * n * (n+1) !!!
+ flag=plgndr(l,1,y,fx_vars)
+ fpi=(1._f-y**2._f)**(-0.5_f)*flag
+ return
+ END FUNCTION fpi
+
+ !!
+ !! Angular function tau_l( x=cos(theta) )
+ !! e.g. Bohren,Huffman (1983)
+ !! pp.94 ff Eq.(4.46)-(4.49)
+ !! p.112
+ !! CALLS: FUNCTION plgndr() Legendre-Functions
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ FUNCTION tau(l,x,fx_vars)
+
+ ! Arguments
+ integer, intent(in) :: l
+ real(kind=f), intent(in) :: x
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! varaibles for functions being integrated
+
+ ! Local Declarations
+ real(kind=f) :: fp
+ real(kind=f) :: tau
+ real(kind=f) :: flag
+ real(kind=f) :: y
+
+ y=x
+ if (x.eq.1._f) y=1._f-1.e-6_f
+ ! alternatively, one could use Bohren,Huffman
+ ! p.112: pi_n(1)=tau_n(1)= 1/2 * n * (n+1) !!!
+ flag=plgndr(l,0,y,fx_vars)
+ fp=fpi(l,y,fx_vars)
+ tau=-y*fp+l*(l*1._f+1._f)*flag
+ return
+ END FUNCTION tau
+
+ !!
+ !!
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ function fp1(u, fx_vars)
+
+ ! Arguments
+ real(kind=f), intent(in) :: u !!
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! varaibles for functions being integrated
+ real(kind=f) :: fp1 !! returns
+
+ ! Local Declarations
+ real(kind=f) :: krg,s1,s2,s3,rg
+
+ rg=fx_vars%alpha*fx_vars%a*fx_vars%nb**(1._f/fx_vars%df)
+ krg=fx_vars%k*rg
+ s1=sin(2._f*krg*fx_vars%zed*u)
+ s2=u**(fx_vars%df-2._f)
+ s3=fco(u, fx_vars)
+ fp1=s1*s2*s3
+
+ return
+ END FUNCTION fp1
+
+ !!
+ !! CALLS: FUNCTION dqagi/dqdagi/DADAPT_() Integration
+ !! FUNCTION fdval() Integrand
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ FUNCTION anorm(carma, fx_vars, rc)
+
+ ! arguments
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! varaibles for functions being integrated
+ integer, intent(inout) :: rc !! return code
+
+ ! Local Declarations
+ real(kind=f) :: anorm
+ integer :: interv
+ integer, parameter :: maxsub=50000
+ integer :: ifail
+ integer, parameter :: lenw=200000 ! .ge. 4*maxsub
+ integer :: iwork(maxsub),neval,nsubin ! nsubin=last
+ real(kind=f) :: work(lenw)
+ real(kind=f) :: bound,errrel,errabs,b,db,c
+
+ rc = RC_OK
+
+ bound=0._f
+ interv=1
+ errrel=1.e-3_f
+ errabs=0._f
+ b=0._f
+ db=0._f
+
+ !======================================================================
+ !--- Version using the QUADPACK - routine :
+ !----------------------------------------------------------------------
+ ifail = 0
+ CALL dqagi(fdval,fx_vars,bound,interv,errabs,errrel,b,db,neval,ifail,maxsub,lenw,nsubin,iwork,work)
+ if(ifail.ne.0) then
+ if (carma%f_do_print) write(carma%f_LUNOPRT, *) "anorm::ifail=",ifail," returned by dqagi() during call of anorm"
+ rc = RC_ERROR
+ return
+ endif
+
+ c=0.5_f
+ anorm=b*4._f*3.1415926_f
+ return
+ END FUNCTION anorm
+
+ !!
+ !! Probability distribution of monomer location within cluster
+ !! CALLS: FUNCTION fdval()
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ FUNCTION phi(x,fx_vars)
+
+ ! Arguments
+ real(kind=f), intent(in) :: x
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! varaibles for functions being integrated
+
+ ! Local Declarations
+ real(kind=f) :: fval,pref,phi, rg, z
+
+ rg=fx_vars%alpha*fx_vars%nb**(1._f/fx_vars%df)*fx_vars%a
+ z=x/rg
+ pref=(x/rg)**(fx_vars%df-3._f)/(fx_vars%coeff*rg**3._f)
+ fval=z**(1._f-fx_vars%df)*fdval(z, fx_vars)
+ phi=pref*fval
+ continue
+ return
+ END FUNCTION phi
+
+ !!
+ !! Probability distribution of monomer location within cluster
+ !! CALLS: FUNCTION fdval()
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ FUNCTION fco(z, fx_vars)
+
+ ! Arguments
+ real(kind=f), intent(in) :: z
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! varaibles for functions being integrated
+
+ ! Local Declarations
+ real(kind=f) :: fco
+ real(kind=f) :: fval
+
+ fval=z**(1._f-fx_vars%df)*fdval(z, fx_vars)
+ fco=fval
+ continue
+ return
+ END FUNCTION fco
+
+ !!
+ !! @author P. Rannou, R. Botet, Eric Wolf
+ !! @version March 2013
+ FUNCTION fdval(x, fx_vars)
+
+ type(adgaquad_vars_type), intent(inout) :: fx_vars !! varaibles for functions being integrated
+
+ ! Arguments
+ real(kind=f), intent(in) :: x
+
+ ! Local Declarations
+ real(kind=f) :: fdval
+
+ fdval=x**(fx_vars%df-1._f)*exp(-x**fx_vars%df/2._f)
+ return
+ END FUNCTION fdval
+
+end module
+
+
diff --git a/src/physics/carma/base/freezaerl_koop2000.F90 b/src/physics/carma/base/freezaerl_koop2000.F90
new file mode 100644
index 0000000000..c26ac320c6
--- /dev/null
+++ b/src/physics/carma/base/freezaerl_koop2000.F90
@@ -0,0 +1,209 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluates particle loss rates due to nucleation :
+!! aerosol freezing only.
+!!
+!! The parameterization described by Koop et al., Nature 406, 611-614, 2000
+!! is used.
+!!
+!! The loss rates for all particle elements in a particle group are equal.
+!!
+!! To avoid nucleation into an evaporating bin, this subroutine must
+!! be called after growp, which evaluates evaporation loss rates .
+!!
+!! @author Eric Jensen, Chuck Bardeen
+!! @version Dec-2003, Apr-2010
+subroutine freezaerl_koop2000(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ real(kind=f), parameter :: prenuc = 2.075e33_f * RHO_W / RHO_I
+ real(kind=f), parameter :: kt0 = 1.6e0_f
+ real(kind=f), parameter :: dkt0dp = -8.8e0_f
+ real(kind=f), parameter :: kti = 0.22e0_f
+ real(kind=f), parameter :: dktidp = -0.17e0_f
+
+ logical :: evapfrom_nucto
+ integer :: igas ! gas index
+ integer :: igroup ! group index
+ integer :: ibin ! bin index
+ integer :: iepart ! element for condensing group index
+ integer :: inuc ! nucleating element index
+ integer :: isol ! solute index of freezing particle
+ integer :: ienucto ! index of target nucleation element
+ integer :: ignucto ! index of target nucleation group
+ integer :: inucto ! index of target nucleation bin
+ real(kind=f) :: sifreeze
+ real(kind=f) :: aw
+ real(kind=f) :: CONTL
+ real(kind=f) :: CONTH
+ real(kind=f) :: H2SO4m
+ real(kind=f) :: WT
+ real(kind=f) :: volrat
+ real(kind=f) :: ssi
+ real(kind=f) :: ssl
+ real(kind=f) :: rjj
+ real(kind=f) :: rlogj
+ real(kind=f) :: daw
+ real(kind=f) :: riv
+ real(kind=f) :: vw0
+ real(kind=f) :: awi
+ real(kind=f) :: rsi
+ real(kind=f) :: dmy
+ real(kind=f) :: rlnt
+ real(kind=f) :: td
+ real(kind=f) :: pp
+ real(kind=f) :: pp2
+ real(kind=f) :: pp3
+ real(kind=f) :: vi
+ real(kind=f) :: fkelv
+ real(kind=f) :: fkelvi
+
+
+ rc = RC_OK
+
+ ! Aerosol freezing limited to T < 240K
+ if (t(iz) <= 240._f) then
+
+ ! Loop over particle groups.
+ do igroup = 1,NGROUP
+
+ igas = inucgas(igroup)
+ iepart = ienconc(igroup)
+ isol = isolelem(iepart)
+
+ if (igas .ne. 0) then
+
+ ! Bypass calculation if few particles are present
+ if (pconmax(iz,igroup) .gt. FEW_PC) then
+
+ ! Calculate nucleation loss rates. Do not allow nucleation into
+ ! an evaporating bin.
+ do inuc = 1, nnuc2elem(iepart)
+
+ ienucto = inuc2elem(inuc,iepart)
+ if (ienucto /= 0) then
+ ignucto = igelem( ienucto )
+
+ ! Only compute nucleation rate for aerosol freezing
+ !
+ ! NOTE: If heterogeneous nucleation of glassy aerosols is being used
+ ! as a nucleation mechanism, then both the heterogeneous nucleation and
+ ! the homogeneous freezing need to be considered.
+ if ((iand(inucproc(iepart,ienucto), I_AF_KOOP_2000) /= 0)) then
+
+ ! Loop over particle bins.
+ do ibin = 1, NBIN
+
+ ssi = supsati(iz,igas)
+ ssl = supsatl(iz,igas)
+
+ ! Calculate approximate critical saturation needed for homogeneous freezing
+ ! of sulfate aerosols (see Jensen and Toon, GRL, 1994).
+ sifreeze = 0.3_f
+
+ ! Homogeneous freezing of sulfate aerosols should only occur if SL < Scrit
+ ! and SI > .
+ if (ssi > sifreeze) then
+
+ ! Koop et al. nucleation rate parameterization
+ td = t(iz)
+ rlnt = log(td)
+ ! eqn 2, potential difference [J mol-1]
+ dmy = 210368._f + 131.438_f * td - (3.32373e6_f / td) - 41729.1_f * rlnt
+ rsi = RGAS / 1.e7_f ! gas constant [J mol-1 K-1]
+ ! Notes (p: ambient vs. at pressure) ?
+ awi = exp(dmy / (rsi * td))
+
+ ! eqn 4
+ vw0 = -230.76_f - 0.1478_f * td + (4099.2_f / td) + 48.8341_f * rlnt
+ ! eqn 5
+ vi = 19.43_f - 2.2e-3_f * td + 1.08e-5_f * td * td
+
+ pp = 1.e-10_f * p(iz) ! pressure [GPa]
+ pp2 = pp * pp * 0.5_f
+ pp3 = pp2 * pp / 3._f
+ riv = vw0 * (pp - kt0 * pp2 - dkt0dp * pp3) - vi * (pp - kti * pp2 - dktidp * pp3) ! eqn 3
+
+ riv = riv * 1.e3_f ! [GPa cm3 mol-1] to [Pa m3 mol-1]
+
+ ! NOTE: The wieght percent can become negative from this parameterization,
+ ! which is not physicsal. With small supersaturations, the water activity
+ ! becomes postive (>1.013) the weight percent becomes negative. Don't allow
+ ! the the supsatl to be greater than 0.
+ ssl = max(-1.0_f, min(0._f, ssl))
+
+ ! Water activity
+ aw = 1._f + ssl ! ?
+
+ ! Kelvin effect on water activity
+ fkelv = exp(akelvin(iz,igas) / r(ibin,igroup)) ! ?
+ aw = aw / fkelv
+
+ ! Nucleation rate
+ !
+ ! NOTE: This formulation is only valid for daw in the range of
+ ! 0.26 < daw < 0.34, so limit daw to that range.
+ daw = aw * exp(riv / (rsi*td)) - awi ! eqn 6
+ daw = min(0.34_f, max(daw, 0.26_f)) ! eqn 7
+
+ rlogj = ((29180._f * daw - 26924._f) * daw + 8502._f) * daw - 906.7_f ! eqn 7
+ rlogj = min(rlogj, POWMAX*0.3_f)
+ rjj = 10._f**(rlogj) ! [cm-3 s-1]
+
+
+ ! Calculate volume ratio of wet/dry aerosols
+ if (aw < 0.05_f) then
+ CONTL = 12.37208932_f * (aw**(-0.16125516114_f)) - 30.490657554_f * aw - 2.1133114241_f
+ CONTH = 13.455394705_f * (aw**(-0.1921312255_f)) - 34.285174604_f * aw - 1.7620073078_f
+ elseif (aw <= 0.85) then
+ CONTL = 11.820654354_f * (aw**(-0.20786404244_f)) - 4.807306373_f * aw - 5.1727540348_f
+ CONTH = 12.891938068_f * (aw**(-0.23233847708_f)) - 6.4261237757_f * aw - 4.9005471319_f
+ else
+ CONTL = -180.06541028_f * (aw**(-0.38601102592_f)) - 93.317846778_f * aw + 273.88132245_f
+ CONTH = -176.95814097_f * (aw**(-0.36257048154_f)) - 90.469744201_f * aw + 267.45509988_f
+ endif
+
+ H2SO4m = CONTL + ((CONTH - CONTL) * (t(iz) - 190._f) / 70._f)
+ WT = (98.0_f * H2SO4m) / (1000._f + 98._f * H2SO4m)
+ WT = max(0._f, min(1._f, WT))
+ WT = 100._f * WT
+
+ ! Volume ratio of wet/dry aerosols.
+ if (WT <= 0._f) then
+ volrat = 1.e10_f
+ else
+ volrat = rhosol(isol) / RHO_W * ((100._f - WT) / WT) + 1._f
+ endif
+
+ ! [s-1]
+ rnuclg(ibin,igroup,ignucto) = rnuclg(ibin,igroup,ignucto) + rjj * volrat * vol(ibin,igroup)
+ endif ! ssi > sifreeze .and. target droplets not evaporating
+ enddo ! ibin = 1,NBIN
+ endif ! inucproc(iepart,ienucto) .eq. I_DROPACT
+ endif
+ enddo ! inuc = 1,nnuc2elem(iepart)
+ endif ! pconmax .gt. FEW_PC
+ endif ! (igas = inucgas(igroup) .ne. 0)
+ enddo ! igroup = 1,NGROUP
+ endif
+
+ ! Return to caller with particle loss rates due to nucleation evaluated.
+ return
+end subroutine
diff --git a/src/physics/carma/base/freezaerl_mohler2010.F90 b/src/physics/carma/base/freezaerl_mohler2010.F90
new file mode 100644
index 0000000000..a21604da77
--- /dev/null
+++ b/src/physics/carma/base/freezaerl_mohler2010.F90
@@ -0,0 +1,183 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluates particle loss rates due to nucleation :
+!! aerosol freezing only.
+!!
+!! The parameterization described by Mohler et al., presented at the AMS
+!! Cloud physics workshop (2010) is used.
+!!
+!! The loss rates for all particle elements in a particle group are equal.
+!!
+!! To avoid nucleation into an evaporating bin, this subroutine must
+!! be called after growp, which evaluates evaporation loss rates .
+!!
+!! @author Chuck Bardeen
+!! @version Aug-2010
+subroutine freezaerl_mohler2010(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ real(kind=f), parameter :: prenuc = 2.075e33_f * RHO_W / RHO_I
+ real(kind=f), parameter :: kt0 = 1.6e0_f
+ real(kind=f), parameter :: dkt0dp = -8.8e0_f
+ real(kind=f), parameter :: kti = 0.22e0_f
+ real(kind=f), parameter :: dktidp = -0.17e0_f
+
+ logical :: evapfrom_nucto
+ integer :: igas ! gas index
+ integer :: igroup ! group index
+ integer :: ibin ! bin index
+ integer :: iepart ! element for condensing group index
+ integer :: inuc ! nucleating element index
+ integer :: isol ! solute index of freezing particle
+ integer :: ienucto ! index of target nucleation element
+ integer :: ignucto ! index of target nucleation group
+ integer :: inucto ! index of target nucleation bin
+ real(kind=f) :: sifreeze
+ real(kind=f) :: aw
+ real(kind=f) :: CONTL
+ real(kind=f) :: CONTH
+ real(kind=f) :: H2SO4m
+ real(kind=f) :: WT
+ real(kind=f) :: volrat
+ real(kind=f) :: ssi
+ real(kind=f) :: ssl
+ real(kind=f) :: rjj
+ real(kind=f) :: rlogj
+ real(kind=f) :: daw
+ real(kind=f) :: riv
+ real(kind=f) :: vw0
+ real(kind=f) :: awi
+ real(kind=f) :: rsi
+ real(kind=f) :: dmy
+ real(kind=f) :: rlnt
+ real(kind=f) :: td
+ real(kind=f) :: pp
+ real(kind=f) :: pp2
+ real(kind=f) :: pp3
+ real(kind=f) :: vi
+ real(kind=f) :: fkelv
+ real(kind=f) :: fkelvi
+
+
+ rc = RC_OK
+
+ ! Aerosol freezing limited to T < 240K
+ if (t(iz) <= 240._f) then
+
+ ! Loop over particle groups.
+ do igroup = 1,NGROUP
+
+ igas = inucgas(igroup)
+ iepart = ienconc(igroup)
+ isol = isolelem(iepart)
+
+ if (igas .ne. 0) then
+
+ ! Bypass calculation if few particles are present
+ if (pconmax(iz,igroup) .gt. FEW_PC) then
+
+ ! Calculate nucleation loss rates. Do not allow nucleation into
+ ! an evaporating bin.
+ do inuc = 1, nnuc2elem(iepart)
+
+ ienucto = inuc2elem(inuc,iepart)
+ if (ienucto /= 0) then
+ ignucto = igelem( ienucto )
+
+ ! Only compute nucleation rate for aerosol freezing
+ !
+ ! NOTE: If heterogeneous nucleation of glassy aerosols is being used
+ ! as a nucleation mechanism, then both the heterogeneous nucleation and
+ ! the homogeneous freezing need to be considered.
+ if (iand(inucproc(iepart,ienucto), I_AF_MOHLER_2010) /= 0) then
+
+ ! Loop over particle bins.
+ do ibin = 1, NBIN
+
+ ssi = supsati(iz,igas)
+ ssl = supsatl(iz,igas)
+
+ ! Adjust ssi for the Kelvin effect.
+ fkelvi = exp(akelvini(iz,igas) / r(ibin,igroup))
+ ssi = ssi / fkelvi
+
+ ! Calculate approximate critical saturation needed for homogeneous freezing
+ ! of sulfate aerosols (see Jensen and Toon, GRL, 1994).
+ sifreeze = 0.3_f
+
+ ! Homogeneous freezing of sulfate aerosols should only occur if SL < Scrit
+ ! and SI > .
+ if (ssi > sifreeze) then
+
+ ! Mohler et al. 2010? nucleation rate parameterization
+ rlogj = 97.973292_f - 154.67476_f * (ssi + 1._f) - 0.84952712_f * t(iz) + 1.0049467_f * (ssi + 1._f) * t(iz)
+ rjj = 10._f**(rlogj) ! [cm-3 s-1]
+
+ ! NOTE: The weight percent can become negative from this parameterization,
+ ! which is not physicsal. With small supersaturations, the water activity
+ ! becomes postive (>1.013) the weight percent becomes negative. Don't allow
+ ! the the supsatl to be greater than 0.
+ ssl = max(-1.0_f, min(0._f, ssl))
+
+ ! Kelvin effect on water activity
+ aw = 1._f + ssl ! ?
+ fkelv = exp(akelvin(iz,igas) / r(ibin,igroup))
+ aw = aw / fkelv
+
+ ! Calculate volume ratio of wet/dry aerosols
+ if (aw < 0.05_f) then
+ CONTL = 12.37208932_f * (aw**(-0.16125516114_f)) - 30.490657554_f * aw - 2.1133114241_f
+ CONTH = 13.455394705_f * (aw**(-0.1921312255_f)) - 34.285174604_f * aw - 1.7620073078_f
+ elseif (aw <= 0.85) then
+ CONTL = 11.820654354_f * (aw**(-0.20786404244_f)) - 4.807306373_f * aw - 5.1727540348_f
+ CONTH = 12.891938068_f * (aw**(-0.23233847708_f)) - 6.4261237757_f * aw - 4.9005471319_f
+ else
+ CONTL = -180.06541028_f * (aw**(-0.38601102592_f)) - 93.317846778_f * aw + 273.88132245_f
+ CONTH = -176.95814097_f * (aw**(-0.36257048154_f)) - 90.469744201_f * aw + 267.45509988_f
+ endif
+
+ H2SO4m = CONTL + ((CONTH - CONTL) * (t(iz) - 190._f) / 70._f)
+ WT = (98.0_f * H2SO4m) / (1000._f + 98._f * H2SO4m)
+ WT = max(0._f, min(1._f, WT))
+ WT = 100._f * WT
+
+ ! Volume ratio of wet/dry aerosols.
+ if (WT <= 0._f) then
+ volrat = 1.e10_f
+ else
+ volrat = rhosol(isol) / RHO_W * ((100._f - WT) / WT) + 1._f
+ endif
+
+ ! NOTE: Limit the rate for stability.
+ ! [s-1]
+ rnuclg(ibin,igroup,ignucto) = rnuclg(ibin,igroup,ignucto) + min(1e20_f, rjj * volrat * vol(ibin,igroup))
+ endif ! ssi > sifreeze .and. target droplets not evaporating
+ enddo ! ibin = 1,NBIN
+ endif ! inucproc(iepart,ienucto) .eq. I_DROPACT
+ endif
+ enddo ! inuc = 1,nnuc2elem(iepart)
+ endif ! pconmax .gt. FEW_PC
+ endif ! (igas = inucgas(igroup) .ne. 0)
+ enddo ! igroup = 1,NGROUP
+ endif
+
+ ! Return to caller with particle loss rates due to nucleation evaluated.
+ return
+end subroutine
diff --git a/src/physics/carma/base/freezaerl_tabazadeh2000.F90 b/src/physics/carma/base/freezaerl_tabazadeh2000.F90
new file mode 100644
index 0000000000..e692abb46a
--- /dev/null
+++ b/src/physics/carma/base/freezaerl_tabazadeh2000.F90
@@ -0,0 +1,311 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluates particle loss rates due to nucleation :
+!! aerosol freezing only.
+!!
+!! The parameterization described by Tabazadeh et al. [GRL, 27, 1111, 2000.] is
+!! used.
+!!
+!! The loss rates for all particle elements in a particle group are equal.
+!!
+!! @author Eric Jensen, Chuck Bardeen
+!! @version Mar-1995, Nov-2009
+subroutine freezaerl_tabazadeh2000(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ ! Define parameters needed for freezing nucleation calculations.
+! real(kind=f), parameter :: adelf = 1.29e-12_f
+! real(kind=f), parameter :: bdelf = 0.05_f
+ real(kind=f), parameter :: prenuc = 2.075e33_f * RHO_W / RHO_I
+! real(kind=f), parameter :: rmiv = 0.6_f
+
+ integer :: igas !! gas index
+ integer :: igroup !! group index
+ integer :: ibin !! bin index
+ integer :: iepart !! element for condensing group index
+ integer :: inuc !! nucleating element index
+ integer :: ienucto !! index of target nucleation element
+ integer :: ignucto !! index of target nucleation group
+ integer :: isol
+ real(kind=f) :: A0, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10
+ real(kind=f) :: c0, C1, C2, C3, C4, c5
+ real(kind=f) :: d0, d1, d2, d3, d4, d5
+ real(kind=f) :: e0, e1, e2, e3, e4, e5
+ real(kind=f) :: sifreeze
+ real(kind=f) :: rhoibar
+ real(kind=f) :: rlhbar
+ real(kind=f) :: act
+ real(kind=f) :: CONTL
+ real(kind=f) :: CONTH
+ real(kind=f) :: H2SO4m
+ real(kind=f) :: WT
+ real(kind=f) :: vrat
+ real(kind=f) :: wtfrac
+ real(kind=f) :: den
+ real(kind=f) :: diffact
+ real(kind=f) :: S260, S220, S180
+ real(kind=f) :: sigma
+ real(kind=f) :: sigsula
+ real(kind=f) :: sigicea
+ real(kind=f) :: sigsulice
+ real(kind=f) :: ag
+ real(kind=f) :: delfg
+ real(kind=f) :: expon
+ real(kind=f) :: ssl
+ real(kind=f) :: fkelv
+
+
+ ! Loop over particle groups.
+ do igroup = 1,NGROUP
+
+ igas = inucgas(igroup)
+ iepart = ienconc(igroup)
+ isol = isolelem(iepart)
+
+ if( igas .ne. 0 )then
+
+ ! Calculate nucleation loss rates. Do not allow nucleation into
+ ! an evaporating bin.
+! if( nnuc2elem(iepart) .gt. 1 )then
+ do inuc = 1,nnuc2elem(iepart)
+
+ ienucto = inuc2elem(inuc,iepart)
+ if( ienucto .ne. 0 )then
+ ignucto = igelem( ienucto )
+
+ ! Only compute nucleation rate for aerosol freezing.
+ !
+ ! NOTE: If heterogeneous nucleation of glassy aerosols is being used
+ ! as a nucleation mechanism, then both the heterogeneous nucleation and
+ ! the homogeneous freezing need to be considered.
+ if ((iand(inucproc(iepart,ienucto), I_AF_TABAZADEH_2000) /= 0)) then
+
+ ! Loop over particle bins. Loop from largest to smallest for
+ ! evaluation of index of smallest bin nucleated during time step .
+ do ibin =NBIN,1,-1
+
+ ! Bypass calculation if few particles are present
+ if( pconmax(iz,igroup) .gt. FEW_PC )then
+
+ ! Calculate approximate critical saturation needed for homogeneous freezing
+ ! of sulfate aerosols (see Jensen and Toon, GRL, 1994).
+ sifreeze = 0.3_f
+
+ ! NOTE: The wieght percent can become negative from this parameterization,
+ ! which is not physicsal. With small supersaturations, the water activity
+ ! becomes postive (>1.013) the weight percent becomes negative. Don't allow
+ ! the the supsatl to be greater than 0.
+ ssl = max(-1.0_f, min(0._f, supsatl(iz,igas)))
+
+
+ ! Homogeneous freezing of sulfate aerosols should only occur of SL < Scrit
+ ! and SI > .
+ if( supsati(iz,igas) .gt. sifreeze)then
+
+ ! Calculate mean ice density and latent heat of freezing over temperature
+ ! interval [T0,T]
+
+ rhoibar = ( 0.916_f * (t(iz)-T0) - &
+ 1.75e-4_f/2._f * ((t(iz)-T0)**2) - &
+ 5.e-7_f * ((t(iz)-T0)**3)/3._f ) / (t(iz)-T0)
+
+ rlhbar = ( 79.7_f * (t(iz)-T0) + &
+ 0.485_f/2._f * (t(iz)-T0)**2 - &
+ 2.5e-3_f/3._f * (t(iz)-T0)**3 ) &
+ / (t(iz)-T0) * 4.186e7*18._f
+
+ ! Equilibrium H2SO4 weight percent for fixed water activity
+ act = min(1.0_f, ssl + 1._f)
+
+ ! Kelvin effect on water activity
+ fkelv = exp(akelvin(iz,igas) / r(ibin,igroup)) ! ?
+ act = act / fkelv
+
+ IF(act .LT. 0.05_f) THEN
+ CONTL = 12.37208932_f * (act**(-0.16125516114_f)) - &
+ 30.490657554_f * act - 2.1133114241_f
+ CONTH = 13.455394705_f * (act**(-0.1921312255_f)) - &
+ 34.285174604_f * act - 1.7620073078_f
+ END IF
+ IF(act .GE. 0.05_f .and. act .LE. 0.85_f) THEN
+ CONTL = 11.820654354_f * (act**(-0.20786404244_f)) - &
+ 4.807306373_f * act - 5.1727540348_f
+ CONTH = 12.891938068_f * (act**(-0.23233847708_f)) - &
+ 6.4261237757_f * act - 4.9005471319_f
+ END IF
+ IF(act .GT. 0.85_f) THEN
+ CONTL = -180.06541028_f * (act**(-0.38601102592_f)) - &
+ 93.317846778_f * act + 273.88132245_f
+ CONTH = -176.95814097_f * (act**(-0.36257048154_f)) - &
+ 90.469744201_f * act + 267.45509988_f
+ END IF
+ H2SO4m = CONTL + ((CONTH - CONTL) * (t(iz) -190._f)/70._f)
+ WT = (98.0_f * H2SO4m)/(1000._f + 98._f * H2SO4m)
+ WT = 100._f * WT
+
+ ! Volume ratio of wet/dry aerosols.
+ vrat = rhosol(isol)/RHO_W * ((100._f-wt)/wt) + 1._f
+
+ ! Calculation sulfate solution density from Myhre et al. (1998).
+ wtfrac = WT/100._f
+ C1 = t(iz) - 273.15_f
+ C2 = C1**2
+ C3 = C1**3
+ C4 = C1**4
+ A0 = 999.8426_f + 334.5402e-4_f*C1 - 569.1304e-5_f*C2
+ A1 = 547.2659_f - 530.0445e-2_f*C1 + 118.7671e-4_f*C2 &
+ + 599.0008e-6_f*C3
+ A2 = 526.295e+1_f + 372.0445e-1_f*C1 + 120.1909e-3_f*C2 &
+ - 414.8594e-5_f*C3 + 119.7973e-7_f*C4
+ A3 = -621.3958e+2_f - 287.7670_f*C1 - 406.4638e-3_f*C2 &
+ + 111.9488e-4_f*C3 + 360.7768e-7_f*C4
+ A4 = 409.0293e+3_f + 127.0854e+1_f*C1 + 326.9710e-3_f*C2 &
+ - 137.7435e-4*C3 - 263.3585e-7*C4
+ A5 = -159.6989e+4_f - 306.2836e+1_f*C1 + 136.6499e-3_f*C2 &
+ + 637.3031e-5_f*C3
+ A6 = 385.7411e+4_f + 408.3717e+1_f*C1 - 192.7785e-3_f*C2
+ A7 = -580.8064e+4_f - 284.4401e+1_f*C1
+ A8 = 530.1976e+4_f + 809.1053_f*C1
+ A9 = -268.2616e+4_f
+ A10 = 576.4288e+3_f
+ den = A0 + wtfrac*A1 + wtfrac**2 * A2 + &
+ wtfrac**3 * A3 + wtfrac**4 * A4
+ den = den + wtfrac**5 * A5 + wtfrac**6 * A6 + &
+ wtfrac**7 * A7
+ den = den + wtfrac**8 * A8 + wtfrac**9 * A9 + &
+ wtfrac**10 * A10
+
+ ! Activation energy is based on Koop's lab data.
+ IF(t(iz) .GT. 220._f) then
+ A0 = 104525.93058_f
+ A1 = -1103.7644651_f
+ A2 = 1.070332702_f
+ A3 = 0.017386254322_f
+ A4 = -1.5506854268e-06_f
+ A5 = -3.2661912497e-07_f
+ A6 = 6.467954459e-10_f
+ ELSE
+ A0 = -17459.516183_f
+ A1 = 458.45827551_f
+ A2 = -4.8492831317_f
+ A3 = 0.026003658878_f
+ A4 = -7.1991577798e-05_f
+ A5 = 8.9049094618e-08_f
+ A6 = -2.4932257419e-11_f
+ END IF
+
+ diffact = ( A0 + A1*t(iz) + A2*t(iz)**2 + &
+ A3*t(iz)**3 + A4*t(iz)**4 + &
+ A5*t(iz)**5 + A6*t(iz)**6 ) * 1.0e-13_f
+
+ ! Surface energy
+
+ ! Weight percent function for T = 260 K
+ c0 = 77.40682664_f
+ c1 = -0.006963123274_f
+ c2 = -0.009682499074_f
+ c3 = 0.00088797988_f
+ c4 = -2.384669516e-05_f
+ c5 = 2.095358048e-07_f
+ S260 = c0 + c1*wt + c2*wt**2 + c3*wt**3 + &
+ c4*wt**4 + c5*wt**5
+
+ ! Weight percent function for T = 220 K
+ d0 = 82.01197792_f
+ d1 = 0.5312072092_f
+ d2 = -0.1050692123_f
+ d3 = 0.005415260617_f
+ d4 = -0.0001145573827_f
+ d5 = 8.969257061e-07_f
+ S220 = d0 + d1*wt + d2*wt**2 + d3*wt**3 + &
+ d4*wt**4 + d5*wt**5
+
+ ! Weight percent function for T = 180K
+ e0 = 85.75507114_f
+ e1 = 0.09541966318_f
+ e2 = -0.1103647657_f
+ e3 = 0.007485866933_f
+ e4 = -0.0001912224154_f
+ e5 = 1.736789787e-06_f
+ S180 = e0 + e1*wt + e2*wt**2 + e3*wt**3 + &
+ e4*wt**4 + e5*wt**5
+
+ if( t(iz) .GE. 220._f ) then
+ sigma = S260 + ((260._f-t(iz))*(S220-S260))/40._f
+ else
+ sigma = S220 + ((220._f-t(iz))*(S180-S220))/40._f
+ endif
+
+ sigsula = sigma
+ sigicea = 105._f
+ sigsulice = abs( sigsula - sigicea )
+
+ ! Critical ice germ radius formed in the sulfate solution
+ ag = 2._f*gwtmol(igas)*sigsulice / &
+ ( rlhbar * rhoibar * log(T0/t(iz)) + &
+ rhoibar * rgas * 0.5_f * (T0+t(iz)) * &
+ log(ssl+1._f) )
+
+ if( ag .lt. 0._f ) ag = 1.e10_f
+
+ ! Gibbs free energy of ice germ formation in the ice/sulfate solution
+ delfg = 4._f/3._f*PI * sigsulice * (ag**2)
+
+ ! Ice nucleation rate in a 0.2 micron aerosol (/sec)
+ expon = ( -diffact - delfg ) / BK / t(iz)
+ expon = max( -100._f*ONE, expon )
+ rnuclg(ibin,igroup,ignucto) = prenuc * &
+ sqrt(sigsulice*t(iz)) * &
+ vrat*vol(ibin,igroup) * exp( expon )
+
+ ! This parameterizations has problems that sometimes yield negative nucleation
+ ! rates. It would be best to fix the parameterization, but at least keep negative
+ ! values from being return.
+ if (rnuclg(ibin,igroup,ignucto) < 0._f) then
+ rnuclg(ibin,igroup,ignucto) = 0._f
+ end if
+
+
+ ! xh = 0.1 * r(ibin,igroup) / ag
+ ! phih = sqrt( 1. - 2.*rmiv*xh + xh**2 )
+ ! rath = (xh-rmiv) / phih
+ ! fv3h = xh**3 * ( 2.*ONE - 3.*rath + rath**3 )
+ ! fv4h = 3. * rmiv * xh**2 * (rath-1.)
+ ! if( abs(rath) .gt. 1.e0-1.e-8 ) fv3h = 0.
+ ! if( abs(rath) .gt. 1.e0-1.e-10 ) fv4h = 0.
+ !
+ ! fh = 0.5 * ( ONE + ((ONE-rmiv*xh)/phih)**3 +
+ ! $ fv3h + fv4h )
+ !
+ ! expon = ( -delfwat2ice - delfg ) / BK / t3(ixyz)
+ ! expon = max( -POWMAX, expon )
+ endif
+ endif ! pconmax(ixyz,igroup) .gt. FEW_PC
+ enddo ! ibin = 1,NBIN
+ endif ! inucproc(iepart,ienucto) .eq. I_DROPACT
+ endif
+ enddo ! inuc = 1,nnuc2elem(iepart)
+! endif ! (nnuc2elem(iepart) .gt. 1)
+ endif ! (igas = inucgas(igroup) .ne. 0)
+ enddo ! igroup = 1,NGROUP
+
+ ! Return to caller with particle loss rates due to nucleation evaluated.
+ return
+end
diff --git a/src/physics/carma/base/freezdropl.F90 b/src/physics/carma/base/freezdropl.F90
new file mode 100644
index 0000000000..f4151b4cbc
--- /dev/null
+++ b/src/physics/carma/base/freezdropl.F90
@@ -0,0 +1,74 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluates particle loss rates due to nucleation :
+!! droplet freezing only.
+!!
+!! The loss rates for all particle elements in a particle group are equal.
+!!
+!! @author Eric Jensen, Chuck Bardeen
+!! @version Jan-2000, Nov-2009
+subroutine freezdropl(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: igroup !! group index
+ integer :: ibin !! bin index
+ integer :: iepart !! element for condensing group index
+ integer :: inuc !! nucleating element index
+ integer :: ienucto !! index of target nucleation element
+ integer :: ignucto !! index of target nucleation group
+
+
+ ! Loop over particle groups.
+ do igroup = 1,NGROUP
+
+ iepart = ienconc( igroup ) ! particle number density element
+
+ ! Calculate nucleation loss rates.
+ do inuc = 1,nnuc2elem(iepart)
+
+ ienucto = inuc2elem(inuc,iepart)
+
+ if( ienucto .ne. 0 )then
+ ignucto = igelem( ienucto )
+
+ ! Only compute nucleation rate for droplet freezing
+ if( inucproc(iepart,ienucto) .eq. I_DROPFREEZE ) then
+
+ ! Loop over particle bins.
+ do ibin = 1,NBIN
+
+ ! Bypass calculation if few particles are present
+ if( pc(iz,ibin,iepart) .gt. FEW_PC )then
+
+ ! Temporary simple kludge: Set to 1.e2 if T < -40C
+ if( t(iz) .lt. T0-40._f ) then
+ rnuclg(ibin,igroup,ignucto) = 1.e2_f
+ endif
+
+ endif ! pc(source particles) .gt. FEW_PC
+ enddo ! ibin = 1,NBIN
+ endif ! inucproc(iepart,ienucto) .eq. I_DROPFREEZE
+ endif
+ enddo ! inuc = 1,nnuc2elem(iepart)
+ enddo ! igroup = 1,NGROUP
+
+ ! Return to caller with particle loss rates due to nucleation evaluated.
+ return
+end
diff --git a/src/physics/carma/base/freezglaerl_murray2010.F90 b/src/physics/carma/base/freezglaerl_murray2010.F90
new file mode 100644
index 0000000000..1fa920fc86
--- /dev/null
+++ b/src/physics/carma/base/freezglaerl_murray2010.F90
@@ -0,0 +1,136 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluates particle loss rates due to nucleation :
+!! heterogeneous nucleation of glassy aerosols only,.
+!!
+!! The parameterization of glass aerosols is described in Murray et al.
+!! [Nature Geosciences, 2010], and is based upon measurements of the nucleation of
+!! citric acid aerosols at cold temperatures.
+!!
+!! NOTE: This implementation assumes that the aerosol being nucleated is the total
+!! aerosol population and not just the fraction of aerosols that are glassy. To
+!! account for homogenous freezing of the aerosol population, the routine freezaerl
+!! also needs to be called and the overall nucleation rate is the sum of
+!! the rates for homogeneous freezing and for heterogenous nucleation.
+!!
+!! The parameter fglass is the fraction of the total aerosol population that will be
+!! in a glassy state for T <= 212K.
+!!
+!! The loss rates for all particle elements in a particle group are equal.
+!!
+!! @author Chuck Bardeen, Eric Jensen
+!! @version Apr-2010
+subroutine freezglaerl_murray2010(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ ! Define parameters needed for freezing nucleation calculations.
+ real(kind=f), parameter :: kice1 = 7.7211e-5_f ! Fit constant from Murray et al.
+ real(kind=f), parameter :: kice2 = 9.2688e-3_f ! Fit constant from Murray et al.
+ real(kind=f), parameter :: ssmin = 0.21_f ! Minimum supersaturation for nucleation
+ real(kind=f), parameter :: ssmax = 0.7_f ! Maximum supersaturation for nucleation
+ real(kind=f), parameter :: tglass = 212._f ! Maximum temperature for glassy state
+ real(kind=f), parameter :: fglass = 0.5_f ! Fraction of aerosols that can become glassy
+
+ integer :: igas ! gas index
+ integer :: igroup ! group index
+ integer :: ibin ! bin index
+ integer :: iepart ! element for condensing group index
+ integer :: inuc ! nucleating element index
+ integer :: ienucto ! index of target nucleation element
+ integer :: ignucto ! index of target nucleation group
+ integer :: inucto ! index of target nucleation bin
+ real(kind=f) :: dfice ! difference in fraction of aerosol nucleated
+ real(kind=f) :: ssi, ssiold
+
+ ! Assume success.
+ rc = RC_OK
+
+ ! Loop over particle groups.
+ do igroup = 1,NGROUP
+
+ igas = inucgas(igroup) ! condensing gas
+ iepart = ienconc( igroup ) ! particle number density element
+
+ if (igas /= 0) then
+
+ ! Calculate nucleation loss rates. Do not allow nucleation into
+ ! an evaporating bin.
+ do inuc = 1, nnuc2elem(iepart)
+
+ ienucto = inuc2elem(inuc,iepart)
+ if (ienucto /= 0) then
+ ignucto = igelem(ienucto)
+
+ ! Only compute nucleation rate for glassy aerosol freezing.
+ if ((iand(inucproc(iepart,ienucto), I_AF_MURRAY_2010) /= 0)) then
+
+ ! Is it cold enough for aerosols to be in a glassy state.
+ if (t(iz) <= tglass) then
+
+ ! Loop over particle bins. Loop from largest to smallest for
+ ! evaluation of index of smallest bin nucleated during time step .
+ do ibin = NBIN, 1, -1
+
+ ! Bypass calculation if few particles are present or if it isn't cold enough
+ ! for the aerosols to be present in a glassy state.
+ if (pconmax(iz,igroup) > FEW_PC) then
+
+ ! Murray et al. [2010] doesn't really give a nucleation rate. Instead it gives
+ ! a fraction of glassy aerosol particles that have been nucleated as a function
+ ! of ice supersaturation.
+ !
+ ! Since CARMA really wants to work with rates, use the difference in relative
+ ! humidity and the length of the timestep to come up with an approximation to
+ ! a nucleation rate.
+
+ ! The supersaturation must be greater than .21 for heterogeneous nucleation to
+ ! commence. The fraction of glassy aerosol nucleated is:
+ !
+ ! fice = 7.7211e-5 * RHi(%) - 9.2688e-3 for 121 % < RHi < 170 %
+ !
+ ! To get a pseudo production rate, use
+ !
+ ! rnuclg = (fice(RHi) - fice(RHi_old)) / dtime
+ !
+ ssi = supsati(iz,igas)
+ ssiold = supsatiold(iz,igas)
+
+ if ((ssi >= ssmin) .and. (ssi > ssiold)) then
+ dfice = kice1 * (1._f + min(ssmax, ssi)) * 100._f - kice2
+
+ if (ssiold >= ssmin) then
+ dfice = dfice - (kice1 * (1._f + min(ssmax, ssiold)) * 100._f - kice2)
+ endif
+
+ ! Add the rate of heterogenous freezing to the rate of homogeneous
+ rnuclg(ibin,igroup,ignucto) = rnuclg(ibin,igroup,ignucto) + fglass * dfice / dtime
+ endif
+ endif
+ enddo
+ endif
+ endif
+ endif
+ enddo
+ endif
+ enddo
+
+ ! Return to caller with particle loss rates due to nucleation evaluated.
+ return
+end
diff --git a/src/physics/carma/base/gasexchange.F90 b/src/physics/carma/base/gasexchange.F90
new file mode 100644
index 0000000000..14913b5b6b
--- /dev/null
+++ b/src/physics/carma/base/gasexchange.F90
@@ -0,0 +1,146 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates the total production of gases due to nucleation,
+!! growth, and evaporation [g/x_units/y_units/z_units/s].
+!! It also calculates the latent heating rate from a condensing gas
+!! [deg_K/s]
+!!
+!! @author Andy Ackerman
+!! @version Dec-1995
+subroutine gasexchange(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: igroup !! group index
+ integer :: iepart
+ integer :: igas !! gasindex
+ integer :: i
+ integer :: i2
+ integer :: ig2
+ integer :: ienuc2
+ integer :: ielem !! element index
+ real(kind=f) :: rlh
+ real(kind=f) :: gasgain
+ real(kind=f) :: gprod_nuc(NGROUP,NGAS)
+ real(kind=f) :: gprod_grow(NGROUP,NGAS)
+
+
+ ! Initialize local variables for keeping track of gas changes due
+ ! to nucleation and growth in each particle group.
+ gprod_nuc(:,:) = 0._f
+ gprod_grow(:,:) = 0._f
+
+ ! First calculate gas loss and latent heat gain rates due to nucleation.
+ do igroup = 1,NGROUP
+
+ igas = inucgas(igroup) ! condensing gas
+ ielem = ienconc(igroup) ! element of particle number concentration
+
+ if( igas .ne. 0 .and. nnuc2elem(ielem) .gt. 0 )then
+
+ do ienuc2 = 1,NELEM
+
+ ig2 = igelem( ienuc2 ) ! target particle group
+
+ if( if_nuc(ielem,ienuc2) ) then
+
+ do i = 1,NBIN
+
+ ! If there is no place for the nucleating particle bin to fit in the
+ ! nucleated particle, then just skip it.
+ !
+ ! This could be an error if significant nucleation really happens from
+ ! these bins, but also more flexibility in setting up particle grids.
+ gprod_nuc(igroup,igas) = gprod_nuc(igroup,igas) - &
+ rhompe(i,ielem) * rmass(i,igroup)
+
+ i2 = inuc2bin(i,igroup,ig2) ! target bin
+ if (i2 /= 0) then
+ gprod_nuc(igroup,igas) = gprod_nuc(igroup,igas) - &
+ pc(iz,i,ielem) * rnuclg(i,igroup,ig2) * diffmass(i2,ig2,i,igroup)
+ end if
+ enddo
+
+ ! Latent heating rate from condensing gas: is latent heat of evaporation
+ ! ( + fusion, for ice deposition ) [erg/g]
+! if(( inucproc(ielem,ienuc2) .eq. I_DROPACT ) .or. &
+! ( inucproc(ielem,ienuc2) .eq. I_HOMNUC )) then
+! rlh = rlhe(iz,igas)
+! elseif(( inucproc(ielem,ienuc2) .eq. I_AERFREEZE ) .or. &
+! ( inucproc(ielem,ienuc2) .eq. I_HETNUC ))then
+! rlh = rlhe(iz,igas) + rlhm(iz,igas)
+! endif
+
+! rlprod = rlprod - rlh * gprod_nuc(igroup,igas) / ( CP * rhoa(iz) )
+ endif
+ enddo ! ienuc2 = 1,NELEM
+ endif ! (igas = inucgas(ielem) .ne. 0
+
+ ! Next calculate gas lost/gained due to and heat gained/lost from
+ ! growth/evaporation.
+ igas = igrowgas(ielem) ! condensing gas
+
+ if( igas .ne. 0 )then
+
+ do i = 1,NBIN-1
+
+ ! Calculate , mass concentration of gas gained due to evaporation
+ ! from each droplet in bin . First check for total evaporation.
+ if( totevap(i+1,igroup) )then
+ gasgain = ( 1._f - cmf(i+1,igroup) )*rmass(i+1,igroup)
+ else
+ gasgain = diffmass(i+1,igroup,i,igroup)
+ endif
+
+ gprod_grow(igroup,igas) = gprod_grow(igroup,igas) &
+ + evaplg(i+1,igroup) * pc(iz,i+1,ielem) * &
+ gasgain &
+ - growlg(i,igroup) * pc(iz,i,ielem) * &
+ diffmass(i+1,igroup,i,igroup)
+ enddo
+
+ ! Add evaporation out of smallest bin (always total evaporation).
+ gprod_grow(igroup,igas) = gprod_grow(igroup,igas) + &
+ evaplg(1,igroup) * pc(iz,1,ielem) * &
+ ( 1._f - cmf(1,igroup) ) * rmass(1,igroup)
+
+ ! Latent heating rate from condensing gas: is latent heat of evaporation
+ ! ( + fusion, for ice deposition ) [erg/g]
+! if( is_grp_ice(igroup) )then
+! rlh = rlhe(iz,igas) + rlhm(iz,igas)
+! else
+! rlh = rlhe(iz,igas)
+! endif
+
+! rlprod = rlprod - rlh * gprod_grow(igroup,igas) / &
+! ( CP * rhoa(iz) )
+ endif ! (igas = igrowgas(ielem)) .ne. 0
+ enddo ! igroup=1,NGROUP
+
+ ! Sum up gas production from nucleation and growth terms.
+ do igas = 1,NGAS
+ do igroup = 1,NGROUP
+ gasprod(igas) = gasprod(igas) + &
+ gprod_nuc(igroup,igas) + gprod_grow(igroup,igas)
+ enddo
+ enddo
+
+ ! Return to caller with evaluated.
+ return
+end
diff --git a/src/physics/carma/base/growevapl.F90 b/src/physics/carma/base/growevapl.F90
new file mode 100644
index 0000000000..6190ff46bd
--- /dev/null
+++ b/src/physics/carma/base/growevapl.F90
@@ -0,0 +1,256 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluate particle loss rates due to condensational
+!! growth and evaporation for all condensing gases.
+!!
+!! The loss rates for each group are and .
+!!
+!! Units are [s^-1].
+!!
+!! @author Andy Ackerman
+!! @version Dec-1995
+subroutine growevapl(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: igroup
+ integer :: iepart
+ integer :: igas
+ integer :: ibin
+ integer :: isol
+ integer :: nother
+ integer :: ieoth_rel
+ integer :: ieoth_abs
+ integer :: jother
+ real(kind=f) :: argsol
+ real(kind=f) :: othermtot
+ real(kind=f) :: condm
+ real(kind=f) :: akas
+ real(kind=f) :: expon
+ real(kind=f) :: g0
+ real(kind=f) :: g1
+ real(kind=f) :: g2
+ real(kind=f) :: ss
+ real(kind=f) :: pvap
+ real(kind=f) :: dpc
+ real(kind=f) :: dpc1
+ real(kind=f) :: dpcm1
+ real(kind=f) :: rat1
+ real(kind=f) :: rat2
+ real(kind=f) :: rat3
+ real(kind=f) :: rat4
+ real(kind=f) :: ratt1
+ real(kind=f) :: ratt2
+ real(kind=f) :: ratt3
+ real(kind=f) :: den1
+ real(kind=f) :: test1
+ real(kind=f) :: test2
+ real(kind=f) :: x
+ integer :: ieother(NELEM)
+ real(kind=f) :: otherm(NELEM)
+ real(kind=f) :: dela(NBIN)
+ real(kind=f) :: delma(NBIN)
+ real(kind=f) :: aju(NBIN)
+ real(kind=f) :: ar(NBIN)
+ real(kind=f) :: al(NBIN)
+ real(kind=f) :: a6(NBIN)
+ real(kind=f) :: dmdt(NBIN)
+ real(kind=f) :: growlg_max
+
+
+ do igroup = 1,NGROUP
+
+ ! element of particle number concentration
+ iepart = ienconc(igroup)
+
+ ! condensing gas
+ igas = igrowgas(iepart)
+
+ if (igas .ne. 0) then
+ ! Only valid for condensing liquid water and sulfric acid currently.
+ if ((igas /= igash2o) .and. (igas .ne. igash2so4)) then
+ if (do_print) write(LUNOPRT,*) 'growevapl::ERROR - Invalid gas (', igas, ').'
+ rc = -1
+ return
+ endif
+
+ ! Treat condensation of gas to/from particle group .
+ !
+ ! Bypass calculation if few particles are present
+ if( pconmax(iz,igroup) .gt. FEW_PC )then
+ do ibin = 1,NBIN-1
+
+ ! Determine the growth rate (dmdt). This calculation may take into account
+ ! radiative effects on the particle which can affect the growth rates.
+ call pheat(carma, cstate, iz, igroup, iepart, ibin, igas, dmdt(ibin), rc)
+
+ enddo ! ibin = 1,NBIN-1
+
+ ! Now calculate condensation/evaporation production and loss rates.
+ ! Use Piecewise Polynomial Method [Colela and Woodard, J. Comp. Phys.,
+ ! 54, 174-201, 1984]
+ !
+ ! First, use cubic fits to estimate concentration values at bin
+ ! boundaries
+ do ibin = 2,NBIN-1
+
+ dpc = pc(iz,ibin,iepart) / dm(ibin,igroup)
+ dpc1 = pc(iz,ibin+1,iepart) / dm(ibin+1,igroup)
+ dpcm1 = pc(iz,ibin-1,iepart) / dm(ibin-1,igroup)
+ ratt1 = pratt(1,ibin,igroup)
+ ratt2 = pratt(2,ibin,igroup)
+ ratt3 = pratt(3,ibin,igroup)
+ dela(ibin) = ratt1 * ( ratt2*(dpc1-dpc) + ratt3*(dpc-dpcm1) )
+ delma(ibin) = 0._f
+
+ if( (dpc1-dpc)*(dpc-dpcm1) .gt. 0._f ) &
+ delma(ibin) = min( abs(dela(ibin)), 2._f*abs(dpc-dpc1), &
+ 2._f*abs(dpc-dpcm1) ) * sign(1._f, dela(ibin))
+
+ enddo ! ibin = 2,NBIN-2
+
+ do ibin = 2,NBIN-2
+
+ dpc = pc(iz,ibin,iepart) / dm(ibin,igroup)
+ dpc1 = pc(iz,ibin+1,iepart) / dm(ibin+1,igroup)
+ dpcm1 = pc(iz,ibin-1,iepart) / dm(ibin-1,igroup)
+ rat1 = prat(1,ibin,igroup)
+ rat2 = prat(2,ibin,igroup)
+ rat3 = prat(3,ibin,igroup)
+ rat4 = prat(4,ibin,igroup)
+ den1 = pden1(ibin,igroup)
+
+ ! is the estimate for concentration (dn/dm) at bin
+ ! boundary +1/2.
+ aju(ibin) = dpc + rat1*(dpc1-dpc) + 1._f/den1 * &
+ ( rat2*(rat3-rat4)*(dpc1-dpc) - &
+ dm(ibin,igroup)*rat3*delma(ibin+1) + &
+ dm(ibin+1,igroup)*rat4*delma(ibin) )
+ enddo ! ibin = 2,NBIN-2
+
+ ! Now construct polynomial functions in each bin
+ do ibin = 3,NBIN-2
+ al(ibin) = aju(ibin-1)
+ ar(ibin) = aju(ibin)
+ enddo
+
+ ! Use linear functions in first two and last two bins
+ if( NBIN .gt. 1 )then
+ ibin = NBIN
+
+ ar(2) = aju(2)
+ al(2) = pc(iz,1,iepart)/dm(1,igroup) + &
+ palr(1,igroup) * &
+ (pc(iz,2,iepart)/dm(2,igroup)- &
+ pc(iz,1,iepart)/dm(1,igroup))
+ ar(1) = al(2)
+ al(1) = pc(iz,1,iepart)/dm(1,igroup) + &
+ palr(2,igroup) * &
+ (pc(iz,2,iepart)/dm(2,igroup)- &
+ pc(iz,1,iepart)/dm(1,igroup))
+
+ al(ibin-1) = aju(ibin-2)
+ ar(ibin-1) = pc(iz,ibin-1,iepart)/dm(ibin-1,igroup) + &
+ palr(3,igroup) * &
+ (pc(iz,ibin,iepart)/dm(ibin,igroup)- &
+ pc(iz,ibin-1,iepart)/dm(ibin-1,igroup))
+ al(ibin) = ar(ibin-1)
+ ar(ibin) = pc(iz,ibin-1,iepart)/dm(ibin-1,igroup) + &
+ palr(4,igroup) * &
+ (pc(iz,ibin,iepart)/dm(ibin,igroup)- &
+ pc(iz,ibin-1,iepart)/dm(ibin-1,igroup))
+ endif
+
+ ! Next, ensure that polynomial functions do not deviate beyond the
+ ! range [,]
+ do ibin = 1,NBIN
+
+ dpc = pc(iz,ibin,iepart) / dm(ibin,igroup)
+
+ if( (ar(ibin)-dpc)*(dpc-al(ibin)) .le. 0._f )then
+ al(ibin) = dpc
+ ar(ibin) = dpc
+ endif
+
+ test1 = (ar(ibin)-al(ibin))*(dpc - 0.5_f*(al(ibin)+ar(ibin)))
+ test2 = 1._f/6._f*(ar(ibin)-al(ibin))**2
+
+ if( test1 .gt. test2 )then
+ al(ibin) = 3._f*dpc - 2._f*ar(ibin)
+ elseif( test1 .lt. -test2 )then
+ ar(ibin) = 3._f*dpc - 2._f*al(ibin)
+ endif
+ enddo
+
+ ! Lastly, calculate fluxes across each bin boundary.
+ !
+ ! Use upwind advection when courant number > 1.
+ do ibin = 1,NBIN
+ dpc = pc(iz,ibin,iepart) / dm(ibin,igroup)
+ dela(ibin) = ar(ibin) - al(ibin)
+ a6(ibin) = 6._f * ( dpc - 0.5_f*(ar(ibin)+al(ibin)) )
+ enddo
+
+ do ibin = 1,NBIN-1
+
+ if( dmdt(ibin) .gt. 0._f .and. &
+ pc(iz,ibin,iepart) .gt. SMALL_PC )then
+
+ x = dmdt(ibin)*dtime/dm(ibin,igroup)
+
+ if( x .lt. 1._f )then
+ growlg(ibin,igroup) = dmdt(ibin)/pc(iz,ibin,iepart) &
+ * ( ar(ibin) - 0.5*dela(ibin)*x + &
+ (x/2._f - x**2/3._f)*a6(ibin) )
+ else
+ growlg(ibin,igroup) = dmdt(ibin) / dm(ibin,igroup)
+ endif
+
+ elseif( dmdt(ibin) .lt. 0._f .and. &
+ pc(iz,ibin+1,iepart) .gt. SMALL_PC )then
+
+ x = -dmdt(ibin)*dtime/dm(ibin+1,igroup)
+
+ if( x .lt. 1._f )then
+ evaplg(ibin+1,igroup) = -dmdt(ibin)/ &
+ pc(iz,ibin+1,iepart) &
+ * ( al(ibin+1) + 0.5_f*dela(ibin+1)*x + &
+ (x/2._f - (x**2)/3._f)*a6(ibin+1) )
+ else
+ evaplg(ibin+1,igroup) = -dmdt(ibin) / dm(ibin+1,igroup)
+ endif
+
+ ! Boundary conditions: for evaporation out of first bin (with cores),
+ ! use evaporation rate from second bin.
+! if( ibin .eq. 1 .and. ncore(igroup) .gt. 0 )then
+ if( ibin .eq. 1)then
+ evaplg(1,igroup) = -dmdt(1) / dm(1,igroup)
+ endif
+ endif
+
+ enddo ! ibin = 1,NBIN-1
+ endif ! (pconmax .gt. FEW_PC)
+ endif ! (igas = igrowgas(ielem)) .ne. 0
+ enddo ! igroup = 1,NGROUP
+
+
+ ! Return to caller with particle loss rates for growth and evaporation
+ ! evaluated.
+ return
+end
diff --git a/src/physics/carma/base/growp.F90 b/src/physics/carma/base/growp.F90
new file mode 100644
index 0000000000..b81b156027
--- /dev/null
+++ b/src/physics/carma/base/growp.F90
@@ -0,0 +1,50 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates particle source terms due to growth
+!! for one particle size bin at one spatial grid point per call.
+!!
+!! @author Andy Ackerman
+!! @version Dec-1995
+subroutine growp(carma, cstate, iz, ibin, ielem, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(in) :: ibin !! bin index
+ integer, intent(in) :: ielem !! element index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: igroup ! group index
+ integer :: iepart
+
+
+ ! Define group & particle # concentration indices for current element
+ igroup = igelem(ielem) ! target particle group
+ iepart = ienconc(igroup) ! target particle number concentration element
+
+ ! Calculate production terms due to condensational growth
+ ! only if group to which element belongs grows.
+ if( igrowgas(iepart) .ne. 0 .and. ibin .ne. 1 )then
+
+ ! Bypass calculation if few droplets are present
+ if( pconmax(iz,igroup) .gt. FEW_PC )then
+ growpe(ibin,ielem) = pc(iz,ibin-1,ielem) * growlg(ibin-1,igroup)
+ endif
+ endif
+
+ ! Return to caller with growth production terms evaluated.
+ return
+end
diff --git a/src/physics/carma/base/gsolve.F90 b/src/physics/carma/base/gsolve.F90
new file mode 100644
index 0000000000..e442575086
--- /dev/null
+++ b/src/physics/carma/base/gsolve.F90
@@ -0,0 +1,101 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates new gas concentrations.
+!!
+!! @author Andy Ackerman, Bill McKie, Chuck Bardeen
+!! @version Dec-1995, Sep-1997, Nov-2009
+subroutine gsolve(carma, cstate, iz, previous_ice, previous_liquid, scale_threshold, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ real(kind=f), intent(in) :: previous_ice(NGAS) !! total ice at the start of substep
+ real(kind=f), intent(in) :: previous_liquid(NGAS) !! total liquid at the start of substep
+ real(kind=f) :: scale_threshold !! Scaling factor for convergence thresholds
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local Variables
+ integer :: igas !! gas index
+ real(kind=f) :: gc_cgs
+ real(kind=f) :: rvap
+ real(kind=f) :: total_ice(NGAS) ! total ice
+ real(kind=f) :: total_liquid(NGAS) ! total liquid
+ real(kind=f) :: threshold ! convergence threshold
+
+
+ 1 format(/,'gsolve::ERROR - negative gas concentration for ',a,' : iz=',i4,',lat=', &
+ f7.2,',lon=',f7.2,',gc=',e10.3,',gasprod=',e10.3,',supsati=',e10.3, &
+ ',supsatl=',e10.3,',t=',f6.2)
+ 2 format('gsolve::ERROR - conditions at beginning of the step : gc=',e10.3,',supsati=',e17.10, &
+ ',supsatl=',e17.10,',t=',f6.2,',d_gc=',e10.3,',d_t=',f6.2)
+ 3 format(/,'microfast::WARNING - gas concentration change exceeds threshold: ',a,' : iz=',i4,',lat=', &
+ f7.2,',lon=',f7.2, ', (gc-gcl)/gcl=', e10.3)
+
+
+ ! Determine the total amount of condensate for each gas.
+ call totalcondensate(carma, cstate, iz, total_ice, total_liquid, rc)
+
+ do igas = 1,NGAS
+
+ ! We do not seem to be conserving mass and energy, so rather than relying upon gasprod
+ ! and rlheat, recalculate the total change in condensate to determine the change
+ ! in gas and energy.
+ !
+ ! This is because in the old scheme, the particles were solved for implicitly, but the
+ ! gas and latent heat were solved for explicitly using the same rates.
+ gasprod(igas) = ((previous_ice(igas) - total_ice(igas)) + (previous_liquid(igas) - total_liquid(igas))) / dtime
+ rlprod = rlprod - ((previous_ice(igas) - total_ice(igas)) * (rlhe(iz,igas) + rlhm(iz,igas)) + &
+ (previous_liquid(igas) - total_liquid(igas)) * (rlhe(iz,igas))) / (CP * rhoa(iz) * dtime)
+
+ ! Don't let the gas concentration go negative.
+ gc(iz,igas) = gc(iz,igas) + dtime * gasprod(igas)
+
+ if (gc(iz,igas) < 0.0_f) then
+ if (do_substep) then
+ if (nretries == maxretries) then
+ if (do_print) write(LUNOPRT,1) trim(gasname(igas)), iz, lat, lon, gc(iz,igas), gasprod(igas), &
+ supsati(iz,igas), supsatl(iz,igas), t(iz)
+ if (do_print) write(LUNOPRT,2) gcl(iz,igas), supsatiold(iz,igas), supsatlold(iz,igas), told(iz), d_gc(iz,igas), d_t(iz)
+ end if
+ else
+ if (do_print) write(LUNOPRT,1) trim(gasname(igas)), iz, lat, lon, gc(iz,igas), gasprod(igas), &
+ supsati(iz, igas), supsatl(iz,igas), t(iz)
+ end if
+
+ rc = RC_WARNING_RETRY
+ end if
+
+ ! If gas changes by too much, then retry the calculation.
+ threshold = dgc_threshold(igas) / scale_threshold
+
+ if (threshold /= 0._f) then
+ if ((dtime * gasprod(igas) / gc(iz,igas)) > threshold) then
+ if (do_substep) then
+ if (nretries == maxretries) then
+ if (do_print) write(LUNOPRT,3) trim(gasname(igas)), iz, lat, lon, dtime * gasprod(igas) / gc(iz,igas)
+ if (do_print) write(LUNOPRT,2) gcl(iz,igas), supsatiold(iz,igas), supsatlold(iz,igas), told(iz), d_gc(iz,igas), d_t(iz)
+ end if
+ else
+ if (do_print) write(LUNOPRT,3) trim(gasname(igas)), iz, lat, lon, dtime * gasprod(igas) / gc(iz,igas)
+ end if
+
+ rc = RC_WARNING_RETRY
+ end if
+ end if
+ end do
+
+ ! Return to caller with new gas concentrations.
+ return
+end
diff --git a/src/physics/carma/base/hetnucl.F90 b/src/physics/carma/base/hetnucl.F90
new file mode 100644
index 0000000000..13082e4932
--- /dev/null
+++ b/src/physics/carma/base/hetnucl.F90
@@ -0,0 +1,163 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluates particle loss rates due to nucleation :
+!! heterogeneous deposition nucleation only. The parameters are adjusted
+!! for mesospheric conditions, based upon the recommendations of Keesee.
+!!
+!! Based on expressions from ...
+!! Keesee [JGR,1989]
+!! Pruppacher and Klett [2000]
+!! Rapp and Thomas [JASTP, 2006]
+!! Trainer et al. [2008]
+!!
+!! The loss rates for all particle elements in a particle group are equal.
+!!
+!! To avoid nucleation into an evaporating bin, this subroutine must
+!! be called after growp, which evaluates evaporation loss rates .
+!!
+!! @author Eric Jensen, Chuck Bardeen
+!! @version Oct-2000, Jan-2010
+subroutine hetnucl(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: igas ! gas index
+ integer :: igroup ! group index
+ integer :: ibin ! bin index
+ integer :: iepart ! element for condensing group index
+ integer :: inuc ! nucleating element index
+ integer :: ienucto ! index of target nucleation element
+ integer :: ignucto ! index of target nucleation group
+ real(kind=f) :: rmw
+ real(kind=f) :: R_H2O
+ real(kind=f) :: rnh2o
+ real(kind=f) :: rlogs
+ real(kind=f) :: ag
+ real(kind=f) :: contang
+ real(kind=f) :: xh
+ real(kind=f) :: phih
+ real(kind=f) :: rath
+ real(kind=f) :: fv3h
+ real(kind=f) :: fv4h
+ real(kind=f) :: fh
+ real(kind=f) :: delfg
+ real(kind=f) :: expon
+
+ ! Heterogeneous nucleation factors
+ real(kind=f), parameter :: gdes = 2.9e-13_f
+ real(kind=f), parameter :: gsd = 2.9e-14_f
+ real(kind=f), parameter :: zeld = 0.1_f
+ real(kind=f), parameter :: vibfreq = 1.e13_f
+ real(kind=f), parameter :: diflen = 0.1e-7_f
+ real(kind=f) :: rmiv
+
+ rmiv = 0.95_f
+
+ ! rmiv - Eq. 2, Trainer et al. [2008]
+! rmiv = 0.94_f - (6005._f * exp(-0.065_f * max(150._f, t(iz))))
+! rmiv = max(0._f, 0.94_f - (6005._f * exp(-0.065_f * t(iz))))
+
+ ! Loop over particle groups.
+ do igroup = 1, NGROUP
+
+ igas = inucgas(igroup) ! condensing gas
+
+ if (igas .ne. 0) then
+
+ iepart = ienconc(igroup) ! particle number density element
+
+ rmw = gwtmol(igas) / AVG
+ R_H2O = RGAS / gwtmol(igas)
+ rnh2o = gc(iz,igas) * R_H2O / BK
+
+ ! Calculate nucleation loss rates. Do not allow nucleation into
+ ! an evaporating bin.
+ !
+ ! is index of target nucleation element;
+ ! is index of target nucleation group.
+ do inuc = 1, nnuc2elem(iepart)
+
+ ienucto = inuc2elem(inuc,iepart)
+
+ if (ienucto .ne. 0) then
+ ignucto = igelem(ienucto)
+ else
+ ignucto = 0
+ endif
+
+ ! Only compute nucleation rate for heterogenous nucleation
+ if (inucproc(iepart,ienucto) .eq. I_HETNUC) then
+
+ ! Loop over particle bins. Loop from largest to smallest for
+ ! evaluation of index of smallest bin nucleated during time step .
+ do ibin = NBIN, 1, -1
+
+ ! Bypass calculation if few particles are present
+ if (pconmax(iz,igroup) .gt. FEW_PC) then
+
+ ! Only proceed if ice supersaturated
+ !
+ ! NOTE: We are only trying to model PMC partcles, so turn of nucleation
+ ! where the CAM microphysics takes over (~1 mb = 1000 dyne).
+ if ((p(iz) .lt. 1.e3_f) .and. (supsati(iz,igas) .gt. 0._f)) then
+ rlogs = log(supsati(iz,igas) + 1._f)
+
+ ! Critical ice germ radius formed in the sulfate solution
+ !
+ ! Eq. 2, Rapp & Thomas [2006]
+ ag = 2._f * gwtmol(igas) * surfctia(iz) / rgas / t(iz) / RHO_I / rlogs
+
+ ! Heterogeneous nucleation geometric factor
+ !
+ ! Eq. 9-22, Pruppacher & Klett [2000]
+ contang = acos(rmiv)
+ xh = r(ibin,igroup) / ag
+ phih = sqrt(1._f - 2._f * rmiv * xh + xh**2 )
+ rath = (xh-rmiv) / phih
+ fv3h = xh**3 * (2._f - 3._f * rath + rath**3 )
+ fv4h = 3._f * rmiv * xh**2 * (rath - 1._f)
+
+ if (abs(rath) .gt. 1._f - 1.e-8_f) fv3h = 0._f
+ if (abs(rath) .gt. 1._f - 1.e-10_f) fv4h = 0._f
+
+ fh = 0.5_f * (1._f + ((1._f - rmiv * xh) / phih)**3 + fv3h + fv4h)
+
+ ! Gibbs free energy of ice germ formation in the ice/sulfate solution
+ !
+ ! Eq. 3, Rapp & Thomas [2006]
+ delfg = 4._f * PI * ag**2 * surfctia(iz) - 4._f * PI * RHO_I * ag**3 *BK * t(iz) * rlogs / 3._f / rmw
+
+ ! Ice nucleation rate in a 0.2 micron aerosol (/sec)
+ expon = (2._f * gdes - gsd - fh*delfg) / BK / t(iz)
+
+ ! NOTE: Excessive nucleation makes it difficult for the substepping to find a
+ ! stable solution, so put a cap on really large nucleation values that can be produced.
+ rnuclg(ibin,igroup,ignucto) = min(1e10_f, zeld * BK * t(iz) * diflen * ag * sin(contang) * &
+ 4._f * PI * r(ibin,igroup)**2 * rnh2o**2 / (fh * rmw * vibfreq) * exp(expon))
+ endif
+ endif ! pconmax(ixyz,igroup) .gt. FEW_PC
+ enddo ! ibin = 1,NBIN
+ endif ! inucproc(iepart,ienucto) .eq. I_DROPACT
+ enddo ! inuc = 1,nnuc2elem(iepart)
+ endif ! (igas = inucgas(igroup) .ne. 0)
+ enddo ! igroup = 1,NGROUP
+
+ ! Return to caller with particle loss rates due to nucleation evaluated.
+ return
+end
diff --git a/src/physics/carma/base/lusolvec_mod.F90 b/src/physics/carma/base/lusolvec_mod.F90
new file mode 100644
index 0000000000..a6018a2ffc
--- /dev/null
+++ b/src/physics/carma/base/lusolvec_mod.F90
@@ -0,0 +1,213 @@
+!!
+!! this module: lusolvec_mod Numerical solution of a set of linear
+!! Equations / a matrix equation A * x = b
+!! using LU decomposition, matrix A and
+!! vectors b and x being double complex,
+!! and inversion of A.
+!! ******************************************************************
+!! Usage:
+!! ======
+!! given a complex matrix A, a right hand side vector b and a
+!! matrix equation A * x = b to solve for vector x.
+!!
+!!
+!! First, call LUDCMPC(A,N,NP,INDX,D). The original Matrix A is lost
+!! and substituted by its LU decomposition.
+!!
+!! Second, call LUBKSBC(A,N,NP,INDX,B). The original right-hand-side
+!! vector ib in B is lost and replaced/returned as the solution
+!! vector x ( x(i) = B(i) ).
+!! Use same kind of call to solve for successive right-hand-sides.
+!!
+!! For Inversion of matrix A, call LUBKSBC() subsequently for each
+!! column vector:
+!! 1) Initialize matrix AINV(i,j) to be equal to the
+!! identity matrix (AINV(i,j)=1 for i=j; =0 otherwise)
+!! 2) DO jj=1,n
+!! CALL LUBKSBC(A,N,NP,INDX,AINV(1,jj))
+!! END DO
+!! (see textbook for further details).
+!! ******************************************************************
+
+module lusolvec_mod
+
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+ private
+
+ ! public subroutines
+ public :: LUDCMPC
+ public :: LUBKSBC
+
+ contains
+
+ !!
+ !! SUBROUTINE LUDCMPC(A,N,NP,INDX,D)
+ !!
+ !! Given a general complex matrix A, this routine replaces it by its
+ !! LU decomposition of a rowwise permutation of itself.
+ !! This routine is used in combination with LUBKSBC(), a complex
+ !! extension of the routine LUBKSB() (DOUBLE COMPLEX).
+ !! For further details, refer to textbook (see below).
+ !!
+ !! Source: Own adaption/extension to complex matrix of the
+ !! Subroutine LUDCMP() taken from
+ !! Press et al, "Numerical Recipes in Fortran"
+ !! The adaption follows the statements given in section 2.3
+ !! of the textbook "N.R. in C", following Eq.(2.3.16):
+ !! - definition of variables, vector and matrix elements
+ !! as complex variables (use of complex arithmetic does
+ !! not necessitate any adaption in fortran).
+ !! - complex modulus instead of absolute values in the
+ !! construction of the vector vv and in the search for the
+ !! largest pivot elements.
+ !! ******************************************************************
+ !! Version: 28.08.2000
+ !! ******************************************************************
+ SUBROUTINE LUDCMPC(A,N,NP,INDX,D)
+
+ INTEGER :: NP
+ COMPLEX(kind=f) :: A(NP,NP)
+ INTEGER :: N
+ INTEGER :: INDX(N)
+ REAL(kind=f) :: D
+
+ INTEGER, PARAMETER :: NMAX=100
+ REAL(kind=f), PARAMETER :: TINY=1.0e-20_f
+ REAL(kind=f) :: VV(NMAX)
+ REAL(kind=f) :: DUM,AAMAX
+ COMPLEX(kind=f) :: SUM,DUMC,ZEROC,TINYC
+ INTEGER I,J,K,IMAX
+
+ D=1._f
+ TINYC=cmplx(TINY,0.0_f,kind=f)
+ ZEROC=cmplx(0.0_f,0.0_f,kind=f)
+ DO I=1,N
+ AAMAX=0._f
+ DO J=1,N
+ IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J))
+ END DO
+! IF (AAMAX.EQ.0._f) PAUSE 'Singular matrix.'
+ IF (AAMAX.EQ.0._f) STOP 'Singular matrix.'
+ VV(I)=1./AAMAX
+ END DO
+ DO J=1,N
+ IF (J.GT.1) THEN
+ DO I=1,J-1
+ SUM=A(I,J)
+ IF (I.GT.1)THEN
+ DO K=1,I-1
+ SUM=SUM-A(I,K)*A(K,J)
+ END DO
+ A(I,J)=SUM
+ ENDIF
+ END DO
+ ENDIF
+ AAMAX=0._f
+ DO I=J,N
+ SUM=A(I,J)
+ IF (J.GT.1)THEN
+ DO K=1,J-1
+ SUM=SUM-A(I,K)*A(K,J)
+ END DO
+ A(I,J)=SUM
+ ENDIF
+ DUM=VV(I)*ABS(SUM)
+ IF (DUM.GE.AAMAX) THEN
+ IMAX=I
+ AAMAX=DUM
+ ENDIF
+ END DO
+ IF (J.NE.IMAX)THEN
+ DO K=1,N
+ DUMC=A(IMAX,K)
+ A(IMAX,K)=A(J,K)
+ A(J,K)=DUMC
+ END DO
+ D=-D
+ VV(IMAX)=VV(J)
+ ENDIF
+ INDX(J)=IMAX
+ IF(J.NE.N)THEN
+ IF(A(J,J).EQ.ZEROC)A(J,J)=TINYC
+ DUMC=1./A(J,J)
+ DO I=J+1,N
+ A(I,J)=A(I,J)*DUMC
+ END DO
+ ENDIF
+ END DO
+ IF (A(N,N).EQ.ZEROC) A(N,N)=TINYC
+ RETURN
+ END SUBROUTINE LUDCMPC
+
+ !!
+ !! SUBROUTINE LUBKSBC(A,N,NP,INDX,B)
+ !!
+ !! Solution of the set of linear equations A' * x = b where
+ !! A is input not as the original matrix, but as a LU decomposition
+ !! of some original matrix A' as determined by the subroutine
+ !! LUDCMPC() (matrix and vectors being of type DOUBLE COMPLEX).
+ !! INDX() is input as the permutation vactor returned by LUDCMPC().
+ !! B() is input as the right hand side vector b of the Eqn. to solve
+ !! and returns with the solution vector x.
+ !! A, N and INDX are not modified by this routine and can be left in
+ !! place for successive calls with different right-hand-sides b.
+ !! For further details, refer to textbook (see below).
+ !!
+ !! Source: Own adaption/extension to complex matrix of the
+ !! Subroutine LUBKSB() taken from
+ !! Press et al, "Numerical Recipes in Fortran"
+ !! The adaption follows the statements given in section 2.3
+ !! of the textbook "N.R. in C", following Eq.(2.3.16).
+ !! ******************************************************************
+ !! Version: 28.08.2000
+ !! ******************************************************************
+ SUBROUTINE LUBKSBC(A,N,NP,INDX,B)
+
+ INTEGER :: NP
+ COMPLEX(kind=f) :: A(NP,NP)
+ INTEGER :: N
+ INTEGER :: INDX(N)
+ COMPLEX(kind=f) :: B(N)
+
+ INTEGER, PARAMETER :: NMAX=100
+ REAL(kind=f), PARAMETER :: TINY=1.0e-20_f
+
+ COMPLEX(kind=f) :: SUM,ZEROC
+ INTEGER :: II,LL,I,J
+
+ II=0
+ ZEROC=cmplx(0.0_f,0.0_f,kind=f)
+ DO I=1,N
+ LL=INDX(I)
+ SUM=B(LL)
+ B(LL)=B(I)
+ IF (II.NE.0)THEN
+ DO J=II,I-1
+ SUM=SUM-A(I,J)*B(J)
+ END DO
+ ELSE IF (SUM.NE.ZEROC) THEN
+ II=I
+ ENDIF
+ B(I)=SUM
+ END DO
+ DO I=N,1,-1
+ SUM=B(I)
+ IF(I.LT.N)THEN
+ DO J=I+1,N
+ SUM=SUM-A(I,J)*B(J)
+ END DO
+ ENDIF
+ B(I)=SUM/A(I,I)
+ END DO
+ RETURN
+ END SUBROUTINE LUBKSBC
+
+
+end module lusolvec_mod
diff --git a/src/physics/carma/base/maxconc.F90 b/src/physics/carma/base/maxconc.F90
new file mode 100644
index 0000000000..0360c2a403
--- /dev/null
+++ b/src/physics/carma/base/maxconc.F90
@@ -0,0 +1,47 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This determines the maximum particle concentration for each group in each
+!! gridbox. This can be used to make calculations more efficient by skipping
+!! calculations when concentrations are low
+!!
+!! @author Chuck Bardeen
+!! @version Nov 2009
+subroutine maxconc(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Locals
+ integer :: igrp
+ integer :: iep
+
+
+ ! Find maximum particle concentration for each spatial grid box
+ ! (in units of cm^-3)
+ do igrp = 1,NGROUP
+ iep = ienconc(igrp)
+
+ pconmax(iz,igrp) = maxval(pc(iz,:,iep))
+
+ pconmax(iz,igrp) = pconmax(iz,igrp) &
+ / xmet(iz) &
+ / ymet(iz) &
+ / zmet(iz)
+ enddo ! igrp
+
+ return
+end
diff --git a/src/physics/carma/base/melticel.F90 b/src/physics/carma/base/melticel.F90
new file mode 100644
index 0000000000..26e1a904d7
--- /dev/null
+++ b/src/physics/carma/base/melticel.F90
@@ -0,0 +1,74 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluates particle loss rates due to nucleation :
+!! Ice crystal melting only.
+!!
+!! The loss rates for all particle elements in a particle group are equal.
+!!
+!! @author Eric Jensen, Chuck Bardeen
+!! @version Jan-2000, Nov-2009
+subroutine melticel(carma, cstate, iz, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: igroup !! group index
+ integer :: ibin !! bin index
+ integer :: iepart !! element for condensing group index
+ integer :: ienucto !! index of target nucleation element
+ integer :: ignucto !! index of target nucleation group
+ integer :: inuc !! nucleating element index
+
+
+ ! Loop over particle groups.
+ do igroup = 1,NGROUP
+
+ iepart = ienconc( igroup ) ! particle number density element
+
+ ! Calculate nucleation loss rates.
+ do inuc = 1,nnuc2elem(iepart)
+
+ ienucto = inuc2elem(inuc,iepart)
+
+ if( ienucto .ne. 0 )then
+ ignucto = igelem( ienucto )
+
+ ! Only compute nucleation rate for ice crystal melting
+ if( inucproc(iepart,ienucto) .eq. I_ICEMELT ) then
+
+ ! Loop over particle bins. Loop from largest to smallest for
+ ! evaluation of index of smallest bin nucleated during time step .
+ do ibin = NBIN,1,-1
+
+ ! Bypass calculation if few particles are present
+ if( pconmax(iz,igroup) .gt. FEW_PC )then
+
+ ! Temporary simple kludge: Set to 1.e2 if T > 0C
+ if( t(iz) .gt. T0 ) then
+ rnuclg(ibin,igroup,ignucto) = 1.e2_f
+ endif
+ endif ! pconmax(ixyz,igroup) .gt. FEW_PC
+ enddo ! ibin = 1,NBIN
+ endif ! inucproc(iepart,ienucto) .eq. I_DROPFREEZE
+ endif
+ enddo ! inuc = 1,nnuc2elem(iepart)
+ enddo ! igroup = 1,NGROUP
+
+ ! Return to caller with particle loss rates due to nucleation evaluated.
+ return
+end
diff --git a/src/physics/carma/base/microfast.F90 b/src/physics/carma/base/microfast.F90
new file mode 100644
index 0000000000..48b034403d
--- /dev/null
+++ b/src/physics/carma/base/microfast.F90
@@ -0,0 +1,277 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine drives the fast microphysics calculations.
+!!
+!! @author Eric Jensen, Bill McKie
+!! @version Sep-1997
+subroutine microfast(carma, cstate, iz, scale_threshold, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ real(kind=f) :: scale_threshold !! Scaling factor for convergence thresholds
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local Variables
+ integer :: ielem ! element index
+ integer :: ibin ! bin index
+ integer :: igas ! gas index
+ real(kind=f) :: previous_ice(NGAS) ! total ice at the start of substep
+ real(kind=f) :: previous_liquid(NGAS) ! total liquid at the start of substep
+ real(kind=f) :: previous_supsatl(NGAS) ! supersaturation wrt ice at the start of substep
+ real(kind=f) :: previous_supsati(NGAS) ! supersaturation wrt liquid at the start of substep
+ real(kind=f) :: supsatold
+ real(kind=f) :: supsatnew
+ real(kind=f) :: srat
+ real(kind=f) :: srat1
+ real(kind=f) :: srat2
+ real(kind=f) :: s_threshold
+
+ 1 format(/,'microfast::ERROR - excessive change in supersaturation for ',a,' : iz=',i4,',lat=', &
+ f7.2,',lon=',f7.2,',srat=',e10.3,',supsatiold=',e10.3,',supsatlold=',e10.3,',supsati=',e10.3, &
+ ',supsatl=',e10.3,',t=',f6.2)
+ 2 format('microfast::ERROR - conditions at beginning of the step : gc=',e10.3,',supsati=',e17.10, &
+ ',supsatl=',e17.10,',t=',f6.2,',d_gc=',e10.3,',d_t=',f6.2)
+ 3 format(/,'microfast::ERROR - excessive change in supersaturation for ',a,' : iz=',i4,',lat=', &
+ f7.2,',lon=',f7.2,',supsatiold=',e10.3,',supsatlold=',e10.3,',supsati=',e10.3, &
+ ',supsatl=',e10.3,',t=',f6.2)
+
+ ! Set production and loss rates to zero.
+ call zeromicro(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+
+ ! Calculate (implicit) particle loss rates for nucleation, growth,
+ ! evaporation, melting, etc.
+ if (do_grow) then
+
+ ! Save off the current condensate totals so the gas and latent heating can be
+ ! figured out in a way that conserves mass and energy.
+ call totalcondensate(carma, cstate, iz, previous_ice, previous_liquid, rc)
+ if (rc < RC_OK) return
+
+ do igas = 1, NGAS
+ call supersat(carma, cstate, iz, igas, rc)
+ if (rc < RC_OK) return
+
+ previous_supsati(igas) = supsati(iz, igas)
+ previous_supsatl(igas) = supsatl(iz, igas)
+ end do
+
+ ! Have water vapor and sulfuric acid been defined?
+ if ((igash2o /= 0) .and. (igash2so4 /= 0)) then
+
+ ! Are both gases avaialble?
+ if ((gc(iz, igash2o) > 0._f) .and. (gc(iz,igash2so4) > 0._f)) then
+
+ ! See if any sulfates will form.
+ call sulfnuc(carma, cstate, iz, rc)
+ endif
+ end if
+
+ call growevapl(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+ call actdropl(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+ ! The Koop, Tabazadeh and Mohler routines provide different schemes for aerosol freezing.
+ ! Only one of these parameterizatons should be active at one time. However, any
+ ! of these routines can be used in conjunction with heterogenous nucleation of glassy
+ ! aerosols.
+ call freezaerl_tabazadeh2000(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+ call freezaerl_koop2000(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+ call freezaerl_mohler2010(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+ call freezglaerl_murray2010(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+ call hetnucl(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+ call freezdropl(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+ call melticel(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+ endif
+
+ ! Calculate particle production terms and solve for particle
+ ! concentrations at end of time step.
+ do ielem = 1,NELEM
+ do ibin = 1,NBIN
+
+ if( do_grow )then
+ call growp(carma, cstate, iz, ibin, ielem, rc)
+ if (rc < RC_OK) return
+
+ call upgxfer(carma, cstate, iz, ibin, ielem, rc)
+ if (rc < RC_OK) return
+ endif
+
+ call psolve(carma, cstate, iz, ibin, ielem, rc)
+ if (rc < RC_OK) return
+ enddo
+ enddo
+
+ ! Calculate particle production terms for evaporation;
+ ! gas loss rates and production terms due to particle nucleation;
+ ! growth, and evaporation;
+ ! apply evaporation production terms to particle concentrations;
+ ! and solve for gas concentrations at end of time step.
+ if (do_grow) then
+ call evapp(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+ call downgxfer(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+! NOTE: Not needed because changes in gas concentrations and latent
+! heats are now calculated later in gsolve using total condensate.
+! call gasexchange(carma, cstate, iz, rc)
+! if (rc < RC_OK) return
+
+ call downgevapply(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+ call gsolve(carma, cstate, iz, previous_ice, previous_liquid, scale_threshold, rc)
+ if (rc /=RC_OK) return
+ endif
+
+ ! Update temperature if thermal processes requested
+ if (do_thermo) then
+ call tsolve(carma, cstate, iz, scale_threshold, rc)
+ if (rc /= RC_OK) return
+ endif
+
+ ! Update saturation ratios
+ if (do_grow .or. do_thermo) then
+ do igas = 1, NGAS
+ call supersat(carma, cstate, iz, igas, rc)
+ if (rc < RC_OK) return
+
+ ! Check to see how much the supersaturation changed during this step. If it
+ ! has changed to much, then cause a retry.
+ if (t(iz) >= T0) then
+ supsatold = previous_supsatl(igas)
+ supsatnew = supsatl(iz,igas)
+ else
+ supsatold = previous_supsati(igas)
+ supsatnew = supsati(iz,igas)
+ end if
+
+ ! If ds_threshold is positive, then it indicates that the criteria should
+ ! be based on the percentage change in saturation.
+ if (ds_threshold(igas) > 0._f) then
+
+ if (supsatold >= 1.e-4_f) then
+ srat1 = abs(supsatnew / supsatold - 1._f)
+ else
+ srat1 = 0._f
+ end if
+
+ if (supsatnew >= 1.e-4_f) then
+ srat2 = abs(supsatold / supsatnew - 1._f)
+ else
+ srat2 = 0._f
+ end if
+
+ srat = max(srat1, srat2)
+
+ ! Don't let one substep change the supersaturation by too much.
+ if (ds_threshold(igas) > 0._f) then
+! if (srat >= ds_threshold(igas)) then
+ if ((srat >= ds_threshold(igas)) .and. (abs(supsatold - supsatnew) > 0.1_f)) then
+ if (do_substep) then
+ if (nretries == maxretries) then
+ if (do_print) write(LUNOPRT,1) trim(gasname(igas)), iz, &
+ lat, lon, srat, previous_supsati(igas), previous_supsatl(igas), &
+ supsati(iz, igas), supsatl(iz,igas), t(iz)
+ if (do_print) write(LUNOPRT,2) gcl(iz,igas), supsatiold(iz, igas), &
+ supsatlold(iz,igas), told(iz), d_gc(iz, igas), d_t(iz)
+ end if
+
+ rc = RC_WARNING_RETRY
+ else
+ if (do_print) write(LUNOPRT,1) trim(gasname(igas)), iz, lat, lon, &
+ srat, previous_supsati(igas), previous_supsatl(igas), &
+ supsati(iz, igas), supsatl(iz,igas), t(iz)
+ end if
+ end if
+ end if
+
+
+ ! If ds_threshold is negative, then it indicates that the criteria is based
+ ! upon the supersaturation crossing 0, Indicating a shift from growth to
+ ! evaporation and a potential overshoot in the result.
+ else if (ds_threshold(igas) < 0._f) then
+
+ ! Adjust the saturation threshold to allow a worse solution if getting a better
+ ! solution is taking too much time. The particular solution at any individual
+ ! point is probably not going to affect the overall result by too much.
+ s_threshold = abs(ds_threshold(igas))
+
+ if (nretries >= (0.8_f * maxretries)) then
+ s_threshold = 4._f * s_threshold
+ else if (nretries >= (0.7_f * maxretries)) then
+ s_threshold = 3.5_f * s_threshold
+ else if (nretries >= (0.6_f * maxretries)) then
+ s_threshold = 3._f * s_threshold
+ else if (nretries >= (0.5_f * maxretries)) then
+ s_threshold = 2.5_f * s_threshold
+ else if (nretries >= (0.4_f * maxretries)) then
+ s_threshold = 2._f * s_threshold
+ end if
+
+ ! If the supersaturation changed signs, then we went from growth to evaporation
+ ! or vice versa. Don't let the new supersaturation go too far past 0 in one substep.
+ ! This is to prevent overshooting as growth/evaporation should normally stop when
+ ! the supersaturation is 0.
+ if (((supsatnew * supsatold) < 0._f) .and. (abs(supsatnew) > s_threshold)) then
+
+ if (do_substep) then
+ if (nretries == maxretries) then
+ if (do_print) write(LUNOPRT,3) trim(gasname(igas)), iz, &
+ lat, lon, previous_supsati(igas), previous_supsatl(igas), &
+ supsati(iz, igas), supsatl(iz,igas), t(iz)
+ if (do_print) write(LUNOPRT,2) gcl(iz,igas), supsatiold(iz, igas), &
+ supsatlold(iz,igas), told(iz), d_gc(iz, igas), d_t(iz)
+ end if
+ else
+ if (do_print) write(LUNOPRT,3) trim(gasname(igas)), iz, &
+ lat, lon, previous_supsati(igas), previous_supsatl(igas), &
+ supsati(iz, igas), supsatl(iz,igas), t(iz)
+ end if
+
+ rc = RC_WARNING_RETRY
+ end if
+ end if
+ end do
+ endif
+
+
+ ! Update particle densities
+! if (do_grow) then
+! call rhopart(carma, cstate, iz, rc)
+! end if
+
+ ! Return to caller with new particle and gas concentrations.
+ return
+end
diff --git a/src/physics/carma/base/microslow.F90 b/src/physics/carma/base/microslow.F90
new file mode 100644
index 0000000000..11376da0c8
--- /dev/null
+++ b/src/physics/carma/base/microslow.F90
@@ -0,0 +1,61 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine drives the potentially slower microphysics calculations.
+!!
+!! Originally part of microphy. Now in this separate routine to allow
+!! time splitting of coagulation at a different timestep size from
+!! other microphysical calcs.
+!!
+!! @author McKie
+!! @version Sep-1997
+subroutine microslow(carma, cstate, rc)
+
+ ! carma types defs
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local Declarations
+ integer :: ibin
+ integer :: ielem
+
+
+
+ ! Set production terms and loss rates due to slow microphysics
+ ! processes (coagulation) to zero.
+ coagpe(:,:,:) = 0._f
+ coaglg(:,:,:) = 0._f
+
+ ! Calculate (implicit) particle loss rates for coagulation.
+ call coagl(carma, cstate, rc)
+
+ ! Calculate particle production terms and solve for particle
+ ! concentrations at end of time step.
+ !
+ ! NOTE: The order of elements required by CARMA to work with the
+ ! element loop first is: if you have a group that is both a source
+ ! and product of coagulation, then it needs to come after the
+ ! other group that participates in that coagulation in the element
+ ! table. For example, icoag(2,1) = 1 will not work, but
+ ! icoag(2,1) = 2 should work.
+ do ielem = 1,NELEM
+ do ibin = 1,NBIN
+ call coagp(carma, cstate, ibin, ielem, rc)
+ call csolve(carma, cstate, ibin, ielem, rc)
+ enddo
+ enddo
+
+ ! Return to caller with new particle concentrations.
+ return
+end
diff --git a/src/physics/carma/base/mie.F90 b/src/physics/carma/base/mie.F90
new file mode 100644
index 0000000000..92758fb184
--- /dev/null
+++ b/src/physics/carma/base/mie.F90
@@ -0,0 +1,143 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! There are several different algorithms that can be used to solve
+!! a mie calculation for the optical properties of particles. This
+!! routine provides a generic front end to these different mie
+!! routines.
+!!
+!! Current methods are:
+!! miess - Original CARMA code, from Toon and Ackerman, supports core/shell
+!! bhmie - Homogeneous sphere, from Bohren and Huffman, handles wider range of parameters
+!!
+!! @author Chuck Bardeen
+!! @version 2011
+subroutine mie(carma, miertn, radius, wavelength, nmonomer, fractaldim, rmonomer, falpha_in, m, lqext, lqsca, lasym, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carma_mod
+ use fractal_meanfield_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ integer, intent(in) :: miertn !! mie routine enumeration
+ real(kind=f), intent(in) :: radius !! radius (cm)
+ real(kind=f), intent(in) :: wavelength !! wavelength (cm)
+ real(kind=f), intent(in) :: nmonomer !! number of monomers per aggregate [fractal particles only]
+ real(kind=f), intent(in) :: fractaldim !! fractal dimension [fractal particles only]
+ real(kind=f), intent(in) :: rmonomer !! monomer size (units?) [fractal particles only]
+ real(kind=f), intent(in) :: falpha_in !! packing coefficient [fractal particles only]
+ complex(kind=f), intent(in) :: m !! refractive index particle
+ real(kind=f), intent(out) :: lqext !! EFFICIENCY FACTOR FOR EXTINCTION
+ real(kind=f), intent(out) :: lqsca !! EFFICIENCY FACTOR FOR SCATTERING
+ real(kind=f), intent(out) :: lasym !! asymmetry factor
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+
+ integer, parameter :: nang = 10 ! Number of angles
+
+ real(kind=f) :: theta(IT)
+ real(kind=f) :: wvno
+ real(kind=f) :: rfr
+ real(kind=f) :: rfi
+ real(kind=f) :: x
+ real(kind=f) :: qback
+ real(kind=f) :: ctbrqs
+ complex(kind=f) :: s1(2*nang-1)
+ complex(kind=f) :: s2(2*nang-1)
+ real(kind=f) :: rmonomer_out
+ real(kind=f) :: fractaldim_out
+
+ ! Calculate the wave number.
+ wvno = 2._f * PI / wavelength
+
+ ! Select the appropriate routine.
+ if (miertn == I_MIERTN_TOON1981) then
+
+ ! We only care about the forward direction.
+ theta(:) = 0.0_f
+
+ rfr = real(m)
+ rfi = aimag(m)
+
+ call miess(carma, &
+ radius, &
+ rfr, &
+ rfi, &
+ theta, &
+ 1, &
+ lqext, &
+ lqsca, &
+ qback,&
+ ctbrqs, &
+ 0.0_f, &
+ rfr, &
+ rfi, &
+ wvno, &
+ rc)
+
+ lasym = ctbrqs / lqsca
+
+ else if (miertn == I_MIERTN_BOHREN1983) then
+
+ x = radius * wvno
+
+ call bhmie(carma, &
+ x, &
+ m, &
+ nang, &
+ s1, &
+ s2, &
+ lqext, &
+ lqsca, &
+ qback, &
+ lasym, &
+ rc)
+
+ else if (miertn == I_MIERTN_BOTET1997) then
+
+ rfr = real(m)
+ rfi = aimag(m)
+
+ if (radius .le. rmonomer) then
+ rmonomer_out = radius
+ fractaldim_out = 3.0_f
+ else
+ rmonomer_out = rmonomer
+ fractaldim_out = fractaldim
+ end if
+
+ call fractal_meanfield(carma, & !! carma object
+ wavelength*1.0e4_f, & !! lambda in microns
+ rfi, & !! imaginary index of refraction
+ rfr, & !! real index of refraction
+ nmonomer, & !! number of monomers
+ falpha_in, & !! packing coefficient
+ fractaldim_out, & !! fractal dimension
+ rmonomer_out, & !! monomer size
+ 1.0_f, & !! xv,"set to 1"
+ 0.0_f, & !! angle, set to 0
+ lqext, & !! extinction efficiency
+ lqsca, & !! scattering efficiency
+ lasym, & !! asymmetry parameter
+ rc)
+
+ else
+ if (do_print) write(LUNOPRT, *) "mie::Unknown Mie routine specified."
+ rc = RC_ERROR
+ end if
+
+ ! The mie code isn't perfect, so don't let it return values that aren't
+ ! physical.
+ lqext = max(lqext, 0._f)
+ lqsca = max(0._f, min(lqext, lqsca))
+ lasym = max(-1.0_f, min(1.0_f, lasym))
+
+ return
+end subroutine mie
diff --git a/src/physics/carma/base/miess.F90 b/src/physics/carma/base/miess.F90
new file mode 100644
index 0000000000..0cca466da9
--- /dev/null
+++ b/src/physics/carma/base/miess.F90
@@ -0,0 +1,496 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This subroutine computes mie scattering by a stratified sphere,
+!! i.e. a particle consisting of a spherical core surrounded by a
+!! Spherical shell. The basic code used was that described in the
+!! report: " Subroutines for computing the parameters of the
+!! electromagnetic radiation scattered by a sphere " J.V. Dave,
+!! IBM Scientific Center, Palo Alto , California.
+!! Report No. 320 - 3236 .. May 1968 .
+!!
+!! The modifications for stratified spheres are described in
+!! Toon and Ackerman, Appl. Optics, in press, 1981
+!!
+!! The definitions for the output parameters can be found in "Light
+!! scattering by small particles, H.C.Van de Hulst, John Wiley '
+!! Sons, Inc., New York, 1957".
+!!
+!! Also the subroutine computes the capital A function by making use of
+!! downward recurrence relationship.
+!!
+!! @author Brian Toon
+!! @version 1981?
+SUBROUTINE miess(carma,RO,RFR,RFI,THETD,JX,QEXT,QSCAT,QBS,CTBRQS,R,RE2,TMAG2,WVNO,rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_constants_mod, only : IT, DEG2RAD
+ use carma_enums_mod, only : RC_ERROR
+ use carma_types_mod, only : carma_type
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ real(kind=f), intent(in) :: RO !! OUTER (SHELL) RADIUS
+ real(kind=f), intent(in) :: RFR !! REAL PART OF THE SHELL INDEX OF REFRACTION
+ real(kind=f), intent(in) :: RFI !! IMAGINARY PART OF THE SHELL INDEX OF REFRACTION
+ real(kind=f), intent(in) :: R !! CORE RADIUS
+ real(kind=f), intent(in) :: RE2 !! REAL PART OF THE CORE INDEX OF REFRACTION
+ real(kind=f), intent(in) :: TMAG2 !! IMAGINARY PART OF THE CORE INDEX OF REFRACTION
+
+ !! ANGLE IN DEGREES BETWEEN THE DIRECTIONS OF THE INCIDENT
+ !! AND THE SCATTERED RADIATION. THETD(J) IS< OR= 90.0
+ !! IF THETD(J) SHOULD HAPPEN TO BE GREATER THAN 90.0, ENTER WITH
+ !! SUPPLEMENTARY VALUE, SEE COMMENTS ON ELTRMX.
+ real(kind=f), intent(inout) :: THETD(IT)
+
+ !! TOTAL NUMBER OF THETD FOR WHICH THE COMPUTATIONS ARE
+ !! REQUIRED. JX SHOULD NOT EXCEED IT UNLESS THE DIMENSIONS
+ !! STATEMENTS ARE APPROPRIATEDLY MODIFIED.
+ integer, intent(in) :: JX
+
+ real(kind=f), intent(out) :: QEXT !! EFFICIENCY FACTOR FOR EXTINCTION,VAN DE HULST,P.14 ' 127.
+ real(kind=f), intent(out) :: QSCAT !! EFFICIENCY FACTOR FOR SCATTERING,V.D. HULST,P.14 ' 127.
+ real(kind=f), intent(out) :: QBS !! BACK SCATTER CROSS SECTION.
+ real(kind=f), intent(out) :: CTBRQS !! AVERAGE(COSINE THETA) * QSCAT,VAN DE HULST,P.128.
+ real(kind=f), intent(in) :: WVNO !! 2*PI / WAVELENGTH.
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ real(kind=f), parameter :: EPSILON_MIE = 1.e-14_f
+
+ integer :: I
+ integer :: J
+ integer :: K
+ integer :: M
+ integer :: N
+ integer :: NN
+ integer :: NMX1
+ integer :: NMX2
+ integer :: IFLAG
+ integer :: IACAP
+
+ ! FNAP, FNBP ARE THE PRECEDING VALUES OF FNA, FNB RESPECTIVELY.
+ complex(kind=f) :: FNAP, FNBP, &
+ FNA, FNB, RF, RRF, &
+ RRFX, WM1, FN1, FN2, &
+ TC1, TC2, WFN(2), Z(4), &
+ K1, K2, K3, &
+ RCR, U(8), DH1, &
+ DH2, DH4, P24H24, P24H21, &
+ PSTORE, HSTORE, DUMMY, DUMSQ
+
+ complex(kind=f), allocatable :: ACAP(:), W(:,:)
+
+
+ ! TA(1): REAL PART OF WFN(1). TA(2): IMAGINARY PART OF WFN(1).
+ ! TA(3): REAL PART OF WFN(2). TA(4): IMAGINARY PART OF WFN(2).
+ real(kind=f) :: T(5), TA(4), &
+ PI(3,IT), TAU(3,IT), CSTHT(IT), SI2THT(IT), &
+ X, X1, X4, Y1, Y4, RX, SINX1, SINX4, COSX1, COSX4, &
+ EY1, E2Y1, EY4, EY1MY4, EY1PY4, AA, BB, CC, DD, DENOM, &
+ REALP, AMAGP, QBSR, QBSI, RMM, PIG, RXP4
+
+ !! ELTRMX(I,J,K): ELEMENTS OF THE TRANSFORMATION MATRIX F,V.D.HULST,P.34,45 ' 125.
+ !! I=1: ELEMENT M SUB 2..I=2: ELEMENT M SUB 1..
+ !! I = 3: ELEMENT S SUB 21.. I = 4: ELEMENT D SUB 21..
+ !! ELTRMX(I,J,1) REPRESENTS THE ITH ELEMENT OF THE MATRIX FOR
+ !! THE ANGLE THETD(J).. ELTRMX(I,J,2) REPRESENTS THE ITH ELEMENT
+ !! OF THE MATRIX FOR THE ANGLE 180.0 - THETD(J) ..
+ real(kind=f) :: ELTRMX(4,IT,2)
+
+
+ ! IF THE CORE IS SMALL SCATTERING IS COMPUTED FOR THE SHELL ONLY
+ IFLAG = 1
+ if ( R/RO .LT. 1.e-6_f ) IFLAG = 2
+
+ if ( JX .gt. IT ) then
+ if (do_print) then
+ write(LUNOPRT, '(a,i3,a)') "miess:: The value of the argument JX=", &
+ JX, " is greater than IT."
+ end if
+ rc = RC_ERROR
+ return
+ endif
+
+ RF = CMPLX( RFR, -RFI, kind=f )
+ RCR = CMPLX( RE2, -TMAG2, kind=f )
+ X = RO * WVNO
+ K1 = RCR * WVNO
+ K2 = RF * WVNO
+ K3 = CMPLX( WVNO, 0.0_f, kind=f )
+ Z(1) = K2 * RO
+ Z(2) = K3 * RO
+ Z(3) = K1 * R
+ Z(4) = K2 * R
+ X1 = REAL( Z(1) )
+ X4 = REAL( Z(4) )
+ Y1 = aimag( Z(1) )
+ Y4 = aimag( Z(4) )
+ RRF = 1.0_f / RF
+ RX = 1.0_f / X
+ RRFX = RRF * RX
+ T(1) = ( X**2 ) * ( RFR**2 + RFI**2 )
+ T(1) = SQRT( T(1) )
+ NMX1 = 1.10_f * T(1)
+
+ ! The dimension of ACAP.
+ !
+ ! In the original program the dimension of ACAP was 7000.
+ ! For conserving space this should be not much higher than
+ ! The value, NMX1=1.1*(NREAL**2 + NIMAG**2)**.5 * X + 1
+ IACAP = max(7000, int(1.5_f * NMX1))
+ allocate(ACAP(IACAP))
+ allocate(W(3,IACAP))
+
+ NMX2 = T(1)
+
+ if ( NMX1 .le. 150 ) then
+ NMX1 = 150
+ NMX2 = 135
+ endif
+
+ ACAP( NMX1+1 ) = ( 0.0_f, 0.0_f )
+
+ if ( IFLAG .ne. 2 ) then
+ do N = 1,3
+ W( N,NMX1+1 ) = ( 0.0_f, 0.0_f )
+ enddo
+ endif
+
+ do N = 1,NMX1
+ NN = NMX1 - N + 1
+ ACAP(NN) = (NN+1) * RRFX - 1.0_f / ( (NN+1) * RRFX + ACAP(NN+1) )
+ if ( IFLAG .ne. 2 ) then
+ do M = 1,3
+ W( M,NN ) = (NN+1) / Z(M+1) - &
+ 1.0_f / ( (NN+1) / Z(M+1) + W( M,NN+1 ) )
+ enddo
+ endif
+ enddo
+
+ do J = 1,JX
+ if ( THETD(J) .lt. 0.0 ) THETD(J) = ABS( THETD(J) )
+
+ if ( THETD(J) .le. 0.0 ) then
+ CSTHT(J) = 1.0_f
+ SI2THT(J) = 0.0_f
+ else if ( THETD(J) .lt. 90.0_f ) then
+ T(1) = THETD(J) * DEG2RAD
+ CSTHT(J) = COS( T(1) )
+ SI2THT(J) = 1.0_f - CSTHT(J)**2
+ else if ( THETD(J) .le. 90.0_f ) then
+ CSTHT(J) = 0.0_f
+ SI2THT(J) = 1.0_f
+ else
+ if (do_print) then
+ write(LUNOPRT, '(a,i3)') "miess:: The value of the scattering angle &
+ &is greater than 90.0 Degrees. It is .", THETD(J)
+ end if
+ rc = RC_ERROR
+ return
+ end if
+ enddo
+
+ do J = 1,JX
+ PI(1,J) = 0.0_f
+ PI(2,J) = 1.0_f
+ TAU(1,J) = 0.0_f
+ TAU(2,J) = CSTHT(J)
+ enddo
+
+ ! INITIALIZATION OF HOMOGENEOUS SPHERE
+ T(1) = COS(X)
+ T(2) = SIN(X)
+ WM1 = CMPLX( T(1),-T(2), kind=f )
+ WFN(1) = CMPLX( T(2), T(1), kind=f )
+ TA(1) = T(2)
+ TA(2) = T(1)
+ WFN(2) = RX * WFN(1) - WM1
+ TA(3) = REAL(WFN(2))
+ TA(4) = aimag(WFN(2))
+
+ if ( IFLAG .ne. 2 ) then
+ N = 1
+
+ ! INITIALIZATION PROCEDURE FOR STRATIFIED SPHERE BEGINS HERE
+ SINX1 = SIN( X1 )
+ SINX4 = SIN( X4 )
+ COSX1 = COS( X1 )
+ COSX4 = COS( X4 )
+ EY1 = EXP( Y1 )
+ E2Y1 = EY1 * EY1
+ EY4 = EXP( Y4 )
+ EY1MY4 = EXP( Y1 - Y4 )
+ EY1PY4 = EY1 * EY4
+ EY1MY4 = EXP( Y1 - Y4 )
+ AA = SINX4 * ( EY1PY4 + EY1MY4 )
+ BB = COSX4 * ( EY1PY4 - EY1MY4 )
+ CC = SINX1 * ( E2Y1 + 1.0 )
+ DD = COSX1 * ( E2Y1 - 1.0 )
+ DENOM = 1.0_f + E2Y1 * ( 4.0_f * SINX1 * SINX1 - 2.0_f + E2Y1 )
+ REALP = ( AA * CC + BB * DD ) / DENOM
+ AMAGP = ( BB * CC - AA * DD ) / DENOM
+ DUMMY = CMPLX( REALP, AMAGP, kind=f )
+ AA = SINX4 * SINX4 - 0.5_f
+ BB = COSX4 * SINX4
+ P24H24 = 0.5_f + CMPLX( AA,BB, kind=f ) * EY4 * EY4
+ AA = SINX1 * SINX4 - COSX1 * COSX4
+ BB = SINX1 * COSX4 + COSX1 * SINX4
+ CC = SINX1 * SINX4 + COSX1 * COSX4
+ DD = -SINX1 * COSX4 + COSX1 * SINX4
+ P24H21 = 0.5_f * CMPLX( AA,BB, kind=f ) * EY1 * EY4 + 0.5_f * CMPLX( CC,DD, kind=f ) * EY1MY4
+ DH4 = Z(4) / ( 1.0_f + ( 0.0_f, 1.0_f ) * Z(4) ) - 1.0_f / Z(4)
+ DH1 = Z(1) / ( 1.0_f + ( 0.0_f, 1.0_f ) * Z(1) ) - 1.0_f / Z(1)
+ DH2 = Z(2) / ( 1.0_f + ( 0.0_f, 1.0_f ) * Z(2) ) - 1.0_f / Z(2)
+ PSTORE = ( DH4 + N / Z(4) ) * ( W(3,N) + N / Z(4) )
+ P24H24 = P24H24 / PSTORE
+ HSTORE = ( DH1 + N / Z(1) ) * ( W(3,N) + N / Z(4) )
+ P24H21 = P24H21 / HSTORE
+ PSTORE = ( ACAP(N) + N / Z(1) ) / ( W(3,N) + N / Z(4) )
+ DUMMY = DUMMY * PSTORE
+ DUMSQ = DUMMY * DUMMY
+
+ ! NOTE: THE DEFINITIONS OF U(I) IN THIS PROGRAM ARE NOT THE SAME AS
+ ! THE USUBI DEFINED IN THE ARTICLE BY TOON AND ACKERMAN. THE
+ ! CORRESPONDING TERMS ARE:
+ ! USUB1 = U(1) USUB2 = U(5)
+ ! USUB3 = U(7) USUB4 = DUMSQ
+ ! USUB5 = U(2) USUB6 = U(3)
+ ! USUB7 = U(6) USUB8 = U(4)
+ ! RATIO OF SPHERICAL BESSEL FTN TO SPHERICAL HENKAL FTN = U(8)
+
+ U(1) = K3 * ACAP(N) - K2 * W(1,N)
+ U(2) = K3 * ACAP(N) - K2 * DH2
+ U(3) = K2 * ACAP(N) - K3 * W(1,N)
+ U(4) = K2 * ACAP(N) - K3 * DH2
+ U(5) = K1 * W(3,N) - K2 * W(2,N)
+ U(6) = K2 * W(3,N) - K1 * W(2,N)
+ U(7) = ( 0.0_f, -1.0_f ) * ( DUMMY * P24H21 - P24H24 )
+ U(8) = TA(3) / WFN(2)
+
+ FNA = U(8) * ( U(1)*U(5)*U(7) + K1*U(1) - DUMSQ*K3*U(5) ) / &
+ ( U(2)*U(5)*U(7) + K1*U(2) - DUMSQ*K3*U(5) )
+ FNB = U(8) * ( U(3)*U(6)*U(7) + K2*U(3) - DUMSQ*K2*U(6) ) / &
+ ( U(4)*U(6)*U(7) + K2*U(4) - DUMSQ*K2*U(6) )
+ else
+ TC1 = ACAP(1) * RRF + RX
+ TC2 = ACAP(1) * RF + RX
+ FNA = ( TC1 * TA(3) - TA(1) ) / ( TC1 * WFN(2) - WFN(1) )
+ FNB = ( TC2 * TA(3) - TA(1) ) / ( TC2 * WFN(2) - WFN(1) )
+ endif
+
+ FNAP = FNA
+ FNBP = FNB
+ T(1) = 1.50_f
+
+ ! FROM HERE TO THE STATMENT NUMBER 90, ELTRMX(I,J,K) HAS
+ ! FOLLOWING MEANING:
+ ! ELTRMX(1,J,K): REAL PART OF THE FIRST COMPLEX AMPLITUDE.
+ ! ELTRMX(2,J,K): IMAGINARY PART OF THE FIRST COMPLEX AMPLITUDE.
+ ! ELTRMX(3,J,K): REAL PART OF THE SECOND COMPLEX AMPLITUDE.
+ ! ELTRMX(4,J,K): IMAGINARY PART OF THE SECOND COMPLEX AMPLITUDE.
+ ! K = 1 : FOR THETD(J) AND K = 2 : FOR 180.0 - THETD(J)
+ ! DEFINITION OF THE COMPLEX AMPLITUDE: VAN DE HULST,P.125.
+ FNA = T(1) * FNA
+ FNB = T(1) * FNB
+
+ do J = 1,JX
+ TC1 = FNA * PI(2,J) + FNB * TAU(2,J)
+ TC2 = FNB * PI(2,J) + FNA * TAU(2,J)
+ ELTRMX(1,J,1) = real(TC1)
+ ELTRMX(2,J,1) = aimag(TC1)
+ ELTRMX(3,J,1) = real(TC2)
+ ELTRMX(4,J,1) = aimag(TC2)
+ TC1 = FNA * PI(2,J) - FNB * TAU(2,J)
+ TC2 = FNB * PI(2,J) - FNA * TAU(2,J)
+ ELTRMX(1,J,2) = real(TC1)
+ ELTRMX(2,J,2) = aimag(TC1)
+ ELTRMX(3,J,2) = real(TC2)
+ ELTRMX(4,J,2) = aimag(TC2)
+ enddo
+
+ QEXT = 2.0_f * ( real(FNA) + real(FNB) )
+ QSCAT = ( real(FNA)**2 + aimag(FNA)**2 + &
+ real(FNB)**2 + aimag(FNB)**2 ) / 0.75_f
+ CTBRQS = 0.0_f
+ TC1 = -2.0_f * (FNB - FNA)
+ QBSR = real(TC1)
+ QBSI = aimag(TC1)
+ RMM = -1.0_f
+ N = 2
+
+ ! Iterate until the answer converges.
+ T(4) = EPSILON_MIE
+
+ do while ( T(4) .ge. EPSILON_MIE )
+
+ T(1) = 2*N - 1
+ T(2) = N - 1
+ T(3) = 2*N + 1
+
+ do J = 1,JX
+ PI(3,J) = ( T(1) * PI(2,J) * CSTHT(J) - N * PI(1,J) ) / T(2)
+ TAU(3,J) = CSTHT(J) * ( PI(3,J) - PI(1,J) ) - &
+ T(1) * SI2THT(J) * PI(2,J) + TAU(1,J)
+ end do
+
+ ! HERE SET UP HOMOGENEOUS SPHERE
+ WM1 = WFN(1)
+ WFN(1) = WFN(2)
+ TA(1) = REAL(WFN(1))
+ TA(2) = aimag(WFN(1))
+ TA(4) = aimag(WFN(2))
+ WFN(2) = T(1) * RX * WFN(1) - WM1
+ TA(3) = REAL(WFN(2))
+
+ if ( IFLAG .ne. 2 ) then
+
+ ! HERE SET UP STRATIFIED SPHERE
+ DH2 = - N / Z(2) + 1.0_f / ( N / Z(2) - DH2 )
+ DH4 = - N / Z(4) + 1.0_f / ( N / Z(4) - DH4 )
+ DH1 = - N / Z(1) + 1.0_f / ( N / Z(1) - DH1 )
+ PSTORE = ( DH4 + N / Z(4) ) * ( W(3,N) + N / Z(4) )
+ P24H24 = P24H24 / PSTORE
+ HSTORE = ( DH1 + N / Z(1) ) * ( W(3,N) + N / Z(4) )
+ P24H21 = P24H21 / HSTORE
+ PSTORE = ( ACAP(N) + N / Z(1) ) / ( W(3,N) + N / Z(4) )
+ DUMMY = DUMMY * PSTORE
+ DUMSQ = DUMMY * DUMMY
+
+ U(1) = K3 * ACAP(N) - K2 * W(1,N)
+ U(2) = K3 * ACAP(N) - K2 * DH2
+ U(3) = K2 * ACAP(N) - K3 * W(1,N)
+ U(4) = K2 * ACAP(N) - K3 * DH2
+ U(5) = K1 * W(3,N) - K2 * W(2,N)
+ U(6) = K2 * W(3,N) - K1 * W(2,N)
+ U(7) = ( 0.0_f, -1.0_f ) * ( DUMMY * P24H21 - P24H24 )
+ U(8) = TA(3) / WFN(2)
+
+ FNA = U(8) * ( U(1)*U(5)*U(7) + K1*U(1) - DUMSQ*K3*U(5) ) / &
+ ( U(2)*U(5)*U(7) + K1*U(2) - DUMSQ*K3*U(5) )
+ FNB = U(8) * ( U(3)*U(6)*U(7) + K2*U(3) - DUMSQ*K2*U(6) ) / &
+ ( U(4)*U(6)*U(7) + K2*U(4) - DUMSQ*K2*U(6) )
+ endif
+
+ TC1 = ACAP(N) * RRF + N * RX
+ TC2 = ACAP(N) * RF + N * RX
+ FN1 = ( TC1 * TA(3) - TA(1) ) / ( TC1 * WFN(2) - WFN(1) )
+ FN2 = ( TC2 * TA(3) - TA(1) ) / ( TC2 * WFN(2) - WFN(1) )
+ M = WVNO * R
+
+ if ( N .ge. M ) then
+ if ( IFLAG .ne. 2 ) then
+ if ( abs( ( FN1-FNA ) / FN1 ) .LT. EPSILON_MIE .AND. &
+ abs( ( FN2-FNB ) / FN2 ) .LT. EPSILON_MIE ) IFLAG = 2
+
+ if ( IFLAG .ne. 1 ) then
+ FNA = FN1
+ FNB = FN2
+ endif
+ else
+ FNA = FN1
+ FNB = FN2
+ endif
+ endif
+
+ T(5) = N
+ T(4) = T(1) / ( T(5) * T(2) )
+ T(2) = ( T(2) * ( T(5) + 1.0_f ) ) / T(5)
+
+ CTBRQS = CTBRQS + T(2) * ( real(FNAP) * real(FNA) + &
+ aimag(FNAP) *aimag(FNA) &
+ + real(FNBP) * real(FNB) + &
+ aimag(FNBP) *aimag(FNB) ) &
+ + T(4) * ( real(FNAP) * real(FNBP) + &
+ aimag(FNAP) *aimag(FNBP) )
+ QEXT = QEXT + T(3) * ( real(FNA) + real(FNB) )
+
+ ! $ T(3), real(FNA), real(FNB), QEXT
+ T(4) = real(FNA)**2 + aimag(FNA)**2 + &
+ real(FNB)**2 + aimag(FNB)**2
+ QSCAT = QSCAT + T(3) * T(4)
+ RMM = -RMM
+ TC1 = T(3)*RMM*(FNB - FNA)
+ QBSR = QBSR + real(TC1)
+ QBSI = QBSI + aimag(TC1)
+
+ T(2) = N * (N+1)
+ T(1) = T(3) / T(2)
+ K = (N/2)*2
+
+ do J = 1,JX
+ TC1 = FNA * PI(3,J) + FNB * TAU(3,J)
+ TC2 = FNB * PI(3,J) + FNA * TAU(3,J)
+ ELTRMX(1,J,1) = ELTRMX(1,J,1)+T(1)* real(TC1)
+ ELTRMX(2,J,1) = ELTRMX(2,J,1)+T(1)*aimag(TC1)
+ ELTRMX(3,J,1) = ELTRMX(3,J,1)+T(1)* real(TC2)
+ ELTRMX(4,J,1) = ELTRMX(4,J,1)+T(1)*aimag(TC2)
+
+ IF ( K .EQ. N ) THEN
+ TC1 = -FNA * PI(3,J) + FNB * TAU(3,J)
+ TC2 = -FNB * PI(3,J) + FNA * TAU(3,J)
+ ELSE
+ TC1 = FNA * PI(3,J) - FNB * TAU(3,J)
+ TC2 = FNB * PI(3,J) - FNA * TAU(3,J)
+ END IF
+ ELTRMX(1,J,2) = ELTRMX(1,J,2)+T(1)* real(TC1)
+ ELTRMX(2,J,2) = ELTRMX(2,J,2)+T(1)*aimag(TC1)
+ ELTRMX(3,J,2) = ELTRMX(3,J,2)+T(1)* real(TC2)
+ ELTRMX(4,J,2) = ELTRMX(4,J,2)+T(1)*aimag(TC2)
+
+ enddo
+
+ if ( T(4) .ge. EPSILON_MIE ) then
+ N = N + 1
+
+ do J = 1,JX
+ PI(1,J) = PI(2,J)
+ PI(2,J) = PI(3,J)
+ TAU(1,J) = TAU(2,J)
+ TAU(2,J) = TAU(3,J)
+ enddo
+
+ FNAP = FNA
+ FNBP = FNB
+
+ if ( N .gt. NMX2 ) then
+ if (do_print) write(LUNOPRT, '(a)') "miess:: The upper limit for acap is not enough."
+ rc = RC_ERROR
+ return
+ endif
+ endif
+ enddo
+
+ ! Calculate the results.
+ do J = 1,JX
+ do K = 1,2
+ do I= 1,4
+ T(I) = ELTRMX(I,J,K)
+ enddo
+
+ ELTRMX(2,J,K) = T(1)**2 + T(2)**2
+ ELTRMX(1,J,K) = T(3)**2 + T(4)**2
+ ELTRMX(3,J,K) = T(1) * T(3) + T(2) * T(4)
+ ELTRMX(4,J,K) = T(2) * T(3) - T(4) * T(1)
+ enddo
+ enddo
+
+ T(1) = 2.0_f * RX**2
+ QEXT = QEXT * T(1)
+ QSCAT = QSCAT * T(1)
+ CTBRQS = 2.0_f * CTBRQS * T(1)
+
+ ! QBS IS THE BACK SCATTER CROSS SECTION
+ PIG = ACOS(-1.0_f)
+ RXP4 = RX*RX/(4.0_f*PIG)
+ QBS = RXP4*(QBSR**2 + QBSI**2)
+
+ deallocate(ACAP)
+ deallocate(W)
+
+ return
+end
diff --git a/src/physics/carma/base/newstate.F90 b/src/physics/carma/base/newstate.F90
new file mode 100644
index 0000000000..f1762f1754
--- /dev/null
+++ b/src/physics/carma/base/newstate.F90
@@ -0,0 +1,245 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine manages the calculations that update state variables
+!! of the model with new values at the current simulation time.
+!!
+!! @author Bardeen
+!! @version Jan 2012
+subroutine newstate(carma, cstate, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ real(kind=f) :: pc_orig(NZ,NBIN,NELEM)
+ real(kind=f) :: gc_orig(NZ,NGAS)
+ real(kind=f) :: t_orig(NZ)
+ real(kind=f) :: cldfrc_orig(NZ)
+ real(kind=f) :: scale_cldfrc(NZ)
+ real(kind=f) :: pc_cloudy(NZ,NBIN,NELEM)
+ real(kind=f) :: gc_cloudy(NZ,NGAS)
+ real(kind=f) :: t_cloudy(NZ)
+ real(kind=f) :: rlheat_cloudy(NZ)
+ real(kind=f) :: partheat_cloudy(NZ)
+ real(kind=f) :: zsubsteps_cloudy(NZ)
+ real(kind=f) :: pc_clear(NZ,NBIN,NELEM)
+ real(kind=f) :: gc_clear(NZ,NGAS)
+ real(kind=f) :: t_clear(NZ)
+ real(kind=f) :: rlheat_clear(NZ)
+ real(kind=f) :: partheat_clear(NZ)
+ real(kind=f) :: zsubsteps_clear(NZ)
+ real(kind=f) :: scale_threshold(NZ)
+ integer :: igroup
+ integer :: igas
+ integer :: ielem
+ integer :: ibin
+ integer :: iz
+
+
+ ! Calculate changes due to vertical transport
+ if (do_vtran) then
+
+ call vertical(carma, cstate, rc)
+ if (rc < RC_OK) return
+ endif
+
+
+ ! There can be two phases to the microphysics: in-cloud and clear sky. Particles
+ ! that are tagged as "In-cloud" will only be processed in the in-cloud loop, and their
+ ! concentrations will be scaled by the cloud fraction since it is assumed to be all
+ ! in-cloud. Other particle types will be process in-cloud and out of cloud; however,
+ ! their mass is assumed to be a gridbox average.
+
+ ! If doing doing in-cloud processing, then scale the parameters for in-cloud concentrations.
+ !
+ ! NOTE: Don't want to do this before sedimentation, since sedimentation doesn't take into
+ ! account the varying cloud fractions, and thus a particle scaled at one level and cloud
+ ! fraction would be scaled inappropriately at another level and cloud fraction.
+ !
+ ! NOTE: All detrainment also happens only in the in-cloud portion.
+ if (do_incloud) then
+
+ ! First do the in-cloud processing.
+
+ ! Convert "cloud" particles to in-cloud values.
+ !
+ ! NOTE: If a particle is a "cloud" particle, it means that the entire mass of the
+ ! particle is in the incloud portion of the grid box. Particle that are not "cloud
+ ! particles" have their mass spread throughout the grid box.
+ pc_orig(:,:,:) = pc(:,:,:)
+ gc_orig(:,:) = gc(:,:)
+ t_orig(:) = t(:)
+
+ ! If the cloud fraction gets too small it causes the microphysics to require a
+ ! lot of substeps. Enforce a minimum cloud fraction for the purposes of scaling
+ ! to incloud values.
+ scale_cldfrc(:) = max(CLDFRC_MIN, cldfrc(:))
+ scale_cldfrc(:) = min(1._f - CLDFRC_MIN, scale_cldfrc(:))
+
+ do ielem = 1, NELEM
+ igroup = igelem(ielem)
+
+ if (is_grp_cloud(igroup)) then
+ do ibin = 1, NBIN
+ pc(:, ibin, ielem) = pc(:, ibin, ielem) / scale_cldfrc(:)
+ pcd(:, ibin, ielem) = pcd(:, ibin, ielem) / scale_cldfrc(:)
+ end do
+ end if
+ end do
+
+ call newstate_calc(carma, cstate, scale_cldfrc(:), rc)
+ if (rc < RC_OK) return
+
+ ! Save the new in-cloud values for the gas, particle and temperature fields.
+ pc_cloudy(:,:,:) = pc(:,:,:)
+ gc_cloudy(:,:) = gc(:,:)
+ t_cloudy(:) = t(:)
+ rlheat_cloudy(:) = rlheat(:)
+ partheat_cloudy(:) = partheat(:)
+
+ if (do_substep) zsubsteps_cloudy(:) = zsubsteps(:)
+
+
+
+ ! Now do the clear sky portion, using the original gridbox average concentrations.
+ ! This is optional. If clear sky is not selected then all of the microphysics is
+ ! done in-cloud.
+ pc(:,:,:) = pc_orig(:,:,:)
+ gc(:,:) = gc_orig(:,:)
+ t(:) = t_orig(:)
+
+ if (do_clearsky) then
+
+ ! Convert "cloud" particles to clear sky values.
+ !
+ ! NOTE: If a particle is a "cloud" particle, it means that the entire mass of the
+ ! particle is in the in-cloud portion of the grid box. They have no mass in the
+ ! clear sky portion.
+ do ielem = 1, NELEM
+ igroup = igelem(ielem)
+
+ if (is_grp_cloud(igroup)) then
+ pc(:, :, ielem) = 0._f
+ pcd(:, :, ielem) = 0._f
+ end if
+ end do
+
+ ! Don't let the supersaturation be scaled by setting the cloud fraction used
+ ! by the saturation code to 1.0. Any clouds formed in-situ in the clear sky
+ ! are assumed to fill the grid box.
+ cldfrc_orig(:) = cldfrc(:)
+ cldfrc(:) = 1._f
+
+ ! Recalculate supersaturation.
+ do igas = 1, NGAS
+ do iz = 1, NZ
+ call supersat(carma, cstate, iz, igas, rc)
+ if (rc < RC_OK) return
+ end do
+ end do
+
+ call newstate_calc(carma, cstate, (1._f - scale_cldfrc(:)), rc)
+ if (rc < RC_OK) return
+
+ ! Restore the cloud fraction
+ cldfrc(:) = cldfrc_orig(:)
+
+ ! Save the new clear sky values for the gas, particle and temperature fields.
+ pc_clear(:,:,:) = pc(:,:,:)
+ gc_clear(:,:) = gc(:,:)
+ t_clear(:) = t(:)
+ rlheat_clear(:) = rlheat(:)
+ partheat_clear(:) = partheat(:)
+
+ if (do_substep) zsubsteps_clear(:) = zsubsteps(:)
+
+ ! If not doing a clear sky calculation, then the clear sky portion reamins
+ ! the same except for any contribution from advection.
+ else
+
+ ! NOTE: If a particle is a "cloud" particle, it means that the entire mass of the
+ ! particle is in the in-cloud portion of the grid box. They have no mass in the
+ ! clear sky portion.
+ do ielem = 1, NELEM
+ igroup = igelem(ielem)
+
+ if (is_grp_cloud(igroup)) then
+ pc_clear(:, :, ielem) = 0._f
+ else
+ pc_clear(:, :, ielem) = pc(:, :, ielem)
+ end if
+ end do
+
+ do igas = 1, NGAS
+ gc_clear(:,:) = gc(:,:)
+ end do
+
+ t_clear(:) = t(:)
+ rlheat_clear(:) = 0._f
+ partheat_clear(:) = 0._f
+
+ ! If substepping, then add the advected part that is being doled out over
+ ! the substeps.
+ if (do_substep) then
+ do igas = 1, NGAS
+ gc_clear(:, igas) = gc_clear(:, igas) + d_gc(:, igas)
+ end do
+ t_clear(:) = t_clear(:) + d_t(:)
+
+ zsubsteps_clear(:) = 0._f
+ end if
+ end if
+
+
+ ! Add up the changes to the particle from the cloudy and clear sky components.
+ do ielem = 1, NELEM
+ igroup = igelem(ielem)
+
+ do ibin = 1, NBIN
+ pc(:, ibin, ielem) = (1._f - scale_cldfrc(:)) * pc_clear(:, ibin, ielem) + scale_cldfrc(:) * pc_cloudy(:, ibin, ielem)
+ end do
+ end do
+
+ t(:) = (1._f - scale_cldfrc(:)) * t_clear(:) + scale_cldfrc(:) * t_cloudy(:)
+
+ if (do_grow) then
+ rlheat(:) = (1._f - scale_cldfrc(:)) * rlheat_clear(:) + scale_cldfrc(:) * rlheat_cloudy(:)
+ partheat(:) = (1._f - scale_cldfrc(:)) * partheat_clear(:) + scale_cldfrc(:) * partheat_cloudy(:)
+ end if
+
+ do igas = 1, NGAS
+ gc(:, igas) = (1._f - scale_cldfrc(:)) * gc_clear(:, igas) + scale_cldfrc(:) * gc_cloudy(:, igas)
+
+ ! Recalculate gridbox average supersaturation.
+ do iz = 1, NZ
+ call supersat(carma, cstate, iz, igas, rc)
+ if (rc < RC_OK) return
+ end do
+ end do
+
+ if (do_substep) zsubsteps(:) = zsubsteps_clear(:) + zsubsteps_cloudy(:)
+
+
+
+ ! No special in-cloud/clear sky processing, everything is gridbox average.
+ else
+ scale_threshold(:) = 1._f
+ call newstate_calc(carma, cstate, scale_threshold, rc)
+ if (rc < RC_OK) return
+ end if
+
+ ! Return to caller with new state computed
+ return
+end
diff --git a/src/physics/carma/base/newstate_calc.F90 b/src/physics/carma/base/newstate_calc.F90
new file mode 100644
index 0000000000..ee88a4faf5
--- /dev/null
+++ b/src/physics/carma/base/newstate_calc.F90
@@ -0,0 +1,277 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine manages the calculations that update state variables
+!! of the model with new values at the current simulation time. It supports
+!! a retry mechanism, so the the number of steps can be increased dynamically
+!! if the fast microphysics was not able to generate a valid solution. The
+!! validity of the solution is control by the convergence thresholds
+!! (dgc_threshold, dt_threshold and ds_threshold)
+!!
+!! NOTE: For cloud models, this routine may get called multiple times, once for
+!! in-cloud calculations and again for clear sky.
+!!
+!! @author Bardeen
+!! @version Jan 2012
+subroutine newstate_calc(carma, cstate, scale_threshold, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ real(kind=f), intent(in) :: scale_threshold(NZ) !! Scaling factor for convergence thresholds
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ real(kind=f) :: sedlayer(NBIN,NELEM)
+ real(kind=f) :: pcd_last(NBIN,NELEM)
+ integer :: kb
+ integer :: ke
+ integer :: idk
+ integer :: iz
+ integer :: isubstep
+ integer :: igroup
+ integer :: igas
+ integer :: ielem
+ integer :: ibin
+ integer :: ntsubsteps
+ logical :: takeSteps
+ real(kind=f) :: fraction ! Fraction of dT, dgc and pdc to be added in a substep.
+
+ 1 format(/,'newstate::ERROR - Substep failed, maximum retries execeed. : iz=',i4,',isubstep=',i12, &
+ ',ntsubsteps=',i12,',nretries=',F9.0)
+
+
+ ! Redetermine the maximum particle values.
+ if ((do_vtran) .or. do_incloud) then
+ do iz = 1, NZ
+ call maxconc(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+ end do
+ end if
+
+ ! Calculate changes in particle concentrations due to microphysical
+ ! processes, part 1. (potentially slower microphysical calcs)
+ ! All spatial points are handled by one call to this routine.
+ if (do_coag) then
+ call microslow(carma, cstate, rc)
+ if (rc < RC_OK) return
+ endif
+
+ ! If there is any microsphysics that happens on a faster time scale,
+ ! then check to see if the time step needs to be subdivided and then
+ ! perform the fast microphysical calculations.
+ if (do_grow) then
+
+ ! Set vertical loop index to increment downwards
+ ! (for substepping of sedimentation)
+ if (igridv .eq. I_CART) then
+ kb = NZ
+ ke = 1
+ idk = -1
+ else
+ kb = 1
+ ke = NZ
+ idk = 1
+ endif
+
+ ! Initialize sedimentation source to zero at top of model
+ dpc_sed(:,:) = 0._f
+
+ ! Save the results from the slow operations, since we might need to retry the
+ ! fast operations
+ pcl(:,:,:) = pc(:,:,:)
+
+ if (do_substep) then
+ do igas = 1,NGAS
+ gcl(:,igas) = gc(:,igas)
+ end do
+ told(:) = t(:)
+ endif
+
+
+ do iz = kb,ke,idk
+
+ ! Compute or specify number of sub-timestep intervals for current spatial point
+ ! (Could be same for all spatial pts, or could vary as a function of location)
+ ntsubsteps = minsubsteps
+
+ call nsubsteps(carma, cstate, iz, dtime_orig, ntsubsteps, rc)
+ if (rc < RC_OK) return
+
+ ! Grab sedimentation source for entire step for this layer
+ ! and set accumlated source for underlying layer to zero
+ sedlayer(:,:) = dpc_sed(:,:)
+
+ ! Do sub-timestepping for current spatial grid point, and allow for
+ ! retrying should this level of substepping not be enough to keep the
+ ! gas concentration from going negative.
+ nretries = 0._f
+ takeSteps = .true.
+
+ do while (takeSteps)
+
+ ! Compute sub-timestep time interval for current spatial grid point
+ dtime = dtime_orig / ntsubsteps
+
+ ! Don't retry unless requested.
+ takeSteps = .false.
+
+ ! Reset the amount that has been collected to sedimented down to the
+ ! layer below.
+ dpc_sed(:,:) = 0._f
+
+ ! Reset the total nucleation for the step.
+ pc_nucl(iz,:,:) = 0._f
+
+ ! Remember the amount of detrained particles.
+ if (do_detrain) then
+ pcd_last(:,:) = pcd(iz,:,:)
+ end if
+
+ ! Reset average heating rates.
+ rlheat(iz) = 0._f
+ partheat(iz) = 0._f
+
+ do isubstep = 1,ntsubsteps
+
+ ! If substepping, then increment the gas concentration and the temperature by
+ ! an amount for one substep.
+ if (do_substep) then
+
+ ! Since we don't really know how the gas and temperature changes arrived during the
+ ! step, we can try different assumptions for how the gas and temperature are add to
+ ! the values from the previous substep.
+
+ ! Linear increment for substepping.
+ fraction = 1._f / ntsubsteps
+
+ do igas = 1,NGAS
+ gc(iz,igas) = gc(iz,igas) + d_gc(iz,igas) * fraction
+ enddo
+
+ t(iz) = t(iz) + d_t(iz) * fraction
+
+
+ ! Detrainment puts the full gridbox amount into the incloud portion.
+ if (do_detrain) then
+ pc(iz,:,:) = pc(iz,:,:) + pcd_last(:,:) * fraction
+ pcd(iz,:,:) = pcd(iz,:,:) - pcd_last(:,:) * fraction
+ end if
+ endif
+
+
+ ! Redetermine maximum particle concentrations.
+ call maxconc(carma, cstate, iz, rc)
+ if (rc < RC_OK) return
+
+ ! Calculate changes in particle concentrations for current spatial point
+ ! due to microphysical processes, part 2. (faster microphysical calcs)
+ call microfast(carma, cstate, iz, scale_threshold(iz), rc)
+ if (rc < RC_OK) return
+
+
+ ! If there was a retry warning message and substepping is enabled, then retry
+ ! the operation with more substepping.
+ if (rc == RC_WARNING_RETRY) then
+ if (do_substep) then
+
+ ! Only retry for so long ...
+ nretries = nretries + 1
+
+ if (nretries > maxretries) then
+ if (do_print) write(LUNOPRT,1) iz, isubstep, ntsubsteps, nretries - 1._f
+ rc = RC_ERROR
+ exit
+ end if
+
+ ! Try twice the substeps
+ !
+ ! NOTE: We are going to rely upon retries, so don't clutter the log
+ ! with retry print statements. They slow down the run.
+ ntsubsteps = ntsubsteps * 2
+
+! if (do_print) write(LUNOPRT,*) "newstate::WARNING - Substep failed, retrying with ", ntsubsteps, " substeps."
+
+ ! Reset the state to the beginning of the step
+ pc(iz,:,:) = pcl(iz,:,:)
+ pcd(iz,:,:) = pcd_last(:,:)
+ t(iz) = told(iz)
+ do igas = 1,NGAS
+ gc(iz,igas) = gcl(iz,igas)
+
+ ! Now that we have reset the gas concentration, we need to recalculate the supersaturation.
+ call supersat(carma, cstate, iz, igas, rc)
+ if (rc < RC_OK) return
+ end do
+
+ rc = RC_OK
+ takeSteps = .true.
+ exit
+
+
+ ! If substepping is not enabled, than the retry warning should be treated as an error.
+ else
+
+ if (do_print) write(LUNOPRT,*) "newstate::ERROR - Step failed, suggest enabling substepping."
+ rc = RC_ERROR
+ exit
+ end if
+ end if
+ end do
+ end do
+
+
+ ! Keep track of substepping and retry statistics for performance tuning.
+ max_nsubstep = max(max_nsubstep, ntsubsteps)
+ max_nretry = max(max_nretry, nretries)
+
+ nstep = nstep + 1._f
+ nsubstep = nsubstep + ntsubsteps
+ nretry = nretry + nretries
+
+ if (do_substep) zsubsteps(iz) = ntsubsteps
+ end do
+
+ ! Restore normal timestep
+ dtime = dtime_orig
+
+ else
+
+ ! If there is no reason to substep, but substepping was enabled, get the gas and
+ ! temperature back to their final states.
+ if (do_substep) then
+
+ do igas = 1,NGAS
+ gc(:,igas) = gc(:,igas) + d_gc(:,igas)
+ enddo
+
+ t(:) = t(:) + d_t(:)
+ end if
+
+ ! Do the detrainment, if it was being done in the growth loop.
+ if (do_detrain) then
+ pc(:,:,:) = pc(:,:,:) + pcd(:,:,:)
+
+ ! Remove the ice from the detrained ice, so that total ice will be conserved.
+ pcd(:,:,:) = 0._f
+ end if
+ end if
+
+ ! Calculate average heating rates.
+ if (do_grow) then
+ rlheat(:) = rlheat(:) / dtime
+ partheat(:) = partheat(:) / dtime
+ end if
+
+ ! Return to caller with new state computed
+ return
+end
diff --git a/src/physics/carma/base/nsubsteps.F90 b/src/physics/carma/base/nsubsteps.F90
new file mode 100644
index 0000000000..0eeed28107
--- /dev/null
+++ b/src/physics/carma/base/nsubsteps.F90
@@ -0,0 +1,178 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates the number of sub-timesteps
+!! for the current model spatial point.
+!!
+!! @author Eric Jensen
+!! @version Apr-2000
+subroutine nsubsteps(carma, cstate, iz, dtime_save, ntsubsteps, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ real(kind=f), intent(in) :: dtime_save !! original (not substepped) dtime
+ integer, intent(inout) :: ntsubsteps !! suggested number of substeps
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: ig ! group index
+ integer :: igas ! gas index
+ integer :: ibin ! bin index
+ integer :: iepart
+ integer :: inuc
+ integer :: ienucto
+ integer :: ibin_small(NGROUP)
+ real(kind=f) :: g0
+ real(kind=f) :: g1
+ real(kind=f) :: dmdt
+ real(kind=f) :: dt_adv
+ real(kind=f) :: ss
+ real(kind=f) :: ssold
+ real(kind=f) :: pvap
+ real(kind=f) :: vf_max
+
+
+ ! If substepping is disabled, then use one substep
+ if (.not. do_substep) then
+ ntsubsteps = 1
+ else
+ ! Set default values
+ ntsubsteps = minsubsteps
+
+ ! Find the bin number of the smallest particle bin that
+ ! contains a significant number of particles.
+ ! Also check for significant activation of water droplets.
+
+ if( ntsubsteps .lt. maxsubsteps )then
+
+ do ig = 1, NGROUP
+
+ if( pconmax(iz,ig) .gt. FEW_PC) then
+
+ ibin_small(ig) = NBIN
+
+ ! element of particle number concentration
+ iepart = ienconc(ig)
+
+ if( itype(iepart) .eq. I_INVOLATILE ) then
+
+ ! condensing gas
+ igas = inucgas(ig)
+
+ if (igas /= 0) then
+
+ ss = max( supsatl(iz,igas), supsatlold(iz,igas) )
+
+ do inuc = 1,nnuc2elem(iepart)
+ ienucto = inuc2elem(inuc,iepart)
+
+ if( inucproc(iepart,ienucto) .eq. I_DROPACT ) then
+ do ibin = 1, NBIN
+ if( pc(iz,ibin,iepart) / xmet(iz) / ymet(iz) / zmet(iz) .gt. conmax * pconmax(iz,ig) .and. &
+ ss .gt. scrit(iz,ibin,ig) )then
+ ntsubsteps = maxsubsteps
+ endif
+ enddo
+ endif
+ enddo
+ endif
+
+ elseif( itype(iepart) .eq. I_VOLATILE ) then
+
+ do ibin = NBIN-1, 1, -1
+ if( pc(iz,ibin,iepart) / xmet(iz) / ymet(iz) / zmet(iz) .gt. conmax * pconmax(iz,ig) )then
+ ibin_small(ig) = ibin
+ endif
+ enddo
+
+ endif
+ endif
+ enddo
+ endif
+
+ ! Calculate the growth rate of a particle with the mode radius for
+ ! each volatile group. The maximum time-step to use is then the
+ ! mass growth rate divided by the mass bin width / 2.
+ if( ntsubsteps .lt. maxsubsteps )then
+
+ dt_adv = dtime_save
+ do ig = 1, NGROUP
+
+ ! element of particle number concentration
+ iepart = ienconc(ig)
+
+ ! condensing gas
+ igas = igrowgas(iepart)
+
+ if (igas /= 0) then
+
+ if( pconmax(iz,ig) .gt. FEW_PC ) then
+
+ if( itype(iepart) .eq. I_VOLATILE ) then
+
+ if( is_grp_ice(ig) )then
+ ss = supsati(iz,igas)
+ pvap = pvapi(iz,igas)
+ else
+ ss = supsatl(iz,igas)
+ pvap = pvapl(iz,igas)
+ endif
+
+ g0 = gro(iz,ibin_small(ig),ig)
+ g1 = gro1(iz,ibin_small(ig),ig)
+ dmdt = abs( pvap * ss * g0 / ( 1._f + g0*g1*pvap ) )
+
+ if (dmdt /= 0._f) then
+ dt_adv = min( dt_adv, dm(ibin_small(ig),ig)/dmdt )
+ end if
+ endif
+ endif
+ endif
+ enddo
+
+ ntsubsteps = nint(min(real(maxsubsteps, kind=f), real(dtime_save, kind=f) / dt_adv))
+ ntsubsteps = max( minsubsteps, ntsubsteps )
+ endif
+
+ ! If the ice supersaturation is large enough for homogeneous freezing
+ ! of sulfate aerosols, then use maximum number of substeps
+ if( ntsubsteps .lt. (maxsubsteps) )then
+ do ig = 1, NGROUP
+
+ ! element of particle number concentration
+ iepart = ienconc(ig)
+
+ ! condensing gas
+ igas = inucgas(ig)
+
+ if (igas /= 0) then
+
+ do inuc = 1,nnuc2elem(iepart)
+ ienucto = inuc2elem(inuc,iepart)
+
+ if (iand(inucproc(iepart,ienucto), I_AERFREEZE) .ne. 0) then
+ if( (supsati(iz,igas) .gt. 0.4_f) .and. (t(iz) .lt. 233.16_f) ) then
+ ntsubsteps = maxsubsteps
+ endif
+ endif
+ enddo
+ endif
+ enddo
+ endif
+ endif
+
+ ! Return to caller with number of sub-timesteps evaluated.
+ return
+end
diff --git a/src/physics/carma/base/pheat.F90 b/src/physics/carma/base/pheat.F90
new file mode 100644
index 0000000000..cb930f148c
--- /dev/null
+++ b/src/physics/carma/base/pheat.F90
@@ -0,0 +1,373 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluate particle loss rates due to particle heating.
+!!
+!! The net energy absorbed by each particle is calculatated as , and
+!! this heating rate is included in the caclulation of in growevapl. The
+!! particle temperature perturbation realtive to atmospheric temperature
+!! and the radiative heating of the atmosphere by particles
+!! are also calculated.
+!!
+!! This algorithm is based upon the model described in the appendix of
+!! Toon et al., J. Geophys. Res., 94, 11359-11380, 1989.
+!!
+!! This routine assumes that the following variable/tables have already been
+!! set up:
+!!
+!! intensity of incoming radiance (solar+ir) [erg/cm2/sr/s/cm]
+!! wavelengths used for integration [cm]
+!! width of wavelength bands for integration [cm]
+!! whether planck emission should be doen for the band
+!! extinction [cm2]
+!! single scattering albedo
+!!
+!! @author Chuck Bardeen
+!! @version Jan-2010
+subroutine pheat(carma, cstate, iz, igroup, iepart, ibin, igas, dmdt, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ use planck, only : planckIntensity, planckBandIntensity, planckBandIntensityWidger1976, planckBandIntensityConley2011
+
+ implicit none
+
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! vertical index
+ integer, intent(in) :: igroup !! group index
+ integer, intent(in) :: iepart !! group's concentration element index
+ integer, intent(in) :: ibin !! bin index
+ integer, intent(in) :: igas !! gas index
+ real(kind=f), intent(out) :: dmdt !! particle growth rate (g/s)
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer, parameter :: MAX_ITER = 10 ! Maximum number of iterations
+ real(kind=f), parameter :: DDTP_LIMIT = 0.01_f ! Convergence criteria for iteration.
+
+ integer :: iter ! iteration
+ integer :: iwvl ! wavelength band index
+ integer :: ieother(NELEM)
+ integer :: nother
+ integer :: ieoth_rel
+ integer :: ieoth_abs
+ integer :: jother
+ integer :: isol
+ real(kind=f) :: otherm(NELEM)
+ real(kind=f) :: argsol
+ real(kind=f) :: othermtot
+ real(kind=f) :: othervtot
+ real(kind=f) :: condm
+ real(kind=f) :: condv
+ real(kind=f) :: volfrc
+ real(kind=f) :: akas
+ real(kind=f) :: expon
+ real(kind=f) :: g0
+ real(kind=f) :: g1
+ real(kind=f) :: g2
+ real(kind=f) :: ss
+ real(kind=f) :: pvap
+ real(kind=f) :: qrad ! particle net radiation (erg/s)
+! real(kind=f) :: qrad0 ! particle net radiation (Tp=Ta) (erg/s)
+ real(kind=f) :: rlh ! latent heat (erg/g)
+ real(kind=f) :: tp ! particle temperature (K)
+ real(kind=f) :: dtp ! change in particle temperature (K)
+ real(kind=f) :: dtpl ! last change in particle temperature (K)
+ real(kind=f) :: ddtp ! change in particle temperature in last iteration (K)
+ real(kind=f) :: plkint ! planck intensity
+
+ ! is combined kelvin (curvature) and solute factors.
+ !
+ ! Ignore solute factor for ice particles.
+ if( is_grp_ice(igroup) )then
+ expon = akelvini(iz,igas) / rup_wet(iz,ibin,igroup)
+
+ ! Ice can't be neutralized, so set the volume fraction to 0.
+ volfrc = 0._f
+ else
+
+ argsol = 0._f
+
+ ! Consider growth of average particle at radius .
+ !
+ ! Treat solute effect first: is solute factor.
+ !
+ ! Only need to treat solute effect if > 1
+ if( nelemg(igroup) .gt. 1 )then
+
+ ! is mass concentration of condensed gas in particle.
+ ! is number of other elements in group having mass.
+ ! are mass concentrations of other elements in particle group.
+ ! is total mass concentrations of other elements in particle.
+ nother = 0
+ othermtot = 0._f
+ othervtot = 0._f
+
+ ! is relative element number of other element in group.
+ do ieoth_rel = 2,nelemg(igroup)
+
+ ! is absolute element number of other element.
+ ieoth_abs = iepart + ieoth_rel - 1
+
+ if( itype(ieoth_abs) .eq. I_COREMASS )then
+ nother = nother + 1
+ ieother(nother) = ieoth_abs
+ otherm(nother) = pc(iz,ibin,ieoth_abs)
+ othermtot = othermtot + otherm(nother)
+ othervtot = othervtot + otherm(nother) / pc(iz,ibin,iepart) / rhoelem(ibin,ieoth_abs)
+ endif
+ enddo
+
+ condm = rmass(ibin,igroup) * pc(iz,ibin,iepart) - othermtot
+ condv = min(0._f, (rmass(ibin,igroup) / rhoelem(ibin,iepart)) - othervtot)
+
+ if( condm .le. 0._f )then
+
+ ! Zero mass for the condensate -- is a small value << 1
+ argsol = 1e6_f
+
+ ! If there is no condensed mass, then the volume fraction of core is 1.
+ volfrc = 1._f
+ else
+
+ ! Sum over masses of other elements in group for argument of solute factor.
+ do jother = 1,nother
+ isol = isolelem(ieother(jother))
+
+ ! Some elements aren't soluble, so skip them.
+ if(isol .gt. 0 ) argsol = argsol + sol_ions(isol)*otherm(jother)/solwtmol(isol)
+ enddo
+
+ argsol = argsol*gwtmol(igas)/condm
+
+ volfrc = othervtot / (othervtot + condv)
+ endif
+ endif ! nelemg(igroup) > 1
+ expon = akelvin(iz,igas) / rup_wet(iz,ibin,igroup) - argsol
+ endif
+
+ expon = max(-POWMAX, expon)
+ akas = exp( expon )
+
+ ! Trick for removing haze droplets from droplet bins:
+ ! allows haze droplets to exist under supersaturated conditions;
+ ! when below supersaturation, haze droplets will evaporate.
+! if( (.not. is_grp_ice(igroup)) .and. (akas .lt. 1._f) .and. &
+! (supsatl(iz,igas) .lt. 0._f) ) akas = 1._f
+
+ ! is growth rate in mass space [g/s].
+ g0 = gro(iz,ibin+1,igroup)
+ g1 = gro1(iz,ibin+1,igroup)
+ g2 = gro2(iz,igroup)
+
+ if( is_grp_ice(igroup) )then
+ ss = supsati(iz,igas)
+ pvap = pvapi(iz,igas)
+ else
+ ss = supsatl(iz,igas)
+ pvap = pvapl(iz,igas)
+ endif
+
+
+ ! If particle heating is being considered, then determine qrad and tpart to
+ ! determine dmdt.
+ !
+ ! NOTE: If no optical properties, then can't do the particle heating calculation.
+ if ((.not. do_pheat) .or. (.not. do_mie(igroup))) then
+
+ ! Ignore the qrad term.
+ dmdt = pvap * ( ss + 1._f - akas ) * g0 / ( 1._f + g0 * g1 * pvap )
+
+ ! Is neutralization set up for the group?
+ if (neutral_volfrc(igroup) > 0._f) then
+
+ ! When the particle is less than fully neutralized, calculate a new
+ ! dmdt based upon assuming that the saturation vapor pressure (pvap)
+ ! is 0.
+ if (volfrc >= neutral_volfrc(igroup)) then
+ dmdt = max((pvap * (ss + 1._f)) * g0, dmdt)
+ else
+
+ ! You can only lose sulfuric acid (condensed) mass until the volume fraction
+ ! for neutralization is reached. At that point the particle is fully
+ ! neutralized and the vapor pressure goes to 0. The volume of condensed gas
+ ! in excess of full neutralization is:
+ !
+ ! condv - othervtot * ((1 - neutral_volfrc) / neutral_volfrc)
+ !
+ ! NOTE: Limit the growth rate so that the neutralized volume fraction is
+ ! not overshot. Test have shown that this requires reducing the rate by a
+ ! factor of 2; although, other values probably work too.
+ dmdt = max(-(condv - othervtot * ((1._f - neutral_volfrc(igroup)) / neutral_volfrc(igroup))) &
+ * rhoelem(ibin,iepart) / 2._f / dtime, &
+ dmdt)
+ end if
+ end if
+ else
+
+ ! Latent heat of condensing gas
+ if( is_grp_ice(igroup) )then
+ rlh = rlhe(iz,igas) + rlhm(iz,igas)
+ else
+ rlh = rlhe(iz,igas)
+ endif
+
+ ! The particle temperature must be solved for by iterating, with an
+ ! initial guess that the particle temperature is the ambient temperature.
+ !
+ ! NOTE: We could also try a guest that is based upon an equilibrium
+ ! between upwelling IR and collisonal heating, which was identified by
+ ! Jensen [1989] as the dominant terms.
+ !
+ ! radp = 0.d0
+ !
+ ! do iwvl = 1, Nwave
+ ! radp = radp + (4.0d0*PI * absk(iwvl,ibin+1,igroup) *
+ ! $ radint3(ixyz,iwvl) * dwave(iwvl))
+ ! end do
+ !
+ ! dtp2 = radp /
+ ! $ (4.d0*PI*rlow(ibin+1,igroup)*thcondnc(iz)*ft(iz,ibin+1,igroup))
+ tp = t(iz)
+ dtp = 0._f
+ dtpl = 0._f
+
+ do iter = 1, MAX_ITER
+
+ ! Calculate the net radiative flux on the particle, which requires
+ ! integrating the incoming and outgoing flux over the spectral
+ ! interval.
+ qrad = 0._f
+
+ do iwvl = 1, NWAVE
+
+ ! There may be overlap between bands, so only do the emission
+ ! for each range of wavelengths once.
+ if (do_wave_emit(iwvl)) then
+
+ ! Get an integral across the entire band. There are several
+ ! techniques for doing this that vary in accuracy and
+ ! performance. Comments below are based on the CAM RRTMG
+ ! band structure.
+
+ ! Just use the band center.
+ !
+ ! NOTE: This generates about a 20% error, but is the fastest
+! plkint = planckIntensity(wave(iwvl), tp)
+
+ ! Brute Force integral
+ !
+ ! The slowest technique, and not as accurate as either Widger
+ ! and Woodall or Conley, even at 100 iterations.
+! plkint = planckBandIntensity(wave(iwvl), dwave(iwvl), tp, 60)
+
+ ! Integral using Widger and Woodall, 1976.
+ !
+ ! NOTE: One of the fastest technique at 2 iterations, but yields errors
+ ! of about 2%. Can handle wide rage of band sizes.
+! plkint = planckBandIntensityWidger1976(wave(iwvl), dwave(iwvl), tp, 2)
+
+ ! Using method developed by Andrew Conley.
+ !
+ ! This is similar in performance to Widger and Woodall, but is more
+ ! accurate with errors of about 0.3%. It had trouble with SW bands that
+ ! are very large, but the latest version has improved performance and
+ ! it does work with the RRTMG band structure.
+ plkint = planckBandIntensityConley2011(wave(iwvl), dwave(iwvl), tp, 1)
+
+ else
+ plkint = 0._f
+ end if
+
+ qrad = qrad + 4.0_f * PI * (1._f - ssa(iwvl,ibin+1,igroup)) * &
+ qext(iwvl,ibin+1,igroup) * PI * (rlow_wet(iz,ibin+1,igroup) ** 2) &
+ * arat(ibin+1,igroup) * (radint(iz,iwvl) - plkint) * dwave(iwvl)
+ end do
+
+ ! Save of the Qrad association with the ambient air temperature.
+! if (iter == 0) then
+! qrad0 = qrad
+! end if
+
+ ! Calculate the change in mass using eq. A3 from Toon et al. [1989].
+ dmdt = pvap * ( ss + 1._f - akas * (1._f + qrad * g1 * g2 )) * &
+ g0 / ( 1._f + g0 * g1 * pvap )
+
+ ! Calculate a new particle temperature based upon the loss of mass and
+ ! energy being absorbed.
+ if ((dmdt * dtime) .le. (- rmass(ibin+1, igroup))) then
+ dtp = ((rlh * (- rmass(ibin+1, igroup) / dtime)) + qrad) / &
+ (4._f * PI * rlow_wet(iz,ibin+1,igroup) * thcondnc(iz,ibin+1,igroup) * ft(iz,ibin+1,igroup))
+ else
+ dtp = ((rlh * dmdt) + qrad) / &
+ (4._f * PI * rlow_wet(iz,ibin+1,igroup) * thcondnc(iz,ibin+1,igroup) * ft(iz,ibin+1,igroup))
+ end if
+
+ tp = t(iz) + dtp
+
+ ddtp = dtp - dtpl
+ dtpl = dtp
+
+ if (abs(ddtp) .le. DDTP_LIMIT) then
+ exit
+ end if
+
+ if ((iter .gt. 1) .and. (ddtp .gt. dtpl)) then
+ exit
+ end if
+ end do
+
+ dtpart(iz,ibin,igroup) = dtp
+
+ ! Calculate the contribution of this bin to the heating of the atmosphere. CARMA does
+ ! not actually apply this heating to change the temperature.
+ !
+ ! From Pruppacher & Klett [2000], eq. 13-19, the heat transfer to
+ ! one particle is:
+ !
+ ! dq/dt = 4*pi*r*thcondnc*Ft(r)*(T - Tp(r))
+ !
+ ! so the total heating rate of the air by the particle is:
+ !
+ ! dT/dt = -Sum((4*pi*r*thcondnc*Ft(r)*(T-Tp(r))*pc(r))) / (Cp,air*arho)
+ !
+ ! or
+ !
+ ! dT/dt = Sum((4*pi*r*thcondnc*Ft(r)*dtp*pc(r))) / (Cp,air*arho)
+ !
+ ! where dtp = Tp(r) - T
+ !
+ ! NOTE: Using these terms will cause the model parent model to go out of
+ ! energy balance, since qrad difference is not being communicated to the
+ ! other layers.
+ if (do_pheatatm) then
+
+ ! NOTE: If the particle is going to evaporate entirely during the timestep,
+ ! then assume that there is no particle heating.
+ if ((dmdt * dtime) .gt. (- rmass(ibin+1, igroup))) then
+
+ ! If the particles are radiatively active, then the parent model's radiation
+ ! code is calculated based upon Ta, not Tp. Adjust for this error in Qrad.
+! phprod = phprod + (qrad - qrad0) * pc(iz,ibin+1,iepart) / CP / rhoa(iz)
+
+ ! Now add in the heating from thermal conduction.
+ phprod = phprod + 4._f * PI * rlow_wet(iz,ibin+1,igroup) * &
+ thcondnc(iz,ibin+1,igroup) * ft(iz,ibin+1,igroup) * dtp * &
+ pc(iz,ibin+1,iepart) / (CP * rhoa(iz))
+ end if
+ end if
+ end if
+
+ ! Return to caller with particle loss rates for growth and evaporation
+ ! evaluated.
+ return
+end
diff --git a/src/physics/carma/base/planck.F90 b/src/physics/carma/base/planck.F90
new file mode 100644
index 0000000000..346a767dad
--- /dev/null
+++ b/src/physics/carma/base/planck.F90
@@ -0,0 +1,326 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+module planck
+
+contains
+
+ !! This routine calculates the planck intensity.
+ !!
+ !! This algorithm is based upon eqn 1.2.4 from Liou[2002].
+ !!
+ !! @author Chuck Bardeen
+ !! @version Jan-2010
+ function planckIntensity(wvl, temp)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ real(kind=f), intent(in) :: wvl !! wavelength (cm)
+ real(kind=f), intent(in) :: temp !! temperature (K)
+ real(kind=f) :: planckIntensity !! Planck intensity (erg/s/cm2/sr/cm)
+
+ ! Local declarations
+
+ real(kind=f), parameter :: C = 2.9979e10_f ! Speed of light [cm/s]
+ real(kind=f), parameter :: H = 6.62608e-27_f ! Planck constant [erg s]
+
+ ! Calculate the planck intensity.
+ planckIntensity = 2._f * H * C**2 / ((wvl**5) * (exp(H * C / (BK * wvl * temp)) - 1._f))
+
+ ! Return the planck intensity to the caller.
+ return
+ end function
+
+
+ !! This routine calculates the total planck intensity from the specified
+ !! wavelength to a wavelength of 0.
+ !!
+ !! This algorithm is based upon Widger and Woodall, BAMS, 1976 as
+ !! indicated at http://www.spectralcalc.com/blackbody/appendixA.html.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Aug-2011
+ function planckIntensityWidger1976(wvl, temp, miniter)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ real(kind=f), intent(in) :: wvl !! band center wavelength (cm)
+ real(kind=f), intent(in) :: temp !! temperature (K)
+ integer, intent(in) :: miniter !! minimum iterations
+ real(kind=f) :: planckIntensityWidger1976 !! Planck intensity (erg/s/cm2/sr/cm)
+
+ ! Local Variables
+ real(kind=f), parameter :: C = 299792458.0_f ! Speed of light [m/s]
+ real(kind=f), parameter :: H = 6.6260693e-34_f ! Planck constant [J s]
+ real(kind=f), parameter :: BZ = 1.380658e-23_f ! Boltzman constant
+
+ real(kind=f) :: c1, x, x2, x3, sumJ, dn, sigma
+ integer :: iter, n
+
+ sigma = 1._f / wvl
+
+ c1 = H * C / BZ
+ x = c1 * 100._f * sigma / temp
+ x2 = x * x
+ x3 = x2 * x
+
+ ! Use fewer iterations, since speed is more important than accuracy for
+ ! the particle heating code, and even with fewer iterations the results
+ ! with CAM bands still show good accuracy.
+! iter = min(512, int(2._f + 20._f / x))
+ iter = min(miniter, int(2._f + 20._f / x))
+
+ sumJ = 0._f
+
+ do n = 1, iter
+ dn = 1._f / n
+ sumJ = sumJ + exp(-n*x) * (x3 + (3.0_f * x2 + 6.0_f * (x + dn) * dn) * dn) * dn
+ end do
+
+ ! Convert results from W/m2/sr to erg/cm2/s/sr
+ planckIntensityWidger1976 = 2.0_f * H * (C**2) * ((temp / c1) ** 4) * sumJ * 1e7_f / 1e4_f
+
+ return
+ end function
+
+
+ !! This routine calculates the average planck intensity in the wavelength
+ !! band defined by wvl and dwvl.
+ !!
+ !! This algorithm is based upon Widger and Woodall, BAMS, 1976 as
+ !! indicated at http://www.spectralcalc.com/blackbody/appendixA.html.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Aug-2011
+ function planckBandIntensityWidger1976(wvl, dwvl, temp, miniter)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ real(kind=f), intent(in) :: wvl !! band center wavelength (cm)
+ real(kind=f), intent(in) :: dwvl !! band width (cm)
+ real(kind=f), intent(in) :: temp !! temperature (K)
+ integer, intent(in) :: miniter !! minimum iterations
+ real(kind=f) :: planckBandIntensityWidger1976 !! Planck intensity (erg/s/cm2/sr/cm)
+
+ ! Calculate the integral from the edges to 0 and subtract.
+ planckBandIntensityWidger1976 = &
+ (planckIntensityWidger1976(wvl + (dwvl / 2._f), temp, miniter) &
+ - planckIntensityWidger1976(wvl - (dwvl / 2._f), temp, miniter)) / dwvl
+
+ return
+ end function
+
+
+ !! This routine calculates the average planck intensity in the wavelength
+ !! band defined by wvl and dwvl.
+ !!
+ !! This algorithm does a brute force integral by dividing the band into
+ !! small sub-bands. This routine can be slow.
+ !!
+ !! @author Chuck Bardeen
+ !! @version Aug-2011
+ function planckBandIntensity(wvl, dwvl, temp, iter)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ real(kind=f), intent(in) :: wvl !! band center wavelength (cm)
+ real(kind=f), intent(in) :: dwvl !! band width (cm)
+ real(kind=f), intent(in) :: temp !! temperature (K)
+ integer, intent(in) :: iter !! number of iterations
+ real(kind=f) :: planckBandIntensity !! Planck intensity (erg/s/cm2/sr/cm)
+
+ ! Local Variables
+ real(kind=f) :: wstart ! Starting wavelength (cm)
+ real(kind=f) :: ddwave ! sub-band width (cm)
+ integer :: i
+
+ wstart = wvl - (dwvl / 2._f)
+ ddwave = dwvl / iter
+
+ planckBandIntensity = 0._f
+
+ do i = 1, iter
+ planckBandIntensity = planckBandIntensity + planckIntensity(wstart + (i - 0.5) * ddwave, temp) * ddwave
+ end do
+
+ planckBandIntensity = planckBandIntensity / dwvl
+
+ return
+ end function
+
+
+ !! This routine calculates the average planck intensity in the wavelength
+ !! band defined by wvl and dwvl.
+ !!
+ !! error computed on full spectrum compared to planck function. Band-levels may be different
+ !! 8.9% error with 5 quadrature points in [100 micrometer, 1 millimeter]
+ !! 1.7% error with 10 quadrature points in [100 micrometer, 1 millimeter]
+ !! 0.001% error with 100 quadrature points in [100 micrometer, 1 millimeter]
+ !!
+ !! NOTE: This code was design to work with the CAM RRTMG band structure, it may not work as
+ !! well with arbitrary bands.
+ !!
+ !! NOTE: For most RRTMG bands, 3 quadrature points are probably sufficient, but testing is
+ !! left to the reader.
+ !!
+ !! @author Andrew Conley, Chuck Bardeen
+ !! @version Aug-2011
+ function planckBandIntensityConley2011(wvl, dwvl, temp, iter)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ real(kind=f), intent(in) :: wvl !! band center wavelength (cm)
+ real(kind=f), intent(in) :: dwvl !! band width (cm)
+ real(kind=f), intent(in) :: temp !! temperature (K)
+ integer, intent(in) :: iter !! number of iterations
+ real(kind=f) :: planckBandIntensityConley2011 !! Planck intensity (erg/s/cm2/sr/cm)
+
+ real(kind=f) :: half = 0.5_f
+ real(kind=f) :: third= 1._f / 3._f
+ real(kind=f) :: sixth= 1._f / 6._f
+ real(kind=f) :: tfth = 1._f /24._f
+
+ real(kind=f) :: k = 1.3806488e-23_f ! boltzmann J/K
+ real(kind=f) :: c = 2.99792458e8_f ! light m/s
+ real(kind=f) :: h = 6.62606957e-34_f ! planck J s
+ real(kind=f) :: sigma = 5.670373e-8_f ! stef-bolt W/m/m/k/k/k/k
+
+ real(kind=f) :: lambda1 ! wavelength m (lower bound)
+ real(kind=f) :: lambda2 ! wavelength m (upper bound)
+
+ ! quadrature iteration
+ integer :: i,inumber
+
+ ! internal temporary variables
+ real(kind=f) :: fr1, fr2 ! frequency bounds of partition
+ real(kind=f) :: kt ! k_boltzmann * temperature
+ real(kind=f) :: l1,l2 ! lower and upper bounds of (wavelength)
+ real(kind=f) :: dellam ! fraction multiplier for next lambda interval
+ real(kind=f) :: t1,t3 ! 2nd and 4th order terms
+ real(kind=f) :: total, total2 ! 2nd and 4th order cumulative partial integral
+ real(kind=f) :: e,d,em1i,di,ci ! exponential terms appearing in integral
+ real(kind=f) :: dfr,m,a,o,tt,mi ! terms appearing in integral
+ real(kind=f) :: argexp ! argument to exponent
+ real(kind=f) :: coeff ! front coefficient of integral
+ real(kind=f) :: planck ! planck function
+
+ inumber = iter ! number of partitions
+
+ !initialize
+ total = 0._f ! partial (cumulative) integral (4th order)
+! total2 = 0._f ! partial (cumulative) integral (2nd order)
+
+ kt = k*temp
+ lambda1 = (wvl - (dwvl / 2._f)) * 1e-2_f
+ lambda2 = (wvl + (dwvl / 2._f)) * 1e-2_f
+ ci = 1._f/c
+
+ if (inumber .gt. 1) then
+ l1 = lambda1
+ dellam = exp(log(lambda1/lambda2)/inumber)
+ l2 = l1/dellam
+ fr1 = c/l2
+ fr2 = c/l1
+ else
+ dellam = 1._f ! meaningless
+ l1 = lambda1
+ l2 = lambda2
+ fr1 = c/l2
+ fr2 = c/l1
+ endif
+
+ ! accumulate integral by stepping (backwards) through partions of frequency
+ do i = 1,inumber
+
+ ! constants
+ dfr = half * (fr2-fr1) ! half-range freq interval
+ m = half * (fr1+fr2) ! mean freq
+ mi = 1._f/m
+ a = h/kt ! alpha
+
+ argexp = a*m
+ if (argexp .lt. 0.5_f) then
+ e = 1._f + &
+ argexp + &
+ (argexp*argexp)*half + &
+ (argexp*argexp*argexp)*sixth + &
+ (argexp*argexp*argexp*argexp)*tfth
+ em1i = 1._f/(e - 1._f )
+ di = e*em1i
+ else if (argexp .lt. 20.0_f) then
+ e = exp(argexp)
+ em1i = 1._f/(e - 1._f )
+ di = e*em1i
+ else
+ e = 1.e+20_f ! exp(20) is large. Use this for frequency >> Temperature
+ em1i = 1.e-20_f
+ di = 1._f
+ endif
+
+ ! frontpiece
+ coeff = 2._f*h*m*m*m*ci*ci*em1i
+
+ ! integrals
+ o = fr2-fr1 ! int 1 deps
+ tt = 2._f*(dfr*dfr*dfr)*third ! int eps^2 deps
+
+ ! term and 4th order correction
+ t1 = 1._f
+ t3 = 3._f*mi*mi - 3._f*a*di*mi + a*a*di*di - half*a*a*di
+ ! t3 could be made more stable by placing (-) terms in denominator of pade approx.
+
+ ! sum it up. Total is 4th order, total2 is 2nd order
+ total = total + coeff*(o*t1+tt*t3)
+! total2 = total2 + coeff*o*t1
+
+ fr2 = fr1
+ fr1 = fr1 * dellam
+ enddo
+
+ ! Convert to erg/cm2/s/sr/cm
+ planckBandIntensityConley2011 = total * 1e7 / 1e4 / dwvl
+
+ return
+ end function
+end
diff --git a/src/physics/carma/base/prestep.F90 b/src/physics/carma/base/prestep.F90
new file mode 100644
index 0000000000..be9862b50a
--- /dev/null
+++ b/src/physics/carma/base/prestep.F90
@@ -0,0 +1,105 @@
+#include "carma_globaer.h"
+
+!! This routine handles all preliminary setup at the beginning
+!! of every timestep. Things that would appropriately be done
+!! here include:
+!! Input or otherwise define interface quantities from other submodels.
+!! Save any model state that is needed to compute tendencies.
+!! Save any model state that might be needed for comparison at end of step.
+!! Update timestep counter and simulation time.
+!!
+!! @author Bill McKie
+!! @version Oct-1995
+subroutine prestep(carma, cstate, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ integer :: iz ! z index
+ integer :: igrp ! group index
+ integer :: igas ! gas index
+ integer :: ibin ! bin index
+ integer :: ielem ! element index
+ integer :: iep
+ real(kind=f) :: tmp_gc(NZ, NGAS)
+ real(kind=f) :: tmp_t(NZ)
+
+
+ ! If substepping is enabled, then determine how much the
+ ! gas concentration and temperature changed during this time step.
+ if (do_substep) then
+ if (NGAS > 0) then
+ d_gc(:,:) = gc(:,:) - gcl(:,:)
+
+ do igas = 1, NGAS
+ do iz = 1, NZ
+
+ ! NOTE: When d_gc is negative, you can get into problems with overshoot
+ ! to negative gas concentrations. To prevent that, when gc is negative
+ ! apply it all in the first step. Only substep gc when gc is increasing.
+ !
+ ! NOTE: Perhaps there should be a limit, so that small changes happen
+ ! over the course of the timestep, but large changes get applied on the
+ ! first step. For now, doing it all on the first step should be the most
+ ! stable.
+ !
+ ! NOTE: The case that is problematic is when the particle is growing
+ ! (i.e. supersaturated) and d_gc is negative. For better performance,
+ ! substep the gas unless both of these are true. This might run into
+ ! trouble if d_t is large and negative.
+! if (d_gc(iz, igas) < 0._f) then
+ if ((d_gc(iz, igas) < 0._f) .and. ((supsatiold(iz, igas) > 0._f) &
+ .or. (supsati(iz, igas) > 0._f))) then
+
+ ! Start from the new state and don't step the gas.
+ d_gc(iz, igas) = 0._f
+ gcl(iz, igas) = gc(iz, igas)
+ else
+
+ ! Start the step from the old state and step the gas.
+ gc(iz, igas) = gcl(iz, igas)
+ end if
+ end do
+ end do
+ end if
+
+ ! Start the temperature from the old state.
+ d_t(:) = t(:) - told(:)
+ t(:) = told(:)
+ endif
+
+
+ ! Don't allow particle concentrations to get too small.
+ do iz = 1, NZ
+ do ibin = 1, NBIN
+ do ielem = 1, NELEM
+ call smallconc(carma, cstate, iz, ibin, ielem, rc)
+ end do
+ end do
+ end do
+
+ ! Set to from previous time step. This is needed by coagulation
+ ! as well as substepping.
+ if (do_substep .or. do_coag) then
+ pcl(:,:,:) = pc(:,:,:)
+ endif
+
+ ! Find maximum particle concentrations.
+ do iz = 1, NZ
+ call maxconc(carma, cstate, iz, rc)
+ end do
+
+ ! Return to caller with preliminary timestep things completed.
+ return
+end
diff --git a/src/physics/carma/base/psolve.F90 b/src/physics/carma/base/psolve.F90
new file mode 100644
index 0000000000..5939604503
--- /dev/null
+++ b/src/physics/carma/base/psolve.F90
@@ -0,0 +1,85 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates new particle concentrations.
+!!
+!! The basic form from which the solution is derived is
+!! ( new_value - old_value ) / dtime = source_term - loss_rate*new_value
+!!
+!! Modified Sep-1997 (McKie)
+!! New particle concentrations due to coagulation processes
+!! were moved to the csolve routine. Csolve is called to
+!! update particle concentrations due to coagulation.
+!! This new psolve now updates particle concentrations due
+!! to the faster calcs of the non-coag microphysical processes.
+!!
+!! @author Eric Jensen, Bill McKie
+!! @version Oct-1995, Sep-1997
+subroutine psolve(carma, cstate, iz, ibin, ielem, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(in) :: iz !! z index
+ integer, intent(in) :: ibin !! bin index
+ integer, intent(in) :: ielem !! element index
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: igroup ! group index
+ integer :: iepart
+ integer :: igto
+ integer :: iz_no_sed
+ real(kind=f) :: ppd ! particle prodocution rate
+ real(kind=f) :: pc_nonuc ! particles - no nucleation
+ real(kind=f) :: pls ! particle loss rate
+ real(kind=f) :: sed_rate
+ real(kind=f) :: rnuclgtot
+ real(kind=f) :: dsed
+
+
+ ! Define current group & particle number concentration element indices
+ igroup = igelem(ielem)
+ iepart = ienconc(igroup)
+
+ if(do_grow) then
+
+ ! Compute total production rate
+ ppd = rnucpe(ibin,ielem) + rhompe(ibin,ielem) + growpe(ibin,ielem) + evappe(ibin,ielem)
+
+ ! Sum up nucleation loss rates
+ rnuclgtot = sum(rnuclg(ibin,igroup,:))
+
+ ! Compute total loss rate
+ pls = rnuclgtot + growlg(ibin,igroup) + evaplg(ibin,igroup)
+
+ ! Figure out the new particle concentration without nucleation.
+ pc_nonuc = (pc(iz,ibin,ielem) + dtime * (ppd - rnucpe(ibin,ielem) - rhompe(ibin,ielem))) / (ONE + (pls - rnuclgtot) * dtime)
+
+ ! Update net particle number concentration during current timestep
+ ! due to production and loss rates.
+ pc(iz,ibin,ielem) = (pc(iz,ibin,ielem) + dtime * ppd) / (ONE + pls * dtime)
+
+ ! Now determine the number of particles produced by nucleation as the difference
+ ! between the actual particle count and that done without nucleation rates.
+ !
+ ! NOTE: This is for statistics and is done as a total for the step, not per substep.
+ pc_nucl(iz,ibin,ielem) = pc_nucl(iz,ibin,ielem) + (pc(iz,ibin,ielem) - pc_nonuc)
+ end if
+
+ ! Prevent particle concentrations from dropping below SMALL_PC
+ call smallconc(carma, cstate, iz, ibin, ielem, rc)
+
+ ! Return to caller with new particle number concentrations.
+ return
+end
diff --git a/src/physics/carma/base/rhoice_heymsfield2010.F90 b/src/physics/carma/base/rhoice_heymsfield2010.F90
new file mode 100644
index 0000000000..ee48054f8e
--- /dev/null
+++ b/src/physics/carma/base/rhoice_heymsfield2010.F90
@@ -0,0 +1,101 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates the effective ice densities for each bin, based upon
+!! the parameterization of Heymsfield et al. [2010].
+!!
+!! @author Chuck Bardeen
+!! @ version March 2010
+!!
+!! @see CARMAELEMENT_Create
+subroutine rhoice_heymsfield2010(carma, rhoice, igroup, regime, rho, aratelem, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ real(kind=f), intent(in) :: rhoice !! ice density(g/cm3)
+ integer, intent(in) :: igroup !! group index
+ character(len=4), intent(in) :: regime !! crystal regime [warm | cold | conv]
+ real(kind=f), intent(out) :: rho(NBIN) !! crystal density per bin (g/cm3)
+ real(kind=f), intent(out) :: aratelem(NBIN) !! projected area ratio ()
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: ibin ! bin index
+ real(kind=f) :: a ! scalar coefficient from Heysfield and Schmitt [2010]
+ real(kind=f), parameter :: b = 2.1_f ! exponential coefficient from Heysfield and Schmitt [2010]
+ real(kind=f) :: rbin ! predicated crystal radius (cm)
+ real(kind=f) :: dmax ! maximum diameter
+ real(kind=f) :: totalmass ! bin mass
+
+1 format(/,'rhoice_heymsfield2010::ERROR - unknown ice regime (', a, ').')
+
+
+ rc = RC_OK
+
+! Figure out the 'a' coefficient.
+ if (regime == "deep") then
+ a = 1.10e-2_f
+ else if (regime == "conv") then
+ a = 6.33e-3_f
+ else if (regime == "cold") then
+ a = 5.74e-3_f
+ else if (regime == "avg") then
+ a = 5.28e-3_f
+ else if (regime == "synp") then
+ a = 4.22e-3_f
+ else if (regime == "warm") then
+ a = 3.79e-3_f
+ else
+ if (do_print) write(LUNOPRT,1) regime
+ rc = RC_ERROR
+ return
+ end if
+
+ ! Get the starting mass for the first bin and the volume ratio from the CARMA_GROUP. This
+ ! call is used before initialization has happened, so the bin structure hasn't been
+ ! determined yet.
+
+ do ibin = 1, NBIN
+
+ ! Determine the total mass of the particle.
+ !
+ ! NOTE: This needs to match the logic in setupbins.F90, so that the ice density
+ ! and radii will be determined properly.
+ totalmass = rmassmin(igroup) * (rmrat(igroup)**(ibin-1))
+
+ ! Determine the radius of the particle from Heymsfield et al. [2010].
+ !
+ ! m(D) = a * D ^ b (all in cgs units)
+ rbin = ((totalmass / a) ** (1._f/b)) / 2._f
+
+ ! Determine the density of an equivalent sphere.
+ rho(ibin) = totalmass / ((4._f / 3._f ) * PI * (rbin ** 3._f))
+
+ ! Don't let the density be larger than the bulk density of ice. This
+ ! will happen for r < ~ 50 um in the parameterization, but this is
+ ! not physical.
+ rho(ibin) = min(rho(ibin), rhoice)
+
+ ! Determine the area ratio based on the formulation given in Schmitt and Heymsfield
+ ! [2009].
+ dmax = 2._f * rbin
+
+ if (dmax <= 200.e-4_f) then
+ aratelem(ibin) = exp(-38._f * dmax)
+ else
+ aratelem(ibin) = 0.16_f * (dmax ** (-0.27_f))
+ end if
+
+ end do
+
+end subroutine rhoice_heymsfield2010
diff --git a/src/physics/carma/base/rhopart.F90 b/src/physics/carma/base/rhopart.F90
new file mode 100644
index 0000000000..434ad51ea4
--- /dev/null
+++ b/src/physics/carma/base/rhopart.F90
@@ -0,0 +1,172 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine calculates new average particle densities.
+!!
+!! The particle mass density can change at each time-step due to
+!! changes in the core mass fraction.
+!!
+!! For particles that are hydrophilic and whose particle size changes based
+!! upon the relative humidity, and wet radius and density are also calculated.
+!! For particles that do not swell, the wet and dry radius and densities are
+!! the same.
+!!
+!! @author Chuck Bardeen Eric Jensen
+!! @ version May-2009; Oct-1995
+!!
+!! @see wetr
+subroutine rhopart(carma, cstate, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+ use sulfate_utils
+ use wetr
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: iz !! z index
+ integer :: igroup !! group index
+ integer :: ibin !! bin index
+ integer :: iepart !! element in group containing the particle concentration
+ integer :: jcore
+ integer :: iecore
+ real(kind=f) :: vcore(NBIN)
+ real(kind=f) :: mcore(NBIN)
+ real(kind=f) :: r_ratio
+ real(kind=f) :: h2o_mass
+
+ 1 format(/,'rhopart::WARNING - core mass > total mass, truncating : iz=',i4,',igroup=',&
+ i4,',ibin=',i4,',total mass=',e10.3,',core mass=',e10.3,',using rhop=',f9.4)
+
+ ! Calculate average particle mass density for each group
+ do igroup = 1,NGROUP
+
+ ! Define particle # concentration element index for current group
+ iepart = ienconc(igroup) ! element of particle number concentration
+
+ do iz = 1, NZ
+
+ ! If there are no cores, than the density of the particle is just the density
+ ! of the element.
+ if (ncore(igroup) < 1) then
+ rhop(iz,:,igroup) = rhoelem(:,iepart)
+
+ ! Otherwise, the density changes depending on the amount of core and volatile
+ ! components.
+ else
+
+ ! Calculate volume of cores and the mass of shell material
+ ! is the volume of core material and is the
+ ! mass of shell material.
+ vcore(:) = 0._f
+ mcore(:) = 0._f
+
+ do jcore = 1,ncore(igroup)
+ iecore = icorelem(jcore,igroup) ! core element
+
+ mcore(:) = mcore(:) + pc(iz,:,iecore)
+ vcore(:) = vcore(:) + pc(iz,:,iecore) / rhoelem(:,iecore)
+ enddo
+
+ ! Calculate average density
+ do ibin = 1,NBIN
+
+ ! If there is no core, the the density is that of the volatile element.
+ if (mcore(ibin) == 0._f) then
+ rhop(iz,ibin,igroup) = rhoelem(ibin,iepart)
+ else
+
+ ! Since core mass and particle number (i.e. total mass) are advected separately,
+ ! numerical diffusion during advection can cause problems where the core mass
+ ! becomes greater than the total mass. To prevent adevction errors from making the
+ ! group inconsistent, we will truncate core mass if it is larger than the total
+ ! mass.
+ if (mcore(ibin) > (rmass(ibin,igroup) * pc(iz,ibin,iepart))) then
+
+ ! Calculate the density.
+ rhop(iz,ibin,igroup) = mcore(ibin) / vcore(ibin)
+
+ ! NOTE: This error happens a lot, so this error message is commented out
+ ! by default.
+! if (do_print) write(LUNOPRT,1) iz, igroup, ibin, pc(iz,ibin,iepart)*rmass(ibin,igroup), &
+! mcore(ibin), rhop(iz,ibin,igroup)
+! rc = RC_WARNING
+
+ ! Repair total mass.
+ pc(iz,ibin,iepart) = mcore(ibin) / rmass(ibin,igroup)
+ else
+ rhop(iz,ibin,igroup) = (rmass(ibin,igroup) * pc(iz,ibin,iepart)) / &
+ ((pc(iz,ibin,iepart)*rmass(ibin,igroup) - mcore(ibin))/rhoelem(ibin,iepart) + vcore(ibin))
+ end if
+ end if
+ enddo
+ endif
+
+ ! If these particles are hygroscopic and grow in response to the relative
+ ! humidity, then caclulate a wet radius and wet density. Otherwise the wet
+ ! and dry radius are the same.
+
+ ! Determine the weight percent of sulfate, and store it for later use.
+ if (irhswell(igroup) == I_WTPCT_H2SO4) then
+ h2o_mass = gc(iz, igash2o) / (xmet(iz) * ymet(iz) * zmet(iz))
+ end if
+
+ ! Loop over particle size bins.
+ do ibin = 1,NBIN
+
+ ! If humidity affects the particle, then determine the equilbirium
+ ! radius and density based upon the relative humidity.
+ if (irhswell(igroup) == I_WTPCT_H2SO4) then
+
+ ! rlow
+ call getwetr(carma, igroup, relhum(iz), rlow(ibin,igroup), rlow_wet(iz,ibin,igroup), &
+ rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc, h2o_mass=h2o_mass, &
+ h2o_vp=pvapl(iz, igash2o), temp=t(iz))
+ if (rc < 0) return
+
+ ! rup
+ call getwetr(carma, igroup, relhum(iz), rup(ibin,igroup), rup_wet(iz,ibin,igroup), &
+ rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc, h2o_mass=h2o_mass, &
+ h2o_vp=pvapl(iz, igash2o), temp=t(iz))
+ if (rc < 0) return
+
+ ! r
+ call getwetr(carma, igroup, relhum(iz), r(ibin,igroup), r_wet(iz,ibin,igroup), &
+ rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc, h2o_mass=h2o_mass, &
+ h2o_vp=pvapl(iz, igash2o), temp=t(iz))
+ if (rc < 0) return
+
+ else
+ ! rlow
+ call getwetr(carma, igroup, relhum(iz), rlow(ibin,igroup), rlow_wet(iz,ibin,igroup), &
+ rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc)
+ if (rc < 0) return
+
+ ! rup
+ call getwetr(carma, igroup, relhum(iz), rup(ibin,igroup), rup_wet(iz,ibin,igroup), &
+ rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc)
+ if (rc < 0) return
+
+ ! r
+ call getwetr(carma, igroup, relhum(iz), r(ibin,igroup), r_wet(iz,ibin,igroup), &
+ rhop(iz,ibin,igroup), rhop_wet(iz,ibin,igroup), rc)
+ if (rc < 0) return
+ end if
+ end do
+ end do
+ enddo
+
+ ! Return to caller with new particle number densities.
+ return
+end
diff --git a/src/physics/carma/base/setupatm.F90 b/src/physics/carma/base/setupatm.F90
new file mode 100644
index 0000000000..f841f36a73
--- /dev/null
+++ b/src/physics/carma/base/setupatm.F90
@@ -0,0 +1,146 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine setups up parameters related to the atmospheric state. It assumes that the
+!! pressure, temperature, and dimensional fields (xc, dx, yc, dy, zc, zl) have already been
+!! specified and all state arrays allocated via CARMASTATE_Create().
+!!
+!! @author Chuck Bardeen
+!! @ version Feb-1995
+!! @see CARMASTATE_Create
+subroutine setupatm(carma, cstate, rescale, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ logical, intent(in) :: rescale !! rescale the fall velocity for zmet change, this is instead of realculating
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ !--
+ ! For air viscosity calculations
+ ! Air viscosity is from Sutherland's equation (using Smithsonian
+ ! Meteorological Tables, in which there is a misprint -- T is deg_K, not
+ ! deg_C.
+ real(kind=f), parameter :: rmu_0 = 1.8325e-4_f
+ real(kind=f), parameter :: rmu_t0 = 296.16_f
+ real(kind=f), parameter :: rmu_c = 120._f
+ real(kind=f), parameter :: rmu_const = rmu_0 * (rmu_t0 + rmu_c)
+
+ integer :: ielem, ibin, i, j, ix, iy, iz, ie, ig, ip, igrp, jgrp, igroup
+
+
+ ! Calculate the dry air density at each level, using the ideal gas
+ ! law. This will be used to calculate zmet.
+ rhoa(:) = p(:) / (R_AIR * t(:))
+
+ ! Calculate the dimensions and the dimensional metrics.
+ dz(:) = abs(zl(2:NZP1) - zl(1:NZ))
+
+ ! Horizontal Metrics
+ select case(igridh)
+ ! Cartesian
+ case (I_CART)
+ xmet(:) = 1._f
+ ymet(:) = 1._f
+
+ ! Latitude/Longitude
+ case (I_LL)
+ xmet(:) = REARTH * DEG2RAD * cos(DEG2RAD * yc(:))
+ ymet(:) = REARTH * DEG2RAD
+
+ case default
+ if (do_print) write(LUNOPRT,*) "setupatm:: ERROR - The specified horizontal grid type (", igridh, &
+ ") is not supported."
+ rc = -1
+ end select
+
+
+ ! Put the fall velocity back into cgs units, so that we can determine
+ ! new metrics and then scale it back. This is optional and is done instead
+ ! of recalculating everything from scratch to improve performance.
+ if (rescale .and. (igridv /= I_CART)) then
+ do ibin = 1, NBIN
+ do igroup = 1, NGROUP
+ vf(:, ibin, igroup) = vf(:, ibin, igroup) * zmetl(:)
+ dkz(:, ibin, igroup) = dkz(:, ibin, igroup) * (zmetl(:)**2)
+ end do
+ end do
+ end if
+
+
+ ! Vertical Metrics
+ select case(igridv)
+ ! Cartesian
+ case (I_CART)
+ zmet = 1._f
+
+ ! Sigma
+ case (I_SIG)
+ zmet(:) = abs(((pl(1:NZ) - pl(2:NZP1)) / (zl(1:NZ) - zl(2:NZP1))) / &
+ (GRAV * rhoa(:)))
+
+ ! Hybrid
+ case (I_HYBRID)
+ zmet(:) = abs(((pl(1:NZ) - pl(2:NZP1)) / (zl(1:NZ) - zl(2:NZP1))) / &
+ (GRAV * rhoa(:)))
+
+ case default
+ if (do_print) write(LUNOPRT,*) "setupatm:: ERROR - The specified vertical grid type (", igridv, &
+ ") is not supported."
+ rc = -1
+ end select
+
+ ! Interpolate the z metric to the grid box edges.
+ if (NZ == 1) then
+ zmetl(:) = zmet(1)
+ else
+
+ ! Extrpolate the top and bottom.
+ zmetl(1) = zmet(1) + (zmet(2) - zmet(1)) / (zc(2) - zc(1)) * (zl(1) - zc(1))
+ zmetl(NZP1) = zmet(NZ) + (zmet(NZ) - zmet(NZ-1)) / (zc(NZ) - zc(NZ-1)) * (zl(NZP1) - zc(NZ))
+
+ ! Interpolate the middles.
+ if (NZ > 2) then
+ do iz = 2, NZ
+ zmetl(iz) = zmet(iz-1) + (zmet(iz) - zmet(iz-1)) / (zc(iz) - zc(iz-1)) * (zl(iz) - zc(iz-1))
+ end do
+ end if
+ end if
+
+
+ ! Determine the z metrics at the grid box edges and then use this to put the
+ ! fall velocity back into /x/y/z units.
+ if (rescale .and. (igridv /= I_CART)) then
+ do ibin = 1, NBIN
+ do igroup = 1, NGROUP
+ vf(:, ibin, igroup) = vf(:, ibin, igroup) / zmetl(:)
+ dkz(:, ibin, igroup) = dkz(:, ibin, igroup) / (zmetl(:)**2)
+ end do
+ end do
+ end if
+
+
+ ! Scale the density into the units carma wants (i.e. /x/y/z)
+ rhoa(:) = rhoa(:) * xmet(:) * ymet(:) * zmet(:)
+
+ ! Use the pressure difference across the cell and the fact that the
+ ! atmosphere is hydrostatic to caclulate an average density in the
+ ! grid box.
+ rhoa_wet(:) = abs((pl(2:NZP1) - pl(1:NZ))) / (GRAV)
+ rhoa_wet(:) = (rhoa_wet(:) * xmet(:) * ymet(:)) / dz(:)
+
+ ! Calculate the thermal properties of the atmosphere.
+ rmu(:) = rmu_const / ( t(:) + rmu_c ) * (t(:) / rmu_t0 )**1.5_f
+ thcond(:) = (5.69_f + .017_f*(t(:) - T0)) * 4.186e2_f
+end subroutine
diff --git a/src/physics/carma/base/setupbdif.F90 b/src/physics/carma/base/setupbdif.F90
new file mode 100644
index 0000000000..54423d4f1f
--- /dev/null
+++ b/src/physics/carma/base/setupbdif.F90
@@ -0,0 +1,114 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluates particle vertical diffusion coefficients,
+!! dkz(k,i,j) [cm^2 s^-1].
+!!
+!! Method: Uses equation 8.73 from Seinfeld and Pandis [1998] along
+!! with the slip correction factor (bpm) calculated in the fall
+!! velocity setup.
+!!
+!! This routine requires that vertical profiles of temperature ,
+!! air density , viscosity , and slip correction are
+!! defined (i.e., initatm.f and setupvf.f must be called before this).
+!!
+!! NOTE: Eddy diffusion is carried out by the parent model, so the only
+!! diffusion that CARMA does is Brownian diffusion.
+!!
+!! @author Chuck Bardeen
+!! @version Aug-2010
+subroutine setupbdif(carma, cstate, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carmastate_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(in) :: carma !! the carma object
+ type(carmastate_type), intent(inout) :: cstate !! the carma state object
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: igroup, ibin, iz, k1, k2, nzm1
+
+ ! Define formats
+ 2 format(/,'Brownian diffusion coefficient (prior to interpolation)')
+ 3 format(/,'Particle group ',i3,/,' bin lev p [dyne/cm2] T [K] r [cm] wet r [cm] dkz [cm2/s]',/)
+ 4 format(i3,4x,i3,5(1pe11.3,4x))
+
+
+ ! Loop over all groups.
+ do igroup = 1, NGROUP
+
+ ! Loop over particle size bins.
+ do ibin = 1,NBIN
+
+ ! Loop over all atltitudes.
+ do iz = 1, NZ
+
+ ! Vertical brownian diffusion coefficient
+ dkz(iz,ibin,igroup) = (BK*t(iz)*bpm(iz,ibin,igroup)) / (6._f*PI*rmu(iz)*r_wet(iz,ibin,igroup) * rprat(ibin,igroup))
+
+ enddo
+ enddo
+ enddo
+
+ ! Print out diffusivities.
+#ifdef DEBUG
+ if (do_print_init) then
+
+ write(LUNOPRT,2)
+
+ do igroup = 1, NGROUP
+
+ write(LUNOPRT,3) igroup
+
+ do ibin = 1,NBIN
+
+ do iz = NZ, 1, -1
+ write(LUNOPRT,4) ibin,iz,p(iz),t(iz),r(ibin,igroup),r_wet(iz,ibin,igroup),dkz(iz,ibin,igroup)
+ end do
+ enddo
+ enddo
+
+ write(LUNOPRT,*) ""
+ end if
+#endif
+
+ ! Interpolate from layer mid-pts to layer boundaries.
+ ! is the diffusion coefficient at the lower edge of the layer
+ nzm1 = max(1, NZ-1)
+
+ ! Set upper boundary before averaging
+ dkz(NZP1,:,:) = dkz(NZ,:,:)
+
+ if (NZ .gt. 1) then
+ dkz(NZ,:,:) = sqrt(dkz(nzm1,:,:) * dkz(NZ,:,:))
+
+ if (NZ .gt. 2) then
+ do iz = NZ-1, 2, -1
+ dkz(iz,:,:) = sqrt(dkz(iz-1,:,:) * dkz(iz,:,:))
+ enddo
+ endif
+ endif
+
+ ! Scale cartesian diffusivities to the appropriate vertical coordinate system.
+ ! Non--cartesion coordinates are assumed to be positive downward, but
+ ! vertical velocities in this model are always assumed to be positive upward.
+ if( igridv .ne. I_CART )then
+ do igroup=1,NGROUP
+ do ibin=1,NBIN
+ dkz(:,ibin,igroup) = dkz(:,ibin,igroup) / (zmetl(:)**2)
+ enddo
+ enddo
+ endif
+
+ ! Return to caller with fall velocities evaluated.
+ return
+end
diff --git a/src/physics/carma/base/setupbins.F90 b/src/physics/carma/base/setupbins.F90
new file mode 100644
index 0000000000..c4f1ab0c8d
--- /dev/null
+++ b/src/physics/carma/base/setupbins.F90
@@ -0,0 +1,235 @@
+! Include shortname defintions, so that the F77 code does not have to be modified to
+! reference the CARMA structure.
+#include "carma_globaer.h"
+
+!! This routine evaluates the derived mapping arrays and sets up
+!! the particle size bins.
+!!
+!! @author Eric Jensen
+!! @ version Oct-1995
+subroutine setupbins(carma, rc)
+
+ ! types
+ use carma_precision_mod
+ use carma_enums_mod
+ use carma_constants_mod
+ use carma_types_mod
+ use carma_mod
+
+ implicit none
+
+ type(carma_type), intent(inout) :: carma !! the carma object
+ integer, intent(inout) :: rc !! return code, negative indicates failure
+
+ ! Local declarations
+ integer :: ielem, ibin, i, j, ix, iy, iz, ie, ig, ip, igrp, jgrp
+ real(kind=f) :: tmp_rhop(NBIN, NGROUP)
+ real(kind=f) :: vrfact
+ real(kind=f) :: cpi
+ ! Local declarations needed for creation of fractal bin structure
+ real(kind=f) :: rf, rp
+ real(kind=f) :: vpor, upor, gamma, happel, perm, brinkman, epsil, omega
+
+ ! Define formats
+ !
+ 1 format(a,': ',12i6)
+ 2 format(a,': ',i6)
+ 3 format(a,': ',f12.2)
+ 4 format(a,': ',12f12.2)
+ 5 format(/,'Particle grid structure (setupbins):')
+ 6 format(a,': ',1p12e12.3)
+ 7 format(a,': ',12l6)
+
+
+ ! Determine which elements are particle number concentrations
+ ! is the element corresponding to particle number
+ ! concentration in group
+ !
+ igrp = 0
+ do ielem = 1, NELEM
+ if( itype(ielem) .eq. I_INVOLATILE .or. &
+ itype(ielem) .eq. I_VOLATILE )then
+
+ igrp = igrp + 1
+ ienconc(igrp) = ielem
+ endif
+ enddo
+
+ if( igrp .gt. NGROUP )then
+ if (do_print) write(LUNOPRT,'(/,a)') 'CARMA_setupbin:: ERROR - bad itype array'
+ rc = -1
+ return
+ endif
+
+ ! Determine which group each element belongs to
+ ! i.e., is the group to which element belongs!
+ igrp = 0
+ do ielem = 1, NELEM
+ if( itype(ielem) .eq. I_INVOLATILE .or. &
+ itype(ielem) .eq. I_VOLATILE )then
+ igrp = igrp + 1
+ endif
+ igelem(ielem) = igrp
+ enddo
+
+ ! Determine how many cores are in each group .
+ ! The core elements in a group are given by .
+ !
+ ! Also evaluate whether or not second moment is used for each group.
+ ielem = 0
+
+ do igrp = 1, NGROUP
+
+ ncore(igrp) = 0
+ if_sec_mom(igrp) = .false.
+ imomelem(igrp) = 0
+
+ do j = 1, nelemg(igrp)
+
+ ielem = ielem + 1
+
+ if( itype(ielem) .eq. I_COREMASS .or. &
+ itype(ielem) .eq. I_VOLCORE )then
+
+ ncore(igrp) = ncore(igrp) + 1
+ icorelem(ncore(igrp),igrp) = ielem
+
+ elseif( itype(ielem) .eq. I_CORE2MOM )then
+
+ if_sec_mom(igrp) = .true.
+ imomelem(igrp) = ielem
+
+ endif
+
+ enddo
+ enddo
+
+ ! Particle mass densities (NBIN for each group) -- the user might want
+ ! to modify this (this code segment does not appear in setupaer subroutine
+ ! because is not defined until this subroutine).
+ do ig = 1,NGROUP
+ ie = ienconc(ig)
+ do ibin = 1,NBIN
+ tmp_rhop(ibin, ig) = rhoelem(ibin, ie)
+
+ ! Set initial density of all hydrometeor groups to 1 such that nucleation
+ ! mapping arrays are calculated correctly.
+ ! or not
+! if( itype(ie) .ne. I_INVOLATILE ) then
+! rhop3(ixyz,ibin,ig) = 1.
+! endif
+ enddo
+ enddo
+
+ ! Set up the particle bins.
+ ! For each particle group, the mass of a particle in
+ ! bin j is times that in bin j-1
+ !
+ ! rmass(NBIN,NGROUP) = bin center mass [g]
+ ! r(NBIN,NGROUP) = bin mean (volume-weighted) radius [cm]
+ ! vol(NBIN,NGROUP) = bin center volume [cm^3]
+ ! dr(NBIN,NGROUP) = bin width in radius space [cm]
+ ! dv(NBIN,NGROUP) = bin width in volume space [cm^3]
+ ! dm(NBIN,NGROUP) = bin width in mass space [g]
+ cpi = 4._f/3._f*PI
+
+ do igrp = 1, NGROUP
+
+ vrfact = ( (3._f/2._f/PI/(rmrat(igrp)+1._f))**(ONE/3._f) )* &
+ ( rmrat(igrp)**(ONE/3._f) - 1._f )
+
+ ! If rmassmin wasn't specified, then use rmin to determine the mass
+ ! of the first bin.
+ if (rmassmin(igrp) == 0._f) then
+ rmassmin(igrp) = cpi*tmp_rhop(1,igrp)*rmin(igrp)**3
+ else
+
+ ! Just for internal consistency, recalculate rmin based on the rmass
+ ! that is being used.
+ rmin(igrp) = (rmassmin(igrp) / cpi / tmp_rhop(1,igrp)) ** (1._f / 3._f)
+ end if
+
+ do j = 1, NBIN
+ rmass(j,igrp) = rmassmin(igrp) * rmrat(igrp)**(j-1)
+ rmassup(j,igrp) = 2._f*rmrat(igrp)/(rmrat(igrp)+1._f)*rmass(j,igrp)
+ dm(j,igrp) = 2._f*(rmrat(igrp)-1._f)/(rmrat(igrp)+1._f)*rmass(j,igrp)
+ vol(j,igrp) = rmass(j,igrp) / tmp_rhop(j,igrp)
+ r(j,igrp) = ( rmass(j,igrp)/tmp_rhop(j,igrp)/cpi )**(ONE/3._f)
+ rup(j,igrp) = ( rmassup(j,igrp)/tmp_rhop(j,igrp)/cpi )**(ONE/3._f)
+ dr(j,igrp) = vrfact*(rmass(j,igrp)/tmp_rhop(j,igrp))**(ONE/3._f)
+ rlow(j,igrp) = rup(j,igrp) - dr(j,igrp)
+
+ if (is_grp_fractal(igrp)) then
+ ! fractal flag is true
+
+ if (r(j,igrp) .le. rmon(igrp)) then ! if the bin radius is less than the monomer size
+
+ nmon(j,igrp) = 1.0_f
+ rrat(j,igrp) = 1.0_f
+ arat(j,igrp) = 1.0_f
+ rprat(j,igrp) = 1.0_f
+ df(j,igrp) = 3.0_f ! Reset fractal dimension to 3 (this is a formality)
+
+ else ! if bin radius is greater than the monomer size
+
+ rf = (1.0_f/falpha(igrp))**(1.0_f/df(j,igrp))*r(j,igrp)**(3.0_f/df(j,igrp))*rmon(igrp)**(1.0_f-3.0_f/df(j,igrp))
+ nmon(j,igrp) = falpha(igrp)*(rf/rmon(igrp))**df(j,igrp)
+
+ rrat(j,igrp) = rf/r(j,igrp)
+
+ ! Calculate mobility radius for permeable aggregates
+ ! using Vainshtein (2003) formulation
+ vpor = 1.0_f - (nmon(j,igrp))**(1.0_f-3.0_f/df(j,igrp)) ! Volume average porosity (eq. 3.2)
+ upor = 1.0_f-(1.0_f - vpor)*sqrt(df(j,igrp)/3.0_f) ! Uniform poroisty (eq. 3.10)
+ gamma = (1.0_f - upor)**(1.0_f/3.0_f)
+ happel = 2.0_f/(9.0_f*(1.0_f-upor))* & ! Happel permeability model
+ (3.0_f-4.5_f*gamma+4.5_f*gamma**5.0_f-3.0_f*gamma**6.0_f)/ &
+ (3.0_f+2.0_f*gamma**5.0_f)
+ perm = happel*rmon(igrp)**2.0_f ! Permeability (eq. 3.3)
+ brinkman = nmon(j,igrp)**(1.0_f/df(j,igrp))*1.0_f/sqrt(happel) ! Brinkman parameter (eq. 3.9)
+ epsil = 1.0_f - brinkman**(-1.)*tanh(brinkman) !
+ omega = 2.0_f/3.0_f*epsil/(2.0_f/3.0_f+epsil/brinkman**2.0_f) ! drag coefficient (eq. 2.7)
+ rp = rf * omega
+ rprat(j,igrp) = rp/r(j,igrp)
+
+ arat(j,igrp) = (rprat(j,igrp) / rrat(j, igrp))**2.0_f
+ endif
+ else
+ ! Not a fractal.
+ nmon(j,igrp) = 1.0_f
+ rprat(j,igrp) = 1.0_f
+ df(j,igrp) = 3.0_f
+ endif
+ enddo
+ enddo
+
+ ! Evaluate differences between valuse of