diff --git a/cime b/cime
index c855888b58c8..5a7e4a10b131 160000
--- a/cime
+++ b/cime
@@ -1 +1 @@
-Subproject commit c855888b58c87241919852072a409f98dadada22
+Subproject commit 5a7e4a10b1317ec896e549b7775af19aa8759a54
diff --git a/cime_config/allactive/config_compsets.xml b/cime_config/allactive/config_compsets.xml
index 06191bf7fef9..5b347a744d75 100755
--- a/cime_config/allactive/config_compsets.xml
+++ b/cime_config/allactive/config_compsets.xml
@@ -44,6 +44,11 @@
1850SOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV
+
+ WCYCL1850_chemUCI-Linozv3
+ 1850SOI_EAM%CHEMUCI-LINOZV3_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV
+
+
WCYCL1850-1pctCO2
1850SOI_EAM%CMIP6-1pctCO2_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV
@@ -70,6 +75,11 @@
20TRSOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV
+
+ WCYCL20TR_chemUCI-Linozv3
+ 20TRSOI_EAM%CHEMUCI-LINOZV3_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV
+
+
WCYCLSSP585
SSP585SOI_EAM%CMIP6_ELM%SPBC_MPASSI_MPASO_MOSART_SGLC_SWAV
@@ -302,6 +312,21 @@
1950SOI_EAM%CMIP6_ELM%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV
+
+ CRYO20TR
+ 20TRSOI_EAM%CMIP6_ELM%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV
+
+
+
+ CRYOSSP585
+ SSP585SOI_EAM%CMIP6_ELM%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV
+
+
+
+ CRYOSSP370
+ SSP370SOI_EAM%CMIP6_ELM%SPBC_MPASSI%DIB_MPASO%IBISMF_MOSART_SGLC_SWAV
+
+
BGCEXP_BDRD_CNPECACNT_SSP585_CMIP6
SSP585_EAM%CMIP6_ELM%CNPECACNTBC_MPASSI%BGC_MPASO%OIECO_MOSART_SGLC_SWAV_BGC%BDRD
diff --git a/cime_config/allactive/config_pesall.xml b/cime_config/allactive/config_pesall.xml
index 82675d693fe5..6b13769da8ca 100644
--- a/cime_config/allactive/config_pesall.xml
+++ b/cime_config/allactive/config_pesall.xml
@@ -107,7 +107,7 @@
-
+
allactive: default, 1 node x MAX_MPITASKS_PER_NODE mpi x 1 omp @ root 0
@@ -122,7 +122,7 @@
-
+
allactive: default, 1 node x MAX_MPITASKS_PER_NODE mpi x 2 omp @ root 0
@@ -152,8 +152,8 @@
56
56
56
- 36
- 36
+ 56
+ 56
16
16
56
@@ -290,7 +290,7 @@
- "pm-cpu 4 nodes, 256 partition"
+ "pm-cpu 4 nodes, 256 partition, 128x1, c8"
-4
-4
@@ -299,8 +299,11 @@
-4
-1
-1
- -4
+ 64
+
+ 8
+
@@ -348,8 +351,8 @@
280
280
280
- 240
- 240
+ 256
+ 256
-1
-1
280
@@ -823,7 +826,6 @@
ne120-wcycl on 42 nodes 128x1c8 ~0.7 sypd
128
- 256
3072
384
@@ -1611,8 +1613,8 @@
280
280
280
- 240
- 84
+ 256
+ 112
280
@@ -1664,22 +1666,22 @@
- -compset A_WCYCL* -res ne30pg2_oECv3 with MPASO on 7 nodes
- 64
+ -compset A_WCYCL* -res ne30pg2_oECv3 with MPASO on 7 nodes, 128x1 c8
+ 128
- 320
- 320
- 320
- 320
- 128
- 320
+ 640
+ 640
+ 640
+ 640
+ 256
+ 80
- 2
- 2
- 2
- 2
- 2
+ 1
+ 1
+ 1
+ 1
+ 1
1
@@ -1687,9 +1689,12 @@
0
0
0
- 320
+ 640
0
+
+ 8
+
-compset A_WCYCL* -res ne30pg2_oECv3 with MPASO on 58 nodes, ~20 sypd
@@ -2334,7 +2339,7 @@
- "pm-cpu ne30np4 and ne30np4.pg2 2 nodes 2 threads"
+ "pm-cpu ne30np4 and ne30np4.pg2 2 nodes 1 thread, 128x1 c8"
-2
-2
@@ -2343,16 +2348,11 @@
-2
-2
-2
- -2
+ 32
-
- 2
- 2
- 2
- 2
- 2
- 2
-
+
+ 8
+
@@ -2766,33 +2766,34 @@
- 8 nodes, 64x2
- 64
- 256
+ 8 nodes, 128x1 c8
- 320
- 320
- 320
- 360
- 192
- 320
+ 640
+ 640
+ 640
+ 640
+ 384
+ 80
0
0
0
0
- 320
+ 640
0
- 2
- 2
- 2
- 2
- 2
+ 1
+ 1
+ 1
+ 1
+ 1
1
+
+ 1
+
@@ -3023,6 +3024,28 @@
+
+
+
+ -4
+ -4
+ -4
+ -4
+ -4
+ -4
+ -4
+ -4
+
+
+ 1
+ 1
+ 1
+ 1
+ 1
+ 1
+
+
+
diff --git a/cime_config/config_files.xml b/cime_config/config_files.xml
index 358f25b311a8..f41ebcea7904 100644
--- a/cime_config/config_files.xml
+++ b/cime_config/config_files.xml
@@ -346,6 +346,7 @@
$COMP_ROOT_DIR_ROF/cime_config/testdefs/testmods_dirs
$COMP_ROOT_DIR_ATM/cime_config/testdefs/testmods_dirs
$COMP_ROOT_DIR_OCN/cime_config/testdefs/testmods_dirs
+ $COMP_ROOT_DIR_ICE/cime_config/testdefs/testmods_dirs
case_last
env_case.xml
diff --git a/cime_config/config_grids.xml b/cime_config/config_grids.xml
index b3d1cf9f7aae..32d55c310af0 100755
--- a/cime_config/config_grids.xml
+++ b/cime_config/config_grids.xml
@@ -2692,7 +2692,7 @@
569915
1
- $DIN_LOC_ROOT/share/domains/domain.ocn.SOwISC12to60E2r4-nomask.210119.nc
+ $DIN_LOC_ROOT/share/domains/domain.ocn.SOwISC12to60E2r4.210119.nc
SOwISC12to60E2r4 is a MPAS ice/ocean grid with enhanced resolution of 12km in the Southern Ocean around Antarctica. The high resolution regions smoothly transition to the background resolution of the standard low resolution 60to30km grid:
diff --git a/cime_config/config_inputdata.xml b/cime_config/config_inputdata.xml
index 254830b7d680..7ed6db38264e 100644
--- a/cime_config/config_inputdata.xml
+++ b/cime_config/config_inputdata.xml
@@ -6,6 +6,10 @@
wget
https://web.lcrc.anl.gov/public/e3sm/inputdata/
+
+ wget
+ https://portal.nersc.gov/project/e3sm/inputdata
+
svn
https://svn-ccsm-inputdata.cgd.ucar.edu/trunk/inputdata
diff --git a/cime_config/customize/provenance.py b/cime_config/customize/provenance.py
index 2b2c9afca2c8..fbd4fd583993 100644
--- a/cime_config/customize/provenance.py
+++ b/cime_config/customize/provenance.py
@@ -410,7 +410,10 @@ def _record_timing(case, lid):
with open(os.path.join(full_timing_dir, "GIT_DESCRIBE.{}".format(lid)), "w") as fd:
fd.write(desc)
- # What this block does is mysterious to me (JGF)
+ # Collect syslog if enabled on machine. (Sarat)
+ # Ref: https://github.com/ESMCI/cime/blob/655de638182ba9381a5d6607cdbade3b0a70a040/CIME/case/case.py#L1696
+ # If machines_dir has a syslog. script, it is copied as caseroot/Tools/mach_syslog and run.
+ # Otherwise, syslog.noop is used and no output is produced.
if job_id is not None:
_record_syslog(case, lid, job_id, caseroot, rundir, full_timing_dir)
@@ -422,10 +425,13 @@ def _record_queue_info(mach, job_id, lid, full_timing_dir):
_record_nersc_queue(job_id, lid, full_timing_dir)
elif mach in ["anvil", "chrysalis", "compy"]:
_record_anl_queue(job_id, lid, full_timing_dir)
+#TODO: Add Perlmutter
+ elif mach in ["frontier", "crusher"]:
+ _record_slurm_queue(job_id, lid, full_timing_dir)
elif mach == "summit":
_record_olcf_queue(job_id, lid, full_timing_dir)
-
+# TODO: Switch to generic Slurm routine
def _record_nersc_queue(job_id, lid, full_timing_dir):
for cmd, filename in [
("sinfo -a -l", "sinfol"),
@@ -441,7 +447,24 @@ def _record_nersc_queue(job_id, lid, full_timing_dir):
utils.run_cmd_no_fail(cmd, arg_stdout=filename, from_dir=full_timing_dir)
utils.gzip_existing_file(os.path.join(full_timing_dir, filename))
+# Generic Slurm queue info (Frontier)
+# TODO: Consolidate _record routines based on batch system if generalization is adequate
+def _record_slurm_queue(job_id, lid, full_timing_dir):
+ for cmd, filename in [
+ ("sinfo -a -l", "sinfol"),
+ ("scontrol show jobid %s" % job_id, "scontrol_jobid"),
+ (
+ "squeue -o '%.10i %.15P %.20j %.10u %.7a %.2t %.6D %.8C %.10M %.10l %.20S %.20V'",
+ "squeuef",
+ ),
+ ("squeue -t R -o '%.10i %R'", "squeues"),
+ ]:
+ filename = "%s.%s" % (filename, lid)
+ utils.run_cmd_no_fail(cmd, arg_stdout=filename, from_dir=full_timing_dir)
+ utils.gzip_existing_file(os.path.join(full_timing_dir, filename))
+
+# TODO: Switch to generic Slurm routine
def _record_anl_queue(job_id, lid, full_timing_dir):
for cmd, filename in [
("sinfo -l", "sinfol"),
@@ -763,7 +786,8 @@ def _get_batch_job_id_for_syslog(case):
"""
mach = case.get_value("MACH")
try:
- if mach in ["anvil", "chrysalis", "compy", "cori-haswell", "cori-knl", "pm-cpu", "pm-gpu", "alvarez"]:
+ if mach in ["anvil", "chrysalis", "compy", "cori-haswell", "cori-knl", "pm-cpu", "pm-gpu", "alvarez","frontier","crusher"]:
+ # Note: Besides, SLURM_JOB_ID, equivalent SLURM_JOBID is also present on some systems (Frontier).
return os.environ["SLURM_JOB_ID"]
elif mach in ["theta"]:
return os.environ["COBALT_JOBID"]
diff --git a/cime_config/machines/Depends.anlgce.gnu.cmake b/cime_config/machines/Depends.anlgce.gnu.cmake
new file mode 100644
index 000000000000..09ad9d987878
--- /dev/null
+++ b/cime_config/machines/Depends.anlgce.gnu.cmake
@@ -0,0 +1,14 @@
+# For this file, see internal compiler error on anlgce with -O2
+set(NOOPT
+ eam/src/physics/cam/zm_conv.F90)
+
+if (NOT DEBUG)
+ foreach(ITEM IN LISTS NOOPT)
+ e3sm_remove_flags("${ITEM}" "-O2")
+ e3sm_remove_flags("${ITEM}" "-O")
+ endforeach()
+endif()
+
+
+
+
diff --git a/cime_config/machines/Depends.chrysalis.intel.cmake b/cime_config/machines/Depends.chrysalis.intel.cmake
index a59f2b3c64d9..8f4a1327ea6e 100644
--- a/cime_config/machines/Depends.chrysalis.intel.cmake
+++ b/cime_config/machines/Depends.chrysalis.intel.cmake
@@ -1,7 +1,12 @@
# Reduce optimization on files with long compile times
+# Also reduce optimizaiton on files with machine-dependent behavior
set(O2MODELSRC
- eam/src/physics/cam/micro_mg_cam.F90 # ~2027 seconds
- elm/src/data_types/VegetationDataType.F90 # ~ 930 seconds
+ eam/src/physics/cam/micro_mg_cam.F90 # ~ 2027 seconds
+ elm/src/data_types/VegetationDataType.F90 # ~ 930 seconds
+ elm/src/external_models/fates/main/FatesHistoryInterfaceMod.F90 # ~ 1685 seconds
+ elm/src/data_types/ColumnDataType.F90 # ~ 556 seconds
+ eam/src/physics/cam/zm_conv.F90 # for machine dependent behavior
+ eam/src/physics/cam/zm_microphysics.F90 # for machine dependent behavior
)
if (NOT DEBUG)
foreach(ITEM IN LISTS O2MODELSRC)
diff --git a/cime_config/machines/Depends.crayclanggpu.cmake b/cime_config/machines/Depends.crayclanggpu.cmake
new file mode 100644
index 000000000000..8c70a4610f11
--- /dev/null
+++ b/cime_config/machines/Depends.crayclanggpu.cmake
@@ -0,0 +1,30 @@
+list(APPEND NOOPT_FILES
+ eam/src/physics/cam/micro_mg_cam.F90
+ elm/src/data_types/ColumnDataType.F90
+ elm/src/data_types/VegetationDataType.F90
+ elm/src/biogeochem/CNNitrogenFluxType.F90
+ elm/src/biogeochem/CNCarbonFluxType.F90
+)
+
+# Files added below to mitigate excessive compilation times
+set(O1MODELSRC
+ eam/src/physics/cam/micro_mg1_5.F90
+ eam/src/physics/cam/micro_mg2_0.F90
+)
+
+set(O2MODELSRC
+)
+
+if (NOT DEBUG)
+ foreach(ITEM IN LISTS O2MODELSRC)
+ e3sm_remove_flags("${ITEM}" "-O3")
+ e3sm_add_flags("${ITEM}" "-O2")
+ endforeach()
+ foreach(ITEM IN LISTS O1MODELSRC)
+ e3sm_remove_flags("${ITEM}" "-O3")
+ e3sm_remove_flags("${ITEM}" "-O2")
+ e3sm_add_flags("${ITEM}" "-O1")
+ endforeach()
+endif()
+
+
diff --git a/cime_config/machines/Depends.pm-cpu.gnu.cmake b/cime_config/machines/Depends.pm-cpu.gnu.cmake
new file mode 100644
index 000000000000..58c0c05d273f
--- /dev/null
+++ b/cime_config/machines/Depends.pm-cpu.gnu.cmake
@@ -0,0 +1,14 @@
+# For this file, fixes non-BFB behavior of stealth feature on pm-cpu with -O2
+set(NOOPT
+ eam/src/physics/cam/zm_conv.F90)
+
+if (NOT DEBUG)
+ foreach(ITEM IN LISTS NOOPT)
+ e3sm_remove_flags("${ITEM}" "-O2")
+ e3sm_remove_flags("${ITEM}" "-O")
+ endforeach()
+endif()
+
+
+
+
diff --git a/cime_config/machines/Depends.pm-cpu.intel.cmake b/cime_config/machines/Depends.pm-cpu.intel.cmake
new file mode 100644
index 000000000000..a6deb4e6efec
--- /dev/null
+++ b/cime_config/machines/Depends.pm-cpu.intel.cmake
@@ -0,0 +1,15 @@
+# For this file, we see internal compiler error with ifx (via intel-oneapi module) on pm-cpu with -O2
+# Commenting for now as we are using intel module which is not seeing build issue
+#set(NOOPT
+# eam/src/physics/cam/debug_info.F90)
+
+#if (NOT DEBUG)
+# foreach(ITEM IN LISTS NOOPT)
+# e3sm_remove_flags("${ITEM}" "-O2")
+# e3sm_add_flags("${ITEM}" "-O0")
+# endforeach()
+#endif()
+
+
+
+
diff --git a/cime_config/machines/cmake_macros/amdclang_crusher.cmake b/cime_config/machines/cmake_macros/amdclang_crusher.cmake
index 4110b9f7d80c..86e4bd2c9e77 100644
--- a/cime_config/machines/cmake_macros/amdclang_crusher.cmake
+++ b/cime_config/machines/cmake_macros/amdclang_crusher.cmake
@@ -4,7 +4,6 @@ if (NOT MPILIB STREQUAL mpi-serial)
endif()
set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
set(CRAY_LIBSCI_PREFIX_DIR "$ENV{CRAY_LIBSCI_PREFIX_DIR}")
-set(PIO_FILESYSTEM_HINTS "gpfs")
#if (COMP_NAME STREQUAL gptl)
# string(APPEND CPPDEFS " -DFORTRANUNDERSCORE")
#endif()
diff --git a/cime_config/machines/cmake_macros/amdclang_frontier.cmake b/cime_config/machines/cmake_macros/amdclang_frontier.cmake
new file mode 100644
index 000000000000..86e4bd2c9e77
--- /dev/null
+++ b/cime_config/machines/cmake_macros/amdclang_frontier.cmake
@@ -0,0 +1,9 @@
+string(APPEND SLIBS " -L$ENV{PNETCDF_PATH}/lib -lpnetcdf -L$ENV{CRAY_LIBSCI_PREFIX_DIR}/lib -lsci_amd")
+if (NOT MPILIB STREQUAL mpi-serial)
+ string(APPEND SLIBS " -L$ENV{ADIOS2_DIR}/lib64 -ladios2_c_mpi -ladios2_c -ladios2_core_mpi -ladios2_core -ladios2_evpath -ladios2_ffs -ladios2_dill -ladios2_atl -ladios2_enet")
+endif()
+set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
+set(CRAY_LIBSCI_PREFIX_DIR "$ENV{CRAY_LIBSCI_PREFIX_DIR}")
+#if (COMP_NAME STREQUAL gptl)
+# string(APPEND CPPDEFS " -DFORTRANUNDERSCORE")
+#endif()
diff --git a/cime_config/machines/cmake_macros/amdclanggpu_crusher.cmake b/cime_config/machines/cmake_macros/amdclanggpu_crusher.cmake
index be0baa1ecc94..50f9f9f8129e 100644
--- a/cime_config/machines/cmake_macros/amdclanggpu_crusher.cmake
+++ b/cime_config/machines/cmake_macros/amdclanggpu_crusher.cmake
@@ -4,7 +4,6 @@ if (NOT DEBUG)
string(APPEND FFLAGS " -O2")
endif()
-set(PIO_FILESYSTEM_HINTS "gpfs")
set(NETCDF_PATH "$ENV{NETCDF_DIR}")
set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
string(APPEND CMAKE_OPTS " -DPIO_ENABLE_TOOLS:BOOL=OFF")
@@ -12,7 +11,7 @@ string(APPEND SLIBS " -L$ENV{CRAY_LIBSCI_PREFIX_DIR}/lib -lsci_amd")
set(MPICXX "hipcc")
set(SCXX "hipcc")
-string(APPEND CXXFLAGS " -I$ENV{MPICH_DIR}/include --amdgpu-target=gfx90a")
+string(APPEND CXXFLAGS " -I$ENV{MPICH_DIR}/include --offload-arch=gfx90a")
string(APPEND SLIBS " -L$ENV{MPICH_DIR}/lib -lmpi -L$ENV{CRAY_MPICH_ROOTDIR}/gtl/lib -lmpi_gtl_hsa")
if (NOT MPILIB STREQUAL mpi-serial)
string(APPEND SLIBS " -L$ENV{ADIOS2_DIR}/lib64 -ladios2_c_mpi -ladios2_c -ladios2_core_mpi -ladios2_core -ladios2_evpath -ladios2_ffs -ladios2_dill -ladios2_atl -ladios2_enet")
@@ -20,3 +19,5 @@ endif()
string(APPEND KOKKOS_OPTIONS " -DKokkos_ENABLE_HIP=On -DKokkos_ARCH_ZEN3=On -DKokkos_ARCH_VEGA90A=On")
+set(USE_HIP "TRUE")
+string(APPEND HIP_FLAGS "${CXXFLAGS} -munsafe-fp-atomics -x hip")
diff --git a/cime_config/machines/cmake_macros/amdclanggpu_frontier.cmake b/cime_config/machines/cmake_macros/amdclanggpu_frontier.cmake
new file mode 100644
index 000000000000..93e1b9691340
--- /dev/null
+++ b/cime_config/machines/cmake_macros/amdclanggpu_frontier.cmake
@@ -0,0 +1,20 @@
+if (NOT DEBUG)
+ string(APPEND CFLAGS " -O2")
+ string(APPEND CXXFLAGS " -O2")
+ string(APPEND FFLAGS " -O2")
+endif()
+
+set(NETCDF_PATH "$ENV{NETCDF_DIR}")
+set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
+string(APPEND CMAKE_OPTS " -DPIO_ENABLE_TOOLS:BOOL=OFF")
+string(APPEND SLIBS " -L$ENV{CRAY_LIBSCI_PREFIX_DIR}/lib -lsci_amd")
+
+set(MPICXX "hipcc")
+set(SCXX "hipcc")
+string(APPEND CXXFLAGS " -I$ENV{MPICH_DIR}/include --offload-arch=gfx90a")
+string(APPEND SLIBS " -L$ENV{MPICH_DIR}/lib -lmpi -L$ENV{CRAY_MPICH_ROOTDIR}/gtl/lib -lmpi_gtl_hsa")
+
+string(APPEND KOKKOS_OPTIONS " -DKokkos_ENABLE_HIP=On -DKokkos_ARCH_ZEN3=On -DKokkos_ARCH_VEGA90A=On")
+
+set(USE_HIP "TRUE")
+string(APPEND HIP_FLAGS "${CXXFLAGS} -munsafe-fp-atomics -x hip")
diff --git a/cime_config/machines/cmake_macros/crayclang-scream_crusher-scream-gpu.cmake b/cime_config/machines/cmake_macros/crayclang-scream_crusher-scream-gpu.cmake
index e71f737f8c7e..de73e2845c19 100644
--- a/cime_config/machines/cmake_macros/crayclang-scream_crusher-scream-gpu.cmake
+++ b/cime_config/machines/cmake_macros/crayclang-scream_crusher-scream-gpu.cmake
@@ -24,12 +24,13 @@ string(APPEND LDFLAGS " -L${MPICH_DIR}/lib -lmpi -L/opt/cray/pe/mpich/8.1.16/gtl
# For YAKL's -lroctx64 -lrocfft; the rocm module doesn't set this.
string(APPEND LDFLAGS " -L$ENV{ROCM_PATH}/lib")
-#this resolves a crash in mct in docn init
-if (NOT DEBUG)
+# 'NOT DEBUG': this resolves a crash in mct in docn init
+# 'DEBUG' casee, too: resolves a build error in elm/src/main/elm_varctl.F90 due to several OpenACC syntax errors
+#if (NOT DEBUG)
string(APPEND CFLAGS " -O2 -hnoacc -hfp0 -hipa0")
string(APPEND FFLAGS " -O2 -hnoacc -hfp0 -hipa0")
-endif()
+#endif()
string(APPEND CPPDEFS " -DCPRCRAY")
-set(SCREAM_MPI_ON_DEVICE OFF CACHE STRING "See SCREAM issue #2080.")
+#set(SCREAM_MPI_ON_DEVICE OFF CACHE STRING "See SCREAM issue #2080.")
diff --git a/cime_config/machines/cmake_macros/crayclang.cmake b/cime_config/machines/cmake_macros/crayclang.cmake
index 70a815f34b4b..b6f071ff4702 100644
--- a/cime_config/machines/cmake_macros/crayclang.cmake
+++ b/cime_config/machines/cmake_macros/crayclang.cmake
@@ -13,7 +13,7 @@ endif()
string(APPEND CPPDEFS " -DFORTRANUNDERSCORE -DNO_R16 -DCPRCRAY")
string(APPEND FC_AUTO_R8 " -s real64")
# -em (default) generates MODULENAME.mod files
-string(APPEND FFLAGS " -f free -N 255 -h byteswapio -em")
+string(APPEND FFLAGS " -f free -h byteswapio -em")
if (NOT compile_threaded)
# -M1077 flag used to suppress message about OpenMP directives
# that are ignored for non-threaded builds. (-h omp inactive)
diff --git a/cime_config/machines/cmake_macros/crayclang_crusher.cmake b/cime_config/machines/cmake_macros/crayclang_crusher.cmake
index d2d0e935fc97..b7977176523d 100644
--- a/cime_config/machines/cmake_macros/crayclang_crusher.cmake
+++ b/cime_config/machines/cmake_macros/crayclang_crusher.cmake
@@ -15,5 +15,4 @@ if (NOT MPILIB STREQUAL mpi-serial)
endif()
set(NETCDF_PATH "$ENV{NETCDF_DIR}")
set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
-set(PIO_FILESYSTEM_HINTS "gpfs")
string(APPEND CXX_LIBS " -lstdc++")
diff --git a/cime_config/machines/cmake_macros/crayclang_frontier.cmake b/cime_config/machines/cmake_macros/crayclang_frontier.cmake
new file mode 100644
index 000000000000..b7977176523d
--- /dev/null
+++ b/cime_config/machines/cmake_macros/crayclang_frontier.cmake
@@ -0,0 +1,18 @@
+if (COMP_NAME STREQUAL elm)
+ # See Land NaNs in conditionals: https://github.com/E3SM-Project/E3SM/issues/4996
+ string(APPEND FFLAGS " -hfp0")
+endif()
+# Disable ipa and zero initialization are for other NaN isues:
+# https://github.com/E3SM-Project/E3SM/pull/5208
+string(APPEND FFLAGS " -hipa0 -hzero")
+# -em -ef generates modulename.mod (lowercase files) to support
+# Scorpio installs
+string(APPEND FFLAGS " -em -ef")
+
+string(APPEND SLIBS " -L$ENV{PNETCDF_PATH}/lib -lpnetcdf")
+if (NOT MPILIB STREQUAL mpi-serial)
+ string(APPEND SLIBS " -L$ENV{ADIOS2_DIR}/lib64 -ladios2_c_mpi -ladios2_c -ladios2_core_mpi -ladios2_core -ladios2_evpath -ladios2_ffs -ladios2_dill -ladios2_atl -ladios2_enet")
+endif()
+set(NETCDF_PATH "$ENV{NETCDF_DIR}")
+set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
+string(APPEND CXX_LIBS " -lstdc++")
diff --git a/cime_config/machines/cmake_macros/crayclanggpu.cmake b/cime_config/machines/cmake_macros/crayclanggpu.cmake
new file mode 100644
index 000000000000..660b72f5fcf0
--- /dev/null
+++ b/cime_config/machines/cmake_macros/crayclanggpu.cmake
@@ -0,0 +1,45 @@
+# Ran into Scorpio build issues using base and child compiler macro files.
+# Especially specified compilers were not picked up properly.
+# Had to replicate section below to get things working as expected.
+# Commenting out until we figure out how to properly handle this.
+
+# if (compile_threaded)
+# string(APPEND FFLAGS " -fopenmp")
+# string(APPEND CFLAGS " -fopenmp")
+# string(APPEND CXXFLAGS " -fopenmp")
+# string(APPEND LDFLAGS " -fopenmp")
+# endif()
+# if (DEBUG)
+# string(APPEND CFLAGS " -O0 -g")
+# string(APPEND FFLAGS " -O0 -g")
+# string(APPEND CXXFLAGS " -O0 -g")
+# string(APPEND CPPDEFS " -DYAKL_DEBUG")
+# endif()
+# string(APPEND CPPDEFS " -DFORTRANUNDERSCORE -DNO_R16 -DCPRCRAY")
+# string(APPEND FC_AUTO_R8 " -s real64")
+# string(APPEND FFLAGS " -f free -N 255 -h byteswapio -em")
+# if (NOT compile_threaded)
+# # -M1077 flag used to suppress message about OpenMP directives
+# # that are ignored for non-threaded builds. (-h omp inactive)
+# # Details: `explain ftn-1077`
+# string(APPEND FFLAGS " -M1077")
+# endif()
+# string(APPEND FFLAGS_NOOPT " -O0")
+# set(HAS_F2008_CONTIGUOUS "TRUE")
+# string(APPEND LDFLAGS " -Wl,--allow-multiple-definition")
+# set(SUPPORTS_CXX "TRUE")
+# set(CXX_LINKER "FORTRAN")
+# set(MPICC "cc")
+# set(MPICXX "hipcc")
+# set(MPIFC "ftn")
+# set(SCC "cc")
+# set(SCXX "hipcc")
+# set(SFC "ftn")
+
+#if (NOT DEBUG)
+# string(APPEND CFLAGS " -O2")
+# string(APPEND CXXFLAGS " -O2")
+# string(APPEND FFLAGS " -O2")
+#endif()
+
+
diff --git a/cime_config/machines/cmake_macros/crayclanggpu_crusher.cmake b/cime_config/machines/cmake_macros/crayclanggpu_crusher.cmake
index eed691418840..dde3ba91f818 100644
--- a/cime_config/machines/cmake_macros/crayclanggpu_crusher.cmake
+++ b/cime_config/machines/cmake_macros/crayclanggpu_crusher.cmake
@@ -21,7 +21,12 @@ if (NOT compile_threaded)
endif()
string(APPEND FFLAGS_NOOPT " -O0")
set(HAS_F2008_CONTIGUOUS "TRUE")
-string(APPEND LDFLAGS " -Wl,--allow-multiple-definition")
+
+# -Wl,--allow-shlib-undefined was added to address rocm 5.4.3 Fortran linker issue:
+# /opt/rocm-5.4.3/lib/libhsa-runtime64.so.1: undefined reference to `std::condition_variable::wait(std::unique_lock&)@GLIBCXX_3.4.30'
+# AMD started building with GCC 12.2.0, which brings in a GLIBCXX symbol that isn't in CCE's default GCC toolchain.
+string(APPEND LDFLAGS " -Wl,--allow-multiple-definition -Wl,--allow-shlib-undefined")
+
set(SUPPORTS_CXX "TRUE")
set(CXX_LINKER "FORTRAN")
set(MPICC "cc")
@@ -31,6 +36,8 @@ set(SCC "cc")
set(SCXX "hipcc")
set(SFC "ftn")
+# Switch to O3 for better performance
+# Using O2 to ensure passing tests
if (NOT DEBUG)
string(APPEND CFLAGS " -O2")
string(APPEND CXXFLAGS " -O2")
@@ -52,7 +59,7 @@ set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
string(APPEND CMAKE_OPTS " -DPIO_ENABLE_TOOLS:BOOL=OFF")
string(APPEND CXX_LIBS " -lstdc++")
-string(APPEND CXXFLAGS " -I$ENV{MPICH_DIR}/include --amdgpu-target=gfx90a")
+string(APPEND CXXFLAGS " -I$ENV{MPICH_DIR}/include --offload-arch=gfx90a")
string(APPEND SLIBS " -L$ENV{MPICH_DIR}/lib -lmpi -L$ENV{CRAY_MPICH_ROOTDIR}/gtl/lib -lmpi_gtl_hsa")
if (NOT MPILIB STREQUAL mpi-serial)
string(APPEND SLIBS " -L$ENV{ADIOS2_DIR}/lib64 -ladios2_c_mpi -ladios2_c -ladios2_core_mpi -ladios2_core -ladios2_evpath -ladios2_ffs -ladios2_dill -ladios2_atl -ladios2_enet")
@@ -60,3 +67,5 @@ endif()
string(APPEND KOKKOS_OPTIONS " -DKokkos_ENABLE_HIP=On -DKokkos_ARCH_ZEN3=On -DKokkos_ARCH_VEGA90A=On")
+set(USE_HIP "TRUE")
+string(APPEND HIP_FLAGS "${CXXFLAGS} -munsafe-fp-atomics -x hip")
diff --git a/cime_config/machines/cmake_macros/crayclanggpu_frontier.cmake b/cime_config/machines/cmake_macros/crayclanggpu_frontier.cmake
new file mode 100644
index 000000000000..365d7acb0796
--- /dev/null
+++ b/cime_config/machines/cmake_macros/crayclanggpu_frontier.cmake
@@ -0,0 +1,72 @@
+if (compile_threaded)
+ string(APPEND FFLAGS " -fopenmp")
+ string(APPEND CFLAGS " -fopenmp")
+ string(APPEND CXXFLAGS " -fopenmp")
+ string(APPEND LDFLAGS " -fopenmp")
+endif()
+if (DEBUG)
+ string(APPEND CFLAGS " -O0 -g")
+ string(APPEND FFLAGS " -O0 -g")
+ string(APPEND CXXFLAGS " -O0 -g")
+ string(APPEND CPPDEFS " -DYAKL_DEBUG")
+endif()
+string(APPEND CPPDEFS " -DFORTRANUNDERSCORE -DNO_R16 -DCPRCRAY")
+string(APPEND FC_AUTO_R8 " -s real64")
+string(APPEND FFLAGS " -f free -N 255 -h byteswapio -em")
+if (NOT compile_threaded)
+ # -M1077 flag used to suppress message about OpenMP directives
+ # that are ignored for non-threaded builds. (-h omp inactive)
+ # Details: `explain ftn-1077`
+ string(APPEND FFLAGS " -M1077")
+endif()
+string(APPEND FFLAGS_NOOPT " -O0")
+set(HAS_F2008_CONTIGUOUS "TRUE")
+
+# -Wl,--allow-shlib-undefined was added to address rocm 5.4.3 Fortran linker issue:
+# /opt/rocm-5.4.3/lib/libhsa-runtime64.so.1: undefined reference to `std::condition_variable::wait(std::unique_lock&)@GLIBCXX_3.4.30'
+# AMD started building with GCC 12.2.0, which brings in a GLIBCXX symbol that isn't in CCE's default GCC toolchain.
+string(APPEND LDFLAGS " -Wl,--allow-multiple-definition -Wl,--allow-shlib-undefined")
+
+set(SUPPORTS_CXX "TRUE")
+set(CXX_LINKER "FORTRAN")
+set(MPICC "cc")
+set(MPICXX "hipcc")
+set(MPIFC "ftn")
+set(SCC "cc")
+set(SCXX "hipcc")
+set(SFC "ftn")
+
+# Switching to O3 for performance benchmarking
+# Will revisit any failing tests
+if (NOT DEBUG)
+ string(APPEND CFLAGS " -O3")
+ string(APPEND CXXFLAGS " -O3")
+ string(APPEND FFLAGS " -O3")
+endif()
+
+if (COMP_NAME STREQUAL elm)
+ # See Land NaNs in conditionals: https://github.com/E3SM-Project/E3SM/issues/4996
+ string(APPEND FFLAGS " -hfp0")
+endif()
+# -em -ef generates modulename.mod (lowercase files) to support
+# Scorpio installs
+# Disable ipa and zero initialization are for other NaN isues:
+# https://github.com/E3SM-Project/E3SM/pull/5208
+string(APPEND FFLAGS " -hipa0 -hzero -em -ef -hnoacc")
+# Solving a 15.0.0 build issue
+#string(APPEND FFLAGS " -hsystem_alloc")
+
+set(NETCDF_PATH "$ENV{NETCDF_DIR}")
+set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
+string(APPEND CMAKE_OPTS " -DPIO_ENABLE_TOOLS:BOOL=OFF")
+string(APPEND CXX_LIBS " -lstdc++")
+
+string(APPEND CXXFLAGS " -I$ENV{MPICH_DIR}/include --offload-arch=gfx90a")
+string(APPEND SLIBS " -L$ENV{MPICH_DIR}/lib -lmpi -L$ENV{CRAY_MPICH_ROOTDIR}/gtl/lib -lmpi_gtl_hsa")
+# string(APPEND SLIBS " -L$ENV{ROCM_PATH}/lib -lamdhip64 -L$ENV{OLCF_OPENBLAS_ROOT}/lib -lopenblas $ENV{OLCF_LIBUNWIND_ROOT}/lib/libunwind.a /sw/frontier/spack-envs/base/opt/cray-sles15-zen3/clang-14.0.0-rocm5.2.0/gperftools-2.10-6g5acp4pcilrl62tddbsbxlut67pp7qn/lib/libtcmalloc.a")
+string(APPEND SLIBS " -L$ENV{ROCM_PATH}/lib -lamdhip64")
+
+string(APPEND KOKKOS_OPTIONS " -DKokkos_ENABLE_HIP=On -DKokkos_ARCH_ZEN3=On -DKokkos_ARCH_VEGA90A=On")
+
+set(USE_HIP "TRUE")
+string(APPEND HIP_FLAGS "${CXXFLAGS} -munsafe-fp-atomics -x hip")
diff --git a/cime_config/machines/cmake_macros/gnu_crusher.cmake b/cime_config/machines/cmake_macros/gnu_crusher.cmake
index a63383fcd514..fbbfc5e50c5a 100644
--- a/cime_config/machines/cmake_macros/gnu_crusher.cmake
+++ b/cime_config/machines/cmake_macros/gnu_crusher.cmake
@@ -12,4 +12,3 @@ if (NOT MPILIB STREQUAL mpi-serial)
endif()
set(NETCDF_PATH "$ENV{NETCDF_DIR}")
set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
-set(PIO_FILESYSTEM_HINTS "gpfs")
diff --git a/cime_config/machines/cmake_macros/gnu_docker-scream.cmake b/cime_config/machines/cmake_macros/gnu_docker-scream.cmake
index c6cd5939554b..eb95c7113ce7 100644
--- a/cime_config/machines/cmake_macros/gnu_docker-scream.cmake
+++ b/cime_config/machines/cmake_macros/gnu_docker-scream.cmake
@@ -1,5 +1,5 @@
set(AR "/opt/conda/bin/x86_64-conda-linux-gnu-ar")
-set(CFLAGS "-mcmodel=medium")
+string(APPEND CFLAGS " -mcmodel=medium")
if (compile_threaded)
string(APPEND CFLAGS " -fopenmp")
endif()
@@ -12,7 +12,7 @@ endif()
if (COMP_NAME STREQUAL csm_share)
string(APPEND CFLAGS " -std=c99")
endif()
-set(CXXFLAGS "-std=c++14")
+string(APPEND CXXFLAGS " -std=c++14")
if (compile_threaded)
string(APPEND CXXFLAGS " -fopenmp")
endif()
@@ -36,8 +36,8 @@ endif()
set(SLIBS "-L/opt/conda/lib -lnetcdf -lnetcdff")
set(CXX_LIBS "-lstdc++")
set(CXX_LINKER "FORTRAN")
-set(FC_AUTO_R8 "-fdefault-real-8")
-set(FFLAGS "-I/opt/conda/include -mcmodel=medium -fconvert=big-endian -ffree-line-length-none -ffixed-line-length-none")
+string(APPEND FC_AUTO_R8 " -fdefault-real-8")
+string(APPEND FFLAGS " -I/opt/conda/include -mcmodel=medium -fconvert=big-endian -ffree-line-length-none -ffixed-line-length-none")
if (compile_threaded)
string(APPEND FFLAGS " -fopenmp")
endif()
@@ -47,9 +47,9 @@ endif()
if (NOT DEBUG)
string(APPEND FFLAGS " -O")
endif()
-set(FFLAGS_NOOPT "-O0")
-set(FIXEDFLAGS "-ffixed-form")
-set(FREEFLAGS "-ffree-form")
+string(APPEND FFLAGS_NOOPT " -O0")
+string(APPEND FIXEDFLAGS " -ffixed-form")
+string(APPEND FREEFLAGS " -ffree-form")
set(HAS_F2008_CONTIGUOUS "FALSE")
if (compile_threaded)
string(APPEND LDFLAGS " -fopenmp")
@@ -66,3 +66,6 @@ set(SCC "/opt/conda/bin/x86_64-conda-linux-gnu-gcc")
set(SCXX "/opt/conda/bin/x86_64-conda-linux-gnu-g++")
set(SFC "/opt/conda/bin/x86_64-conda-linux-gnu-gfortran")
set(SUPPORTS_CXX "TRUE")
+if (CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
+ string(APPEND FFLAGS " -fallow-argument-mismatch -fallow-invalid-boz ")
+endif()
diff --git a/cime_config/machines/cmake_macros/gnu_eddi.cmake b/cime_config/machines/cmake_macros/gnu_eddi.cmake
index eac0a75ecd5b..4318ecd7e224 100644
--- a/cime_config/machines/cmake_macros/gnu_eddi.cmake
+++ b/cime_config/machines/cmake_macros/gnu_eddi.cmake
@@ -4,10 +4,10 @@ if (COMP_NAME STREQUAL gptl)
endif()
set(NETCDF_PATH "$ENV{NETCDF_HOME}")
if (NOT DEBUG)
- string(APPEND FFLAGS " -fno-unsafe-math-optimizations")
+ string(APPEND FFLAGS " -fno-unsafe-math-optimizations -fallow-argument-mismatch -fallow-invalid-boz")
endif()
if (DEBUG)
- string(APPEND FFLAGS " -g -fbacktrace -fbounds-check -ffpe-trap=invalid,zero,overflow")
+ string(APPEND FFLAGS " -g -fbacktrace -fbounds-check -ffpe-trap=invalid,zero,overflow -fallow-argument-mismatch -fallow-invalid-boz -Wall")
endif()
string(APPEND SLIBS " -L$ENV{NETCDF_HOME}/lib/ -lnetcdff -lnetcdf -lcurl -llapack -lblas")
if (MPILIB STREQUAL mpi-serial)
diff --git a/cime_config/machines/cmake_macros/gnu_frontier.cmake b/cime_config/machines/cmake_macros/gnu_frontier.cmake
new file mode 100644
index 000000000000..fbbfc5e50c5a
--- /dev/null
+++ b/cime_config/machines/cmake_macros/gnu_frontier.cmake
@@ -0,0 +1,14 @@
+string(APPEND FFLAGS " -Wno-implicit-interface")
+
+if (NOT DEBUG)
+ string(APPEND FFLAGS " -O2")
+ string(APPEND CFLAGS " -O2")
+endif()
+string(APPEND CXX_LIBS " -lstdc++")
+
+string(APPEND SLIBS " -L$ENV{PNETCDF_PATH}/lib -lpnetcdf")
+if (NOT MPILIB STREQUAL mpi-serial)
+ string(APPEND SLIBS " -L$ENV{ADIOS2_DIR}/lib64 -ladios2_c_mpi -ladios2_c -ladios2_core_mpi -ladios2_core -ladios2_evpath -ladios2_ffs -ladios2_dill -ladios2_atl -ladios2_enet")
+endif()
+set(NETCDF_PATH "$ENV{NETCDF_DIR}")
+set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
diff --git a/cime_config/machines/cmake_macros/gnugpu_crusher.cmake b/cime_config/machines/cmake_macros/gnugpu_crusher.cmake
index dc4204d07da8..43966d40bd9b 100644
--- a/cime_config/machines/cmake_macros/gnugpu_crusher.cmake
+++ b/cime_config/machines/cmake_macros/gnugpu_crusher.cmake
@@ -10,7 +10,6 @@ if (COMP_NAME STREQUAL gptl)
endif()
set(NETCDF_PATH "$ENV{NETCDF_DIR}")
set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
-set(PIO_FILESYSTEM_HINTS "gpfs")
string(APPEND CMAKE_OPTS " -DPIO_ENABLE_TOOLS:BOOL=OFF")
set(MPICC "cc")
@@ -20,7 +19,7 @@ set(SCC "cc")
set(SCXX "hipcc")
set(SFC "ftn")
-string(APPEND CXXFLAGS " -I$ENV{MPICH_DIR}/include --amdgpu-target=gfx90a")
+string(APPEND CXXFLAGS " -I$ENV{MPICH_DIR}/include --offload-arch=gfx90a")
string(APPEND SLIBS " -Wl,--copy-dt-needed-entries -L/opt/cray/pe/gcc-libs -lgfortran -L$ENV{MPICH_DIR}/lib -lmpi -L$ENV{CRAY_MPICH_ROOTDIR}/gtl/lib -lmpi_gtl_hsa ")
if (NOT MPILIB STREQUAL mpi-serial)
string(APPEND SLIBS " -L$ENV{ADIOS2_DIR}/lib64 -ladios2_c_mpi -ladios2_c -ladios2_core_mpi -ladios2_core -ladios2_evpath -ladios2_ffs -ladios2_dill -ladios2_atl -ladios2_enet")
@@ -28,3 +27,5 @@ endif()
string(APPEND KOKKOS_OPTIONS " -DKokkos_ENABLE_HIP=On -DKokkos_ARCH_ZEN3=On -DKokkos_ARCH_VEGA90A=On")
+set(USE_HIP "TRUE")
+string(APPEND HIP_FLAGS "${CXXFLAGS} -munsafe-fp-atomics -x hip")
diff --git a/cime_config/machines/cmake_macros/gnugpu_frontier.cmake b/cime_config/machines/cmake_macros/gnugpu_frontier.cmake
new file mode 100644
index 000000000000..515bb4c185d0
--- /dev/null
+++ b/cime_config/machines/cmake_macros/gnugpu_frontier.cmake
@@ -0,0 +1,28 @@
+string(APPEND FFLAGS " -Wno-implicit-interface")
+
+if (NOT DEBUG)
+ string(APPEND CFLAGS " -O2")
+ string(APPEND CXXFLAGS " -O2")
+ string(APPEND FFLAGS " -O2")
+endif()
+if (COMP_NAME STREQUAL gptl)
+ string(APPEND CPPDEFS " -DHAVE_SLASHPROC")
+endif()
+set(NETCDF_PATH "$ENV{NETCDF_DIR}")
+set(PNETCDF_PATH "$ENV{PNETCDF_DIR}")
+string(APPEND CMAKE_OPTS " -DPIO_ENABLE_TOOLS:BOOL=OFF")
+
+set(MPICC "cc")
+set(MPICXX "hipcc")
+set(MPIFC "ftn")
+set(SCC "cc")
+set(SCXX "hipcc")
+set(SFC "ftn")
+
+string(APPEND CXXFLAGS " -I$ENV{MPICH_DIR}/include --offload-arch=gfx90a")
+string(APPEND SLIBS " -Wl,--copy-dt-needed-entries -L/opt/cray/pe/gcc-libs -lgfortran -L$ENV{MPICH_DIR}/lib -lmpi -L$ENV{CRAY_MPICH_ROOTDIR}/gtl/lib -lmpi_gtl_hsa ")
+
+string(APPEND KOKKOS_OPTIONS " -DKokkos_ENABLE_HIP=On -DKokkos_ARCH_ZEN3=On -DKokkos_ARCH_VEGA90A=On")
+
+set(USE_HIP "TRUE")
+string(APPEND HIP_FLAGS "${CXXFLAGS} -munsafe-fp-atomics -x hip")
diff --git a/cime_config/machines/cmake_macros/intel_pm-cpu.cmake b/cime_config/machines/cmake_macros/intel_pm-cpu.cmake
new file mode 100644
index 000000000000..cd26d8891b2c
--- /dev/null
+++ b/cime_config/machines/cmake_macros/intel_pm-cpu.cmake
@@ -0,0 +1,49 @@
+string(APPEND CONFIG_ARGS " --host=cray")
+if (COMP_NAME STREQUAL gptl)
+ string(APPEND CPPDEFS " -DHAVE_NANOTIME -DBIT64 -DHAVE_SLASHPROC -DHAVE_GETTIMEOFDAY")
+endif()
+string(APPEND SLIBS " -L$ENV{CRAY_HDF5_PARALLEL_PREFIX}/lib -lhdf5_hl -lhdf5 -L$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}/lib -L$ENV{CRAY_PARALLEL_NETCDF_PREFIX}/lib -lpnetcdf -lnetcdf -lnetcdff")
+#if (NOT MPILIB STREQUAL mpi-serial)
+# string(APPEND SLIBS " -L$ENV{ADIOS2_DIR}/lib64 -ladios2_c_mpi -ladios2_c -ladios2_core_mpi -ladios2_core -ladios2_evpath -ladios2_ffs -ladios2_dill -ladios2_atl -ladios2_enet")
+#endif()
+string(APPEND SLIBS " -qmkl")
+set(CXX_LINKER "FORTRAN")
+set(NETCDF_PATH "$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}")
+set(NETCDF_C_PATH "$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}")
+set(NETCDF_FORTRAN_PATH "$ENV{CRAY_NETCDF_HDF5PARALLEL_PREFIX}")
+set(HDF5_PATH "$ENV{CRAY_HDF5_PARALLEL_PREFIX}")
+set(PNETCDF_PATH "$ENV{CRAY_PARALLEL_NETCDF_PREFIX}")
+
+set(MPICC "cc")
+set(MPICXX "CC")
+set(MPIFC "ftn")
+set(SCC "icx")
+set(SCXX "icpx")
+set(SFC "ifx")
+
+# Bit of a hack here. For whatever reason, the intel version on pm-cpu (both intel and intel-oneapi, and both icpc/icpx)
+# does not seem to have the -fp-model=source flag (docs still show it). And I was unable to find a reliable way of testing
+# on the compiler ID or version, so for now, simply manually adjust the CXXFLAG setting for pm-cpu/intel
+# Try to manually remove -fp-model=source (and replace with -fp-model=precise) from CXXFLAGS
+#message(STATUS "ndk CXXFLAGS=${CXXFLAGS}")
+set(CXXFLAGS " ") # hardcode it here to blank, then try to do same things as in intel.cmake
+if (compile_threaded)
+ string(APPEND CXXFLAGS " -qopenmp")
+endif()
+if (DEBUG)
+ string(APPEND CXXFLAGS " -O0 -g")
+endif()
+if (NOT DEBUG)
+ string(APPEND CXXFLAGS " -O2")
+endif()
+string(APPEND CXXFLAGS " -fp-model=precise") # and manually add precise
+#message(STATUS "ndk CXXFLAGS=${CXXFLAGS}")
+
+string(APPEND FFLAGS " -fp-model=consistent -fimf-use-svml")
+if (NOT DEBUG)
+ # string(APPEND FFLAGS " -qno-opt-dynamic-align")
+ string(APPEND FFLAGS " -g -traceback")
+ string(APPEND CXXFLAGS " -g -traceback")
+endif()
+string(APPEND FFLAGS " -DHAVE_ERF_INTRINSICS")
+string(APPEND CXXFLAGS " -fp-model=consistent")
diff --git a/cime_config/machines/cmake_macros/intel_quartz.cmake b/cime_config/machines/cmake_macros/intel_quartz.cmake
index e72a61a31ec1..458352f689ce 100644
--- a/cime_config/machines/cmake_macros/intel_quartz.cmake
+++ b/cime_config/machines/cmake_macros/intel_quartz.cmake
@@ -3,15 +3,10 @@ if (DEBUG)
string(APPEND FFLAGS " -check all -ftrapuv")
endif()
string(APPEND SLIBS " -llapack -lblas")
-string(APPEND CXXFLAGS " -cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh")
-string(APPEND LDFLAGS " -L/usr/tce/packages/gcc/gcc-8.3.1/rh/lib/gcc/x86_64-redhat-linux/8/")
-set(KOKKOS_OPTIONS "--with-serial --cxxflags='-cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh' --ldflags='-L/usr/tce/packages/gcc/gcc-8.3.1/rh/lib/gcc/x86_64-redhat-linux/8/'")
+string(APPEND LDFLAGS " -L/usr/tce/packages/gcc/gcc-10.3.1-magic/lib/gcc/x86_64-redhat-linux/10/")
+set(KOKKOS_OPTIONS "--with-serial --ldflags='-L/usr/tce/packages/gcc/gcc-10.3.1-magic/lib/gcc/x86_64-redhat-linux/10/'")
set(MPI_LIB_NAME "mpich")
-set(MPI_PATH "/usr/tce/packages/mvapich2/mvapich2-2.3-intel-19.0.4/")
-set(NETCDF_PATH "/usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-19.0.4/")
-set(PNETCDF_PATH "$ENV{PNETCDFROOT}")
-execute_process(COMMAND /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-19.0.4/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE)
+set(MPI_PATH "/usr/tce/packages/mvapich2/mvapich2-2.3.6-intel-classic-2021.6.0/")
+set(NETCDF_PATH "$ENV{NETCDFROOT}")
+execute_process(COMMAND /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.6.0-mvapich2-2.3.6-intel-classic-2021.6.0/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE)
string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0}")
-string(APPEND CXXFLAGS " -cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh")
-string(APPEND LDFLAGS " -cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh")
-string(APPEND KOKKOS_OPTIONS " -DKokkos_ARCH_BDW=On -DCMAKE_CXX_FLAGS='-cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh'")
diff --git a/cime_config/machines/cmake_macros/intel_ruby.cmake b/cime_config/machines/cmake_macros/intel_ruby.cmake
new file mode 100644
index 000000000000..e72a61a31ec1
--- /dev/null
+++ b/cime_config/machines/cmake_macros/intel_ruby.cmake
@@ -0,0 +1,17 @@
+string(APPEND CPPDEFS " -DNO_SHR_VMATH -DCNL")
+if (DEBUG)
+ string(APPEND FFLAGS " -check all -ftrapuv")
+endif()
+string(APPEND SLIBS " -llapack -lblas")
+string(APPEND CXXFLAGS " -cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh")
+string(APPEND LDFLAGS " -L/usr/tce/packages/gcc/gcc-8.3.1/rh/lib/gcc/x86_64-redhat-linux/8/")
+set(KOKKOS_OPTIONS "--with-serial --cxxflags='-cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh' --ldflags='-L/usr/tce/packages/gcc/gcc-8.3.1/rh/lib/gcc/x86_64-redhat-linux/8/'")
+set(MPI_LIB_NAME "mpich")
+set(MPI_PATH "/usr/tce/packages/mvapich2/mvapich2-2.3-intel-19.0.4/")
+set(NETCDF_PATH "/usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-19.0.4/")
+set(PNETCDF_PATH "$ENV{PNETCDFROOT}")
+execute_process(COMMAND /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.4.4-intel-19.0.4/bin/nf-config --flibs OUTPUT_VARIABLE SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0 OUTPUT_STRIP_TRAILING_WHITESPACE)
+string(APPEND SLIBS " ${SHELL_CMD_OUTPUT_BUILD_INTERNAL_IGNORE0}")
+string(APPEND CXXFLAGS " -cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh")
+string(APPEND LDFLAGS " -cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh")
+string(APPEND KOKKOS_OPTIONS " -DKokkos_ARCH_BDW=On -DCMAKE_CXX_FLAGS='-cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh'")
diff --git a/cime_config/machines/config_batch.xml b/cime_config/machines/config_batch.xml
index cb9f92f55716..2572f2743664 100644
--- a/cime_config/machines/config_batch.xml
+++ b/cime_config/machines/config_batch.xml
@@ -65,7 +65,7 @@
- /gpfs/alpine/cli133/world-shared/e3sm/tools/sbatch/throttle
+ /lustre/orion/cli115/world-shared/e3sm/tools/sbatch/throttle
--core-spec=$SHELL{tpn=`./xmlquery --value MAX_TASKS_PER_NODE`; if [[ $tpn > 56 ]]; then echo "64-$tpn"|bc; else echo 8; fi; }
@@ -76,6 +76,20 @@
+
+ sbatch
+
+ --core-spec=$SHELL{tpn=`./xmlquery --value MAX_TASKS_PER_NODE`; if [[ $tpn > 56 ]]; then echo "64-$tpn"|bc; else echo 8; fi; }
+
+
+ batch
+ batch
+ batch
+ batch
+ batch
+
+
+
qstat
qsub
@@ -130,7 +144,7 @@
bkill
-env
#BSUB
- <(\d+)>
+ (\d+)
-w 'done(jobid)'
-w 'ended(jobid)'
&&
@@ -431,7 +445,8 @@
-G 0
- regular
+ regular
+ preempt
debug
@@ -441,8 +456,9 @@
--constraint=cpu
- regular
- debug
+ regular
+ preempt
+ debug
@@ -661,7 +677,7 @@
- /gpfs/alpine/cli133/world-shared/e3sm/tools/sbatch/throttle
+ /lustre/orion/cli133/world-shared/e3sm/tools/sbatch/throttle
-S 0
diff --git a/cime_config/machines/config_machines.xml b/cime_config/machines/config_machines.xml
index 5eaaf6c9512b..f2ca4beb3c97 100644
--- a/cime_config/machines/config_machines.xml
+++ b/cime_config/machines/config_machines.xml
@@ -148,7 +148,7 @@
Perlmutter CPU-only nodes at NERSC. Phase2 only: Each node has 2 AMD EPYC 7713 64-Core (Milan) 512GB
$ENV{NERSC_HOST}:perlmutter
Linux
- gnu,nvidia,amdclang
+ gnu,intel,nvidia,amdclang
mpich
e3sm
/global/cfs/cdirs/e3sm
@@ -167,7 +167,7 @@
nersc_slurm
e3sm
256
- 64
+ 128
TRUE
srun
@@ -194,9 +194,12 @@
cray-netcdf-hdf5parallel
cray-parallel-netcdf
PrgEnv-gnu
+ PrgEnv-intel
PrgEnv-nvidia
PrgEnv-cray
PrgEnv-aocc
+ intel
+ intel-oneapi
cudatoolkit
craype-accel-nvidia80
craype-accel-host
@@ -208,21 +211,28 @@
PrgEnv-gnu/8.3.3
gcc/11.2.0
+ cray-libsci/23.02.1.1
+
+
+
+ PrgEnv-intel/8.3.3
+ intel/2023.0.0
PrgEnv-nvidia
nvidia/22.7
+ cray-libsci/23.02.1.1
PrgEnv-aocc
aocc/3.2.0
+ cray-libsci/23.02.1.1
craype-accel-host
- cray-libsci/23.02.1.1
craype/2.7.19
cray-mpich/8.1.24
cray-hdf5-parallel/1.12.2.3
@@ -420,7 +430,7 @@
nersc_slurm
e3sm
256
- 64
+ 128
TRUE
srun
@@ -586,19 +596,145 @@
+
+ Frontier exascale supercomputer at ORNL. 9408 nodes, Node: 4 AMD MI250X GPUs (2 GCDs) ~ 8 GPUs, 512 GB HDB2E, AMD EPYC 64 cores, 512GB DDR4
+ .*frontier.*
+ CNL
+ gnu,crayclang,amdclang,gnugpu,crayclanggpu,amdclanggpu
+ mpich
+ cli115
+ /lustre/orion/cli115/world-shared/frontier
+ .*
+ /lustre/orion/$PROJECT/proj-shared/$ENV{USER}/e3sm_scratch
+ /lustre/orion/cli115/world-shared/e3sm/inputdata
+ /lustre/orion/cli115/world-shared/e3sm/inputdata/atm/datm7
+ $CIME_OUTPUT_ROOT/archive/$CASE
+ /lustre/orion/cli115/world-shared/e3sm/baselines/frontier/$COMPILER
+ /lustre/orion/cli115/world-shared/e3sm/tools/cprnc/cprnc
+ 8
+ 1
+ slurm
+ e3sm
+ 56
+ 56
+ 8
+ 8
+ 8
+ TRUE
+
+ srun
+
+ -l -K -n {{ total_tasks }} -N {{ num_nodes }}
+ -c $ENV{OMP_NUM_THREADS}
+ $ENV{NTASKS_PER_GPU}
+ $ENV{GPU_BIND_ARGS}
+
+
+
+ /usr/share/lmod/lmod/init/sh
+ /usr/share/lmod/lmod/init/csh
+ /usr/share/lmod/lmod/init/perl
+ /usr/share/lmod/lmod/init/env_modules_python.py
+ /usr/share/lmod/lmod/libexec/lmod perl
+ module
+ module
+ /usr/share/lmod/lmod/libexec/lmod python
+
+
+ PrgEnv-cray PrgEnv-cray/8.3.3
+ cce cce/15.0.1
+
+
+ craype craype/2.7.20
+
+
+ craype-accel-amd-gfx90a
+ rocm/5.4.0
+
+
+
+ PrgEnv-cray PrgEnv-amd/8.3.3
+ amd amd/5.4.0
+
+
+ craype-accel-amd-gfx90a
+
+
+
+ PrgEnv-cray PrgEnv-gnu/8.3.3
+
+ gcc gcc/11.2.0
+
+
+ craype-accel-amd-gfx90a
+ rocm/5.4.0
+
+
+ cray-python/3.9.13.1
+ subversion/1.14.1
+ git/2.36.1
+ cmake/3.21.3
+ zlib/1.2.11
+ cray-hdf5-parallel/1.12.2.1
+ cray-netcdf-hdf5parallel/4.9.0.1
+ cray-parallel-netcdf/1.12.3.1
+
+
+ $CIME_OUTPUT_ROOT/$CASE/run
+ $CIME_OUTPUT_ROOT/$CASE/bld
+ 0.1
+ 0.25
+ 0
+
+ $ENV{NETCDF_DIR}
+ $ENV{PNETCDF_DIR}
+
+
+
+
+ $ENV{CRAY_LIBSCI_DIR}/amd/4.0/x86_64/lib:$ENV{LD_LIBRARY_PATH}
+
+
+ --ntasks-per-gpu=$SHELL{echo "`./xmlquery --value MAX_MPITASKS_PER_NODE`/8"|bc}
+ --gpu-bind=closest
+ romio_cb_read=disable
+ 0
+
+
+ 10
+ 3
+
+
+ 128M
+ spread
+ threads
+
+
+ /lustre/orion/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/gcc-11.2.0
+
+
+ /lustre/orion/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/crayclang-14.0.2
+
+
+ /lustre/orion/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/amdclang-15.0.0
+
+
+
Crusher. NCCS moderate-security system that contains similar hardware and software as the upcoming Frontier system at ORNL. 192 AMD EPYC 7A53 64C nodes, 128 hwthreads, 512GB DDR4, 4 MI250X GPUs
.*crusher.*
CNL
gnu,crayclang,amdclang,gnugpu,crayclanggpu,amdclanggpu
mpich
- cli133_crusher
- /gpfs/alpine/cli133/proj-shared/$ENV{USER}/e3sm_scratch/crusher
- /gpfs/alpine/cli115/world-shared/e3sm/inputdata
- /gpfs/alpine/cli115/world-shared/e3sm/inputdata/atm/datm7
+ cli115
+ /lustre/orion/cli115/world-shared/crusher
+ .*
+ /lustre/orion/$PROJECT/proj-shared/$ENV{USER}/e3sm_scratch/crusher
+ /lustre/orion/cli115/world-shared/e3sm/inputdata
+ /lustre/orion/cli115/world-shared/e3sm/inputdata/atm/datm7
$CIME_OUTPUT_ROOT/archive/$CASE
- /gpfs/alpine/cli133/world-shared/e3sm/baselines/$COMPILER
- /gpfs/alpine/cli133/world-shared/e3sm/tools/cprnc/cprnc
+ /lustre/orion/cli115/world-shared/e3sm/baselines/crusher/$COMPILER
+ /lustre/orion/cli115/world-shared/e3sm/tools/cprnc/cprnc
8
1
slurm
@@ -630,7 +766,10 @@
PrgEnv-cray PrgEnv-cray/8.3.3
- cce cce/14.0.2
+ cce cce/15.0.1
+
+
+ craype craype/2.7.20
craype-accel-amd-gfx90a
@@ -654,13 +793,14 @@
rocm/5.4.0
- cray-python/3.9.12.1
+ cray-python/3.9.13.1
subversion/1.14.1
git/2.36.1
cmake/3.21.3
- cray-hdf5-parallel/1.12.1.1
- cray-netcdf-hdf5parallel/4.8.1.1
- cray-parallel-netcdf/1.12.1.7
+ zlib/1.2.11
+ cray-hdf5-parallel/1.12.2.1
+ cray-netcdf-hdf5parallel/4.9.0.1
+ cray-parallel-netcdf/1.12.3.1
$CIME_OUTPUT_ROOT/$CASE/run
@@ -693,31 +833,28 @@
threads
- /gpfs/alpine/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/gcc-11.2.0
+ /lustre/orion/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/gcc-11.2.0
- /gpfs/alpine/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/crayclang-14.0.2
+ /lustre/orion/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/crayclang-14.0.2
- /gpfs/alpine/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/amdclang-15.0.0
+ /lustre/orion/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/amdclang-15.0.0
-
-
-
Crusher. NCCS moderate-security system that contains similar hardware and software as the upcoming Frontier system at ORNL. 192 AMD EPYC 7A53 64C nodes, 128 hwthreads, 512GB DDR4, 4 MI250X GPUs
.*crusher.*
CNL
- gnu,crayclang-scream,amdclang
+ crayclang-scream
mpich
CLI133_crusher
- /gpfs/alpine/cli133/proj-shared/$ENV{USER}/e3sm_scratch/crusher
- /gpfs/alpine/cli115/world-shared/e3sm/inputdata
- /gpfs/alpine/cli115/world-shared/e3sm/inputdata/atm/datm7
+ /lustre/orion/cli133/proj-shared/$ENV{USER}/e3sm_scratch/crusher
+ /lustre/orion/cli115/world-shared/e3sm/inputdata
+ /lustre/orion/cli115/world-shared/e3sm/inputdata/atm/datm7
$CIME_OUTPUT_ROOT/archive/$CASE
- /gpfs/alpine/cli133/world-shared/e3sm/tools/cprnc/cprnc
+ /lustre/orion/cli115/world-shared/e3sm/tools/cprnc/cprnc
8
1
slurm
@@ -801,14 +938,10 @@
threads
- /gpfs/alpine/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/crayclang-14.0.2
+ /lustre/orion/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/crayclang-14.0.2
-
-
-
-
Crusher. NCCS moderate-security system that contains similar hardware and software as the upcoming Frontier system at ORNL. 192 AMD EPYC 7A53 64C nodes, 128 hwthreads, 512GB DDR4, 4 MI250X GPUs
.*crusher.*
@@ -816,11 +949,11 @@
crayclang-scream
mpich
CLI133_crusher
- /gpfs/alpine/cli133/proj-shared/$ENV{USER}/e3sm_scratch/crusher
- /gpfs/alpine/cli115/world-shared/e3sm/inputdata
- /gpfs/alpine/cli115/world-shared/e3sm/inputdata/atm/datm7
+ /lustre/orion/cli133/proj-shared/$ENV{USER}/e3sm_scratch/crusher
+ /lustre/orion/cli115/world-shared/e3sm/inputdata
+ /lustre/orion/cli115/world-shared/e3sm/inputdata/atm/datm7
$CIME_OUTPUT_ROOT/archive/$CASE
- /gpfs/alpine/cli133/world-shared/e3sm/tools/cprnc/cprnc
+ /lustre/orion/cli115/world-shared/e3sm/tools/cprnc/cprnc
8
1
slurm
@@ -855,8 +988,10 @@
PrgEnv-cray
-
+ craype-accel-amd-gfx90a
rocm/5.1.0
+
+ cce/14.0.3
cray-python/3.9.4.2
@@ -864,9 +999,9 @@
git/2.31.1
cmake/3.21.3
zlib/1.2.11
- cray-hdf5-parallel/1.12.1.1
- cray-netcdf-hdf5parallel/4.8.1.1
- cray-parallel-netcdf/1.12.1.7
+ cray-hdf5-parallel/1.12.2.1
+ cray-netcdf-hdf5parallel/4.9.0.1
+ cray-parallel-netcdf/1.12.3.1
@@ -879,7 +1014,7 @@
$ENV{PNETCDF_DIR}
0
- 0
+ 1
romio_cb_read=disable
@@ -889,15 +1024,10 @@
threads
- /gpfs/alpine/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/crayclang-14.0.2
+ /lustre/orion/cli133/world-shared/3rdparty/adios2/2.8.3.patch/cray-mpich-8.1.17/crayclang-14.0.2
-
-
-
-
-
Cori. XC40 Cray system at NERSC. Haswell partition. os is CNL, 32 pes/node, batch system is SLURM
cori-knl-is-default
@@ -2747,13 +2877,13 @@
-
- LLNL Linux Cluster, Linux (pgi), 36 pes/node, batch system is Slurm
+
+ LLNL Linux Cluster, Linux (pgi), 56 pes/node, batch system is Slurm
LINUX
intel
mpich
cbronze
- /p/lustre2/$USER/e3sm_scratch/quartz
+ /p/lustre2/$USER/e3sm_scratch/ruby
/usr/gdata/climdat/ccsm3data/inputdata
/usr/gdata/climdat/ccsm3data/inputdata/atm/datm7
/p/lustre2/$USER/archive/$CASE
@@ -2762,8 +2892,8 @@
8
lc_slurm
donahue5 -at- llnl.gov
- 72
- 36
+ 56
+ 56
@@ -2780,7 +2910,7 @@
/usr/share/lmod/lmod/libexec/lmod python
/usr/share/lmod/lmod/libexec/lmod perl
- python
+ python/3.8.2
git
intel/19.0.4
mvapich2/2.3
@@ -2800,6 +2930,57 @@
+
+ LLNL Linux Cluster, Linux (pgi), 36 pes/node, batch system is Slurm
+ LINUX
+ intel
+ mpich
+ cbronze
+ /p/lustre2/$USER/e3sm_scratch/quartz
+ /usr/gdata/climdat/ccsm3data/inputdata
+ /usr/gdata/climdat/ccsm3data/inputdata/atm/datm7
+ /p/lustre2/$USER/archive/$CASE
+ /p/lustre2/$USER/ccsm_baselines/$COMPILER
+ /usr/gdata/climdat/tools/cprnc
+ 8
+ lc_slurm
+ donahue5 -at- llnl.gov
+ 72
+ 36
+
+
+
+
+ srun
+
+
+ /usr/share/lmod/lmod/init/env_modules_python.py
+ /usr/share/lmod/lmod/init/perl
+ /usr/share/lmod/lmod/init/sh
+ /usr/share/lmod/lmod/init/csh
+ module
+ module
+ /usr/share/lmod/lmod/libexec/lmod python
+ /usr/share/lmod/lmod/libexec/lmod perl
+
+ python/3.9.12
+ git
+ mkl/2022.1.0
+ intel-classic/2021.6.0-magic
+ mvapich2/2.3.6
+ cmake/3.19.2
+ netcdf-fortran-parallel/4.6.0
+ netcdf-c-parallel/4.9.0
+
+
+ $CIME_OUTPUT_ROOT/$CASE/run
+ $CIME_OUTPUT_ROOT/$CASE/bld
+
+ /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.6.0-mvapich2-2.3.6-intel-classic-2021.6.0/
+ /usr/tce/packages/netcdf-fortran/netcdf-fortran-4.6.0-mvapich2-2.3.6-intel-classic-2021.6.0/
+
+
+
ALCF Cray XC40 KNL, os is CNL, 64 pes/node, batch system is cobalt
theta.*
@@ -4181,24 +4362,24 @@
small developer workhorse at lbl climate sciences
LINUX
gnu
- mpi-serial
+ openmpi
ngeet
/raid1/lbleco/e3sm/
- /raid1/lbleco/cesm/cesm_input_datasets/
- /raid1/lbleco/cesm/cesm_input_datasets/atm/datm7/
- /raid1/lbleco/acme/cesm_archive/$CASE
- /raid1/lbleco/acme/cesm_baselines/$COMPILER
+ /home/rgknox/Models/InputDatasets/cesm_input_data/
+ /home/rgknox/Models/InputDatasets/cesm_input_data/atm/datm7/
+ /home/rgknox/Models//cesm_archive/$CASE
+ /home/rgknox/Models//cesm_baselines/$COMPILER
/raid1/lbleco/cesm/cesm_tools/cprnc/cprnc
1
none
rgknox at lbl gov
- 4
- 4
+ 16
+ 16
FALSE
-
+
mpirun
-np {{ total_tasks }}
@@ -4206,6 +4387,9 @@
+
+ /usr/local/share/cmake-3.21/
+
@@ -4672,7 +4856,7 @@
$CIME_OUTPUT_ROOT/archive/$CASE
/home/baselines/$COMPILER
/home/tools/cprnc/cprnc
- 24
+ 20
e3sm_developer
8
slurm
@@ -5221,6 +5405,45 @@
+
+ Docker
+ docker
+ LINUX
+
+ gnu,gnuX
+ openmpi
+ CIME
+ /storage/timings
+ CIME
+ /storage/cases
+ /storage/inputdata
+ /storage/inputdata-clmforc
+ /storage/archive/$CASE
+ /storage/baselines/$COMPILER
+ /storage/tools/cprnc
+ make
+ 8
+ e3sm_developer
+ none
+ scream
+ 8
+ 8
+
+ mpiexec
+
+ -n {{ total_tasks }}
+ --oversubscribe
+
+
+
+ $CASEROOT/run
+ $CASEROOT/bld
+
+ 1
+ 1
+
+
+
${EXEROOT}/e3sm.exe
>> e3sm.log.$LID 2>&1
diff --git a/cime_config/machines/config_pio.xml b/cime_config/machines/config_pio.xml
index e1784b1618d1..d263d144db31 100644
--- a/cime_config/machines/config_pio.xml
+++ b/cime_config/machines/config_pio.xml
@@ -68,6 +68,7 @@
netcdf
netcdf
netcdf
+ netcdf
diff --git a/cime_config/machines/syslog.crusher b/cime_config/machines/syslog.crusher
new file mode 100755
index 000000000000..25ef50e1e955
--- /dev/null
+++ b/cime_config/machines/syslog.crusher
@@ -0,0 +1,94 @@
+#!/bin/csh -f
+# pm-gpu syslog script:
+# mach_syslog
-
+
eam: default, 1 node x MAX_MPITASKS_PER_NODE mpi x 1 omp @ root 0
@@ -180,9 +180,9 @@
-
+
- allactive: default, 1 node x MAX_MPITASKS_PER_NODE mpi x 2 omp @ root 0
+ eam+gcp: default 1 node
-1
-1
@@ -193,29 +193,6 @@
-1
-1
-
- 2
- 2
- 2
- 2
- 2
- 2
-
-
-
-
-
- eam+gcp: default 1 node
-
- 56
- 56
- 56
- 36
- 36
- 16
- 16
- 56
-
@@ -411,6 +388,21 @@
+
+
+ gcp12: any compset on ne4np4.pg2 grid, 56x1 except 36 for ice/ocn
+
+ 56
+ 56
+ 56
+ 36
+ 36
+ 56
+ 56
+ 56
+
+
+
@@ -1207,8 +1199,8 @@
280
280
280
- 240
- 240
+ 256
+ 256
280
@@ -1250,24 +1242,19 @@
- -compset A_WCYCL* -res ne30pg2_oECv3 without MPASO on 4 nodes
- 64
+ -compset A_WCYCL* -res ne30pg2_oECv3 without MPASO on 4 nodes, 128x1 c8
+ 128
- 256
- 256
- 256
- 256
- 256
- 256
+ 512
+ 512
+ 512
+ 512
+ 512
+ 64
-
- 2
- 2
- 2
- 1
- 1
- 1
-
+
+ 8
+
@@ -1707,7 +1694,6 @@
pm-cpu ne120pg2 F-compset with MPASSI on 43 nodes 128x1c8 0.6 sypd
128
- 256
5504
5504
diff --git a/components/eam/cime_config/testdefs/testmods_dirs/eam/zm_enhancements/user_nl_eam b/components/eam/cime_config/testdefs/testmods_dirs/eam/zm_enhancements/user_nl_eam
new file mode 100644
index 000000000000..ba8377a3f209
--- /dev/null
+++ b/components/eam/cime_config/testdefs/testmods_dirs/eam/zm_enhancements/user_nl_eam
@@ -0,0 +1,4 @@
+zmconv_microp = .true.
+zmconv_clos_dyn_adj = .true.
+zmconv_MCSP_heat_coeff = 0.3
+zmconv_tpert_fix = .true.
\ No newline at end of file
diff --git a/components/eam/src/chemistry/modal_aero/modal_aero_amicphys.F90 b/components/eam/src/chemistry/modal_aero/modal_aero_amicphys.F90
index 45c907ec30d3..fbf1b17adb3f 100644
--- a/components/eam/src/chemistry/modal_aero/modal_aero_amicphys.F90
+++ b/components/eam/src/chemistry/modal_aero/modal_aero_amicphys.F90
@@ -17,7 +17,7 @@ module modal_aero_amicphys
use chem_mods, only: gas_pcnst
use physconst, only: pi
use ppgrid, only: pcols, pver
- use modal_aero_data, only: ntot_aspectype, ntot_amode, nsoa, npoa, nbc
+ use modal_aero_data, only: ntot_aspectype, ntot_amode, nsoag, nsoa, npoa, nbc
! use ref_pres, only: top_lev => clim_modal_aero_top_lev ! this is for gg02a
use ref_pres, only: top_lev => trop_cloud_top_lev ! this is for ee02c
@@ -96,7 +96,11 @@ module modal_aero_amicphys
integer, parameter :: max_gas = nsoa + 1
! the +3 in max_aer are dst, ncl, so4
integer, parameter :: max_aer = nsoa + npoa + nbc + 3
-#elif ( defined MODAL_AERO_4MODE_MOM )
+#elif ( ( defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE ) && ( defined VBS_SOA ) )
+ integer, parameter :: max_gas = nsoag + 1
+ ! the +4 in max_aer are dst, ncl, so4, mom
+ integer, parameter :: max_aer = nsoa + npoa + nbc + 4
+#elif ( defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE )
integer, parameter :: max_gas = nsoa + 1
! the +4 in max_aer are dst, ncl, so4, mom
integer, parameter :: max_aer = nsoa + npoa + nbc + 4
@@ -155,7 +159,7 @@ module modal_aero_amicphys
! early versions of mam neglected the seasalt contribution
! species indices for various qgas_--- arrays
- integer :: igas_soa, igas_h2so4, igas_nh3, igas_hno3, igas_hcl
+ integer :: igas_soa, igas_soag, igas_soag_end, igas_h2so4, igas_nh3, igas_hno3, igas_hcl
! species indices for various qaer_--- arrays
! when nsoa > 1, igas_soa and iaer_soa are indices of the first soa species
! when nbc > 1, iaer_bc is index of the first bc species
@@ -199,6 +203,7 @@ module modal_aero_amicphys
real(r8) :: mw_gas(max_gas), mw_aer(max_aer)
real(r8) :: mwhost_gas(max_gas), mwhost_aer(max_aer), mwhost_num
real(r8) :: mw_nh4a_host, mw_so4a_host
+ real(r8) :: mwuse_soag(nsoag)
real(r8) :: mwuse_soa(nsoa), mwuse_poa(npoa)
real(r8) :: sigmag_aer(max_mode)
real(r8) :: vol_molar_gas(max_gas)
@@ -1023,7 +1028,11 @@ subroutine modal_aero_amicphys_intr( &
if ( history_aerocom ) then
! 3d soa tendency for aerocom
! note that flux units (kg/m2/s) are used here instead of tendency units (kg/kg/s or kg/m3/s)
+#if ( defined VBS_SOA )
+ do jsoa = 1, nsoag
+#else
do jsoa = 1, nsoa
+#endif
l = lptr2_soa_g_amode(jsoa) - loffset
soag_3dtend_cond(i,k,jsoa) = qgcm_tendaa(l,iqtend_cond)*(adv_mass(l)/mwdry)*(pdel(i,k)/gravit)
end do
@@ -1082,7 +1091,11 @@ subroutine modal_aero_amicphys_intr( &
end do ! l
if ( ipass==1 .and. history_aerocom ) then
+#if ( defined VBS_SOA )
+ do jsoa = 1, nsoag
+#else
do jsoa = 1, nsoa
+#endif
l = lptr2_soa_g_amode(jsoa)
fieldname = trim(cnst_name(l)) // '_sfgaex3d'
call outfld( fieldname, soag_3dtend_cond(1:ncol,:,jsoa), ncol, lchnk )
@@ -3122,7 +3135,15 @@ subroutine mam_gasaerexch_1subarea( &
accom_coef_gas(igas), gas_diffus(igas), gas_freepath(igas), &
0.0_r8, ntot_amode, dgn_awet, alnsg_aer, uptkrate )
+#if ( defined VBS_SOA )
+ if (igas <= nsoag) then
+ iaer = 1
+ else
+ iaer = igas - nsoag + 1
+ endif
+#else
iaer = igas
+#endif
do n = 1, ntot_amode
if ( lmap_aer(iaer,n) > 0 .or. &
mode_aging_optaa(n) > 0 ) then
@@ -3137,7 +3158,11 @@ subroutine mam_gasaerexch_1subarea( &
do igas = 1, ngas
! use cam5.1.00 uptake rates
+#if ( defined VBS_SOA )
+ if (igas <= nsoag ) uptkaer(igas,1:ntot_amode) = uptkaer(igas_h2so4,1:ntot_amode)*0.81
+#else
if (igas <= nsoa ) uptkaer(igas,1:ntot_amode) = uptkaer(igas_h2so4,1:ntot_amode)*0.81
+#endif
if (igas == igas_nh3) uptkaer(igas,1:ntot_amode) = uptkaer(igas_h2so4,1:ntot_amode)*2.08
end do ! igas
uptkrate_h2so4 = sum( uptkaer(igas_h2so4,1:ntot_amode) )
@@ -3160,6 +3185,20 @@ subroutine mam_gasaerexch_1subarea( &
! do soa
+#if ( defined VBS_SOA )
+ call mam_soaexch_vbs_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ dtsubstep, &
+ temp, pmid, aircon, &
+ n_mode, &
+ qgas_cur, qgas_avg, &
+ qaer_cur, &
+ qnum_cur, &
+ qwtr_cur, &
+ uptkaer )
+#else
call mam_soaexch_1subarea( &
nstep, lchnk, &
i, k, jsub, &
@@ -3172,17 +3211,27 @@ subroutine mam_gasaerexch_1subarea( &
qnum_cur, &
qwtr_cur, &
uptkaer )
-
+#endif
! do other gases (that are assumed non-volatile) with no time sub-stepping
+#if ( defined VBS_SOA )
+ do igas = nsoag+1, ngas
+ iaer = igas - nsoag + 1
+#else
do igas = nsoa+1, ngas
iaer = igas
+#endif
qgas_prv(igas) = qgas_cur(igas)
qaer_prv(iaer,1:n_mode) = qaer_cur(iaer,1:n_mode)
end do
+#if ( defined VBS_SOA )
+ do igas = nsoag+1, ngas
+ iaer = igas - nsoag + 1
+#else
do igas = nsoa+1, ngas
iaer = igas
+#endif
if ( (igas == igas_hno3) .or. &
(igas == igas_hcl ) ) cycle
@@ -3261,6 +3310,422 @@ end subroutine mam_gasaerexch_1subarea
!----------------------------------------------------------------------
!----------------------------------------------------------------------
+
+#if ( defined VBS_SOA )
+ subroutine mam_soaexch_vbs_1subarea( &
+ nstep, lchnk, &
+ i, k, jsub, &
+ latndx, lonndx, lund, &
+ dtsubstep, &
+ temp, pmid, aircon, &
+ n_mode, &
+ qgas_cur, qgas_avg, &
+ qaer_cur, &
+ qnum_cur, &
+ qwtr_cur, &
+ uptkaer )
+
+! calculate soa condensation/evaporation for i,k,jsub over time dtsubstep
+! for the mam vbs soa mechanism
+!
+! currently this does a modified version of the nvsoa mechanism
+! of shrivastava et al. (2015) (doi 10.1002/2014jd022563)
+! the main difference is that soa and condensible organic vapors from
+! biomass-burning (and biofuel), biogenic, and fossil-fuel sources
+! are all lumped together rather than treated separately
+
+ use shr_kind_mod, only: r8 => shr_kind_r8
+ use modal_aero_data, only: lptr2_soa_a_amode
+ use cam_abortutils, only: endrun
+ use modal_aero_data, only: ntot_amode, nsoag, nsoa, npoa
+ use cam_logfile, only: iulog
+ use cam_history, only: outfld
+ use phys_debug_util, only: phys_debug_col
+
+ implicit none
+
+! arguments
+ integer, intent(in) :: nstep ! model time-step number
+ integer, intent(in) :: lchnk ! chunk identifier
+ integer, intent(in) :: i, k ! column and level indices
+ integer, intent(in) :: jsub ! sub-area index
+ integer, intent(in) :: latndx, lonndx ! lat and lon indices
+ integer, intent(in) :: lund ! logical unit for diagnostic output
+ integer, intent(in) :: n_mode ! current number of modes (including temporary)
+
+ real(r8), intent(in) :: dtsubstep ! current integration timestep (s)
+ real(r8), intent(in) :: temp ! temperature (K)
+ real(r8), intent(in) :: pmid ! pressure at model levels (Pa)
+ real(r8), intent(in) :: aircon ! air molar concentration (kmol/m3)
+
+ real(r8), intent(inout), dimension( 1:max_gas ) :: qgas_cur, qgas_avg
+ real(r8), intent(inout), dimension( 1:max_aer, 1:max_mode ) :: qaer_cur
+ real(r8), intent(inout), dimension( 1:max_mode ) :: qnum_cur
+ real(r8), intent(inout), dimension( 1:max_mode ) :: qwtr_cur
+ real(r8), intent(in ), dimension( 1:max_gas, 1:max_mode ) :: uptkaer
+
+! local
+ integer, parameter :: maxd_poaspec = npoa
+ integer, parameter :: maxd_soaspec = 7
+
+ integer :: iaer, igas, ip
+ integer :: isoa_bgn, isoa_end
+ integer :: ll
+ integer :: n, niter, niter_max
+ integer :: ntot_poaspec, ntot_soaspec
+ integer :: ntot_soamode
+
+ integer :: icol
+
+ logical, parameter :: flag_pcarbon_opoa_frac_zero = .true.
+
+ logical :: skip_soamode(max_mode) ! true if this mode does not have soa
+
+
+ real(r8), parameter :: a_min1 = 1.0e-20
+ real(r8), parameter :: g_min1 = 1.0e-20
+ real(r8), parameter :: alpha_astem = 0.05_r8 ! parameter used in calc of time step
+ real(r8), parameter :: dtsub_fixed = -1.0 ! fixed sub-step for time integration (s)
+! real(r8), parameter :: dtsub_fixed = 10.0 ! fixed sub-step for time integration (s)
+ real(r8), parameter :: rgas = 8.3144_r8 ! gas constant in J/K/mol
+
+ real(r8) :: a_ooa_sum_tmp(max_mode) ! total ooa (=soa+opoa) in a mode
+ real(r8) :: a_opoa(max_mode) ! oxidized-poa aerosol mixrat (mol/mol at actual mw)
+ real(r8) :: a_soa(maxd_soaspec,max_mode) ! soa aerosol mixrat (mol/mol at actual mw)
+ real(r8) :: a_soa_prv(maxd_soaspec,max_mode) ! soa aerosol mixrat at beginning of current time sub-step
+ real(r8) :: a_soa_tmp(maxd_soaspec,max_mode) ! temporary soa aerosol mixrat (mol/mol)
+ real(r8) :: beta(maxd_soaspec,max_mode) ! dtcur*xferrate
+ real(r8) :: c0_soa_298(maxd_soaspec) ! c0_soa_298 = soa gas equilib vapor conc (ug/m3) at 298 k
+ real(r8) :: delh_vap_soa(maxd_soaspec) ! delh_vap_soa = heat of vaporization for gas soa (J/mol)
+ real(r8) :: del_g_soa_tmp(maxd_soaspec)
+ real(r8) :: dtcur ! current time step (s)
+ real(r8) :: dtfull ! full time step (s)
+ real(r8) :: dtmax ! = (dtfull-tcur)
+ real(r8) :: dtsum_g_soa_avg
+ real(r8) :: g0_soa(maxd_soaspec) ! ambient soa gas equilib mixrat (mol/mol at actual mw)
+ real(r8) :: g_soa(maxd_soaspec) ! soa gas mixrat (mol/mol at actual mw)
+ real(r8) :: g_soa_prv(maxd_soaspec) ! soa gas mixrat at beginning of current time sub-step
+ real(r8) :: g_soa_avg(maxd_soaspec) ! time-averaged soa gas mixrat
+ real(r8) :: g_star(maxd_soaspec,max_mode) ! soa gas mixrat that is in equilib
+ ! with each aerosol mode (mol/mol)
+ real(r8) :: mw_poa(maxd_poaspec) ! actual molec wght of poa
+ real(r8) :: mw_soa(maxd_soaspec) ! actual molec wght of soa
+ real(r8) :: opoa_frac(maxd_poaspec,max_mode) ! fraction of poa that is opoa
+ real(r8) :: phi(maxd_soaspec,max_mode) ! "relative driving force"
+ real(r8) :: p0_soa(maxd_soaspec) ! soa gas equilib vapor presssure (atm)
+ real(r8) :: p0_soa_298(maxd_soaspec) ! p0_soa_298 = soa gas equilib vapor presssure (atm) at 298 k
+ real(r8) :: sat(maxd_soaspec,max_mode) ! sat(m,ll) = g0_soa(ll)/a_ooa_sum_tmp(m) = g_star(m,ll)/a_soa(m,ll)
+ ! used by the numerical integration scheme -- it is not a saturation rato!
+ real(r8) :: tcur ! current integration time (from 0 s)
+
+ real(r8) :: tmpa, tmpb, tmpc
+
+ real(r8) :: tot_soa(maxd_soaspec),tempvar(maxd_soaspec) ! g_soa + sum( a_soa(:) )
+ real(r8) :: uptkaer_soag(maxd_soaspec,max_mode)
+ real(r8) :: uptkaer_soag_tmp(maxd_soaspec,max_mode)
+
+ character(len=128) :: msg
+
+!check if it enters this subroutine
+ write(msg,'(a)') 'Within subroutine mam_soaexch_vbs_1subarea'
+
+ if (nsoag /= 7 .or. nsoa /= 1) then
+ write(msg,'(a,2(1x,i5))') 'mam_soaexch_vbs_1subarea - bad nsoag, nsoa =', nsoag, nsoa
+ call endrun( msg )
+ end if
+
+ ntot_poaspec = npoa
+
+! in the nvsoa treatment, the condensible organic vapors partition to the particle phase,
+! and the resulting aerosol species are initially semi-volatile (svsoa)
+! once in the particle phase, they quickly age (oligomerize) to non-volatile soa (nvsoa)
+!
+! ntot_soaspec here is the number of condensible organic vapors and corresponding svsoa species
+!
+! most of the calculations in this routine involve the dynamic partitioning (i.e., mass transfer),
+! and the nvsoa soa does not participate (or affect) the partitioning
+! after partitioning has been calculated for the time step (dtsubstep),
+! all of the svsoa is immediately converted to nvsoa
+! as a result, the final (i.e., end of time step) svsoa mixing ratios are always zero,
+! so the svsoa species do not need to be transported in the model,
+! and are just "temporary variables" within this routine
+
+ ntot_soaspec = nsoag
+
+ isoa_bgn = igas_soag
+ isoa_end = igas_soag_end
+
+! calc ntot_soamode = "last" mode on which soa is allowed to condense
+ ntot_soamode = 0
+ do n = 1, ntot_amode
+ if (n == nufi) cycle
+ if (mode_aging_optaa(n) > 0) ntot_soamode = n
+ if (lptr2_soa_a_amode(n,1) > 0) ntot_soamode = n
+ end do
+#if ( defined( CAMBOX_ACTIVATE_THIS ) )
+ if ( i*k == top_lev .and. ldiagd1 ) write(lund,'(/a,5i5)') &
+ 'ntot_amode, ntot_amode_extd, n_mode, ntot_soamode', &
+ ntot_amode, ntot_amode_extd, n_mode, ntot_soamode
+#endif
+
+! in the shrivastava et al. (2015) nvsoa treatment, poa is assumed to not contribute
+! to the raoults law calculation of effective saturation vapor pressures, so opoa_frac = 0.0
+ opoa_frac = 0.0_r8
+! for primary carbon mode, set opoa_frac=0 for consistency with older code
+! (this could be changed)
+ !if ( flag_pcarbon_opoa_frac_zero ) then
+ ! if (npca > 0) opoa_frac(:,npca) = 0.0_r8
+ !end if !QZR commented out 11March2022
+
+ c0_soa_298 = 0.1_r8
+ delh_vap_soa = 100.0e3
+ ! c0 an delh values from shrivastava et al. (2015)
+ ! SOAG15 SOAG24 SOAG35 SOAG34 SOAG33 SOAG32 SOAG31
+ delh_vap_soa(1:7) = (/ 82.0_r8, 88.0_r8, 82.0_r8, 88.0_r8, 94.0_r8, 100.0_r8, 106.0_r8 /) * 1.0e3_r8
+ c0_soa_298( 1:7) = (/ 1000.0_r8, 100.0_r8, 1000.0_r8, 100.0_r8, 10.0_r8, 1.0_r8, 0.1_r8 /)
+
+ do ll = 1, ntot_soaspec
+ igas = igas_soag + ll - 1
+ ! convert sat vapor conc from ug/m^3 to mol/m^3 then to mol/liter
+ tmpa = (c0_soa_298(ll)*1.0e-6_r8/mw_gas(igas)) * 1.0e-3_r8
+ ! calc sat vapor pressure (atm) from molar-conc and temp [ 0.082056 = gas constant in (atm/deg-K/(mol/liter)) ]
+ p0_soa_298(ll) = 0.082056_r8*tmpa*temp
+ end do
+
+! calc soa gas saturation molar-mixing-ratio at local temp and air-pressure
+ do ll = 1, ntot_soaspec
+ p0_soa(ll) = p0_soa_298(ll) * &
+ exp( -(delh_vap_soa(ll)/rgas)*((1.0/temp)-(1.0/298.0)) )
+ g0_soa(ll) = 1.01325e5*p0_soa(ll)/pmid
+ end do
+
+ niter_max = 1000
+ niter = 0
+ dtfull = dtsubstep
+ tcur = 0.0_r8
+ dtcur = 0.0_r8
+ phi(:,:) = 0.0_r8
+ g_star(:,:) = 0.0_r8
+ g_soa(:) = 0.0_r8
+ g_soa_prv(:) = 0.0_r8
+ a_opoa(:) = 0.0_r8
+ a_soa(:,:) = 0.0_r8
+ a_soa_prv(:,:) = 0.0_r8
+ g_soa_avg(:) = 0.0_r8
+ dtsum_g_soa_avg = 0.0_r8
+ uptkaer_soag(:,:) = 0.0_r8
+
+! initialize g_soa_prv, a_soa_prv, uptkaer_soag
+! the a_soa, which involves only the svsoa species, and is initially zero
+ do ll = 1, ntot_soaspec
+ igas = igas_soag + ll - 1
+ g_soa_prv(ll) = qgas_cur(igas)
+ do n = 1, ntot_soamode
+ !uptkaer(igas,n) = 100.0_r8 ! check if soa changes QZR test
+ uptkaer_soag(ll,n) = uptkaer(igas,n) !100.0_r8 !uptkaer(igas,n)
+ end do
+
+ iaer = iaer_soa + ll - 1
+ do n = 1, ntot_soamode
+ a_soa_prv(ll,n) = 0.0_r8
+ end do
+ end do
+
+! calc oxygenated poa (which does not change during the soa uptake integration)
+ do n = 1, ntot_soamode
+ a_opoa(n) = 0.0_r8
+ do ll = 1, ntot_poaspec
+ a_opoa(n) = a_opoa(n) + opoa_frac(ll,n) * max( qaer_cur(iaer_pom+ll-1,n), 0.0_r8 )
+ end do
+ end do
+
+
+!
+! main integration loop -- does multiple substeps to reach dtfull
+!
+
+time_loop: &
+ do while (tcur < dtfull-1.0e-3_r8 )
+
+ niter = niter + 1
+ if (niter > niter_max) exit
+
+
+! set qxxx_prv to be current value
+ if (niter > 1) then
+ g_soa_prv = g_soa
+ a_soa_prv = a_soa
+ end if
+
+
+! determine which modes have non-zero transfer rates
+! and are involved in the soa gas-aerosol transfer
+! for diameter = 1 nm and number = 1 #/cm3, xferrate ~= 1e-9 s-1
+ do n = 1, ntot_soamode
+ skip_soamode(n) = .true.
+ do ll = 1, ntot_soaspec
+ if (uptkaer_soag(ll,n) > 1.0e-15_r8) then
+ uptkaer_soag_tmp(ll,n) = uptkaer_soag(ll,n)
+ skip_soamode(n) = .false.
+ else
+ uptkaer_soag_tmp(ll,n) = 0.0_r8
+ end if
+ end do
+ end do
+
+! load incoming soag and soaa into temporary arrays
+! force things to be non-negative
+! calc tot_soa(ll)
+! calc a_opoa (always slightly >0)
+!
+! *** questions ***
+! > why not use qgas and qaer instead of g_soa and a_soa
+! > why not calc the following on every substep because
+! nuc and coag may change things:
+! skip)soamode, uptkaer_soag_tmp, tot_soa, a_opoa
+! > include gasprod for soa ??
+! > create qxxx_bgn = qxxx_cur at the very beginning (is it needed)
+!
+ do ll = 1, ntot_soaspec
+ g_soa(ll) = max( g_soa_prv(ll), 0.0_r8 )
+ tot_soa(ll) = g_soa(ll)
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ a_soa(ll,n) = max( a_soa_prv(ll,n), 0.0_r8 )
+ tot_soa(ll) = tot_soa(ll) + a_soa(ll,n)
+ end do
+ end do
+
+
+! determine time step
+ tmpa = 0.0_r8 ! time integration parameter for all soa species
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ a_ooa_sum_tmp(n) = a_opoa(n) + sum( a_soa(1:ntot_soaspec,n) )
+ end do
+
+ do ll = 1, ntot_soaspec
+ tmpb = 0.0_r8 ! time integration parameter for a single soa species
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ sat(ll,n) = g0_soa(ll)/max( a_ooa_sum_tmp(n), a_min1 )
+ g_star(ll,n) = sat(ll,n)*a_soa(ll,n)
+ phi(ll,n) = (g_soa(ll) - g_star(ll,n))/max( g_soa(ll), g_star(ll,n), g_min1 )
+ tmpb = tmpb + uptkaer_soag_tmp(ll,n)*abs(phi(ll,n))
+ end do
+ tmpa = max( tmpa, tmpb )
+ end do
+
+ if (dtsub_fixed > 0.0_r8) then
+ dtcur = dtsub_fixed
+ tcur = tcur + dtcur
+ else
+ dtmax = dtfull-tcur
+ if (dtmax*tmpa <= alpha_astem) then
+! here alpha_astem/tmpa >= dtmax, so this is final substep
+ dtcur = dtmax
+ tcur = dtfull
+ else
+ dtcur = alpha_astem/tmpa
+ tcur = tcur + dtcur
+ end if
+ end if
+
+! step 1 - for modes where soa is condensing, estimate "new" a_soa(ll,n)
+! using an explicit calculation with "old" g_soa
+! and g_star(ll,n) calculated using "old" a_soa(ll,n)
+! do this to get better estimate of "new" a_soa(ll,n) and sat(ll,n)
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ do ll = 1, ntot_soaspec
+ ! first ll loop calcs a_soa_tmp(ll,n) & a_ooa_sum_tmp
+ a_soa_tmp(ll,n) = a_soa(ll,n)
+ beta(ll,n) = dtcur*uptkaer_soag_tmp(ll,n)
+ del_g_soa_tmp(ll) = g_soa(ll) - g_star(ll,n)
+ if (del_g_soa_tmp(ll) > 0.0_r8) then
+ a_soa_tmp(ll,n) = a_soa(ll,n) + beta(ll,n)*del_g_soa_tmp(ll)
+ end if
+ end do
+ a_ooa_sum_tmp(n) = a_opoa(n) + sum( a_soa_tmp(1:ntot_soaspec,n) )
+ do ll = 1, ntot_soaspec
+ ! second ll loop calcs sat & g_star
+ if (del_g_soa_tmp(ll) > 0.0_r8) then
+ sat(ll,n) = g0_soa(ll)/max( a_ooa_sum_tmp(n), a_min1 )
+ g_star(ll,n) = sat(ll,n)*a_soa_tmp(ll,n) ! this just needed for diagnostics
+ end if
+ end do
+ end do
+
+
+! step 2 - implicit in g_soa and semi-implicit in a_soa,
+! with g_star(ll,n) calculated semi-implicitly
+ do ll = 1, ntot_soaspec
+ tmpa = 0.0_r8
+ tmpb = 0.0_r8
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ tmpa = tmpa + a_soa(ll,n)/(1.0_r8 + beta(ll,n)*sat(ll,n))
+ tmpb = tmpb + beta(ll,n)/(1.0_r8 + beta(ll,n)*sat(ll,n))
+ end do
+
+ g_soa(ll) = (tot_soa(ll) - tmpa)/(1.0_r8 + tmpb)
+ g_soa(ll) = max( 0.0_r8, g_soa(ll) )
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ a_soa(ll,n) = (a_soa(ll,n) + beta(ll,n)*g_soa(ll))/ &
+ (1.0_r8 + beta(ll,n)*sat(ll,n))
+ end do
+ end do
+
+! increment g_soa_avg
+ do ll = 1, ntot_soaspec
+ tmpc = g_soa(ll) - g_soa_prv(ll)
+ g_soa_avg(ll) = g_soa_avg(ll) + dtcur*(g_soa_prv(ll) + 0.5_r8*tmpc)
+ end do
+
+ dtsum_g_soa_avg = dtsum_g_soa_avg + dtcur
+
+ end do time_loop
+
+
+! update mix ratios for soa gas species,
+! and convert g_soa_avg from sum_over[ qgas*dt_cut ] to an time averaged value
+ do ll = 1, ntot_soaspec
+ igas = igas_soag + ll - 1
+ qgas_cur(igas) = g_soa(ll)
+ qgas_avg(igas) = max( 0.0_r8, g_soa_avg(ll)/dtsum_g_soa_avg )
+ end do
+
+
+! Print qaer_cur but for each species and sum of all mode QZR MS
+ do ll = 1, ntot_soaspec
+ tempvar(ll)=0.0_r8
+ end do
+
+
+ do ll = 1, ntot_soaspec
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ tempvar(ll)=tempvar(ll)+a_soa(ll,n)
+ end do
+ end do
+
+! for each mode, sum up all of the newly condensed svsoa
+! and "oligomerize" it to the single nvsoa species
+ do n = 1, ntot_soamode
+ if ( skip_soamode(n) ) cycle
+ tmpa = 0.0_r8
+ do ll = 1, ntot_soaspec
+ tmpa = tmpa + a_soa(ll,n)
+ end do
+ iaer = iaer_soa
+ qaer_cur(iaer,n) = qaer_cur(iaer,n) + tmpa
+ end do
+
+ return
+ end subroutine mam_soaexch_vbs_1subarea
+#endif
+
subroutine mam_soaexch_1subarea( &
nstep, lchnk, &
i, k, jsub, &
@@ -5170,11 +5635,14 @@ subroutine modal_aero_amicphys_init( imozart, species_class,n_so4_monolayers_pca
#endif
- call mam_set_lptr2_and_specxxx2
-
-
+#if ( defined VBS_SOA )
+ mwuse_soag(:) = 250.0_r8
+ mwuse_soa(:) = 250.0_r8
+ mwuse_poa(:) = 250.0_r8
+#else
mwuse_soa(:) = 150.0_r8
mwuse_poa(:) = 150.0_r8
+#endif
! set ngas, name_gas, and igas_xxx
! set naer, name_aerpfx, and iaer_xxx
@@ -5186,6 +5654,8 @@ subroutine modal_aero_amicphys_init( imozart, species_class,n_so4_monolayers_pca
name_numcw = "???"
igas_h2so4 = 0 ; igas_nh3 = 0
+ igas_hno3 = 0 ; igas_hcl = 0
+ igas_soag = 0
iaer_bc = 0 ; iaer_dst = 0
iaer_ncl = 0 ; iaer_nh4 = 0
iaer_pom = 0 ; iaer_soa = 0
@@ -5196,7 +5666,22 @@ subroutine modal_aero_amicphys_init( imozart, species_class,n_so4_monolayers_pca
iaer_mlip = 0 ; iaer_mhum = 0
iaer_mproc = 0 ; iaer_mom = 0
+#if ( defined VBS_SOA )
+ if (nsoa == 1 .and. nsoag == 7) then
+ jsoa = 1 ; name_gas(jsoa) = 'SOAG15'
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAG24'
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAG35'
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAG34'
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAG33'
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAG32'
+ jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAG31'
+ igas_soag_end = jsoa
+
+ name_aerpfx(1) = 'soa'
+ else if (nsoa == 1 .and. nsoag == 1) then
+#else
if (nsoa == 1) then
+#endif
name_gas(1) = 'SOAG'
name_aerpfx(1) = 'soa'
else if (nsoa == 2) then
@@ -5210,9 +5695,16 @@ subroutine modal_aero_amicphys_init( imozart, species_class,n_so4_monolayers_pca
jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAGb2' ; name_aerpfx(jsoa) = 'soab2' ! jsoa=5
jsoa = jsoa+1 ; name_gas(jsoa) = 'SOAGb3' ; name_aerpfx(jsoa) = 'soab3' ! jsoa=6
else
- call endrun( 'modal_aero_amicphys_init ERROR - bad nsoa' )
+ write( msg, '(a,3(1x,i10))') &
+ 'modal_aero_amicphys_init ERROR - bad soa, nsoa, nsoag =', nsoa, nsoag
+ call endrun( msg )
end if
+#if ( defined VBS_SOA )
+ ngas = nsoag
+ igas_soag = 1
+#else
ngas = nsoa
+#endif
naer = nsoa
igas_soa = 1
iaer_soa = 1
@@ -5323,6 +5815,8 @@ subroutine modal_aero_amicphys_init( imozart, species_class,n_so4_monolayers_pca
call endrun( 'modal_aero_amicphys_init ERROR - bad ngas or naer' )
end if
+ call mam_set_lptr2_and_specxxx2
+
lmapcc_all(:) = 0
! set gas mapping
@@ -5352,10 +5846,18 @@ subroutine modal_aero_amicphys_init( imozart, species_class,n_so4_monolayers_pca
mwhost_gas(igas) = adv_mass(lmz)
mw_gas(igas) = mwhost_gas(igas)
+#if ( defined VBS_SOA )
+ if (igas <= nsoag) mw_gas(igas) = mwuse_soag(igas)
+#else
if (igas <= nsoa) mw_gas(igas) = mwuse_soa(igas)
+#endif
fcvt_gas(igas) = mwhost_gas(igas)/mw_gas(igas)
+#if ( defined VBS_SOA )
+ if (igas <= nsoag) then
+#else
if (igas <= nsoa) then
+#endif
vol_molar_gas(igas) = vol_molar_gas(igas_h2so4) * (mw_gas(igas)/98.0_r8)
else if (igas == igas_nh3) then
vol_molar_gas(igas) = 14.90_r8
@@ -5624,11 +6126,11 @@ subroutine modal_aero_amicphys_init( imozart, species_class,n_so4_monolayers_pca
'ngas, max_gas, naer, max_aer', &
ngas, max_gas, naer, max_aer
write(iulog,'(/a56,10i5)') &
- 'nsoa, npoa, nbc', &
- nsoa, npoa, nbc
+ 'nsoag, nsoa, npoa, nbc', &
+ nsoag, nsoa, npoa, nbc
write(iulog,'(/a56,10i5)') &
- 'igas_soa, igas_h2so4, igas_nh3, igas_hno3, igas_hcl', &
- igas_soa, igas_h2so4, igas_nh3, igas_hno3, igas_hcl
+ 'igas_soag, igas_soa, igas_h2so4, igas_nh3, igas_hno3, igas_hcl', &
+ igas_soag, igas_soa, igas_h2so4, igas_nh3, igas_hno3, igas_hcl
write(iulog,'(/a56,10i5)') &
'iaer_soa, iaer_so4, iaer_nh4, iaer_no3, iaer_cl', &
iaer_soa, iaer_so4, iaer_nh4, iaer_no3, iaer_cl
@@ -5717,17 +6219,28 @@ subroutine mam_set_lptr2_and_specxxx2
implicit none
- integer :: jsoa
+ integer :: jsoa, igas
integer :: l1, l2
integer :: n
- if (nsoa == 1) then
+#if ( defined VBS_SOA )
+ if (nsoa == 1 .and. nsoag == 7) then
+ jsoa = 1
+ do igas = 1, nsoag
+ call cnst_get_ind( name_gas(igas), l1, .false. )
+ if (l1 < 1 .or. l1 > pcnst) &
+ call endrun( 'mam_set_lptr2_and_specxxx2 ERROR - no VBS' // name_gas(igas) )
+ lptr2_soa_g_amode(igas) = l1
+ end do
+#else
+ if (nsoa == 1 .and. nsoag == 1) then
jsoa = 1
call cnst_get_ind( 'SOAG', l1, .false. )
if (l1 < 1 .or. l1 > pcnst) &
call endrun( 'mam_set_lptr2_and_specxxx2 ERROR - no SOAG' )
lptr2_soa_g_amode(jsoa) = l1
+#endif
do n = 1, ntot_amode
lptr2_soa_a_amode(n,jsoa) = lptr_soa_a_amode(n)
end do
@@ -5823,7 +6336,15 @@ subroutine m_a_amicphys_init_history( loffset )
lmz = lmap_gas(igas)
if (lmz <= 0) cycle
do_q_coltendaa(lmz,iqtend_cond) = .true.
+#if ( defined VBS_SOA )
+ if (igas <= nsoag) then
+ iaer = 1
+ else
+ iaer = igas - nsoag + 1
+ endif
+#else
iaer = igas
+#endif
do n = 1, ntot_amode
lmz = lmap_aer(iaer,n)
if (lmz <= 0) cycle
@@ -5864,7 +6385,11 @@ subroutine m_a_amicphys_init_history( loffset )
end do ! lmz
! define history fields for 3d soa production for aerocom
+#if ( defined VBS_SOA )
+ do igas = 1, nsoag
+#else
do igas = 1, nsoa
+#endif
lmz = lmap_gas(igas)
if (lmz <= 0) cycle
if ( .not. do_q_coltendaa(lmz,iqtend_cond)) cycle
@@ -5989,7 +6514,15 @@ subroutine m_a_amicphys_init_history( loffset )
lmz = lmap_gas(igas)
if (lmz > 0) then
do_q_coltendaa(lmz,iqtend_nnuc) = .true.
+#if ( defined VBS_SOA )
+ if (igas <= nsoag) then
+ iaer = 1
+ else
+ iaer = igas - nsoag + 1
+ endif
+#else
iaer = igas
+#endif
lmz = lmap_aer(iaer,n)
if (lmz > 0) do_q_coltendaa(lmz,iqtend_nnuc) = .true.
end if
diff --git a/components/eam/src/chemistry/modal_aero/modal_aero_data.F90 b/components/eam/src/chemistry/modal_aero/modal_aero_data.F90
index 86b0ceb1642a..410c78aefb88 100644
--- a/components/eam/src/chemistry/modal_aero/modal_aero_data.F90
+++ b/components/eam/src/chemistry/modal_aero/modal_aero_data.F90
@@ -33,8 +33,11 @@ module modal_aero_data
integer, parameter :: nbc = 1 ! number of differently tagged black-carbon aerosol species
integer, parameter :: npoa = 1 ! number of differently tagged primary-organic aerosol species
integer, parameter :: nsoa = 1 ! number of differently tagged secondary-organic aerosol species
+#if ( defined VBS_SOA )
+ integer, parameter :: nsoag = 7 ! number of differently tagged secondary-organic gas species
+#else
integer, parameter :: nsoag = 1 ! number of differently tagged secondary-organic gas species
-
+#endif
!
! definitions for aerosol chemical components
!
@@ -67,7 +70,11 @@ module modal_aero_data
real(r8), parameter :: specmw_amode(ntot_aspectype) = (/ 96.0_r8, 18.0_r8, 62.0_r8, &
12.0_r8, 12.0_r8, 12.0_r8, 58.5_r8, 135.0_r8, &
250092.0_r8, 66528.0_r8, 284.0_r8 /)
-#elif ( defined MODAL_AERO_4MODE_MOM )
+#elif ( ( defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE ) && ( defined VBS_SOA ) )
+ real(r8), parameter :: specmw_amode(ntot_aspectype) = (/ 115.0_r8, 115.0_r8, 62.0_r8, &
+ 12.0_r8, 250.0_r8, 12.0_r8, 58.5_r8, 135.0_r8, &
+ 250092.0_r8 /)
+#elif ( defined MODAL_AERO_4MODE_MOM || defined MODAL_AERO_5MODE )
real(r8), parameter :: specmw_amode(ntot_aspectype) = (/ 115.0_r8, 115.0_r8, 62.0_r8, &
12.0_r8, 12.0_r8, 12.0_r8, 58.5_r8, 135.0_r8, &
250092.0_r8 /)
diff --git a/components/eam/src/chemistry/mozart/chemistry.F90 b/components/eam/src/chemistry/mozart/chemistry.F90
index 4621cb480f10..f4cee663fbfd 100644
--- a/components/eam/src/chemistry/mozart/chemistry.F90
+++ b/components/eam/src/chemistry/mozart/chemistry.F90
@@ -1496,6 +1496,11 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o, f
!-----------------------------------------------------------------------
! get tropopause level
!-----------------------------------------------------------------------
+
+! initialize tropospheric level flags
+ tropFlag = .false.
+ tropFlagInt = 0._r8
+
e90_ndx = get_spc_ndx('E90')
if (e90_ndx <= 0) then
call tropopause_find(state, tropLev, primary=TROP_ALG_HYBSTOB, backup=TROP_ALG_CLIMATE)
diff --git a/components/eam/src/chemistry/mozart/mo_chm_diags.F90 b/components/eam/src/chemistry/mozart/mo_chm_diags.F90
index 9df5f57c0ecf..7a099bca8d74 100644
--- a/components/eam/src/chemistry/mozart/mo_chm_diags.F90
+++ b/components/eam/src/chemistry/mozart/mo_chm_diags.F90
@@ -114,6 +114,7 @@ subroutine chm_diags_inti
integer :: UCIgaschmbudget_2D_L4_s
integer :: UCIgaschmbudget_2D_L4_e
integer :: bulkaero_species(20)
+ integer :: e90_ndx
!-----------------------------------------------------------------------
@@ -843,12 +844,16 @@ subroutine chm_diags_inti
call addfld( 'AREA', horiz_only, 'A', 'm2', 'area of grid box' )
! tropospheric air mass diagnostics based on 3D tropopause flag
- call addfld( 'TROPMASS', horiz_only , 'A', 'kg', 'tropospheric air mass of grid column' )
- call addfld( 'TROPMASSB', horiz_only , 'A', 'kg', 'tropospheric air mass of grid column (lowest tropopause)' )
- call addfld( 'TROPMASST', horiz_only , 'A', 'kg', 'tropospheric air mass of grid column (highest tropopause)' )
- call add_default( 'TROPMASS', 1, ' ' )
- call add_default( 'TROPMASSB', 1, ' ' )
- call add_default( 'TROPMASST', 1, ' ' )
+ e90_ndx=-1
+ e90_ndx = get_spc_ndx('E90')
+ if (e90_ndx > 0) then
+ call addfld( 'TROPMASS', horiz_only , 'A', 'kg', 'tropospheric air mass of grid column' )
+ call addfld( 'TROPMASSB', horiz_only , 'A', 'kg', 'tropospheric air mass of grid column (lowest tropopause)' )
+ call addfld( 'TROPMASST', horiz_only , 'A', 'kg', 'tropospheric air mass of grid column (highest tropopause)' )
+ call add_default( 'TROPMASS', 1, ' ' )
+ call add_default( 'TROPMASSB', 1, ' ' )
+ call add_default( 'TROPMASST', 1, ' ' )
+ endif
if (history_gaschmbudget .or. history_gaschmbudget_2D .or. history_gaschmbudget_2D_levels .or.&
history_UCIgaschmbudget_2D .or. history_UCIgaschmbudget_2D_levels) then
@@ -982,6 +987,7 @@ subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depf
!--------------------------------------------------------------------
integer :: i,j,k, m, n
integer :: plat
+ integer :: e90_ndx
real(r8) :: wrk(ncol,pver)
real(r8) :: un2(ncol)
@@ -1057,8 +1063,12 @@ subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depf
call outfld( 'MASS', mass(:ncol,:), ncol, lchnk )
call outfld( 'DRYMASS', drymass(:ncol,:), ncol, lchnk )
+ ! use existence of E90 to supplement the logical switch based on presence of tropFlag or its values
+ e90_ndx=-1
+ e90_ndx = get_spc_ndx('E90')
+
! tropospheric air mass when 3D tropopause is available
- if (present(tropFlag)) then
+ if (e90_ndx > 0 .and. present(tropFlag)) then
! 3D tropopause
wrk1d(:) = 0._r8
do i = 1,ncol
@@ -1110,7 +1120,12 @@ subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depf
! stratospheric column ozone
wrk1d(:) = 0._r8
- if (.not. present(tropFlag)) then
+ if (e90_ndx < 0 .or. .not. present(tropFlag)) then
+ ! use 2D tropopause if E90 not used or tropFlag not present.
+ ! e90_ndx < 0 condition alone is sufficient, as 3D tropFlag is computed
+ ! only when E90 is used.
+ ! This change is to make the calculation valid when E90 is not in use
+
do i = 1,ncol
do k = 1,pver
if (k > ltrop(i)) then
@@ -1132,7 +1147,7 @@ subroutine chm_diags( lchnk, ncol, vmr, mmr, rxt_rates, invariants, depvel, depf
! tropospheric column ozone
wrk1d(:) = 0._r8
- if (.not. present(tropFlag)) then
+ if (e90_ndx < 0 .or. .not. present(tropFlag)) then
do i = 1,ncol
do k = 1,pver
if (k <= ltrop(i)) then
diff --git a/components/eam/src/chemistry/mozart/mo_gas_phase_chemdr.F90 b/components/eam/src/chemistry/mozart/mo_gas_phase_chemdr.F90
index 19ebd9a6c906..3c979e80229b 100644
--- a/components/eam/src/chemistry/mozart/mo_gas_phase_chemdr.F90
+++ b/components/eam/src/chemistry/mozart/mo_gas_phase_chemdr.F90
@@ -690,6 +690,7 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, &
!-----------------------------------------------------------------------
! ... Set the column densities at the upper boundary
!-----------------------------------------------------------------------
+ col_delta = 0._r8
call set_ub_col( col_delta, vmr, invariants, pint(:,1), pdel, ncol, lchnk)
!-----------------------------------------------------------------------
@@ -1276,8 +1277,14 @@ subroutine gas_phase_chemdr(lchnk, ncol, imozart, q, &
n = map2chm( m )
if ( n > 0 ) then
if ( .not. any( aer_species == n ) ) then
- if (trim(solsym(n))/='DMS' .and. trim(solsym(n))/='SO2' .and. &
- trim(solsym(n))/='H2SO4' .and. trim(solsym(n))/='SOAG') then
+ if (trim(solsym(n))/='DMS' .and. trim(solsym(n))/='SO2' .and. &
+ trim(solsym(n))/='H2SO4' .and. trim(solsym(n))/='SOAG' .and. &
+ trim(solsym(n))/='SOAG0' .and. trim(solsym(n))/='SOAG15' .and. &
+ trim(solsym(n))/='SOAG24' .and. trim(solsym(n))/='SOAG31' .and. &
+ trim(solsym(n))/='SOAG32' .and. trim(solsym(n))/='SOAG33' .and. &
+ trim(solsym(n))/='SOAG34' .and. trim(solsym(n))/='SOAG35' .and. &
+ trim(solsym(n))/='HNO3' .and. trim(solsym(n))/='NH3' .and. &
+ trim(solsym(n))/='HCL') then
!write(iulog,*) 'n=',n,'solsym=',trim(solsym(n))
vmr(:ncol,:,n) = vmr_old2(:ncol,:,n)
endif
diff --git a/components/eam/src/chemistry/mozart/mo_neu_wetdep.F90 b/components/eam/src/chemistry/mozart/mo_neu_wetdep.F90
index ffd8fe2a4ca9..eddd35763859 100644
--- a/components/eam/src/chemistry/mozart/mo_neu_wetdep.F90
+++ b/components/eam/src/chemistry/mozart/mo_neu_wetdep.F90
@@ -93,7 +93,15 @@ subroutine neu_wetdep_init
case ( 'CLONO2','BRONO2','HCL','HOCL','HOBR','HBR', 'Pb', 'MACROOH', 'ISOPOOH', 'XOOH', 'H2SO4' )
test_name = 'HNO3'
case ( 'ALKOOH', 'MEKOOH', 'TOLOOH', 'TERPOOH' )
- test_name = 'CH3OOH'
+ test_name = 'CH3OOH'
+ case ( 'SOAG0', 'SOAG15', 'SOAG24', 'SOAG31', 'SOAG32', &
+ 'SOAG33', 'SOAG34', 'SOAG35')
+! added by Manish Shrivastava on 01/22/2016 to do wet deposition of SOA gas species
+ test_name = 'CH3OOH'
+! this is just a place holder. values are explicitly set below dheff,
+! and species are read in from n_species_table in seq_drydep_mod.F90,
+! where the values of all SOAG deposition constants like Henry's coefficients are set
+! These constants are shared by dry and wet deposition calculations of gases
end select
!
diff --git a/components/eam/src/chemistry/mozart/mo_sethet.F90 b/components/eam/src/chemistry/mozart/mo_sethet.F90
index 881da9970d36..5a6fece2e2ca 100644
--- a/components/eam/src/chemistry/mozart/mo_sethet.F90
+++ b/components/eam/src/chemistry/mozart/mo_sethet.F90
@@ -28,6 +28,8 @@ module mo_sethet
integer :: alkooh_ndx, mekooh_ndx, tolooh_ndx, terpooh_ndx, ch3cooh_ndx
integer :: so2_ndx, soa_ndx, so4_ndx, cb2_ndx, oc2_ndx, nh3_ndx, nh4no3_ndx, &
sa1_ndx, sa2_ndx, sa3_ndx, sa4_ndx, nh4_ndx, h2so4_ndx
+ integer :: soag0_ndx, soag15_ndx, soag24_ndx, soag31_ndx
+ integer :: soag32_ndx, soag33_ndx, soag34_ndx, soag35_ndx
integer :: xisopno3_ndx,xho2no2_ndx,xonitr_ndx,xhno3_ndx,xonit_ndx
integer :: clono2_ndx, brono2_ndx, hcl_ndx, n2o5_ndx, hocl_ndx, hobr_ndx, hbr_ndx
integer :: ch3cn_ndx, hcn_ndx, hcooh_ndx
@@ -137,9 +139,18 @@ subroutine sethet_inti
ch3cn_ndx = get_het_ndx( 'CH3CN' )
hcn_ndx = get_het_ndx( 'HCN' )
hcooh_ndx = get_het_ndx( 'HCOOH' )
+ soag0_ndx = get_het_ndx( 'SOAG0' )
+ soag15_ndx = get_het_ndx( 'SOAG15' )
+ soag24_ndx = get_het_ndx( 'SOAG24' )
+ soag31_ndx = get_het_ndx( 'SOAG31' )
+ soag32_ndx = get_het_ndx( 'SOAG32' )
+ soag33_ndx = get_het_ndx( 'SOAG33' )
+ soag34_ndx = get_het_ndx( 'SOAG34' )
+ soag35_ndx = get_het_ndx( 'SOAG35' )
if (masterproc) then
write(iulog,*) 'sethet_inti: new ndx ',so2_ndx,soa_ndx,so4_ndx,cb2_ndx,oc2_ndx, &
+ soag0_ndx,soag15_ndx,soag24_ndx,soag31_ndx,soag32_ndx,soag33_ndx,soag34_ndx,soag35_ndx, &
nh3_ndx,nh4no3_ndx,sa1_ndx,sa2_ndx,sa3_ndx,sa4_ndx
write(iulog,*) ' '
write(iulog,*) 'sethet_inti: diagnotics '
@@ -668,6 +679,30 @@ subroutine sethet( het_rates, press, zmid, phis, tfld, &
if( ch3ooh_ndx > 0 ) then
het_rates(i,k,ch3ooh_ndx) = work3(i)
end if
+ if( soag0_ndx > 0 ) then
+ het_rates(i,k,soag0_ndx) = work3(i)
+ endif
+ if( soag15_ndx > 0 ) then
+ het_rates(i,k,soag15_ndx) = work3(i)
+ endif
+ if( soag24_ndx > 0 ) then
+ het_rates(i,k,soag24_ndx) = work3(i)
+ endif
+ if( soag31_ndx > 0 ) then
+ het_rates(i,k,soag31_ndx) = work3(i)
+ endif
+ if( soag32_ndx > 0 ) then
+ het_rates(i,k,soag32_ndx) = work3(i)
+ endif
+ if( soag33_ndx > 0 ) then
+ het_rates(i,k,soag33_ndx) = work3(i)
+ endif
+ if( soag34_ndx > 0 ) then
+ het_rates(i,k,soag34_ndx) = work3(i)
+ endif
+ if( soag35_ndx > 0 ) then
+ het_rates(i,k,soag35_ndx) = work3(i)
+ endif
if( pooh_ndx > 0 ) then
het_rates(i,k,pooh_ndx) = work3(i)
end if
diff --git a/components/eam/src/control/cam_history.F90 b/components/eam/src/control/cam_history.F90
index 1c6a1c98f226..b586d9317edb 100644
--- a/components/eam/src/control/cam_history.F90
+++ b/components/eam/src/control/cam_history.F90
@@ -3848,7 +3848,7 @@ subroutine h_define (t, restart)
&Mailing address: LLNL Climate Program, c/o David C. Bader, &
&Principal Investigator, L-103, 7000 East Avenue, Livermore, CA 94550, USA')
ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'contact', &
- 'e3sm-data-support@listserv.llnl.gov')
+ 'e3sm-data-support@llnl.gov')
ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'initial_file', ncdata)
ierr=pio_put_att (tape(t)%File, PIO_GLOBAL, 'topography_file', bnd_topo)
diff --git a/components/eam/src/dynamics/se/inidat.F90 b/components/eam/src/dynamics/se/inidat.F90
index bfb162d5cf0a..83245fc8b897 100644
--- a/components/eam/src/dynamics/se/inidat.F90
+++ b/components/eam/src/dynamics/se/inidat.F90
@@ -440,8 +440,10 @@ subroutine read_inidat( ncid_ini, ncid_topo, dyn_in)
call endrun('Problem reading ps field')
end if
- if (scm_multcols .and. tmp(1,1,1) < 10000._r8) then
- call endrun('Problem reading ps field')
+ if (scm_multcols) then
+ if (tmp(1,1,1) < 10000._r8) then
+ call endrun('Problem reading ps field')
+ endif
endif
deallocate(tmpmask)
diff --git a/components/eam/src/physics/cam/activate_drop_mam.F90 b/components/eam/src/physics/cam/activate_drop_mam.F90
new file mode 100755
index 000000000000..eafa377b2bf5
--- /dev/null
+++ b/components/eam/src/physics/cam/activate_drop_mam.F90
@@ -0,0 +1,569 @@
+module activate_drop_mam
+
+!---------------------------------------------------------------------------------
+!
+! Routines for droplet activation by modal aerosols
+!
+!---------------------------------------------------------------------------------
+
+use shr_kind_mod, only: r8 => shr_kind_r8
+#ifndef HAVE_ERF_INTRINSICS
+use shr_spfn_mod, only: erf => shr_spfn_erf
+#endif
+use wv_saturation, only: qsat
+
+use cam_abortutils, only: endrun
+
+implicit none
+private
+save
+
+public &
+ actdrop_mam_init, &
+ actdrop_mam_calc
+
+integer :: iulog ! fortran unit to use for log messages
+
+real(r8) :: pi
+real(r8) :: rair
+real(r8) :: rgas
+real(r8) :: rh2o
+real(r8) :: rhoh2o
+real(r8) :: mwh2o
+real(r8) :: epsilo ! Ratio of h2o to dry air molecular weights
+real(r8) :: latvap
+real(r8) :: cpair
+real(r8) :: gravit
+
+real(r8), parameter :: t0 = 273._r8
+real(r8), parameter :: p0 = 1013.25e2_r8 ! reference pressure (Pa)
+real(r8), parameter :: surften = 0.076_r8
+real(r8), parameter :: zero = 0._r8
+real(r8), parameter :: third = 1._r8/3._r8
+real(r8), parameter :: twothird = 2._r8*third
+real(r8), parameter :: sixth = 1._r8/6._r8
+
+real(r8) :: sq2, alog2, alog3, sqpi
+real(r8) :: aten, alogaten
+
+integer :: nmode
+real(r8), allocatable :: alogsig(:) ! natl log of geometric standard dev of aerosol
+real(r8), allocatable :: exp45logsig(:)
+real(r8), allocatable :: f1(:) ! abdul-razzak functions of width
+real(r8), allocatable :: f2(:) ! abdul-razzak functions of width
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine actdrop_mam_init( &
+ iulog_in, pi_in, rair_in, rgas_in, rh2o_in, &
+ rhoh2o_in, mwh2o_in, epsilo_in, latvap_in, cpair_in, &
+ gravit_in, ntot_amode, sigmag_amode)
+
+ integer, intent(in) :: iulog_in ! fortran unit to use for log messages
+ real(r8), intent(in) :: pi_in
+ real(r8), intent(in) :: rair_in
+ real(r8), intent(in) :: rgas_in
+ real(r8), intent(in) :: rh2o_in
+ real(r8), intent(in) :: rhoh2o_in
+ real(r8), intent(in) :: mwh2o_in
+ real(r8), intent(in) :: epsilo_in ! Ratio of h2o to dry air molecular weights
+ real(r8), intent(in) :: latvap_in
+ real(r8), intent(in) :: cpair_in
+ real(r8), intent(in) :: gravit_in
+ integer, intent(in) :: ntot_amode
+ real(r8), intent(in) :: sigmag_amode(ntot_amode)
+
+ integer :: m
+
+ character(len=*), parameter :: subname='actdrop_mam_init'
+ !---------------------------------------------------------------------------------
+
+ iulog = iulog_in
+
+ pi = pi_in
+ rair = rair_in
+ rgas = rgas_in
+ rh2o = rh2o_in
+ rhoh2o = rhoh2o_in
+ mwh2o = mwh2o_in
+ epsilo = epsilo_in
+ latvap = latvap_in
+ cpair = cpair_in
+ gravit = gravit_in
+
+ sq2 = sqrt(2._r8)
+ alog2 = log(2._r8)
+ alog3 = log(3._r8)
+ sqpi = sqrt(pi)
+ aten = 2._r8*mwh2o*surften/(rgas*t0*rhoh2o)
+ alogaten = log(aten)
+
+ allocate( &
+ alogsig(ntot_amode), &
+ exp45logsig(ntot_amode), &
+ f1(ntot_amode), &
+ f2(ntot_amode) )
+
+ do m = 1, ntot_amode
+ ! use only if width of size distribution is prescribed
+ 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)
+ end do
+
+end subroutine actdrop_mam_init
+
+!---------------------------------------------------------------------------------
+
+subroutine actdrop_mam_calc( &
+ wbar, sigw, wdiab, wminf, wmaxf, &
+ tair, rhoair, na, nmode, volume, &
+ hygro, in_cloud, smax_f, fn, fm, &
+ fluxn, fluxm, flux_fullact)
+
+ ! 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.
+ !
+ ! **** NOTE **** The modification to the in-cloud calculation of smax has only
+ ! implemented in the single updraft branch of the sigw conditional
+ !
+ ! mks units
+ !
+ ! Abdul-Razzak and Ghan, A parameterization of aerosol activation.
+ ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844.
+
+ ! Input Arguments
+ 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(:) ! (nmode) aerosol number concentration (/m3)
+ integer, intent(in) :: nmode ! number of aerosol modes
+ real(r8), intent(in) :: volume(:) ! (nmode) aerosol volume concentration (m3/m3)
+ real(r8), intent(in) :: hygro(:) ! (nmode) hygroscopicity of aerosol mode
+ logical, intent(in) :: in_cloud ! switch to modify calculations when above cloud base
+ real(r8), intent(in) :: smax_f ! droplet and rain size distr factor in the smax calculation
+ ! used when in_cloud=.true.
+
+ ! Output Arguments
+ real(r8), intent(out) :: fn(:) ! (nmode) number fraction of aerosols activated
+ real(r8), intent(out) :: fm(:) ! (nmode) mass fraction of aerosols activated
+ real(r8), intent(out) :: fluxn(:) ! (nmode) flux of activated aerosol number fraction into cloud (cm/s)
+ real(r8), intent(out) :: fluxm(:) ! (nmode) 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 :: m, n
+
+ real(r8), parameter :: eps=0.3_r8, fmax=0.99_r8, sds=3._r8
+
+ real(r8) :: pres ! pressure (Pa)
+ 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) :: alpha
+ real(r8) :: gamma
+ real(r8) :: etafactor2(nmode), etafactor2max
+
+ real(r8) :: amcube(nmode) ! cube of dry mode radius (m)
+ real(r8) :: grow, beta
+ real(r8) :: sqrtg(nmode)
+ real(r8) :: smc(nmode) ! critical supersaturation for number mode radius
+ real(r8) :: lnsm(nmode) ! ln(smc)
+
+ real(r8) :: wmin, wmax, w, dw, dwmax, dwmin, wnuc, dwnew
+ real(r8) :: dfmin, dfmax
+ 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) :: sumflx_fullact
+ real(r8) :: fold, wold, gold
+ real(r8) :: alw, sqrtalw, etafactor1
+ real(r8) :: zeta(nmode), eta(nmode)
+ real(r8) :: smax
+ real(r8) :: lnsmax ! ln(smax)
+ real(r8) :: x, fnew
+ real(r8) :: g, z, fnmin
+
+ real(r8) :: arg
+ real(r8) :: fnbar, fmbar, wb
+
+ real(r8) :: z1, z2
+ real(r8) :: integ,integf
+ real(r8) :: wf1, wf2, zf1, zf2, gf1, gf2, gf
+
+ character(len=*), parameter :: subname='actdrop_mam_calc'
+ !---------------------------------------------------------------------------------
+
+ fn(:) = 0._r8
+ fm(:) = 0._r8
+ fluxn(:) = 0._r8
+ fluxm(:) = 0._r8
+ flux_fullact = 0._r8
+
+ if (nmode == 1 .and. na(1) < 1.e-20_r8) return
+
+ if (sigw <= 1.e-5_r8 .and. wbar <= 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.
+
+ ! 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.
+ grow = 1._r8/(rhoh2o/(diff0*rhoair*qs) &
+ + latvap*rhoh2o/(conduct0*tair)*(latvap/(rh2o*tair) - 1._r8))
+
+ do m = 1, nmode
+
+ sqrtg(m) = sqrt(grow)
+
+ if (volume(m) > 1.e-39_r8 .and. na(m) > 1.e-39_r8) then
+
+ ! number mode radius (m)
+ ! write(iulog,*)'alogsig,volc,na=',alogsig(m),volc(m),na(m)
+ amcube(m) = (3._r8*volume(m)/(4._r8*pi*exp45logsig(m)*na(m))) ! only if variable size dist
+
+ beta = 2._r8*pi*rhoh2o*grow*gamma
+ etafactor2(m) = 1._r8/(na(m)*beta*sqrtg(m))
+
+ if (hygro(m) > 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,*)'hygro,amcube=',hygro(m),amcube(m)
+ else
+ etafactor2(m) = etafactor2max ! this should make eta big if na is very small.
+ smc(m) = 1._r8
+ endif
+
+ lnsm(m) = log(smc(m))
+
+ ! write(iulog,'(a,i4,4g12.2)')'m,na,amcube,hygro,sm,lnsm=', &
+ ! m,na(m),amcube(m),hygro(m),sm(m),lnsm(m)
+ end do
+
+ if (sigw > 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
+
+ ! *** return ***
+ if (wmax <= w) return
+
+ sumflxn(:) = 0._r8
+ sumfn(:) = 0._r8
+ fnold(:) = 0._r8
+ sumflxm(:) = 0._r8
+ sumfm(:) = 0._r8
+ fmold(:) = 0._r8
+ 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(m)
+ enddo
+
+ call maxsat(zeta, eta, nmode, smc, smax)
+ ! write(iulog,*)'w,smax=',w,smax
+
+ lnsmax = log(smax)
+ x = twothird*(lnsm(nmode) - lnsmax)/(sq2*alogsig(nmode))
+ fnew = 0.5_r8*(1._r8 - erf(x))
+
+ dwnew = dw
+ if (fnew-fold > dfmax .and. n > 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
+ end if
+ end if
+
+ if (fnew-fold < dfmin) then
+ ! increase updraft increment to accelerate integration
+ dwnew = min(1.5_r8*dw, dwmax)
+ end if
+ fold = fnew
+
+ z = (w - wbar)/(sigw*sq2)
+ g = exp(-z*z)
+ fnmin = 1._r8
+
+ do m = 1, nmode
+ ! modal
+ x = twothird*(lnsm(m) - lnsmax)/(sq2*alogsig(m))
+ 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)
+ arg = x - 1.5_r8*sq2*alogsig(m)
+ fm(m) = 0.5_r8*(1._r8 - erf(arg))
+ fmbar = (fm(m)*g + fmold(m)*gold)
+ wb = (w + wold)
+ if (w > 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)
+ end do
+
+ ! 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
+
+ end do ! n = 1, nx
+
+
+ if (w < 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
+ end do
+ ! same form as sumflxm but replace the fm with 1.0
+ sumflx_fullact = sumflx_fullact + integf
+ ! sumg=sumg+integ
+ end if
+
+ do m = 1, nmode
+
+ fn(m) = sumfn(m)/(sq2*sqpi*sigw)
+ ! fn(m)=sumfn(m)/(sumg)
+
+ if (fn(m) > 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(subname)
+ end if
+
+ fluxn(m) = sumflxn(m)/(sq2*sqpi*sigw)
+ fm(m) = sumfm(m)/(sq2*sqpi*sigw)
+ ! fm(m)=sumfm(m)/(sumg)
+ if (fm(m) > 1.01_r8) then
+ write(iulog,*)'fm=',fm(m),' > 1 in activate'
+ end if
+ fluxm(m) = sumflxm(m)/(sq2*sqpi*sigw)
+ end do
+ ! same form as fluxm
+ flux_fullact = sumflx_fullact/(sq2*sqpi*sigw)
+
+ else ! single updraft
+
+ wnuc = wbar + wdiab
+
+ if (wnuc > 0._r8) then
+
+ w = wbar
+
+ if (in_cloud) then
+
+ if (smax_f > 0._r8) then
+ smax = alpha*w/(2.0_r8*pi*rhoh2o*grow*gamma*smax_f)
+ else
+ smax = 1.e-20_r8
+ end if
+
+ else ! at cloud base
+
+ alw = alpha*wnuc
+ sqrtalw = sqrt(alw)
+ etafactor1 = alw*sqrtalw
+
+ do m = 1, nmode
+ eta(m) = etafactor1*etafactor2(m)
+ zeta(m) = twothird*sqrtalw*aten/sqrtg(m)
+ end do
+
+ call maxsat(zeta, eta, nmode, smc, smax)
+
+ end if
+
+ lnsmax = log(smax)
+
+ do m = 1, nmode
+
+ x = twothird*(lnsm(m) - lnsmax)/(sq2*alogsig(m))
+ fn(m) = 0.5_r8*(1._r8 - erf(x))
+ arg = x - 1.5_r8*sq2*alogsig(m)
+ fm(m) = 0.5_r8*(1._r8 - erf(arg))
+
+ if (wbar > 0._r8) then
+ fluxn(m) = fn(m)*w
+ fluxm(m) = fm(m)*w
+ end if
+
+ end do
+
+ flux_fullact = w
+
+ end if ! wnuc>0
+
+ endif ! single updraft
+
+end subroutine actdrop_mam_calc
+
+!===============================================================================
+
+subroutine maxsat(zeta, eta, nmode, smc, smax)
+
+ ! calculates maximum supersaturation for multiple
+ ! competing aerosol modes.
+ !
+ ! Abdul-Razzak and Ghan, A parameterization of aerosol activation.
+ ! 2. Multiple aerosol types. J. Geophys. Res., 105, 6837-6844.
+
+ 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(out) :: smax ! maximum supersaturation
+
+ integer :: m
+ real(r8) :: sum, g1, g2, g1sqrt, g2sqrt
+ !---------------------------------------------------------------------------------
+
+ do m = 1, nmode
+ if (zeta(m) > 1.e5_r8*eta(m) .or. smc(m)*smc(m) > 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
+ end if
+
+ ! No significant activation in any mode. Do nothing.
+ if (m == nmode) return
+
+ end do
+
+ sum = 0.0_r8
+ do m = 1, nmode
+ if (eta(m) > 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(m)*g1 + f2(m)*g2)/(smc(m)*smc(m))
+ else
+ sum = 1.e20_r8
+ end if
+ end do
+
+ smax = 1._r8/sqrt(sum)
+
+end subroutine maxsat
+
+!===============================================================================
+
+end module activate_drop_mam
diff --git a/components/eam/src/physics/cam/bfb_math.inc b/components/eam/src/physics/cam/bfb_math.inc
index 7e429beb355b..c95cb5bc530a 100644
--- a/components/eam/src/physics/cam/bfb_math.inc
+++ b/components/eam/src/physics/cam/bfb_math.inc
@@ -17,7 +17,7 @@
#define bfb_quad(val) (bfb_square(bfb_square(val)))
! This conditional must match CPP logic for SCREAM_BFB_TESTING in scream_types.hpp
-#if !defined(SCREAM_CONFIG_IS_CMAKE) || defined (NDEBUG) || defined (EKAT_ENABLE_CUDA_MEMCHECK)
+#if !defined(SCREAM_CONFIG_IS_CMAKE) || defined (NDEBUG) || defined (SCREAM_SHORT_TESTS)
# define bfb_pow(base, exp) (base)**(exp)
# define bfb_cbrt(base) (base)**(1.0D0/3.0D0)
# define bfb_gamma(val) gamma(val)
diff --git a/components/eam/src/physics/cam/clubb_intr.F90 b/components/eam/src/physics/cam/clubb_intr.F90
index aaea35a4eddb..a3e786629e39 100644
--- a/components/eam/src/physics/cam/clubb_intr.F90
+++ b/components/eam/src/physics/cam/clubb_intr.F90
@@ -37,6 +37,8 @@ module clubb_intr
use shr_kind_mod, only: core_rknd=>shr_kind_r8
#endif
+ use zm_conv, only: zm_microp
+
implicit none
private
@@ -224,6 +226,15 @@ module clubb_intr
integer :: cmfmc_sh_idx = 0
+! ZM convective microphysics(zm_microp)
+ integer :: &
+ dlfzm_idx = -1, & ! index of ZM detrainment of convective cloud water mixing ratio.
+ difzm_idx = -1, & ! index of ZM detrainment of convective cloud ice mixing ratio.
+ dsfzm_idx = -1, & ! index of ZM detrainment of convective snow mixing ratio.
+ dnlfzm_idx = -1, & ! index of ZM detrainment of convective cloud water num concen.
+ dnifzm_idx = -1, & ! index of ZM detrainment of convective cloud ice num concen.
+ dnsfzm_idx = -1 ! index of ZM detrainment of convective snow num concen.
+
real(r8) :: dp1 !set in namelist; assigned in cloud_fraction.F90
! Output arrays for CLUBB statistics
real(r8), allocatable, dimension(:,:,:) :: out_zt, out_zm, out_radzt, out_radzm, out_sfc
@@ -764,6 +775,15 @@ subroutine clubb_ini_cam(pbuf2d, dp1_in)
iiedsclr_thl = -1
iiedsclr_CO2 = -1
+ if (zm_microp) then
+ dlfzm_idx = pbuf_get_index('DLFZM')
+ difzm_idx = pbuf_get_index('DIFZM')
+ dsfzm_idx = pbuf_get_index('DSFZM')
+ dnlfzm_idx = pbuf_get_index('DNLFZM')
+ dnifzm_idx = pbuf_get_index('DNIFZM')
+ dnsfzm_idx = pbuf_get_index('DNSFZM')
+ end if
+
! ----------------------------------------------------------------- !
! Define number of tracers for CLUBB to diffuse
! ----------------------------------------------------------------- !
@@ -1453,6 +1473,15 @@ subroutine clubb_tend_cam( &
real(r8), pointer, dimension(:,:) :: prer_evap
real(r8), pointer, dimension(:,:) :: qrl
real(r8), pointer, dimension(:,:) :: radf_clubb
+
+ ! ZM convective microphysics(zm_microp)
+ real(r8), pointer :: dlfzm(:,:) ! ZM detrainment of convective cloud water mixing ratio.
+ real(r8), pointer :: difzm(:,:) ! ZM detrainment of convective cloud ice mixing ratio.
+ real(r8), pointer :: dsfzm(:,:) ! ZM detrainment of convective snow mixing ratio.
+ real(r8), pointer :: dnlfzm(:,:) ! ZM detrainment of convective cloud water num concen.
+ real(r8), pointer :: dnifzm(:,:) ! ZM detrainment of convective cloud ice num concen.
+ real(r8), pointer :: dnsfzm(:,:) ! ZM detrainment of convective snow num concen.
+
!PMA
real(r8) relvarc(pcols,pver)
real(r8) stend(pcols,pver)
@@ -2628,6 +2657,15 @@ subroutine clubb_tend_cam( &
call physics_ptend_init(ptend_loc,state%psetcols, 'clubb_det', ls=.true., lq=lqice)
+ if (zm_microp) then
+ call pbuf_get_field(pbuf, dlfzm_idx, dlfzm)
+ call pbuf_get_field(pbuf, difzm_idx, difzm)
+ call pbuf_get_field(pbuf, dsfzm_idx, dsfzm)
+ call pbuf_get_field(pbuf, dnlfzm_idx, dnlfzm)
+ call pbuf_get_field(pbuf, dnifzm_idx, dnifzm)
+ call pbuf_get_field(pbuf, dnsfzm_idx, dnsfzm)
+ end if
+
call t_startf('ice_cloud_detrain_diag')
do k=1,pver
do i=1,ncol
@@ -2641,17 +2679,29 @@ subroutine clubb_tend_cam( &
dum1 = ( clubb_tk1 - state1%t(i,k) ) /(clubb_tk1 - clubb_tk2)
endif
- 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* clubb_liq_deep**3*997._r8) + & ! Deep Convection
- 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) &
- / (4._r8*3.14_r8*clubb_liq_sh**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*clubb_ice_deep**3*500._r8) + & ! Deep Convection
- 3._r8 * ( dlf2(i,k) * dum1 ) &
- / (4._r8*3.14_r8*clubb_ice_sh**3*500._r8) ! Shallow Convection
- ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice
+ if (zm_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) + dsfzm(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*pi*clubb_liq_sh**3._r8*997._r8) ! Shallow Convection
+ ptend_loc%q(i,k,ixnumice) = dnifzm(i,k) + dnsfzm(i,k) + 3._r8 * ( dlf2(i,k) * dum1 ) &
+ / (4._r8*pi*clubb_ice_sh**3._r8*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* clubb_liq_deep**3._r8*997._r8) + & ! Deep Convection
+ 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) &
+ / (4._r8*3.14_r8*clubb_liq_sh**3._r8*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*clubb_ice_deep**3._r8*500._r8) + & ! Deep Convection
+ 3._r8 * ( dlf2(i,k) * dum1 ) &
+ / (4._r8*3.14_r8*clubb_ice_sh**3._r8*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
diff --git a/components/eam/src/physics/cam/conv_water.F90 b/components/eam/src/physics/cam/conv_water.F90
index 3ea18fa7ddbf..75ebb529280b 100644
--- a/components/eam/src/physics/cam/conv_water.F90
+++ b/components/eam/src/physics/cam/conv_water.F90
@@ -23,6 +23,7 @@ module conv_water
use perf_mod
use cam_logfile, only: iulog
+ use zm_conv, only: zm_microp
implicit none
private
@@ -33,7 +34,7 @@ module conv_water
! pbuf indices
integer :: icwmrsh_idx, icwmrdp_idx, fice_idx, sh_frac_idx, dp_frac_idx, &
- ast_idx, sh_cldliq1_idx, sh_cldice1_idx, rei_idx
+ ast_idx, sh_cldliq1_idx, sh_cldice1_idx, rei_idx,icimrdp_idx
integer :: ixcldice, ixcldliq
@@ -79,17 +80,22 @@ subroutine conv_water_init()
use physics_buffer, only : pbuf_get_index
- use cam_history, only : addfld
+ use cam_history, only : addfld
+ use phys_control, only : phys_getopts
use constituents, only: cnst_get_ind
implicit none
+ logical :: use_MMF
+ call phys_getopts(use_MMF_out = use_MMF)
call cnst_get_ind('CLDICE', ixcldice)
call cnst_get_ind('CLDLIQ', ixcldliq)
icwmrsh_idx = pbuf_get_index('ICWMRSH')
icwmrdp_idx = pbuf_get_index('ICWMRDP')
+ icimrdp_idx = -1
+ if (.not. use_MMF) icimrdp_idx = pbuf_get_index('ICIMRDP')
fice_idx = pbuf_get_index('FICE')
sh_frac_idx = pbuf_get_index('SH_FRAC')
dp_frac_idx = pbuf_get_index('DP_FRAC')
@@ -156,6 +162,7 @@ subroutine conv_water_4rad( state, pbuf, conv_water_mode, totg_liq, totg_ice )
real(r8), pointer, dimension(:,:) :: rei ! Ice effective drop size (microns)
real(r8), pointer, dimension(:,:) :: dp_icwmr ! Deep conv. cloud water
+ real(r8), pointer, dimension(:,:) :: dp_icimr ! Deep conv. cloud ice
real(r8), pointer, dimension(:,:) :: sh_icwmr ! Shallow conv. cloud water
real(r8), pointer, dimension(:,:) :: fice ! Ice partitioning ratio
real(r8), pointer, dimension(:,:) :: sh_cldliq ! shallow convection gbx liq cld mixing ratio for COSP
@@ -177,6 +184,10 @@ subroutine conv_water_4rad( state, pbuf, conv_water_mode, totg_liq, totg_ice )
real(r8) :: kabs, kabsi, kabsl, alpha, dp0, sh0, ic_limit, frac_limit
real(r8) :: wrk1
+ real(r8) :: sh_iclmr ! Shallow convection in-cloud liquid water
+ real(r8) :: sh_icimr ! Shallow convection in-cloud ice water
+ real(r8) :: dp_iclmr ! Deep convection in-cloud liquid water
+
integer :: lchnk
integer :: ncol
@@ -197,8 +208,10 @@ subroutine conv_water_4rad( state, pbuf, conv_water_mode, totg_liq, totg_ice )
call pbuf_get_field(pbuf, icwmrsh_idx, sh_icwmr )
call pbuf_get_field(pbuf, icwmrdp_idx, dp_icwmr )
+ if (icimrdp_idx .gt. 0) call pbuf_get_field(pbuf, icimrdp_idx, dp_icimr )
call pbuf_get_field(pbuf, fice_idx, fice )
+
! Get convective in-cloud fraction
call pbuf_get_field(pbuf, sh_frac_idx, sh_frac )
@@ -237,14 +250,24 @@ subroutine conv_water_4rad( state, pbuf, conv_water_mode, totg_liq, totg_ice )
cu0_frac = 0._r8
cu_icwmr = 0._r8
-
+ conv_ice(i,k) = 0._r8
+ conv_liq(i,k) = 0._r8
+
ls_frac = ast(i,k)
if( ls_frac < frac_limit ) then
ls_frac = 0._r8
ls_icwmr = 0._r8
+ tot_ice(i,k) = 0._r8
+ tot_liq(i,k) = 0._r8
+ totg_ice(i,k) = 0._r8
+ totg_liq(i,k) = 0._r8
else
ls_icwmr = ( state%q(i,k,ixcldliq) + state%q(i,k,ixcldice) )/max(frac_limit,ls_frac) ! Convert to IC value.
- end if
+ tot_ice(i,k) = state%q(i,k,ixcldice)/max(frac_limit,ls_frac)
+ tot_liq(i,k) = state%q(i,k,ixcldliq)/max(frac_limit,ls_frac)
+ totg_ice(i,k) = state%q(i,k,ixcldice)
+ totg_liq(i,k) = state%q(i,k,ixcldliq)
+ endif
tot0_frac = ls_frac
tot_icwmr = ls_icwmr
@@ -260,7 +283,20 @@ subroutine conv_water_4rad( state, pbuf, conv_water_mode, totg_liq, totg_ice )
endif
kabs = kabsl * ( 1._r8 - wrk1 ) + kabsi * wrk1
alpha = -1.66_r8*kabs*state%pdel(i,k)/gravit*1000.0_r8
-
+ if (zm_microp) then
+ sh_iclmr = sh_icwmr(i,k)*(1-wrk1)
+ sh_icimr = sh_icwmr(i,k)*wrk1
+ dp_iclmr = dp_icwmr(i,k)- dp_icimr(i,k)
+
+ conv_ice(i,k) = ( sh0_frac * sh_icimr + dp0_frac*dp_icimr(i,k))/max(frac_limit,cu0_frac)
+ conv_liq(i,k) = ( sh0_frac * sh_iclmr + dp0_frac*dp_iclmr)/max(frac_limit,cu0_frac)
+ ls_frac = ast(i,k)
+ tot0_frac = (ls_frac + cu0_frac)
+ tot_ice(i,k) = (state%q(i,k,ixcldice) + cu0_frac*conv_ice(i,k))/max(frac_limit,tot0_frac)
+ tot_liq(i,k) = (state%q(i,k,ixcldliq) + cu0_frac*conv_liq(i,k))/max(frac_limit,tot0_frac)
+ totg_ice(i,k) = tot0_frac * tot_ice(i,k)
+ totg_liq(i,k) = tot0_frac * tot_liq(i,k)
+ else
! Selecting cumulus in-cloud water.
select case (conv_water_mode) ! Type of average
@@ -291,9 +327,10 @@ subroutine conv_water_4rad( state, pbuf, conv_water_mode, totg_liq, totg_ice )
case default ! Area weighted 'arithmetic in emissivity' average.
! call endrun ('CONV_WATER_4_RAD: Unknown option for conv_water_in_rad - exiting')
end select
-
+ end if !zm_microp
end if
-
+
+ if (.not.zm_microp) then
!BSINGH - Logic by Phil R. to account for insignificant condensate in large scale clouds
if (ls_icwmr < 100._r8*ic_limit .and. pergro_mods) then ! if there is virtually no stratiform condensate
if (state%t(i,k) < 243._r8) then ! if very cold assume convective condensate is ice
@@ -318,7 +355,8 @@ subroutine conv_water_4rad( state, pbuf, conv_water_mode, totg_liq, totg_ice )
totg_ice(i,k) = tot0_frac * tot_icwmr * wrk1
totg_liq(i,k) = tot0_frac * tot_icwmr * (1._r8-wrk1)
-
+
+ endif
end do
end do
diff --git a/components/eam/src/physics/cam/convect_deep.F90 b/components/eam/src/physics/cam/convect_deep.F90
index 2698b3a9ec26..9f0a2d596694 100644
--- a/components/eam/src/physics/cam/convect_deep.F90
+++ b/components/eam/src/physics/cam/convect_deep.F90
@@ -56,6 +56,9 @@ module convect_deep
integer :: ttend_dp_idx = 0
+ integer :: lambdadpcu_idx = 0
+ integer :: mudpcu_idx = 0
+ integer :: icimrdp_idx = 0
!=========================================================================================
contains
@@ -124,6 +127,10 @@ subroutine convect_deep_register
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)
+ call pbuf_add_field('LAMBDADPCU', 'physpkg', dtype_r8,(/pcols,pver/), lambdadpcu_idx)
+ call pbuf_add_field('MUDPCU', 'physpkg', dtype_r8,(/pcols,pver/), mudpcu_idx)
+ call pbuf_add_field('ICIMRDP', 'physpkg', dtype_r8,(/pcols,pver/), icimrdp_idx)
+
! If WACCM gravity waves are on, output this field.
if (use_gw_convect) then
call pbuf_add_field('TTEND_DP','physpkg',dtype_r8,(/pcols,pver/),ttend_dp_idx)
@@ -156,6 +163,7 @@ subroutine convect_deep_init(pref_edge,pbuf2d)
dp_frac_idx = pbuf_get_index('DP_FRAC')
icwmrdp_idx = pbuf_get_index('ICWMRDP')
+ icimrdp_idx = pbuf_get_index('ICIMRDP')
select case ( deep_scheme )
case('off') ! ==> no deep convection
@@ -166,6 +174,7 @@ subroutine convect_deep_init(pref_edge,pbuf2d)
call pbuf_set_field(pbuf2d, dp_flxsnw_idx, 0._r8)
call pbuf_set_field(pbuf2d, dp_frac_idx, 0._r8)
call pbuf_set_field(pbuf2d, icwmrdp_idx, 0._r8)
+ call pbuf_set_field(pbuf2d, icimrdp_idx, 0._r8)
call pbuf_set_field(pbuf2d, rprddp_idx, 0._r8)
call pbuf_set_field(pbuf2d, nevapr_dpcu_idx, 0._r8)
case('CLUBB_SGS')
@@ -194,7 +203,7 @@ end subroutine convect_deep_init
subroutine convect_deep_tend( &
mcon ,cme , &
dlf ,pflx ,zdu , &
- rliq , &
+ rliq ,rice , &
ztodt , &
state ,ptend ,landfrac ,pbuf, mu, eu, &
du, md, ed, dp, dsubcld, jt, maxg, ideep,lengath )
@@ -227,6 +236,8 @@ subroutine convect_deep_tend( &
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
+
real(r8), intent(out):: mu(pcols,pver)
real(r8), intent(out):: eu(pcols,pver)
real(r8), intent(out):: du(pcols,pver)
@@ -259,6 +270,11 @@ subroutine convect_deep_tend( &
real(r8), pointer, dimension(:,:) :: rprd ! rain production rate
real(r8), pointer, dimension(:,:,:) :: fracis ! fraction of transported species that are insoluble
+ real(r8), pointer, dimension(:,:) :: mudpcu ! Droplet size distribution shape parameter for radiation
+ real(r8), pointer, dimension(:,:) :: lambdadpcu ! Droplet size distribution shape parameter for radiation
+ real(r8), pointer, dimension(:,:) :: qi ! wg grid slice of cloud ice.
+
+
real(r8), pointer, dimension(:,:) :: evapcdp ! Evaporation of deep convective precipitation
real(r8), pointer :: pblh(:) ! Planetary boundary layer height
@@ -269,6 +285,7 @@ subroutine convect_deep_tend( &
real(r8) zero(pcols, pver)
+
integer i, k
call pbuf_get_field(pbuf, cldtop_idx, jctop )
@@ -284,6 +301,7 @@ subroutine convect_deep_tend( &
cme = 0
zdu = 0
rliq = 0
+ rice = 0
call physics_ptend_init(ptend, state%psetcols, 'convect_deep')
@@ -297,6 +315,9 @@ subroutine convect_deep_tend( &
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, mudpcu_idx, mudpcu)
+ call pbuf_get_field(pbuf, lambdadpcu_idx, lambdadpcu)
+ call pbuf_get_field(pbuf, icimrdp_idx, qi )
!cld = 0 !!HuiWan 2014-05. Bugfix. cld is an input variable to zm_conv_tend.
ql = 0
@@ -305,6 +326,10 @@ subroutine convect_deep_tend( &
evapcdp = 0
prec=0
snow=0
+ mudpcu = 0.0_r8
+ lambdadpcu = 0.0_r8
+ qi = 0._r8
+
jctop = pver
jcbot = 1._r8
@@ -316,7 +341,7 @@ subroutine convect_deep_tend( &
call t_startf('zm_conv_tend')
call zm_conv_tend( pblh ,mcon ,cme , &
tpert ,dlf ,pflx ,zdu , &
- rliq , &
+ rliq ,rice , &
ztodt , &
jctop, jcbot , &
state ,ptend ,landfrac, pbuf, mu, eu, &
diff --git a/components/eam/src/physics/cam/convect_shallow.F90 b/components/eam/src/physics/cam/convect_shallow.F90
index 04c9eee8414d..578dbd8668fd 100644
--- a/components/eam/src/physics/cam/convect_shallow.F90
+++ b/components/eam/src/physics/cam/convect_shallow.F90
@@ -471,6 +471,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , cmfmc2 , &
real(r8) :: ntprprd(pcols,pver) ! Net precip production in layer
real(r8) :: ntsnprd(pcols,pver) ! Net snow production in layer
+ real(r8) :: sprd(pcols,pver) ! evap infld only for deep conv
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) :: slflx(pcols,pverp) ! Shallow convective liquid water static energy flux
@@ -904,6 +905,8 @@ subroutine convect_shallow_tend( ztodt , cmfmc , cmfmc2 , &
call pbuf_get_field(pbuf, sh_cldliq_idx, sh_cldliq )
call pbuf_get_field(pbuf, sh_cldice_idx, sh_cldice )
+ sprd = 0._r8
+
!! clouds have no water... :)
sh_cldliq(:ncol,:) = 0._r8
sh_cldice(:ncol,:) = 0._r8
@@ -913,7 +916,7 @@ subroutine convect_shallow_tend( ztodt , cmfmc , cmfmc2 , &
ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, &
ptend_loc%q(:pcols,:pver,1), &
rprdsh, cld, ztodt, &
- precc, snow, ntprprd, ntsnprd , flxprec, flxsnow )
+ precc, snow, ntprprd, ntsnprd , flxprec, flxsnow, sprd, .true.)
! ------------------------------------------ !
! record history variables from zm_conv_evap !
diff --git a/components/eam/src/physics/cam/macrop_driver.F90 b/components/eam/src/physics/cam/macrop_driver.F90
index 12a8fbc5c3e9..d0bbd79e335f 100644
--- a/components/eam/src/physics/cam/macrop_driver.F90
+++ b/components/eam/src/physics/cam/macrop_driver.F90
@@ -23,6 +23,7 @@ module macrop_driver
use perf_mod, only: t_startf, t_stopf
use cam_logfile, only: iulog
use cam_abortutils, only: endrun
+ use zm_conv, only: zm_microp
implicit none
private
@@ -85,7 +86,13 @@ module macrop_driver
fice_idx, &
cmeliq_idx, &
shfrc_idx, &
- naai_idx
+ naai_idx, &
+ dlfzm_idx, & ! index of ZM detrainment of convective cloud water mixing ratio.
+ difzm_idx, & ! index of ZM detrainment of convective cloud ice mixing ratio.
+ dsfzm_idx, & ! index of ZM detrainment of convective snow mixing ratio.
+ dnlfzm_idx, & ! index of ZM detrainment of convective cloud water num concen.
+ dnifzm_idx, & ! index of ZM detrainment of convective cloud ice num concen.
+ dnsfzm_idx ! index of ZM detrainment of convective snow num concen.
logical :: liqcf_fix
@@ -204,6 +211,7 @@ subroutine macrop_driver_init(pbuf2d)
! liquid budgets.
integer :: history_budget_histfile_num ! output history file number for budget fields
integer :: istat
+ integer :: err
character(len=*), parameter :: subname = 'macrop_driver_init'
!-----------------------------------------------------------------------
@@ -321,6 +329,13 @@ subroutine macrop_driver_init(pbuf2d)
CC_ni_idx = pbuf_get_index('CC_ni')
CC_qlst_idx = pbuf_get_index('CC_qlst')
+ dlfzm_idx = pbuf_get_index('DLFZM')
+ difzm_idx = pbuf_get_index('DIFZM')
+ dsfzm_idx = pbuf_get_index('DSFZM', err)
+ dnlfzm_idx = pbuf_get_index('DNLFZM', err)
+ dnifzm_idx = pbuf_get_index('DNIFZM', err)
+ dnsfzm_idx = pbuf_get_index('DNSFZM', err)
+
if (micro_do_icesupersat) then
naai_idx = pbuf_get_index('NAAI')
endif
@@ -457,6 +472,14 @@ subroutine macrop_driver_tend( &
real(r8), pointer, dimension(:,:) :: fice_ql ! Cloud ice/water partitioning ratio.
real(r8), pointer, dimension(:,:) :: naai ! Number concentration of activated ice nuclei
+
+ ! ZM microphysics
+ real(r8), pointer :: dlfzm(:,:) ! ZM detrainment of convective cloud water mixing ratio.
+ real(r8), pointer :: difzm(:,:) ! ZM detrainment of convective cloud ice mixing ratio.
+ real(r8), pointer :: dsfzm(:,:) ! ZM detrainment of convective snow mixing ratio.
+ real(r8), pointer :: dnlfzm(:,:) ! ZM detrainment of convective cloud water num concen.
+ real(r8), pointer :: dnifzm(:,:) ! ZM detrainment of convective cloud ice num concen.
+ real(r8), pointer :: dnsfzm(:,:) ! ZM detrainment of convective snow num concen.
real(r8) :: latsub
@@ -654,6 +677,15 @@ subroutine macrop_driver_tend( &
! This is the key procesure generating upper-level cirrus clouds.
! The unit of dlf : [ kg/kg/s ]
+ if (zm_microp) then
+ call pbuf_get_field(pbuf, dlfzm_idx, dlfzm)
+ call pbuf_get_field(pbuf, difzm_idx, difzm)
+ call pbuf_get_field(pbuf, dsfzm_idx, dsfzm)
+ call pbuf_get_field(pbuf, dnlfzm_idx, dnlfzm)
+ call pbuf_get_field(pbuf, dnifzm_idx, dnifzm)
+ call pbuf_get_field(pbuf, dnsfzm_idx, dnsfzm)
+ end if
+
det_s(:) = 0._r8
det_ice(:) = 0._r8
@@ -680,20 +712,36 @@ subroutine macrop_driver_tend( &
! 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 (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
+ if (zm_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) + dsfzm(i,k) + dlf2(i,k) * dum1
+ ! The mass of a cloud droplet(ice particle) is calculated using mass=volume * density = [(4/3) * pi * r^3 ]* density.
+ ! The density of droplet and ice particle in shallow convection is assumed to be 997. kg/m3, and 500. kg/m3, respectively.
+ ! The radius of droplet and ice particle in shallow convection is assumed to be 10 microns (10.e-6 m), and
+ ! 50. microns( 50.e-6 m), respectively.
+ 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._r8*997._r8) ! Shallow Convection
+ ptend_loc%q(i,k,ixnumice) = dnifzm(i,k) + dnsfzm(i,k) + 3._r8 * ( dlf2(i,k) * dum1 ) &
+ / (4._r8*3.14_r8*50.e-6_r8**3._r8*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
+ ! 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._r8*997._r8) + & ! Deep Convection
+ 3._r8 * ( dlf2(i,k) * ( 1._r8 - dum1 ) ) / &
+ (4._r8*3.14_r8*10.e-6_r8**3._r8*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._r8*500._r8) + & ! Deep Convection
+ 3._r8 * ( dlf2(i,k) * dum1 ) / &
+ (4._r8*3.14_r8*50.e-6_r8**3._r8*500._r8) ! Shallow Convection
+ ptend_loc%s(i,k) = dlf(i,k) * dum1 * latice
+ end if ! zm_microp
else
ptend_loc%q(i,k,ixcldliq) = 0._r8
ptend_loc%q(i,k,ixcldice) = 0._r8
@@ -701,7 +749,7 @@ subroutine macrop_driver_tend( &
ptend_loc%q(i,k,ixnumice) = 0._r8
ptend_loc%s(i,k) = 0._r8
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
@@ -730,11 +778,17 @@ subroutine macrop_driver_tend( &
dpdlft (i,k) = 0._r8
shdlft (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 )
+ if (zm_microp) then
+ dpdlfliq(i,k) = dlfzm(i,k)
+ dpdlfice(i,k) = difzm(i,k) + dsfzm(i,k)
+ dpdlft (i,k) = 0._r8
+ else
+ dpdlft (i,k) = ( dlf(i,k) - dlf2(i,k) ) * dum1 * latice/cpair
+ dpdlfliq(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( 1._r8 - dum1 )
+ dpdlfice(i,k) = ( dlf(i,k) - dlf2(i,k) ) * ( dum1 )
+ end if
shdlfliq(i,k) = dlf2(i,k) * ( 1._r8 - dum1 )
shdlfice(i,k) = dlf2(i,k) * ( dum1 )
- dpdlft (i,k) = ( dlf(i,k) - dlf2(i,k) ) * dum1 * latice/cpair
shdlft (i,k) = dlf2(i,k) * dum1 * latice/cpair
endif
end do
@@ -1163,7 +1217,7 @@ elemental subroutine ice_macro_tend(naai,t,p,qv,qi,ni,xxls,deltat,stend,qvtend,q
! if ice exists (more than 1 L-1) and there is condensation, do not add to number (= growth), else, add 10um ice
if (ni.lt.1.e3_r8.and.(qi+qitend*deltat).gt.1e-18_r8) then
- nitend = nitend + 3._r8 * qitend/(4._r8*3.14_r8* 10.e-6_r8**3*997._r8)
+ nitend = nitend + 3._r8 * qitend/(4._r8*3.14_r8* 10.e-6_r8**3._r8*997._r8)
endif
endif
diff --git a/components/eam/src/physics/cam/ndrop.F90 b/components/eam/src/physics/cam/ndrop.F90
index 463d4ea2054f..b4dc999309bf 100644
--- a/components/eam/src/physics/cam/ndrop.F90
+++ b/components/eam/src/physics/cam/ndrop.F90
@@ -15,6 +15,8 @@ module ndrop
use ppgrid, only: pcols, pver, pverp
use physconst, only: pi, rhoh2o, mwh2o, r_universal, rh2o, &
gravit, latvap, cpair, rair
+use physconst, only: epsilo
+use activate_drop_mam, only: actdrop_mam_init, actdrop_mam_calc
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_get_field
@@ -258,6 +260,13 @@ subroutine ndrop_init
end do
end do
+ ! convective microphysics
+ call actdrop_mam_init( &
+ iulog, pi, rair, r_universal, rh2o, &
+ rhoh2o, mwh2o, epsilo, latvap, cpair, &
+ gravit, ntot_amode, sigmag_amode)
+
+
call addfld('CCN1',(/ 'lev' /), 'A','1/cm3','CCN concentration at S=0.02%')
call addfld('CCN2',(/ 'lev' /), 'A','1/cm3','CCN concentration at S=0.05%')
call addfld('CCN3',(/ 'lev' /), 'A','1/cm3','CCN concentration at S=0.1%')
diff --git a/components/eam/src/physics/cam/ndrop_bam.F90 b/components/eam/src/physics/cam/ndrop_bam.F90
index edceb79773a7..a8c44e22ef5e 100644
--- a/components/eam/src/physics/cam/ndrop_bam.F90
+++ b/components/eam/src/physics/cam/ndrop_bam.F90
@@ -67,6 +67,11 @@ module ndrop_bam
integer :: naer_all ! number of aerosols affecting climate
integer :: idxsul = -1 ! index in aerosol list for sulfate
+! Both microp_aero_init and zm_conv_init can call ndrop_bam_init. Use this
+! logical so that it only gets called once.
+logical :: ndrop_bam_init_done = .false.
+
+
!===============================================================================
contains
!===============================================================================
@@ -84,6 +89,8 @@ subroutine ndrop_bam_init
real(r8) :: arg
!-------------------------------------------------------------------------------
+ if (ndrop_bam_init_done) return
+
! Access the physical properties of the bulk aerosols that are affecting the climate
! by using routines from the rad_constituents module.
@@ -199,6 +206,8 @@ subroutine ndrop_bam_init
end do
+ ndrop_bam_init_done = .true.
+
end subroutine ndrop_bam_init
!===============================================================================
diff --git a/components/eam/src/physics/cam/nucleate_ice_conv.F90 b/components/eam/src/physics/cam/nucleate_ice_conv.F90
new file mode 100755
index 000000000000..405141ea1571
--- /dev/null
+++ b/components/eam/src/physics/cam/nucleate_ice_conv.F90
@@ -0,0 +1,281 @@
+module nucleate_ice_conv
+
+!---------------------------------------------------------------------------------
+! Purpose:
+! Ice nucleation code.
+!
+!---------------------------------------------------------------------------------
+
+use shr_kind_mod, only: r8=>shr_kind_r8
+use wv_saturation, only: svp_water, svp_ice
+use cam_logfile, only: iulog
+
+implicit none
+private
+save
+
+public :: nucleati_conv
+
+!===============================================================================
+contains
+!===============================================================================
+
+subroutine nucleati_conv( &
+ wbar, tair, relhum, cldn, qc, &
+ nfice, rhoair, so4_num, dst_num, soot_num, zm_microp, &
+ nuci, onihf, oniimm, onidep, onimey)
+
+ !---------------------------------------------------------------
+ ! Purpose:
+ ! The parameterization of ice nucleation.
+ !
+ ! Method: The current method is based on Liu & Penner (2005)
+ ! It related the ice nucleation with the aerosol number, temperature and the
+ ! updraft velocity. It includes homogeneous freezing of sulfate, immersion
+ ! freezing of soot, and Meyers et al. (1992) deposition nucleation
+ !
+ ! Authors: Xiaohong Liu, 01/2005, modifications by A. Gettelman 2009-2010
+ !----------------------------------------------------------------
+
+ ! Input Arguments
+ real(r8), intent(in) :: wbar ! grid cell mean vertical velocity (m/s)
+ real(r8), intent(in) :: tair ! temperature (K)
+ real(r8), intent(in) :: relhum ! relative humidity with respective to liquid
+ real(r8), intent(in) :: cldn ! new value of cloud fraction (fraction)
+ real(r8), intent(in) :: qc ! liquid water mixing ratio (kg/kg)
+ real(r8), intent(in) :: nfice ! ice mass fraction
+ real(r8), intent(in) :: rhoair ! air density (kg/m3)
+ real(r8), intent(in) :: so4_num ! so4 aerosol number (#/cm^3)
+ real(r8), intent(in) :: dst_num ! total dust aerosol number (#/cm^3)
+ real(r8), intent(in) :: soot_num ! soot (hydrophilic) aerosol number (#/cm^3)
+ logical, intent(in) :: zm_microp ! true for in ZM convection scheme
+
+ ! Output Arguments
+ real(r8), intent(out) :: nuci ! ice number nucleated (#/kg)
+ real(r8), intent(out) :: onihf ! nucleated number from homogeneous freezing of so4
+ real(r8), intent(out) :: oniimm ! nucleated number from immersion freezing
+ real(r8), intent(out) :: onidep ! nucleated number from deposition nucleation
+ real(r8), intent(out) :: onimey ! nucleated number from deposition nucleation (meyers: mixed phase)
+
+ ! Local workspace
+ real(r8) :: nihf ! nucleated number from homogeneous freezing of so4
+ real(r8) :: niimm ! nucleated number from immersion freezing
+ real(r8) :: nidep ! nucleated number from deposition nucleation
+ real(r8) :: nimey ! nucleated number from deposition nucleation (meyers)
+ real(r8) :: n1, ni ! nucleated number
+ real(r8) :: tc, A, B, C, regm, RHw ! work variable
+ real(r8) :: esl, esi, deles ! work variable
+ real(r8) :: subgrid
+ !-------------------------------------------------------------------------------
+
+ ni = 0._r8
+ tc = tair - 273.15_r8
+
+ ! initialize
+ niimm = 0._r8
+ nidep = 0._r8
+ nihf = 0._r8
+
+ if(so4_num.ge.1.0e-10_r8 .and. (soot_num+dst_num).ge.1.0e-10_r8 .and. cldn.gt.0._r8) then
+
+ !-----------------------------
+ ! RHw parameterization for heterogeneous immersion nucleation
+ A = 0.0073_r8
+ B = 1.477_r8
+ C = 131.74_r8
+ RHw=(A*tc*tc+B*tc+C)*0.01_r8 ! RHi ~ 120-130%
+
+ if (zm_microp) then
+ subgrid = 1.0_r8
+ else
+ subgrid = 1.2_r8
+ end if
+
+ if((tc.le.-35.0_r8) .and. ((relhum*svp_water(tair)/svp_ice(tair)*subgrid).ge.1.2_r8)) then ! use higher RHi threshold
+
+ A = -1.4938_r8 * log(soot_num+dst_num) + 12.884_r8
+ B = -10.41_r8 * log(soot_num+dst_num) - 67.69_r8
+ regm = A * log(wbar) + B
+
+ if(tc.gt.regm) then ! heterogeneous nucleation only
+ if(tc.lt.-40._r8 .and. wbar.gt.1._r8) then ! exclude T<-40 & W>1m/s from hetero. nucleation
+ call hf(tc,wbar,relhum,subgrid,so4_num,nihf)
+ niimm=0._r8
+ nidep=0._r8
+ n1=nihf
+ else
+ call hetero(tc,wbar,soot_num+dst_num,niimm,nidep)
+ nihf=0._r8
+ n1=niimm+nidep
+ endif
+ elseif (tc.lt.regm-5._r8) then ! homogeneous nucleation only
+ call hf(tc,wbar,relhum,subgrid,so4_num,nihf)
+ niimm=0._r8
+ nidep=0._r8
+ n1=nihf
+ else ! transition between homogeneous and heterogeneous: interpolate in-between
+ if(tc.lt.-40._r8 .and. wbar.gt.1._r8) then ! exclude T<-40 & W>1m/s from hetero. nucleation
+ call hf(tc,wbar,relhum,subgrid,so4_num,nihf)
+ niimm=0._r8
+ nidep=0._r8
+ n1=nihf
+ else
+
+ call hf(regm-5._r8,wbar,relhum,subgrid,so4_num,nihf)
+ call hetero(regm,wbar,soot_num+dst_num,niimm,nidep)
+
+ if(nihf.le.(niimm+nidep)) then
+ n1=nihf
+ else
+ n1=(niimm+nidep)*((niimm+nidep)/nihf)**((tc-regm)/5._r8)
+ endif
+ endif
+ endif
+
+ ni=n1
+
+ endif
+ endif
+
+ ! deposition/condensation nucleation in mixed clouds (-40-64 deg)
+ A22_fast =-6.045_r8 !(T<=-64 deg)
+ B1_fast =-0.008_r8
+ B21_fast =-0.042_r8 !(T>-64 deg)
+ B22_fast =-0.112_r8 !(T<=-64 deg)
+ C1_fast =0.0739_r8
+ C2_fast =1.2372_r8
+
+ A1_slow =-0.3949_r8
+ A2_slow =1.282_r8
+ B1_slow =-0.0156_r8
+ B2_slow =0.0111_r8
+ B3_slow =0.0217_r8
+ C1_slow =0.120_r8
+ C2_slow =2.312_r8
+
+ Ni = 0.0_r8
+
+!----------------------------
+!RHw parameters
+ A = 6.0e-4_r8*log(ww)+6.6e-3_r8
+ B = 6.0e-2_r8*log(ww)+1.052_r8
+ C = 1.68_r8 *log(ww)+129.35_r8
+ RHw=(A*T*T+B*T+C)*0.01_r8
+
+ if((T.le.-37.0_r8) .and. ((RH*subgrid).ge.RHw)) then
+
+ regm = 6.07_r8*log(ww)-55.0_r8
+
+ if(T.ge.regm) then ! fast-growth regime
+
+ if(T.gt.-64.0_r8) then
+ A2_fast=A21_fast
+ B2_fast=B21_fast
+ else
+ A2_fast=A22_fast
+ B2_fast=B22_fast
+ endif
+
+ k1_fast = exp(A2_fast + B2_fast*T + C2_fast*log(ww))
+ k2_fast = A1_fast+B1_fast*T+C1_fast*log(ww)
+
+ Ni = k1_fast*Na**(k2_fast)
+ Ni = min(Ni,Na)
+
+ else ! slow-growth regime
+
+ k1_slow = exp(A2_slow + (B2_slow+B3_slow*log(ww))*T + C2_slow*log(ww))
+ k2_slow = A1_slow+B1_slow*T+C1_slow*log(ww)
+
+ Ni = k1_slow*Na**(k2_slow)
+ Ni = min(Ni,Na)
+
+ endif
+
+ end if
+
+end subroutine hf
+
+!===============================================================================
+
+end module nucleate_ice_conv
+
diff --git a/components/eam/src/physics/cam/physpkg.F90 b/components/eam/src/physics/cam/physpkg.F90
index f9c3c8e662c2..85133dad5f30 100644
--- a/components/eam/src/physics/cam/physpkg.F90
+++ b/components/eam/src/physics/cam/physpkg.F90
@@ -2173,6 +2173,7 @@ subroutine tphysbc (ztodt, &
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) :: totice_dp(pcols) ! total frozen precip from ZM convection
! stratiform precipitation variables
real(r8),pointer :: prec_str(:) ! sfc flux of precip from stratiform (m/s)
@@ -2196,6 +2197,7 @@ subroutine tphysbc (ztodt, &
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
@@ -2519,7 +2521,7 @@ subroutine tphysbc (ztodt, &
call convect_deep_tend( &
cmfmc, cmfcme, &
dlf, pflx, zdu, &
- rliq, &
+ rliq, rice, &
ztodt, &
state, ptend, cam_in%landfrac, pbuf, mu, eu, du, md, ed, dp, &
dsubcld, jt, maxg, ideep, lengath)
@@ -2545,7 +2547,8 @@ subroutine tphysbc (ztodt, &
! Check energy integrals, including "reserved liquid"
flx_cnd(:ncol) = prec_dp(:ncol) + rliq(:ncol)
- call check_energy_chng(state, tend, "convect_deep", nstep, ztodt, zero, flx_cnd, snow_dp, zero)
+ totice_dp(:ncol) = snow_dp(:ncol) + rice(:ncol)
+ call check_energy_chng(state, tend, "convect_deep", nstep, ztodt, zero, flx_cnd, totice_dp, zero)
call cnd_diag_checkpoint( diag, 'DEEPCU', state, pbuf, cam_in, cam_out )
diff --git a/components/eam/src/physics/cam/tropopause.F90 b/components/eam/src/physics/cam/tropopause.F90
index fea695f96c22..96df8e3f43ec 100644
--- a/components/eam/src/physics/cam/tropopause.F90
+++ b/components/eam/src/physics/cam/tropopause.F90
@@ -162,10 +162,13 @@ subroutine tropopause_init()
use ppgrid, only: pver
use cam_pio_utils, only:
use cam_history, only: addfld, horiz_only, add_default
+ use mo_chem_utls, only : get_spc_ndx
implicit none
+ integer :: e90_ndx
+
! define physical constants
cnst_kap = cappa
cnst_faktor = -gravit/rair
@@ -198,6 +201,9 @@ subroutine tropopause_init()
call addfld( 'hstobie_tropop', (/ 'lev' /), 'I', 'fraction of model time', &
'Troposphere boundary calculated in chemistry' )
+ e90_ndx=-1
+ e90_ndx = get_spc_ndx('E90')
+
! If requested, be prepared to output results from all of the methods.
if (output_all) then
call addfld('TROPA_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (analytic)', flag_xyfill=.True.)
@@ -236,24 +242,30 @@ subroutine tropopause_init()
call addfld('TROPH_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (Hybrid Stobie)')
call addfld('TROPH_FD', horiz_only, 'A', 'probability', 'Tropopause Found (Hybrid Stobie)')
- call addfld('TROPE_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (E90)', flag_xyfill=.True.)
- call addfld('TROPE_T', horiz_only, 'A', 'K', 'Tropopause Temperature (E90)', flag_xyfill=.True.)
- call addfld('TROPE_Z', horiz_only, 'A', 'm', 'Tropopause Height (E90)', flag_xyfill=.True.)
- call addfld('TROPE_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (E90)')
- call addfld('TROPE_FD', horiz_only, 'A', 'probability', 'Tropopause Found (E90)')
- end if
+ if (e90_ndx > 0) then
+ call addfld('TROPE_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (E90)', flag_xyfill=.True.)
+ call addfld('TROPE_T', horiz_only, 'A', 'K', 'Tropopause Temperature (E90)', flag_xyfill=.True.)
+ call addfld('TROPE_Z', horiz_only, 'A', 'm', 'Tropopause Height (E90)', flag_xyfill=.True.)
+ call addfld('TROPE_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (E90)')
+ call addfld('TROPE_FD', horiz_only, 'A', 'probability', 'Tropopause Found (E90)')
+ end if
+
+ end if
- call addfld('TROPE3D_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (E90 3D)', flag_xyfill=.True.)
- call addfld('TROPE3D_T', horiz_only, 'A', 'K', 'Tropopause Temperature (E90 3D)', flag_xyfill=.True.)
- call addfld('TROPE3D_Z', horiz_only, 'A', 'm', 'Tropopause Height (E90 3D)', flag_xyfill=.True.)
- call addfld('TROPE3D_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (E90 3D)')
- call addfld('TROPE3D_FD', horiz_only, 'A', 'probability', 'Tropopause Found (E90 3D)')
- call addfld('TROPE3D_DZ', (/ 'lev' /), 'A', 'm', 'Relative Tropopause Height (E90 3D)')
+ if (e90_ndx > 0) then
+ call addfld('TROPE3D_P', horiz_only, 'A', 'Pa', 'Tropopause Pressure (E90 3D)', flag_xyfill=.True.)
+ call addfld('TROPE3D_T', horiz_only, 'A', 'K', 'Tropopause Temperature (E90 3D)', flag_xyfill=.True.)
+ call addfld('TROPE3D_Z', horiz_only, 'A', 'm', 'Tropopause Height (E90 3D)', flag_xyfill=.True.)
+ call addfld('TROPE3D_PD', (/ 'lev' /), 'A', 'probability', 'Tropopause Distribution (E90 3D)')
+ call addfld('TROPE3D_FD', horiz_only, 'A', 'probability', 'Tropopause Found (E90 3D)')
+ call addfld('TROPE3D_DZ', (/ 'lev' /), 'A', 'm', 'Relative Tropopause Height (E90 3D)')
+
+ call add_default('TROPE3D_P', 1, ' ')
+ call add_default('TROPE3D_T', 1, ' ')
+ endif
call add_default('TROP_P', 1, ' ')
call add_default('TROP_T', 1, ' ')
- call add_default('TROPE3D_P', 1, ' ')
- call add_default('TROPE3D_T', 1, ' ')
call add_default('hstobie_linoz', 1, ' ')
call tropopause_read_file()
@@ -268,7 +280,7 @@ subroutine tropopause_read_file
!------------------------------------------------------------------
use interpolate_data, only : lininterp_init, lininterp, interp_type, lininterp_finish
use dyn_grid, only : get_dyn_grid_parm
- use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p
+ use phys_grid, only : get_ncols_p, get_rlat_all_p, get_rlon_all_p
use ioFileMod, only : getfil
use time_manager, only : get_calday
use physconst, only : pi
@@ -1622,6 +1634,7 @@ end subroutine tropopause_output
! 3D E90 tropopause
subroutine tropopause_e90_3d_output(pstate)
use cam_history, only : outfld
+ use mo_chem_utls, only : get_spc_ndx
implicit none
@@ -1632,6 +1645,7 @@ subroutine tropopause_e90_3d_output(pstate)
integer :: ncol ! number of cloumns in the chunk
integer :: lchnk ! chunk identifier
integer :: tropLevB(pcols) ! lowest tropopause level index
+ integer :: e90_ndx ! E90 index in the species list
real(r8) :: tropP(pcols) ! lowest tropopause pressure (Pa)
real(r8) :: tropT(pcols) ! lowest tropopause temperature (K)
real(r8) :: tropZ(pcols) ! lowest tropopause height (m)
@@ -1646,6 +1660,11 @@ subroutine tropopause_e90_3d_output(pstate)
lchnk = pstate%lchnk
ncol = pstate%ncol
+ e90_ndx=-1
+ e90_ndx = get_spc_ndx('E90')
+
+ if (e90_ndx < 0) return
+
! Find the tropopause
call tropopause_e90_3d(pstate, tropLevB, tropLevU, tropFlag, tropFlagInt, tropP=tropP, tropT=tropT, tropZ=tropZ)
diff --git a/components/eam/src/physics/cam/zm_conv.F90 b/components/eam/src/physics/cam/zm_conv.F90
index fdd3faca4818..3d7c2db51b58 100644
--- a/components/eam/src/physics/cam/zm_conv.F90
+++ b/components/eam/src/physics/cam/zm_conv.F90
@@ -12,6 +12,8 @@ module zm_conv
!
! Author: Byron Boville, from code in tphysbc
!
+! April 2021: X. Song added code for convective microphysics
+! April 2022: X. Song added code for mass flux adjustment
!---------------------------------------------------------------------------------
use shr_kind_mod, only: r8 => shr_kind_r8
use spmd_utils, only: masterproc
@@ -21,6 +23,7 @@ module zm_conv
cpwv, cpliq, rh2o
use cam_abortutils, only: endrun
use cam_logfile, only: iulog
+ use zm_microphysics, only: zm_mphy, zm_aero_t, zm_microp_st
implicit none
@@ -39,10 +42,18 @@ module zm_conv
public trig_dcape_only ! true if to use dcape only trigger
public trig_ull_only ! true if to ULL along with default CAPE-based trigger
public buoyan_dilute ! subroutine that calculates CAPE
+ public zm_microp ! true for convective microphysics
+ public MCSP ! true if running MCSP
+ public MCSP_heat_coeff ! MCSP coefficient setting degree of dry static energy transport
+ public MCSP_moisture_coeff ! MCSP coefficient setting degree of moisture transport
+ public MCSP_uwind_coeff ! MCSP coefficient setting degree of zonal wind transport
+ public MCSP_vwind_coeff ! MCSP coefficient setting degree of meridional wind transport
+
!
! PUBLIC: data
!
public limcnv ! top interface level limit for convection
+
!
! Private data
!
@@ -55,12 +66,23 @@ module zm_conv
real(r8) :: zmconv_dmpdz = unset_r8
real(r8) :: zmconv_alfa = unset_r8
real(r8) :: zmconv_tiedke_add = unset_r8
- logical :: zmconv_trigdcape_ull = .false.
- logical :: zmconv_trig_dcape_only = .false.
- logical :: zmconv_trig_ull_only = .false.
+ logical :: zmconv_trigdcape_ull = .false.
+ logical :: zmconv_trig_dcape_only = .false.
+ logical :: zmconv_trig_ull_only = .false.
+
+ logical :: zmconv_microp = .false. ! switch for convective microphysics
+ logical :: zmconv_clos_dyn_adj = .false. ! switch for mass flux adjustment
+ logical :: zmconv_tpert_fix = .false. ! switch for tpert impacts
integer :: zmconv_cape_cin = unset_int
integer :: zmconv_mx_bot_lyr_adj = unset_int
real(r8) :: zmconv_tp_fac = unset_r8
+ real(r8) :: zmconv_auto_fac = unset_r8
+ real(r8) :: zmconv_accr_fac = unset_r8
+ real(r8) :: zmconv_micro_dcs = unset_r8
+ real(r8) :: zmconv_MCSP_heat_coeff = 0._r8
+ real(r8) :: zmconv_MCSP_moisture_coeff = 0._r8
+ real(r8) :: zmconv_MCSP_uwind_coeff = 0._r8
+ real(r8) :: zmconv_MCSP_vwind_coeff = 0._r8
real(r8) rl ! wg latent heat of vaporization.
real(r8) cpres ! specific heat at constant pressure in j/kg-degk.
@@ -68,16 +90,21 @@ module zm_conv
!DCAPE-ULL, including options for DCAPE_only and ull_only
real(r8), parameter :: trigdcapelmt = 0._r8 ! threshold value of dcape for deep convection
- logical :: trigdcape_ull = .false. !true to use DCAPE trigger and ULL
+ logical :: trigdcape_ull = .false. !true to use DCAPE trigger and ULL
logical :: trig_dcape_only = .false. !true to use DCAPE trigger, ULL not used
logical :: trig_ull_only = .false. !true to use ULL along with default CAPE-based trigger
+
real(r8) :: ke ! Tunable evaporation efficiency set from namelist input zmconv_ke
real(r8) :: c0_lnd ! set from namelist input zmconv_c0_lnd
real(r8) :: c0_ocn ! set from namelist input zmconv_c0_ocn
real(r8) :: dmpdz = unset_r8 ! Parcel fractional mass entrainment rate (/m)
real(r8) :: alfa_scalar ! maximum downdraft mass flux fraction
- real(r8) :: tiedke_add = unset_r8
+ real(r8) :: tiedke_add = unset_r8
+ logical :: zm_microp = .false. ! switch for convective microphysics
+ logical :: clos_dyn_adj = .false. ! true if apply mass flux adjustment to CAPE closure
+ logical :: tpert_fix = .false. ! true if apply tpert only to PBL-rooted convection
+
integer :: num_cin = unset_int !number of negative buoyancy regions that are allowed before the conv. top and CAPE calc are completed
integer :: mx_bot_lyr_adj = unset_int !bottom layer adjustment for setting "launching" level(mx) (to be at maximum moist static energy).
real(r8) tau ! convective time scale
@@ -100,7 +127,16 @@ module zm_conv
integer,protected :: limcnv ! top interface level limit for convection
- real(r8) :: tp_fac = unset_r8 ! PMA tunes tpert
+ real(r8) :: tp_fac = unset_r8
+ real(r8) :: auto_fac = unset_r8
+ real(r8) :: accr_fac = unset_r8
+ real(r8) :: micro_dcs= unset_r8
+
+ logical :: MCSP
+ real(r8) :: MCSP_heat_coeff = unset_r8
+ real(r8) :: MCSP_moisture_coeff = unset_r8
+ real(r8) :: MCSP_uwind_coeff = unset_r8
+ real(r8) :: MCSP_vwind_coeff = unset_r8
contains
@@ -119,7 +155,10 @@ subroutine zmconv_readnl(nlfile)
namelist /zmconv_nl/ zmconv_c0_lnd, zmconv_c0_ocn, zmconv_ke, zmconv_tau, &
zmconv_dmpdz, zmconv_alfa, zmconv_tiedke_add, &
zmconv_cape_cin, zmconv_mx_bot_lyr_adj, zmconv_tp_fac, zmconv_trigdcape_ull, &
- zmconv_trig_dcape_only, zmconv_trig_ull_only
+ zmconv_trig_dcape_only, zmconv_trig_ull_only, zmconv_microp, zmconv_auto_fac,&
+ zmconv_accr_fac, zmconv_micro_dcs, zmconv_clos_dyn_adj, zmconv_tpert_fix, &
+ zmconv_MCSP_heat_coeff, zmconv_MCSP_moisture_coeff, &
+ zmconv_MCSP_uwind_coeff, zmconv_MCSP_vwind_coeff
!-----------------------------------------------------------------------------
zmconv_tau = 3600._r8
@@ -137,37 +176,68 @@ subroutine zmconv_readnl(nlfile)
call freeunit(unitn)
! set local variables
- c0_lnd = zmconv_c0_lnd
- c0_ocn = zmconv_c0_ocn
- ke = zmconv_ke
- tau = zmconv_tau
- trigdcape_ull = zmconv_trigdcape_ull
+ c0_lnd = zmconv_c0_lnd
+ c0_ocn = zmconv_c0_ocn
+ ke = zmconv_ke
+ tau = zmconv_tau
+ trigdcape_ull = zmconv_trigdcape_ull
trig_dcape_only = zmconv_trig_dcape_only
- trig_ull_only = zmconv_trig_ull_only
- tiedke_add = zmconv_tiedke_add
- num_cin = zmconv_cape_cin
- mx_bot_lyr_adj = zmconv_mx_bot_lyr_adj
- dmpdz = zmconv_dmpdz
- tp_fac = zmconv_tp_fac
-
+ trig_ull_only = zmconv_trig_ull_only
+ zm_microp = zmconv_microp
+ clos_dyn_adj = zmconv_clos_dyn_adj
+ tpert_fix = zmconv_tpert_fix
+ tiedke_add = zmconv_tiedke_add
+ num_cin = zmconv_cape_cin
+ mx_bot_lyr_adj = zmconv_mx_bot_lyr_adj
+ dmpdz = zmconv_dmpdz
+ tp_fac = zmconv_tp_fac
+ auto_fac = zmconv_auto_fac
+ accr_fac = zmconv_accr_fac
+ micro_dcs = zmconv_micro_dcs
+ MCSP_heat_coeff = zmconv_MCSP_heat_coeff
+ MCSP_moisture_coeff = zmconv_MCSP_moisture_coeff
+ MCSP_uwind_coeff = zmconv_MCSP_uwind_coeff
+ MCSP_vwind_coeff = zmconv_MCSP_vwind_coeff
+
+ if( abs(MCSP_heat_coeff)+abs(MCSP_moisture_coeff)+abs(MCSP_uwind_coeff)+abs(MCSP_vwind_coeff) > 0._r8 ) then
+ MCSP = .true.
+ else
+ MCSP = .false.
+ end if
+
if ( zmconv_alfa /= unset_r8 ) then
alfa_scalar = zmconv_alfa
else
alfa_scalar = 0.1_r8
end if
- if (trigdcape_ull) then
+ if (trigdcape_ull) then
write(iulog,*)'**** ZMCONV-DCAPE trigger with unrestricted launch level:', trigdcape_ull
endif
- if (trig_dcape_only) then
+ if (trig_dcape_only) then
write(iulog,*)'**** ZM scheme uses DCAPE-only trigger:', trig_dcape_only
endif
- if (trig_ull_only) then
+ if (trig_ull_only) then
write(iulog,*)'**** ZM scheme uses unrestricted launch level along with default CAPE-based trigger:', trig_ull_only
endif
+ if(MCSP) then
+ write(iulog,*)'**** ZM scheme uses multiscale coherent structure parameterization (MCSP):',MCSP
+ end if
+
+ if(zm_microp) then
+ write(iulog,*)'**** ZM scheme uses convective microphysics scheme:',zm_microp
+ end if
+
+ if(clos_dyn_adj) then
+ write(iulog,*)'**** ZM scheme uses cloud-base mass flux adjustment:',clos_dyn_adj
+ end if
+
+ if(tpert_fix) then
+ write(iulog,*)'**** ZM scheme uses tpert_fix:',tpert_fix
+ end if
end if
#ifdef SPMD
@@ -181,10 +251,21 @@ subroutine zmconv_readnl(nlfile)
call mpibcast(trigdcape_ull, 1, mpilog, 0, mpicom)
call mpibcast(trig_dcape_only, 1, mpilog, 0, mpicom)
call mpibcast(trig_ull_only, 1, mpilog, 0, mpicom)
+ call mpibcast(zm_microp, 1, mpilog, 0, mpicom)
+ call mpibcast(clos_dyn_adj, 1, mpilog, 0, mpicom)
+ call mpibcast(tpert_fix, 1, mpilog, 0, mpicom)
call mpibcast(tiedke_add, 1, mpir8, 0, mpicom)
call mpibcast(num_cin, 1, mpiint, 0, mpicom)
call mpibcast(mx_bot_lyr_adj, 1, mpiint, 0, mpicom)
- call mpibcast(tp_fac, 1, mpir8, 0, mpicom)
+ call mpibcast(tp_fac, 1, mpir8, 0, mpicom)
+ call mpibcast(auto_fac, 1, mpir8, 0, mpicom)
+ call mpibcast(accr_fac, 1, mpir8, 0, mpicom)
+ call mpibcast(micro_dcs, 1, mpir8, 0, mpicom)
+ call mpibcast(MCSP, 1, mpilog, 0, mpicom)
+ call mpibcast(MCSP_heat_coeff, 1, mpir8, 0, mpicom)
+ call mpibcast(MCSP_moisture_coeff,1, mpir8, 0, mpicom)
+ call mpibcast(MCSP_uwind_coeff, 1, mpir8, 0, mpicom)
+ call mpibcast(MCSP_vwind_coeff, 1, mpir8, 0, mpicom)
#endif
end subroutine zmconv_readnl
@@ -240,13 +321,16 @@ end subroutine zm_convi
subroutine zm_convr(lchnk ,ncol , &
t ,qh ,prec ,jctop ,jcbot , &
pblh ,zm ,geos ,zi ,qtnd , &
- heat ,pap ,paph ,dpp , &
+ heat ,pap ,paph ,dpp ,omega , &
delt ,mcon ,cme ,cape , &
tpert ,dlf ,pflx ,zdu ,rprd , &
mu ,md ,du ,eu ,ed , &
dp ,dsubcld ,jt ,maxg ,ideep , &
lengath ,ql ,rliq ,landfrac, &
- t_star ,q_star, dcape)
+ t_star ,q_star, dcape, &
+ aero ,qi ,dif ,dnlf ,dnif , &
+ dsf ,dnsf ,sprd ,rice ,frz , &
+ mudpcu ,lambdadpcu, microp_st)
!-----------------------------------------------------------------------
!
! Purpose:
@@ -266,7 +350,7 @@ subroutine zm_convr(lchnk ,ncol , &
!
!-----------------------------------------------------------------------
use phys_control, only: cam_physpkg_is
- use time_manager, only: is_first_step
+ use time_manager, only: is_first_step
!
! ************************ index of variables **********************
!
@@ -372,12 +456,18 @@ subroutine zm_convr(lchnk ,ncol , &
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) :: omega(pcols,pver) ! Vertical velocity Pa/s
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_aero_t), intent(inout) :: aero ! aerosol object. intent(inout) because the
+ ! gathered arrays are set here
+ ! before passing object
+ ! to microphysics
+ type(zm_microp_st), intent(inout) :: microp_st ! state and tendency of convective microphysics
!DCAPE-ULL
real(r8), intent(in), pointer, dimension(:,:) :: t_star ! intermediate T between n and n-1 time step
@@ -396,6 +486,18 @@ subroutine zm_convr(lchnk ,ncol , &
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) :: sprd(pcols,pver) ! snow 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.
+ real(r8), intent(out) :: dsf(pcols,pver) ! detrained convective snow mixing ratio.
+ real(r8), intent(out) :: dnsf(pcols,pver) ! detrained convective snow num concen.
+ real(r8), intent(out) :: lambdadpcu(pcols,pver) ! slope of cloud liquid size distr
+ real(r8), intent(out) :: mudpcu(pcols,pver) ! width parameter of droplet size distr
+ real(r8), intent(out) :: frz(pcols,pver) ! freezing heating
+ real(r8), intent(out) :: rice(pcols) ! reserved ice (not yet in cldce) for energy integrals
+ real(r8), intent(out) :: qi(pcols,pver) ! cloud ice mixing ratio.
+
! 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)
@@ -408,9 +510,10 @@ subroutine zm_convr(lchnk ,ncol , &
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) :: rliq(pcols) ! reserved liquid (not yet in cldliq) for energy integrals
real(r8), intent(out) :: dcape(pcols) ! output dynamical CAPE
+
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
@@ -423,9 +526,9 @@ subroutine zm_convr(lchnk ,ncol , &
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.
+ real(r8) pblt(pcols) ! i row of pbl top indices.
+ real(r8) pbltg(pcols) ! i row of pbl top indices.
@@ -444,7 +547,6 @@ subroutine zm_convr(lchnk ,ncol , &
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.
-
real(r8) tpm1(pcols,pver) ! w parcel temperatures at n-1 time step.
real(r8) qstpm1(pcols,pver) ! w parcel temp. saturation mixing ratio at n-1 time step
real(r8) tlm1(pcols) ! w LCL parcel Temperature at n-1 time step
@@ -478,6 +580,8 @@ subroutine zm_convr(lchnk ,ncol , &
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) omegag(pcols,pver) ! wg grid slice of gathered values of omega.
+
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.
@@ -507,6 +611,29 @@ subroutine zm_convr(lchnk ,ncol , &
real(r8) dvdt(pcols,pver) ! wg v-wind tendency at gathered points.
! real(r8) ud(pcols,pver)
! real(r8) vd(pcols,pver)
+ real(r8) :: lambdadpcug(pcols,pver) ! slope of cloud liquid size distr
+ real(r8) :: mudpcug(pcols,pver) ! width parameter of droplet size distr
+
+ real(r8) sprdg(pcols,pver) ! wg gathered snow production rate
+ real(r8) dig(pcols,pver)
+ real(r8) dsg(pcols,pver)
+ real(r8) dnlg(pcols,pver)
+ real(r8) dnig(pcols,pver)
+ real(r8) dnsg(pcols,pver)
+
+ real(r8) qldeg(pcols,pver) ! cloud water mixing ratio for detrainment (kg/kg)
+ real(r8) qideg(pcols,pver) ! cloud ice mixing ratio for detrainment (kg/kg)
+ real(r8) qsdeg(pcols,pver) ! snow mixing ratio for detrainment (kg/kg)
+ real(r8) ncdeg(pcols,pver) ! cloud water number concentration for detrainment (1/kg)
+ real(r8) nideg(pcols,pver) ! cloud ice number concentration for detrainment (1/kg)
+ real(r8) nsdeg(pcols,pver) ! snow concentration for detrainment (1/kg)
+
+ real(r8) dsfmg(pcols,pver) ! mass tendency due to detrainment of snow
+ real(r8) dsfng(pcols,pver) ! num tendency due to detrainment of snow
+ real(r8) frzg(pcols,pver) ! gathered heating rate due to freezing
+
+ type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics
+
real(r8) mb(pcols) ! wg cloud base mass flux.
@@ -518,14 +645,21 @@ subroutine zm_convr(lchnk ,ncol , &
integer i
integer ii
- integer k
+ integer k, kk
integer msg ! ic number of missing moisture levels at the top of model.
integer ierror
real(r8) qdifr
real(r8) sdifr
- integer dcapemx(pcols) ! maxi saved from 1st call for CAPE calculation; used in 2nd call when DCAPE-ULL active
+ integer l, m
+ real(r8), parameter :: dcon = 25.e-6_r8
+ real(r8), parameter :: mucon = 5.3_r8
+ real(r8) negadq
+ logical doliq
+
+ integer dcapemx(pcols) ! launching level index saved from 1st call for CAPE calculation; used in 2nd call when DCAPE-ULL active
+
!
!--------------------------Data statements------------------------------
!
@@ -540,6 +674,10 @@ subroutine zm_convr(lchnk ,ncol , &
heat(:,:) = 0._r8
mcon(:,:) = 0._r8
rliq(:ncol) = 0._r8
+ rice(:ncol) = 0._r8
+!
+! Allocate microphysics arrays
+ if (zm_microp) call zm_microp_st_alloc(loc_microp_st)
!
! initialize convective tendencies
!
@@ -559,8 +697,46 @@ subroutine zm_convr(lchnk ,ncol , &
qlg(i,k) = 0._r8
dlf(i,k) = 0._r8
dlg(i,k) = 0._r8
+ ! Convective microphysics
+ dif(i,k) = 0._r8
+ dsf(i,k) = 0._r8
+ dnlf(i,k) = 0._r8
+ dnif(i,k) = 0._r8
+ dnsf(i,k) = 0._r8
+
+ dig(i,k) = 0._r8
+ dsg(i,k) = 0._r8
+ dnlg(i,k) = 0._r8
+ dnig(i,k) = 0._r8
+ dnsg(i,k) = 0._r8
+
+ qi(i,k) = 0._r8
+ sprd(i,k) = 0._r8
+ frz(i,k) = 0._r8
+
+ sprdg(i,k) = 0._r8
+ frzg(i,k) = 0._r8
+
+ qldeg(i,k) = 0._r8
+ qideg(i,k) = 0._r8
+ qsdeg(i,k) = 0._r8
+ ncdeg(i,k) = 0._r8
+ nideg(i,k) = 0._r8
+ nsdeg(i,k) = 0._r8
+
+ dsfmg(i,k) = 0._r8
+ dsfng(i,k) = 0._r8
end do
end do
+
+! Initialize microphysics arrays
+ if (zm_microp) call zm_microp_st_ini(microp_st,loc_microp_st,ncol)
+
+ lambdadpcu = (mucon + 1._r8)/dcon
+ mudpcu = mucon
+ lambdadpcug = lambdadpcu
+ mudpcug = mudpcu
+
do i = 1,ncol
pflx(i,pverp) = 0
pflxg(i,pverp) = 0
@@ -641,6 +817,7 @@ subroutine zm_convr(lchnk ,ncol , &
! The differewnce of CAPE values from the two calls is DCAPE, based on the same launch level
iclosure = .true.
+
call buoyan_dilute(lchnk ,ncol , &! in
q ,t ,p ,z ,pf , &! in
tp ,qstp ,tl ,rl ,cape , &! rl = in, others = out
@@ -655,6 +832,7 @@ subroutine zm_convr(lchnk ,ncol , &
!DCAPE-ULL
if (.not. is_first_step() .and. (trigdcape_ull .or. trig_dcape_only)) then
iclosure = .false.
+
call buoyan_dilute(lchnk ,ncol , &! in
q_star ,t_star ,p ,z ,pf , &! in
tpm1 ,qstpm1 ,tlm1 ,rl ,capem1 , &! rl = in, others = out
@@ -718,10 +896,49 @@ subroutine zm_convr(lchnk ,ncol , &
tpg(i,k) = tp(ideep(i),k)
zfg(i,k) = zf(ideep(i),k)
qstpg(i,k) = qstp(ideep(i),k)
+ omegag(i,k) = omega(ideep(i),k)
ug(i,k) = 0._r8
vg(i,k) = 0._r8
end do
end do
+
+ if (zm_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)
@@ -733,6 +950,7 @@ subroutine zm_convr(lchnk ,ncol , &
maxg(i) = maxi(ideep(i))
tlg(i) = tl(ideep(i))
landfracg(i) = landfrac(ideep(i))
+ pbltg(i) = pblt(ideep(i))
tpertg(i) = tpert(ideep(i))
end do
!
@@ -786,7 +1004,12 @@ subroutine zm_convr(lchnk ,ncol , &
maxg ,j0 ,jd ,rl ,lengath , &
rgas ,grav ,cpres ,msg , &
pflxg ,evpg ,cug ,rprdg ,limcnv , &
- landfracg, tpertg) !PMA adds tpert to the calculation
+ landfracg, tpertg, &
+ aero ,qhat ,lambdadpcug,mudpcug ,sprdg ,frzg , &
+ qldeg ,qideg ,qsdeg ,ncdeg ,nideg ,nsdeg, &
+ dsfmg ,dsfng ,loc_microp_st )
+
+
!
! convert detrainment from units of "1/m" to "1/mb".
!
@@ -798,6 +1021,8 @@ subroutine zm_convr(lchnk ,ncol , &
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)
+ sprdg(i,k) = sprdg(i,k)* (zfg(i,k)-zfg(i,k+1))/dp(i,k)
+ frzg (i,k) = frzg (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
@@ -830,6 +1055,13 @@ subroutine zm_convr(lchnk ,ncol , &
mb(i) = 0._r8
endif
end do
+
+ if (clos_dyn_adj) then
+ do i = 1,lengath
+ mb(i) = max(mb(i) - omegag(i,pbltg(i))*0.01_r8, 0._r8)
+ end do
+ end if
+
! If no_deep_pbl = .true., don't allow convection entirely
! within PBL (suggestion of Bjorn Stevens, 8-2000)
@@ -853,6 +1085,99 @@ subroutine zm_convr(lchnk ,ncol , &
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
+ sprdg(i,k) = sprdg(i,k)*mb(i)
+ frzg(i,k) = frzg(i,k)*mb(i)
+
+
+ if ( zm_microp .and. mb(i).eq.0._r8) then
+ qlg (i,k) = 0._r8
+ dsfmg(i,k) = 0._r8
+ dsfng(i,k) = 0._r8
+ frzg (i,k) = 0._r8
+ loc_microp_st%wu(i,k) = 0._r8
+ loc_microp_st%qliq (i,k) = 0._r8
+ loc_microp_st%qice (i,k) = 0._r8
+ loc_microp_st%qrain(i,k) = 0._r8
+ loc_microp_st%qsnow(i,k) = 0._r8
+ loc_microp_st%qgraupel(i,k)= 0._r8
+ loc_microp_st%qnl (i,k) = 0._r8
+ loc_microp_st%qni (i,k) = 0._r8
+ loc_microp_st%qnr (i,k) = 0._r8
+ loc_microp_st%qns (i,k) = 0._r8
+ loc_microp_st%qng (i,k) = 0._r8
+
+ loc_microp_st%autolm(i,k) = 0._r8
+ loc_microp_st%accrlm(i,k) = 0._r8
+ loc_microp_st%bergnm(i,k) = 0._r8
+ loc_microp_st%fhtimm(i,k) = 0._r8
+ loc_microp_st%fhtctm(i,k) = 0._r8
+ loc_microp_st%fhmlm (i,k) = 0._r8
+ loc_microp_st%hmpim (i,k) = 0._r8
+ loc_microp_st%accslm(i,k) = 0._r8
+ loc_microp_st%dlfm (i,k) = 0._r8
+
+ loc_microp_st%autoln(i,k) = 0._r8
+ loc_microp_st%accrln(i,k) = 0._r8
+ loc_microp_st%bergnn(i,k) = 0._r8
+ loc_microp_st%fhtimn(i,k) = 0._r8
+ loc_microp_st%fhtctn(i,k) = 0._r8
+ loc_microp_st%fhmln (i,k) = 0._r8
+ loc_microp_st%accsln(i,k) = 0._r8
+ loc_microp_st%activn(i,k) = 0._r8
+ loc_microp_st%dlfn (i,k) = 0._r8
+ loc_microp_st%cmel (i,k) = 0._r8
+
+
+ loc_microp_st%autoim(i,k) = 0._r8
+ loc_microp_st%accsim(i,k) = 0._r8
+ loc_microp_st%difm (i,k) = 0._r8
+ loc_microp_st%cmei (i,k) = 0._r8
+
+ loc_microp_st%nuclin(i,k) = 0._r8
+ loc_microp_st%autoin(i,k) = 0._r8
+ loc_microp_st%accsin(i,k) = 0._r8
+ loc_microp_st%hmpin (i,k) = 0._r8
+ loc_microp_st%difn (i,k) = 0._r8
+
+ loc_microp_st%trspcm(i,k) = 0._r8
+ loc_microp_st%trspcn(i,k) = 0._r8
+ loc_microp_st%trspim(i,k) = 0._r8
+ loc_microp_st%trspin(i,k) = 0._r8
+
+ loc_microp_st%accgrm(i,k) = 0._r8
+ loc_microp_st%accglm(i,k) = 0._r8
+ loc_microp_st%accgslm(i,k)= 0._r8
+ loc_microp_st%accgsrm(i,k)= 0._r8
+ loc_microp_st%accgirm(i,k)= 0._r8
+ loc_microp_st%accgrim(i,k)= 0._r8
+ loc_microp_st%accgrsm(i,k)= 0._r8
+
+ loc_microp_st%accgsln(i,k)= 0._r8
+ loc_microp_st%accgsrn(i,k)= 0._r8
+ loc_microp_st%accgirn(i,k)= 0._r8
+
+ loc_microp_st%accsrim(i,k)= 0._r8
+ loc_microp_st%acciglm(i,k)= 0._r8
+ loc_microp_st%accigrm(i,k)= 0._r8
+ loc_microp_st%accsirm(i,k)= 0._r8
+
+ loc_microp_st%accigln(i,k)= 0._r8
+ loc_microp_st%accigrn(i,k)= 0._r8
+ loc_microp_st%accsirn(i,k)= 0._r8
+ loc_microp_st%accgln(i,k) = 0._r8
+ loc_microp_st%accgrn(i,k) = 0._r8
+
+ loc_microp_st%accilm(i,k) = 0._r8
+ loc_microp_st%acciln(i,k) = 0._r8
+
+ loc_microp_st%fallrm(i,k) = 0._r8
+ loc_microp_st%fallsm(i,k) = 0._r8
+ loc_microp_st%fallgm(i,k) = 0._r8
+ loc_microp_st%fallrn(i,k) = 0._r8
+ loc_microp_st%fallsn(i,k) = 0._r8
+ loc_microp_st%fallgn(i,k) = 0._r8
+ loc_microp_st%fhmrm (i,k) = 0._r8
+ end if
end do
end do
!
@@ -861,10 +1186,110 @@ subroutine zm_convr(lchnk ,ncol , &
call q1q2_pjr(lchnk , &
dqdt ,dsdt ,qg ,qs ,qu , &
su ,du ,qhat ,shat ,dp , &
- mu ,md ,sd ,qd ,qlg , &
+ mu ,md ,sd ,qd ,qldeg , &
dsubcld ,jt ,maxg ,1 ,lengath , &
cpres ,rl ,msg , &
- dlg ,evpg ,cug )
+ dlg ,evpg ,cug ,qideg ,dig , &
+ ncdeg ,nideg ,dnlg ,dnig ,frzg , &
+ qsdeg ,nsdeg ,dsg ,dnsg )
+
+!
+! Conservation check
+!
+ if (zm_microp) then
+ do k = msg + 1,pver
+#ifdef CPRCRAY
+!DIR$ CONCURRENT
+#endif
+ 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
+ dqdt(i,k) = dqdt(i,k)-negadq
+
+ ! First evaporate precipitation from k layer to cloud top assuming that the preciptation
+ ! above will fall down and evaporate at k layer. So dsdt will be applied at k layer.
+ do kk=k,jt(i),-1
+ if (negadq<0._r8) then
+ if (rprdg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then
+ ! precipitation is enough
+ dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres
+ if (rprdg(i,kk)>sprdg(i,kk)) then
+ ! if there is rain, evaporate it first
+ if(rprdg(i,kk)-sprdg(i,kk)<-negadq*dp(i,k)/dp(i,kk)) then
+ ! if rain is not enough, evaporate snow and graupel
+ dsdt(i,k) = dsdt(i,k) + (negadq+ (rprdg(i,kk)-sprdg(i,kk))*dp(i,kk)/dp(i,k))*latice/cpres
+ sprdg(i,kk) = negadq*dp(i,k)/dp(i,kk)+rprdg(i,kk)
+ end if
+ else
+ ! if there is not rain, evaporate snow and graupel
+ sprdg(i,kk) = sprdg(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
+ ! precipitation is not enough. calculate the residue and evaporate next layer
+ 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)
+ dsdt(i,k) = dsdt(i,k) - sprdg(i,kk)*latice/cpres*dp(i,kk)/dp(i,k)
+ sprdg(i,kk) = 0._r8
+ rprdg(i,kk) = 0._r8
+ end if
+
+
+ if (negadq<0._r8) then
+ if (dlg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then
+ ! first evaporate (detrained) cloud liquid water
+ dsdt(i,k) = dsdt(i,k) + negadq*rl/cpres
+ dnlg(i,kk) = dnlg(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
+ ! if cloud liquid water is not enough then calculate the residual and evaporate the detrained cloud ice
+ 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
+ dnlg(i,kk) = 0._r8
+ if (dig(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then
+ dsdt(i,k) = dsdt(i,k) + negadq*(rl+latice)/cpres
+ dnig(i,kk) = dnig(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dig(i,kk))
+ dig(i,kk) = dig(i,kk)+negadq*dp(i,k)/dp(i,kk)
+ negadq = 0._r8
+ else
+ ! if cloud ice is not enough, then calculate the residual and evaporate the detrained snow
+ negadq = negadq + dig(i,kk)*dp(i,kk)/dp(i,k)
+ dsdt(i,k) = dsdt(i,k) - dig(i,kk)*dp(i,kk)/dp(i,k)*(rl+latice)/cpres
+ dig(i,kk) = 0._r8
+ dnig(i,kk) = 0._r8
+ if (dsg(i,kk)> -negadq*dp(i,k)/dp(i,kk)) then
+ dsdt(i,k) = dsdt(i,k) + negadq*(rl+latice)/cpres
+ dnsg(i,kk) = dnsg(i,kk)*(1._r8+negadq*dp(i,k)/dp(i,kk)/dsg(i,kk))
+ dsg(i,kk) = dsg(i,kk)+negadq*dp(i,k)/dp(i,kk)
+ negadq = 0._r8
+ else
+ ! if cloud ice is not enough, then calculate the residual and evaporate next layer
+ negadq = negadq + dsg(i,kk)*dp(i,kk)/dp(i,k)
+ dsdt(i,k) = dsdt(i,k) - dsg(i,kk)*dp(i,kk)/dp(i,k)*(rl+latice)/cpres
+ dsg(i,kk) = 0._r8
+ dnsg(i,kk) = 0._r8
+ end if
+ end if
+ 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
+
+
! gather back temperature and mixing ratio.
!
@@ -886,8 +1311,71 @@ subroutine zm_convr(lchnk ,ncol , &
dlf (ideep(i),k) = dlg (i,k)
pflx(ideep(i),k) = pflxg(i,k)
ql (ideep(i),k) = qlg (i,k)
+
+ sprd(ideep(i),k) = sprdg(i,k)
+ dif (ideep(i),k) = dig (i,k)
+ dsf (ideep(i),k) = dsg (i,k)
+ dnlf(ideep(i),k) = dnlg (i,k)
+ dnif(ideep(i),k) = dnig (i,k)
+ dnsf(ideep(i),k) = dnsg (i,k)
+ lambdadpcu(ideep(i),k) = lambdadpcug(i,k)
+ mudpcu(ideep(i),k) = mudpcug(i,k)
+ frz(ideep(i),k) = frzg(i,k)*latice/cpres
+ if (zm_microp) qi(ideep(i),k) = loc_microp_st%qice(i,k)
end do
end do
+
+! Gather back microphysics arrays.
+ if (zm_microp) call zm_microp_st_gb(microp_st,loc_microp_st,ideep,lengath)
+
+ if (zm_microp) then
+ do k = msg + 1,pver
+ do i = 1,ncol
+
+ !Interpolate variable from interface to mid-layer.
+
+ if(k.lt.pver) then
+ microp_st%qice (i,k) = 0.5_r8*(microp_st%qice(i,k)+microp_st%qice(i,k+1))
+ microp_st%qliq (i,k) = 0.5_r8*(microp_st%qliq(i,k)+microp_st%qliq(i,k+1))
+ microp_st%qrain (i,k) = 0.5_r8*(microp_st%qrain(i,k)+microp_st%qrain(i,k+1))
+ microp_st%qsnow (i,k) = 0.5_r8*(microp_st%qsnow(i,k)+microp_st%qsnow(i,k+1))
+ microp_st%qgraupel(i,k) = 0.5_r8*(microp_st%qgraupel(i,k)+microp_st%qgraupel(i,k+1))
+ microp_st%qni (i,k) = 0.5_r8*(microp_st%qni(i,k)+microp_st%qni(i,k+1))
+ microp_st%qnl (i,k) = 0.5_r8*(microp_st%qnl(i,k)+microp_st%qnl(i,k+1))
+ microp_st%qnr (i,k) = 0.5_r8*(microp_st%qnr(i,k)+microp_st%qnr(i,k+1))
+ microp_st%qns (i,k) = 0.5_r8*(microp_st%qns(i,k)+microp_st%qns(i,k+1))
+ microp_st%qng (i,k) = 0.5_r8*(microp_st%qng(i,k)+microp_st%qng(i,k+1))
+ microp_st%wu(i,k) = 0.5_r8*(microp_st%wu(i,k)+microp_st%wu(i,k+1))
+ end if
+
+ if (t(i,k).gt.tmelt .and. t(i,k-1).le.tmelt) then
+ microp_st%qice (i,k-1) = microp_st%qice (i,k-1) + microp_st%qice (i,k)
+ microp_st%qice (i,k) = 0._r8
+ microp_st%qni (i,k-1) = microp_st%qni (i,k-1) + microp_st%qni (i,k)
+ microp_st%qni (i,k) = 0._r8
+ microp_st%qsnow (i,k-1) = microp_st%qsnow (i,k-1) + microp_st%qsnow (i,k)
+ microp_st%qsnow (i,k) = 0._r8
+ microp_st%qns (i,k-1) = microp_st%qns (i,k-1) + microp_st%qns (i,k)
+ microp_st%qns (i,k) = 0._r8
+ microp_st%qgraupel (i,k-1) = microp_st%qgraupel (i,k-1) + microp_st%qgraupel (i,k)
+ microp_st%qgraupel (i,k) = 0._r8
+ microp_st%qng (i,k-1) = microp_st%qng (i,k-1) + microp_st%qng (i,k)
+ microp_st%qng (i,k) = 0._r8
+ end if
+ !Convert it from units of "kg/kg" to "g/m3"
+ microp_st%qice (i,k) = microp_st%qice(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8
+ microp_st%qliq (i,k) = microp_st%qliq(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8
+ microp_st%qrain (i,k) = microp_st%qrain(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8
+ microp_st%qsnow (i,k) = microp_st%qsnow(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8
+ microp_st%qgraupel (i,k) = microp_st%qgraupel(i,k) * pap(i,k)/t(i,k)/rgas *1000._r8
+ microp_st%qni (i,k) = microp_st%qni(i,k) * pap(i,k)/t(i,k)/rgas
+ microp_st%qnl (i,k) = microp_st%qnl(i,k) * pap(i,k)/t(i,k)/rgas
+ microp_st%qnr (i,k) = microp_st%qnr(i,k) * pap(i,k)/t(i,k)/rgas
+ microp_st%qns (i,k) = microp_st%qns(i,k) * pap(i,k)/t(i,k)/rgas
+ microp_st%qng (i,k) = microp_st%qng(i,k) * pap(i,k)/t(i,k)/rgas
+ end do
+ end do
+ end if
!
#ifdef CPRCRAY
!DIR$ CONCURRENT
@@ -903,7 +1391,7 @@ subroutine zm_convr(lchnk ,ncol , &
! 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)*2*delt
+ prec(i) = prec(i) - dpp(i,k)* (q(i,k)-qh(i,k)) - dpp(i,k)*(dlf(i,k)+dif(i,k)+dsf(i,k))*2._r8*delt
end do
end do
@@ -916,10 +1404,15 @@ subroutine zm_convr(lchnk ,ncol , &
! 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)*dpp(i,k)/gravit
+ rliq(i) = rliq(i) + (dlf(i,k)+dif(i,k)+dsf(i,k))*dpp(i,k)/gravit
+ rice(i) = rice(i) + (dif(i,k)+dsf(i,k))*dpp(i,k)/gravit
end do
end do
rliq(:ncol) = rliq(:ncol) /1000._r8
+ rice(:ncol) = rice(:ncol) /1000._r8
+
+! Deallocate microphysics arrays.
+ if (zm_microp) call zm_microp_st_dealloc(loc_microp_st)
return
end subroutine zm_convr
@@ -929,8 +1422,7 @@ subroutine zm_conv_evap(ncol,lchnk, &
t,pmid,pdel,q, &
tend_s, tend_s_snwprd, tend_s_snwevmlt, tend_q, &
prdprec, cldfrc, deltat, &
- prec, snow, ntprprd, ntsnprd, flxprec, flxsnow )
-
+ prec, snow, ntprprd, ntsnprd, flxprec, flxsnow, prdsnow, old_snow )
!-----------------------------------------------------------------------
! Compute tendencies due to evaporation of rain from ZM scheme
!--
@@ -962,6 +1454,10 @@ subroutine zm_conv_evap(ncol,lchnk, &
real(r8), intent(inout) :: prec(pcols) ! Convective-scale preciptn rate
real(r8), intent(out) :: snow(pcols) ! Convective-scale snowfall rate
+
+ ! Convective microphysics
+ real(r8), intent(in ) :: prdsnow(pcols,pver)! snow production (kg/ks/s)
+ logical, intent(in) :: old_snow ! true for old estimate of snow production
!
!---------------------------Local storage-------------------------------
@@ -985,6 +1481,8 @@ subroutine zm_conv_evap(ncol,lchnk, &
real(r8) :: evplimit ! temp variable for evaporation limits
real(r8) :: rlat(pcols)
+ real(r8) :: dum
+ real(r8) :: omsm
integer :: i,k ! longitude,level indices
@@ -1004,11 +1502,13 @@ subroutine zm_conv_evap(ncol,lchnk, &
flxprec(:ncol,1) = 0._r8
flxsnow(:ncol,1) = 0._r8
evpvint(:ncol) = 0._r8
+ omsm=0.99999_r8 ! to prevent problems due to round off error
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)
@@ -1016,6 +1516,27 @@ subroutine zm_conv_evap(ncol,lchnk, &
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
evplimit = max(1._r8 - q(i,k)/qs(i,k), 0._r8)
@@ -1042,11 +1563,17 @@ subroutine zm_conv_evap(ncol,lchnk, &
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)
+ if (.not.old_snow .and. prdsnow(i,k)>prdprec(i,k)) work1 = 1._r8
evpsnow(i) = evpprec(i) * work1
else
evpsnow(i) = 0._r8
@@ -1063,6 +1590,8 @@ subroutine zm_conv_evap(ncol,lchnk, &
! 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
@@ -1078,6 +1607,11 @@ subroutine zm_conv_evap(ncol,lchnk, &
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
@@ -1092,11 +1626,35 @@ subroutine zm_conv_evap(ncol,lchnk, &
! heating (cooling) and moistening due to evaporation
! - latent heat of vaporization for precip production has already been accounted for
! - snow is contained in prec
- tend_s(i,k) =-evpprec(i)*latvap + ntsnprd(i,k)*latice
+ 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
+! protect against rounding error
+ if( .not.old_snow ) then
+ do i = 1, ncol
+ if(flxsnow(i,pverp).gt.flxprec(i,pverp)) then
+ dum = (flxsnow(i,pverp)-flxprec(i,pverp))*gravit
+ do k = pver, 1, -1
+ if (ntsnprd(i,k)>ntprprd(i,k).and. dum > 0._r8) then
+ ntsnprd(i,k) = ntsnprd(i,k) - dum/pdel(i,k)
+ tend_s_snwevmlt(i,k) = tend_s_snwevmlt(i,k) - dum/pdel(i,k)*latice
+ tend_s(i,k) = tend_s(i,k) - dum/pdel(i,k)*latice
+ dum = 0._r8
+ end if
+ end do
+ flxsnow(i,pverp) = flxprec(i,pverp)
+ end if
+ end do
+ end if
+
+
! set output precipitation rates (m/s)
prec(:ncol) = flxprec(:ncol,pver+1) / 1000._r8
snow(:ncol) = flxsnow(:ncol,pver+1) / 1000._r8
@@ -1113,7 +1671,7 @@ subroutine convtran(lchnk , &
doconvtran,q ,ncnst ,mu ,md , &
du ,eu ,ed ,dp ,dsubcld , &
jt ,mx ,ideep ,il1g ,il2g , &
- nstep ,fracis ,dqdt ,dpdry )
+ nstep ,fracis ,dqdt ,dpdry ,dt )
!-----------------------------------------------------------------------
!
! Purpose:
@@ -1159,7 +1717,7 @@ subroutine convtran(lchnk , &
integer, intent(in) :: nstep ! Time step index
real(r8), intent(in) :: dpdry(pcols,pver) ! Delta pressure between interfaces
-
+ real(r8), intent(in) :: dt ! model time increment
! input/output
@@ -1199,6 +1757,9 @@ subroutine convtran(lchnk , &
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
+
+ ! Conservation check
+ real(r8) negadt,qtmp
!-----------------------------------------------------------------------
!
small = 1.e-36_r8
@@ -1389,6 +1950,47 @@ subroutine convtran(lchnk , &
end do
end do
+ ! Conservation check
+ if (zm_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
@@ -2140,7 +2742,11 @@ subroutine cldprp(lchnk , &
mx ,j0 ,jd ,rl ,il2g , &
rd ,grav ,cp ,msg , &
pflx ,evp ,cu ,rprd ,limcnv , &
- landfrac, tpertg )
+ landfrac,tpertg , &
+ aero ,qhat ,lambdadpcu ,mudpcu ,sprd ,frz1 , &
+ qcde ,qide ,qsde ,ncde ,nide ,nsde , &
+ dsfm ,dsfn ,loc_microp_st )
+
!-----------------------------------------------------------------------
!
! Purpose:
@@ -2194,6 +2800,10 @@ subroutine cldprp(lchnk , &
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) :: tpertg(pcols)
+
+ 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
!
@@ -2214,6 +2824,25 @@ subroutine cldprp(lchnk , &
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
+ ! Convective microphysics
+ type(zm_microp_st) :: loc_microp_st ! state and tendency of convective microphysics
+
+ 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) :: qsde(pcols,pver) ! snow mixing ratio for detrainment (kg/kg)
+ real(r8), intent(out) :: ncde(pcols,pver) ! cloud water number concentration for detrainment (1/kg)
+ real(r8), intent(out) :: nide(pcols,pver) ! cloud ice number concentration for detrainment (1/kg)
+ real(r8), intent(out) :: nsde(pcols,pver) ! snow number concentration for detrainment (1/kg)
+ real(r8), intent(out) :: sprd(pcols,pver) ! rate of production of snow at that layer
+
+ ! tendency for output
+
+ real(r8), intent(out) :: dsfm (pcols,pver) !mass tendency due to detrainment of snow
+ real(r8), intent(out) :: dsfn (pcols,pver) !num tendency due to detrainment of snow
+
+ real(r8), intent(inout) :: lambdadpcu(pcols,pver) ! slope of cloud liquid size distr
+ real(r8), intent(inout) :: mudpcu(pcols,pver) ! width parameter of droplet size distr
+
real(r8) rd ! gas constant for dry air
real(r8) grav ! gravity
real(r8) cp ! heat capacity of dry air
@@ -2266,6 +2895,27 @@ subroutine cldprp(lchnk , &
real(r8) small
real(r8) mdt
+ ! Convective microphysics
+ real(r8) fice(pcols,pver) ! ice fraction in precip production
+ real(r8) tug(pcols,pver)
+
+ real(r8) totfrz(pcols)
+ real(r8) frz1(pcols,pver) ! rate of freezing
+ real(r8) frz (pcols,pver) ! rate of freezing
+ real(r8) pflxs(pcols,pverp) ! frozen precipitation flux thru layer
+ real(r8) dum, sdum
+
+ real(r8), parameter :: omsm=0.99999_r8 ! to prevent problems due to round off error
+ real(r8), parameter :: mu_min = 0.02_r8 ! minimum value of mu
+ real(r8), parameter :: t_homofrz = 233.15_r8 ! homogeneous freezing temperature
+ real(r8), parameter :: t_mphase = 40._r8 ! mixed phase temperature = tmelt-t_homofrz = 273.15K - 233.15K
+
+ integer jto(pcols) ! updraft plume old top
+ integer tmplel(pcols)
+
+ integer iter, itnum
+ integer m
+
integer khighest
integer klowest
integer kount
@@ -2273,8 +2923,86 @@ subroutine cldprp(lchnk , &
logical doit(pcols)
logical done(pcols)
+
!
!------------------------------------------------------------------------------
+ dsfm (:il2g,:) = 0._r8
+ dsfn (:il2g,:) = 0._r8
+ if (zm_microp) then
+ loc_microp_st%autolm(:il2g,:) = 0._r8
+ loc_microp_st%accrlm(:il2g,:) = 0._r8
+ loc_microp_st%bergnm(:il2g,:) = 0._r8
+ loc_microp_st%fhtimm(:il2g,:) = 0._r8
+ loc_microp_st%fhtctm(:il2g,:) = 0._r8
+ loc_microp_st%fhmlm (:il2g,:) = 0._r8
+ loc_microp_st%hmpim (:il2g,:) = 0._r8
+ loc_microp_st%accslm(:il2g,:) = 0._r8
+ loc_microp_st%dlfm (:il2g,:) = 0._r8
+
+ loc_microp_st%autoln(:il2g,:) = 0._r8
+ loc_microp_st%accrln(:il2g,:) = 0._r8
+ loc_microp_st%bergnn(:il2g,:) = 0._r8
+ loc_microp_st%fhtimn(:il2g,:) = 0._r8
+ loc_microp_st%fhtctn(:il2g,:) = 0._r8
+ loc_microp_st%fhmln (:il2g,:) = 0._r8
+ loc_microp_st%accsln(:il2g,:) = 0._r8
+ loc_microp_st%activn(:il2g,:) = 0._r8
+ loc_microp_st%dlfn (:il2g,:) = 0._r8
+
+ loc_microp_st%autoim(:il2g,:) = 0._r8
+ loc_microp_st%accsim(:il2g,:) = 0._r8
+ loc_microp_st%difm (:il2g,:) = 0._r8
+
+
+ loc_microp_st%nuclin(:il2g,:) = 0._r8
+ loc_microp_st%autoin(:il2g,:) = 0._r8
+ loc_microp_st%accsin(:il2g,:) = 0._r8
+ loc_microp_st%hmpin (:il2g,:) = 0._r8
+ loc_microp_st%difn (:il2g,:) = 0._r8
+
+ loc_microp_st%trspcm(:il2g,:) = 0._r8
+ loc_microp_st%trspcn(:il2g,:) = 0._r8
+ loc_microp_st%trspim(:il2g,:) = 0._r8
+ loc_microp_st%trspin(:il2g,:) = 0._r8
+
+ do k = 1,pver
+ do i = 1,il2g
+ loc_microp_st%accgrm(i,k) = 0._r8
+ loc_microp_st%accglm(i,k) = 0._r8
+ loc_microp_st%accgslm(i,k)= 0._r8
+ loc_microp_st%accgsrm(i,k)= 0._r8
+ loc_microp_st%accgirm(i,k)= 0._r8
+ loc_microp_st%accgrim(i,k)= 0._r8
+ loc_microp_st%accgrsm(i,k)= 0._r8
+
+ loc_microp_st%accgsln(i,k)= 0._r8
+ loc_microp_st%accgsrn(i,k)= 0._r8
+ loc_microp_st%accgirn(i,k)= 0._r8
+
+ loc_microp_st%accsrim(i,k)= 0._r8
+ loc_microp_st%acciglm(i,k)= 0._r8
+ loc_microp_st%accigrm(i,k)= 0._r8
+ loc_microp_st%accsirm(i,k)= 0._r8
+
+ loc_microp_st%accigln(i,k)= 0._r8
+ loc_microp_st%accigrn(i,k)= 0._r8
+ loc_microp_st%accsirn(i,k)= 0._r8
+ loc_microp_st%accgln(i,k) = 0._r8
+ loc_microp_st%accgrn(i,k) = 0._r8
+
+ loc_microp_st%accilm(i,k) = 0._r8
+ loc_microp_st%acciln(i,k) = 0._r8
+
+ loc_microp_st%fallrm(i,k) = 0._r8
+ loc_microp_st%fallsm(i,k) = 0._r8
+ loc_microp_st%fallgm(i,k) = 0._r8
+ loc_microp_st%fallrn(i,k) = 0._r8
+ loc_microp_st%fallsn(i,k) = 0._r8
+ loc_microp_st%fallgn(i,k) = 0._r8
+ loc_microp_st%fhmrm (i,k) = 0._r8
+ end do
+ end do
+ end if
!
do i = 1,il2g
ftemp(i) = 0._r8
@@ -2331,6 +3059,33 @@ subroutine cldprp(lchnk , &
hu(i,k) = hmn(i,k)
hd(i,k) = hmn(i,k)
rprd(i,k) = 0._r8
+ ! Convective microphysics
+ sprd(i,k) = 0._r8
+ fice(i,k) = 0._r8
+ tug(i,k) = 0._r8
+ qcde(i,k) = 0._r8
+ qide(i,k) = 0._r8
+ qsde(i,k) = 0._r8
+ ncde(i,k) = 0._r8
+ nide(i,k) = 0._r8
+ nsde(i,k) = 0._r8
+ frz(i,k) = 0._r8
+ frz1(i,k) = 0._r8
+ if (zm_microp) then
+ loc_microp_st%cmel(i,k) = 0._r8
+ loc_microp_st%cmei(i,k) = 0._r8
+ loc_microp_st%wu(i,k) = 0._r8
+ loc_microp_st%qliq(i,k) = 0._r8
+ loc_microp_st%qice(i,k) = 0._r8
+ loc_microp_st%qrain(i,k)= 0._r8
+ loc_microp_st%qsnow(i,k)= 0._r8
+ loc_microp_st%qgraupel(i,k) = 0._r8
+ loc_microp_st%qnl(i,k) = 0._r8
+ loc_microp_st%qni(i,k) = 0._r8
+ loc_microp_st%qnr(i,k) = 0._r8
+ loc_microp_st%qns(i,k) = 0._r8
+ loc_microp_st%qng(i,k) = 0._r8
+ end if
end do
end do
!
@@ -2377,6 +3132,7 @@ subroutine cldprp(lchnk , &
!jr changed hard-wired 4 to limcnv+1 (not to exceed pver)
!
jt(:) = pver
+ jto(:)= pver
do i = 1,il2g
jt(i) = max(lel(i),limcnv+1)
jt(i) = min(jt(i),pver)
@@ -2410,8 +3166,20 @@ subroutine cldprp(lchnk , &
do k = msg + 1,pver
do i = 1,il2g
if (k >= jt(i) .and. k <= jb(i)) then
- hu(i,k) = hmn(i,mx(i)) + cp*(tiedke_add+tp_fac*tpertg(i)) !PMA
- su(i,k) = s(i,mx(i)) + tiedke_add+tp_fac*tpertg(i)
+ ! Tunable temperature perturbation (tiedke_add) was already added to parcel hu/su to
+ ! represent subgrid temperature perturbation. If PBL temperature perturbation (tpert)
+ ! is used to represent subgrid temperature perturbation, tiedke_add may need to be
+ ! removed. In addition, current calculation of PBL temperature perturbation is not
+ ! accurate enough so that a new tunable parameter tp_fac was introduced. This introduced
+ ! new uncertainties into the ZM scheme. The original code of ZM scheme will be used
+ ! when tpert_fix=.true.
+ if(tpert_fix) then
+ hu(i,k) = hmn(i,mx(i)) + cp*tiedke_add
+ su(i,k) = s(i,mx(i)) + tiedke_add
+ else
+ hu(i,k) = hmn(i,mx(i)) + cp*(tiedke_add+tp_fac*tpertg(i))
+ su(i,k) = s(i,mx(i)) + tiedke_add+tp_fac*tpertg(i)
+ end if
end if
end do
end do
@@ -2507,6 +3275,27 @@ subroutine cldprp(lchnk , &
if (k < j0(i) .and. k >= jt(i)) eps(i,k) = f(i,k)
end do
end do
+
+
+ itnum = 1
+ if (zm_microp) itnum = 2
+
+ do iter=1, itnum
+
+ do k = pver,msg + 1,-1
+ do i = 1,il2g
+ cu(i,k) = 0._r8
+ if (zm_microp) loc_microp_st%qliq(i,k) = 0._r8
+ if (zm_microp) loc_microp_st%qice(i,k) = 0._r8
+ ql(i,k) = 0._r8
+ frz1(i,k) = 0._r8
+ end do
+ end do
+ do i = 1,il2g
+ totpcp(i) = 0._r8
+ if (zm_microp) hu(i,jb(i)) = hmn(i,jb(i)) + cp*tiedke_add
+ end do
+
!
! specify the updraft mass flux mu, entrainment eu, detrainment du
! and moist static energy hu.
@@ -2517,10 +3306,15 @@ subroutine cldprp(lchnk , &
mu(i,jb(i)) = 1._r8
eu(i,jb(i)) = mu(i,jb(i))/dz(i,jb(i))
end if
+ if (zm_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 >= jt(i) .and. k < jb(i))) then
+ 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)
@@ -2546,8 +3340,13 @@ subroutine cldprp(lchnk , &
eu(i,k) = 0._r8
du(i,k) = mu(i,k+1)/dz(i,k)
else
- hu(i,k) = mu(i,k+1)/mu(i,k)*hu(i,k+1) + &
+ if (zm_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
@@ -2559,11 +3358,15 @@ subroutine cldprp(lchnk , &
!
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) .and. hu(i,k+1) > hsthat(i,k+1) .and. mu(i,k) >= mu_min) then
if (hu(i,k)-hsthat(i,k) < -2000._r8) then
jt(i) = k + 1
doit(i) = .false.
@@ -2571,13 +3374,18 @@ subroutine cldprp(lchnk , &
jt(i) = k
doit(i) = .false.
end if
- else if (hu(i,k) > hu(i,jb(i)) .or. mu(i,k) < 0.02_r8) then
+ else if ( (hu(i,k) > hu(i,jb(i)) .and. totfrz(i)<=0._r8) .or. mu(i,k) < mu_min) then
jt(i) = k + 1
doit(i) = .false.
end if
end if
end do
end do
+
+ do i = 1,il2g
+ if (iter == 1) jto(i) = jt(i)
+ end do
+
do k = pver,msg + 1,-1
do i = 1,il2g
if (k >= lel(i) .and. k <= jt(i) .and. eps0(i) > 0._r8) then
@@ -2593,63 +3401,6 @@ subroutine cldprp(lchnk , &
end if
end do
end do
-
-! 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
-!
- alfa(i) = alfa_scalar
- 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)
- 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)))
- end if
- end do
- end do
!
do i = 1,il2g
done(i) = .false.
@@ -2688,18 +3439,123 @@ subroutine cldprp(lchnk , &
end do
end do
+ do i = 1,il2g
+ if (zm_microp) then
+ tmplel(i) = jlcl(i)+1
+ else
+ tmplel(i) = jb(i)
+ end if
+ end do
+
! compute condensation in updraft
do k = pver,msg + 2,-1
do i = 1,il2g
- if (k >= jt(i) .and. k < jb(i) .and. eps0(i) > 0._r8) then
+ if (k >= jt(i) .and. k < tmplel(i) .and. eps0(i) > 0._r8) then
+ if (zm_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) &
+ - latice*frz(i,k)/rl
+ else
+
cu(i,k) = ((mu(i,k)*su(i,k)-mu(i,k+1)*su(i,k+1))/ &
dz(i,k)- (eu(i,k)-du(i,k))*s(i,k))/(rl/cp)
+ 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 (zm_microp) then
+
+ tug(:il2g,:) = t(:il2g,:)
+ fice(:,:) = 0._r8
+
+ do k = pver, msg+2, -1
+ do i = 1, il2g
+ tug(i,k) = su(i,k) - grav/cp*zf(i,k)
+ end do
+ end do
+ do k = 1, pver-1
+ do i = 1, il2g
+
+ if (tug(i,k+1) > tmelt) then
+ ! If warmer than tmelt then water phase
+ fice(i,k) = 0._r8
+
+ else if (tug(i,k+1) < t_homofrz) then
+ ! If colder than t_homofrz then ice phase
+ fice(i,k) = 1._r8
+
+ else
+ ! Otherwise mixed phase, with ice fraction decreasing linearly
+ ! from t_homofrz to tmelt
+ fice(i,k) =(tmelt - tug(i,k+1)) / t_mphase
+ end if
+ end do
+ end do
+
+ do k = 1, pver
+ do i = 1,il2g
+ loc_microp_st%cmei(i,k) = cu(i,k)* fice(i,k)
+ loc_microp_st%cmel(i,k) = cu(i,k) * (1._r8-fice(i,k))
+ end do
+ end do
+
+ call zm_mphy(su, qu, mu, du, eu, loc_microp_st%cmel, loc_microp_st%cmei, zf, p, &
+ t, q, eps0, jb, jt, jlcl, msg, il2g, grav, cp, rd, aero, gamhat, &
+ loc_microp_st%qliq, loc_microp_st%qice, loc_microp_st%qnl, loc_microp_st%qni, &
+ qcde, qide, ncde, nide, rprd, sprd, frz, loc_microp_st%wu, loc_microp_st%qrain, &
+ loc_microp_st%qsnow, loc_microp_st%qnr, loc_microp_st%qns, loc_microp_st%qgraupel, &
+ loc_microp_st%qng, qsde, nsde, loc_microp_st%autolm, loc_microp_st%accrlm, &
+ loc_microp_st%bergnm, loc_microp_st%fhtimm, loc_microp_st%fhtctm, loc_microp_st%fhmlm, &
+ loc_microp_st%hmpim, loc_microp_st%accslm, loc_microp_st%dlfm, loc_microp_st%autoln, &
+ loc_microp_st%accrln, loc_microp_st%bergnn, loc_microp_st%fhtimn, loc_microp_st%fhtctn, &
+ loc_microp_st%fhmln, loc_microp_st%accsln, loc_microp_st%activn, loc_microp_st%dlfn, &
+ loc_microp_st%autoim, loc_microp_st%accsim, loc_microp_st%difm, loc_microp_st%nuclin, &
+ loc_microp_st%autoin, loc_microp_st%accsin, loc_microp_st%hmpin, loc_microp_st%difn, &
+ loc_microp_st%trspcm, loc_microp_st%trspcn, loc_microp_st%trspim, loc_microp_st%trspin, &
+ lambdadpcu, mudpcu, &
+ loc_microp_st%accgrm, loc_microp_st%accglm, loc_microp_st%accgslm,loc_microp_st%accgsrm, &
+ loc_microp_st%accgirm,loc_microp_st%accgrim,loc_microp_st%accgrsm,loc_microp_st%accgsln, &
+ loc_microp_st%accgsrn,loc_microp_st%accgirn,loc_microp_st%accsrim,loc_microp_st%acciglm, &
+ loc_microp_st%accigrm,loc_microp_st%accsirm,loc_microp_st%accigln,loc_microp_st%accigrn, &
+ loc_microp_st%accsirn,loc_microp_st%accgln ,loc_microp_st%accgrn ,loc_microp_st%accilm , &
+ loc_microp_st%acciln ,loc_microp_st%fallrm ,loc_microp_st%fallsm ,loc_microp_st%fallgm , &
+ loc_microp_st%fallrn ,loc_microp_st%fallsn ,loc_microp_st%fallgn ,loc_microp_st%fhmrm , &
+ dsfm, dsfn, auto_fac, accr_fac, micro_dcs)
+
+
+ do k = pver,msg + 2,-1
+ do i = 1,il2g
+ ! In the original ZM scheme, which does not consider ice phase, ql actually represents total cloud
+ ! water. With convective microphysics, loc_microp_st%qliq and loc_microp_st%qice represent cloud
+ ! liquid water and cloud ice, respectively. Since ql is still used in other subroutines as total
+ ! cloud water, here ql is calculated as total cloud water for consistency.
+ ql(i,k) = loc_microp_st%qliq(i,k)+ loc_microp_st%qice(i,k)
+ frz1(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
+ frz1(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)+qide(i,k+1)+qsde(i,k+1) ))
+ end if
+ end do
+ end do
+
+ else ! no microphysics
+
! compute condensed liquid, rain production rate
! accumulate total precipitation (condensation - detrainment of liquid)
! Note ql1 = ql(k) + rprd(k)*dz(k)/mu(k)
@@ -2707,8 +3563,8 @@ subroutine cldprp(lchnk , &
! consistently applied.
! mu, ql are interface quantities
! cu, du, eu, rprd are midpoint quantites
- do k = pver,msg + 2,-1
- do i = 1,il2g
+ 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
@@ -2720,6 +3576,75 @@ subroutine cldprp(lchnk , &
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)
+ ! reset convective microphysics variables
+ qcde(i,k) = ql(i,k)
+ qide(i,k) = 0._r8
+ qsde(i,k) = 0._r8
+ ncde(i,k) = 0._r8
+ nide(i,k) = 0._r8
+ nsde(i,k) = 0._r8
+ sprd(i,k) = 0._r8
+ frz1(i,k) = 0._r8
+ end if
+ end do
+ end do
+ end if ! zm_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
+!
+ alfa(i) = alfa_scalar
+ 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)
+ 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)))
end if
end do
end do
@@ -2736,6 +3661,7 @@ subroutine cldprp(lchnk , &
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 (zm_microp) evp(i,k) = min(evp(i,k),rprd(i,k))
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
totevp(i) = totevp(i) - dz(i,k)*ed(i,k)*q(i,k)
end if
@@ -2776,24 +3702,88 @@ subroutine cldprp(lchnk , &
! 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)
+ if (zm_microp) then
+ if (rprd(i,k)> 0._r8) then
+ frz1(i,k) = frz1(i,k)- evp(i,k)*min(1._r8,sprd(i,k)/rprd(i,k))
+ sprd(i,k) = sprd(i,k)- evp(i,k)*min(1._r8,sprd(i,k)/rprd(i,k))
+ end if
+ end if
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
+ if (zm_microp) pflxs(:,:) = 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)
+ if (zm_microp) pflxs(i,k) = pflxs(i,k-1) + sprd(i,k-1)*dz(i,k-1)
end do
end do
-!
+! protect against rounding error
+ if (zm_microp) then
+ do i = 1,il2g
+ if(pflxs(i,pverp).gt.pflx(i,pverp)) then
+ dum = (pflxs(i,pverp)-pflx(i,pverp))/omsm
+ do k = pver, msg+2, -1
+ if (sprd(i,k) > 0._r8 .and. dum > 0._r8) then
+ sdum = min(sprd(i,k),dum/dz(i,k))
+ sprd(i,k) = sprd(i,k)- sdum
+ frz1(i,k) = frz1(i,k)- sdum
+ dum = dum - sdum*dz(i,k)
+ end if
+ end do
+ end if
+ end do
+ end if
+
do k = msg + 1,pver
do i = 1,il2g
mc(i,k) = mu(i,k) + md(i,k)
end do
end do
!
+ do i = 1,il2g
+ if ( zm_microp .and. jt(i)>=jlcl(i)) then
+ do k = msg + 1,pver
+ mu(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
+ md(i,k) = 0._r8
+ ed(i,k) = 0._r8
+ mc(i,k) = 0._r8
+ rprd(i,k) = 0._r8
+ sprd(i,k) = 0._r8
+ fice(i,k) = 0._r8
+ qcde(i,k) = 0._r8
+ qide(i,k) = 0._r8
+ qsde(i,k) = 0._r8
+ ncde(i,k) = 0._r8
+ nide(i,k) = 0._r8
+ nsde(i,k) = 0._r8
+ frz(i,k) = 0._r8
+ frz1(i,k) = 0._r8
+ loc_microp_st%wu(i,k) = 0._r8
+ loc_microp_st%cmel(i,k) = 0._r8
+ loc_microp_st%cmei(i,k) = 0._r8
+ loc_microp_st%qliq(i,k) = 0._r8
+ loc_microp_st%qice(i,k) = 0._r8
+ loc_microp_st%qrain(i,k)= 0._r8
+ loc_microp_st%qsnow(i,k)= 0._r8
+ loc_microp_st%qgraupel(i,k) = 0._r8
+ loc_microp_st%qnl(i,k) = 0._r8
+ loc_microp_st%qni(i,k) = 0._r8
+ loc_microp_st%qnr(i,k) = 0._r8
+ loc_microp_st%qns(i,k) = 0._r8
+ loc_microp_st%qng(i,k) = 0._r8
+ end do
+ end if
+ end do
return
end subroutine cldprp
@@ -3007,6 +3997,7 @@ subroutine closure(lchnk , &
do i = il1g,il2g
dltaa = -1._r8* (cape(i)-capelmt)
if (dadt(i) /= 0._r8) mb(i) = max(dltaa/tau/dadt(i),0._r8)
+ if (zm_microp .and. mx(i)-jt(i) < 2._r8) mb(i) =0.0_r8
end do
!
return
@@ -3018,8 +4009,9 @@ subroutine q1q2_pjr(lchnk , &
mu ,md ,sd ,qd ,ql , &
dsubcld ,jt ,mx ,il1g ,il2g , &
cp ,rl ,msg , &
- dl ,evp ,cu )
-
+ dl ,evp ,cu ,qice ,dice , &
+ qnl ,qni ,dnl ,dni ,frz , &
+ qsde ,nsde ,dsnow ,dns )
implicit none
@@ -3061,8 +4053,25 @@ subroutine q1q2_pjr(lchnk , &
real(r8), intent(in) :: cu(pcols,pver)
real(r8), intent(in) :: dsubcld(pcols)
+ ! Convective microphysics
+ real(r8), intent(in) :: frz(pcols,pver)
+ real(r8), intent(in) :: qice(pcols,pver)
+ real(r8), intent(in) :: qnl(pcols,pver)
+ real(r8), intent(in) :: qni(pcols,pver)
+ real(r8), intent(in) :: qsde(pcols,pver)
+ real(r8), intent(in) :: nsde(pcols,pver)
+
real(r8),intent(out) :: dqdt(pcols,pver),dsdt(pcols,pver)
real(r8),intent(out) :: dl(pcols,pver)
+
+ ! Convective microphysics
+ real(r8),intent(out) :: dice(pcols,pver)
+ real(r8),intent(out) :: dnl(pcols,pver)
+ real(r8),intent(out) :: dni(pcols,pver)
+ real(r8),intent(out) :: dsnow(pcols,pver)
+ real(r8),intent(out) :: dns(pcols,pver)
+
+
integer kbm
integer ktm
integer jt(pcols)
@@ -3081,6 +4090,12 @@ subroutine q1q2_pjr(lchnk , &
dsdt(i,k) = 0._r8
dqdt(i,k) = 0._r8
dl(i,k) = 0._r8
+ ! Convective microphysics
+ dice(i,k) = 0._r8
+ dnl(i,k) = 0._r8
+ dni(i,k) = 0._r8
+ dsnow(i,k) = 0._r8
+ dns(i,k) = 0._r8
end do
end do
!
@@ -3105,6 +4120,8 @@ subroutine q1q2_pjr(lchnk , &
-md(i,k)* (sd(i,k)-shat(i,k)) &
)/dp(i,k)
+ if (zm_microp) dsdt(i,k) = dsdt(i,k) + latice/cp*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)) &
@@ -3113,6 +4130,13 @@ subroutine q1q2_pjr(lchnk , &
)/dp(i,k)
dl(i,k) = du(i,k)*ql(i,k+1)
+ if (zm_microp) then
+ dice(i,k) = du(i,k)*qice(i,k+1)
+ dnl(i,k) = du(i,k)*qnl(i,k+1)
+ dni(i,k) = du(i,k)*qni(i,k+1)
+ dsnow(i,k) = du(i,k)*qsde(i,k+1)
+ dns(i,k) = du(i,k)*nsde(i,k+1)
+ end if
end do
end do
@@ -3142,6 +4166,7 @@ subroutine q1q2_pjr(lchnk , &
return
end subroutine q1q2_pjr
+
subroutine buoyan_dilute(lchnk ,ncol , &! in
q_in ,t_in ,p ,z ,pf , &! in
tp ,qstp ,tl ,rl ,cape , &! rl = in, others = out
@@ -3150,6 +4175,7 @@ subroutine buoyan_dilute(lchnk ,ncol , &! in
tpert ,iclosure, &! in
dcapemx , use_input_parcel_tq_in, &! in, optional
q_mx ,t_mx )! in, optional
+
!-----------------------------------------------------------------------
!
! Purpose:
@@ -3227,7 +4253,6 @@ subroutine buoyan_dilute(lchnk ,ncol , &! in
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)
@@ -3335,7 +4360,6 @@ subroutine buoyan_dilute(lchnk ,ncol , &! in
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.
@@ -3419,8 +4443,8 @@ subroutine buoyan_dilute(lchnk ,ncol , &! in
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! DILUTE PLUME CALCULATION USING ENTRAINING PLUME !!!
!!! RBN 9/9/04 !!!
-
- call parcel_dilute(lchnk, ncol, msg, mx, p, t, q, tpert, tp, tpv, qstp, pl, tl, lcl)
+ call parcel_dilute(lchnk, ncol, msg, mx, p, t, q, tpert, pblt, tp, tpv, qstp, pl, tl, lcl)
+
! If lcl is above the nominal level of non-divergence (600 mbs),
! no deep convection is permitted (ensuing calculations
@@ -3453,7 +4477,6 @@ subroutine buoyan_dilute(lchnk ,ncol , &! in
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
!
do k = msg + 2,pver
do i = 1,ncol
@@ -3500,7 +4523,7 @@ subroutine buoyan_dilute(lchnk ,ncol , &! in
return
end subroutine buoyan_dilute
-subroutine parcel_dilute (lchnk, ncol, msg, klaunch, p, t, q, tpert, tp, tpv, qstp, pl, tl, lcl)
+subroutine parcel_dilute (lchnk, ncol, msg, klaunch, p, t, q, tpert, pblt, tp, tpv, qstp, pl, tl, lcl)
! Routine to determine
! 1. Tp - Parcel temperature
! 2. qstp - Saturated mixing ratio at the parcel temperature.
@@ -3519,6 +4542,7 @@ subroutine parcel_dilute (lchnk, ncol, msg, klaunch, p, t, q, tpert, tp, tpv, qs
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(in), dimension(pcols) :: pblt ! index of pbl depth
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).
@@ -3554,6 +4578,8 @@ subroutine parcel_dilute (lchnk, ncol, msg, klaunch, p, t, q, tpert, tp, tpv, qs
real(r8) qtp0(pcols) ! Parcel launch total water.
real(r8) mp0(pcols) ! Parcel launch relative mass flux.
+real(r8) tpertg(pcols)
+
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).
@@ -3616,6 +4642,18 @@ subroutine parcel_dilute (lchnk, ncol, msg, klaunch, p, t, q, tpert, tp, tpv, qs
new_q = 0._r8
new_s = 0._r8
+
+! The original ZM scheme only treats PBL-rooted convection. PBL temperature perturbation (tpert) was
+! used to increase the parcel temperatue at launch level, which is in PBL.
+! The dcape_ull or ull triggr enables ZM scheme to treat elevated convection with launch level above PBL.
+! If parcel launch level is above PBL top, tempeature perturbation in PBL should not be able to influence
+! it. In this situation, the temporary varaible tpertg is reset to zero.
+do i=1,ncol
+ tpertg(i)=tpert(i)
+ if ( tpert_fix .and. klaunch(i)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, trigdcape_ull, trig_dcape_only
+ use zm_conv, only: zm_microp
+ use zm_microphysics, only: zm_aero_t, zm_microp_st
+ 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 cam_history, only: outfld, addfld, horiz_only, add_default
use perf_mod
- use cam_logfile, only: iulog
-
+ use cam_logfile, only: iulog
+ use zm_conv, only: MCSP, MCSP_heat_coeff, MCSP_moisture_coeff, MCSP_uwind_coeff, MCSP_vwind_coeff
+
implicit none
private
save
@@ -37,6 +50,12 @@ module zm_conv_intr
dp_flxsnw_idx, &
dp_cldliq_idx, &
dp_cldice_idx, &
+ dlfzm_idx, & ! detrained convective cloud water mixing ratio.
+ difzm_idx, & ! detrained convective cloud ice mixing ratio.
+ dsfzm_idx, & ! detrained convective snow mixing ratio.
+ dnlfzm_idx, & ! detrained convective cloud water num concen.
+ dnifzm_idx, & ! detrained convective cloud ice num concen.
+ dnsfzm_idx, & ! detrained convective snow num concen.
prec_dp_idx, &
snow_dp_idx
@@ -54,6 +73,20 @@ module zm_conv_intr
logical :: convproc_do_gas
logical :: clim_modal_aero
+ integer :: dgnum_idx = 0
+ integer :: lambdadpcu_idx = 0
+ integer :: mudpcu_idx = 0
+ integer :: icimrdp_idx = 0
+
+
+ logical :: old_snow = .true. ! set true to use old estimate of snow production in zm_conv_evap
+ ! set false to use snow production from zm
+ ! microphysics
+ integer :: nmodes
+ integer :: nbulk
+
+ type(zm_aero_t), allocatable :: aero(:) ! object contains information about the aerosols
+
!=========================================================================================
contains
!=========================================================================================
@@ -88,10 +121,30 @@ subroutine zm_conv_register
if (trigdcape_ull .or. trig_dcape_only) then
! temperature from physics in n-1 time step
call pbuf_add_field('T_STAR','global',dtype_r8,(/pcols,pver/), t_star_idx)
- ! moisturetendency from physics in n-1 time step
+ ! moisturetendency from physics in n-1 time step
call pbuf_add_field('Q_STAR','global',dtype_r8,(/pcols,pver/), q_star_idx)
endif
+
+ ! 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 (zm_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)
+ ! detrained convective snow num concen.
+ call pbuf_add_field('DNSFZM', 'physpkg', dtype_r8, (/pcols,pver/), dnsfzm_idx)
+ ! detrained convective snow mixing ratio.
+ call pbuf_add_field('DSFZM', 'physpkg', dtype_r8, (/pcols,pver/), dsfzm_idx)
+
+ end if
+
! Variables for dCAPE diagnosis and decomposition
call dcape_diags_register( pcols )
@@ -115,6 +168,8 @@ subroutine zm_conv_init(pref_edge)
use phys_control, only: phys_deepconv_pbl, phys_getopts, cam_physpkg_is
use physics_buffer, only: pbuf_get_index
use rad_constituents, only: rad_cnst_get_info
+ use zm_microphysics, only: zm_mphyi
+
implicit none
@@ -128,7 +183,18 @@ subroutine zm_conv_init(pref_edge)
! temperature, water vapor, cloud ice and cloud
! liquid budgets.
integer :: history_budget_histfile_num ! output history file number for budget fields
- integer :: nmodes
+
+! integer :: nmodes
+
+ ! Aerosols
+ integer :: i
+ character(len=*), parameter :: routine = 'zm_conv_init'
+
+! 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
@@ -160,6 +226,7 @@ subroutine zm_conv_init(pref_edge)
call addfld ('MAXI',horiz_only , 'A','level' ,'model level of launching parcel')
call addfld ('CAPE_ZM',horiz_only, 'A', 'J/kg', 'Convectively available potential energy')
+ call addfld ('DCAPE', horiz_only, 'A', 'J/kg', 'change rate of 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')
@@ -178,6 +245,143 @@ subroutine zm_conv_init(pref_edge)
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')
+
+ if (MCSP) then
+ call addfld ('MCSP_DT',(/ 'lev' /), 'A','K/s','T tedency due to MCSP')
+ call addfld ('MCSP_freq',horiz_only, 'A','1','frequency of MCSP activated')
+ call addfld ('MCSP_DU',(/ 'lev' /), 'A','m/s/day','U tedency due to MCSP')
+ call addfld ('MCSP_DV',(/ 'lev' /), 'A','m/s/day','V tedency due to MCSP')
+ call addfld ('ZM_freq',horiz_only, 'A','1','frequency for ZM to be activated')
+ call addfld ('ZM_depth',horiz_only,'A','Pa','ZM depth')
+ call addfld ('MCSP_shear',horiz_only,'A','m/s','vertical zonal wind shear')
+ end if
+
+
+
+ if (zm_microp) then
+
+ 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 ('QGRAPZM' ,(/ 'lev' /), 'A', 'g/m3', 'graupel - 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 ('CGRAPNUM',(/ 'lev' /), 'A', '1' , 'Cloud graupel sample number -ZM convection')
+
+ 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')
+ 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 ('QNGZM',(/ 'lev' /), 'A','1/m3' , 'Cloud graupel number concen -ZM convection')
+
+ call addfld ('FRZZM',(/ 'lev' /), 'A','K/s' , 'heating 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/s' , '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 addfld ('ACCGR_M' ,(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency due to collection of rain by graupel')
+ call addfld ('ACCGL_M' ,(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency due to collection of droplets by graupel')
+ call addfld ('ACCGSL_M',(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of graupel due to collection of droplets by snow')
+ call addfld ('ACCGSR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of graupel due to collection of rain by snow')
+ call addfld ('ACCGIR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of graupel due to collection of rain by ice')
+ call addfld ('ACCGRI_M',(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of graupel due to collection of ice by rain')
+ call addfld ('ACCGRS_M',(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of graupel due to collection of snow by rain')
+
+ call addfld ('ACCGSL_N',(/ 'lev' /), 'A', '1/kg/m' , 'num tendency of graupel due to collection of droplets by snow')
+ call addfld ('ACCGSR_N',(/ 'lev' /), 'A', '1/kg/m' , 'num tendency of graupel due to collection of rain by snow')
+ call addfld ('ACCGIR_N',(/ 'lev' /), 'A', '1/kg/m' , 'num tendency of graupel due to collection of rain by ice')
+
+ call addfld ('ACCSRI_M',(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of snow due to collection of ice by rain')
+ call addfld ('ACCIGL_M',(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of ice mult(splintering) due to acc droplets by graupel')
+ call addfld ('ACCIGR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of ice mult(splintering) due to acc rain by graupel')
+ call addfld ('ACCSIR_M',(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of snow due to collection of rain by ice')
+
+ call addfld ('ACCIGL_N',(/ 'lev' /), 'A', '1/kg/m' , 'num tendency of ice mult(splintering) due to acc droplets by graupel')
+ call addfld ('ACCIGR_N',(/ 'lev' /), 'A', '1/kg/m' , 'num tendency of ice mult(splintering) due to acc rain by graupel')
+ call addfld ('ACCSIR_N',(/ 'lev' /), 'A', '1/kg/m' , 'num tendency of snow due to collection of rain by ice')
+ call addfld ('ACCGL_N' ,(/ 'lev' /), 'A', '1/kg/m' , 'num tendency due to collection of droplets by graupel')
+ call addfld ('ACCGR_N' ,(/ 'lev' /), 'A', '1/kg/m' , 'num tendency due to collection of rain by graupel')
+ call addfld ('ACCIL_M' ,(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of cloud ice due to collection of droplet by cloud ice')
+ call addfld ('ACCIL_N' ,(/ 'lev' /), 'A', '1/kg/m' , 'num tendency of cloud ice due to collection of droplet by cloud ice')
+
+ call addfld ('FALLR_M' ,(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of rain fallout')
+ call addfld ('FALLS_M' ,(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of snow fallout')
+ call addfld ('FALLG_M' ,(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency of graupel fallout')
+ call addfld ('FALLR_N' ,(/ 'lev' /), 'A', '1/kg/m' , 'num tendency of rain fallout')
+ call addfld ('FALLS_N' ,(/ 'lev' /), 'A', '1/kg/m' , 'num tendency of snow fallout')
+ call addfld ('FALLG_N' ,(/ 'lev' /), 'A', '1/kg/m' , 'num tendency of graupel fallout')
+ call addfld ('FHMR_M' ,(/ 'lev' /), 'A', 'kg/kg/m', 'mass tendency due to homogeneous freezing of rain')
+
+ call addfld ('PRECZ_SN',horiz_only , 'A', '#' , 'sample num of convective precipitation rate from ZM deep')
+
+ call add_default ('CLDLIQZM', 1, ' ')
+ call add_default ('CLDICEZM', 1, ' ')
+ call add_default ('CLIQSNUM', 1, ' ')
+ call add_default ('CICESNUM', 1, ' ')
+ call add_default ('DIFZM', 1, ' ')
+ call add_default ('DLFZM', 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 ('QGRAPZM', 1, ' ')
+ call add_default ('CRAINNUM', 1, ' ')
+ call add_default ('CSNOWNUM', 1, ' ')
+ call add_default ('CGRAPNUM', 1, ' ')
+ call add_default ('QNLZM', 1, ' ')
+ call add_default ('QNIZM', 1, ' ')
+ call add_default ('QNRZM', 1, ' ')
+ call add_default ('QNSZM', 1, ' ')
+ call add_default ('QNGZM', 1, ' ')
+ call add_default ('FRZZM', 1, ' ')
+
+ end if
+
+
call phys_getopts( history_budget_out = history_budget, &
history_budget_histfile_num_out = history_budget_histfile_num, &
@@ -237,13 +441,188 @@ subroutine zm_conv_init(pref_edge)
prec_dp_idx = pbuf_get_index('PREC_DP')
snow_dp_idx = pbuf_get_index('SNOW_DP')
+ lambdadpcu_idx = pbuf_get_index('LAMBDADPCU')
+ mudpcu_idx = pbuf_get_index('MUDPCU')
+ icimrdp_idx = pbuf_get_index('ICIMRDP')
+
+ ! Initialization for the microphysics
+ if (zm_microp) then
+
+ call zm_mphyi()
+
+ ! if zmconv_microp not enabled then use old estimate of snow production in
+ ! zm_conv_evap
+ old_snow = .false.
+
+ ! 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) then
+
+ ! This call is needed to allow running the ZM microphysics with the
+ ! cam4 physics package.
+ call ndrop_bam_init()
+
+ end if
+
+ end if ! zmconv_microp
+
+ !-------------------------------------------------------------------------------------
+ contains
+ !-------------------------------------------------------------------------------------
+
+ subroutine zm_aero_init(nmodes, nbulk, aero)
+
+ ! 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
+
+ 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
+
end subroutine zm_conv_init
!=========================================================================================
!subroutine zm_conv_tend(state, ptend, tdt)
subroutine zm_conv_tend(pblh ,mcon ,cme , &
- tpert ,dlf ,pflx ,zdu , &
- rliq , &
+ tpert ,dlftot ,pflx ,zdu , &
+ rliq ,rice ,&
ztodt , &
jctop ,jcbot , &
state ,ptend_all ,landfrac, pbuf, mu, eu, &
@@ -262,10 +641,12 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
use constituents, only: pcnst, cnst_get_ind, cnst_is_convtran1
use physconst, only: gravit
use phys_control, only: cam_physpkg_is
+ use time_manager, only: get_curr_date
+ use interpolate_data, only: vertinterp
- ! Arguments
- type(physics_state), intent(in ) :: state ! Physics state variables
+ ! Arguments
+ type(physics_state), target, intent(in ) :: state ! Physics state variables
type(physics_ptend), intent(out) :: ptend_all ! individual parameterization tendencies
type(physics_buffer_desc), pointer :: pbuf(:)
@@ -275,12 +656,13 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
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) :: dlf(pcols,pver) ! scattrd version of the detraining cld h2o tend
+ real(r8), intent(out) :: dlftot(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) ! 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
real(r8), intent(out):: mu(pcols,pver)
real(r8), intent(out):: eu(pcols,pver)
real(r8), intent(out):: du(pcols,pver)
@@ -305,7 +687,9 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
! Local variables
- integer :: i,k,m
+ type(zm_microp_st) :: microp_st
+
+ integer :: i,k,l,m
integer :: ilon ! global longitude index of a column
integer :: ilat ! global latitude index of a column
integer :: nstep
@@ -323,8 +707,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
! physics types
type(physics_state) :: state1 ! locally modify for evaporation to use, not returned
- type(physics_ptend) :: ptend_loc ! package tendencies
-
+ 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
@@ -344,6 +727,16 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
real(r8) :: dcape(pcols) ! dynamical cape
real(r8) :: maxgsav(pcols) ! tmp array for recording and outfld to MAXI
+ real(r8), pointer :: dlf(:,:) ! detrained convective cloud water mixing ratio.
+ real(r8), pointer :: dif(:,:) ! detrained convective cloud ice mixing ratio.
+ real(r8), pointer :: dsf(:,:) ! detrained convective snow 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 :: dnsf(:,:) ! detrained convective snow 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 :: qi(:,:) ! wg grid slice of cloud ice.
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.
@@ -369,6 +762,137 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
logical :: lq(pcnst)
+ real(r8) :: alpha2, alpha_moisture, alphau, alphav, top, bottom
+ real(r8) :: Q_dis(pcols), Qc_adjust, Qq_dis(pcols), Qcq_adjust
+ real(r8) :: Qm(pcols,pver), Qmq(pcols,pver), Qmu(pcols,pver), Qmv(pcols,pver)
+ real(r8) :: Qc_int_start(pcols), Qcq_int_start(pcols)
+ real(r8) :: Qm_int_end(pcols), Qmq_int_end(pcols), Pa_int_end(pcols)
+ real(r8) :: Qs_zmconv(pcols), Qv_zmconv(pcols)
+
+ real(r8) :: MCSP_freq(pcols), MCSP_DT(pcols,pver)
+ real(r8) :: ZM_depth(pcols), MCSP_shear(pcols)
+ real(r8) :: du600(pcols), dv600(pcols)
+ integer :: iyr, imon, iday, isec
+
+ logical :: doslop
+ logical :: doslop_heat
+ logical :: doslop_moisture
+ logical :: doslop_uwind
+ logical :: doslop_vwind
+
+
+ real(r8) :: sprd(pcols,pver)
+ real(r8) :: frz(pcols,pver)
+ real(r8) precz_snum(pcols)
+
+
+ if (zm_microp) then
+ allocate( &
+ microp_st%wu(pcols,pver), & ! vertical velocity
+ microp_st%qliq(pcols,pver), & ! convective cloud liquid water.
+ microp_st%qice(pcols,pver), & ! convective cloud ice.
+ microp_st%qrain(pcols,pver), & ! convective rain water.
+ microp_st%qsnow(pcols,pver), & ! convective snow.
+ microp_st%qgraupel(pcols,pver),& ! convective graupel
+ microp_st%qnl(pcols,pver), & ! convective cloud liquid water num concen.
+ microp_st%qni(pcols,pver), & ! convective cloud ice num concen.
+ microp_st%qnr(pcols,pver), & ! convective rain water num concen.
+ microp_st%qns(pcols,pver), & ! convective snow num concen.
+ microp_st%qng(pcols,pver), & ! convective graupel num concen.
+ microp_st%autolm(pcols,pver), & !mass tendency due to autoconversion of droplets to rain
+ microp_st%accrlm(pcols,pver), & !mass tendency due to accretion of droplets by rain
+ microp_st%bergnm(pcols,pver), & !mass tendency due to Bergeron process
+ microp_st%fhtimm(pcols,pver), & !mass tendency due to immersion freezing
+ microp_st%fhtctm(pcols,pver), & !mass tendency due to contact freezing
+ microp_st%fhmlm (pcols,pver), & !mass tendency due to homogeneous freezing
+ microp_st%hmpim (pcols,pver), & !mass tendency due to HM process
+ microp_st%accslm(pcols,pver), & !mass tendency due to accretion of droplets by snow
+ microp_st%dlfm (pcols,pver), & !mass tendency due to detrainment of droplet
+ microp_st%autoln(pcols,pver), & !num tendency due to autoconversion of droplets to rain
+ microp_st%accrln(pcols,pver), & !num tendency due to accretion of droplets by rain
+ microp_st%bergnn(pcols,pver), & !num tendency due to Bergeron process
+ microp_st%fhtimn(pcols,pver), & !num tendency due to immersion freezing
+ microp_st%fhtctn(pcols,pver), & !num tendency due to contact freezing
+ microp_st%fhmln (pcols,pver), & !num tendency due to homogeneous freezing
+ microp_st%accsln(pcols,pver), & !num tendency due to accretion of droplets by snow
+ microp_st%activn(pcols,pver), & !num tendency due to droplets activation
+ microp_st%dlfn (pcols,pver), & !num tendency due to detrainment of droplet
+ microp_st%autoim(pcols,pver), & !mass tendency due to autoconversion of cloud ice to snow
+ microp_st%accsim(pcols,pver), & !mass tendency due to accretion of cloud ice by snow
+ microp_st%difm (pcols,pver), & !mass tendency due to detrainment of cloud ice
+ microp_st%nuclin(pcols,pver), & !num tendency due to ice nucleation
+ microp_st%autoin(pcols,pver), & !num tendency due to autoconversion of cloud ice to snow
+ microp_st%accsin(pcols,pver), & !num tendency due to accretion of cloud ice by snow
+ microp_st%hmpin (pcols,pver), & !num tendency due to HM process
+ microp_st%difn (pcols,pver), & !num tendency due to detrainment of cloud ice
+ microp_st%cmel (pcols,pver), & !mass tendency due to condensation
+ microp_st%cmei (pcols,pver), & !mass tendency due to deposition
+ microp_st%trspcm(pcols,pver), & !LWC tendency due to convective transport
+ microp_st%trspcn(pcols,pver), & !droplet num tendency due to convective transport
+ microp_st%trspim(pcols,pver), & !IWC tendency due to convective transport
+ microp_st%trspin(pcols,pver), & !ice crystal num tendency due to convective transport
+ microp_st%accgrm(pcols,pver), & ! mass tendency due to collection of rain by graupel
+ microp_st%accglm(pcols,pver), & ! mass tendency due to collection of droplets by graupel
+ microp_st%accgslm(pcols,pver), & ! mass tendency of graupel due to collection of droplets by snow
+ microp_st%accgsrm(pcols,pver), & ! mass tendency of graupel due to collection of rain by snow
+ microp_st%accgirm(pcols,pver), & ! mass tendency of graupel due to collection of rain by ice
+ microp_st%accgrim(pcols,pver), & ! mass tendency of graupel due to collection of ice by rain
+ microp_st%accgrsm(pcols,pver), & ! mass tendency due to collection of snow by rain
+ microp_st%accgsln(pcols,pver), & ! num tendency of graupel due to collection of droplets by snow
+ microp_st%accgsrn(pcols,pver), & ! num tendency of graupel due to collection of rain by snow
+ microp_st%accgirn(pcols,pver), & ! num tendency of graupel due to collection of rain by ice
+ microp_st%accsrim(pcols,pver), & ! mass tendency of snow due to collection of ice by rain
+ microp_st%acciglm(pcols,pver), & ! mass tendency of ice mult(splintering) due to acc droplets by graupel
+ microp_st%accigrm(pcols,pver), & ! mass tendency of ice mult(splintering) due to acc rain by graupel
+ microp_st%accsirm(pcols,pver), & ! mass tendency of snow due to collection of rain by ice
+ microp_st%accigln(pcols,pver), & ! num tendency of ice mult(splintering) due to acc droplets by graupel
+ microp_st%accigrn(pcols,pver), & ! num tendency of ice mult(splintering) due to acc rain by graupel
+ microp_st%accsirn(pcols,pver), & ! num tendency of snow due to collection of rain by ice
+ microp_st%accgln(pcols,pver), & ! num tendency due to collection of droplets by graupel
+ microp_st%accgrn(pcols,pver), & ! num tendency due to collection of rain by graupel
+ microp_st%accilm(pcols,pver), & ! mass tendency of cloud ice due to collection of droplet by cloud ice
+ microp_st%acciln(pcols,pver), & ! number conc tendency of cloud ice due to collection of droplet by cloud ice
+ microp_st%fallrm(pcols, pver), & ! mass tendency of rain fallout
+ microp_st%fallsm(pcols, pver), & ! mass tendency of snow fallout
+ microp_st%fallgm(pcols, pver), & ! mass tendency of graupel fallout
+ microp_st%fallrn(pcols, pver), & ! num tendency of rain fallout
+ microp_st%fallsn(pcols, pver), & ! num tendency of snow fallout
+ microp_st%fallgn(pcols, pver), & ! num tendency of graupel fallout
+ microp_st%fhmrm (pcols,pver) ) ! mass tendency due to homogeneous freezing of rain
+ end if
+
+
+ doslop = .false.
+ doslop_heat = .false.
+ doslop_moisture = .false.
+ doslop_uwind = .false.
+ doslop_vwind = .false.
+ alphau = 0.0_r8
+ alphav = 0.0_r8
+ if( MCSP ) then
+ if( MCSP_heat_coeff > 0._r8 ) then
+ doslop_heat = .true.
+ alpha2 = MCSP_heat_coeff
+ end if
+ if( MCSP_moisture_coeff > 0._r8 ) then
+ doslop_moisture = .true.
+ alpha_moisture = MCSP_moisture_coeff
+ end if
+ if( MCSP_uwind_coeff > 0._r8 ) then
+ doslop_uwind = .true.
+ alphau = MCSP_uwind_coeff
+ end if
+ if( MCSP_vwind_coeff > 0._r8 ) then
+ doslop_vwind = .true.
+ alphav = MCSP_vwind_coeff
+ end if
+ end if
+
+ if (doslop_heat .or. doslop_moisture .or. doslop_uwind .or. doslop_vwind) then
+ doslop = .true.
+ endif
+
+
!----------------------------------------------------------------------
! initialize
@@ -379,13 +903,19 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
ftem = 0._r8
mu_out(:,:) = 0._r8
md_out(:,:) = 0._r8
+ dlftot(:,:) = 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.
- call physics_ptend_init(ptend_loc, state%psetcols, 'zm_convr', ls=.true., lq=lq)! initialize local ptend type
+
+ if (doslop) then
+ call physics_ptend_init(ptend_loc, state%psetcols, 'zm_convr', ls=.true., lu = doslop_uwind, lv = doslop_vwind, lq=lq)! initialize local ptend type
+ else
+ call physics_ptend_init(ptend_loc, state%psetcols, 'zm_convr', ls=.true., lq=lq)! initialize local ptend type
+ end if
!
! Associate pointers with physics buffer fields
@@ -400,6 +930,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
call pbuf_get_field(pbuf, prec_dp_idx, prec )
call pbuf_get_field(pbuf, snow_dp_idx, snow )
+
! DCAPE-ULL
if(trigdcape_ull .or. trig_dcape_only)then
call pbuf_get_field(pbuf, t_star_idx, t_star)
@@ -410,6 +941,50 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
end if
end if
+ call pbuf_get_field(pbuf, icimrdp_idx, qi )
+ call pbuf_get_field(pbuf, dlfzm_idx, dlf)
+ call pbuf_get_field(pbuf, difzm_idx, dif)
+
+ if (zm_microp) then
+ call pbuf_get_field(pbuf, dnlfzm_idx, dnlf)
+ call pbuf_get_field(pbuf, dnifzm_idx, dnif)
+ call pbuf_get_field(pbuf, dsfzm_idx, dsf)
+ call pbuf_get_field(pbuf, dnsfzm_idx, dnsf)
+ else
+ allocate(dnlf(pcols,pver), dnif(pcols,pver),dsf(pcols,pver), dnsf(pcols,pver))
+ end if
+
+ call pbuf_get_field(pbuf, lambdadpcu_idx, lambdadpcu)
+ call pbuf_get_field(pbuf, mudpcu_idx, mudpcu)
+
+ if (zm_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
!
@@ -417,15 +992,161 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
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 , &
+ ptend_loc%s ,state%pmid ,state%pint ,state%pdel ,state%omega , &
.5_r8*ztodt ,mcon ,cme , cape, &
tpert ,dlf ,pflx ,zdu ,rprd , &
mu,md,du,eu,ed , &
dp ,dsubcld ,jt,maxg,ideep , &
lengath ,ql ,rliq ,landfrac, &
- t_star, q_star, dcape)
+ t_star, q_star, dcape, &
+ aero(lchnk), qi, dif, dnlf, dnif, dsf, dnsf, sprd, rice, frz, mudpcu, &
+ lambdadpcu, microp_st)
+
+ if (zm_microp) then
+ dlftot(:,:) = dlf(:,:) + dif(:,:) + dsf(:,:)
+ else
+ dlftot(:,:) = dlf(:,:)
+ end if
+
+
call t_stopf ('zm_convr')
+
+ if (doslop) then
+ !
+ ! Begin MCSP parameterization here
+ !
+ du600 = 0._r8
+ dv600 = 0._r8
+ ZM_depth = 0._r8
+ MCSP_shear = 0._r8
+
+ call vertinterp(ncol, pcols, pver, state%pmid, 60000._r8, state%u,du600)
+ call vertinterp(ncol, pcols, pver, state%pmid, 60000._r8, state%v,dv600)
+
+ do i=1,ncol
+ if(state%pmid(i,pver).gt.60000._r8) then
+ du600(i) = du600(i)-state%u(i,pver)
+ dv600(i) = dv600(i)-state%v(i,pver)
+ else
+ du600(i) = -999._r8
+ dv600(i) = -999._r8
+ end if
+ end do
+
+ MCSP_shear = du600
+ do i=1,ncol
+ if( jctop(i).ne.pver ) ZM_depth(i) = state%pint(i,pver+1)-state%pmid(i,jctop(i))
+ end do
+
+ ! Define parameters
+
+ Qs_zmconv(:) = 0._r8
+ Qv_zmconv(:) = 0._r8
+ Pa_int_end(:) = 0._r8
+ do i = 1,ncol
+ do k = jctop(i),pver
+
+ Qs_zmconv(i) = Qs_zmconv(i) + ptend_loc%s(i,k) * state%pdel(i,k)
+ Qv_zmconv(i) = Qv_zmconv(i) + ptend_loc%q(i,k,1) * state%pdel(i,k)
+ Pa_int_end(i) = Pa_int_end(i) + state%pdel(i,k)
+
+ enddo
+ enddo
+
+ do i = 1,ncol
+ if (jctop(i) .ne. pver) then
+ Qs_zmconv(i) = Qs_zmconv(i) / Pa_int_end(i)
+ Qv_zmconv(i) = Qv_zmconv(i) / Pa_int_end(i)
+ else
+ Qs_zmconv(i) = 0._r8
+ Qv_zmconv(i) = 0._r8
+ endif
+ enddo
+
+ Qm(:,:) = 0.0_r8
+ Qmq(:,:) = 0.0_r8
+ Qmu(:,:) = 0.0_r8
+ Qmv(:,:) = 0.0_r8
+
+ do i = 1,ncol
+
+ Qm_int_end(i) = 0._r8
+ Qmq_int_end(i) = 0._r8
+ Pa_int_end(i) = 0._r8
+
+ Q_dis(i) = 0._r8
+ Qq_dis(i) = 0._r8
+
+ if( (state%pint(i,pver+1)-state%pmid(i,jctop(i))) >= 70000._r8 ) then
+ if(abs(du600(i)).ge.3._r8.and.abs(du600(i)).lt.200.and.Qs_zmconv(i).gt.0._r8) then
+
+ do k = jctop(i),pver
+
+ top = state%pint(i,pver+1) - state%pmid(i,k)
+ bottom = state%pint(i,pver+1) - state%pmid(i,jctop(i))
+
+ Qm(i,k) = -1._r8 * Qs_zmconv(i) * alpha2 * sin(2.0_r8*pi*(top/bottom))
+ Qmq(i,k) = -1._r8 * Qv_zmconv(i) * alpha2 * sin(2.0_r8*pi*(top/bottom))
+ Qmq(i,k) = Qm(i,k)/2500000._r8/4._r8
+
+
+ Qmu(i,k) = alphau * (cos(pi*(top/bottom)))
+
+ Qmv(i,k) = alphav * (cos(pi*(top/bottom)))
+
+ Qm_int_end(i) = Qm_int_end(i) + Qm(i,k) * (state%pdel(i,k)/gravit)
+ Qm_int_end(i) = Qm_int_end(i) + (2._r8*Qmu(i,k)*ztodt*state%u(i,k)+ &
+ Qmu(i,k)*Qmu(i,k)*ztodt*ztodt)/2._r8 * (state%pdel(i,k)/gravit)/ztodt
+ Qm_int_end(i) = Qm_int_end(i) + (2._r8*Qmv(i,k)*ztodt*state%v(i,k)+ &
+ Qmv(i,k)*Qmv(i,k)*ztodt*ztodt)/2._r8 * (state%pdel(i,k)/gravit)/ztodt
+ Qmq_int_end(i) = Qmq_int_end(i) + Qmq(i,k) * (state%pdel(i,k)/gravit)
+ Pa_int_end(i) = Pa_int_end(i) + state%pdel(i,k)
+ end do
+
+ Q_dis(i) = Qm_int_end(i) / Pa_int_end(i)
+ Qq_dis(i) = Qmq_int_end(i) / Pa_int_end(i)
+
+ endif
+ endif
+ enddo
+
+ MCSP_DT = 0._r8
+ MCSP_freq = 0._r8
+
+ do i = 1,ncol
+ do k = jctop(i),pver
+ Qcq_adjust = ptend_loc%q(i,k,1) - Qq_dis(i) * gravit
+
+ ptend_loc%s(i,k) = ptend_loc%s(i,k) - Q_dis(i)*gravit ! energy fixer
+
+ MCSP_DT(i,k) = -Q_dis(i)*gravit+Qm(i,k)
+ if(abs(Qm(i,k)).gt.0._r8 .and. abs(Qmu(i,k)).gt.0._r8) MCSP_freq(i) = 1._r8
+
+ if (doslop_heat) ptend_loc%s(i,k) = ptend_loc%s(i,k) + Qm(i,k)
+ if (doslop_moisture) ptend_loc%q(i,k,1) = Qcq_adjust + Qmq(i,k)
+ if (doslop_uwind) ptend_loc%u(i,k) = Qmu(i,k)
+ if (doslop_vwind) ptend_loc%v(i,k) = Qmv(i,k)
+ enddo
+ enddo
+
+
+ !
+ ! End the MCSP parameterization here
+ !
+
+
+ MCSP_DT(:ncol,:pver) = MCSP_DT(:ncol,:pver)/cpair
+ call outfld('MCSP_DT ',MCSP_DT ,pcols ,lchnk )
+ call outfld('MCSP_freq ',MCSP_freq ,pcols ,lchnk )
+ if (doslop_uwind) call outfld('MCSP_DU ',ptend_loc%u*86400._r8 ,pcols ,lchnk )
+ if (doslop_vwind) call outfld('MCSP_DV ',ptend_loc%v*86400._r8 ,pcols ,lchnk )
+ call outfld('ZM_depth ',ZM_depth ,pcols ,lchnk )
+ call outfld('MCSP_shear ',MCSP_shear ,pcols ,lchnk )
+
+ end if
+
+ call outfld('DCAPE', dcape, pcols, lchnk)
call outfld('CAPE_ZM', cape, pcols, lchnk) ! RBN - CAPE output
!
! Output fractional occurance of ZM convection
@@ -440,6 +1161,8 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
!
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
@@ -463,6 +1186,9 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
call outfld('ZMDT ',ftem ,pcols ,lchnk )
call outfld('ZMDQ ',ptend_loc%q(1,1,1) ,pcols ,lchnk )
+ if (zm_microp) call zm_conv_micro_outfld(microp_st, dlf, dif, dnlf, dnif, frz, lchnk, ncol)
+
+
maxgsav(:) = 0._r8 ! zero if no convection. true mean to be MAXI/FREQZM
pcont(:ncol) = state%ps(:ncol)
pconb(:ncol) = state%ps(:ncol)
@@ -478,6 +1204,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
call outfld('PCONVB ',pconb ,pcols ,lchnk )
call outfld('MAXI ',maxgsav ,pcols ,lchnk )
+
call physics_ptend_init(ptend_all, state%psetcols, 'zm_conv_tend')
! add tendency from this process to tendencies from other processes
@@ -510,7 +1237,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
state1%t,state1%pmid,state1%pdel,state1%q(:pcols,:pver,1), &
ptend_loc%s, tend_s_snwprd, tend_s_snwevmlt, ptend_loc%q(:pcols,:pver,1), &
rprd, cld, ztodt, &
- prec, snow, ntprprd, ntsnprd , flxprec, flxsnow)
+ prec, snow, ntprprd, ntsnprd , flxprec, flxsnow, sprd, old_snow)
call t_stopf ('zm_conv_evap')
evapcdp(:ncol,:pver) = ptend_loc%q(:ncol,:pver,1)
@@ -529,13 +1256,23 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
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 outfld('PRECZ ', prec , pcols, lchnk)
+ if (zm_microp) then
+ do i = 1,ncol
+ if (prec(i) .gt. 0.0_r8) then
+ precz_snum(i) = 1.0_r8
+ else
+ precz_snum(i) = 0.0_r8
+ end if
+ end do
+ call outfld('PRECZ_SN', precz_snum, pcols, lchnk)
+ end if
+
! add tendency from this process to tend from other processes here
call physics_ptend_sum(ptend_loc,ptend_all, ncol)
@@ -609,7 +1346,7 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
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)
+ nstep, fracis, ptend_loc%q, fake_dpdry, ztodt)
call t_stopf ('convtran1')
call outfld('ZMDICE ',ptend_loc%q(1,1,ixcldice) ,pcols ,lchnk )
@@ -621,6 +1358,82 @@ subroutine zm_conv_tend(pblh ,mcon ,cme , &
call physics_state_dealloc(state1)
call physics_ptend_dealloc(ptend_loc)
+ if (zm_microp) then
+ deallocate( &
+ microp_st%wu, &
+ microp_st%qliq, &
+ microp_st%qice, &
+ microp_st%qrain, &
+ microp_st%qsnow, &
+ microp_st%qgraupel,&
+ microp_st%qnl, &
+ microp_st%qni, &
+ microp_st%qnr, &
+ microp_st%qns, &
+ microp_st%qng, &
+ microp_st%autolm, &
+ microp_st%accrlm, &
+ microp_st%bergnm, &
+ microp_st%fhtimm, &
+ microp_st%fhtctm, &
+ microp_st%fhmlm , &
+ microp_st%hmpim , &
+ microp_st%accslm, &
+ microp_st%dlfm , &
+ microp_st%autoln, &
+ microp_st%accrln, &
+ microp_st%bergnn, &
+ microp_st%fhtimn, &
+ microp_st%fhtctn, &
+ microp_st%fhmln , &
+ microp_st%accsln, &
+ microp_st%activn, &
+ microp_st%dlfn , &
+ microp_st%autoim, &
+ microp_st%accsim, &
+ microp_st%difm , &
+ microp_st%nuclin, &
+ microp_st%autoin, &
+ microp_st%accsin, &
+ microp_st%hmpin , &
+ microp_st%difn , &
+ microp_st%cmel , &
+ microp_st%cmei , &
+ microp_st%trspcm, &
+ microp_st%trspcn, &
+ microp_st%trspim, &
+ microp_st%trspin, &
+ microp_st%accgrm, &
+ microp_st%accglm, &
+ microp_st%accgslm, &
+ microp_st%accgsrm, &
+ microp_st%accgirm, &
+ microp_st%accgrim, &
+ microp_st%accgrsm, &
+ microp_st%accgsln, &
+ microp_st%accgsrn, &
+ microp_st%accgirn, &
+ microp_st%accsrim, &
+ microp_st%acciglm, &
+ microp_st%accigrm, &
+ microp_st%accsirm, &
+ microp_st%accigln, &
+ microp_st%accigrn, &
+ microp_st%accsirn, &
+ microp_st%accgln, &
+ microp_st%accgrn, &
+ microp_st%accilm, &
+ microp_st%acciln, &
+ microp_st%fallrm, &
+ microp_st%fallsm, &
+ microp_st%fallgm, &
+ microp_st%fallrn, &
+ microp_st%fallsn, &
+ microp_st%fallgn, &
+ microp_st%fhmrm )
+ else
+ deallocate(dnlf, dnif, dsf, dnsf)
+ end if
end subroutine zm_conv_tend
!=========================================================================================
@@ -719,7 +1532,7 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf,mu, eu, &
ptend%lq,state%q, pcnst, mu, md, &
du, eu, ed, dp, dsubcld, &
jt,maxg,ideep, 1, lengath, &
- nstep, fracis, ptend%q, dpdry)
+ nstep, fracis, ptend%q, dpdry, ztodt)
call t_stopf ('convtran2')
end if
@@ -735,6 +1548,164 @@ subroutine zm_conv_tend_2( state, ptend, ztodt, pbuf,mu, eu, &
end subroutine zm_conv_tend_2
+
+subroutine zm_conv_micro_outfld(microp_st, dlf, dif, dnlf, dnif, frz, lchnk, ncol)
+
+ use cam_history, only: outfld
+
+ type(zm_microp_st),intent(in) :: microp_st
+ real(r8), intent(in) :: dlf(:,:) ! detrainment of convective cloud liquid water mixing ratio.
+ real(r8), intent(in) :: dif(:,:) ! detrainment of convective cloud ice mixing ratio.
+ real(r8), intent(in) :: dnlf(:,:) ! detrainment of convective cloud liquid water num concen.
+ real(r8), intent(in) :: dnif(:,:) ! detrainment of convective cloud ice num concen.
+ real(r8), intent(in) :: frz(:,:) ! heating rate due to freezing
+ 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) :: cgraupel_snum(pcols,pver) ! convective graupel sample number.
+ real(r8) :: wu_snum(pcols,pver) ! vertical velocity sample number
+
+ do k = 1,pver
+ do i = 1,ncol
+ if (microp_st%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 (microp_st%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 (microp_st%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 (microp_st%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 (microp_st%qgraupel(i,k) .gt. 0.0_r8) then
+ cgraupel_snum(i,k) = 1.0_r8
+ else
+ cgraupel_snum(i,k) = 0.0_r8
+ end if
+ if (microp_st%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('CLIQSNUM',cliq_snum ,pcols, lchnk)
+ call outfld('CICESNUM',cice_snum ,pcols, lchnk)
+ call outfld('CRAINNUM',crain_snum ,pcols, lchnk)
+ call outfld('CSNOWNUM',csnow_snum ,pcols, lchnk)
+ call outfld('CGRAPNUM',cgraupel_snum ,pcols, lchnk)
+ call outfld('WUZMSNUM',wu_snum ,pcols, lchnk)
+
+ call outfld('DIFZM' ,dif ,pcols, lchnk)
+ call outfld('DLFZM' ,dlf ,pcols, lchnk)
+ call outfld('DNIFZM' ,dnif ,pcols, lchnk)
+ call outfld('DNLFZM' ,dnlf ,pcols, lchnk)
+ call outfld('FRZZM' ,frz ,pcols, lchnk)
+
+ call outfld('WUZM' ,microp_st%wu ,pcols, lchnk)
+! call outfld('FRZZM' ,microp_st%frz ,pcols, lchnk)
+
+ call outfld('CLDLIQZM',microp_st%qliq ,pcols, lchnk)
+ call outfld('CLDICEZM',microp_st%qice ,pcols, lchnk)
+ call outfld('QRAINZM' ,microp_st%qrain ,pcols, lchnk)
+ call outfld('QSNOWZM' ,microp_st%qsnow ,pcols, lchnk)
+ call outfld('QGRAPZM' ,microp_st%qgraupel ,pcols, lchnk)
+
+ call outfld('QNLZM' ,microp_st%qnl ,pcols, lchnk)
+ call outfld('QNIZM' ,microp_st%qni ,pcols, lchnk)
+ call outfld('QNRZM' ,microp_st%qnr ,pcols, lchnk)
+ call outfld('QNSZM' ,microp_st%qns ,pcols, lchnk)
+ call outfld('QNGZM' ,microp_st%qng ,pcols, lchnk)
+
+ call outfld('AUTOL_M' ,microp_st%autolm ,pcols, lchnk)
+ call outfld('ACCRL_M' ,microp_st%accrlm ,pcols, lchnk)
+ call outfld('BERGN_M' ,microp_st%bergnm ,pcols, lchnk)
+ call outfld('FHTIM_M' ,microp_st%fhtimm ,pcols, lchnk)
+ call outfld('FHTCT_M' ,microp_st%fhtctm ,pcols, lchnk)
+ call outfld('FHML_M' ,microp_st%fhmlm ,pcols, lchnk)
+ call outfld('HMPI_M' ,microp_st%hmpim ,pcols, lchnk)
+ call outfld('ACCSL_M' ,microp_st%accslm ,pcols, lchnk)
+ call outfld('DLF_M' ,microp_st%dlfm ,pcols, lchnk)
+
+ call outfld('AUTOL_N' ,microp_st%autoln ,pcols, lchnk)
+ call outfld('ACCRL_N' ,microp_st%accrln ,pcols, lchnk)
+ call outfld('BERGN_N' ,microp_st%bergnn ,pcols, lchnk)
+ call outfld('FHTIM_N' ,microp_st%fhtimn ,pcols, lchnk)
+ call outfld('FHTCT_N' ,microp_st%fhtctn ,pcols, lchnk)
+ call outfld('FHML_N' ,microp_st%fhmln ,pcols, lchnk)
+ call outfld('ACCSL_N' ,microp_st%accsln ,pcols, lchnk)
+ call outfld('ACTIV_N' ,microp_st%activn ,pcols, lchnk)
+ call outfld('DLF_N' ,microp_st%dlfn ,pcols, lchnk)
+ call outfld('AUTOI_M' ,microp_st%autoim ,pcols, lchnk)
+ call outfld('ACCSI_M' ,microp_st%accsim ,pcols, lchnk)
+ call outfld('DIF_M' ,microp_st%difm ,pcols, lchnk)
+ call outfld('NUCLI_N' ,microp_st%nuclin ,pcols, lchnk)
+ call outfld('AUTOI_N' ,microp_st%autoin ,pcols, lchnk)
+ call outfld('ACCSI_N' ,microp_st%accsin ,pcols, lchnk)
+ call outfld('HMPI_N' ,microp_st%hmpin ,pcols, lchnk)
+ call outfld('DIF_N' ,microp_st%difn ,pcols, lchnk)
+ call outfld('COND_M' ,microp_st%cmel ,pcols, lchnk)
+ call outfld('DEPOS_M' ,microp_st%cmei ,pcols, lchnk)
+
+ call outfld('TRSPC_M' ,microp_st%trspcm ,pcols, lchnk)
+ call outfld('TRSPC_N' ,microp_st%trspcn ,pcols, lchnk)
+ call outfld('TRSPI_M' ,microp_st%trspim ,pcols, lchnk)
+ call outfld('TRSPI_N' ,microp_st%trspin ,pcols, lchnk)
+
+ call outfld('ACCGR_M' ,microp_st%accgrm ,pcols, lchnk)
+ call outfld('ACCGL_M' ,microp_st%accglm ,pcols, lchnk)
+ call outfld('ACCGSL_M',microp_st%accgslm ,pcols, lchnk)
+ call outfld('ACCGSR_M',microp_st%accgsrm ,pcols, lchnk)
+ call outfld('ACCGIR_M',microp_st%accgirm ,pcols, lchnk)
+ call outfld('ACCGRI_M',microp_st%accgrim ,pcols, lchnk)
+ call outfld('ACCGRS_M',microp_st%accgrsm ,pcols, lchnk)
+
+ call outfld('ACCGSL_N',microp_st%accgsln ,pcols, lchnk)
+ call outfld('ACCGSR_N',microp_st%accgsrn ,pcols, lchnk)
+ call outfld('ACCGIR_N',microp_st%accgirn ,pcols, lchnk)
+
+ call outfld('ACCSRI_M',microp_st%accsrim ,pcols, lchnk)
+ call outfld('ACCIGL_M',microp_st%acciglm ,pcols, lchnk)
+ call outfld('ACCIGR_M',microp_st%accigrm ,pcols, lchnk)
+ call outfld('ACCSIR_M',microp_st%accsirm ,pcols, lchnk)
+
+ call outfld('ACCIGL_N',microp_st%accigln ,pcols, lchnk)
+ call outfld('ACCIGR_N',microp_st%accigrn ,pcols, lchnk)
+ call outfld('ACCSIR_N',microp_st%accsirn ,pcols, lchnk)
+ call outfld('ACCGL_N' ,microp_st%accgln ,pcols, lchnk)
+ call outfld('ACCGR_N' ,microp_st%accgrn ,pcols, lchnk)
+
+ call outfld('ACCIL_M' ,microp_st%accilm ,pcols, lchnk)
+ call outfld('ACCIL_N' ,microp_st%acciln ,pcols, lchnk)
+
+ call outfld('FALLR_M' ,microp_st%fallrm ,pcols, lchnk)
+ call outfld('FALLS_M' ,microp_st%fallsm ,pcols, lchnk)
+ call outfld('FALLG_M' ,microp_st%fallgm ,pcols, lchnk)
+ call outfld('FALLR_N' ,microp_st%fallrn ,pcols, lchnk)
+ call outfld('FALLS_N' ,microp_st%fallsn ,pcols, lchnk)
+ call outfld('FALLG_N' ,microp_st%fallgn ,pcols, lchnk)
+
+ call outfld('FHMR_M' ,microp_st%fhmrm ,pcols, lchnk)
+
+ end subroutine zm_conv_micro_outfld
!=========================================================================================
diff --git a/components/eam/src/physics/cam/zm_microphysics.F90 b/components/eam/src/physics/cam/zm_microphysics.F90
new file mode 100755
index 000000000000..1a35130f48a7
--- /dev/null
+++ b/components/eam/src/physics/cam/zm_microphysics.F90
@@ -0,0 +1,3358 @@
+module zm_microphysics
+
+!---------------------------------------------------------------------------------
+! Purpose:
+! CAM Interface for cumulus microphysics
+!
+! Author: Xialiang Song and Guang 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_bam, only: ndrop_bam_run
+use nucleate_ice_conv, only: nucleati_conv
+#ifndef HAVE_ERF_INTRINSICS
+use shr_spfn_mod, only: erf => shr_spfn_erf
+#endif
+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
+implicit none
+private
+save
+
+public :: &
+ zm_mphyi, &
+ zm_mphy, &
+ zm_aero_t, &
+ zm_microp_st
+
+! 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) :: rhog ! bulk density graupel
+
+real(r8) :: ac,bc,as,bs,ai,bi,ar,br,ag,bg !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) :: cg,dg !graupel 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) :: ecg ! collection efficiency, ice-droplet collisions
+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) :: mg0 ! mass of embryo graupel
+real(r8) :: rin ! radius of contact nuclei
+real(r8) :: pi ! pi
+real(r8) :: mmult
+
+! for Bergeron process (Rotstayn et al.2000)
+real(r8) :: Ka_b ! thermal conductivity of air(J/m/s/K)
+real(r8) :: Ls_b ! latent heat of sublimation of water(J/kg)
+real(r8) :: Rv_b ! specigic gas constant for water vapour(J/kg/K)
+real(r8) :: alfa_b ! parameter for ice crystal habit
+real(r8) :: rhoi13 ! rhoi**(1/3)
+real(r8) :: c23 ! 2/3
+
+real(r8) :: cons14,cons16,cons17,cons18,cons19,cons24,cons25, cons31, cons32, cons41
+
+real(r8) :: droplet_mass_25um
+
+! 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_microp_st
+
+ real(r8), allocatable :: wu(:,:) ! vertical velocity
+
+ real(r8), allocatable :: qliq(:,:) ! convective cloud liquid water.
+ real(r8), allocatable :: qice(:,:) ! convective cloud ice.
+ real(r8), allocatable :: qrain(:,:) ! convective rain water.
+ real(r8), allocatable :: qsnow(:,:) ! convective snow.
+ real(r8), allocatable :: qgraupel(:,:) ! convective graupel.
+ 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 :: qng(:,:) ! convective graupel num concen.
+
+ 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 :: accgrm(:,:) ! mass tendency due to collection of rain by graupel
+ real(r8), allocatable :: accglm(:,:) ! mass tendency due to collection of droplets by graupel
+ real(r8), allocatable :: accgslm(:,:) ! mass tendency of graupel due to collection of droplets by snow
+ real(r8), allocatable :: accgsrm(:,:) ! mass tendency of graupel due to collection of rain by snow
+ real(r8), allocatable :: accgirm(:,:) ! mass tendency of graupel due to collection of rain by ice
+ real(r8), allocatable :: accgrim(:,:) ! mass tendency of graupel due to collection of ice by rain
+ real(r8), allocatable :: accgrsm(:,:) ! mass tendency due to collection of snow by rain
+ real(r8), allocatable :: accgsln(:,:) ! num tendency of graupel due to collection of droplets by snow
+ real(r8), allocatable :: accgsrn(:,:) ! num tendency of graupel due to collection of rain by snow
+ real(r8), allocatable :: accgirn(:,:) ! num tendency of graupel due to collection of rain by ice
+ real(r8), allocatable :: accsrim(:,:) ! mass tendency of snow due to collection of ice by rain
+ real(r8), allocatable :: acciglm(:,:) ! mass tendency of ice mult(splintering) due to acc droplets by graupel
+ real(r8), allocatable :: accigrm(:,:) ! mass tendency of ice mult(splintering) due to acc rain by graupel
+ real(r8), allocatable :: accsirm(:,:) ! mass tendency of snow due to collection of rain by ice
+ real(r8), allocatable :: accigln(:,:) ! num tendency of ice mult(splintering) due to acc droplets by graupel
+ real(r8), allocatable :: accigrn(:,:) ! num tendency of ice mult(splintering) due to acc rain by graupel
+ real(r8), allocatable :: accsirn(:,:) ! num tendency of snow due to collection of rain by ice
+ real(r8), allocatable :: accgln(:,:) ! num tendency due to collection of droplets by graupel
+ real(r8), allocatable :: accgrn(:,:) ! num tendency due to collection of rain by graupel
+ real(r8), allocatable :: accilm(:,:) ! mass tendency of cloud ice due to collection of droplet by cloud ice
+ real(r8), allocatable :: acciln(:,:) ! number conc tendency of cloud ice due to collection of droplet by cloud ice
+ real(r8), allocatable :: fallrm(:,:) ! mass tendency of rain fallout
+ real(r8), allocatable :: fallsm(:,:) ! mass tendency of snow fallout
+ real(r8), allocatable :: fallgm(:,:) ! mass tendency of graupel fallout
+ real(r8), allocatable :: fallrn(:,:) ! num tendency of rain fallout
+ real(r8), allocatable :: fallsn(:,:) ! num tendency of snow fallout
+ real(r8), allocatable :: fallgn(:,:) ! num tendency of graupel fallout
+ real(r8), allocatable :: fhmrm (:,:) ! mass tendency due to homogeneous freezing of rain
+
+end type zm_microp_st
+
+
+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
+
+ rhog = 400._r8 ! bulk density graupel(if dense precipitating ice is graupel)
+! rhog = 900._r8 ! bulk density graupel(if dense precipitating ice is hail)
+
+! 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
+
+!graupel(if dense precipitating ice is graupel)
+
+ ag = 19.3_r8
+ bg = 0.37_r8
+
+!if dense precipitating ice is hail (matsun and huggins 1980)
+! ag = 114.5
+! bg = 0.5
+
+
+! 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
+
+! graupel mass-diameter relationship
+
+ cg = rhog*pi/6._r8
+ dg = 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
+
+ ecg = 0.7_r8
+
+! immersion freezing parameters, bigg 1953
+
+ bimm = 100._r8
+ aimm = 0.66_r8
+
+! typical air density at 850 mb
+
+ rhosu = 85000._r8/(rair * tmelt)
+
+! for Bergeron process (Rotstayn et al.2000)
+ Ka_b = 2.4e-2_r8 ! thermal conductivity of air(J/m/s/K)
+ Ls_b = 2.834e6_r8 ! latent heat of sublimation of water(J/kg)
+ Rv_b = 461._r8 ! specigic gas constant for water vapour(J/kg/K)
+ alfa_b = 1._r8/3._r8
+ rhoi13 = rhoi**alfa_b
+ c23 = 2._r8/3._r8
+
+! 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)
+
+ mg0 = 1.6E-10
+! radius of contact nuclei aerosol (m)
+
+ rin = 0.1e-6_r8
+ mmult = 4._r8/3._r8*pi*rhoi*(5.e-6_r8)**3
+
+ cons14=gamma(bg+3._r8)*pi/4._r8*ecg
+ cons16=gamma(bi+3._r8)*pi/4._r8*ecg
+ cons17=4._r8*2._r8*3._r8*rhosu*pi*ecg*ecg*gamma(2._r8*bs+2._r8)/(8._r8*(rhog-rhosn))
+ cons18=rhosn*rhosn
+ cons19=rhow*rhow
+ cons24=pi/4._r8*ecr*gamma(br+3._r8)
+ cons25=pi*pi/24._r8*rhow*ecr*gamma(br+6._r8)
+
+ cons31=pi*pi*ecr*rhosn
+ cons32=pi/2._r8*ecr
+ cons41=pi*pi*ecr*rhow
+
+ droplet_mass_25um = 4._r8/3._r8*pi*rhow*(25.e-6_r8)**3
+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, qg, ng, qnide,nsde, &
+ 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 , &
+ accgrm, accglm, accgslm,accgsrm,accgirm,accgrim,accgrsm,accgsln,accgsrn, &
+ accgirn,accsrim,acciglm,accigrm,accsirm,accigln,accigrn,accsirn,accgln, &
+ accgrn ,accilm, acciln ,fallrm ,fallsm ,fallgm ,fallrn ,fallsn ,fallgn, &
+ fhmrm ,dsfm, dsfn, auto_fac, accr_fac, dcs)
+
+
+! 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
+ real(r8) auto_fac ! droplet-rain autoconversion enhancement factor
+ real(r8) accr_fac ! droplet-rain accretion enhancement factor
+ real(r8) dcs ! autoconversion size threshold for cloud ice to snow (m)
+
+! 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) :: qnide(pcols,pver) ! cloud snow 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) :: nsde(pcols,pver) ! cloud snow number conc for detrainment (1/kg)
+ 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) :: qg(pcols,pver) ! graupel mixing ratio
+ real(r8), intent(out) :: ng(pcols,pver) ! graupel 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/graupel 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) :: autolm(pcols,pver) !mass tendency due to autoconversion of droplets to rain
+ real(r8) :: accrlm(pcols,pver) !mass tendency due to accretion of droplets by rain
+ real(r8) :: bergnm(pcols,pver) !mass tendency due to Bergeron process
+ real(r8) :: fhtimm(pcols,pver) !mass tendency due to immersion freezing
+ real(r8) :: fhtctm(pcols,pver) !mass tendency due to contact freezing
+ real(r8) :: fhmlm (pcols,pver) !mass tendency due to homogeneous freezing
+ real(r8) :: hmpim (pcols,pver) !mass tendency due to HM process
+ real(r8) :: accslm(pcols,pver) !mass tendency due to accretion of droplets by snow
+ real(r8) :: dlfm (pcols,pver) !mass tendency due to detrainment of droplet
+ real(r8) :: trspcm(pcols,pver) !mass tendency of droplets due to convective transport
+
+ real(r8) :: autoln(pcols,pver) !num tendency due to autoconversion of droplets to rain
+ real(r8) :: accrln(pcols,pver) !num tendency due to accretion of droplets by rain
+ real(r8) :: bergnn(pcols,pver) !num tendency due to Bergeron process
+ real(r8) :: fhtimn(pcols,pver) !num tendency due to immersion freezing
+ real(r8) :: fhtctn(pcols,pver) !num tendency due to contact freezing
+ real(r8) :: fhmln (pcols,pver) !num tendency due to homogeneous freezing
+ real(r8) :: accsln(pcols,pver) !num tendency due to accretion of droplets by snow
+ real(r8) :: activn(pcols,pver) !num tendency due to droplets activation
+ real(r8) :: dlfn (pcols,pver) !num tendency due to detrainment of droplet
+ real(r8) :: trspcn(pcols,pver) !num tendency of droplets due to convective transport
+
+ real(r8) :: autoim(pcols,pver) !mass tendency due to autoconversion of cloud ice to snow
+ real(r8) :: accsim(pcols,pver) !mass tendency due to accretion of cloud ice by snow
+ real(r8) :: difm (pcols,pver) !mass tendency due to detrainment of cloud ice
+ real(r8) :: trspim(pcols,pver) !mass tendency of ice crystal due to convective transport
+
+ real(r8) :: nuclin(pcols,pver) !num tendency due to ice nucleation
+ real(r8) :: autoin(pcols,pver) !num tendency due to autoconversion of cloud ice to snow
+ real(r8) :: accsin(pcols,pver) !num tendency due to accretion of cloud ice by snow
+ real(r8) :: hmpin (pcols,pver) !num tendency due to HM process
+ real(r8) :: difn (pcols,pver) !num tendency due to detrainment of cloud ice
+ real(r8) :: trspin(pcols,pver) !num tendency of ice crystal due to convective transport
+
+ real(r8) :: dsfm (pcols,pver) !mass tendency due to detrainment of snow
+ real(r8) :: trspsm(pcols,pver) !mass tendency of snow due to convective transport
+ real(r8) :: dsfn (pcols,pver) !num tendency due to detrainment of snow
+ real(r8) :: trspsn(pcols,pver) !num tendency of snow due to convective transport
+!graupel
+ real(r8) :: accgrm(pcols,pver) ! mass tendency due to collection of rain by graupel
+ real(r8) :: accglm(pcols,pver) ! mass tendency due to collection of droplets by graupel
+ real(r8) :: accgslm(pcols,pver) ! mass tendency of graupel due to collection of droplets by snow
+ real(r8) :: accgsrm(pcols,pver) ! mass tendency of graupel due to collection of rain by snow
+ real(r8) :: accgirm(pcols,pver) ! mass tendency of graupel due to collection of rain by ice
+ real(r8) :: accgrim(pcols,pver) ! mass tendency of graupel due to collection of ice by rain
+ real(r8) :: accgrsm(pcols,pver) ! mass tendency due to collection of snow by rain
+
+ real(r8) :: accgsln(pcols,pver) ! num tendency of graupel due to collection of droplets by snow
+ real(r8) :: accgsrn(pcols,pver) ! num tendency of graupel due to collection of rain by snow
+ real(r8) :: accgirn(pcols,pver) ! num tendency of graupel due to collection of rain by ice
+
+ real(r8) :: accsrim(pcols,pver) ! mass tendency of snow due to collection of ice by rain
+ real(r8) :: acciglm(pcols,pver) ! mass tendency of ice mult(splintering) due to acc droplets by graupel
+ real(r8) :: accigrm(pcols,pver) ! mass tendency of ice mult(splintering) due to acc rain by graupel
+ real(r8) :: accsirm(pcols,pver) ! mass tendency of snow due to collection of rain by ice
+
+ real(r8) :: accigln(pcols,pver) ! num tendency of ice mult(splintering) due to acc droplets by graupel
+ real(r8) :: accigrn(pcols,pver) ! num tendency of ice mult(splintering) due to acc rain by graupel
+ real(r8) :: accsirn(pcols,pver) ! num tendency of snow due to collection of rain by ice
+ real(r8) :: accgln(pcols,pver) ! num tendency due to collection of droplets by graupel
+ real(r8) :: accgrn(pcols,pver) ! num tendency due to collection of rain by graupel
+ real(r8) :: accilm(pcols,pver) ! mass tendency of cloud ice due to collection of droplet by cloud ice
+ real(r8) :: acciln(pcols,pver) ! number conc tendency of cloud ice due to collection of droplet by cloud ice
+
+ real(r8) :: fallrm(pcols, pver) ! mass tendency of rain fallout
+ real(r8) :: fallsm(pcols, pver) ! mass tendency of snow fallout
+ real(r8) :: fallgm(pcols, pver) ! mass tendency of graupel fallout
+ real(r8) :: fallrn(pcols, pver) ! num tendency of rain fallout
+ real(r8) :: fallsn(pcols, pver) ! num tendency of snow fallout
+ real(r8) :: fallgn(pcols, pver) ! num tendency of graupel fallout
+
+! 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)
+
+!................................................................................
+! 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-cloud snow mixing ratio
+ real(r8) :: qric(pcols,pver) ! in-cloud rain mixing ratio
+ real(r8) :: qgic(pcols,pver) ! in-cloud graupel 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-cloud snow number conc
+ real(r8) :: nric(pcols,pver) ! in-cloud rain number conc
+ real(r8) :: ngic(pcols,pver) ! in-cloud graupel 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) :: lamg(pver) ! slope of graupel size distr
+ real(r8) :: n0g(pver) ! intercept of graupel 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) :: pgf(pver) ! mixing ratio tendency due to fallout of graupel
+ real(r8) :: pngf(pver) ! number conc tendency due to fallout of graupel
+ 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
+!graupel
+ real(r8) :: psacwi(pver) ! mass tendency of cloud ice due to collection of droplet by cloud ice
+ real(r8) :: npsacwi(pver) ! number conc tendency of cloud ice due to collection of droplet by cloud ice
+ real(r8) :: pracg(pver) ! mixing rat tendency due to collection of rain by graupel
+ real(r8) :: psacwg(pver) ! mixing rat tendency due to collection of droplets by graupel
+ real(r8) :: pgsacw(pver) ! mixing rat tendency of graupel due to collection of droplets by snow
+ real(r8) :: pgracs(pver) ! mixing rat tendency of graupel due to collection of rain by snow
+ real(r8) :: piacr(pver) ! mixing rat tendency of graupel due to collection of rain by ice
+ real(r8) :: praci(pver) ! mixing rat tendency of graupel due to collection of ice by rain
+ real(r8) :: psacr(pver) ! mixing rat tendency due to collection of snow by rain
+
+ real(r8) :: nscng(pver) ! number conc tendency of graupel due to collection of droplets by snow
+ real(r8) :: ngracs(pver) ! number conc tendency of graupel due to collection of rain by snow
+ real(r8) :: niacr(pver) ! number conc tendency of graupel due to collection of rain by ice
+
+ real(r8) :: pracis(pver) ! mixing rat tendency of snow due to collection of ice by rain
+ real(r8) :: qmultg(pver) ! mixing rat tendency of ice mult(splintering) due to acc droplets by graupel
+ real(r8) :: qmultrg(pver) ! mixing rat tendency of ice mult(splintering) due to acc rain by graupel
+ real(r8) :: piacrs(pver) ! mixing rat tendency of snow due to collection of rain by ice
+
+ real(r8) :: nmultg(pver) ! number conc tendency of ice mult(splintering) due to acc droplets by graupel
+ real(r8) :: nmultrg(pver) ! number conc tendency of ice mult(splintering) due to acc rain by graupel
+ real(r8) :: niacrs(pver) ! number conc tendency of snow due to collection of rain by ice
+ real(r8) :: npsacwg(pver) ! number conc tendency due to collection of droplets by graupel
+ real(r8) :: npracg(pver) ! number conc tendency due to collection of rain by graupel
+
+! 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) :: agn(pcols,pver) ! air density corrected graupel 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) :: ung(pver) ! number-weighted graupel fallspeed
+ real(r8) :: umg(pver) ! mass-weighted graupel 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) :: qge ! dummy qg for conservation check
+ real(r8) :: nge ! dummy ng 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
+ real(r8) :: qgtend(pcols,pver) ! graupel mixing ratio source/sink term
+ real(r8) :: ngtend(pcols,pver) ! graupel 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
+ real(r8) :: a_prime
+ real(r8) :: b_prime
+ real(r8) :: csvd
+ real(r8) :: cpvd
+ real(r8) :: dqi
+
+
+! 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
+
+ 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) wu(pcols,pver)
+ real(r8) zkine(pcols,pver)
+ real(r8) zbuo(pcols,pver)
+ real(r8) zfacbuo, cwdrag, cwifrac, retv, zbuoc
+ real(r8) zbc, zbe, zdkbuo, zdken
+ real(r8) arcf(pcols,pver)
+ real(r8) p(pcols,pver)
+ real(r8) ph(pcols,pver)
+
+! 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) :: nsadj(pcols,pver) ! snow num tendency due to adjustment
+ real(r8) :: ncorg, niorg, nsorg, 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
+ real(r8) flxgm, mvtgm, flxgn, mvtgn
+ integer nlr, nls, nlg
+
+ real(r8) rmean, beta6, beta66, r6, r6c
+
+ real(r8) dt, fmult
+!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
+ nsde(i,k) = 0._r8
+ qcde(i,k) = 0._r8
+ qide(i,k) = 0._r8
+ qnide(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
+ qg(i,k) = 0._r8
+ nr(i,k) = 0._r8
+ ns(i,k) = 0._r8
+ ng(i,k) = 0._r8
+ qric(i,k) = 0._r8
+ qniic(i,k) = 0._r8
+ nric(i,k) = 0._r8
+ nsic(i,k) = 0._r8
+ qgic(i,k) = 0._r8
+ ngic(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
+ trspsm(i,k) = 0._r8
+ trspsn(i,k) = 0._r8
+
+ dsfm (i,k) = 0._r8
+ dsfn (i,k) = 0._r8
+ ncadj (i,k) = 0._r8
+ niadj (i,k) = 0._r8
+ nsadj (i,k) = 0._r8
+
+ accgrm(i,k) = 0._r8
+ accglm(i,k) = 0._r8
+ accgslm(i,k)= 0._r8
+ accgsrm(i,k)= 0._r8
+ accgirm(i,k)= 0._r8
+ accgrim(i,k)= 0._r8
+ accgrsm(i,k)= 0._r8
+
+ accgsln(i,k)= 0._r8
+ accgsrn(i,k)= 0._r8
+ accgirn(i,k)= 0._r8
+
+ accsrim(i,k)= 0._r8
+ acciglm(i,k)= 0._r8
+ accigrm(i,k)= 0._r8
+ accsirm(i,k)= 0._r8
+
+ accigln(i,k)= 0._r8
+ accigrn(i,k)= 0._r8
+ accsirn(i,k)= 0._r8
+ accgln(i,k) = 0._r8
+ accgrn(i,k) = 0._r8
+
+ accilm(i,k) = 0._r8
+ acciln(i,k) = 0._r8
+
+ fallrm(i,k) = 0._r8
+ fallsm(i,k) = 0._r8
+ fallgm(i,k) = 0._r8
+ fallrn(i,k) = 0._r8
+ fallsn(i,k) = 0._r8
+ fallgn(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
+ agn(i,k)=ag*(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
+ qgtend(i,k)=0._r8
+ nctend(i,k)=0._r8
+ nitend(i,k)=0._r8
+ nrtend(i,k)=0._r8
+ nstend(i,k)=0._r8
+ ngtend(i,k)=0._r8
+ qniic(i,k)=0._r8
+ qgic(i,k)=0._r8
+ qric(i,k)=0._r8
+ nsic(i,k)=0._r8
+ ngic(i,k)=0._r8
+ nric(i,k)=0._r8
+ qni(i,k)=0._r8
+ qg(i,k)=0._r8
+ qr(i,k)=0._r8
+ ns(i,k)=0._r8
+ ng(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
+ qnide(i,k) = 0._r8
+ ncde(i,k) = 0._r8
+ nide(i,k) = 0._r8
+ nsde(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
+ qgtend(i,k)=0._r8
+ nctend(i,k)=0._r8
+ nitend(i,k)=0._r8
+ nrtend(i,k)=0._r8
+ nstend(i,k)=0._r8
+ ngtend(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
+ qgic(i,k)=0._r8
+ nsic(i,k)=0._r8
+ nric(i,k)=0._r8
+ ngic(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
+
+ dsfm (i,k) = 0._r8
+ dsfn (i,k) = 0._r8
+ nsadj (i,k) = 0._r8
+
+ trspcm(i,k) = 0._r8
+ trspcn(i,k) = 0._r8
+ trspim(i,k) = 0._r8
+ trspin(i,k) = 0._r8
+ trspsm(i,k) = 0._r8
+ trspsn(i,k) = 0._r8
+
+ fhmrm (i,k) = 0._r8
+
+ accgrm(i,k) = 0._r8
+ accglm(i,k) = 0._r8
+ accgslm(i,k)= 0._r8
+ accgsrm(i,k)= 0._r8
+ accgirm(i,k)= 0._r8
+ accgrim(i,k)= 0._r8
+ accgrsm(i,k)= 0._r8
+
+ accgsln(i,k)= 0._r8
+ accgsrn(i,k)= 0._r8
+ accgirn(i,k)= 0._r8
+
+ accsrim(i,k)= 0._r8
+ acciglm(i,k)= 0._r8
+ accigrm(i,k)= 0._r8
+ accsirm(i,k)= 0._r8
+
+ accigln(i,k)= 0._r8
+ accigrn(i,k)= 0._r8
+ accsirn(i,k)= 0._r8
+ accgln(i,k) = 0._r8
+ accgrn(i,k) = 0._r8
+
+ accilm(i,k) = 0._r8
+ acciln(i,k) = 0._r8
+
+ fallrm(i,k) = 0._r8
+ fallsm(i,k) = 0._r8
+ fallgm(i,k) = 0._r8
+ fallrn(i,k) = 0._r8
+ fallsn(i,k) = 0._r8
+ fallgn(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
+ umg(k)=0._r8
+ ung(k)=0._r8
+ pgf(k) =0._r8
+ pngf(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)
+ qgic(i,k) = qg(i,k)
+ ngic(i,k) = ng(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
+
+ ! consider graupel falling from above
+ flxgm = 0._r8
+ mvtgm = 0._r8
+ flxgn = 0._r8
+ mvtgn = 0._r8
+ nlg = 0
+
+ do kk= k,jt(i)+3,-1
+ if (qg(i,kk-1) .gt. 0._r8) then
+ nlg = nlg + 1
+ flxgm = flxgm + umg(kk-1)*qg(i,kk-1)*arcf(i,kk-1)
+ mvtgm = mvtgm + umg(kk-1)*arcf(i,kk-1)
+ flxgn = flxgn + ung(kk-1)*ng(i,kk-1)*arcf(i,kk-1)
+ mvtgn = mvtgn + ung(kk-1)*arcf(i,kk-1)
+ end if
+ end do
+
+ if (mvtgm.gt.0) then
+ qgic(i,k) = (qg(i,k)*mu(i,k)+flxgm)/(mu(i,k)+mvtgm)
+ else
+ qgic(i,k) = qg(i,k)
+ end if
+ if (mvtgn.gt.0) then
+ ngic(i,k) = (ng(i,k)*mu(i,k)+flxgn)/(mu(i,k)+mvtgn)
+ else
+ ngic(i,k) = ng(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))
+ ! Cloud water number concentration is mainly determined by the source (e.g., activation)
+ ! and sink terms in the budget equation. Sensitivity test shows that the cloud water number
+ ! concentration is not very sensitive to the boundary conditions.
+! ncic(i,k) = qcic(i,k)/(4._r8/3._r8*pi*10.e-6_r8**3*rhow)
+ ncic(i,k) = qcic(i,k)/(4._r8/3._r8*pi*25.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*15.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, gamma(z+1)=z*gamma(z), gamma(z+4)=(z+3)*(z+2)*(z+1)*gamma(z+1)
+ 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)
+ ! parameters with updated values for 72 layer model
+ prc(k) = auto_fac*30500._r8*qcic(i,k)**3.19_r8* &
+ (ncic(i,k)/1.e6_r8*rho(i,k))**(-1.2_r8)
+ nprc1(k) = prc(k)/(qcic(i,k)/ncic(i,k))
+ nprc(k) = prc(k) * (1._r8/droplet_mass_25um)
+
+ 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)
+
+ if (t(i,k).le.273.15_r8.and.qiic(i,k).ge.qsmall) then
+
+ ! note: assumes autoconversion timescale of 180 sec
+ nprci(k) = n0i(k)/(lami(k)*180._r8)*exp(-lami(k)*dcs)
+ prci(k) = pi*rhoi*n0i(k)/(6._r8*180._r8)* &
+ (dcs**3/lami(k)+3._r8*dcs**2/lami(k)**2+ &
+ 6._r8*dcs/lami(k)**3+6._r8/lami(k)**4)*exp(-lami(k)*dcs)
+ else
+ prci(k)=0._r8
+ nprci(k)=0._r8
+ end if
+
+ ! provisional snow mixing ratio and number concentration (qniic and nsic)
+ ! at boundary are estimated via autoconversion
+
+ if (k.eq.kqi(i) .and. it.eq.1) then
+ qniic(i,k)= prci(k)*dz(i,k)*0.25_r8
+ nsic(i,k)= nprci(k)*dz(i,k)*0.25_r8
+ qni(i,k)= 0.0_r8
+ ns(i,k)= 0.0_r8
+ end if
+
+ ! if precip mix ratio is zero so should number concentration
+ if (qniic(i,k).lt.qsmall) then
+ qniic(i,k)=0._r8
+ nsic(i,k)=0._r8
+ end if
+ if (qric(i,k).lt.qsmall) then
+ qric(i,k)=0._r8
+ nric(i,k)=0._r8
+ end if
+ if (qgic(i,k).lt.qsmall) then
+ qgic(i,k)=0._r8
+ ngic(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)
+ ngic(i,k)=max(ngic(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._r8*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._r8*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/dcs
+ lammin = 1._r8/5000.e-6_r8
+
+ ! adjust vars
+ if (lams(k).lt.lammin) then
+ lams(k) = lammin
+ n0s(k) = lams(k)**4._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)**4._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)
+ dum=(rhosu/rho(i,k))**0.54_r8
+ ums(k) = min(asn(i,k)*gamma(4._r8+bs)/(6._r8*lams(k)**bs),1.2_r8*dum)
+ uns(k) = min(asn(i,k)*gamma(1._r8+bs)/lams(k)**bs,1.2_r8*dum)
+ else
+ lams(k) = 0._r8
+ n0s(k) = 0._r8
+ ums(k) = 0._r8
+ uns(k) = 0._r8
+ end if
+ !.......................................................................
+ !graupel
+
+ if (qgic(i,k).ge.qsmall) then
+ lamg(k) = (gamma(1._r8+dg)*cg*ngic(i,k)/qgic(i,k))**(1._r8/dg)
+ n0g(k) = ngic(i,k)*lamg(k)
+
+ ! check for slope
+ ! adjust vars
+ lammax = 1._r8/20.e-6_r8
+ lammin = 1._r8/5000.e-6_r8
+
+ if (lamg(k).lt.lammin) then
+ lamg(k) = lammin
+ n0g(k) = lamg(k)**4._r8*qgic(i,k)/(gamma(1._r8+dg)*cg)
+ ngic(i,k) = n0g(k)/lamg(k)
+ else if (lamg(k).gt.lammax) then
+ lamg(k) = lammax
+ n0g(k) = lamg(k)**4._r8*qgic(i,k)/(gamma(1._r8+dg)*cg)
+ ngic(i,k) = n0g(k)/lamg(k)
+ end if
+ ! provisional snow number and mass weighted mean fallspeed (m/s)
+ dum=(rhosu/rho(i,k))**0.54_r8
+ umg(k) = min(agn(i,k)*gamma(4._r8+bg)/(6._r8*lamg(k)**bg),20._r8*dum)
+ ung(k) = min(agn(i,k)*gamma(1._r8+bg)/lamg(k)**bg,20._r8*dum)
+ else
+ lamg(k) = 0._r8
+ n0g(k) = 0._r8
+ umg(k) = 0._r8
+ ung(k) = 0._r8
+ end if
+
+
+ !.......................................................................
+ ! snow self-aggregation from passarelli, 1978, used by Reisner(1998,Eq.A.35)
+ ! this is hard-wired for bs = 0.4 for now
+ ! ignore self-collection of cloud ice
+
+ if (qniic(i,k).ge.qsmall .and. t(i,k).le.273.15_r8) then
+ nsagg(k) = -1108._r8*asn(i,k)*Eii* &
+ pi**((1._r8-bs)/3._r8)*rhosn**((-2._r8-bs)/3._r8)*rho(i,k)** &
+ ((2._r8+bs)/3._r8)*qniic(i,k)**((2._r8+bs)/3._r8)* &
+ (nsic(i,k)*rho(i,k))**((4._r8-bs)/3._r8)/ &
+ (4._r8*720._r8*rho(i,k))
+ else
+ nsagg(k)=0._r8
+ end if
+
+ !.......................................................................
+ ! accretion of cloud droplets onto snow/graupel
+ ! here use continuous collection equation with
+ ! simple gravitational collection kernel
+ ! ignore collisions between droplets/cloud ice
+
+ ! ignore collision of snow with droplets above freezing
+
+ if (qniic(i,k).ge.qsmall .and. t(i,k).le.273.15_r8 .and. &
+ qcic(i,k).ge.qsmall) then
+
+ ! put in size dependent collection efficiency
+ ! mean diameter of snow is area-weighted, since
+ ! accretion is function of crystal geometric area
+ ! collection efficiency is from stoke's law (Thompson et al. 2004)
+
+ dc0 = (pgam(i,k)+1._r8)/lamc(i,k)
+ ds0 = 1._r8/lams(k)
+ dum = dc0*dc0*uns(k)*rhow/(9._r8*mua(i,k)*ds0)
+ eci = dum*dum/((dum+0.4_r8)*(dum+0.4_r8))
+ eci = max(eci,0._r8)
+ eci = min(eci,1._r8)
+
+ psacws(k) = pi/4._r8*asn(i,k)*qcic(i,k)*rho(i,k)* &
+ n0s(k)*Eci*gamma(bs+3._r8)/ &
+ lams(k)**(bs+3._r8)
+ npsacws(k) = pi/4._r8*asn(i,k)*ncic(i,k)*rho(i,k)* &
+ n0s(k)*Eci*gamma(bs+3._r8)/ &
+ lams(k)**(bs+3._r8)
+ else
+ psacws(k)=0._r8
+ npsacws(k)=0._r8
+ end if
+
+ ! secondary ice production due to accretion of droplets by snow
+ ! (Hallet-Mossop process) (from Cotton et al., 1986)
+ if((t(i,k).lt.270.16_r8) .and. (t(i,k).ge.268.16_r8)) then
+ ni_secp = 3.5e8_r8*(270.16_r8-t(i,k))/2.0_r8*psacws(k)
+ nsacwi(k) = ni_secp
+ msacwi(k) = min(ni_secp*mi0,psacws(k))
+ else if((t(i,k).lt.268.16_r8) .and. (t(i,k).ge.265.16_r8)) then
+ ni_secp = 3.5e8_r8*(t(i,k)-265.16_r8)/3.0_r8*psacws(k)
+ nsacwi(k) = ni_secp
+ msacwi(k) = min(ni_secp*mi0,psacws(k))
+ else
+ ni_secp = 0.0_r8
+ nsacwi(k) = 0.0_r8
+ msacwi(k) = 0.0_r8
+ endif
+ psacws(k) = max(0.0_r8,psacws(k)-ni_secp*mi0)
+
+!........................................................................
+! conversion of rimed cloud water onto snow to graupel/hail
+
+! only allow conversion if qni > 0.1 and qc > 0.5 g/kg following rutledge and
+! hobbs (1984)
+
+ if (psacws(k).gt.0._r8 .and. qniic(i,k).ge.0.1e-3_r8.and.qcic(i,k).ge.0.5e-3_r8) then
+! if (ums(k).eq.0._r8) write(iulog,*) "ums=0., k=",k,"i=",i
+! portion of riming converted to graupel (reisner et al. 1998, originally
+! is1991)
+ dt = dz(i,k)/ums(k)
+ pgsacw(k) = min(psacws(k),cons17*dt*n0s(k)*qcic(i,k)*qcic(i,k)* &
+ asn(i,k)*asn(i,k)*rho(i,k)/(lams(k)**(2._r8*bs+2._r8)))
+
+! mix rat converted into graupel as embryo (reisner et al. 1998, orig m1990)
+ dum = max(rhosn/(rhog-rhosn)*pgsacw(k),0._r8)
+
+! number concentraiton of embryo graupel from riming of snow
+ nscng(k) = dum/mg0
+! limit max number converted to snow number
+! nscng(k) = min(nscng(k),nsic(i,k)/dt)
+
+! portion of riming left for snow
+ psacws(k) = psacws(k) - pgsacw(k)
+ else
+ pgsacw(k) = 0._r8
+ nscng(k) = 0._r8 !
+ end if
+
+! cloud ice collecting droplets, assume that cloud ice mean diam > 100 micron
+! before riming can occur
+! assume that rime collected on cloud ice does not lead
+! to hallet-mossop splintering
+
+ if (qiic(i,k).ge.1.e-8_r8 .and. qcic(i,k).ge.qsmall) then
+ if (1._r8/lami(k).ge.100.e-6_r8 ) then
+
+ ! put in size dependent collection efficiency based on stokes law
+ ! from thompson et al. 2004, mwr
+
+ psacwi(k) = cons16*ain(i,k)*qcic(i,k)*rho(i,k)* &
+ n0i(k)/lami(k)**(bi+3._r8)
+ npsacwi(k) = cons16*ain(i,k)*ncic(i,k)*rho(i,k)* &
+ n0i(k)/lami(k)**(bi+3._r8)
+ else
+ psacwi(k) = 0._r8
+ npsacwi(k) = 0._r8
+ end if
+ else
+ psacwi(k) = 0._r8
+ npsacwi(k) = 0._r8
+ end if
+
+
+ !............................................................................
+ ! collection of cloud water by graupel
+
+ if (qgic(i,k).ge.1.e-8_r8 .and. qcic(i,k).ge.qsmall .and. t(i,k).le.273.15_r8) then
+
+ psacwg(k) = cons14*agn(i,k)*qcic(i,k)*rho(i,k)* &
+ n0g(k)/ &
+ lamg(k)**(bg+3._r8)
+ npsacwg(k) = cons14*agn(i,k)*ncic(i,k)*rho(i,k)* &
+ n0g(k)/ &
+ lamg(k)**(bg+3._r8)
+ else
+ psacwg(k) = 0._r8
+ npsacwg(k) = 0._r8
+ end if
+
+
+ !.......................................................................
+ ! 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._r8)+ &
+ 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._r8+ &
+ 0.3_r8*unr(k)*uns(k))**0.5_r8*n0r(k)*n0s(k)* &
+ (1._r8/(lamr(k)**3._r8*lams(k))+ &
+ 1._r8/(lamr(k)**2._r8*lams(k)**2._r8)+ &
+ 1._r8/(lamr(k)*lams(k)**3._r8))
+
+
+ ! collection of snow by rain - needed for graupel conversion calculations
+ ! only calculate if snow and rain mixing ratios exceed 0.1 g/kg
+
+ if (qniic(i,k).ge.0.1e-3_r8.and.qric(i,k).ge.0.1e-3_r8) then
+ psacr(k) = cons31*(((1.2_r8*umr(k)-0.95_r8*ums(k))**2+ &
+ 0.08_r8*ums(k)*umr(k))**0.5_r8*rho(i,k)* &
+ n0r(k)*n0s(k)/lams(k)**3._r8* &
+ (5._r8/(lams(k)**3._r8*lamr(k))+ &
+ 2._r8/(lams(k)**2._r8*lamr(k)**2._r8)+ &
+ 0.5_r8/(lams(k)*lamr(k)**3._r8)))
+ else
+ psacr(k) = 0._r8
+ end if
+
+ else
+ pracs(k)=0._r8
+ npracs(k)=0._r8
+ psacr(k) = 0._r8
+ end if
+
+
+ ! conversion of rimed rainwater onto snow converted to graupel
+
+ ! only allow conversion if qni > 0.1 and qr > 0.1 g/kg following rutledge and
+ ! hobbs (1984)
+ if (pracs(k).gt.0._r8 .and. qniic(i,k).ge.0.1e-3_r8.and.qric(i,k).ge.0.1e-3_r8) then
+ ! portion of collected rainwater converted to graupel (reisner et al. 1998)
+ dum = cons18*(4._r8/lams(k))**3._r8*(4._r8/lams(k))**3._r8 &
+ /(cons18*(4._r8/lams(k))**3._r8*(4._r8/lams(k))**3._r8+ &
+ cons19*(4._r8/lamr(k))**3._r8*(4._r8/lamr(k))**3._r8)
+ dum=min(dum,1._r8)
+ dum=max(dum,0._r8)
+ pgracs(k) = (1._r8-dum)*pracs(k)
+ ngracs(k) = (1._r8-dum)*npracs(k)
+
+ ! amount left for snow production
+ pracs(k) = pracs(k) - pgracs(k)
+ npracs(k) = npracs(k) - ngracs(k)
+ ! conversion to graupel due to collection of snow by rain
+ psacr(k)=psacr(k)*(1._r8-dum)
+ else
+ pgracs(k) = 0._r8
+ ngracs(k) = 0._r8
+ end if
+
+!.......................................................................
+
+! collection of rainwater by graupel, from ikawa and saito 1990,
+! used by reisner et al 1998
+ if (qric(i,k).ge.1.e-8.and.qgic(i,k).ge.1.e-8) then
+
+ pracg(k) = cons41*(((1.2_r8*umr(k)-0.95_r8*umg(k))**2._r8+ &
+ 0.08_r8*umg(k)*umr(k))**0.5_r8*rho(i,k)* &
+ n0r(k)*n0g(k)/lamr(k)**3* &
+ (5._r8/(lamr(k)**3._r8*lamg(k))+ &
+ 2._r8/(lamr(k)**2._r8*lamg(k)**2._r8)+ &
+ 0.5_r8/(lamr(k)*lamg(k)**3._r8)))
+
+ npracg(k) = cons32*rho(i,k)*(1.7_r8*(unr(k)-ung(k))**2._r8+ &
+ 0.3_r8*unr(k)*ung(k))**0.5_r8*n0r(k)*n0g(k)* &
+ (1._r8/(lamr(k)**3._r8*lamg(k))+ &
+ 1._r8/(lamr(k)**2*lamg(k)**2._r8)+ &
+ 1._r8/(lamr(k)*lamg(k)**3._r8))
+
+ else
+ pracg(k) = 0._r8
+ npracg(k) = 0._r8
+ end if
+
+!.......................................................................
+! rime-splintering - graupel
+! hallet-mossop (1974)
+! number of splinters formed is based on mass of rimed water
+
+! dum1 = mass of individual splinters
+
+! hm add threshold snow mixing ratio for rime-splintering
+! to limit rime-splintering in stratiform clouds
+
+ fmult = 0._r8
+ nmultg(k) = 0._r8
+ qmultg(k) = 0._r8
+ nmultrg(k) = 0._r8
+ qmultrg(k) = 0._r8
+ if (qgic(i,k).ge.0.1e-3_r8) then
+ if (qcic(i,k).ge.0.5e-3_r8.or.qric(i,k).ge.0.1e-3_r8) then
+ if (psacwg(k).gt.0._r8.or.pracg(k).gt.0._r8) then
+ if((t(i,k).lt.270.16_r8) .and. (t(i,k).ge.265.16_r8)) then
+ if((t(i,k).lt.270.16_r8) .and. (t(i,k).ge.268.16_r8)) &
+ fmult = (270.16_r8-t(i,k))/2._r8
+ if(t(i,k).ge.265.16_r8 .and. t(i,k).lt.268.16_r8) &
+ fmult = (t(i,k)-265.16_r8)/3._r8
+
+! 1000 is to convert from kg to g
+! splintering from droplets accreted onto graupel
+
+ if (psacwg(k).gt.0._r8) then
+ nmultg(k) = 35.e4_r8*psacwg(k)*fmult
+ qmultg(k) = nmultg(k)*mmult
+
+! constrain so that transfer of mass from graupel to ice cannot be more mass
+! than was rimed onto graupel
+
+ qmultg(k) = min(qmultg(k),psacwg(k))
+ psacwg(k) = psacwg(k)-qmultg(k)
+ end if
+
+! riming and splintering from accreted raindrops
+
+ if (pracg(k).gt.0._r8) then
+ nmultrg(k) = 35.e4_r8*pracg(k)*fmult
+ qmultrg(k) = nmultrg(k)*mmult
+
+! constrain so that transfer of mass from graupel to ice cannot be more mass
+! than was rimed onto graupel
+
+ qmultrg(k) = min(qmultrg(k),pracg(k))
+ pracg(k) = pracg(k)-qmultrg(k)
+ end if
+ end if
+ end if
+ end if
+ end if
+
+ !.......................................................................
+ ! 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._r8 &
+ /lamr(k)**3._r8
+
+ nnuccr(k) = pi*nric(i,k)*bimm* &
+ (exp(aimm*(273.15_r8-t(i,k)))-1._r8)/lamr(k)**3._r8
+ else
+ mnuccr(k)=0._r8
+ nnuccr(k)=0._r8
+ end if
+
+ !.......................................................................
+ ! accretion of cloud liquid water by rain
+ ! formula from Khrouditnov and Kogan (2000)
+ ! gravitational collection kernel, droplet fall speed neglected
+
+ if (qric(i,k).ge.qsmall .and. qcic(i,k).ge.qsmall) then
+ pra(k) = accr_fac*67._r8*(qcic(i,k)*qric(i,k))**1.15_r8
+ npra(k) = pra(k)/(qcic(i,k)/ncic(i,k))
+ else
+ pra(k)=0._r8
+ npra(k)=0._r8
+ end if
+
+ !.......................................................................
+ ! Self-collection of rain drops
+ ! from Beheng(1994)
+
+ if (qric(i,k).ge.qsmall) then
+ nragg(k) = -8._r8*nric(i,k)*qric(i,k)*rho(i,k)
+ else
+ nragg(k)=0._r8
+ end if
+
+ !.......................................................................
+ ! Accretion of cloud ice by snow
+ ! For this calculation, it is assumed that the Vs >> Vi
+ ! and Ds >> Di for continuous collection
+
+ if (qniic(i,k).ge.qsmall.and.qiic(i,k).ge.qsmall &
+ .and.t(i,k).le.273.15_r8) then
+ prai(k) = pi/4._r8*asn(i,k)*qiic(i,k)*rho(i,k)* &
+ n0s(k)*Eii*gamma(bs+3._r8)/ &
+ lams(k)**(bs+3._r8)
+ nprai(k) = pi/4._r8*asn(i,k)*niic(i,k)* &
+ rho(i,k)*n0s(k)*Eii*gamma(bs+3._r8)/ &
+ lams(k)**(bs+3._r8)
+ else
+ prai(k)=0._r8
+ nprai(k)=0._r8
+ end if
+
+!.......................................................................
+! hm, add 12/13/06, collision of rain and ice to produce snow or graupel
+! follows reisner et al. 1998
+! assumed fallspeed and size of ice crystal << than for rain
+
+ niacr(k)= 0._r8
+ piacr(k)= 0._r8
+ praci(k)= 0._r8
+ niacrs(k) = 0._r8
+ piacrs(k)= 0._r8
+ pracis(k)= 0._r8
+ if (qric(i,k).ge.1.e-8_r8.and.qiic(i,k).ge.1.e-8_r8.and.t(i,k).le.273.15_r8) then
+
+! allow graupel formation from rain-ice collisions only if rain mixing ratio >
+! 0.1 g/kg,
+! otherwise add to snow
+
+ if (qric(i,k).ge.0.1e-3_r8) then
+ niacr(k)=cons24*niic(i,k)*n0r(k)*arn(i,k) &
+ /lamr(k)**(br+3._r8)*rho(i,k)
+ piacr(k)=cons25*niic(i,k)*n0r(k)*arn(i,k) &
+ /lamr(k)**(br+3._r8)/lamr(k)**3*rho(i,k)
+ praci(k)=cons24*qiic(i,k)*n0r(k)*arn(i,k)/ &
+ lamr(k)**(br+3._r8)*rho(i,k)
+ else
+ niacrs(k)=cons24*niic(i,k)*n0r(k)*arn(i,k) &
+ /lamr(k)**(br+3._r8)*rho(i,k)
+ piacrs(k)=cons25*niic(i,k)*n0r(k)*arn(i,k) &
+ /lamr(k)**(br+3._r8)/lamr(k)**3*rho(i,k)
+ pracis(k)=cons24*qiic(i,k)*n0r(k)*arn(i,k)/ &
+ lamr(k)**(br+3._r8)*rho(i,k)
+ end if
+ end if
+
+ !.......................................................................
+ ! fallout term
+ prf(k) = -umr(k)*qric(i,k)/dz(i,k)
+ pnrf(k) = -unr(k)*nric(i,k)/dz(i,k)
+ psf(k) = -ums(k)*qniic(i,k)/dz(i,k)
+ pnsf(k) = -uns(k)*nsic(i,k)/dz(i,k)
+ pgf(k) = -umg(k)*qgic(i,k)/dz(i,k)
+ pngf(k) = -ung(k)*ngic(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 actdrop_mam_calc( &
+ wu(i,k), wmix, wdiab, wmin, wmax, &
+ t(i,k), rho(i,k), naermod, aero%nmodes, vaerosol, &
+ hygro, in_cloud, smax_f, fn, fm, &
+ fluxn, fluxm, flux_fullact)
+
+ 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_conv( &
+ wu(i,k), t(i,k), relhum(i,k), 1.0_r8, qcic(i,k), &
+ 0.0_r8, rho(i,k), so4_num, dst_num, soot_num, .true., &
+ dum2i(i,k), nihf(i,k), niimm(i,k), nidep(i,k), nimey(i,k) )
+
+ 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)
+
+ 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 (.false.) then
+ 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
+ else
+ ! Rotstayn et al.(2000)
+ 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
+ ! Eqs.(3) and (4)
+ a_prime = Ls_b*(Ls_b/(Rv_b*t(i,k))-1._r8)/(Ka_b*t(i,k))
+ b_prime = Rv_b*t(i,k)*ph(i,k)/(2.21_r8*esi(i,k))
+ ! In Rotstayn et al.(2000), Ni is in units of #/m3. Since here nicc is in
+ ! units of #/kg, we do not need to calculate Ni/rho.
+ ! sphere
+! csvd = 7.8_r8*niic(i,k)**c23*(es(i,k)-esi(i,k))/ &
+! (rhoi13*(a_prime+b_prime)*esi(i,k))
+! dqi = max(0._r8,(c23*csvd*deltat+qiic(i,k)**c23)**1.5_r8-qiic(i,k))
+ ! plate
+ cpvd = 65.2_r8*niic(i,k)**0.5_r8*(es(i,k)-esi(i,k))/ &
+ ((a_prime+b_prime)*esi(i,k))
+ dqi = max(0._r8,(0.5_r8*cpvd*deltat+qiic(i,k)**0.5_r8)**2._r8-qiic(i,k))
+ prb(k) = min(qcic(i,k),dqi)/deltat
+ ! decrease in droplet number concentration
+ nprb(k) = prb(k)/(qcic(i,k)/ncic(i,k))
+ else
+ prb(k)=0._r8
+ nprb(k)=0._r8
+ end if
+ 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._r8/lamc(i,k)**3._r8
+
+ 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._r8
+ 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._r8
+
+ nnucct(k) = (dfaer1*nacon1+dfaer2*nacon2+dfaer3*nacon3+dfaer4*nacon4)*2._r8*pi* &
+ cdist1(k)*gamma(pgam(i,k)+2._r8)/lamc(i,k)
+
+ 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)+psacwg(k)+pgsacw(k) +qmultg(k)+psacwi(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
+ psacwg(k) = 0._r8
+ pgsacw(k) = 0._r8
+ qmultg(k) = 0._r8
+ psacwi(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
+ psacwg(k) = psacwg(k)*ratio
+ pgsacw(k) = pgsacw(k)*ratio
+ qmultg(k) = qmultg(k)*ratio
+ psacwi(k) = psacwi(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)+npsacwg(k)+npsacwi(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
+ npsacwg(k)= 0._r8
+ npsacwi(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
+ npsacwg(k)= npsacwg(k)*ratio
+ npsacwi(k)=npsacwi(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)+pracg(k)+pgracs(k) &
+ +piacr(k)+piacrs(k)+qmultrg(k) )
+
+ if (qre.lt.0._r8) then
+ prf(k) = 0._r8
+ pracs(k) = 0._r8
+ mnuccr(k) = 0._r8
+ pracg(k) = 0._r8
+ pgracs(k)= 0._r8
+ piacr(k) = 0._r8
+ piacrs(k)= 0._r8
+ qmultrg(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
+ pracg(k) = pracg(k)*ratio
+ pgracs(k)= pgracs(k)*ratio
+ piacr(k) = piacr(k)*ratio
+ piacrs(k)= piacrs(k)*ratio
+ qmultrg(k)=qmultrg(k)*ratio
+ end if
+
+ if (k-1==jt(i)+1) then
+ dum = pra(k)+prc(k)-pracs(k)-mnuccr(k)-pracg(k)-pgracs(k) &
+ -piacr(k)-piacrs(k) -qmultrg(k)
+ if (dum.lt.0._r8) then
+ if (mnuccr(k).gt.0._r8) then
+ mnuccr(k) = max(mnuccr(k)+dum/omsm, 0._r8)
+ else
+ pracg(k) = max(pracg(k)+dum/omsm, 0._r8)
+ end if
+ end if
+ 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)+niacr(k)+niacrs(k)+ npracg(k)-ngracs(k) )
+ if(nre.lt.0._r8) then
+ npracs(k)= 0._r8
+ nnuccr(k)= 0._r8
+ nragg(k) = 0._r8
+ pnrf(k) = 0._r8
+ niacr(k) = 0._r8
+ niacrs(k)= 0._r8
+ npracg(k)= 0._r8
+ ngracs(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
+ niacr(k) = niacr(k)*ratio
+ niacrs(k)=niacrs(k)*ratio
+ npracg(k)=npracg(k)*ratio
+ ngracs(k)=ngracs(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)+qmultg(k)+qmultrg(k)+psacwi(k))*arcf(i,k) )
+ dum = arcf(i,k)*(prci(k)+ prai(k)+praci(k)+pracis(k))*dz(i,k)
+ if (qie.lt.0._r8) then
+ qiimp(k) = .true.
+ prci(k) = 0._r8
+ prai(k) = 0._r8
+ praci(k)= 0._r8
+ pracis(k)= 0._r8
+ else if (dum.gt.qie) then
+ ratio = qie/dum*omsm
+ prci(k) = prci(k)*ratio
+ prai(k) = prai(k)*ratio
+ praci(k)= praci(k)*ratio
+ pracis(k) = pracis(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)+nmultg(k)+ nmultrg(k))*arcf(i,k) )
+ dum = arcf(i,k)*dz(i,k)*(-nsacwi(k)+nprci(k)+ nprai(k)+niacr(k)+niacrs(k))
+ if( nie.lt.0._r8) then
+ niimp(k) = .true.
+ nsacwi(k)= 0._r8
+ nprci(k) = 0._r8
+ nprai(k) = 0._r8
+ niacr(k) = 0._r8
+ niacrs(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
+ niacr(k) = niacr(k)*ratio
+ niacrs(k)=niacrs(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)+piacrs(k)+pracis(k) )*arcf(i,k) )
+ dum = arcf(i,k)*dz(i,k)*(-psf(k)+ psacr(k) )
+
+ if(qnie.lt.0._r8) then
+ psf(k) = 0._r8
+ psacr(k) = 0._r8
+ else if (dum.gt.qnie) then
+ ratio = qnie/dum*omsm
+ psf(k) = psf(k)*ratio
+ psacr(k)= psacr(k)*ratio
+ end if
+
+ ! conservation of ns
+ nse = mu(i,k)*ns(i,k)+dz(i,k)*(nprci(k)+niacrs(k))*arcf(i,k)
+ dum = arcf(i,k)*dz(i,k)*(-nsagg(k)-pnsf(k)+nscng(k)+ngracs(k))
+ if (nse.lt.0._r8) then
+ nsagg(k) = 0._r8
+ pnsf(k) = 0._r8
+ nscng(k) = 0._r8
+ ngracs(k) = 0._r8
+ else if (dum.gt.nse) then
+ ratio = nse/dum*omsm
+ nsagg(k) = nsagg(k)*ratio
+ pnsf(k) = pnsf(k)*ratio
+ nscng(k) = nscng(k)*ratio
+ ngracs(k) = ngracs(k)*ratio
+ end if
+
+ ! conservation of qg
+
+ qge = mu(i,k)*qg(i,k)+dz(i,k)*(pracg(k)+psacwg(k)+pgsacw(k) &
+ +pgracs(k)+mnuccr(k)+piacr(k)+praci(k)+psacr(k))*arcf(i,k)
+
+ dum = arcf(i,k)*dz(i,k)*(-pgf(k))
+
+ if(qge.lt.0._r8) then
+ pgf(k) = 0._r8
+ else if (dum.gt.qge) then
+ ratio = qge/dum*omsm
+ pgf(k) = pgf(k)*ratio
+ end if
+
+ ! conservation of ng
+ nge = mu(i,k)*ng(i,k)+dz(i,k)*(nscng(k)+ngracs(k)+nnuccr(k)+niacr(k))*arcf(i,k)
+ dum = arcf(i,k)*dz(i,k)*(-pngf(k))
+ if (nge.lt.0._r8) then
+ pngf(k) = 0._r8
+ else if (dum.gt.nge) then
+ ratio = nge/dum*omsm
+ pngf(k) = pngf(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))-psacwg(k) -pgsacw(k) -qmultg(k)-psacwi(k)
+
+ qitend(i,k) = (prb(k)+mnuccc(k)+mnucct(k)+msacwi(k)-prci(k)- prai(k)) &
+ -praci(k)-pracis(k)+qmultg(k)+ qmultrg(k)+psacwi(k)
+
+ qrtend(i,k) = pra(k)+prc(k)-pracs(k)-mnuccr(k)-pracg(k)-pgracs(k) &
+ -piacr(k)-piacrs(k) -qmultrg(k)
+
+ qnitend(i,k) = (prai(k)+psacws(k)+prci(k))+pracs(k)-psacr(k)+piacrs(k) &
+ +pracis(k)
+
+ qgtend(i,k) = (pracg(k)+psacwg(k)+pgsacw(k)+pgracs(k)+ &
+ +mnuccr(k)+piacr(k)+praci(k)+psacr(k))
+
+ if ((qnitend(i,k)+qrtend(i,k)+qgtend(i,k))<0._r8) then
+ dum = (qnitend(i,k)+qrtend(i,k)+qgtend(i,k))/omsm
+ qrtend(i,k) = qrtend(i,k) - dum
+ qmultrg(k) = qmultrg(k) + dum
+ qitend(i,k) = qitend(i,k) + dum
+ end if
+
+ ! 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)- npsacwg(k)-npsacwi(k))
+
+ nitend(i,k) = nnuccd(k)*mtime+(nnuccc(k)+ nnucct(k)+nsacwi(k)-nprci(k)- &
+ nprai(k)) - niacr(k)-niacrs(k)+nmultg(k)+ nmultrg(k)
+
+ nstend(i,k) = nsagg(k) + nprci(k)- nscng(k)-ngracs(k)+niacrs(k)
+
+ nrtend(i,k) = nprc(k)+(-npracs(k)-nnuccr(k) +nragg(k))-niacr(k)-niacrs(k) &
+ -npracg(k)-ngracs(k)
+
+ ngtend(i,k) = (nscng(k)+ngracs(k)+nnuccr(k)+niacr(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)
+
+ accgrm(i,k-1) = -pracg(k)*arcf(i,k) !rain
+ accglm(i,k-1) = -psacwg(k)*arcf(i,k) !droplet
+ accgslm(i,k-1)= -pgsacw(k)*arcf(i,k) !droplet
+ accgsrm(i,k-1)= -pgracs(k)*arcf(i,k) !rain
+ accgirm(i,k-1)= -piacr(k)*arcf(i,k) !rain
+ accgrim(i,k-1)= -praci(k)*arcf(i,k) !ice
+ accgrsm(i,k-1)= -psacr(k)*arcf(i,k) !snow
+
+ accgsln(i,k-1)= -nscng(k)*arcf(i,k) !snow
+ accgsrn(i,k-1)= -ngracs(k)*arcf(i,k) !snow, rain
+ accgirn(i,k-1)= -niacr(k)*arcf(i,k) !ice ,rain
+
+ accsrim(i,k-1)= -pracis(k)*arcf(i,k) !ice
+ acciglm(i,k-1)= -qmultg(k)*arcf(i,k) !droplet
+ accigrm(i,k-1)= qmultrg(k)*arcf(i,k) !ice
+ accsirm(i,k-1)= -piacrs(k)*arcf(i,k) !rain
+
+ accigln(i,k-1)= nmultg(k)*arcf(i,k) !ice
+ accigrn(i,k-1)= nmultrg(k)*arcf(i,k) !ice
+ accsirn(i,k-1)= -niacrs(k)*arcf(i,k) !ice,rain
+ accgln(i,k-1) = -npsacwg(k)*arcf(i,k) !droplet
+ accgrn(i,k-1) = -npracg(k)*arcf(i,k) !rain
+
+ accilm(i,k-1) = -psacwi(k)*arcf(i,k) !droplet
+ acciln(i,k-1) = -npsacwi(k)*arcf(i,k) !droplet
+
+ fallrm(i,k-1) = prf(k)*arcf(i,k) !rain
+ fallsm(i,k-1) = psf(k)*arcf(i,k) !snow
+ fallgm(i,k-1) = pgf(k)*arcf(i,k) !graupel
+ fallrn(i,k-1) = pnrf(k)*arcf(i,k) !rain
+ fallsn(i,k-1) = pnsf(k)*arcf(i,k) !snow
+ fallgn(i,k-1) = pngf(k)*arcf(i,k) !graupel
+ else
+ qctend(i,k) = 0._r8
+ qitend(i,k) = 0._r8
+ qrtend(i,k) = 0._r8
+ qnitend(i,k) = 0._r8
+ qgtend(i,k) = 0._r8
+ nctend(i,k) = 0._r8
+ nitend(i,k) = 0._r8
+ nstend(i,k) = 0._r8
+ nrtend(i,k) = 0._r8
+ ngtend(i,k) = 0._r8
+ end if
+
+ !********************************************************************************
+ ! vertical integration
+ !********************************************************************************
+ ! graupel
+ if ( k.le.kqi(i) ) then
+ qg(i,k-1) = 1._r8/mu(i,k-1)* &
+ (mu(i,k)*qg(i,k)+dz(i,k)*(qgtend(i,k)+pgf(k))*arcf(i,k) )
+
+ ng(i,k-1) = 1._r8/mu(i,k-1)* &
+ (mu(i,k)*ng(i,k)+dz(i,k)*(ngtend(i,k)+pngf(k))*arcf(i,k) )
+ ng(i,k-1) = max(ng(i,k-1),0._r8)
+ else
+ qg(i,k-1)=0._r8
+ ng(i,k-1)=0._r8
+ end if
+
+ if (qg(i,k-1).le.0._r8) then
+ qg(i,k-1)=0._r8
+ ng(i,k-1)=0._r8
+ end if
+
+
+
+ ! snow
+ if ( k.le.kqi(i) ) then
+ qni(i,k-1) = 1._r8/(mu(i,k-1)+dz(i,k)*du(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)+dz(i,k)*du(i,k-1) )* &
+ (mu(i,k)*ns(i,k)+dz(i,k)*(nstend(i,k)+pnsf(k))*arcf(i,k) )
+ ns(i,k-1) = max(ns(i,k-1),0._r8)
+ qnide(i,k) = qni(i,k-1)
+ nsde(i,k) = ns(i,k-1)
+ else
+ qni(i,k-1)=0._r8
+ ns(i,k-1)=0._r8
+ end if
+ dsfm(i,k-1) = -du(i,k-1)*qnide(i,k)
+ dsfn(i,k-1) = -du(i,k-1)*nsde(i,k)
+
+ 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) )
+ nr(i,k-1) = max(nr(i,k-1),0._r8)
+ 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
+ fhmrm(i,k-1) = -mu(i,k-1)*dum*qr(i,k-1)/dz(i,k)
+ if (k-1==jt(i)+1 .and. (qrtend(i,k)*arcf(i,k)+fhmrm(i,k-1))<0._r8) then
+ fhmrm(i,k-1) = -qrtend(i,k)*arcf(i,k)
+ dum = -fhmrm(i,k-1)*dz(i,k)/mu(i,k-1)/qr(i,k-1)
+ end if
+
+ if (.true.) then
+ qg(i,k-1)=qg(i,k-1)+dum*qr(i,k-1)
+ ng(i,k-1)=ng(i,k-1)+dum*nr(i,k-1)
+ ng(i,k-1) = max(ng(i,k-1),0._r8)
+ else
+ 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)
+ ns(i,k-1) = max(ns(i,k-1),0._r8)
+ end if
+ qr(i,k-1)=(1._r8-dum)*qr(i,k-1)
+ nr(i,k-1)=(1._r8-dum)*nr(i,k-1)
+ nr(i,k-1) = max(nr(i,k-1),0._r8)
+ end if
+
+ ! snow detrainment adjustment
+ dum = min((qnitend(i,k)+qrtend(i,k)+qgtend(i,k))*arcf(i,k),(qnitend(i,k)+qgtend(i,k))*arcf(i,k)-fhmrm(i,k-1))
+ if ( dum+dsfm(i,k-1).lt.0._r8) then
+ if (dsfm(i,k-1).ne.0._r8) then
+ dsfn(i,k-1) = dsfn(i,k-1)*(-dum*omsm)/dsfm(i,k-1)
+ dsfm(i,k-1) = -dum*omsm
+ qnide(i,k) = -dsfm(i,k-1)/du(i,k-1)
+ nsde(i,k) = -dsfn(i,k-1)/du(i,k-1)
+ qni(i,k-1) = qni(i,k-1) + dz(i,k)*du(i,k-1)*(qni(i,k-1)-qnide(i,k))/mu(i,k-1)
+ ns(i,k-1) = ns(i,k-1) + dz(i,k)*du(i,k-1)*(ns(i,k-1)-nsde(i,k))/mu(i,k-1)
+ ns(i,k-1) = max(ns(i,k-1),0._r8)
+ end if
+ end if
+
+ rprd(i,k-1)= (qnitend(i,k) + qrtend(i,k)+ qgtend(i,k) )*arcf(i,k) + dsfm(i,k-1)
+ sprd(i,k-1)= (qnitend(i,k)+qgtend(i,k)) *arcf(i,k) -fhmrm(i,k-1) + dsfm(i,k-1)
+
+ ! 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))
+ nc(i,k-1) = max(nc(i,k-1),0._r8)
+ 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))
+ ni(i,k-1) = max(ni(i,k-1),0._r8)
+ 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) then
+ write(iulog,*) "negative qi(i,k-1)=",qi(i,k-1),"k-1=",k-1,"qitend=",qitend(i,k)
+ write(*,*) "prb=",prb(k),"mnuccc=",mnuccc(k),"mnucct=",mnucct(k),"msacwi=",msacwi(k), &
+ "prci=",prci(k),"prai=", prai(k),"praci=",praci(k),"pracis=", pracis(k), &
+ "qmultg=", qmultg(k),"qmultrg=", qmultrg(k)
+
+ end if
+ 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)+pracg(k)+psacwg(k)+pgsacw(k)+pgracs(k)+ &
+ piacr(k)+piacrs(k)+qmultg(k)+ qmultrg(k)+psacwi(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
+ 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
+ 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._r8)-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._r8*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._r8*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
+ if (nr(i,k-1).lt. 0._r8) write(iulog,*) "nr(i,k-1)=",nr(i,k-1)
+ 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
+ nsorg = ns(i,k-1)
+ if (qni(i,k-1).ge.qsmall) then
+ if (ns(i,k-1).lt. 0._r8) write(iulog,*) "ns(i,k-1)=",ns(i,k-1)
+ 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/dcs
+ lammin = 1._r8/5000.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
+ dum=(rhosu/rho(i,k))**0.54
+ ums(k-1) = min(asn(i,k-1)*gamma(4._r8+bs)/(6._r8*lams(k-1)**bs),1.2_r8*dum)
+ uns(k-1) = min(asn(i,k-1)*gamma(1._r8+bs)/lams(k-1)**bs,1.2_r8*dum)
+ else
+ lams(k-1) = 0._r8
+ n0s(k-1) = 0._r8
+ ums(k-1) = 0._r8
+ uns(k-1) = 0._r8
+ end if
+
+ nsde(i,k) = ns(i,k-1)
+ dsfn(i,k-1) = -du(i,k-1)*nsde(i,k)
+
+ nsadj(i,k-1) = (ns(i,k-1)- nsorg)*mu(i,k-1)/dz(i,k)
+ trspsm(i,k-1) = (mu(i,k)*qni(i,k) - mu(i,k-1)*qni(i,k-1))/dz(i,k)
+ trspsn(i,k-1) = (mu(i,k)*ns(i,k) - mu(i,k-1)*ns(i,k-1))/dz(i,k)
+ if (k-1 .eq. jt(i)+1) then
+ trspsm(i,k-2) = mu(i,k-1)*qni(i,k-1)/dz(i,k-1)
+ trspsn(i,k-2) = mu(i,k-1)*ns(i,k-1)/dz(i,k-1)
+
+! no snow detrainment between jt and jt+1
+ qnide(i,k-1) = 0._r8
+ nsde(i,k-1) = 0._r8
+ dsfm (i,k-2) = 0._r8
+ dsfn (i,k-2) = 0._r8
+
+ end if
+
+ !graupel
+ if (qg(i,k-1).ge.qsmall) then
+
+ if (ng(i,k-1).lt. 0._r8) write(iulog,*) "ng(i,k-1)=",ng(i,k-1)
+ lamg(k-1) = (gamma(1._r8+dg)*cg*ng(i,k-1)/qg(i,k-1))**(1._r8/dg)
+ n0g(k-1) = ng(i,k-1)*lamg(k-1)
+
+ ! check for slope
+ ! adjust vars
+ lammax = 1._r8/20.e-6_r8
+ lammin = 1._r8/5000.e-6_r8
+
+ if (lamg(k-1).lt.lammin) then
+ lamg(k-1) = lammin
+ n0g(k-1) = lamg(k-1)**4._r8*qg(i,k-1)/(gamma(1._r8+dg)*cg)
+ ng(i,k-1) = n0g(k-1)/lamg(k-1)
+ else if (lamg(k-1).gt.lammax) then
+ lamg(k-1) = lammax
+ n0g(k-1) = lamg(k-1)**4._r8*qg(i,k-1)/(gamma(1._r8+dg)*cg)
+ ng(i,k-1) = n0g(k-1)/lamg(k-1)
+ end if
+ ! provisional graupel number and mass weighted mean fallspeed
+ ! (m/s)
+ dum=(rhosu/rho(i,k))**0.54
+ umg(k-1) = min(agn(i,k-1)*gamma(4._r8+bg)/(6._r8*lamg(k-1)**bg),20._r8*dum)
+ ung(k-1) = min(agn(i,k-1)*gamma(1._r8+bg)/lamg(k-1)**bg,20._r8*dum)
+ else
+ lamg(k-1) = 0._r8
+ n0g(k-1) = 0._r8
+ umg(k-1) = 0._r8
+ ung(k-1) = 0._r8
+ end if
+
+ end if ! k
-
+
+
+ NONE
+ 0
+
+
Dynamics
moist
+
+ 0
diff --git a/components/eamxx/cime_config/testdefs/testmods_dirs/scream/bfbhash/shell_commands b/components/eamxx/cime_config/testdefs/testmods_dirs/scream/bfbhash/shell_commands
new file mode 100644
index 000000000000..c0b42727ba49
--- /dev/null
+++ b/components/eamxx/cime_config/testdefs/testmods_dirs/scream/bfbhash/shell_commands
@@ -0,0 +1 @@
+./xmlchange --append SCREAM_ATMCHANGE_BUFFER='BfbHash=6'
diff --git a/components/eamxx/cmake/machine-files/chrysalis.cmake b/components/eamxx/cmake/machine-files/chrysalis.cmake
index efdb7d3dff81..add68b4b0799 100644
--- a/components/eamxx/cmake/machine-files/chrysalis.cmake
+++ b/components/eamxx/cmake/machine-files/chrysalis.cmake
@@ -1,4 +1,15 @@
include(${CMAKE_CURRENT_LIST_DIR}/common.cmake)
common_setup()
-set (SCREAM_INPUT_ROOT "/lcrc/group/e3sm/ccsm-data/inputdata/" CACHE STRING "" FORCE)
+set(EKAT_MACH_FILES_PATH ${CMAKE_CURRENT_LIST_DIR}/../../../../externals/ekat/cmake/machine-files)
+
+# Get AMD arch settings
+include(${EKAT_MACH_FILES_PATH}/kokkos/amd-zen2.cmake)
+
+# Add OpenMP settings in standalone mode OR e3sm with compile_threaded=ON
+if (NOT "${PROJECT_NAME}" STREQUAL "E3SM" OR compile_threaded)
+ include(${EKAT_MACH_FILES_PATH}/kokkos/openmp.cmake)
+endif()
+
+# Use srun for standalone testing
+include(${EKAT_MACH_FILES_PATH}/mpi/srun.cmake)
diff --git a/components/eamxx/cmake/machine-files/docker-scream.cmake b/components/eamxx/cmake/machine-files/docker-scream.cmake
new file mode 100644
index 000000000000..0287c5d399f7
--- /dev/null
+++ b/components/eamxx/cmake/machine-files/docker-scream.cmake
@@ -0,0 +1,21 @@
+include(${CMAKE_CURRENT_LIST_DIR}/common.cmake)
+common_setup()
+
+include (${EKAT_MACH_FILES_PATH}/kokkos/openmp.cmake)
+set(CMAKE_CXX_FLAGS "-DTHRUST_IGNORE_CUB_VERSION_CHECK" CACHE STRING "" FORCE)
+
+set(BLAS_LIBRARIES /opt/conda/lib/libblas.so CACHE STRING "")
+set(LAPACK_LIBRARIES /opt/conda/lib/liblapack.so CACHE STRING "")
+set(SCREAM_INPUT_ROOT "/storage/inputdata/" CACHE STRING "")
+set(PYBIND11_PYTHON_VERSION 3.9 CACHE STRING "")
+set(RUN_ML_CORRECTION_TEST TRUE CACHE BOOL "")
+
+if ("${PROJECT_NAME}" STREQUAL "E3SM")
+ if ("${CMAKE_CXX_COMPILER_ID}" STREQUAL "GNU")
+ if (CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10)
+ set(CMAKE_Fortran_FLAGS "-fallow-argument-mismatch" CACHE STRING "" FORCE) # only works with gnu v10 and above
+ endif()
+ endif()
+else()
+ set(CMAKE_Fortran_FLAGS "-fallow-argument-mismatch" CACHE STRING "" FORCE) # only works with gnu v10 and above
+endif()
\ No newline at end of file
diff --git a/components/eamxx/cmake/machine-files/docker.cmake b/components/eamxx/cmake/machine-files/docker.cmake
deleted file mode 100644
index 08899b9d7a3c..000000000000
--- a/components/eamxx/cmake/machine-files/docker.cmake
+++ /dev/null
@@ -1,11 +0,0 @@
-include(${CMAKE_CURRENT_LIST_DIR}/common.cmake)
-common_setup()
-
-include (${EKAT_MACH_FILES_PATH}/kokkos/openmp.cmake)
-set(CMAKE_CXX_FLAGS "-DTHRUST_IGNORE_CUB_VERSION_CHECK" CACHE STRING "" FORCE)
-
-set(BLAS_LIBRARIES /opt/conda/lib/libblas.so CACHE STRING "")
-set(LAPACK_LIBRARIES /opt/conda/lib/liblapack.so CACHE STRING "")
-set(SCREAM_INPUT_ROOT "/storage/inputdata/" CACHE STRING "")
-set(PYBIND11_PYTHON_VERSION 3.9 CACHE STRING "")
-set(RUN_ML_CORRECTION_TEST TRUE CACHE BOOL "")
\ No newline at end of file
diff --git a/components/eamxx/cmake/machine-files/quartz-intel.cmake b/components/eamxx/cmake/machine-files/quartz-intel.cmake
index b3ff0bc2da51..cefda8437da4 100644
--- a/components/eamxx/cmake/machine-files/quartz-intel.cmake
+++ b/components/eamxx/cmake/machine-files/quartz-intel.cmake
@@ -1,5 +1,3 @@
include(${CMAKE_CURRENT_LIST_DIR}/quartz.cmake)
-set(CMAKE_CXX_FLAGS "-w -cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh" CACHE STRING "" FORCE)
-set(CMAKE_EXE_LINKER_FLAGS "-L/usr/tce/packages/gcc/gcc-8.3.1/rh/lib/gcc/x86_64-redhat-linux/8/ -mkl" CACHE STRING "" FORCE)
-set(PYTHON_EXECUTABLE "/usr/tce/packages/python/python-3.8.2/bin/python3" CACHE STRING "" FORCE)
-set(RUN_ML_CORRECTION_TEST TRUE CACHE BOOL "")
\ No newline at end of file
+set(CMAKE_EXE_LINKER_FLAGS "-L/usr/tce/packages/gcc/gcc-10.3.1-magic/lib/gcc/x86_64-redhat-linux/10/ -qmkl" CACHE STRING "" FORCE)
+set(RUN_ML_CORRECTION_TEST TRUE CACHE BOOL "")
diff --git a/components/eamxx/cmake/machine-files/quartz.cmake b/components/eamxx/cmake/machine-files/quartz.cmake
index fde9385b33dc..24c97078475c 100644
--- a/components/eamxx/cmake/machine-files/quartz.cmake
+++ b/components/eamxx/cmake/machine-files/quartz.cmake
@@ -9,8 +9,7 @@ option(Kokkos_ARCH_BDW "" ON)
#if COMPILER is not defined, should be running standalone with quartz-intel or quartz-gcc
if ("${COMPILER}" STREQUAL "intel")
- set(CMAKE_CXX_FLAGS "-w -cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh" CACHE STRING "" FORCE)
- set(CMAKE_EXE_LINKER_FLAGS "-L/usr/tce/packages/gcc/gcc-8.3.1/rh/lib/gcc/x86_64-redhat-linux/8/ -mkl" CACHE STRING "" FORCE)
+ set(CMAKE_EXE_LINKER_FLAGS "-L/usr/tce/packages/gcc/gcc-10.3.1-magic/lib/gcc/x86_64-redhat-linux/10/ -qmkl" CACHE STRING "" FORCE)
elseif ("${COMPILER}" STREQUAL "gnu")
message(WARNING "You are using an unsupported e3sm compiler. For supported quartz compilers run ./${E3SM_ROOT}/cime/scripts/query_config --machines quartz")
set(CMAKE_CXX_FLAGS "-w" CACHE STRING "" FORCE)
diff --git a/components/eamxx/cmake/machine-files/ruby-intel.cmake b/components/eamxx/cmake/machine-files/ruby-intel.cmake
new file mode 100644
index 000000000000..5ebae48a9285
--- /dev/null
+++ b/components/eamxx/cmake/machine-files/ruby-intel.cmake
@@ -0,0 +1,5 @@
+include(${CMAKE_CURRENT_LIST_DIR}/ruby.cmake)
+set(CMAKE_CXX_FLAGS "-w -cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh" CACHE STRING "" FORCE)
+set(CMAKE_EXE_LINKER_FLAGS "-L/usr/tce/packages/gcc/gcc-8.3.1/rh/lib/gcc/x86_64-redhat-linux/8/ -mkl" CACHE STRING "" FORCE)
+set(PYTHON_EXECUTABLE "/usr/tce/packages/python/python-3.8.2/bin/python3" CACHE STRING "" FORCE)
+set(RUN_ML_CORRECTION_TEST TRUE CACHE BOOL "")
diff --git a/components/eamxx/cmake/machine-files/ruby.cmake b/components/eamxx/cmake/machine-files/ruby.cmake
new file mode 100644
index 000000000000..20a7eb008444
--- /dev/null
+++ b/components/eamxx/cmake/machine-files/ruby.cmake
@@ -0,0 +1,17 @@
+include(${CMAKE_CURRENT_LIST_DIR}/common.cmake)
+common_setup()
+
+# Load all kokkos settings from Ekat's mach file
+set(Kokkos_ENABLE_SERIAL TRUE CACHE BOOL "")
+
+# Enable Broadwell arch in Kokkos
+option(Kokkos_ARCH_BDW "" ON)
+# Load Broadwell flags and openmp backend for kokkos
+include (${EKAT_MACH_FILES_PATH}/kokkos/intel-bdw.cmake)
+include (${EKAT_MACH_FILES_PATH}/kokkos/openmp.cmake)
+
+include (${EKAT_MACH_FILES_PATH}/mpi/srun.cmake)
+
+set(CMAKE_CXX_FLAGS "-w -cxxlib=/usr/tce/packages/gcc/gcc-8.3.1/rh" CACHE STRING "" FORCE)
+set(CMAKE_EXE_LINKER_FLAGS "-L/usr/tce/packages/gcc/gcc-8.3.1/rh/lib/gcc/x86_64-redhat-linux/8/ -mkl" CACHE STRING "" FORCE)
+
diff --git a/components/eamxx/data/scream_default_output.yaml b/components/eamxx/data/scream_default_output.yaml
index 6067d638c368..81ccf0293dac 100644
--- a/components/eamxx/data/scream_default_output.yaml
+++ b/components/eamxx/data/scream_default_output.yaml
@@ -63,7 +63,4 @@ output_control:
# WARNING: ERS/ERP tets will override this with STOP_N/STOP_OPTION
Frequency: ${HIST_N}
frequency_units: ${HIST_OPTION}
-Checkpoint Control:
- Frequency: ${REST_N}
- frequency_units: ${REST_OPTION}
...
diff --git a/components/eamxx/data/scream_default_remap.yaml b/components/eamxx/data/scream_default_remap.yaml
index f7bdfa0aff9d..6749034adc4b 100644
--- a/components/eamxx/data/scream_default_remap.yaml
+++ b/components/eamxx/data/scream_default_remap.yaml
@@ -62,7 +62,4 @@ Fields:
output_control:
Frequency: ${HIST_N}
frequency_units: ${HIST_OPTION}
-Checkpoint Control:
- Frequency: ${REST_N}
- frequency_units: ${REST_OPTION}
...
diff --git a/components/eamxx/docker/Dockerfile b/components/eamxx/docker/Dockerfile
index c2a1a5848e9c..4dcdc8371e0d 100644
--- a/components/eamxx/docker/Dockerfile
+++ b/components/eamxx/docker/Dockerfile
@@ -14,7 +14,7 @@ RUN mamba install --yes -c conda-forge \
rm -rf /opt/conda/pkgs/*
# Install dependencies
-COPY requirements.txt /tmp/requirements.txt
+COPY components/eamxx/docker/requirements.txt /tmp/requirements.txt
RUN pip install -r /tmp/requirements.txt
# install gcloud
@@ -28,4 +28,6 @@ RUN gcloud config set project vcm-ml
ENV OMPI_ALLOW_RUN_AS_ROOT=1
ENV OMPI_ALLOW_RUN_AS_ROOT_CONFIRM=1
-ENV IS_DOCKER=TRUE
\ No newline at end of file
+ENV IS_DOCKER=TRUE
+
+COPY / /src/E3SM
\ No newline at end of file
diff --git a/components/eamxx/docker/README.md b/components/eamxx/docker/README.md
index 8a2eb344460b..a5e92f819977 100644
--- a/components/eamxx/docker/README.md
+++ b/components/eamxx/docker/README.md
@@ -5,9 +5,10 @@ SCREAM Docker is built on top of CIME's Docker image. Make sure CIME image is bu
## Building the container
+From the top level of the SCREAM repository, run the following commands:
```bash
-docker build -t cime:latest --target base ../../../cime/docker/
-docker build -t scream:latest .
+docker build -t cime:latest --target base cime/docker/
+docker build --file components/eamxx/docker/Dockerfile -t scream:latest .
```
## Running the container
diff --git a/components/eamxx/scripts/jenkins/jenkins_common_impl.sh b/components/eamxx/scripts/jenkins/jenkins_common_impl.sh
index bc5837902c1f..dfd5cbb178a6 100755
--- a/components/eamxx/scripts/jenkins/jenkins_common_impl.sh
+++ b/components/eamxx/scripts/jenkins/jenkins_common_impl.sh
@@ -96,24 +96,33 @@ if [ $skip_testing -eq 0 ]; then
sa_fail=1
fi
- # Add a valgrind and coverage tests for mappy for nightlies
+ # Add memcheck and coverage tests for nightlies on specific machines
if [[ $is_at_run == 0 ]]; then
if [[ "$SCREAM_MACHINE" == "mappy" ]]; then
- ./scripts/gather-all-data "./scripts/test-all-scream -t cov ${TAS_ARGS} -c SCREAM_TEST_SIZE=SHORT" -l -m $SCREAM_MACHINE
+ ./scripts/gather-all-data "./scripts/test-all-scream -t cov ${TAS_ARGS}" -l -m $SCREAM_MACHINE
if [[ $? != 0 ]]; then
fails=$fails+1;
cov_fail=1
fi
fi
- # Add a memcheck test for mappy/weaver for nightlies
- if [[ "$SCREAM_MACHINE" == "mappy" || "$SCREAM_MACHINE" == "weaver" ]]; then
- ./scripts/gather-all-data "./scripts/test-all-scream -t dbg --mem-check ${TAS_ARGS} -c SCREAM_TEST_SIZE=SHORT" -l -m $SCREAM_MACHINE
+ # Add a memcheck test for mappy for nightlies
+ if [[ "$SCREAM_MACHINE" == "mappy" ]]; then
+ ./scripts/gather-all-data "./scripts/test-all-scream -t mem ${TAS_ARGS}" -l -m $SCREAM_MACHINE
+ if [[ $? != 0 ]]; then
+ fails=$fails+1;
+ memcheck_fail=1
+ fi
+ fi
+
+ if [[ "$SCREAM_MACHINE" == "weaver" ]]; then
+ ./scripts/gather-all-data "./scripts/test-all-scream -t cmc -t csr -t csi -t css ${TAS_ARGS}" -l -m $SCREAM_MACHINE
if [[ $? != 0 ]]; then
fails=$fails+1;
memcheck_fail=1
fi
fi
+
fi
else
echo "SCREAM Stand-Alone tests were skipped, since the Github label 'AT: Skip Stand-Alone Testing' was found.\n"
diff --git a/components/eamxx/scripts/jenkins/valgrind/mappy.supp b/components/eamxx/scripts/jenkins/valgrind/mappy.supp
new file mode 100644
index 000000000000..67d6ec76114c
--- /dev/null
+++ b/components/eamxx/scripts/jenkins/valgrind/mappy.supp
@@ -0,0 +1,265 @@
+{
+
+ Memcheck:Cond
+ fun:pmi_encode
+ fun:opal_pmix_base_partial_commit_packed
+ fun:s1_put
+ fun:mca_btl_base_vader_modex_send
+ fun:mca_btl_vader_component_init
+ fun:mca_btl_base_select
+ fun:mca_bml_r2_component_init
+ fun:mca_bml_base_init
+ fun:ompi_mpi_init
+ fun:PMPI_Init
+ fun:main
+}
+{
+
+ Memcheck:Cond
+ fun:strlen
+ fun:opal_pmix_base_partial_commit_packed
+ fun:s1_put
+ fun:mca_btl_base_vader_modex_send
+ fun:mca_btl_vader_component_init
+ fun:mca_btl_base_select
+ fun:mca_bml_r2_component_init
+ fun:mca_bml_base_init
+ fun:ompi_mpi_init
+ fun:PMPI_Init
+ fun:main
+}
+{
+
+ Memcheck:Cond
+ fun:strlen
+ fun:PMI_KVS_Put
+ fun:kvs_put
+ fun:opal_pmix_base_partial_commit_packed
+ fun:s1_put
+ fun:mca_btl_base_vader_modex_send
+ fun:mca_btl_vader_component_init
+ fun:mca_btl_base_select
+ fun:mca_bml_r2_component_init
+ fun:mca_bml_base_init
+ fun:ompi_mpi_init
+ fun:PMPI_Init
+}
+{
+
+ Memcheck:Cond
+ fun:__strncpy_sse2_unaligned
+ obj:/usr/lib64/libpmi.so.0.0.0
+ fun:kvs_put
+ fun:opal_pmix_base_partial_commit_packed
+ fun:s1_put
+ fun:mca_btl_base_vader_modex_send
+ fun:mca_btl_vader_component_init
+ fun:mca_btl_base_select
+ fun:mca_bml_r2_component_init
+ fun:mca_bml_base_init
+ fun:ompi_mpi_init
+ fun:PMPI_Init
+}
+{
+
+ Memcheck:Addr1
+ fun:strlen
+ fun:opal_pmix_base_partial_commit_packed
+ fun:s1_put
+ fun:mca_btl_base_vader_modex_send
+ fun:mca_btl_vader_component_init
+ fun:mca_btl_base_select
+ fun:mca_bml_r2_component_init
+ fun:mca_bml_base_init
+ fun:ompi_mpi_init
+ fun:PMPI_Init
+ fun:main
+}
+{
+
+ Memcheck:Cond
+ fun:pmi_encode
+ fun:opal_pmix_base_commit_packed
+ fun:s1_commit
+ fun:ompi_mpi_init
+ fun:PMPI_Init
+ fun:main
+}
+{
+
+ Memcheck:Cond
+ fun:strlen
+ fun:opal_pmix_base_commit_packed
+ fun:s1_commit
+ fun:ompi_mpi_init
+ fun:PMPI_Init
+ fun:main
+}
+{
+
+ Memcheck:Cond
+ fun:strlen
+ fun:PMI_KVS_Put
+ fun:kvs_put
+ fun:opal_pmix_base_commit_packed
+ fun:s1_commit
+ fun:ompi_mpi_init
+ fun:PMPI_Init
+ fun:main
+}
+{
+
+ Memcheck:Cond
+ fun:__strncpy_sse2_unaligned
+ obj:/usr/lib64/libpmi.so.0.0.0
+ fun:kvs_put
+ fun:opal_pmix_base_commit_packed
+ fun:s1_commit
+ fun:ompi_mpi_init
+ fun:PMPI_Init
+ fun:main
+}
+{
+
+ Memcheck:Cond
+ fun:strlen
+ obj:/usr/lib64/libslurm_pmi-20.11.9.so
+ obj:/usr/lib64/libslurm_pmi-20.11.9.so
+ fun:slurm_send_node_msg
+ fun:slurm_send_recv_msg
+ fun:slurm_send_recv_rc_msg_only_one
+ fun:slurm_pmi_send_kvs_comm_set
+ fun:PMI_KVS_Commit
+ fun:s1_commit
+ fun:ompi_mpi_init
+ fun:PMPI_Init
+ fun:main
+}
+{
+
+ Memcheck:Param
+ socketcall.sendto(msg)
+ fun:send
+ fun:slurm_send_timeout
+ fun:slurm_msg_sendto_timeout
+ fun:slurm_send_node_msg
+ fun:slurm_send_recv_msg
+ fun:slurm_send_recv_rc_msg_only_one
+ fun:slurm_pmi_send_kvs_comm_set
+ fun:PMI_KVS_Commit
+ fun:s1_commit
+ fun:ompi_mpi_init
+ fun:PMPI_Init
+ fun:main
+}
+{
+
+ Memcheck:Cond
+ fun:strlen
+ fun:PMI_KVS_Get
+ fun:kvs_get
+ fun:opal_pmix_base_get_packed
+ fun:opal_pmix_base_cache_keys_locally
+ fun:fencenb
+ fun:opal_libevent2022_event_base_loop
+ fun:progress_engine
+ fun:start_thread
+ fun:clone
+}
+{
+
+ Memcheck:Cond
+ fun:__strncpy_sse2_unaligned
+ fun:PMI_KVS_Get
+ fun:kvs_get
+ fun:opal_pmix_base_get_packed
+ fun:opal_pmix_base_cache_keys_locally
+ fun:fencenb
+ fun:opal_libevent2022_event_base_loop
+ fun:progress_engine
+ fun:start_thread
+ fun:clone
+}
+{
+
+ Memcheck:Cond
+ fun:opal_pmix_base_get_packed
+ fun:opal_pmix_base_cache_keys_locally
+ fun:fencenb
+ fun:opal_libevent2022_event_base_loop
+ fun:progress_engine
+ fun:start_thread
+ fun:clone
+}
+{
+
+ Memcheck:Cond
+ fun:malloc
+ fun:opal_pmix_base_get_packed
+ fun:opal_pmix_base_cache_keys_locally
+ fun:fencenb
+ fun:opal_libevent2022_event_base_loop
+ fun:progress_engine
+ fun:start_thread
+ fun:clone
+}
+{
+
+ Memcheck:Cond
+ fun:is_overlap
+ fun:memcpy@@GLIBC_2.14
+ fun:opal_pmix_base_get_packed
+ fun:opal_pmix_base_cache_keys_locally
+ fun:fencenb
+ fun:opal_libevent2022_event_base_loop
+ fun:progress_engine
+ fun:start_thread
+ fun:clone
+}
+{
+
+ Memcheck:Cond
+ fun:memcpy@@GLIBC_2.14
+ fun:opal_pmix_base_get_packed
+ fun:opal_pmix_base_cache_keys_locally
+ fun:fencenb
+ fun:opal_libevent2022_event_base_loop
+ fun:progress_engine
+ fun:start_thread
+ fun:clone
+}
+{
+
+ Memcheck:Value8
+ fun:opal_pmix_base_get_packed
+ fun:opal_pmix_base_cache_keys_locally
+ fun:fencenb
+ fun:opal_libevent2022_event_base_loop
+ fun:progress_engine
+ fun:start_thread
+ fun:clone
+}
+{
+
+ Memcheck:Cond
+ fun:realloc
+ fun:opal_pmix_base_get_packed
+ fun:opal_pmix_base_cache_keys_locally
+ fun:fencenb
+ fun:opal_libevent2022_event_base_loop
+ fun:progress_engine
+ fun:start_thread
+ fun:clone
+}
+{
+
+ Memcheck:Value8
+ fun:memcpy@@GLIBC_2.14
+ fun:opal_pmix_base_get_packed
+ fun:opal_pmix_base_cache_keys_locally
+ fun:fencenb
+ fun:opal_libevent2022_event_base_loop
+ fun:progress_engine
+ fun:start_thread
+ fun:clone
+}
diff --git a/components/eamxx/scripts/machines_specs.py b/components/eamxx/scripts/machines_specs.py
index 1deb997314b7..d9566ad1a256 100644
--- a/components/eamxx/scripts/machines_specs.py
+++ b/components/eamxx/scripts/machines_specs.py
@@ -34,7 +34,11 @@
["mpicxx","mpifort","mpicc"],
"bsub -Ip -qpdebug",
""),
- "quartz-intel" : (["module --force purge", "module load StdEnv cmake/3.16.8 mkl/2019.0 intel/19.0.4 netcdf-fortran/4.4.4 netcdf/4.4.1.1 pnetcdf/1.9.0 mvapich2/2.3 python/3.8.2"],
+ "ruby-intel" : (["module --force purge", "module load StdEnv cmake/3.18.0 mkl/2019.0 intel/19.0.4 netcdf-fortran/4.4.4 netcdf/4.4.1.1 pnetcdf/1.9.0 mvapich2/2.3 python/3.8.2"],
+ ["mpicxx","mpifort","mpicc"],
+ "salloc --partition=pdebug",
+ ""),
+ "quartz-intel" : (["module --force purge", "module load StdEnv cmake/3.19.2 mkl/2022.1.0 intel-classic/2021.6.0-magic netcdf-c-parallel/4.9.0 netcdf-fortran-parallel/4.6.0 mvapich2/2.3.6 python/3.9.12"],
["mpicxx","mpifort","mpicc"],
"salloc --partition=pdebug",
""),
@@ -62,6 +66,10 @@
["mpicxx","mpifort","mpicc"],
"srun --time 02:00:00 --nodes=1 -p short --exclusive --account e3sm",
""),
+ "chrysalis" : (["eval $(../../cime/CIME/Tools/get_case_env)", "export OMP_NUM_THREADS=1"],
+ ["mpic++","mpif90","mpicc"],
+ "srun --mpi=pmi2 -l -N 1 --kill-on-bad-exit --cpu_bind=cores",
+ "/lcrc/group/e3sm/baselines/chrys/intel/scream"),
"linux-generic" : ([],["mpicxx","mpifort","mpicc"],"", ""),
"linux-generic-debug" : ([],["mpicxx","mpifort","mpicc"],"", ""),
diff --git a/components/eamxx/scripts/scripts-tests b/components/eamxx/scripts/scripts-tests
index 87435f2bafab..e80dbbb92b4f 100755
--- a/components/eamxx/scripts/scripts-tests
+++ b/components/eamxx/scripts/scripts-tests
@@ -342,15 +342,14 @@ class TestTestAllScream(TestBaseOuter.TestBase):
def test_mem_check_details(self):
"""
- Test the --mem-check flag in test-all-scream. It should set certain CMake values
+ Test the mem (default mem-check build) in test-all-scream. It should set certain CMake values
"""
if not self._jenkins:
- options = "-b HEAD -k -t dbg --mem-check --config-only"
+ options = "-b HEAD -k -t mem --config-only"
cmd = self.get_cmd("./test-all-scream -m $machine {}".format(options),
self._machine, dry_run=False)
run_cmd_assert_result(self, cmd, from_dir=TEST_DIR)
- extension = "cuda_mem_check" if is_cuda_machine(self._machine) else "valgrind"
- builddir = f"full_debug_{extension}"
+ builddir = "cuda_mem_check" if is_cuda_machine(self._machine) else "valgrind"
test_cmake_cache_contents(self, builddir, "CMAKE_BUILD_TYPE", "Debug")
test_cmake_cache_contents(self, builddir, "SCREAM_TEST_SIZE", "SHORT")
if is_cuda_machine(self._machine):
diff --git a/components/eamxx/scripts/test-all-scream b/components/eamxx/scripts/test-all-scream
index 67ddacbfc223..4a6d0710b4e3 100755
--- a/components/eamxx/scripts/test-all-scream
+++ b/components/eamxx/scripts/test-all-scream
@@ -141,10 +141,9 @@ OR
parser.add_argument("--test-level", action="store", choices=("at", "nightly", "experimental"), default="at",
help="Set the testing level.")
- parser.add_argument("--mem-check", action="store_true",
- help="Run the tests you've selected with memory checking on. "
- "This will use valgrind for CPU, cuda-mem-check for GPU etc."
- "This will dramatically slow down tests and also disables baseline checking.")
+ parser.add_argument("--test-size", action="store", choices=("short", "medium", "long"),
+ help="Set the testing level. Defaults to medium unless the test is cov or mem_check"
+ "(short is default in those cases).")
parser.add_argument("--force-baseline-regen", action="store_true",
help="Existing baseline will always be considered expired even if they do not appear to be.")
diff --git a/components/eamxx/scripts/test_all_scream.py b/components/eamxx/scripts/test_all_scream.py
index 9ddaff5577ad..94b642846265 100644
--- a/components/eamxx/scripts/test_all_scream.py
+++ b/components/eamxx/scripts/test_all_scream.py
@@ -25,7 +25,16 @@
class TestProperty(object):
###############################################################################
- def __init__(self, longname, description, cmake_args, uses_baselines=True, on_by_default=True):
+ """
+ Parent class of predefined test types for SCREAM standalone. test-all-scream
+ offers a number of customization points, but you may need to just use
+ cmake if you need maximal customization. You can run test-all-scream --dry-run
+ to get the corresponding cmake command which can then be used as a starting
+ point for making your own cmake command.
+ """
+
+ def __init__(self, longname, description, cmake_args,
+ uses_baselines=True, on_by_default=True, default_test_len=None):
# What the user uses to select tests via test-all-scream CLI.
# Should also match the class name when converted to caps
self.shortname = type(self).__name__.lower()
@@ -46,6 +55,9 @@ def __init__(self, longname, description, cmake_args, uses_baselines=True, on_by
# Should this test be run if the user did not specify tests at all?
self.on_by_default = on_by_default
+ # Should this test have a default test size
+ self.default_test_len = default_test_len
+
#
# Properties not set by constructor (Set by the main TestAllScream object)
#
@@ -64,7 +76,6 @@ def __init__(self, longname, description, cmake_args, uses_baselines=True, on_by
if not self.uses_baselines:
self.cmake_args += [("SCREAM_ENABLE_BASELINE_TESTS", "False")]
- # Tests will generally be referred to via their longname
def disable_baselines(self):
if self.uses_baselines:
self.uses_baselines = False
@@ -80,7 +91,7 @@ class DBG(TestProperty):
CMAKE_ARGS = [("CMAKE_BUILD_TYPE", "Debug"), ("EKAT_DEFAULT_BFB", "True")]
- def __init__(self):
+ def __init__(self, _):
TestProperty.__init__(
self,
"full_debug",
@@ -92,7 +103,7 @@ def __init__(self):
class SP(TestProperty):
###############################################################################
- def __init__(self):
+ def __init__(self, _):
TestProperty.__init__(
self,
"full_sp_debug",
@@ -104,20 +115,21 @@ def __init__(self):
class FPE(TestProperty):
###############################################################################
- def __init__(self):
+ def __init__(self, tas):
TestProperty.__init__(
self,
"debug_nopack_fpe",
"debug pksize=1 floating point exceptions on",
DBG.CMAKE_ARGS + [("SCREAM_PACK_SIZE", "1"), ("SCREAM_FPE","True")],
- uses_baselines=False
+ uses_baselines=False,
+ on_by_default=(tas is not None and not tas.on_cuda())
)
###############################################################################
class OPT(TestProperty):
###############################################################################
- def __init__(self):
+ def __init__(self, _):
TestProperty.__init__(
self,
"release",
@@ -129,34 +141,131 @@ def __init__(self):
class COV(TestProperty):
###############################################################################
- def __init__(self):
+ def __init__(self, _):
TestProperty.__init__(
self,
"coverage",
"debug coverage",
[("CMAKE_BUILD_TYPE", "Debug"), ("EKAT_ENABLE_COVERAGE", "True")],
uses_baselines=False,
- on_by_default=False
+ on_by_default=False,
+ default_test_len="short"
+ )
+
+###############################################################################
+class VALG(TestProperty):
+###############################################################################
+
+ def __init__(self, tas):
+ TestProperty.__init__(
+ self,
+ "valgrind",
+ "debug with valgrind",
+ [("CMAKE_BUILD_TYPE", "Debug"), ("EKAT_ENABLE_VALGRIND", "True")],
+ uses_baselines=False,
+ on_by_default=False,
+ default_test_len="short"
+ )
+ if tas is not None:
+ # If a stored suppression file exists for this machine, use it
+ persistent_supp_file = tas.get_root_dir() / "scripts" / "jenkins" / "valgrind" / f"{tas.get_machine()}.supp"
+ if persistent_supp_file.exists():
+ self.cmake_args.append( ("EKAT_VALGRIND_SUPPRESSION_FILE", str(persistent_supp_file)) )
+
+###############################################################################
+class CMC(TestProperty):
+###############################################################################
+
+ def __init__(self, _):
+ TestProperty.__init__(
+ self,
+ "cuda_mem_check",
+ "debug with cuda memcheck",
+ [("CMAKE_BUILD_TYPE", "Debug"), ("EKAT_ENABLE_CUDA_MEMCHECK", "True")],
+ uses_baselines=False,
+ on_by_default=False,
+ default_test_len="short"
)
###############################################################################
-def test_factory(user_req_tests, machine, mem_check):
+class CSM(TestProperty):
+###############################################################################
+
+ def __init__(self, _):
+ TestProperty.__init__(
+ self,
+ "compute_santizer_memcheck",
+ "debug with compute sanitizer memcheck",
+ [("CMAKE_BUILD_TYPE", "Debug"), ("EKAT_ENABLE_COMPUTE_SANITIZER", "True")],
+ uses_baselines=False,
+ on_by_default=False,
+ default_test_len="short"
+ )
+
+###############################################################################
+class CSR(TestProperty):
+###############################################################################
+
+ def __init__(self, _):
+ TestProperty.__init__(
+ self,
+ "compute_santizer_racecheck",
+ "debug with compute sanitizer racecheck",
+ [("CMAKE_BUILD_TYPE", "Debug"),
+ ("EKAT_ENABLE_COMPUTE_SANITIZER", "True"),
+ ("EKAT_COMPUTE_SANITIZER_OPTIONS", "'--tool racecheck'")],
+ uses_baselines=False,
+ on_by_default=False,
+ default_test_len="short"
+ )
+
+###############################################################################
+class CSI(TestProperty):
+###############################################################################
+
+ def __init__(self, _):
+ TestProperty.__init__(
+ self,
+ "compute_santizer_initcheck",
+ "debug with compute sanitizer initcheck",
+ [("CMAKE_BUILD_TYPE", "Debug"),
+ ("EKAT_ENABLE_COMPUTE_SANITIZER", "True"),
+ ("EKAT_COMPUTE_SANITIZER_OPTIONS", "'--tool initcheck'")],
+ uses_baselines=False,
+ on_by_default=False,
+ default_test_len="short"
+ )
+
+###############################################################################
+class CSS(TestProperty):
+###############################################################################
+
+ def __init__(self, _):
+ TestProperty.__init__(
+ self,
+ "compute_santizer_synccheck",
+ "debug with compute sanitizer synccheck",
+ [("CMAKE_BUILD_TYPE", "Debug"),
+ ("EKAT_ENABLE_COMPUTE_SANITIZER", "True"),
+ ("EKAT_COMPUTE_SANITIZER_OPTIONS", "'--tool synccheck'")],
+ uses_baselines=False,
+ on_by_default=False,
+ default_test_len="short"
+ )
+
+###############################################################################
+def test_factory(user_req_tests, tas):
###############################################################################
testclasses = TestProperty.__subclasses__()
if not user_req_tests:
- result = [testclass() for testclass in testclasses
- if (testclass().on_by_default and not (is_cuda_machine(machine) and testclass().shortname == "fpe"))]
+ result = [testclass(tas) for testclass in testclasses
+ if testclass(tas).on_by_default]
else:
- valid_names = [testclass().shortname for testclass in testclasses]
+ valid_names = [testclass(tas).shortname for testclass in testclasses]
for user_req_test in user_req_tests:
expect(user_req_test in valid_names, f"'{user_req_test}' is not a known test")
- result = [testclass() for testclass in testclasses if testclass().shortname in user_req_tests]
-
- # Mangle test full name if mem_check is on
- if mem_check:
- for test in result:
- test.longname += "_cuda_mem_check" if is_cuda_machine(machine) else "_valgrind"
+ result = [testclass(tas) for testclass in testclasses if testclass(tas).shortname in user_req_tests]
return result
@@ -172,7 +281,7 @@ def get_test_name_desc(cls):
Returns a dict mapping short test names to full names
"""
testclasses = TestProperty.__subclasses__()
- return OrderedDict([(testc().shortname, testc().description) for testc in testclasses])
+ return OrderedDict([(testc(None).shortname, testc(None).description) for testc in testclasses])
###########################################################################
def __init__(self, cxx_compiler=None, f90_compiler=None, c_compiler=None,
@@ -182,8 +291,8 @@ def __init__(self, cxx_compiler=None, f90_compiler=None, c_compiler=None,
integration_test=False, local=False, root_dir=None, work_dir=None,
quick_rerun=False,quick_rerun_failed=False,dry_run=False,
make_parallel_level=0, ctest_parallel_level=0, update_expired_baselines=False,
- extra_verbose=False, limit_test_regex=None, test_level="at",
- mem_check=False, force_baseline_regen=False):
+ extra_verbose=False, limit_test_regex=None, test_level="at", test_size=None,
+ force_baseline_regen=False):
###########################################################################
# When using scripts-tests, we can't pass "-l" to test-all-scream,
@@ -219,7 +328,7 @@ def __init__(self, cxx_compiler=None, f90_compiler=None, c_compiler=None,
self._extra_verbose = extra_verbose
self._limit_test_regex = limit_test_regex
self._test_level = test_level
- self._mem_check = mem_check
+ self._test_size = test_size
self._force_baseline_regen = force_baseline_regen
# Not all builds are ment to perform comparisons against pre-built baselines
@@ -249,9 +358,6 @@ def __init__(self, cxx_compiler=None, f90_compiler=None, c_compiler=None,
else:
expect (not self._local, "Specifying a machine while passing '-l,--local' is ambiguous.")
- # Make our test objects!
- self._tests = test_factory(tests, self._machine, self._mem_check)
-
# Compute root dir (where repo is) and work dir (where build/test will happen)
if not self._root_dir:
self._root_dir = Path(__file__).resolve().parent.parent
@@ -260,6 +366,11 @@ def __init__(self, cxx_compiler=None, f90_compiler=None, c_compiler=None,
expect(self._root_dir.is_dir() and self._root_dir.parts()[-2:] == ('scream', 'components'),
f"Bad root-dir '{self._root_dir}', should be: $scream_repo/components/eamxx")
+ # Make our test objects! Change mem to default mem-check test for current platform
+ if "mem" in tests:
+ tests[tests.index("mem")] = "cmc" if self.on_cuda() else "valg"
+ self._tests = test_factory(tests, self)
+
if self._work_dir is not None:
self._work_dir = Path(self._work_dir).absolute()
expect(self._work_dir.is_dir(),
@@ -319,7 +430,7 @@ def __init__(self, cxx_compiler=None, f90_compiler=None, c_compiler=None,
# Avoid splitting physical cores across test types
make_jobs_per_test = ((make_max_jobs // len(self._tests)) // log_per_phys) * log_per_phys
- if is_cuda_machine(self._machine):
+ if self.on_cuda():
ctest_jobs_per_test = ctest_max_jobs // len(self._tests)
else:
ctest_jobs_per_test = ((ctest_max_jobs // len(self._tests)) // log_per_phys) * log_per_phys
@@ -413,13 +524,9 @@ def __init__(self, cxx_compiler=None, f90_compiler=None, c_compiler=None,
# Do not do baseline operations if mem checking is on
print (f"Checking baselines directory: {self._baseline_dir}")
- if self._mem_check:
- for test in self._tests:
- test.disable_baselines()
- else:
- self.baselines_are_present()
- if self._update_expired_baselines:
- self.baselines_are_expired()
+ self.baselines_are_present()
+ if self._update_expired_baselines:
+ self.baselines_are_expired()
############################################
# Deduce compilers if needed/possible #
@@ -480,6 +587,21 @@ def get_test_dir(self, root, test):
###############################################################################
return root/str(test)
+ ###############################################################################
+ def get_root_dir(self):
+ ###############################################################################
+ return self._root_dir
+
+ ###############################################################################
+ def get_machine(self):
+ ###############################################################################
+ return self._machine
+
+ ###########################################################################
+ def on_cuda(self):
+ ###########################################################################
+ return is_cuda_machine(self._machine)
+
###############################################################################
def get_preexisting_baseline(self, test):
###############################################################################
@@ -548,7 +670,7 @@ def baselines_are_expired(self):
if num_ref_is_ahead_file > 0 or self._force_baseline_regen:
test.missing_baselines = True
reason = "forcing baseline regen" if self._force_baseline_regen \
- else "f{self._baseline_ref} is ahead of the baseline commit by {num_ref_is_ahead_file}"
+ else f"{self._baseline_ref} is ahead of the baseline commit by {num_ref_is_ahead_file}"
print(f" -> Test {test} baselines are expired because {reason}")
else:
print(f" -> Test {test} baselines are valid and do not need to be regenerated")
@@ -562,7 +684,7 @@ def get_machine_file(self):
return self._root_dir/"cmake"/"machine-files"/f"{self._machine}.cmake"
###############################################################################
- def generate_cmake_config(self, extra_configs, for_ctest=False):
+ def generate_cmake_config(self, test, for_ctest=False):
###############################################################################
# Ctest only needs config options, and doesn't need the leading 'cmake '
@@ -579,7 +701,7 @@ def generate_cmake_config(self, extra_configs, for_ctest=False):
result += f" -DNetCDF_C_PATH={c_path}"
# Test-specific cmake options
- for key, value in extra_configs:
+ for key, value in test.cmake_args:
result += f" -D{key}={value}"
# The output coming from all tests at the same time will be a mixed-up mess
@@ -595,11 +717,12 @@ def generate_cmake_config(self, extra_configs, for_ctest=False):
elif self._test_level == "experimental":
result += " -DSCREAM_TEST_LEVEL=EXPERIMENTAL"
- # Add configs for mem checking
- if self._mem_check:
- # valgrind/cmc slow down things a lot, we need to run tests in short mode
- result += " -DSCREAM_TEST_SIZE=SHORT"
- result += f" -DEKAT_ENABLE_{'CUDA_MEMCHECK' if is_cuda_machine(self._machine) else 'VALGRIND'}=True"
+ # Define test size. Default is to let it be undefined and CMake will pick
+ # unless test has a special default test length
+ if self._test_size:
+ result += f" -DSCREAM_TEST_SIZE={self._test_size.upper()}"
+ elif test.default_test_len:
+ result += f" -DSCREAM_TEST_SIZE={test.default_test_len.upper()}"
# User-requested config options
custom_opts_keys = []
@@ -629,7 +752,7 @@ def get_taskset_range(self, test, for_compile=True):
###############################################################################
res_name = "compile_res_count" if for_compile else "testing_res_count"
- if not for_compile and is_cuda_machine(self._machine):
+ if not for_compile and self.on_cuda():
# For GPUs, the cpu affinity is irrelevant. Just assume all GPUS are open
affinity_cp = list(range(self._ctest_max_jobs))
else:
@@ -715,12 +838,6 @@ def generate_ctest_config(self, cmake_config, extra_configs, test):
result += f"-DBUILD_WORK_DIR={work_dir} "
build_name_mod = str(test)
- if self._mem_check:
- if self._submit:
- # Need backwards compatible build name for db submission
- expect(len(self._tests) == 1, "Expected only one mem-check test being submitted")
- build_name_mod = "cuda_mem_check" if is_cuda_machine(self._machine) else "valgrind"
-
result += f"-DBUILD_NAME_MOD={build_name_mod} "
if self._limit_test_regex:
@@ -744,7 +861,7 @@ def generate_baselines(self, test, commit):
test_dir = self.get_test_dir(self._baseline_dir, test)
- cmake_config = self.generate_cmake_config(test.cmake_args)
+ cmake_config = self.generate_cmake_config(test)
cmake_config += " -DSCREAM_BASELINES_ONLY=ON"
cmake_config += f" -DSCREAM_TEST_DATA_DIR={test_dir}/data"
@@ -835,7 +952,7 @@ def run_test(self, test):
print("===============================================================================")
test_dir = self.get_test_dir(self._work_dir,test)
- cmake_config = self.generate_cmake_config(test.cmake_args, for_ctest=True)
+ cmake_config = self.generate_cmake_config(test, for_ctest=True)
ctest_config = self.generate_ctest_config(cmake_config, [], test)
if self._config_only:
diff --git a/components/eamxx/src/control/atmosphere_driver.cpp b/components/eamxx/src/control/atmosphere_driver.cpp
index f39a53da8c92..0afb7a6328b8 100644
--- a/components/eamxx/src/control/atmosphere_driver.cpp
+++ b/components/eamxx/src/control/atmosphere_driver.cpp
@@ -94,6 +94,11 @@ AtmosphereDriver(const ekat::Comm& atm_comm,
set_params(params);
}
+AtmosphereDriver::~AtmosphereDriver ()
+{
+ finalize();
+}
+
void AtmosphereDriver::
set_comm(const ekat::Comm& atm_comm)
{
@@ -594,6 +599,9 @@ void AtmosphereDriver::initialize_output_managers () {
// OM of all the requested outputs.
// Check for model restart output
+ ekat::ParameterList checkpoint_params;
+ checkpoint_params.set("frequency_units",std::string("never"));
+ checkpoint_params.set("Frequency",-1);
if (io_params.isSublist("model_restart")) {
auto restart_pl = io_params.sublist("model_restart");
// Signal that this is not a normal output, but the model restart one
@@ -613,7 +621,13 @@ void AtmosphereDriver::initialize_output_managers () {
om.setup(m_atm_comm,restart_pl,m_field_mgrs,m_grids_manager,m_run_t0,m_case_t0,true);
}
om.set_logger(m_atm_logger);
- om.setup_globals_map(m_atm_process_group->get_restart_extra_data());
+ for (const auto& it : m_atm_process_group->get_restart_extra_data()) {
+ om.add_global(it.first,*it.second);
+ }
+
+ // Store the "Output Control" pl of the model restart as the "Checkpoint Control" for all other output streams
+ checkpoint_params.set("frequency_units",restart_pl.sublist("output_control").get("frequency_units"));
+ checkpoint_params.set("Frequency",restart_pl.sublist("output_control").get("Frequency"));
}
// Build one manager per output yaml file
@@ -623,6 +637,10 @@ void AtmosphereDriver::initialize_output_managers () {
for (const auto& fname : output_yaml_files) {
ekat::ParameterList params;
ekat::parse_yaml_file(fname,params);
+ auto& checkpoint_pl = params.sublist("Checkpoint Control");
+ checkpoint_pl.set("frequency_units",checkpoint_params.get("frequency_units"));
+ checkpoint_pl.set("Frequency",checkpoint_params.get("Frequency"));
+
// Check if the filename prefix for this file has already been set. If not, use the simulation casename.
if (not params.isParameter("filename_prefix")) {
params.set("filename_prefix",m_casename+".scream.h"+std::to_string(om_tally));
@@ -747,10 +765,6 @@ void AtmosphereDriver::restart_model ()
const auto& casename = m_atm_params.sublist("initial_conditions").get("restart_casename");
auto filename = find_filename_in_rpointer (casename,true,m_atm_comm,m_run_t0);
- // Restart the num steps counter in the atm time stamp
- ekat::ParameterList rest_pl;
- rest_pl.set("Filename",filename);
- AtmosphereInput model_restart(m_atm_comm,rest_pl);
m_atm_logger->info(" [EAMxx] Restart filename: " + filename);
for (auto& it : m_field_mgrs) {
@@ -764,31 +778,32 @@ void AtmosphereDriver::restart_model ()
for (const auto& fn : restart_group->m_fields_names) {
fnames.push_back(fn);
}
- read_fields_from_file (fnames,it.first,filename,m_current_ts);
+ read_fields_from_file (fnames,it.second->get_grid(),filename,m_current_ts);
}
- // Read number of steps from restart file
- int nsteps = model_restart.read_int_scalar("nsteps");
+ // Restart the num steps counter in the atm time stamp
+ int nsteps = scorpio::get_attribute(filename,"nsteps");
m_current_ts.set_num_steps(nsteps);
m_run_t0.set_num_steps(nsteps);
- for (const auto& it : m_atm_process_group->get_restart_extra_data()) {
+ for (auto& it : m_atm_process_group->get_restart_extra_data()) {
const auto& name = it.first;
- const auto& type = it.second.first;
- auto any = it.second.second;
-
- if (type=="int") {
- ekat::any_cast(any) = model_restart.read_int_scalar(name);
- } else {
- EKAT_ERROR_MSG ("Error! Unsupported type for restart extra data.\n"
- " - data name: " + name + "'\n"
- " - data type: " + type + "'\n");
- }
+ auto& any = it.second;
+
+
+ auto data = scorpio::get_any_attribute(filename,name);
+ EKAT_REQUIRE_MSG (any->content().type()==data.content().type(),
+ "Error! Type mismatch for restart global attribute.\n"
+ " - file name: " + filename + "\n"
+ " - att name: " + name + "\n"
+ " - expected type: " + any->content().type().name() + "\n"
+ " - actual type: " + data.content().type().name() + "\n"
+ "NOTE: the above names use type_info::name(), which returns an implementation defined string,\n"
+ " with no guarantees. In particular, the string can be identical for several types,\n"
+ " and/or change between invocations of the same program.\n");
+ *any = data;
}
- // Close files and finalize all pio data structs
- model_restart.finalize();
-
m_atm_logger->info(" [EAMxx] restart_model ... done!");
}
@@ -982,7 +997,7 @@ void AtmosphereDriver::set_initial_conditions ()
m_atm_logger->info(" [EAMxx] IC filename: " + file_name);
for (const auto& it : m_field_mgrs) {
const auto& grid_name = it.first;
- read_fields_from_file (ic_fields_names[grid_name],it.first,file_name,m_current_ts);
+ read_fields_from_file (ic_fields_names[grid_name],it.second->get_grid(),file_name,m_current_ts);
}
}
@@ -1048,9 +1063,19 @@ void AtmosphereDriver::set_initial_conditions ()
m_atm_logger->info(" filename: " + file_name);
for (const auto& it : m_field_mgrs) {
const auto& grid_name = it.first;
+ // Topography files always use "ncol_d" for the GLL grid value of ncol.
+ // To ensure we read in the correct value, we must change the name for that dimension
+ auto io_grid = it.second->get_grid();
+ if (grid_name=="Physics GLL") {
+ using namespace ShortFieldTagsNames;
+ auto grid = io_grid->clone(io_grid->name(),true);
+ grid->reset_field_tag_name(COL,"ncol_d");
+ io_grid = grid;
+ }
+
read_fields_from_file (topography_file_fields_names[grid_name],
topography_eamxx_fields_names[grid_name],
- it.first,file_name,m_current_ts);
+ io_grid,file_name,m_current_ts);
}
m_atm_logger->debug(" [EAMxx] Processing topography from file ... done!");
} else {
@@ -1072,7 +1097,7 @@ void AtmosphereDriver::set_initial_conditions ()
void AtmosphereDriver::
read_fields_from_file (const std::vector& field_names_nc,
const std::vector& field_names_eamxx,
- const std::string& grid_name,
+ const std::shared_ptr& grid,
const std::string& file_name,
const util::TimeStamp& t0)
{
@@ -1083,43 +1108,39 @@ read_fields_from_file (const std::vector& field_names_nc,
return;
}
- ekat::ParameterList ic_reader_params;
- ic_reader_params.set("Field Names",field_names_nc);
- ic_reader_params.set("Filename",file_name);
-
- using view_1d_host = AtmosphereInput::view_1d_host;
-
- const auto& field_mgr = m_field_mgrs.at(grid_name);
- std::map hosts_views;
- std::map layouts;
- for (int i=0; iget_field(fname_eamxx).get_view();
- layouts.emplace(fname_nc,
- field_mgr->get_field(fname_eamxx).get_header().get_identifier().get_layout());
+ // NOTE: we cannot pass the field_mgr and m_grids_mgr, since the input
+ // grid may not be in the grids_manager and may not be the grid
+ // of the field mgr. This sounds weird, but there is a precise
+ // use case: when grid is a shallow clone of the fm grid, where
+ // we changed the name of some field tags (e.g., we set the name
+ // of COL to ncol_d). This is used when reading the topography,
+ // since the topo file *always* uses ncol_d for GLL points data,
+ // while a non-PG2 run would have the tag name be "ncol".
+ const auto& field_mgr = m_field_mgrs.at(grid->name());
+ std::vector fields;
+ for (size_t i=0; iget_field(eamxx_name).alias(nc_name));
}
- AtmosphereInput ic_reader(ic_reader_params,
- m_grids_manager->get_grid(grid_name),
- hosts_views, layouts);
+ AtmosphereInput ic_reader(file_name,grid,fields);
ic_reader.read_variables();
ic_reader.finalize();
- for (const auto& fname : field_names_eamxx) {
- auto f = field_mgr->get_field(fname);
- // Sync fields to device
- f.sync_to_dev();
+ for (auto& f : fields) {
// Set the initial time stamp
+ // NOTE: f is an alias of the field from field_mgr, so it shares all
+ // pointers to the metadata (except for the FieldIdentifier),
+ // so changing its timestamp will also change the timestamp
+ // of the field in field_mgr
f.get_header().get_tracking().update_time_stamp(t0);
}
}
void AtmosphereDriver::
read_fields_from_file (const std::vector& field_names,
- const std::string& grid_name,
+ const std::shared_ptr& grid,
const std::string& file_name,
const util::TimeStamp& t0)
{
@@ -1127,24 +1148,26 @@ read_fields_from_file (const std::vector& field_names,
return;
}
- // Loop over all grids, setup and run an AtmosphereInput object,
- // loading all fields in the RESTART group on that grid from
- // the nc file stored in the rpointer file
- // for (const auto& it : m_field_mgrs) {
- const auto& field_mgr = m_field_mgrs.at(grid_name);
-
- // There are fields to read from the nc file. We must have a valid nc file then.
- ekat::ParameterList ic_reader_params;
- ic_reader_params.set("Field Names",field_names);
- ic_reader_params.set("Filename",file_name);
+ // NOTE: we cannot pass the field_mgr and m_grids_mgr, since the input
+ // grid may not be in the grids_manager and may not be the grid
+ // of the field mgr. This sounds weird, but there is a precise
+ // use case: when grid is a shallow clone of the fm grid, where
+ // we changed the name of some field tags (e.g., we set the name
+ // of COL to ncol_d). This is used when reading the topography,
+ // since the topo file *always* uses ncol_d for GLL points data,
+ // while a non-PG2 run would have the tag name be "ncol".
+ const auto& field_mgr = m_field_mgrs.at(grid->name());
+ std::vector fields;
+ for (const auto& fn : field_names) {
+ fields.push_back(field_mgr->get_field(fn));
+ }
- AtmosphereInput ic_reader(ic_reader_params,field_mgr,m_grids_manager);
+ AtmosphereInput ic_reader(file_name,grid,fields);
ic_reader.read_variables();
ic_reader.finalize();
- for (const auto& fname : field_names) {
+ for (auto& f : fields) {
// Set the initial time stamp
- auto f = field_mgr->get_field(fname);
f.get_header().get_tracking().update_time_stamp(t0);
}
}
@@ -1322,6 +1345,10 @@ void AtmosphereDriver::run (const int dt) {
void AtmosphereDriver::finalize ( /* inputs? */ ) {
start_timer("EAMxx::finalize");
+ if (m_ad_status==0) {
+ return;
+ }
+
m_atm_logger->info("[EAMxx] Finalize ...");
// Finalize and destroy output streams, make sure files are closed
@@ -1369,6 +1396,8 @@ void AtmosphereDriver::finalize ( /* inputs? */ ) {
m_atm_logger->debug("[EAMxx::finalize] memory usage: " + std::to_string(max_mem_usage) + "MB");
#endif
+ m_ad_status = 0;
+
stop_timer("EAMxx::finalize");
}
diff --git a/components/eamxx/src/control/atmosphere_driver.hpp b/components/eamxx/src/control/atmosphere_driver.hpp
index e4194ff0475f..0ba183cf74d3 100644
--- a/components/eamxx/src/control/atmosphere_driver.hpp
+++ b/components/eamxx/src/control/atmosphere_driver.hpp
@@ -48,8 +48,10 @@ class AtmosphereDriver
AtmosphereDriver (const ekat::Comm& atm_comm,
const ekat::ParameterList& params);
- // The default dtor is fine.
- ~AtmosphereDriver () = default;
+ // Must call finalize, so that, if AD is destroyed as part of uncaught
+ // exception stack unwinding, we will still perform some cleanup ops,
+ // among which, for instance, closing any open output file.
+ ~AtmosphereDriver ();
// ---- Begin initialization methods ---- //
@@ -130,8 +132,9 @@ class AtmosphereDriver
// Note: dt is assumed to be in seconds
void run (const int dt);
- // Clean up the driver (includes cleaning up the parameterizations and the fm's);
- void finalize ( /* inputs */ );
+ // Clean up the driver (finalizes and cleans up all internals)
+ // NOTE: if already finalized, this is a no-op
+ void finalize ();
field_mgr_ptr get_ref_grid_field_mgr () const;
field_mgr_ptr get_field_mgr (const std::string& grid_name) const;
@@ -164,13 +167,13 @@ class AtmosphereDriver
// different naming conventions for phis.
void read_fields_from_file (const std::vector& field_names_nc,
const std::vector& field_names_eamxx,
- const std::string& grid_name,
+ const std::shared_ptr& grid,
const std::string& file_name,
const util::TimeStamp& t0);
// Read fields from a file when the names of the fields in
// EAMxx match with the .nc file.
void read_fields_from_file (const std::vector& field_names,
- const std::string& grid_name,
+ const std::shared_ptr& grid,
const std::string& file_name,
const util::TimeStamp& t0);
void register_groups ();
diff --git a/components/eamxx/src/control/atmosphere_surface_coupling_exporter.cpp b/components/eamxx/src/control/atmosphere_surface_coupling_exporter.cpp
index 1d525ccec0e4..ebbd993b4f94 100644
--- a/components/eamxx/src/control/atmosphere_surface_coupling_exporter.cpp
+++ b/components/eamxx/src/control/atmosphere_surface_coupling_exporter.cpp
@@ -46,28 +46,40 @@ void SurfaceCouplingExporter::set_grids(const std::shared_ptr("p_int", scalar3d_layout_int, Pa, grid_name);
- add_field("pseudo_density", scalar3d_layout_mid, Pa, grid_name, ps);
- add_field("phis", scalar2d_layout, m2/s2, grid_name);
- add_field("p_mid", scalar3d_layout_mid, Pa, grid_name, ps);
- add_field("qv", scalar3d_layout_mid, Qunit, grid_name, "tracers", ps);
- add_field("T_mid", scalar3d_layout_mid, K, grid_name, ps);
- add_field("horiz_winds", vector3d_layout, m/s, grid_name);
- add_field("sfc_flux_dir_nir", scalar2d_layout, Wm2, grid_name);
- add_field("sfc_flux_dir_vis", scalar2d_layout, Wm2, grid_name);
- add_field("sfc_flux_dif_nir", scalar2d_layout, Wm2, grid_name);
- add_field("sfc_flux_dif_vis", scalar2d_layout, Wm2, grid_name);
- add_field("sfc_flux_sw_net" , scalar2d_layout, Wm2, grid_name);
- add_field("sfc_flux_lw_dn" , scalar2d_layout, Wm2, grid_name);
+ add_field("p_int", scalar3d_layout_int, Pa, grid_name);
+ add_field("pseudo_density", scalar3d_layout_mid, Pa, grid_name, ps);
+ add_field("phis", scalar2d_layout, m2/s2, grid_name);
+ add_field("p_mid", scalar3d_layout_mid, Pa, grid_name, ps);
+ add_field("qv", scalar3d_layout_mid, Qunit, grid_name, "tracers", ps);
+ add_field("T_mid", scalar3d_layout_mid, K, grid_name, ps);
+ // TODO: Switch horiz_winds to using U and V, note right now there is an issue with when the subfields are created, so can't switch yet.
+ add_field("horiz_winds", vector3d_layout, m/s, grid_name);
+ add_field("sfc_flux_dir_nir", scalar2d_layout, Wm2, grid_name);
+ add_field("sfc_flux_dir_vis", scalar2d_layout, Wm2, grid_name);
+ add_field("sfc_flux_dif_nir", scalar2d_layout, Wm2, grid_name);
+ add_field("sfc_flux_dif_vis", scalar2d_layout, Wm2, grid_name);
+ add_field("sfc_flux_sw_net" , scalar2d_layout, Wm2, grid_name);
+ add_field("sfc_flux_lw_dn" , scalar2d_layout, Wm2, grid_name);
add_field("precip_liq_surf_mass", scalar2d_layout, kg/m2, grid_name);
add_field("precip_ice_surf_mass", scalar2d_layout, kg/m2, grid_name);
create_helper_field("Sa_z", scalar2d_layout, grid_name);
+ create_helper_field("Sa_u", scalar2d_layout, grid_name);
+ create_helper_field("Sa_v", scalar2d_layout, grid_name);
+ create_helper_field("Sa_tbot", scalar2d_layout, grid_name);
create_helper_field("Sa_ptem", scalar2d_layout, grid_name);
+ create_helper_field("Sa_pbot", scalar2d_layout, grid_name);
+ create_helper_field("Sa_shum", scalar2d_layout, grid_name);
create_helper_field("Sa_dens", scalar2d_layout, grid_name);
create_helper_field("Sa_pslv", scalar2d_layout, grid_name);
create_helper_field("Faxa_rainl", scalar2d_layout, grid_name);
create_helper_field("Faxa_snowl", scalar2d_layout, grid_name);
+ create_helper_field("Faxa_swndr", scalar2d_layout, grid_name);
+ create_helper_field("Faxa_swvdr", scalar2d_layout, grid_name);
+ create_helper_field("Faxa_swndf", scalar2d_layout, grid_name);
+ create_helper_field("Faxa_swvdf", scalar2d_layout, grid_name);
+ create_helper_field("Faxa_swnet", scalar2d_layout, grid_name);
+ create_helper_field("Faxa_lwdn", scalar2d_layout, grid_name);
}
// =========================================================================================
void SurfaceCouplingExporter::create_helper_field (const std::string& name,
@@ -158,16 +170,10 @@ void SurfaceCouplingExporter::initialize_impl (const RunType /* run_type */)
for (int i=0; iname())) field = get_field_out(fname);
- else if (has_required_field(fname, m_grid->name())) field = get_field_in(fname);
- else if (has_helper_field(fname)) field = m_helper_fields.at(fname);
- else EKAT_ERROR_MSG("Error! Attempting to export "+fname+
- " which is niether a requested field or a helper field.\n");
+ EKAT_REQUIRE_MSG(has_helper_field(fname),"Error! Attempting to export "+fname+
+ " which has not been added as a helper field.\n");
+ auto& field = m_helper_fields.at(fname);
// Check that is valid
EKAT_REQUIRE_MSG (field.is_allocated(), "Error! Export field view has not been allocated yet.\n");
@@ -196,6 +202,42 @@ void SurfaceCouplingExporter::initialize_impl (const RunType /* run_type */)
// Copy data to device for use in do_export()
Kokkos::deep_copy(m_column_info_d, m_column_info_h);
+ // Set the number of exports from eamxx or set to a constant, default type = FROM_MODEL
+ using vos_type = std::vector;
+ using vor_type = std::vector;
+ m_export_source = view_1d("",m_num_scream_exports);
+ m_export_source_h = Kokkos::create_mirror_view(m_export_source);
+ Kokkos::deep_copy(m_export_source_h,FROM_MODEL); // The default is that all export variables will be derived from the EAMxx state.
+ m_num_from_model_exports = m_num_scream_exports;
+
+ if (m_params.isSublist("prescribed_constants")) {
+ auto export_constant_params = m_params.sublist("prescribed_constants");
+ EKAT_REQUIRE_MSG(export_constant_params.isParameter("fields"),"Error! surface_coupling_exporter::init - prescribed_constants does not have 'fields' parameter.");
+ EKAT_REQUIRE_MSG(export_constant_params.isParameter("values"),"Error! surface_coupling_exporter::init - prescribed_constants does not have 'values' parameter.");
+ auto export_constant_fields = export_constant_params.get("fields");
+ auto export_constant_values = export_constant_params.get("values");
+ EKAT_REQUIRE_MSG(export_constant_fields.size()==export_constant_values.size(),"Error! surface_coupling_exporter::init - prescribed_constants 'fields' and 'values' are not the same size");
+ if (export_constant_fields.size()>0) {
+ // Determine which fields need constants
+ for (int i=0; i=0,"Error! surface_coupling_exporter - The number of exports derived from EAMxx < 0, something must have gone wrong in assigning the types of exports for all variables.");
+
// Perform initial export (if any are marked for export during initialization)
if (any_initial_exports) do_export(0, true);
}
@@ -207,89 +249,215 @@ void SurfaceCouplingExporter::run_impl (const double dt)
// =========================================================================================
void SurfaceCouplingExporter::do_export(const double dt, const bool called_during_initialization)
{
- using policy_type = KT::RangePolicy;
+ if (m_num_const_exports>0) {
+ set_constant_exports(dt,called_during_initialization);
+ }
+ if (m_num_from_model_exports>0) {
+ compute_eamxx_exports(dt,called_during_initialization);
+ }
+
+ // Finish up exporting vars
+ do_export_to_cpl(called_during_initialization);
+}
+// =========================================================================================
+void SurfaceCouplingExporter::set_constant_exports(const double dt, const bool called_during_initialization)
+{
+ // Cycle through those fields that will be set to a constant value:
+ for (int i=0; i();
+ Kokkos::deep_copy(field_view,m_export_constants.at(fname));
+ }
+ }
+
+}
+// =========================================================================================
+// This compute_eamxx_exports routine handles all export variables that are derived from the EAMxx state.
+// Important! This setup assumes the numerical order of export_cpl_indices as listed in
+// /src/mct_coupling/scream_cpl_indices.F90
+//
+// If this order is changed or a new variable is added it is important to update the corresponding
+// index query in the below.
+void SurfaceCouplingExporter::compute_eamxx_exports(const double dt, const bool called_during_initialization)
+{
using PC = physics::Constants;
const auto& p_int = get_field_in("p_int").get_view();
const auto& pseudo_density = get_field_in("pseudo_density").get_view();
const auto& qv = get_field_in("qv").get_view();
const auto& T_mid = get_field_in("T_mid").get_view();
+ // TODO: This will need to change if we ever switch from horiz_winds to U and V
+ const auto& horiz_winds = get_field_in("horiz_winds").get_view();
const auto& p_mid = get_field_in("p_mid").get_view();
const auto& phis = get_field_in("phis").get_view();
+ const auto& sfc_flux_dir_nir = get_field_in("sfc_flux_dir_nir").get_view();
+ const auto& sfc_flux_dir_vis = get_field_in("sfc_flux_dir_vis").get_view();
+ const auto& sfc_flux_dif_nir = get_field_in("sfc_flux_dif_nir").get_view();
+ const auto& sfc_flux_dif_vis = get_field_in("sfc_flux_dif_vis").get_view();
+ const auto& sfc_flux_sw_net = get_field_in("sfc_flux_sw_net" ).get_view();
+ const auto& sfc_flux_lw_dn = get_field_in("sfc_flux_lw_dn" ).get_view();
const auto& precip_liq_surf_mass = get_field_in("precip_liq_surf_mass").get_view();
const auto& precip_ice_surf_mass = get_field_in("precip_ice_surf_mass").get_view();
const auto Sa_z = m_helper_fields.at("Sa_z").get_view();
+ const auto Sa_u = m_helper_fields.at("Sa_u").get_view();
+ const auto Sa_v = m_helper_fields.at("Sa_v").get_view();
+ const auto Sa_tbot = m_helper_fields.at("Sa_tbot").get_view();
const auto Sa_ptem = m_helper_fields.at("Sa_ptem").get_view();
+ const auto Sa_pbot = m_helper_fields.at("Sa_pbot").get_view();
+ const auto Sa_shum = m_helper_fields.at("Sa_shum").get_view();
const auto Sa_dens = m_helper_fields.at("Sa_dens").get_view();
const auto Sa_pslv = m_helper_fields.at("Sa_pslv").get_view();
const auto Faxa_rainl = m_helper_fields.at("Faxa_rainl").get_view();
const auto Faxa_snowl = m_helper_fields.at("Faxa_snowl").get_view();
+ const auto Faxa_swndr = m_helper_fields.at("Faxa_swndr").get_view();
+ const auto Faxa_swvdr = m_helper_fields.at("Faxa_swvdr").get_view();
+ const auto Faxa_swndf = m_helper_fields.at("Faxa_swndf").get_view();
+ const auto Faxa_swvdf = m_helper_fields.at("Faxa_swvdf").get_view();
+ const auto Faxa_swnet = m_helper_fields.at("Faxa_swnet").get_view();
+ const auto Faxa_lwdn = m_helper_fields.at("Faxa_lwdn" ).get_view();
const auto dz = m_buffer.dz;
const auto z_int = m_buffer.z_int;
const auto z_mid = m_buffer.z_mid;
- // Any field not exported by scream, or not exported
- // during initialization, is set to 0.0
- Kokkos::deep_copy(m_cpl_exports_view_d, 0.0);
+ // Set the indexes for all of the exported variables
+ int idx_Sa_z = 0;
+ int idx_Sa_u = 1;
+ int idx_Sa_v = 2;
+ int idx_Sa_tbot = 3;
+ int idx_Sa_ptem = 4;
+ int idx_Sa_pbot = 5;
+ int idx_Sa_shum = 6;
+ int idx_Sa_dens = 7;
+ int idx_Sa_pslv = 8;
+ int idx_Faxa_rainl = 9;
+ int idx_Faxa_snowl = 10;
+ int idx_Faxa_swndr = 11;
+ int idx_Faxa_swvdr = 12;
+ int idx_Faxa_swndf = 13;
+ int idx_Faxa_swvdf = 14;
+ int idx_Faxa_swnet = 15;
+ int idx_Faxa_lwdn = 16;
+
// Local copies, to deal with CUDA's handling of *this.
const int num_levs = m_num_levs;
- const auto col_info = m_column_info_d;
- const auto cpl_exports_view_d = m_cpl_exports_view_d;
const int num_cols = m_num_cols;
- const int num_exports = m_num_scream_exports;
// Preprocess exports
+ auto export_source = m_export_source;
const auto setup_policy = ekat::ExeSpaceUtils::get_thread_range_parallel_scan_team_policy(num_cols, num_levs);
Kokkos::parallel_for(setup_policy, KOKKOS_LAMBDA(const Kokkos::TeamPolicy::member_type& team) {
const int i = team.league_rank();
+ // These views are needed by more than one export variable so we declare them here.
const auto qv_i = ekat::subview(qv, i);
const auto T_mid_i = ekat::subview(T_mid, i);
const auto p_mid_i = ekat::subview(p_mid, i);
- const auto p_int_i = ekat::subview(p_int, i);
const auto pseudo_density_i = ekat::subview(pseudo_density, i);
const auto dz_i = ekat::subview(dz, i);
- const auto z_int_i = ekat::subview(z_int, i);
- const auto z_mid_i = ekat::subview(z_mid, i);
- // Compute vertical layer thickness
- PF::calculate_dz(team, pseudo_density_i, p_mid_i, T_mid_i, qv_i, dz_i);
- team.team_barrier();
+ const auto s_p_mid_i = ekat::scalarize(p_mid_i);
+ const auto s_T_mid_i = ekat::scalarize(T_mid_i);
+ const auto z_int_i = ekat::subview(z_int, i);
+ const auto z_mid_i = ekat::subview(z_mid, i);
// Compute vertical layer heights (relative to ground surface rather than from sea level).
// Use z_int(nlevs) = z_surf = 0.0.
- const Real z_surf = 0.0;
- PF::calculate_z_int(team, num_levs, dz_i, z_surf, z_int_i);
- team.team_barrier();
- PF::calculate_z_mid(team, num_levs, z_int_i, z_mid_i);
- team.team_barrier();
-
- const auto s_dz_i = ekat::scalarize(dz_i);
- const auto s_z_mid_i = ekat::scalarize(z_mid_i);
- const auto s_pseudo_density_i = ekat::scalarize(pseudo_density_i);
- const auto s_p_mid_i = ekat::scalarize(p_mid_i);
- const auto s_T_mid_i = ekat::scalarize(T_mid_i);
+ // Currently only needed for Sa_z, Sa_dens and Sa_pslv
+ const bool calculate_z_vars = export_source(idx_Sa_z)==FROM_MODEL
+ || export_source(idx_Sa_dens)==FROM_MODEL
+ || export_source(idx_Sa_pslv)==FROM_MODEL;
+ if (calculate_z_vars) {
+ PF::calculate_dz(team, pseudo_density_i, p_mid_i, T_mid_i, qv_i, dz_i);
+ team.team_barrier();
+ const Real z_surf = 0.0;
+ PF::calculate_z_int(team, num_levs, dz_i, z_surf, z_int_i);
+ team.team_barrier();
+ PF::calculate_z_mid(team, num_levs, z_int_i, z_mid_i);
+ team.team_barrier();
+ }
+
+ // Set the values in the helper fields which correspond to the exported variables
- // Calculate air temperature at bottom of cell closest to the ground for PSL
- const Real T_int_bot = PF::calculate_surface_air_T(s_T_mid_i(num_levs-1),s_z_mid_i(num_levs-1));
- Sa_z(i) = s_z_mid_i(num_levs-1);
- Sa_ptem(i) = PF::calculate_theta_from_T(s_T_mid_i(num_levs-1), s_p_mid_i(num_levs-1));
- Sa_dens(i) = PF::calculate_density(s_pseudo_density_i(num_levs-1), s_dz_i(num_levs-1));
- Sa_pslv(i) = PF::calculate_psl(T_int_bot, p_int_i(num_levs), phis(i));
+ if (export_source(idx_Sa_z)==FROM_MODEL) {
+ // Assugb to Sa_z
+ const auto s_z_mid_i = ekat::scalarize(z_mid_i);
+ Sa_z(i) = s_z_mid_i(num_levs-1);
+ }
+
+ if (export_source(idx_Sa_u)==FROM_MODEL) {
+ const auto u_wind_i = ekat::subview(horiz_winds, i, 0); // TODO, when U and V work switch to using here instead of horiz_winds.
+ Sa_u(i) = u_wind_i(num_levs-1);
+ }
+
+ if (export_source(idx_Sa_v)==FROM_MODEL) {
+ const auto v_wind_i = ekat::subview(horiz_winds, i, 1);
+ Sa_v(i) = v_wind_i(num_levs-1);
+ }
+
+ if (export_source(idx_Sa_tbot)==FROM_MODEL) {
+ Sa_tbot(i) = s_T_mid_i(num_levs-1);
+ }
+
+ if (export_source(idx_Sa_ptem)==FROM_MODEL) {
+ Sa_ptem(i) = PF::calculate_theta_from_T(s_T_mid_i(num_levs-1), s_p_mid_i(num_levs-1));
+ }
+
+ if (export_source(idx_Sa_pbot)==FROM_MODEL) {
+ Sa_pbot(i) = s_p_mid_i(num_levs-1);
+ }
+
+ if (export_source(idx_Sa_shum)==FROM_MODEL) {
+ const auto s_qv_i = ekat::scalarize(qv_i);
+ Sa_shum(i) = s_qv_i(num_levs-1);
+ }
+
+ if (export_source(idx_Sa_dens)==FROM_MODEL) {
+ const auto s_dz_i = ekat::scalarize(dz_i);
+ const auto s_pseudo_density_i = ekat::scalarize(pseudo_density_i);
+ Sa_dens(i) = PF::calculate_density(s_pseudo_density_i(num_levs-1), s_dz_i(num_levs-1));
+ }
+
+ if (export_source(idx_Sa_pslv)==FROM_MODEL) {
+ const auto p_int_i = ekat::subview(p_int, i);
+ const auto s_z_mid_i = ekat::scalarize(z_mid_i);
+ // Calculate air temperature at bottom of cell closest to the ground for PSL
+ const Real T_int_bot = PF::calculate_surface_air_T(s_T_mid_i(num_levs-1),s_z_mid_i(num_levs-1));
+
+ Sa_pslv(i) = PF::calculate_psl(T_int_bot, p_int_i(num_levs), phis(i));
+ }
if (not called_during_initialization) {
// Precipitation has units of kg/m2, and Faxa_rainl/snowl
// need units mm/s. Here, 1000 converts m->mm, dt has units s, and
// rho_h2o has units kg/m3.
- Faxa_rainl(i) = precip_liq_surf_mass(i)/dt*(1000.0/PC::RHO_H2O);
- Faxa_snowl(i) = precip_ice_surf_mass(i)/dt*(1000.0/PC::RHO_H2O);
+ if (export_source(idx_Faxa_rainl)==FROM_MODEL) { Faxa_rainl(i) = precip_liq_surf_mass(i)/dt*(1000.0/PC::RHO_H2O); }
+ if (export_source(idx_Faxa_snowl)==FROM_MODEL) { Faxa_snowl(i) = precip_ice_surf_mass(i)/dt*(1000.0/PC::RHO_H2O); }
}
});
-
+ // Variables that are already surface vars in the ATM can just be copied directly.
+ if (m_export_source_h(idx_Faxa_swndr)==FROM_MODEL) { Kokkos::deep_copy(Faxa_swndr, sfc_flux_dir_nir); }
+ if (m_export_source_h(idx_Faxa_swvdr)==FROM_MODEL) { Kokkos::deep_copy(Faxa_swvdr, sfc_flux_dir_vis); }
+ if (m_export_source_h(idx_Faxa_swndf)==FROM_MODEL) { Kokkos::deep_copy(Faxa_swndf, sfc_flux_dif_nir); }
+ if (m_export_source_h(idx_Faxa_swvdf)==FROM_MODEL) { Kokkos::deep_copy(Faxa_swvdf, sfc_flux_dif_vis); }
+ if (m_export_source_h(idx_Faxa_swnet)==FROM_MODEL) { Kokkos::deep_copy(Faxa_swnet, sfc_flux_sw_net); }
+ if (m_export_source_h(idx_Faxa_lwdn )==FROM_MODEL) { Kokkos::deep_copy(Faxa_lwdn, sfc_flux_lw_dn); }
+}
+// =========================================================================================
+void SurfaceCouplingExporter::do_export_to_cpl(const bool called_during_initialization)
+{
+ using policy_type = KT::RangePolicy;
+ // Any field not exported by scream, or not exported
+ // during initialization, is set to 0.0
+ Kokkos::deep_copy(m_cpl_exports_view_d, 0.0);
+ const auto cpl_exports_view_d = m_cpl_exports_view_d;
+ const int num_exports = m_num_scream_exports;
+ const int num_cols = m_num_cols;
+ const auto col_info = m_column_info_d;
// Export to cpl data
auto export_policy = policy_type (0,num_exports*num_cols);
Kokkos::parallel_for(export_policy, KOKKOS_LAMBDA(const int& i) {
diff --git a/components/eamxx/src/control/atmosphere_surface_coupling_exporter.hpp b/components/eamxx/src/control/atmosphere_surface_coupling_exporter.hpp
index 04b6d34e89a6..285401d1193b 100644
--- a/components/eamxx/src/control/atmosphere_surface_coupling_exporter.hpp
+++ b/components/eamxx/src/control/atmosphere_surface_coupling_exporter.hpp
@@ -21,6 +21,14 @@ namespace scream
* in its list of subcomponents (the AD should make sure of this).
*/
+// enum to track how exported fields will be set.
+enum ExportType {
+ FROM_MODEL = 0, // Variable will be derived from atmosphere model state
+ FROM_FILE = 1, // Variable will be set given data from a file
+ CONSTANT = 2 // Set variable to a constant value
+};
+
+
class SurfaceCouplingExporter : public AtmosphereProcess
{
public:
@@ -69,7 +77,10 @@ class SurfaceCouplingExporter : public AtmosphereProcess
// If calling in initialize_impl(), set
// called_during_initialization=true to avoid exporting fields
// which do not have valid entries.
- void do_export(const double dt, const bool called_during_initialization=false);
+ void do_export(const double dt, const bool called_during_initialization=false); // Main export routine
+ void compute_eamxx_exports(const double dt, const bool called_during_initialization=false); // Export vars are derived from eamxx state
+ void set_constant_exports(const double dt, const bool called_during_initialization=false); // Export vars are set to a constant
+ void do_export_to_cpl(const bool called_during_initialization=false); // Finish export by copying data to cpl structures.
// Take and store data from SCDataManager
void setup_surface_coupling_data(const SCDataManager &sc_data_manager);
@@ -111,8 +122,13 @@ class SurfaceCouplingExporter : public AtmosphereProcess
// Number of fields in cpl data
Int m_num_cpl_exports;
- // Number of exports from SCREAM
- Int m_num_scream_exports;
+ // Number of exports from EAMxx and how they will be handled
+ Int m_num_scream_exports;
+ view_1d m_export_source;
+ view_1d m_export_source_h;
+ std::map m_export_constants;
+ int m_num_from_model_exports=0;
+ int m_num_const_exports=0;
// Views storing a 2d array with dims (num_cols,num_fields) for cpl export data.
// The field idx strides faster, since that's what mct does (so we can "view" the
diff --git a/components/eamxx/src/control/atmosphere_surface_coupling_importer.cpp b/components/eamxx/src/control/atmosphere_surface_coupling_importer.cpp
index b773979a7e6a..828bc4a1abfb 100644
--- a/components/eamxx/src/control/atmosphere_surface_coupling_importer.cpp
+++ b/components/eamxx/src/control/atmosphere_surface_coupling_importer.cpp
@@ -53,6 +53,8 @@ void SurfaceCouplingImporter::set_grids(const std::shared_ptr("qv_2m", scalar2d_layout, Qunit, grid_name);
add_field("wind_speed_10m", scalar2d_layout, m/s, grid_name);
add_field("snow_depth_land", scalar2d_layout, m, grid_name);
+ add_field("ocnfrac", scalar2d_layout, nondim, grid_name);
+ add_field("landfrac", scalar2d_layout, nondim, grid_name);
}
// =========================================================================================
void SurfaceCouplingImporter::setup_surface_coupling_data(const SCDataManager &sc_data_manager)
diff --git a/components/eamxx/src/dynamics/homme/atmosphere_dynamics.cpp b/components/eamxx/src/dynamics/homme/atmosphere_dynamics.cpp
index 322c7ee78f2d..d307ec78dd6c 100644
--- a/components/eamxx/src/dynamics/homme/atmosphere_dynamics.cpp
+++ b/components/eamxx/src/dynamics/homme/atmosphere_dynamics.cpp
@@ -52,9 +52,8 @@ HommeDynamics::HommeDynamics (const ekat::Comm& comm, const ekat::ParameterList&
// This class needs Homme's context, so register as a user
HommeContextUser::singleton().add_user();
- ekat::any homme_nsteps;
- homme_nsteps.reset(-1);
- m_restart_extra_data["homme_nsteps"] = std::make_pair(std::string("int"),homme_nsteps);
+ auto homme_nsteps = std::make_shared(-1);
+ m_restart_extra_data["homme_nsteps"] = homme_nsteps;
if (!is_parallel_inited_f90()) {
// While we're here, we can init homme's parallel session
@@ -65,6 +64,10 @@ HommeDynamics::HommeDynamics (const ekat::Comm& comm, const ekat::ParameterList&
// Set the log filename in the F90 interface
const char* logname = m_atm_logger->get_logfile_name().c_str();
set_homme_log_file_name_f90 (&logname);
+
+ m_bfb_hash_nstep = 0;
+ if (params.isParameter("BfbHash"))
+ m_bfb_hash_nstep = std::max(0, params.get("BfbHash"));
}
HommeDynamics::~HommeDynamics ()
@@ -470,6 +473,9 @@ void HommeDynamics::run_impl (const double dt)
" - input dt : " << dt << "\n"
" - tolerance: " << std::numeric_limits::epsilon()*10 << "\n");
+ if (m_bfb_hash_nstep > 0 && timestamp().get_num_steps() % m_bfb_hash_nstep == 0)
+ print_fast_global_state_hash("Hommexx");
+
const int dt_int = static_cast(std::round(dt));
const int nsplit = get_homme_nsplit_f90(dt_int);
@@ -487,7 +493,7 @@ void HommeDynamics::run_impl (const double dt)
// Update nstep in the restart extra data, so it can be written to restart if needed.
const auto& tl = c.get();
- auto& nstep = ekat::any_cast(m_restart_extra_data["homme_nsteps"].second);
+ auto& nstep = ekat::any_cast(*m_restart_extra_data["homme_nsteps"]);
nstep = tl.nstep;
// Post process Homme's output, to produce what the rest of Atm expects
@@ -778,14 +784,22 @@ void HommeDynamics::init_homme_views () {
constexpr int QSZ = HOMMEXX_QSIZE_D;
constexpr int NVL = HOMMEXX_NUM_LEV;
constexpr int NVLI = HOMMEXX_NUM_LEV_P;
+ constexpr int N = HOMMEXX_PACK_SIZE;
const int nelem = m_dyn_grid->get_num_local_dofs()/(NGP*NGP);
const int qsize = tracers.num_tracers();
+ const auto ncols = m_phys_grid->get_num_local_dofs();
+ const auto nlevs = m_phys_grid->get_num_vertical_levels();
+ const auto npacks= ekat::PackInfo::num_packs(nlevs);
+
+ using ESU = ekat::ExeSpaceUtils;
+ const auto default_policy = ESU::get_default_team_policy(ncols,npacks);
+
// Print homme's parameters, so user can see whether something wasn't set right.
// TODO: make Homme::SimulationParams::print accept an ostream.
std::stringstream msg;
- msg << "\n************** CXX SimulationParams **********************\n\n";
+ msg << "\n************** HOMMEXX SimulationParams **********************\n\n";
msg << " time_step_type: " << Homme::etoi(params.time_step_type) << "\n";
msg << " moisture: " << (params.moisture==Homme::MoistDry::DRY ? "dry" : "moist") << "\n";
msg << " remap_alg: " << Homme::etoi(params.remap_alg) << "\n";
@@ -815,6 +829,15 @@ void HommeDynamics::init_homme_views () {
msg << " disable_diagnostics: " << (params.disable_diagnostics ? "yes" : "no") << "\n";
msg << " theta_hydrostatic_mode: " << (params.theta_hydrostatic_mode ? "yes" : "no") << "\n";
msg << " prescribed_wind: " << (params.prescribed_wind ? "yes" : "no") << "\n";
+
+ msg << "\n************** General run info **********************\n\n";
+ msg << " ncols: " << ncols << "\n";
+ msg << " nlevs: " << nlevs << "\n";
+ msg << " npacks: " << npacks << "\n";
+ msg << " league_size: " << default_policy.league_size() << "\n";
+ msg << " team_size: " << default_policy.team_size() << "\n";
+ msg << " concurrent teams: " << KT::ExeSpace().concurrency() / default_policy.team_size() << "\n";
+
// TODO: Replace with scale_factor and laplacian_rigid_factor when available.
//msg << " rearth: " << params.rearth << "\n";
msg << "\n**********************************************************\n" << "\n";
@@ -913,9 +936,9 @@ void HommeDynamics::restart_homme_state () {
auto& tl = c.get();
// For BFB restarts, set nstep counter in Homme's TimeLevel to match the restarted value.
- const auto& nstep = ekat::any_cast(m_restart_extra_data["homme_nsteps"].second);
- tl.nstep = nstep;
- set_homme_param("num_steps",nstep);
+ const auto& nstep = ekat::any_ptr_cast(*m_restart_extra_data["homme_nsteps"]);
+ tl.nstep = *nstep;
+ set_homme_param("num_steps",*nstep);
constexpr int NGP = HOMMEXX_NP;
const int nlevs = m_phys_grid->get_num_vertical_levels();
@@ -1095,7 +1118,7 @@ void HommeDynamics::initialize_homme_state () {
const int n0 = tl.n0;
const int n0_qdp = tl.n0_qdp;
- ekat::any_cast(m_restart_extra_data["homme_nsteps"].second) = tl.nstep;
+ ekat::any_cast(*m_restart_extra_data["homme_nsteps"]) = tl.nstep;
const auto phis_dyn_view = m_helper_fields.at("phis_dyn").get_view();
const auto phi_int_view = m_helper_fields.at("phi_int_dyn").get_view();
diff --git a/components/eamxx/src/dynamics/homme/atmosphere_dynamics.hpp b/components/eamxx/src/dynamics/homme/atmosphere_dynamics.hpp
index dc93c6c89267..346951b8bf8c 100644
--- a/components/eamxx/src/dynamics/homme/atmosphere_dynamics.hpp
+++ b/components/eamxx/src/dynamics/homme/atmosphere_dynamics.hpp
@@ -149,6 +149,8 @@ class HommeDynamics : public AtmosphereProcess
Real m_raykrange; // Range of rayleigh friction profile.
Real m_raytau0; // Approximate value of decay time at model top (days)
// if set to 0, no rayleigh friction is applied
+
+ int m_bfb_hash_nstep;
};
} // namespace scream
diff --git a/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp b/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp
index 94720c75d9f8..0f13141b9f6b 100644
--- a/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp
+++ b/components/eamxx/src/dynamics/homme/homme_grids_manager.cpp
@@ -181,7 +181,7 @@ void HommeGridsManager::build_dynamics_grid () {
initialize_vertical_coordinates(dyn_grid);
- dyn_grid->m_short_name = "_dyn";
+ dyn_grid->m_short_name = "dyn";
add_grid(dyn_grid);
}
@@ -314,8 +314,7 @@ initialize_vertical_coordinates (const nonconstgrid_ptr_type& dyn_grid) {
{ "hybm", layout_mid }
};
- AtmosphereInput vcoord_reader(m_comm,vcoord_reader_pl);
- vcoord_reader.init(dyn_grid,host_views,layouts);
+ AtmosphereInput vcoord_reader(vcoord_reader_pl,dyn_grid,host_views,layouts);
vcoord_reader.read_variables();
vcoord_reader.finalize();
diff --git a/components/eamxx/src/dynamics/homme/tests/dyn_grid_io.cpp b/components/eamxx/src/dynamics/homme/tests/dyn_grid_io.cpp
index 1d3c103cdab9..0819dd87fd39 100644
--- a/components/eamxx/src/dynamics/homme/tests/dyn_grid_io.cpp
+++ b/components/eamxx/src/dynamics/homme/tests/dyn_grid_io.cpp
@@ -27,6 +27,12 @@ void cleanup_test_f90 ();
namespace {
+/*
+ * In this test we do a dyn->physGLL remap "on the fly" during the output phase.
+ * Then, we load the generated file on a separate FieldManager, and compare the
+ * values against the ones we would get manually running the d2p remapper.
+ */
+
TEST_CASE("dyn_grid_io")
{
using namespace scream;
@@ -47,17 +53,6 @@ TEST_CASE("dyn_grid_io")
}
init_test_params_f90 ();
- // The homme context
- auto& c = Homme::Context::singleton();
-
- // The TimeLevel structure is needed by the PD remapper
- // Note: we don't remap states, so doesn't matter what values we pick
- c.create_if_not_there();
- auto& tl = c.get();
- tl.np1 = 0;
- tl.nm1 = 1;
- tl.n0 = 2;
-
// Set parameters
constexpr int ne = 2;
set_homme_param("ne",ne);
@@ -96,10 +91,15 @@ TEST_CASE("dyn_grid_io")
FieldIdentifier fid_phys_2 ("field_2",layout_phys_2,nondim,phys_grid->name());
FieldIdentifier fid_phys_3 ("field_3",layout_phys_3,nondim,phys_grid->name());
+ // The starting FM
auto fm_dyn = std::make_shared (dyn_grid);
- auto fm_phys= std::make_shared (phys_grid);
+
+ // The FM we will manually remap onto
auto fm_ctrl= std::make_shared (phys_grid);
+ // The FM we will read into, and compare against the previous
+ auto fm_phys= std::make_shared (phys_grid);
+
fm_dyn->registration_begins();
fm_phys->registration_begins();
fm_ctrl->registration_begins();
@@ -128,67 +128,54 @@ TEST_CASE("dyn_grid_io")
std::vector fnames = {"field_1", "field_2", "field_3"};
- // Randomize control fields, then remap to dyn fields
+ // Randomize dyn fields, then remap to ctrl fields
std::uniform_real_distribution pdf(0.01,100.0);
auto engine = setup_random_test(&comm);
- auto dyn2phys = gm->create_remapper(dyn_grid,phys_grid);
auto dyn2ctrl = gm->create_remapper(dyn_grid,phys_grid);
- dyn2phys->registration_begins();
dyn2ctrl->registration_begins();
for (const auto& fn : fnames) {
auto fd = fm_dyn->get_field(fn);
- auto fp = fm_phys->get_field(fn);
auto fc = fm_ctrl->get_field(fn);
dyn2ctrl->register_field(fd,fc);
- dyn2phys->register_field(fd,fp);
- randomize(fc,engine,pdf);
+ randomize(fd,engine,pdf);
+ // Init phys field to something obviously wrong
+ auto fp = fm_phys->get_field(fn);
+ fp.deep_copy(-1.0);
}
- dyn2phys->registration_ends();
dyn2ctrl->registration_ends();
- dyn2ctrl->remap(false); // Remap bwd to get data from ctrl to dyn
+ dyn2ctrl->remap(true);
// Now try to write all fields to file from the dyn grid fm
- // IMPORTANT! Make the file name dependent on comm size, so all tests
- // can run in parallel without race conditions on the nc file.
- ekat::ParameterList io_params;
- io_params.set("Max Snapshots Per File",1);
- io_params.set("Averaging Type","Instant");
- io_params.set>("Grids",{"Dynamics"});
- io_params.set("filename_prefix","dyn_grid_io_np" + std::to_string(comm.size()));
- io_params.sublist("Fields").sublist("Dynamics").set>("Field Names",fnames);
- io_params.sublist("Fields").sublist("Dynamics").set("IO Grid Name","Physics GLL");
-
- io_params.sublist("output_control").set("Frequency",1);
- io_params.sublist("output_control").set("frequency_units","nsteps");
- io_params.set("Floating Point Precision","real");
+ // Note: add MPI ranks to filename, to allow MPI tests to run in parallel
+ ekat::ParameterList out_params;
+ out_params.set("Averaging Type","Instant");
+ out_params.set("filename_prefix","dyn_grid_io");
+ out_params.sublist("Fields").sublist("Dynamics").set>("Field Names",fnames);
+ out_params.sublist("Fields").sublist("Dynamics").set("IO Grid Name","Physics GLL");
+
+ out_params.sublist("output_control").set("Frequency",1);
+ out_params.sublist("output_control").set("frequency_units","nsteps");
+ out_params.sublist("output_control").set("MPI Ranks in Filename",true);
+ out_params.set("Floating Point Precision","real");
OutputManager output;
- // AtmosphereOutput output(comm,io_params,fm_dyn,gm);
- output.setup (comm, io_params, fm_dyn, gm, t0, t0, false);
+ output.setup (comm, out_params, fm_dyn, gm, t0, t0, false);
output.run(t0);
output.finalize();
- // Clear the content of the dyn fields, to avoid seeing the same numbers
- // only b/c nothing was in fact read.
- for (const auto& fn : fnames) {
- auto f = fm_dyn->get_field(fn);
- f.deep_copy(-1.0);
- }
-
// Next, let's load all fields from file directly into the dyn grid fm
- std::string filename = "dyn_grid_io_np" + std::to_string(comm.size())
- + ".INSTANT.nsteps_x1." + t0.to_string() + ".nc";
+ std::string filename = "dyn_grid_io.INSTANT.nsteps_x1.np" + std::to_string(comm.size()) + "." + t0.to_string() + ".nc";
filename.erase(std::remove(filename.begin(),filename.end(),':'),filename.end());
- io_params.set("Filename",filename);
- io_params.set("Grid",dyn_grid->name());
- AtmosphereInput input (io_params,fm_dyn, gm);
+ ekat::ParameterList in_params;
+ in_params.set("Filename",filename);
+ in_params.set>("Field Names",fnames);
+ AtmosphereInput input (in_params,fm_phys);
input.read_variables();
input.finalize();
- // Remap dyn->phys, and compare against ctrl
- dyn2phys->remap(true);
+ // Compare against ctrl fields
for (const auto& fn : fnames) {
auto fp = fm_phys->get_field(fn);
auto fc = fm_ctrl->get_field(fn);
diff --git a/components/eamxx/src/mct_coupling/scream_cpl_indices.F90 b/components/eamxx/src/mct_coupling/scream_cpl_indices.F90
index 89c7f02a16dd..df96edab0f06 100644
--- a/components/eamxx/src/mct_coupling/scream_cpl_indices.F90
+++ b/components/eamxx/src/mct_coupling/scream_cpl_indices.F90
@@ -6,7 +6,7 @@ module scream_cpl_indices
private
! Focus only on the ones that scream imports/exports (subsets of x2a and a2x)
- integer, parameter, public :: num_scream_imports = 14
+ integer, parameter, public :: num_scream_imports = 16
integer, parameter, public :: num_scream_exports = 17
integer, public :: num_cpl_imports, num_cpl_exports, import_field_size, export_field_size
@@ -87,6 +87,8 @@ subroutine scream_set_cpl_indices (x2a, a2x)
import_field_names(12) = 'surf_mom_flux'
import_field_names(13) = 'surf_sens_flux'
import_field_names(14) = 'surf_evap'
+ import_field_names(15) = 'ocnfrac'
+ import_field_names(16) = 'landfrac'
! CPL indices
import_cpl_indices(1) = mct_avect_indexra(x2a,'Sx_avsdr')
@@ -103,6 +105,8 @@ subroutine scream_set_cpl_indices (x2a, a2x)
import_cpl_indices(12) = mct_avect_indexra(x2a,'Faxx_tauy')
import_cpl_indices(13) = mct_avect_indexra(x2a,'Faxx_sen')
import_cpl_indices(14) = mct_avect_indexra(x2a,'Faxx_evap')
+ import_cpl_indices(15) = mct_avect_indexra(x2a,'Sf_ofrac')
+ import_cpl_indices(16) = mct_avect_indexra(x2a,'Sf_lfrac')
! Vector components
import_vector_components(11) = 0
@@ -139,22 +143,22 @@ subroutine scream_set_cpl_indices (x2a, a2x)
! SCREAM names
export_field_names(1) = 'Sa_z'
- export_field_names(2) = 'horiz_winds'
- export_field_names(3) = 'horiz_winds'
- export_field_names(4) = 'T_mid'
+ export_field_names(2) = 'Sa_u'
+ export_field_names(3) = 'Sa_v'
+ export_field_names(4) = 'Sa_tbot'
export_field_names(5) = 'Sa_ptem'
- export_field_names(6) = 'p_mid'
- export_field_names(7) = 'qv'
+ export_field_names(6) = 'Sa_pbot'
+ export_field_names(7) = 'Sa_shum'
export_field_names(8) = 'Sa_dens'
export_field_names(9) = 'Sa_pslv'
export_field_names(10) = 'Faxa_rainl'
export_field_names(11) = 'Faxa_snowl'
- export_field_names(12) = 'sfc_flux_dir_nir'
- export_field_names(13) = 'sfc_flux_dir_vis'
- export_field_names(14) = 'sfc_flux_dif_nir'
- export_field_names(15) = 'sfc_flux_dif_vis'
- export_field_names(16) = 'sfc_flux_sw_net'
- export_field_names(17) = 'sfc_flux_lw_dn'
+ export_field_names(12) = 'Faxa_swndr'
+ export_field_names(13) = 'Faxa_swvdr'
+ export_field_names(14) = 'Faxa_swndf'
+ export_field_names(15) = 'Faxa_swvdf'
+ export_field_names(16) = 'Faxa_swnet'
+ export_field_names(17) = 'Faxa_lwdn'
! CPL indices
export_cpl_indices(1) = mct_avect_indexra(a2x,'Sa_z')
@@ -175,10 +179,6 @@ subroutine scream_set_cpl_indices (x2a, a2x)
export_cpl_indices(16) = mct_avect_indexra(a2x,'Faxa_swnet')
export_cpl_indices(17) = mct_avect_indexra(a2x,'Faxa_lwdn')
- ! Vector components
- export_vector_components(2) = 0
- export_vector_components(3) = 1
-
! Does this field need to be imported during intialization
do_export_during_init(1) = .true.
do_export_during_init(2) = .true.
diff --git a/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp b/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp
index b6ec3769e93d..9b4d8875cdfd 100644
--- a/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp
+++ b/components/eamxx/src/mct_coupling/scream_cxx_f90_interface.cpp
@@ -49,7 +49,13 @@ void fpe_guard_wrapper (const Lambda& f) {
ekat::enable_fpes(get_default_fpes());
// Execute wrapped function
- f();
+ try {
+ f();
+ } catch (...) {
+ auto& c = ScreamContext::singleton();
+ c.clean_up();
+ throw;
+ }
// Restore the FPE flag as it was when control was handed to us.
ekat::disable_all_fpes();
diff --git a/components/eamxx/src/physics/mam/eamxx_mam_microphysics.cpp b/components/eamxx/src/physics/mam/eamxx_mam_microphysics.cpp
index 7cca30b348a4..65e358e975da 100644
--- a/components/eamxx/src/physics/mam/eamxx_mam_microphysics.cpp
+++ b/components/eamxx/src/physics/mam/eamxx_mam_microphysics.cpp
@@ -13,7 +13,7 @@ MAMMicrophysics::MAMMicrophysics(
const ekat::Comm& comm,
const ekat::ParameterList& params)
: AtmosphereProcess(comm, params),
- nucleation_(nullptr) {
+ aero_config_(), nucleation_(new mam4::NucleationProcess(aero_config_)) {
}
AtmosphereProcessType MAMMicrophysics::type() const {
@@ -31,6 +31,8 @@ void MAMMicrophysics::set_grids(const std::shared_ptr grids_
// Nevertheless, for output reasons, we like to see 'kg/kg'.
auto q_unit = kg/kg;
q_unit.set_string("kg/kg");
+ auto n_unit = 1/kg;
+ n_unit.set_string("#/kg");
Units nondim(0,0,0,0,0,0,0);
grid_ = grids_manager->get_grid("Physics");
@@ -60,10 +62,19 @@ void MAMMicrophysics::set_grids(const std::shared_ptr grids_
add_field("pseudo_density", scalar3d_layout_mid, q_unit, grid_name); // pdel
add_field("cldfrac_tot", scalar3d_layout_mid, nondim, grid_name);
- // tracer group (stores all aerosol prognostics)
- add_group("tracers", grid_name, Bundling::Required);
+ // aerosol tracers of interest: mass (q) and number (n) mixing ratios
+ add_field("q_aitken_so4", scalar3d_layout_mid, q_unit, grid_name, "tracers");
+ add_field("n_aitken_so4", scalar3d_layout_mid, n_unit, grid_name, "tracers");
+
+ // aerosol-related gases: mass mixing ratios
+ add_field("q_soag", scalar3d_layout_mid, q_unit, grid_name, "tracers");
+ add_field("q_h2so4", scalar3d_layout_mid, q_unit, grid_name, "tracers");
+
+ // Tracer group -- do we need this in addition to the tracers above?
+ add_group("tracers", grid_name, 1, Bundling::Required);
}
+// this checks whether we have the tracers we expect
void MAMMicrophysics::
set_computed_group_impl(const FieldGroup& group) {
const auto& name = group.m_info->m_group_name;
@@ -75,7 +86,8 @@ set_computed_group_impl(const FieldGroup& group) {
// How many aerosol/gas tracers do we expect? Recall that we maintain
// both cloudborne and interstitial aerosol tracers.
- int num_aero_tracers =
+ int num_aero_tracers = 4; // for now, just 2 gases + aitken so4 n,q
+ /*
aero_config_.num_gas_ids() + // gas tracers
2 * aero_config_.num_modes(); // modal number mixing ratio tracers
for (int m = 0; m < aero_config_.num_modes(); ++m) {
@@ -87,23 +99,86 @@ set_computed_group_impl(const FieldGroup& group) {
}
}
}
+ */
EKAT_REQUIRE_MSG(group.m_info->size() >= num_aero_tracers,
"Error! MAM4 requires at least " << num_aero_tracers << " aerosol tracers.");
}
+size_t MAMMicrophysics::requested_buffer_size_in_bytes() const
+{
+ // number of Reals needed by local views in interface
+ const size_t iface_request = sizeof(Real) *
+ (Buffer::num_2d_mid * ncol_ * nlev_ +
+ Buffer::num_2d_iface * ncol_ * (nlev_+1));
+
+ // FIXME: Need to figure out whether we need this stuff
+ /*
+ // Number of Reals needed by the WorkspaceManager passed to shoc_main
+ const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(m_num_cols, nlev_packs);
+ const int n_wind_slots = ekat::npack(2)*Spack::n;
+ const int n_trac_slots = ekat::npack(m_num_tracers+3)*Spack::n;
+ const size_t wsm_request= WSM::get_total_bytes_needed(nlevi_packs, 13+(n_wind_slots+n_trac_slots), policy);
+ */
+
+ return iface_request;// + wsm_request;
+}
+
+void MAMMicrophysics::init_buffers(const ATMBufferManager &buffer_manager) {
+ EKAT_REQUIRE_MSG(buffer_manager.allocated_bytes() >= requested_buffer_size_in_bytes(),
+ "Error! Insufficient buffer size.\n");
+
+ Real* mem = reinterpret_cast(buffer_manager.get_memory());
+
+ // set view pointers for midpoint fields
+ using view_2d_t = decltype(buffer_.z_mid);
+ view_2d_t* view_2d_mid_ptrs[Buffer::num_2d_mid] = {&buffer_.z_mid, &buffer_.dz};
+ for (int i = 0; i < Buffer::num_2d_mid; ++i) {
+ *view_2d_mid_ptrs[i] = view_2d_t(mem, ncol_, nlev_);
+ mem += view_2d_mid_ptrs[i]->size();
+ }
+
+ // set view pointers for interface fields
+ view_2d_t* view_2d_iface_ptrs[Buffer::num_2d_iface] = {&buffer_.z_iface};
+ for (int i = 0; i < Buffer::num_2d_iface; ++i) {
+ *view_2d_iface_ptrs[i] = view_2d_t(mem, ncol_, nlev_+1);
+ mem += view_2d_iface_ptrs[i]->size();
+ }
+
+ // WSM data
+ buffer_.wsm_data = mem;
+
+ /* FIXME: this corresponds to the FIXME in the above function
+ // Compute workspace manager size to check used memory
+ // vs. requested memory
+ const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol_, nlev_);
+ const int n_wind_slots = ekat::npack(2)*Spack::n;
+ const int n_trac_slots = ekat::npack(m_num_tracers+3)*Spack::n;
+ const int wsm_size = WSM::get_total_bytes_needed(nlevi_packs, 13+(n_wind_slots+n_trac_slots), policy)/sizeof(Spack);
+ mem += wsm_size;
+ */
+
+ size_t used_mem = (mem - buffer_manager.get_memory())*sizeof(Real);
+ EKAT_REQUIRE_MSG(used_mem==requested_buffer_size_in_bytes(),
+ "Error! Used memory != requested memory for MAMMicrophysics.");
+}
+
void MAMMicrophysics::initialize_impl(const RunType run_type) {
const auto& T_mid = get_field_in("T_mid").get_view();
- const auto& p_mid = get_field_in("p_mid").get_view();
+ const auto& p_mid = get_field_in("p_mid").get_view();
const auto& qv = get_field_in("qv").get_view();
const auto& pblh = get_field_in("pbl_height").get_view();
- const auto& p_del = get_field_in("pseudo_density").get_view();
+ const auto& p_del = get_field_in("pseudo_density").get_view();
const auto& cldfrac = get_field_in("cldfrac_tot").get_view(); // FIXME: tot or liq?
+
const auto& tracers = get_group_out("tracers");
const auto& tracers_info = tracers.m_info;
+ int num_tracers = tracers_info->size();
// Alias local variables from temporary buffer
- // e.g. auto z_mid = buffer_.z_mid;
+ auto z_mid = buffer_.z_mid;
+ auto dz = buffer_.dz;
+ auto z_iface = buffer_.z_iface;
// Perform any initialization work.
if (run_type==RunType::Initial){
@@ -116,17 +191,39 @@ void MAMMicrophysics::initialize_impl(const RunType run_type) {
*/
}
- // Find indices of qv and aerosol-related quantities
- auto qv_index = tracers_info->m_subview_idx.at("qv");
- // FIXME
+ // set atmosphere state data
+ T_mid_ = T_mid;
+ p_mid_ = p_mid;
+ qv_ = qv;
+ pdel_ = p_del;
+// cloud_f_ = cloud_f; // cloud fraction
+// uv_ = uv; // updraft velocity
+
+ // For now, set z_surf to zero.
+ const Real z_surf = 0.0;
+
+ // Determine indices of aerosol/gas tracers for wet<->dry conversion
+ auto q_aitken_so4_index = tracers_info->m_subview_idx.at("q_aitken_so4");
+ auto q_soag_index = tracers_info->m_subview_idx.at("q_soag");
+ auto q_h2so4_index = tracers_info->m_subview_idx.at("q_h2so4");
+ int num_aero_tracers = 3; // for now, just 2 gases + aitken so4
+ view_1d_int convert_wet_dry_idx_d("convert_wet_dry_idx_d", num_aero_tracers);
+ auto convert_wet_dry_idx_h = Kokkos::create_mirror_view(convert_wet_dry_idx_d);
+ for (int it=0, iq=0; it < num_tracers; ++it) {
+ if ((it == q_aitken_so4_index) || (it == q_soag_index) || (it == q_h2so4_index)) {
+ convert_wet_dry_idx_h(iq) = it;
+ ++iq;
+ }
+ }
+ Kokkos::deep_copy(convert_wet_dry_idx_d, convert_wet_dry_idx_h);
- //preprocess_.set_variables(ncol_, nlev_, T_mid, p_mid, qv, height,
- // p_del, pblh, q_soag, q_h2so4, q_nh3, q_aitken_so4);
+ preprocess_.set_variables(ncol_, nlev_, z_surf, convert_wet_dry_idx_d, T_mid,
+ p_mid, qv, z_mid, z_iface, dz, pdel_, pblh, q_soag_,
+ q_h2so4_, q_aitken_so4_);
// FIXME: here we run the aerosol microphysics parameterizations
- //postprocess_.set_variables(ncol_, nlev_, qv, q_soag, q_h2so4,
- // q_nh3, q_aitken_so4);
+ //postprocess_.set_variables(ncol_, nlev_, qv, q_soag, q_h2so4, q_aitken_so4);
// Set field property checks for the fields in this process
/* e.g.
@@ -139,8 +236,8 @@ void MAMMicrophysics::initialize_impl(const RunType run_type) {
*/
// Setup WSM for internal local variables
- const auto default_policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol_, nlev_);
- // FIXME
+ // FIXME: do we need this?
+ //const auto default_policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol_, nlev_);
//workspace_mgr_.setup(buffer_.wsm_data, nlev_+1, 13+(n_wind_slots+n_trac_slots), default_policy);
// FIXME: aerosol process initialization goes here!
@@ -148,19 +245,70 @@ void MAMMicrophysics::initialize_impl(const RunType run_type) {
void MAMMicrophysics::run_impl(const double dt) {
- const auto default_policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol_, nlev_);
+ const auto scan_policy = ekat::ExeSpaceUtils::get_thread_range_parallel_scan_team_policy(ncol_, nlev_);
+ const auto policy = ekat::ExeSpaceUtils::get_default_team_policy(ncol_, nlev_);
- // preprocess input
- Kokkos::parallel_for("preprocess", default_policy, preprocess_);
+ // preprocess input -- needs a scan for the calculation of atm height
+ Kokkos::parallel_for("preprocess", scan_policy, preprocess_);
Kokkos::fence();
// Reset internal WSM variables.
//workspace_mgr_.reset_internals();
- // FIXME: Aerosol stuff goes here!
+ // nothing depends on simulation time (yet), so we can just use zero for now
+ double t = 0.0;
+
+ // FIXME: for now, we set cloud fraction and updraft velocity to zero.
+ view_1d cloud_f("cloud fraction", nlev_);
+ view_1d uv("updraft velocity", nlev_);
+ Kokkos::deep_copy(cloud_f, 0.0);
+ Kokkos::deep_copy(uv, 0.0);
+
+ // Compute nucleation tendencies on all local columns and accumulate them
+ // into our tracer state.
+ Kokkos::parallel_for(policy, KOKKOS_LAMBDA(const ThreadTeam& team) {
+ const Int icol = team.league_rank(); // column index
+
+ // extract column-specific atmosphere state data
+ haero::Atmosphere atm(nlev_, pblh_(icol));
+ atm.temperature = ekat::subview(T_mid_, icol);
+ atm.pressure = ekat::subview(p_mid_, icol);
+ atm.vapor_mixing_ratio = ekat::subview(qv_, icol);
+ atm.height = ekat::subview(height_, icol);
+ atm.hydrostatic_dp = ekat::subview(pdel_, icol);
+ atm.cloud_fraction = cloud_f;
+ atm.updraft_vel_ice_nucleation = uv;
+
+ // extract column-specific subviews into aerosol prognostics
+ using AeroConfig = mam4::AeroConfig;
+ using ModeIndex = mam4::ModeIndex;
+ using AeroId = mam4::AeroId;
+ using GasId = mam4::GasId;
+
+ mam4::Prognostics progs(nlev_);
+ int iait = static_cast(ModeIndex::Aitken);
+ progs.n_mode_i[iait] = ekat::subview(n_aitken_, icol);
+ int iso4 = mam4::aerosol_index_for_mode(ModeIndex::Aitken, AeroId::SO4);
+ progs.q_aero_i[iait][iso4] = ekat::subview(q_aitken_so4_, icol);
+ int ih2so4 = static_cast(GasId::H2SO4);
+ progs.q_gas[ih2so4] = ekat::subview(q_h2so4_, icol);
+
+ mam4::Diagnostics diags(nlev_);
+
+ // run the nucleation process to obtain tendencies
+ mam4::Tendencies tends(nlev_);
+ nucleation_->compute_tendencies(team, t, dt, atm, progs, diags, tends);
+
+ // accumulate tendencies into tracers state
+ Kokkos::parallel_for(Kokkos::TeamThreadRange(team, nlev_), [&](const int klev) {
+ progs.n_mode_i[iait](klev) += dt * tends.n_mode_i[iait](klev);
+ progs.q_aero_i[iait][iso4](klev) += dt * tends.q_aero_i[iait][iso4](klev);
+ progs.q_gas[ih2so4](klev) += dt * tends.q_gas[ih2so4](klev);
+ });
+ });
// postprocess output
- Kokkos::parallel_for("postprocess", default_policy, postprocess_);
+ Kokkos::parallel_for("postprocess", policy, postprocess_);
Kokkos::fence();
}
diff --git a/components/eamxx/src/physics/mam/eamxx_mam_microphysics.hpp b/components/eamxx/src/physics/mam/eamxx_mam_microphysics.hpp
index 08d7b035dc78..95e0a05713d3 100644
--- a/components/eamxx/src/physics/mam/eamxx_mam_microphysics.hpp
+++ b/components/eamxx/src/physics/mam/eamxx_mam_microphysics.hpp
@@ -57,18 +57,16 @@ class MAMMicrophysics final : public scream::AtmosphereProcess {
// grid
void set_grids(const std::shared_ptr grids_manager) override;
- /*
// management of common atm process memory
size_t requested_buffer_size_in_bytes() const override;
void init_buffers(const ATMBufferManager &buffer_manager) override;
- */
// process behavior
void initialize_impl(const RunType run_type) override;
void run_impl(const double dt) override;
void finalize_impl() override;
- // MAM4xx updates the 'tracers' group.
+ // performs some checks on the tracers group
void set_computed_group_impl(const FieldGroup& group) override;
private:
@@ -84,7 +82,17 @@ class MAMMicrophysics final : public scream::AtmosphereProcess {
KOKKOS_INLINE_FUNCTION
void operator()(const Kokkos::TeamPolicy::member_type& team) const {
- const int i = team.league_rank();
+ const int i = team.league_rank(); // column index
+
+ // Compute vertical layer heights
+ const auto dz_i = ekat::subview(dz_, i);
+ auto z_iface_i = ekat::subview(z_iface_, i);
+ auto z_mid_i = ekat::subview(z_mid_, i);
+ PF::calculate_z_int(team, nlev_, dz_i, z_surf_, z_iface_i);
+ team.team_barrier();
+ PF::calculate_z_mid(team, nlev_, z_iface_i, z_mid_i);
+ team.team_barrier();
+
Kokkos::parallel_for(Kokkos::TeamThreadRange(team, nlev_), [&](const int k) {
//--------------------------
// Wet to dry mixing ratios
@@ -103,7 +111,6 @@ class MAMMicrophysics final : public scream::AtmosphereProcess {
// conversion. qv is converted to dry mmr in the next parallel for.
q_soag_(i,k) = PF::calculate_drymmr_from_wetmmr(q_soag_(i,k), qv_(i,k));
q_h2so4_(i,k) = PF::calculate_drymmr_from_wetmmr(q_h2so4_(i,k), qv_(i,k));
- q_nh3_(i,k) = PF::calculate_drymmr_from_wetmmr(q_nh3_(i,k), qv_(i,k));
q_aitken_so4_(i,k) = PF::calculate_drymmr_from_wetmmr(q_aitken_so4_(i,k), qv_(i,k));
@@ -116,53 +123,65 @@ class MAMMicrophysics final : public scream::AtmosphereProcess {
// number of horizontal columns and vertical levels
int ncol_, nlev_;
+ // height of bottom of atmosphere
+ Real z_surf_;
+
// used for converting between wet and dry mixing ratios
view_1d_int convert_wet_dry_idx_d_;
// local atmospheric state column variables
- view_2d_const T_mid_; // temperature at grid midpoints [K]
- view_2d_const p_mid_; // total pressure at grid midpoints [Pa]
- view_2d qv_; // water vapor mass mixing ratio, not const because it
- // must be converted from wet to dry [kg vapor/kg dry air]
- view_2d height_; // height at grid interfaces [m]
- view_2d pdel_; // hydrostatic "pressure thickness" at grid
- // interfaces [Pa]
- view_1d_const pblh_; // planetary boundary layer height [m]
+ view_2d T_mid_; // temperature at grid midpoints [K]
+ view_2d p_mid_; // total pressure at grid midpoints [Pa]
+ view_2d qv_; // water vapor mass mixing ratio, not const because it
+ // must be converted from wet to dry [kg vapor/kg dry air]
+ view_2d z_mid_; // height at layer midpoints [m]
+ view_2d z_iface_; // height at layer interfaces [m]
+ view_2d dz_; // layer thickness [m]
+ view_2d pdel_; // hydrostatic "pressure thickness" at grid
+ // interfaces [Pa]
+ view_2d cloud_f_; // cloud fraction [-]
+ view_2d uv_; // updraft velocity [m/s]
+ view_1d pblh_; // planetary boundary layer height [m]
// local aerosol-related gases
- view_2d q_soag_; // secondary organic aerosol gas [kg gas/kg dry air]
- view_2d q_h2so4_; // H2SO3 gas [kg/kg dry air]
- view_2d q_nh3_; // NH3 gas [kg/kg dry air]
+ view_2d q_soag_; // secondary organic aerosol gas [kg gas/kg dry air]
+ view_2d q_h2so4_; // H2SO3 gas [kg/kg dry air]
// local aerosols (more to appear as we improve this atm process)
- view_2d q_aitken_so4_; // SO4 aerosol in aitken mode [kg/kg dry air]
+ view_2d n_aitken_; // aitken mode number mixing ratio [1/kg dry air]
+ view_2d q_aitken_so4_; // SO4 mass mixing ratio in aitken mode [kg/kg dry air]
// assigns local variables
- void set_variables(const int ncol, const int nlev,
- const view_2d_const& T_mid,
- const view_2d_const& p_mid,
- const view_2d& qv,
- const view_2d& height,
- const view_2d& pdel,
- const view_1d_const& pblh,
- const view_2d& q_soag,
- const view_2d& q_h2so4,
- const view_2d& q_nh3,
- const view_2d& q_aitken_so4) {
+ void set_variables(const int ncol, const int nlev, const Real z_surf,
+ const view_1d_int& convert_wet_dry_idx_d,
+ const view_2d& T_mid,
+ const view_2d& p_mid,
+ const view_2d& qv,
+ const view_2d& z_mid,
+ const view_2d& z_iface,
+ const view_2d& dz,
+ const view_2d& pdel,
+ const view_1d& pblh,
+ const view_2d& q_soag,
+ const view_2d& q_h2so4,
+ const view_2d& q_aitken_so4) {
ncol_ = ncol;
nlev_ = nlev;
+ z_surf_ = z_surf;
+ convert_wet_dry_idx_d_ = convert_wet_dry_idx_d;
T_mid_ = T_mid;
p_mid_ = p_mid;
qv_ = qv;
- height_ = height;
+ z_mid_ = z_mid;
+ z_iface_ = z_iface;
+ dz_ = dz;
pdel_ = pdel;
pblh_ = pblh;
q_soag_ = q_soag;
q_h2so4_ = q_h2so4;
- q_nh3_ = q_nh3;
q_aitken_so4_ = q_aitken_so4;
} // set_variables
- }; // MAM4AerosolMicrophysics::Preprocess
+ }; // MAMMicrophysics::Preprocess
// Postprocessing functor
struct Postprocess {
@@ -170,9 +189,6 @@ class MAMMicrophysics final : public scream::AtmosphereProcess {
KOKKOS_INLINE_FUNCTION
void operator()(const Kokkos::TeamPolicy::member_type& team) const {
- // Copy the updated aerosol tracers back into the tracer array.
- // FIXME
-
// After these updates, all tracers are converted from dry mmr to wet mmr
const int i = team.league_rank();
Kokkos::parallel_for(Kokkos::TeamThreadRange(team, nlev_), [&](const int k) {
@@ -182,7 +198,6 @@ class MAMMicrophysics final : public scream::AtmosphereProcess {
// 2. "dry" water vapor mixing ratio
q_soag_(i,k) = PF::calculate_wetmmr_from_drymmr(q_soag_(i,k), qv_(i,k));
q_h2so4_(i,k) = PF::calculate_wetmmr_from_drymmr(q_h2so4_(i,k), qv_(i,k));
- q_nh3_(i,k) = PF::calculate_wetmmr_from_drymmr(q_nh3_(i,k), qv_(i,k));
q_aitken_so4_(i,k) = PF::calculate_wetmmr_from_drymmr(q_aitken_so4_(i,k), qv_(i,k));
@@ -195,10 +210,12 @@ class MAMMicrophysics final : public scream::AtmosphereProcess {
int ncol_, nlev_;
view_2d qv_;
+ // used for converting between wet and dry mixing ratios
+ view_1d_int convert_wet_dry_idx_d_;
+
// local aerosol-related gases
view_2d q_soag_; // secondary organic aerosol gas [kg gas/kg dry air]
view_2d q_h2so4_; // H2SO3 gas [kg/kg dry air]
- view_2d q_nh3_; // NH3 gas [kg/kg dry air]
// local aerosols (more to appear as we improve this atm process)
view_2d q_aitken_so4_; // SO4 aerosol in aitken mode [kg/kg dry air]
@@ -206,20 +223,39 @@ class MAMMicrophysics final : public scream::AtmosphereProcess {
// assigns local variables
void set_variables(const int ncol,
const int nlev,
+ const view_1d_int& convert_wet_dry_idx_d,
const view_2d& qv,
const view_2d& q_soag,
const view_2d& q_h2so4,
- const view_2d& q_nh3,
const view_2d& q_aitken_so4) {
ncol_ = ncol;
nlev_ = nlev;
+ convert_wet_dry_idx_d_ = convert_wet_dry_idx_d;
qv_ = qv;
q_soag_ = q_soag;
q_h2so4_ = q_h2so4;
- q_nh3_ = q_nh3;
q_aitken_so4_ = q_aitken_so4;
} // set_variables
- }; // MAM4AerosolMicrophysics::Postprocess
+ }; // MAMMicrophysics::Postprocess
+
+ // storage for local variables, initialized with ATMBufferManager
+ struct Buffer {
+ // number of fields stored at column midpoints
+ static constexpr int num_2d_mid = 2;
+
+ // number of fields stored at column interfaces
+ static constexpr int num_2d_iface = 1;
+
+ // column midpoint fields
+ uview_2d z_mid; // height at midpoints
+ uview_2d dz; // layer thickness
+
+ // column interface fields
+ uview_2d z_iface; // height at interfaces
+
+ // storage
+ Real* wsm_data;
+ };
// MAM4 aerosol particle size description
mam4::AeroConfig aero_config_;
@@ -231,11 +267,29 @@ class MAMMicrophysics final : public scream::AtmosphereProcess {
Preprocess preprocess_;
Postprocess postprocess_;
- /*
- // WSM for internal local variables
- ekat::WorkspaceManager workspace_mgr_;
+ // local atmospheric state column variables
+ view_2d T_mid_; // temperature at grid midpoints [K]
+ view_2d p_mid_; // total pressure at grid midpoints [Pa]
+ view_2d qv_; // water vapor mass mixing ratio, not const because it
+ // must be converted from wet to dry [kg vapor/kg dry air]
+ view_2d height_; // height at grid interfaces [m]
+ view_2d pdel_; // hydrostatic "pressure thickness" at grid
+ // interfaces [Pa]
+ view_2d cloud_f_; // cloud fraction [-]
+ view_2d uv_; // updraft velocity [m/s]
+ view_1d pblh_; // planetary boundary layer height [m]
+
+ // local aerosol-related gases
+ view_2d q_soag_; // secondary organic aerosol gas [kg gas/kg dry air]
+ view_2d q_h2so4_; // H2SO3 gas [kg/kg dry air]
+
+ // local aerosols (more to appear as we improve this atm process)
+ view_2d n_aitken_; // aitken mode number mixing ratio [1/kg dry air]
+ view_2d q_aitken_so4_; // SO4 mass mixing ratio in aitken mode [kg/kg dry air]
+
+ // workspace manager for internal local variables
+ //ekat::WorkspaceManager workspace_mgr_;
Buffer buffer_;
- */
// physics grid for column information
std::shared_ptr grid_;
diff --git a/components/eamxx/src/physics/nudging/atmosphere_nudging.cpp b/components/eamxx/src/physics/nudging/atmosphere_nudging.cpp
index 4a6ceedf550e..03fc2a5563c8 100644
--- a/components/eamxx/src/physics/nudging/atmosphere_nudging.cpp
+++ b/components/eamxx/src/physics/nudging/atmosphere_nudging.cpp
@@ -35,7 +35,7 @@ void Nudging::set_grids(const std::shared_ptr grids_manager)
//Now need to read in the file
scorpio::register_file(datafile,scorpio::Read);
- m_num_src_levs = scorpio::get_dimlen_c2f(datafile.c_str(),"lev");
+ m_num_src_levs = scorpio::get_dimlen(datafile,"lev");
double time_value_1= scorpio::read_time_at_index_c2f(datafile.c_str(),1);
double time_value_2= scorpio::read_time_at_index_c2f(datafile.c_str(),2);
@@ -91,8 +91,7 @@ void Nudging::initialize_impl (const RunType /* run_type */)
// We need to skip grid checks because multiple ranks
// may want the same column of source data.
data_in_params.set("Skip_Grid_Checks",true);
- data_input = std::make_shared(m_comm,data_in_params);
- data_input->init(grid_l,host_views,layouts);
+ data_input.init(data_in_params,grid_l,host_views,layouts);
T_mid_ext = fields_ext["T_mid"];
p_mid_ext = fields_ext["p_mid"];
@@ -102,8 +101,8 @@ void Nudging::initialize_impl (const RunType /* run_type */)
ts0=timestamp();
//Check that internal timestamp starts at same point as time in external file
- int start_date=scorpio::get_int_attribute_c2f(datafile.c_str(),"start_date");
- int start_time=scorpio::get_int_attribute_c2f(datafile.c_str(),"start_time");
+ int start_date=scorpio::get_attribute(datafile,"start_date");
+ int start_time=scorpio::get_attribute(datafile,"start_time");
int start_year=int(start_date/10000);
int start_month=int((start_date-start_year*10000)/100);
int start_day=int(start_date-start_year*10000-start_month*100);
@@ -137,7 +136,7 @@ void Nudging::initialize_impl (const RunType /* run_type */)
NudgingData_aft.time = -999;
//Read in the first time step
- data_input->read_variables(0);
+ data_input.read_variables(0);
Kokkos::deep_copy(NudgingData_bef.T_mid,fields_ext_h["T_mid"]);
Kokkos::deep_copy(NudgingData_bef.p_mid,fields_ext_h["p_mid"]);
Kokkos::deep_copy(NudgingData_bef.u,fields_ext_h["u"]);
@@ -146,7 +145,7 @@ void Nudging::initialize_impl (const RunType /* run_type */)
NudgingData_bef.time = 0.;
//Read in the first time step
- data_input->read_variables(1);
+ data_input.read_variables(1);
Kokkos::deep_copy(NudgingData_aft.T_mid,fields_ext_h["T_mid"]);
Kokkos::deep_copy(NudgingData_aft.p_mid,fields_ext_h["p_mid"]);
Kokkos::deep_copy(NudgingData_aft.u,fields_ext_h["u"]);
@@ -225,7 +224,7 @@ void Nudging::update_time_step (const int time_s)
std::swap (NudgingData_bef,NudgingData_aft);
NudgingData_bef.time = NudgingData_aft.time;
- data_input->read_variables(time_index+1);
+ data_input.read_variables(time_index+1);
Kokkos::deep_copy(NudgingData_aft.T_mid,fields_ext_h["T_mid"]);
Kokkos::deep_copy(NudgingData_aft.p_mid,fields_ext_h["p_mid"]);
Kokkos::deep_copy(NudgingData_aft.u,fields_ext_h["u"]);
@@ -347,7 +346,7 @@ void Nudging::run_impl (const double dt)
// =========================================================================================
void Nudging::finalize_impl()
{
- data_input->finalize();
+ data_input.finalize();
}
} // namespace scream
diff --git a/components/eamxx/src/physics/nudging/atmosphere_nudging.hpp b/components/eamxx/src/physics/nudging/atmosphere_nudging.hpp
index 81e069d2bc56..9414758f2696 100644
--- a/components/eamxx/src/physics/nudging/atmosphere_nudging.hpp
+++ b/components/eamxx/src/physics/nudging/atmosphere_nudging.hpp
@@ -96,7 +96,7 @@ class Nudging : public AtmosphereProcess
TimeStamp ts0;
NudgingFunc::NudgingData NudgingData_bef;
NudgingFunc::NudgingData NudgingData_aft;
- std::shared_ptr data_input;
+ AtmosphereInput data_input;
}; // class Nudging
} // namespace scream
diff --git a/components/eamxx/src/physics/p3/tests/CMakeLists.txt b/components/eamxx/src/physics/p3/tests/CMakeLists.txt
index 8c8e9d9528d6..8a46639bc419 100644
--- a/components/eamxx/src/physics/p3/tests/CMakeLists.txt
+++ b/components/eamxx/src/physics/p3/tests/CMakeLists.txt
@@ -40,7 +40,7 @@ set(P3_TESTS_SRCS
p3_prevent_liq_supersaturation_tests.cpp
) # P3_TESTS_SRCS
-if (SCREAM_DEBUG AND NOT EKAT_ENABLE_CUDA_MEMCHECK)
+if (SCREAM_DEBUG AND NOT SCREAM_TEST_SIZE STREQUAL "SHORT")
set (FORCE_RUN_DIFF_FAILS TRUE)
else ()
set (FORCE_RUN_DIFF_FAILS FALSE)
diff --git a/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp b/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp
index 032835aab34a..5bc12b2464db 100644
--- a/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp
+++ b/components/eamxx/src/physics/p3/tests/p3_run_and_cmp.cpp
@@ -1,5 +1,6 @@
#include "share/scream_types.hpp"
#include "share/scream_session.hpp"
+#include "share/util/scream_utils.hpp"
#include "p3_main_wrap.hpp"
#include "p3_functions_f90.hpp"
@@ -29,56 +30,6 @@ using namespace scream::p3;
*/
-/* Given a column of data for variable "label" from the reference run
- * (probably master) and from your new exploratory run, loop over all
- * heights and confirm whether or not the relative difference between
- * runs is within tolerance "tol". If not, print debug info. Here, "a"
- * is the value from the reference run and "b" is from the new run.
- */
-template
-static Int compare (const std::string& label, const Scalar* a,
- const Scalar* b, const Int& n, const Real& tol) {
-
- Int nerr1 = 0;
- Int nerr2 = 0;
- Real den = 0;
- for (Int i = 0; i < n; ++i)
- den = std::max(den, std::abs(a[i]));
- Real worst = 0;
- for (Int i = 0; i < n; ++i) {
- if (std::isnan(a[i]) || std::isinf(a[i]) ||
- std::isnan(b[i]) || std::isinf(b[i])) {
- ++nerr1;
- continue;
- }
-
- // The code below is to force a result difference. This is used by the
- // scream/scripts internal testing to verify that various DIFFs are detected.
-#if defined(SCREAM_FORCE_RUN_DIFF)
- const Real num = std::abs(a[i]*Real(1.2) - b[i]);
-#else
- const Real num = std::abs(a[i] - b[i]);
-#endif
- if (num > tol*den) {
- ++nerr2;
- worst = std::max(worst, num);
- }
- }
-
- if (nerr1) {
- std::cout << label << " has " << nerr1 << " infs + nans.\n";
-
- }
-
- if (nerr2) {
- std::cout << label << " > tol " << nerr2 << " times. Max rel diff= " << (worst/den)
- << " normalized by ref impl val=" << den << ".\n";
-
- }
-
- return nerr1 + nerr2;
-}
-
/* When called with the below 3 args, compare loops over all variables
* and calls the above version of "compare" to check for and report
* large discrepancies.
@@ -93,7 +44,7 @@ static Int compare (const std::string& label, const Scalar* a,
const auto& fr = refi.getfield(i);
const auto& fd = di.getfield(i);
EKAT_ASSERT(fr.size == fd.size);
- nerr += compare(fr.name, fr.data, fd.data, fr.size, tol);
+ nerr += scream::compare(fr.name, fr.data, fd.data, fr.size, tol);
}
return nerr;
}
@@ -247,6 +198,13 @@ struct Baseline {
<< i << " to have extent " << f.extent[i] << " but got "
<< ds[i]);
ekat::read(f.data, f.size, fid);
+ // The code below is to force a result difference. This is used by the
+ // scream/scripts internal testing to verify that various DIFFs are detected.
+#if defined(SCREAM_FORCE_RUN_DIFF)
+ for (decltype(f.size) i = 0; i < f.size; ++i) {
+ f.data[i] *= Real(1.2);
+ }
+#endif
}
}
};
diff --git a/components/eamxx/src/physics/share/tests/CMakeLists.txt b/components/eamxx/src/physics/share/tests/CMakeLists.txt
index 6643aba54df0..9a270577e580 100644
--- a/components/eamxx/src/physics/share/tests/CMakeLists.txt
+++ b/components/eamxx/src/physics/share/tests/CMakeLists.txt
@@ -1,13 +1,41 @@
include(ScreamUtils)
set(NEED_LIBS physics_share scream_share)
-set(PHYSICS_TESTS_SRCS
- physics_saturation_unit_tests.cpp
- physics_test_data_unit_tests.cpp
-)
# NOTE: tests inside this if statement won't be built in a baselines-only build
if (NOT ${SCREAM_BASELINES_ONLY})
- CreateUnitTest(physics_tests "${PHYSICS_TESTS_SRCS}" "${NEED_LIBS}" THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC} DEP physics_tests_ut_np1_omp1)
+ CreateUnitTest(physics_test_data physics_test_data_unit_tests.cpp "${NEED_LIBS}"
+ THREADS 1 ${SCREAM_TEST_MAX_THREADS} ${SCREAM_TEST_THREAD_INC})
endif()
+if (SCREAM_ENABLE_BASELINE_TESTS)
+ set(BASELINE_FILE_ARG "-b ${SCREAM_TEST_DATA_DIR}/physics_saturation.baseline")
+
+ # The comparison test. Expects baseline to exist. All thread configurations
+ # will use the same baseline.
+ CreateUnitTest(
+ physics_saturation_run_and_cmp "physics_saturation_run_and_cmp.cpp" "${NEED_LIBS}"
+ EXE_ARGS "${BASELINE_FILE_ARG}"
+ LABELS "physics")
+
+ #
+ # Use fake tests to generate shell commands to generate baselines
+ #
+ CreateUnitTestFromExec(physics_saturation_baseline_fake physics_saturation_run_and_cmp
+ EXE_ARGS "-g ${BASELINE_FILE_ARG}"
+ PROPERTIES DISABLED True)
+
+ get_test_property(physics_saturation_baseline_fake FULL_TEST_COMMAND PHYSICS_SATURATION_GEN)
+
+ if (PHYSICS_SATURATION_GEN STREQUAL "NOTFOUND")
+ message(FATAL_ERROR "Could not get FULL_TEST_COMMAND for physics_saturation_baseline fake test")
+ endif()
+
+ separate_arguments(PHYSICS_SATURATION_GEN_ARGS UNIX_COMMAND "${PHYSICS_SATURATION_GEN}")
+
+ add_custom_target(physics_saturation_baseline
+ COMMAND ${CMAKE_COMMAND} -E env OMP_NUM_THREADS=${SCREAM_TEST_MAX_THREADS} ${PHYSICS_SATURATION_GEN_ARGS})
+
+ add_dependencies(baseline physics_saturation_baseline)
+
+endif()
diff --git a/components/eamxx/src/physics/share/tests/physics_saturation_run_and_cmp.cpp b/components/eamxx/src/physics/share/tests/physics_saturation_run_and_cmp.cpp
new file mode 100644
index 000000000000..630247cbabd1
--- /dev/null
+++ b/components/eamxx/src/physics/share/tests/physics_saturation_run_and_cmp.cpp
@@ -0,0 +1,323 @@
+#include "catch2/catch.hpp"
+
+#include "physics/share/physics_functions.hpp"
+#include "physics/share/physics_saturation_impl.hpp"
+#include "physics_unit_tests_common.hpp"
+
+#include "share/scream_types.hpp"
+#include "share/scream_session.hpp"
+#include "share/util/scream_utils.hpp"
+
+#include "ekat/ekat_pack.hpp"
+#include "ekat/util/ekat_file_utils.hpp"
+#include "ekat/util/ekat_test_utils.hpp"
+#include "ekat/kokkos/ekat_kokkos_utils.hpp"
+
+#include
+#include
+#include
+#include
+#include // std::setprecision
+
+namespace scream {
+namespace physics {
+namespace unit_test {
+
+template
+struct UnitWrap::UnitTest::TestSaturation
+{
+ KOKKOS_FUNCTION static void saturation_tests(
+ const Scalar& temperature, const Scalar& pressure,
+ Scalar& sat_ice_fp, Scalar& sat_liq_fp, Scalar& mix_ice_fr, Scalar& mix_liq_fr,
+ Scalar& sat_ice_mkp, Scalar& sat_liq_mkp, Scalar& mix_ice_mkr, Scalar& mix_liq_mkr)
+ {
+ //Nomenclature:
+ //subscript "_fp" stands for "Flatau Pressure"
+ //subscript "_fr" stands for "Flatau mixing Ratios"
+ //subscript "_mkp" stands for "Murphy Koop Pressure"
+ //subscript "_mkr" stands for "Murphy Koop mixing Ratios"
+
+ //Allow usage of saturation functions
+ using physics = scream::physics::Functions;
+
+ //Convert Scalar inputs to Spacks because that's what polysvp1 and qv_sat expect as inputs.
+ //--------------------------------------
+ const Spack temps(temperature);
+ const Spack pres(pressure);
+
+ //Get values from polysvp1 and qv_sat (qv_sat calls polysvp1 here) to test against "expected" values
+ //--------------------------------------
+ sat_ice_fp = physics::polysvp1(temps, true, Smask(true))[0];
+ sat_liq_fp = physics::polysvp1(temps, false, Smask(true))[0];
+
+ mix_ice_fr = physics::qv_sat(temps, pres, true, Smask(true), physics::Polysvp1)[0];
+ mix_liq_fr = physics::qv_sat(temps, pres, false,Smask(true), physics::Polysvp1)[0];
+
+ //Get values from MurphyKoop_svp and qv_sat (qv_sat calls MurphyKoop_svp here) to test against "expected" values
+ sat_ice_mkp = physics::MurphyKoop_svp(temps, true, Smask(true))[0];
+ sat_liq_mkp = physics::MurphyKoop_svp(temps, false, Smask(true))[0];
+
+ mix_ice_mkr = physics::qv_sat(temps, pres, true, Smask(true), physics::MurphyKoop)[0];
+ mix_liq_mkr = physics::qv_sat(temps, pres, false, Smask(true), physics::MurphyKoop)[0];
+ }
+
+ static constexpr auto atm_pres = 1e5;
+ static constexpr auto tmelt = C::Tmelt;
+
+ /*
+ Originally written by Kyle Pressel, updated by Peter Caldwell on 4/5/20 and
+ by Jim Foucar on 4/21/23.
+
+ This code tests polysvp1 and qv_sat at 0 degrees C, at a very cold T, and at a very hot T
+ to make sure our impl gets the same answer as Flatau et al 1992:
+ (https://journals.ametsoc.org/jamc/article/31/12/1507/14870/Polynomial-Fits-to-Saturation-Vapor-Pressure)
+ For 0 degrees C, polysvp values can be read directly from Flatau. For other cases, I independently
+ coded up the Flatau scheme (polysvp1) in python and used it to derive the expected values. My python code is
+ in https://github.com/E3SM-Project/scream-docs.git analysis-scripts/test_qv_sat.py
+ */
+
+
+ TestSaturation () :
+ // Hardcode these for now
+ params_({
+ // Just Freezing Case: Test values @ 273.15K (tmelt) @ 1e5 Pa
+ //---------------------------------------
+ // This is the nicest test b/c polysvp1 is a polynomial fit around (T-273.15)
+ // so T=273.15 collapses back to the intercept coefficient which can be read
+ // directly from the RHS of table 4 of Flatau et al 1992.
+ {tmelt, atm_pres},
+ {243.15, atm_pres},
+ {303.15, atm_pres},
+
+ //Following values are picked from Murphy and Koop (2005)
+ //Table C1 titled: "VALUES RECOMMENDED FOR CHECKING COMPUTER CODES"
+ //Saturation vapor pressure (SVP) values in the table were upto only 5 significant digits.
+ {150, atm_pres},
+ {180, atm_pres},
+ {210, atm_pres},
+ {240, atm_pres},
+ {273.16, atm_pres},
+ {300, atm_pres},
+ {243.15, 5e4}
+ })
+ {}
+
+ Int generate_baseline (const std::string& filename) {
+ auto fid = ekat::FILEPtr(fopen(filename.c_str(), "w"));
+ EKAT_REQUIRE_MSG( fid, "generate_baseline can't write " << filename);
+
+ for (auto p : params_) {
+ OutputData d;
+ ParamSet ps = p;
+ Kokkos::parallel_reduce(1,
+ KOKKOS_LAMBDA(const size_t&, OutputData& output) {
+ TestSaturation::saturation_tests(
+ ps.temperature, ps.pressure,
+ output.sat_ice_fp,
+ output.sat_liq_fp,
+ output.mix_ice_fr,
+ output.mix_liq_fr,
+ output.sat_ice_mkp,
+ output.sat_liq_mkp,
+ output.mix_ice_mkr,
+ output.mix_liq_mkr);
+ }, d);
+
+ Kokkos::fence();
+ write(fid, d); // Save the fields to the baseline file.
+ }
+
+ return 0;
+ }
+
+ Int run_and_cmp (const std::string& filename, const Scalar& tol) {
+ auto fid = ekat::FILEPtr(fopen(filename.c_str(), "r"));
+ EKAT_REQUIRE_MSG( fid, "generate_baseline can't read " << filename);
+ Int nerr = 0, ne;
+ int case_num = 0;
+ for (auto p : params_) {
+ ++case_num;
+ OutputData ref, d;
+ ParamSet ps = p;
+ std::cout << "--- checking physics saturation case # " << case_num << std::endl;
+ read(fid, ref);
+
+ Kokkos::parallel_reduce(1,
+ KOKKOS_LAMBDA(const size_t&, OutputData& output) {
+ TestSaturation::saturation_tests(
+ ps.temperature, ps.pressure,
+ output.sat_ice_fp,
+ output.sat_liq_fp,
+ output.mix_ice_fr,
+ output.mix_liq_fr,
+ output.sat_ice_mkp,
+ output.sat_liq_mkp,
+ output.mix_ice_mkr,
+ output.mix_liq_mkr);
+ }, d);
+
+ Kokkos::fence();
+
+ ne = compare(tol, ref, d);
+ if (ne) std::cout << "Ref impl failed.\n";
+ nerr += ne;
+ }
+ return nerr;
+ }
+
+#ifndef KOKKOS_ENABLE_CUDA
+ // Everything below is private but on CUDA they must be public
+ private:
+#endif
+
+ // Full specification for a run
+ struct ParamSet {
+ Scalar temperature;
+ Scalar pressure;
+ };
+
+ struct OutputData {
+ Scalar sat_ice_fp;
+ Scalar sat_liq_fp;
+ Scalar mix_ice_fr;
+ Scalar mix_liq_fr;
+
+ Scalar sat_ice_mkp;
+ Scalar sat_liq_mkp;
+ Scalar mix_ice_mkr;
+ Scalar mix_liq_mkr;
+
+ OutputData& operator+=(const OutputData& rhs)
+ {
+ sat_ice_fp += rhs.sat_ice_fp;
+ sat_liq_fp += rhs.sat_liq_fp;
+ mix_ice_fr += rhs.mix_ice_fr;
+ mix_liq_fr += rhs.mix_liq_fr;
+
+ sat_ice_mkp += rhs.sat_ice_mkp;
+ sat_liq_mkp += rhs.sat_liq_mkp;
+ mix_ice_mkr += rhs.mix_ice_mkr;
+ mix_liq_mkr += rhs.mix_liq_mkr;
+
+ return *this;
+ }
+ };
+
+ std::vector params_;
+
+ static void write (const ekat::FILEPtr& fid, const OutputData& d) {
+ ekat::write(&d.sat_ice_fp, 1, fid);
+ ekat::write(&d.sat_liq_fp, 1, fid);
+ ekat::write(&d.mix_ice_fr, 1, fid);
+ ekat::write(&d.mix_liq_fr, 1, fid);
+
+ ekat::write(&d.sat_ice_mkp, 1, fid);
+ ekat::write(&d.sat_liq_mkp, 1, fid);
+ ekat::write(&d.mix_ice_mkr, 1, fid);
+ ekat::write(&d.mix_liq_mkr, 1, fid);
+ }
+
+ static void read (const ekat::FILEPtr& fid, OutputData& d) {
+ ekat::read(&d.sat_ice_fp, 1, fid);
+ ekat::read(&d.sat_liq_fp, 1, fid);
+ ekat::read(&d.mix_ice_fr, 1, fid);
+ ekat::read(&d.mix_liq_fr, 1, fid);
+
+ ekat::read(&d.sat_ice_mkp, 1, fid);
+ ekat::read(&d.sat_liq_mkp, 1, fid);
+ ekat::read(&d.mix_ice_mkr, 1, fid);
+ ekat::read(&d.mix_liq_mkr, 1, fid);
+ }
+
+ static Int compare (const Scalar& tol,
+ const OutputData& ref, const OutputData& d) {
+ Int nerr = 0;
+
+ nerr += scream::compare("sat_ice_fp", &ref.sat_ice_fp, &d.sat_ice_fp, 1, tol);
+ nerr += scream::compare("sat_liq_fp", &ref.sat_liq_fp, &d.sat_liq_fp, 1, tol);
+ nerr += scream::compare("mix_ice_fr", &ref.mix_ice_fr, &d.mix_ice_fr, 1, tol);
+ nerr += scream::compare("mix_liq_fr", &ref.mix_liq_fr, &d.mix_liq_fr, 1, tol);
+
+ nerr += scream::compare("sat_ice_mkp", &ref.sat_ice_mkp, &d.sat_ice_mkp, 1, tol);
+ nerr += scream::compare("sat_liq_mkp", &ref.sat_liq_mkp, &d.sat_liq_mkp, 1, tol);
+ nerr += scream::compare("mix_ice_mkr", &ref.mix_ice_mkr, &d.mix_ice_mkr, 1, tol);
+ nerr += scream::compare("mix_liq_mkr", &ref.mix_liq_mkr, &d.mix_liq_mkr, 1, tol);
+
+ return nerr;
+ }
+
+};
+
+}
+}
+}
+
+namespace {
+
+void expect_another_arg (int i, int argc) {
+ EKAT_REQUIRE_MSG(i != argc-1, "Expected another cmd-line arg.");
+}
+
+} // empty namespace
+
+int main (int argc, char** argv) {
+ using UnitTest = scream::physics::unit_test::UnitWrap::UnitTest;
+ using TestSaturation = UnitTest::TestSaturation;
+
+ int nerr = 0;
+
+ if (argc == 1) {
+ std::cout <<
+ argv[0] << " [options]\n"
+ "Options:\n"
+ " -g Generate baseline file. Default False.\n"
+ " -b Path to baseline file. Required.\n"
+ " -t Tolerance for relative error. Default machine eps (*10000 for Release).\n";
+ return 1;
+ }
+
+ // Set up options with defaults
+ bool generate = false;
+ scream::Real tol = UnitTest::C::macheps
+#ifdef NDEBUG
+ * 10000
+#endif
+ ;
+ std::string baseline_fn;
+
+ // Parse options
+ for (int i = 1; i < argc-1; ++i) {
+ if (ekat::argv_matches(argv[i], "-g", "--generate")) generate = true;
+ if (ekat::argv_matches(argv[i], "-t", "--tol")) {
+ expect_another_arg(i, argc);
+ ++i;
+ tol = std::atof(argv[i]);
+ }
+ if (ekat::argv_matches(argv[i], "-b", "--baseline-file")) {
+ expect_another_arg(i, argc);
+ ++i;
+ baseline_fn = argv[i];
+ }
+ }
+
+ // Decorate baseline name with precision.
+ baseline_fn += std::to_string(sizeof(scream::Real));
+
+ std::vector args;
+ for (int i=0; i
-#include
-#include
-#include
-#include // std::setprecision
-
-namespace scream {
-namespace physics {
-namespace unit_test {
-
-template
-struct UnitWrap::UnitTest::TestSaturation
-{
-
- KOKKOS_FUNCTION static Scalar condNum(const Scalar& svp, const Scalar& temp, const bool isIce=false){
-
- //computes condition number for saturation vapor pressure calc.
-
- //Set constant values
- //--------------------------------------
- static constexpr Scalar RV = C::RV;
- static constexpr Scalar RhoLiq = C::RHO_H2O;
- static constexpr Scalar RhoIce = C::RhoIce;
- static constexpr Scalar LatVap = C::LatVap;
- static constexpr Scalar LatIce = C::LatIce;
-
- //==========================================================
- // Test Saturation Vapor Pressure
- //==========================================================
- // First calculate condition number Cond=x*f'(x)/f(x), which gives the growth in roundoff error
- // expected from the function. Here, x=temperature, f(x) = sat_X_p, and
- // f'(x) = L/T*sat_X_p/(Rv*T - sat_X_p/rho_{liq or ice}) from Clausius-Clapeyron.
- // Note this analytical solution isn't exact because it misses things like surface tension
- // so it can't replace curve fits like Flatau. But Clausius-Clapeyron is good enough for
- // getting a ballpark value, which is all we're doing here.
-
- //for liquid
- auto latent = LatVap;
- auto rho = RhoLiq;
-
- if(isIce){
- //for ice
- latent += LatIce;
- rho = RhoIce;
- }
-
- return latent*svp/(RV*temp - svp/rho); //return condition number
-
- }
-
- KOKKOS_FUNCTION static void saturation_tests(const Scalar& temperature, const Scalar& pressure,
- const Scalar *expected_vals, int& errors ){
-
- //Nomenclature:
- //subscript "_fp" stands for "Flatau Pressure"
- //subscript "_fr" stands for "Flatau mixing Ratios"
- //subscript "_mkp" stands for "Murphy Koop Pressure"
- //subscript "_mkr" stands for "Murphy Koop mixing Ratios"
-
- //extract values from the array
- const auto expected_sat_ice_fp = expected_vals[0];
- const auto expected_sat_liq_fp = expected_vals[1];
- const auto expected_mix_ice_fr = expected_vals[2];
- const auto expected_mix_liq_fr = expected_vals[3];
-
- const auto expected_sat_ice_mkp = expected_vals[4];
- const auto expected_sat_liq_mkp = expected_vals[5];
- const auto expected_mix_ice_mkr = expected_vals[6];
- const auto expected_mix_liq_mkr = expected_vals[7];
-
- //Allow usage of saturation functions
- using physics = scream::physics::Functions;
-
- //Convert Scalar inputs to Spacks because that's what polysvp1 and qv_sat expect as inputs.
- //--------------------------------------
- const Spack temps(temperature);
- const Spack pres(pressure);
-
- //Get values from polysvp1 and qv_sat (qv_sat calls polysvp1 here) to test against "expected" values
- //--------------------------------------
- const Spack sat_ice_fp = physics::polysvp1(temps, true, Smask(true));
- const Spack sat_liq_fp = physics::polysvp1(temps, false, Smask(true));
- //last argument "0" of qv_sat function below forces qv_sat to call "polysvp1"
- const Spack mix_ice_fr = physics::qv_sat(temps, pres, true, Smask(true), physics::Polysvp1);
- const Spack mix_liq_fr = physics::qv_sat(temps, pres, false,Smask(true), physics::Polysvp1);
-
- //Get values from MurphyKoop_svp and qv_sat (qv_sat calls MurphyKoop_svp here) to test against "expected" values
- const Spack sat_ice_mkp = physics::MurphyKoop_svp(temps, true, Smask(true));
- const Spack sat_liq_mkp = physics::MurphyKoop_svp(temps, false, Smask(true));
- //last argument "1" of qv_sat function below forces qv_sat to call "MurphyKoop_svp"
- const Spack mix_ice_mkr = physics::qv_sat(temps, pres, true, Smask(true), physics::MurphyKoop);
- const Spack mix_liq_mkr = physics::qv_sat(temps, pres, false, Smask(true), physics::MurphyKoop);
-
- //Set error tolerances
- //--------------------------------------
- //: C::macheps is machine epsilon for single or double precision as appropriate. This will be
- //multiplied by a condition # to get the actual expected numerical uncertainty.
-
- static constexpr Scalar tol = C::macheps
-#ifdef NDEBUG
- * 10000
-#endif
-;
-
- //PMC note: original version looped over pack dimension, testing each entry. This isn't
- //necessary b/c packs were created by copying a scalar up to pack size. Thus just evaluating
- // 1st entry below.
-
- const Scalar Cond_ice_fp = condNum(sat_ice_fp[0],temps[0], true); //"isIce=true"
- const Scalar Cond_liq_fp = condNum(sat_liq_fp[0],temps[0]);
-
- const Scalar Cond_ice_mkp = condNum(sat_ice_mkp[0],temps[0], true);//"isIce=true"
- const Scalar Cond_liq_mkp = condNum(sat_liq_mkp[0],temps[0]);
-
- // Test vapor pressure against Flatau's impl of Wexler:
- // ---------------------------------------------------------
- // Now check that computed vs expected values are small enough.
- if ( std::abs(sat_ice_fp[0] - expected_sat_ice_fp ) > Cond_ice_fp*tol ) {
- printf("esi_fp for T = %f abs diff is %e but max allowed is %e\n",
- temperature,std::abs(sat_ice_fp[0] - expected_sat_ice_fp ),tol*Cond_ice_fp );
- errors++;
- }
- if (std::abs(sat_liq_fp[0] - expected_sat_liq_fp) > Cond_liq_fp*tol) {
- printf("esl_fp for T = %f abs diff is %e but max allowed is %e\n",
- temperature,std::abs(sat_liq_fp[0] - expected_sat_liq_fp ),tol*Cond_liq_fp);
- errors++;
- }
-
- // Test vapor pressure against Murphy and Koop:
- // ---------------------------------------------------------
- // Now check that computed vs expected values are small enough.
- if ( std::abs(sat_ice_mkp[0] - expected_sat_ice_mkp ) > Cond_ice_mkp*tol ) {
- printf("esi_mkp for T = %f abs diff is %e but max allowed is %e\n",
- temperature,std::abs(sat_ice_mkp[0] - expected_sat_ice_mkp ),tol*Cond_ice_mkp );
- errors++;
- }
- if (std::abs(sat_liq_mkp[0] - expected_sat_liq_mkp) > Cond_liq_mkp*tol) {
- printf("esl_mkp for T = %f abs diff is %e but max allowed is %e\n",
- temperature,std::abs(sat_liq_mkp[0] - expected_sat_liq_mkp ),tol*Cond_liq_mkp);
- errors++;
- }
-
- //Set constant values
- //--------------------------------------
- static constexpr Scalar RV = C::RV;
- static constexpr Scalar LatVap = C::LatVap;
- static constexpr Scalar LatIce = C::LatIce;
-
- //==========================================================
- // Test Saturation Mixing Ratio
- //==========================================================
- // First, compute condition # Cond=x*f'(x)/f(x), with x=temperature, f(x)=mix_X_r[0], and
- // f'(x) = L*mix_X_r[0]/(Rv*temperature**2.) from Clausius-Clapeyron. Nice cancelation leaves:
-
- const Scalar Cond_ice_r=(LatVap+LatIce)/(RV*temps[0]);
- const Scalar Cond_liq_r=LatVap/(RV*temps[0]);
-
- //Test mixing-ratios against Wexler approx:
- // -------------------
- // Now check that computed vs expected values are small enough (Flatau).
- if (std::abs(mix_ice_fr[0] - expected_mix_ice_fr) > Cond_ice_r*tol ) {
- printf("qsi_fp: abs(calc-expected)=%e %e\n",std::abs(mix_ice_fr[0] - expected_mix_ice_fr),tol*Cond_ice_r);
- errors++;
- }
- if (std::abs(mix_liq_fr[0] - expected_mix_liq_fr) > Cond_liq_r*tol ) {
- printf("qsl_fp: abs(calc-expected)=%e %e\n",std::abs(mix_liq_fr[0] - expected_mix_liq_fr),tol*Cond_liq_r);
- errors++;
- }
-
- // Now check that computed vs expected values are small enough (Murphy and Koop).
- if (std::abs(mix_ice_mkr[0] - expected_mix_ice_mkr) > Cond_ice_r*tol ) {
- printf("qsi_mkp: abs(calc-expected)=%e %e\n",std::abs(mix_ice_mkr[0] - expected_mix_ice_mkr),tol*Cond_ice_r);
- errors++;
- }
- if (std::abs(mix_liq_mkr[0] - expected_mix_liq_mkr) > Cond_liq_r*tol ) {
- printf("qsl_mkp: abs(calc-expected)=%e %e\n",std::abs(mix_liq_mkr[0] - expected_mix_liq_mkr),tol*Cond_liq_r);
- errors++;
- }
- }
-
- static void run()
- {
- /*Originally written by Kyle Pressel, updated by Peter Caldwell on 4/5/20.
- *This code tests polysvp1 and qv_sat at 0 degrees C, at a very cold T, and at a very hot T
- *to make sure our impl gets the same answer as Flatau et al 1992:
- *(https://journals.ametsoc.org/jamc/article/31/12/1507/14870/Polynomial-Fits-to-Saturation-Vapor-Pressure)
- *For 0 degrees C, polysvp values can be read directly from Flatau. For other cases, I independently
- *coded up the Flatau scheme (polysvp1) in python and used it to derive the expected values. My python code is
- *in https://github.com/E3SM-Project/scream-docs.git analysis-scripts/test_qv_sat.py
- */
-
- int nerr = 0;
- TeamPolicy policy(ekat::ExeSpaceUtils::get_default_team_policy(1, 1));
- Kokkos::parallel_reduce("TestTableIce::run", policy, KOKKOS_LAMBDA(const MemberType&, int& errors) {
-
- errors = 0;
-
- //Following struct stores data for lauching the saturation_tests function
- //for polysvp1 and MurphyKoop(MK) saturation schemes. We are supplying temperature,
- //pressure, expected values in double and single precision. Polysvp1 is very
- //sensitive (due to shear number of calcs required at low temps)to single
- //precision values at low temperatures, therefore we explicity supply single
- //precision expected values. Single precision expected values are computed
- //from a python code using numpy's float32. The code uses the same functions
- //for polysvp1 and MK as in the code present at:
- // https://github.com/E3SM-Project/scream-docs.git analysis-scripts/test_qv_sat.py
-
- //total number expected vals to store for each precision for both MK and polysvp1
- static constexpr int ncrv = 8; // 4 for each saturation scheme
-
- struct sat_test_args {
- Scalar t_atm; //temperature [K]
- Scalar pres; //pressure [Pa]
- Scalar dp_data[ncrv]; // double precision expected vals for MK and polysvp1
- Scalar sp_data[ncrv]; // single precision expected vals for MK and polysvp1
- };
-
- static constexpr auto ncases = 10; //total number of test cases
-
- sat_test_args stargs[ncases]; // variable to store all the data for launching tests
-
- // Just Freezing Case: Test values @ 273.15K (tmelt) @ 1e5 Pa
- //---------------------------------------
- // This is the nicest test b/c polysvp1 is a polynomial fit around (T-273.15)
- // so T=273.15 collapses back to the intercept coefficient which can be read
- // directly from the RHS of table 4 of Flatau et al 1992.
- // Note that ice values are identical to liquid values b/c C++ uses liq val for T>=0 C.
-
- static constexpr auto tmelt = C::Tmelt;
- static constexpr auto atm_pres = 1e5;
-
- stargs[0] = {tmelt,
- atm_pres,
- //dp_data
- {611.23992100000009, 611.23992100000009,
- 0.0038251131382843278, 0.0038251131382843278,
- 611.2126978267946, 611.2126978267946,
- 0.0038249417291628678, 0.0038249417291628678},
- //sp_data
- {611.2399, 611.2399, 0.0038251132, 0.0038251132,
- 611.2123, 611.2123, 0.003824939, 0.003824939}
- };
-
- // Cold Case: Test values @ 243.15K @ 1e5 Pa
- //---------------------------------------
- stargs[1] = {243.15,
- atm_pres,
- //dp_data
- {38.024844602056795, 51.032583257624964,
- 0.00023659331311441935, 0.00031756972127516819,
- 38.01217277745647, 50.93561537896607,
- 0.00023651443812988484, 0.0003169659941390894},
- //sp_data
- {38.024666, 51.03264, 0.00023659221, 0.00031757005,
- 38.012142, 50.935585, 0.00023651426, 0.0003169658}
- };
-
- //Warm Case: Test values @ 303.15K @ 1e5 Pa
- //---------------------------------------
- stargs[2] = {303.15,
- atm_pres,
- //dp_data
- {4245.1933273786717, 4245.1933273786717,
- 0.027574442204332306, 0.027574442204332306,
- 4246.814076877233, 4246.814076877233,
- 0.027585436614272162, 0.027585436614272162},
- //sp_data
- {4245.1934, 4245.1934, 0.027574444, 0.027574444,
- 4246.8115, 4246.8115, 0.027585419, 0.027585419}
- };
-
- //Following values are picked from Murphy and Koop (2005)
- //Table C1 titled: "VALUES RECOMMENDED FOR CHECKING COMPUTER CODES"
- //Saturation vapor pressure (SVP) values in the table were upto only 5 significant digits.
- //Python code at https://github.com/E3SM-Project/scream-docs.git analysis-scripts/test_qv_sat.py
- //was extended to print Murphy and Koop SVP. "expected values" below are from that python code
- //for both polysvp1 and MK. Python code's computed "expected values" are exactly
- //same as compared to the values in MK table for upto 5 significant digits.
-
- //Test values @ 150K @ 1e5 Pa
- stargs[3] = {150,
- atm_pres,
- //dp_data
- {0.0565113360640801, 0.17827185346988017,
- 3.514840868181163e-07, 1.1088004687434155e-06,
- 6.1061006509816675e-06, 1.5621037177920032e-05,
- 3.79781500154674e-11, 9.715825652191167e-11},
- //sp_data
- {0.05517006, 0.17905235, 3.4314175e-07, 1.113655e-06,
- 6.1060973e-06, 1.5621057e-05, 3.797813e-11, 9.715838e-11}
- };
-
- //Test values @ 180K @ 1e5 Pa
- stargs[4] = {180,
- atm_pres,
- //dp_data
- {0.0565113360640801, 0.17827185346988017,
- 3.514840868181163e-07, 1.1088004687434155e-06,
- 0.005397500125274297, 0.01123923029036248,
- 3.3570864981545485e-08, 6.990471437859482e-08},
- //sp_data
- {0.05517006, 0.17905235, 3.4314175e-07, 1.113655e-06,
- 0.0053975, 0.011239249, 3.3570867e-08, 6.990483e-08}
- };
-
- //Test values @ 210K @ 1e5 Pa
- stargs[5] = {210,
- atm_pres,
- //dp_data
- {0.7021857060894199, 1.2688182238880685,
- 4.3674192198021676e-06, 7.891776277281936e-06,
- 0.7020234713180218, 1.2335424085746476,
- 4.366410153074117e-06, 7.672365591576349e-06},
- //sp_data
- {0.7016659, 1.2685776, 4.364186e-06, 7.890279e-06,
- 0.70202345, 1.2335398, 4.36641e-06, 7.67235e-06}
- };
-
- //Test values @ 240K @ 1e5 Pa
- stargs[6] = {240,
- atm_pres,
- //dp_data
- {27.280908658710246, 37.77676490183603,
- 0.00016972553017335565, 0.0002350491600776575,
- 27.272365420780556, 37.66700070557609,
- 0.00016967236474679822, 0.0002343659437158037},
- //sp_data
- {27.28076, 37.776802, 0.0001697246, 0.00023504937,
- 27.27235, 37.666973, 0.00016967228, 0.00023436577}
- };
-
- //Test values @ 273.16K @ 1e5 Pa
- stargs[7] = {273.16,
- atm_pres,
- //dp_data
- {611.6840516537769, 611.6840516537769,
- 0.003827909594290528, 0.003827909594290528,
- 611.6570436443282, 611.6570436443282,
- 0.0038277395384149105, 0.0038277395384149105},
- //sp_data
- {611.68445, 611.68445, 0.0038279123, 0.0038279123,
- 611.65607, 611.65607, 0.0038277335, 0.0038277335}
- };
- //Test values @ 300K @ 1e5 Pa
- stargs[8] = {300,
- atm_pres,
- //dp_data
- {3535.4066341569387, 3535.4066341569387,
- 0.022795088436007804, 0.022795088436007804,
- 3536.7644130514645, 3536.7644130514645,
- 0.022804163906259393, 0.022804163906259393},
- //sp_data
- {3535.4077, 3535.4077, 0.022795096, 0.022795096,
- 3536.7559, 3536.7559, 0.022804108, 0.022804108}
- };
-
- //Change Pressure Case: Test values @ 243.15 @ 500 mb
- //---------------------------------------
- stargs[9] = {243.15,
- 5e4,
- //dp_data
- {38.024844602056795, 51.032583257624964,
- 0.00047336669164733106, 0.00063546390177500586,
- 38.01217277745647, 50.93561537896607,
- 0.00047320882161578, 0.0006342552147122389},
- //sp_data
- {38.024666, 51.03264, 0.00047336446, 0.00063546456,
- 38.012142, 50.935585, 0.00047320846, 0.00063425483}
- };
-
- //Launch Tests:
- //---------------------------------------------
-
- //find out which precision to use
- constexpr auto is_single_prec = ekat::is_single_precision::value;
-
- if(is_single_prec){
- for (size_t ista = 0; ista < ncases; ista++) {
- //use sp_data values
- saturation_tests(stargs[ista].t_atm,stargs[ista].pres,stargs[ista].sp_data,errors);
- }
- } else{
- for (size_t ista = 0; ista < ncases; ista++) {
- //use dp_data values
- saturation_tests(stargs[ista].t_atm,stargs[ista].pres,stargs[ista].dp_data,errors);
- }
- }
-
-
- }, nerr);
-
- Kokkos::fence();
- REQUIRE(nerr == 0);
- }
-}; //end of TestSaturation struct
-
-} // namespace unit_test
-} // namespace physics
-} // namespace scream
-
-namespace{
-
-TEST_CASE("physics_saturation_test", "[physics_saturation_test]"){
- scream::physics::unit_test::UnitWrap::UnitTest::TestSaturation::run();
-
- } // TEST_CASE
-
-} // namespace
diff --git a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp
index 3f3eb14e68bb..a5198d959800 100644
--- a/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp
+++ b/components/eamxx/src/physics/shoc/tests/shoc_run_and_cmp.cpp
@@ -4,6 +4,7 @@
#include "share/scream_types.hpp"
#include "share/scream_session.hpp"
+#include "share/util/scream_utils.hpp"
#include "ekat/util/ekat_file_utils.hpp"
#include "ekat/util/ekat_test_utils.hpp"
@@ -15,62 +16,17 @@ namespace {
using namespace scream;
using namespace scream::shoc;
- /* shoc_run_and_cmp can be run in 2 modes. First, generate_baseline
- * runs the baseline (aka reference, probably git master) version of
- * the code and saves its output as a raw binary file. Then run_and_cmp
- * runs the new/experimental version of the code and compares it against
- * the baseline data you've saved to file. Both baseline and cmp modes
- * start from an initial condition in ../shoc_ic_cases.cpp. Each call to
- * shoc_main loops through nadv=15 steps with dt=5 min. On top of this,
- * shoc_main is called iteratively num_iters=10 steps, performing checks
- * and potentiallywriting output each time. This means that shoc_run_and_cmp
- * is really a single 150-step shoc run.
- */
-
-
-/* Given a column of data for variable "label" from the reference run
- * (probably master) and from your new exploratory run, loop over all
- * heights and confirm whether or not the relative difference between
- * runs is within tolerance "tol". If not, print debug info. Here, "a"
- * is the value from the reference run and "b" is from the new run.
+/* shoc_run_and_cmp can be run in 2 modes. First, generate_baseline
+ * runs the baseline (aka reference, probably git master) version of
+ * the code and saves its output as a raw binary file. Then run_and_cmp
+ * runs the new/experimental version of the code and compares it against
+ * the baseline data you've saved to file. Both baseline and cmp modes
+ * start from an initial condition in ../shoc_ic_cases.cpp. Each call to
+ * shoc_main loops through nadv=15 steps with dt=5 min. On top of this,
+ * shoc_main is called iteratively num_iters=10 steps, performing checks
+ * and potentiallywriting output each time. This means that shoc_run_and_cmp
+ * is really a single 150-step shoc run.
*/
-template
-static Int compare (const std::string& label, const Scalar* a,
- const Scalar* b, const Int& n, const Real& tol) {
-
- Int nerr1 = 0;
- Int nerr2 = 0;
- Real den = 0;
- for (Int i = 0; i < n; ++i)
- den = std::max(den, std::abs(a[i]));
- Real worst = 0;
- for (Int i = 0; i < n; ++i) {
- if (std::isnan(a[i]) || std::isinf(a[i]) ||
- std::isnan(b[i]) || std::isinf(b[i])) {
- ++nerr1;
- continue;
- }
-
- const auto num = std::abs(a[i] - b[i]);
- if (num > tol*den) {
- ++nerr2;
- worst = std::max(worst, num);
- }
- }
-
- if (nerr1) {
- std::cout << label << " has " << nerr1 << " infs + nans.\n";
-
- }
-
- if (nerr2) {
- std::cout << label << " > tol " << nerr2 << " times. Max rel diff= " << (worst/den)
- << " normalized by ref impl val=" << den << ".\n";
-
- }
-
- return nerr1 + nerr2;
-}
/* When called with the below 3 args, compare loops over all variables
* and calls the above version of "compare" to check for and report
@@ -93,7 +49,7 @@ static Int compare (const std::string& label, const Scalar* a,
// So we just skip the comparison.
if (fr.name == "tkh") continue;
- nerr += compare(fr.name, fr.data, fd.data, fr.size, tol);
+ nerr += scream::compare(fr.name, fr.data, fd.data, fr.size, tol);
}
return nerr;
}
diff --git a/components/eamxx/src/physics/spa/atmosphere_prescribed_aerosol.cpp b/components/eamxx/src/physics/spa/atmosphere_prescribed_aerosol.cpp
index 08c793674ec4..53a113f469e1 100644
--- a/components/eamxx/src/physics/spa/atmosphere_prescribed_aerosol.cpp
+++ b/components/eamxx/src/physics/spa/atmosphere_prescribed_aerosol.cpp
@@ -67,7 +67,7 @@ void SPA::set_grids(const std::shared_ptr grids_manager)
// take this information directly from the spa data file.
m_spa_data_file = m_params.get