diff --git a/.github/PULL_REQUEST_TEMPLATE/pull_request_template.md b/.github/pull_request_template.md similarity index 76% rename from .github/PULL_REQUEST_TEMPLATE/pull_request_template.md rename to .github/pull_request_template.md index 5968702e5..97cfef798 100644 --- a/.github/PULL_REQUEST_TEMPLATE/pull_request_template.md +++ b/.github/pull_request_template.md @@ -1,22 +1,21 @@ -## Description of Changes: +## Description of Changes: One or more paragraphs describing the problem, solution, and required changes. -## Tests Conducted: -Explicitly state what tests were run on these changes, or if any are still pending (for README or other text-only changes, just put "None required". Make note of the compilers used, the platform/machine, and other relevant details as necessary. For more complicated changes, or those resulting in scientific changes, please be explicit! -**OR** Add any links to tests conducted. For example, "See ufs-community/ufs-weather-model/pull/" +## Tests Conducted: +Explicitly state what tests were run on these changes, or if any are still pending (for README or other text-only changes, just put "None required". Make note of the compilers used, the platform/machine, and other relevant details as necessary. For more complicated changes, or those resulting in scientific changes, please be explicit! +**OR** Add any links to tests conducted. For example, "See ufs-community/ufs-weather-model#" ## Dependencies: Add any links to parent PRs (e.g. SCM and/or UFS PRs) or submodules (e.g. rte-rrtmgp). For example: -- NCAR/ccpp-framework/pull/ -- NOAA-EMC/fv3atm/pull/ -- ufs-community/ufs-weather-model/pull/ +- NCAR/ccpp-framework# +- NOAA-EMC/ufsatm# +- ufs-community/ufs-weather-model/# ## Documentation: Does this PR add new capabilities that need to be documented or require modifications to the existing documentation? If so, brief supporting material can be provided here. Contact the CODEOWNERS if your PR requires extensive updates to the documentation. See https://github.com/NCAR/ccpp-doc for Technical Documentation or https://dtcenter.org/community-code/common-community-physics-package-ccpp/documentation for the latest Scientific Documentation. -## Issue (optional): -If this PR is resolving or referencing one or more issues, in this repository or elewhere, list them here. For example, "Fixes issue mentioned in #123" or "Related to bug in https://github.com/NCAR/other_repository/pull/63" +## Issue (optional): +If this PR is resolving or referencing one or more issues, in this repository or elewhere, list them here. For example, "Fixes issue mentioned in #123" or "Related to bug in NCAR/other_repository#123" -## Contributors (optional): +## Contributors (optional): If others have contributed to this work aside from the PR author, list them here - diff --git a/.github/workflows/basic_checks.yml b/.github/workflows/basic_checks.yml index 4e40790b5..7730b423d 100644 --- a/.github/workflows/basic_checks.yml +++ b/.github/workflows/basic_checks.yml @@ -4,6 +4,7 @@ on: [push, pull_request] jobs: build: + if: github.repository == 'NCAR/ccpp-physics' || github.repository == 'ufs-community/ccpp-physics' runs-on: macos-latest diff --git a/.github/workflows/ci_fv3_ccpp_prebuild.yml b/.github/workflows/ci_fv3_ccpp_prebuild.yml index a5c2f8092..968e3a066 100644 --- a/.github/workflows/ci_fv3_ccpp_prebuild.yml +++ b/.github/workflows/ci_fv3_ccpp_prebuild.yml @@ -4,9 +4,10 @@ on: [push, pull_request] jobs: ccpp-prebuild-FV3: + if: github.repository == 'NCAR/ccpp-physics' || github.repository == 'ufs-community/ccpp-physics' # The type of runner that the job will run on - runs-on: ubuntu-20.04 + runs-on: ubuntu-latest steps: - name: Checkout current ccpp-physics code @@ -38,11 +39,11 @@ jobs: git remote add remote_local $GIT_REMOTE_URL git fetch remote_local $GIT_REMOTE_BRANCH git checkout remote_local/$GIT_REMOTE_BRANCH - - - name: Set up Python 3.8.5 + + - name: Set up Python 3.10.13 uses: actions/setup-python@v3 with: - python-version: 3.8.5 + python-version: 3.10.13 - name: Add conda to system path run: | @@ -53,4 +54,4 @@ jobs: run: | cd /home/runner/work/ccpp-physics/ccpp-physics/fv3atm/ccpp/ mkdir -p /home/runner/work/ccpp-physics/ccpp-physics/fv3atm/bin/ccpp/physics/physics/ - ./framework/scripts/ccpp_prebuild.py --config config/ccpp_prebuild_config.py \ No newline at end of file + ./framework/scripts/ccpp_prebuild.py --config config/ccpp_prebuild_config_fv3.py diff --git a/.github/workflows/ci_scm_ccpp_prebuild.yml b/.github/workflows/ci_scm_ccpp_prebuild.yml index 7c9d2300a..d50dafcef 100644 --- a/.github/workflows/ci_scm_ccpp_prebuild.yml +++ b/.github/workflows/ci_scm_ccpp_prebuild.yml @@ -4,9 +4,10 @@ on: [push, pull_request] jobs: ccpp-prebuild-SCM: + if: github.repository == 'NCAR/ccpp-physics' || github.repository == 'ufs-community/ccpp-physics' # The type of runner that the job will run on - runs-on: ubuntu-20.04 + runs-on: ubuntu-latest steps: @@ -42,11 +43,11 @@ jobs: git remote add remote_local $GIT_REMOTE_URL git fetch remote_local $GIT_REMOTE_BRANCH git checkout remote_local/$GIT_REMOTE_BRANCH - - - name: Set up Python 3.8.5 + + - name: Set up Python 3.10.13 uses: actions/setup-python@v3 with: - python-version: 3.8.5 + python-version: 3.10.13 - name: Add conda to system path run: | @@ -58,4 +59,4 @@ jobs: cd /home/runner/work/ccpp-physics/ccpp-physics/ccpp-scm/ git status mkdir -p /home/runner/work/ccpp-physics/ccpp-physics/ccpp-scm/scm/bin/ccpp/physics/physics/ - ./ccpp/framework/scripts/ccpp_prebuild.py --config ccpp/config/ccpp_prebuild_config.py \ No newline at end of file + ./ccpp/framework/scripts/ccpp_prebuild.py --config ccpp/config/ccpp_prebuild_config.py diff --git a/.gitmodules b/.gitmodules index 24b9cf118..d098a48b7 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,7 +1,8 @@ -[submodule "physics/rte-rrtmgp"] +[submodule "physics/Radiation/RRTMGP/rte-rrtmgp"] path = physics/Radiation/RRTMGP/rte-rrtmgp - url = https://github.com/earth-system-radiation/rte-rrtmgp + url = https://github.com/NCAR/rte-rrtmgp + branch = main +[submodule "physics/MP/TEMPO/TEMPO"] + path = physics/MP/TEMPO/TEMPO + url = https://github.com/NCAR/TEMPO branch = main -[submodule "physics/Radiation/RRTMGP/rte-rrtmgp"] - path = physics/Radiation/RRTMGP/rte-rrtmgp - url = https://github.com/earth-system-radiation/rte-rrtmgp diff --git a/CMakeLists.txt b/CMakeLists.txt index ee708d4c4..5afd86200 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,4 +1,4 @@ -cmake_minimum_required(VERSION 3.3) +cmake_minimum_required(VERSION 3.18) project(ccpp_physics VERSION 5.0.0 @@ -6,11 +6,20 @@ project(ccpp_physics #------------------------------------------------------------------------------ set(PACKAGE "ccpp-physics") -set(AUTHORS "Grant Firl" "Dustin Swales" "Man Zhang" "Mike Kavulich" ) +set(AUTHORS "Grant Firl" "Dustin Swales" "Dom Heinzeller" "Man Zhang" "Mike Kavulich") + +include(GNUInstallDirs) + +#------------------------------------------------------------------------------ +# Set MPI flags for Fortran with MPI F08 interface +find_package(MPI REQUIRED Fortran) +if(NOT MPI_Fortran_HAVE_F08_MODULE) + message(FATAL_ERROR "MPI implementation does not support the Fortran 2008 mpi_f08 interface") +endif() #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran -if (OPENMP) +if(OPENMP) find_package(OpenMP REQUIRED) endif() @@ -44,12 +53,6 @@ else(TYPEDEFS) endif(TYPEDEFS) list(REMOVE_DUPLICATES TYPEDEFS) -# Generate list of Fortran modules from the CCPP type -# definitions that need need to be installed -foreach(typedef_module ${TYPEDEFS}) - list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${typedef_module}) -endforeach() - #------------------------------------------------------------------------------ # Set the sources: physics schemes set(SCHEMES $ENV{CCPP_SCHEMES}) @@ -78,32 +81,36 @@ get_filename_component(LOCAL_CURRENT_SOURCE_DIR ${FULL_PATH_TO_CMAKELISTS} DIREC #------------------------------------------------------------------------------ -# List of files that need to be compiled without OpenMP -set(SCHEMES_OPENMP_OFF ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_optics.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_rrtmgp_constants.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_rrtmgp_util_string.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/kernels/mo_gas_optics_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90 +# List of files that should be compiled with RTE-RRTMGP compilation flags +set(SCHEMES_RTERRTMGP ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/gas-optics/mo_gas_optics.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/gas-optics/mo_gas_optics_constants.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/gas-optics/mo_gas_concentrations.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/gas-optics/mo_gas_optics_util_string.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rrtmgp-frontend/mo_cloud_optics_rrtmgp.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_rrtmgp_clr_all_sky.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_fluxes_byband.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/solar_variability/mo_solar_variability.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_heating_rates.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_fluxes_bygpoint.F90 ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_compute_bc.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/cloud_optics/mo_cloud_sampling.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/cloud_optics/mo_cloud_optics.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_config.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_source_functions.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_sw.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_fluxes.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_lw.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_util_array.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_optical_props_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_rte_kind.F90 - ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte/mo_optical_props.F90) + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/extensions/mo_cloud_sampling.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_util_array_validation.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_config.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_source_functions.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_sw.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_fluxes.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_lw.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-kernels/mo_rte_util_array.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-kernels/mo_rte_solver_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-kernels/mo_optical_props_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-kernels/mo_fluxes_broadband_kernels.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_kind.F90 + ${LOCAL_CURRENT_SOURCE_DIR}/physics/Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_optical_props.F90) + +# List of files that need to be compiled without OpenMP (currently a copy of SCHEMES_RTERRTMGP) +set(SCHEMES_OPENMP_OFF ${SCHEMES_RTERRTMGP}) # List of files that need to be compiled with different precision set(SCHEMES_DYNAMICS) @@ -120,22 +127,47 @@ if(SCHEMES_DYNAMICS) list(REMOVE_ITEM SCHEMES ${SCHEMES_DYNAMICS}) endif() +# Remove files that need to be compiled with different flags for RTE-RRTMGP from list +# of files with standard compiler flags, and assign special flags +if(SCHEMES_RTERRTMGP) + SET_PROPERTY(SOURCE ${SCHEMES_RTERRTMGP} + APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_RTERRTMGP}") + list(REMOVE_ITEM SCHEMES ${SCHEMES_RTERRTMGP}) +endif() + # Remove files that need to be compiled without OpenMP from list # of files with standard compiler flags, and assign no-OpenMP flags if(SCHEMES_OPENMP_OFF) SET_PROPERTY(SOURCE ${SCHEMES_OPENMP_OFF} - APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PHYSICS}") + APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_OPENMP_OFF}") list(REMOVE_ITEM SCHEMES ${SCHEMES_OPENMP_OFF}) endif() # Assign standard floating point precision flags to all remaining schemes and caps SET_PROPERTY(SOURCE ${SCHEMES} ${CAPS} - APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PHYSICS} ${OpenMP_Fortran_FLAGS}") + APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PHYSICS}") +if(OPENMP) + SET_PROPERTY(SOURCE ${SCHEMES} ${CAPS} + APPEND_STRING PROPERTY COMPILE_FLAGS " ${OpenMP_Fortran_FLAGS}") +endif() + +# For CAPS, remove bounds checks with Intel Classic (ifort), Intel LLVM (ifx), +# and GNU (gfortran) to avoid the compilation being killed or taking forever +if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel" OR ${CMAKE_Fortran_COMPILER_ID} STREQUAL "IntelLLVM") + set_PROPERTY(SOURCE ${CAPS} + APPEND_STRING PROPERTY COMPILE_FLAGS " -check nobounds") +elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") + set_PROPERTY(SOURCE ${CAPS} + APPEND_STRING PROPERTY COMPILE_FLAGS " -fcheck=no-bounds") +endif() # Lower optimization for certain schemes when compiling with Intel in Release mode -if(CMAKE_BUILD_TYPE STREQUAL "Release" AND ${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") +if(CMAKE_BUILD_TYPE STREQUAL "Release" AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel" OR ${CMAKE_Fortran_COMPILER_ID} STREQUAL "IntelLLVM")) # Define a list of schemes that need lower optimization with Intel in Release mode - set(SCHEME_NAMES_LOWER_OPTIMIZATION module_sf_mynn.F90) + set(SCHEME_NAMES_LOWER_OPTIMIZATION module_sf_mynn.F90 + module_mp_nssl_2mom.F90 + mynnedmf_wrapper.F90 + gcycle.F90) foreach(SCHEME_NAME IN LISTS SCHEME_NAMES_LOWER_OPTIMIZATION) set(SCHEMES_TMP ${SCHEMES}) # Need to determine the name of the scheme with its path @@ -147,7 +179,7 @@ if(CMAKE_BUILD_TYPE STREQUAL "Release" AND ${CMAKE_Fortran_COMPILER_ID} STREQUAL endif() # No optimization for certain schemes when compiling with Intel in Release mode -if(CMAKE_BUILD_TYPE STREQUAL "Release" AND ${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") +if(CMAKE_BUILD_TYPE STREQUAL "Release" AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel" OR ${CMAKE_Fortran_COMPILER_ID} STREQUAL "IntelLLVM")) # Define a list of schemes that can't be optimized with Intel in Release mode set(SCHEME_NAMES_NO_OPTIMIZATION GFS_typedefs.F90) foreach(SCHEME_NAME IN LISTS SCHEME_NAMES_NO_OPTIMIZATION) @@ -161,24 +193,27 @@ endif() #------------------------------------------------------------------------------ -add_library(ccpp_physics STATIC ${SCHEMES} ${SCHEMES_OPENMP_OFF} ${SCHEMES_DYNAMICS} ${CAPS}) -# Generate list of Fortran modules from defined sources -foreach(source_f90 ${CAPS}) - get_filename_component(tmp_source_f90 ${source_f90} NAME) - string(REGEX REPLACE ".F90" ".mod" tmp_module_f90 ${tmp_source_f90}) - string(TOLOWER ${tmp_module_f90} module_f90) - list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${module_f90}) -endforeach() +set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_INSTALL_INCLUDEDIR}) + +add_library(ccpp_physics STATIC ${SCHEMES} ${SCHEMES_RTERRTMGP} ${SCHEMES_OPENMP_OFF} ${SCHEMES_DYNAMICS} ${CAPS}) set_target_properties(ccpp_physics PROPERTIES VERSION ${PROJECT_VERSION} SOVERSION ${PROJECT_VERSION_MAJOR}) target_include_directories(ccpp_physics PUBLIC - $) + INTERFACE $ + $ +) +target_link_libraries(ccpp_physics PRIVATE MPI::MPI_Fortran) target_link_libraries(ccpp_physics PUBLIC w3emc::w3emc_d sp::sp_d - NetCDF::NetCDF_Fortran) + NetCDF::NetCDF_Fortran + ) +#add FMS for FV3 only +if(FV3 OR MPAS) + target_link_libraries(ccpp_physics PUBLIC fms) +endif() # Define where to install the library install(TARGETS ccpp_physics @@ -192,6 +227,5 @@ install(EXPORT ccpp_physics-targets FILE ccpp_physics-config.cmake DESTINATION lib/cmake ) -# Define where to install the C headers and Fortran modules -#install(FILES ${HEADERS_C} DESTINATION include) -install(FILES ${MODULES_F90} DESTINATION include) + +install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}) diff --git a/CODEOWNERS b/CODEOWNERS index d55a200fc..2e6e555ef 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -4,199 +4,190 @@ # Default codeowners for files that don't have specific owners: -* @grantfirl @Qingfu-Liu @dustinswales @mzhangw +* @grantfirl @rhaesung @Qingfu-Liu @dustinswales @mzhangw # The following lines are from the CCPP Primary Schemes Points of Contact # https://docs.google.com/spreadsheets/d/14y0Th_sSpCqlssEMNfSZ_Ni9wrpPqfpPY0kRG7jCZB8/edit#gid=0 # (Internal NOAA document.) -smoke_dust/* @haiqinli @grantfirl @Qingfu-Liu @dustinswales -physics/aer_cloud.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/aerclm_def.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/aerinterp.F90 @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/bl_mynn_common.f90 @joeolson42 @grantfirl @Qingfu-Liu @dustinswales -physics/calpreciptype.f90 @grantfirl @Qingfu-Liu @dustinswales -physics/cires_orowam2017.f @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cires_tauamf_data.F90 @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cires_ugwp* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cldmacro.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/cldwat2m_micro.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/clm_lake.* @tanyasmirnova @SamuelTrahanNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cnvc90.* @grantfirl @Qingfu-Liu @dustinswales -physics/cs_conv_aw_adj.* @AnningCheng-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cs_conv.* @AnningCheng-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/cu_gf* @haiqinli @grantfirl @Qingfu-Liu @dustinswales -physics/cu_ntiedtke* @JongilHan66 @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/cu_c3* @lisa-bengtsson @haiqinli @grantfirl @Qingfu-Liu @dustinswales -physics/date_def.f @XuLi-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/dcyc2t3.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/drag_suite.* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/flake* @barlage @grantfirl @Qingfu-Liu @dustinswales -physics/funcphys.f90 @grantfirl @Qingfu-Liu @dustinswales -physics/fv_sat_adj.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/gcycle.F90 @grantfirl @Qingfu-Liu @dustinswales -physics/get_phi_fv3.* @grantfirl @Qingfu-Liu @dustinswales -physics/get_prs_fv3.* @grantfirl @Qingfu-Liu @dustinswales -physics/gfdl_cloud_microphys.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/GFDL_parse_tracers.F90 @grantfirl @Qingfu-Liu @dustinswales -physics/gfdl_sfc_layer.* @ZhanZhang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_cloud_diagnostics.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_DCNV_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_DCNV_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_debug.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_GWD_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_GWD_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_MP_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_MP_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_PBL_generic_common.F90 @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_PBL_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_PBL_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_phys_time_vary.fv3.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_phys_time_vary.scm.* @grantfirl @Qingfu-Liu @dustinswales -physics/gfs_phy_tracer_config.F @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_radiation_surface.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rad_time_vary.fv3.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rad_time_vary.scm.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmgp_cloud_mp.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmgp_cloud_overlap.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmg_post.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmgp_pre.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmg_pre.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmgp_setup.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmgp_post.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_rrtmg_setup.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_SCNV_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_SCNV_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_stochastics.* @pjpegion @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_1.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_2.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_3.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_4.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_5.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_phys_reset.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_interstitial_rad_reset.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_stateout_reset.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_suite_stateout_update.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_composites_inter.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_composites_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_composites_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_generic_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_generic_pre.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_loop_control_part1.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_surface_loop_control_part2.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_time_vary_pre.fv3.* @grantfirl @Qingfu-Liu @dustinswales -physics/GFS_time_vary_pre.scm.* @grantfirl @Qingfu-Liu @dustinswales -physics/gocart_tracer_config_stub.f @grantfirl @Qingfu-Liu @dustinswales -physics/gwdc.* @Songyou184 @grantfirl @Qingfu-Liu @dustinswales -physics/gwdps.* @Songyou184 @grantfirl @Qingfu-Liu @dustinswales -physics/h2o_def.* @grantfirl @Qingfu-Liu @dustinswales -physics/h2ointerp.f90 @grantfirl @Qingfu-Liu @dustinswales -physics/h2ophys.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/hedmf.* @JongilHan66 @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/iccn_def.F @grantfirl @Qingfu-Liu @dustinswales -physics/iccninterp.F90 @grantfirl @Qingfu-Liu @dustinswales -physics/iounitdef.f @grantfirl @Qingfu-Liu @dustinswales -physics/lsm_noah.* @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/lsm_ruc.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales -physics/machine.* @grantfirl @Qingfu-Liu @dustinswales -physics/maximum_hourly_diagnostics.* @grantfirl @Qingfu-Liu @dustinswales -physics/mersenne_twister.f @grantfirl @Qingfu-Liu @dustinswales -physics/mfpbl.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/mfpblt.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/mfpbltq.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/mfscu.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/mfscuq.f @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/micro_mg* @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/m_micro* @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/module_bfmicrophysics.f @grantfirl @Qingfu-Liu @dustinswales -physics/module_BL_MYJPBL.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/module_bl_mynn.* @joeolson42 @grantfirl @Qingfu-Liu @dustinswales -physics/module_gfdl_cloud_microphys.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/module_MP_FER_HIRES.* @ericaligo-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/module_mp_nssl_2mom.F90 @MicroTed @grantfirl @Qingfu-Liu @dustinswales -physics/module_mp_radar.* @gthompsnWRF @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/module_mp_thompson* @gthompsnWRF @RuiyuSun @AndersJensen-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/module_nst* @XuLi-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/module_sf_exchcoef.f90 @ZhanZhang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/module_SF_JSFC.F90 @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/module_sf_mynn.F90 @joeolson42 @grantfirl @Qingfu-Liu @dustinswales -physics/module_sf_ruclsm.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales -physics/module_soil_pre.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales -physics/moninshoc.* @grantfirl @Qingfu-Liu @dustinswales -physics/mp_fer_hires.* @ericaligo-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/mp_nssl.* @MicroTed @grantfirl @Qingfu-Liu @dustinswales -physics/mp_thompson* @gthompsnWRF @RuiyuSun @AndersJensen-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/multi_gases.F90 @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/myjpbl_wrapper.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/myjsfc_wrapper.* @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/mynnedmf_wrapper.* @joeolson42 @grantfirl @Qingfu-Liu @dustinswales -physics/mynnsfc_wrapper.* @joeolson42 @grantfirl @Qingfu-Liu @dustinswales -physics/namelist_soilveg.* @HelinWei-NOAA @barlage @cenlinhe @grantfirl @Qingfu-Liu @dustinswales -physics/namelist_soilveg_ruc.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales -physics/*noahmp* @barlage @cenlinhe @grantfirl @Qingfu-Liu @dustinswales -physics/ozinterp.f90 @grantfirl @Qingfu-Liu @dustinswales -physics/ozne_def.* @grantfirl @Qingfu-Liu @dustinswales -physics/ozphys* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/physcons.F90 @grantfirl @Qingfu-Liu @dustinswales -physics/phys_tend.* @grantfirl @Qingfu-Liu @dustinswales -physics/progsigma_calc.f90 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales -physics/radcons.f90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_aerosols.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_astronomy.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_cloud_overlap.F90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_clouds.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_gases.f @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_surface.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radiation_tools.F90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/radlw_* @mjiacono @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/radsw_* @mjiacono @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/rascnv.* @haiqinli @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/rayleigh_damp.* @yangfanglin @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmg_lw_cloud_optics.F90 @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmg_lw_post.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmg_lw_pre.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmgp_aerosol_optics.* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmgp_lw_* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmgp_sw_* @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmg_sw_cloud_optics.F90 @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/rrtmg_sw_post.* @Qingfu-Liu @dustinswales @grantfirl @Qingfu-Liu @dustinswales -physics/rte-rrtmgp @dustinswales @Qingfu-Liu @grantfirl @Qingfu-Liu @dustinswales -physics/samfdeepcnv.* @JongilHan66 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales -physics/samfshalcnv.* @JongilHan66 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales -physics/samfaerosols.* @JongilHan66 @lisa-bengtsson @grantfirl @Qingfu-Liu @dustinswales -physics/sascnvn.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/satmedmfvdif.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/satmedmfvdifq.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/scm_sfc_flux_spec.* @grantfirl @grantfirl @Qingfu-Liu @dustinswales -physics/set_soilveg.* @HelinWei-NOAA @barlage @cenlinhe @grantfirl @Qingfu-Liu @dustinswales -physics/set_soilveg_ruc.* @tanyasmirnova @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_cice.* @wd20xw @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_diag.* @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_diag_post.* @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_diff.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_nst* @XuLi-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_ocean.* @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/sfc_sice.* @wd20xw @grantfirl @Qingfu-Liu @dustinswales -physics/sfcsub.F @grantfirl @Qingfu-Liu @dustinswales -physics/sflx.f @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/sgscloud_radpost.* @grantfirl @Qingfu-Liu @dustinswales -physics/sgscloud_radpre.* @grantfirl @Qingfu-Liu @dustinswales -physics/shalcnv.* @JongilHan66 @grantfirl @Qingfu-Liu @dustinswales -physics/shinhongvdif.* @Qingfu-Liu @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/shoc.* @grantfirl @Qingfu-Liu @dustinswales -physics/surface_perturbation.* @HelinWei-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/tridi.f @JongilHan66 @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/ugwp_driver_v0.F @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/ugwpv1_gsldrag.* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/ugwpv1_gsldrag_post.* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/unified_ugwp* @mdtoyNOAA @grantfirl @Qingfu-Liu @dustinswales -physics/wv_saturation.F @AnningCheng-NOAA @andrewgettelman @grantfirl @Qingfu-Liu @dustinswales -physics/ysuvdif.* @Qingfu-Liu @WeiguoWang-NOAA @grantfirl @Qingfu-Liu @dustinswales -physics/zhaocarr_gscond.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales -physics/zhaocarr_precpd.* @RuiyuSun @grantfirl @Qingfu-Liu @dustinswales - -physics/sfc_land.* @uturuncoglu @barlage +physics/CONV/C3/cu_c3* @lisa-bengtsson @haiqinli @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.* @AnningCheng-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/CONV/Chikira_Sugiyama/cs_conv.* @AnningCheng-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/CONV/Grell_Freitas/cu_gf* @haiqinli @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/CONV/RAS/rascnv.* @haiqinli @JongilHan66 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/CONV/SAMF/samfdeepcnv.* @JongilHan66 @lisa-bengtsson @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/CONV/SAMF/samfshalcnv.* @JongilHan66 @lisa-bengtsson @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/CONV/SAMF/samfaerosols.* @JongilHan66 @lisa-bengtsson @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/CONV/SAS/sascnvn.* @JongilHan66 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/CONV/SAS/shalcnv.* @JongilHan66 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/CONV/nTiedtke/cu_ntiedtke* @JongilHan66 @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/CONV/progsigma_calc.f90 @lisa-bengtsson @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/cires_orowam2017.f @mdtoyNOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/cires_tauamf_data.F90 @mdtoyNOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/cires_ugwp* @mdtoyNOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/drag_suite.* @mdtoyNOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/gwdc.* @Songyou184 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/gwdps.* @Songyou184 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/rayleigh_damp.* @yangfanglin @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/ugwp_driver_v0.F @mdtoyNOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/ugwpv1_gsldrag.* @mdtoyNOAA @BoYang-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/ugwpv1_gsldrag_post.* @mdtoyNOAA @BoYang-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/GWD/unified_ugwp* @mdtoyNOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.* @ericaligo-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Ferrier_Aligo/mp_fer_hires.* @ericaligo-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.* @RuiyuSun @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/GFDL/v1_2019/gfdl_cloud_microphys_mod.* @RuiyuSun @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.* @RuiyuSun @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.* @RuiyuSun @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/GFDL/fv_sat_adj.* @RuiyuSun @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/GFDL/multi_gases.F90 @RuiyuSun @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/aer_cloud.F @AnningCheng-NOAA @andrewgettelman @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/aerclm_def.F @AnningCheng-NOAA @andrewgettelman @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/aerinterp.F90 @AnningCheng-NOAA @andrewgettelman @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/cldmacro.F @AnningCheng-NOAA @andrewgettelman @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/cldwat2m_micro.F @AnningCheng-NOAA @andrewgettelman @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/micro_mg* @AnningCheng-NOAA @andrewgettelman @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/m_micro* @AnningCheng-NOAA @andrewgettelman @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Morrison_Gettelman/wv_saturation.F @AnningCheng-NOAA @andrewgettelman @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/NSSL/module_mp_nssl_2mom.F90 @MicroTed @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/NSSL/mp_nssl.* @MicroTed @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Thompson/module_mp_thompson* @gthompsnWRF @RuiyuSun @AndersJensen-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Thompson/mp_thompson* @gthompsnWRF @RuiyuSun @AndersJensen-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Zhao_Carr/zhaocarr_gscond.* @RuiyuSun @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/Zhao_Carr/zhaocarr_precpd.* @RuiyuSun @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/calpreciptype.f90 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/MP/module_mp_radar.* @gthompsnWRF @RuiyuSun @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/HEDMF/hedmf.* @JongilHan66 @WeiguoWang-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/MYJ/module_BL_MYJPBL.* @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/MYJ/myjpbl_wrapper.* @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/MYNN_EDMF/bl_mynn_common.f90 @joeolson42 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/MYNN_EDMF/module_bl_mynn.* @joeolson42 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/MYNN_EDMF/mynnedmf_wrapper.* @joeolson42 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/SATMEDMF/satmedmfvdif.* @JongilHan66 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/SATMEDMF/satmedmfvdifq.* @JongilHan66 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/SATMEDMF/mfscu.f @JongilHan66 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/SATMEDMF/mfscuq.f @JongilHan66 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/SHOC/moninshoc.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/SHOC/shoc.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/YSU/ysuvdif.* @Qingfu-Liu @WeiguoWang-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/saYSU/shinhongvdif.* @Qingfu-Liu @WeiguoWang-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/mfpbl.f @JongilHan66 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/mfpblt.f @JongilHan66 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/mfpbltq.f @JongilHan66 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/PBL/tridi.f @JongilHan66 @WeiguoWang-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/iounitdef.f @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/module_bfmicrophysics.f @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/rad_sw_pre* @mjiacono @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/radcons.f90 @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/radlw_* @mjiacono @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/radsw_* @mjiacono @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/rrtmg_lw_post.* @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 @dustinswales @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMG/rrtmg_sw_post.* @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMGP/rte-rrtmgp @dustinswales @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.* @dustinswales @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMGP/rrtmgp_lw_* @dustinswales @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/RRTMGP/rrtmgp_sw_* @dustinswales @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/mersenne_twister.f @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/radiation_aerosols.f @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/radiation_astronomy.f @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/radiation_cloud_overlap.F90 @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/radiation_clouds.f @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/radiation_gases.f @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/radiation_surface.f @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Radiation/radiation_tools.F90 @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/GFDL/gfdl_sfc_layer.* @ZhanZhang-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 @ZhanZhang-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/MYJ/myjsfc_wrapper.* @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/MYJ/module_SF_JSFC.F90 @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/MYNN/mynnsfc_wrapper.* @joeolson42 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/MYNN/module_sf_mynn.F90 @joeolson42 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/date_def.f @XuLi-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/module_nst* @XuLi-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/sfc_diag.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/sfc_diag_post.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/sfc_diff.* @JongilHan66 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Layer/UFS/sfc_nst* @XuLi-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Lake/CLM/clm_lake.* @tanyasmirnova @SamuelTrahanNOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Lake/Flake/flake* @barlage @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noah/lsm_noah.* @HelinWei-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noah/namelist_soilveg.* @HelinWei-NOAA @barlage @cenlinhe @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noah/set_soilveg.* @HelinWei-NOAA @barlage @cenlinhe @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noah/sflx.f @HelinWei-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noah/surface_perturbation.* @HelinWei-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/Noahmp/*noahmp* @barlage @cenlinhe @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/RUC/lsm_ruc.* @tanyasmirnova @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/RUC/module_sf_ruclsm.* @tanyasmirnova @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/RUC/module_soil_pre.* @tanyasmirnova @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.* @tanyasmirnova @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/RUC/set_soilveg_ruc.* @tanyasmirnova @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Land/sfc_land.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/Ocean/UFS/sfc_ocean.* @HelinWei-NOAA @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/SeaIce/CICE/sfc_cice.* @wd20xw @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/SFC_Models/SeaIce/CICE/sfc_sice.* @wd20xw @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/hooks/machine.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/hooks/physcons.F90 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/photochem/module_h2ophys.* @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/photochem/module_ozphys.* @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/smoke_dust/* @haiqinli @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/tools/funcphys.f90 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/tools/get_phi_fv3.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/tools/get_prs_fv3.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.* @dustinswales @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_pre.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.* @dustinswales @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.* @dustinswales @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.* @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.* @dustinswales @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.* @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.* @dustinswales @Qingfu-Liu @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.* @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_pre.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.* @pjpegion @lisa-bengtsson @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_1.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_5.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_reset.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part2.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/cnvc90.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.* @Qingfu-Liu @dustinswales @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/iccn_def.F @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.* @grantfirl @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpost.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales +physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.* @grantfirl @rhaesung @Qingfu-Liu @dustinswales ######################################################################## diff --git a/README.md b/README.md index 9a38f5e0f..60ba98449 100644 --- a/README.md +++ b/README.md @@ -11,7 +11,7 @@ Please see more information about the CCPP at the locations below. - [CCPP Physics GitHub wiki](https://github.com/NCAR/ccpp-physics/wiki) - [CCPP Framework GitHub wiki](https://github.com/NCAR/ccpp-framework/wiki) -For the use of CCPP with its Single Column Model, see the [Single Column Model User's Guide](http://dtcenter.org/sites/default/files/paragraph/scm-ccpp-guide-v6.0.0.pdf). +For the use of CCPP with its Single Column Model, see the [Single Column Model User's Guide](https://ccpp-scm.readthedocs.io/en/latest/). For the use of CCPP with NOAA's Unified Forecast System (UFS), see the [UFS Medium-Range Application User's Guide](https://ufs-mrweather-app.readthedocs.io/en/latest), the [UFS Short-Range Application User's Guide](https://ufs-srweather-app.readthedocs.io/en/latest) and the [UFS Weather Model User's Guide](https://ufs-weather-model.readthedocs.io/en/latest). diff --git a/physics/CONV/C3/cu_c3_deep.F90 b/physics/CONV/C3/cu_c3_deep.F90 index b7cd5f62d..2b88bba6f 100644 --- a/physics/CONV/C3/cu_c3_deep.F90 +++ b/physics/CONV/C3/cu_c3_deep.F90 @@ -153,7 +153,7 @@ subroutine cu_c3_deep_run( & !! betwee -1 and +1 ,do_capsuppress,cap_suppress_j & ! ,k22 & ! - ,jmin,tropics) ! + ,jmin,mc_thresh) ! implicit none @@ -167,7 +167,7 @@ subroutine cu_c3_deep_run( & real(kind=kind_phys), dimension (its:) & ,intent (in ) :: rand_mom,rand_vmas !$acc declare copyin(rand_clos,rand_mom,rand_vmas) - real(kind=kind_phys), intent(in), dimension (its:) :: ca_deep(:) + real(kind=kind_phys), intent(in), dimension (its:), optional :: ca_deep(:) integer, intent(in) :: do_capsuppress real(kind=kind_phys), intent(in), dimension(:) :: cap_suppress_j !$acc declare create(cap_suppress_j) @@ -188,23 +188,26 @@ subroutine cu_c3_deep_run( & frh_out,rainevap real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & - tmf, qmicro, sigmain, forceqv_spechum + tmf + real(kind=kind_phys), dimension (its:,kts:) & + ,intent (in ), optional :: & + qmicro, sigmain, forceqv_spechum real(kind=kind_phys), dimension (its:) & ,intent (inout ) :: & pre,xmb_out !$acc declare copy(cnvwt,outu,outv,outt,outq,outqc,cupclw,frh_out,pre,xmb_out) real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & - hfx,qfx,xmbm_in,xmbs_in -!$acc declare copyin(hfx,qfx,xmbm_in,xmbs_in) + mc_thresh,hfx,qfx,xmbm_in,xmbs_in +!$acc declare copyin(mc_thresh,hfx,qfx,xmbm_in,xmbs_in) integer, dimension (its:) & ,intent (inout ) :: & kbcon,ktop !$acc declare copy(kbcon,ktop) integer, dimension (its:) & ,intent (in ) :: & - kpbl,tropics -!$acc declare copyin(kpbl,tropics) + kpbl +!$acc declare copyin(kpbl) ! ! basic environmental input includes moisture convergence (mconv) ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off @@ -223,7 +226,7 @@ subroutine cu_c3_deep_run( & q,qo,zuo,zdo,zdm !$acc declare sigmaout real(kind=kind_phys), dimension (its:,kts:) & - ,intent (out) :: & + ,intent (out), optional :: & sigmaout real(kind=kind_phys), dimension (its:) & ,intent (in ) :: & @@ -376,7 +379,7 @@ subroutine cu_c3_deep_run( & !$acc ktopdby,kbconx,ierr2,ierr3,kbmax) integer, dimension (its:), intent(inout) :: ierr - integer, dimension (its:), intent(in) :: csum + integer, dimension (its:), intent(in), optional :: csum logical, intent(in) :: do_ca, progsigma logical, intent(in) :: flag_init, flag_restart !$acc declare copy(ierr) copyin(csum) @@ -445,10 +448,19 @@ subroutine cu_c3_deep_run( & !---meltglac------------------------------------------------- real(kind=kind_phys), dimension (its:ite,kts:kte) :: p_liq_ice,melting_layer,melting -!$acc declare create(p_liq_ice,melting_layer,melting) +! icoldpool + integer, parameter :: icoldpool=0 + real(kind=kind_phys), parameter :: Kfr = 0.9, epsx = 1.e2, alpha_dd=45., pi=3.1416 + real(kind=kind_phys), dimension (its:ite) :: beta_x, vcpool, wlpool,umcl,vmcl,slope_pool + real(kind=kind_phys), dimension (its:ite,kts:kte) :: buoysrc,dellat_d + real(kind=kind_phys) :: aux,mcl_speed,total_dz,mx_buoy2,h_env,dpsum integer :: itemp +!$acc declare create(p_liq_ice,melting_layer,melting,buoysrc,beta_x,vcpool,wlpool,umcl,vmcl) + + + mx_buoy2 = cp*10. !---meltglac------------------------------------------------- !$acc kernels melting_layer(:,:)=0. @@ -583,9 +595,8 @@ subroutine cu_c3_deep_run( & !$acc loop private(radius,frh) do i=its,ite c1d(i,:)= 0. !c1 ! 0. ! c1 ! max(.003,c1+float(csum(i))*.0001) - entr_rate(i)=7.e-5 - min(20.,float(csum(i))) * 3.e-6 - if(xland1(i) == 0)entr_rate(i)=7.e-5 - if(dx(i) 0 dellaq(i,1) = dellaq(i,1)+ e_dn-g_rain + dellat_d(i,1)=zdo(i,2)*edto(i)*(hcdo(i,2)-heo_cup(i,2))*g/dp !--- conservation check !- water mass balance @@ -1777,6 +1790,12 @@ subroutine cu_c3_deep_run( & ! trash= trash+ (dellaq(i,k)+dellaqc(i,k)+ g_rain-e_dn)*dp/g enddo ! k + do k=2,jmin(i)-1 + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + dellat_d(i,k)= & + edto(i)*dd_massdetro(i,k)*(.5*(hcdo(i,k+1)+hcdo(i,k))-heo(i,k))*g/dp + enddo ! k + endif enddo @@ -1988,6 +2007,7 @@ subroutine cu_c3_deep_run( & !$acc atomic update mconv(i)=mconv(i)+omeg(i,k)*dq/g enddo + if ((mconv(i) < mc_thresh(i)) .and. (xland1(i) == 0)) ierr(i)=2242 enddo !> - From Bengtsson et al. (2022) \cite Bengtsson_2022 prognostic closure scheme, @@ -2013,9 +2033,9 @@ subroutine cu_c3_deep_run( & endif enddo call progsigma_calc(itf,ktf,flag_init,flag_restart,flag_shallow, & - flag_mid,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,xlv,dtime, & - forceqv_spechum,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, & - sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) + flag_mid,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,xlv,dtime, & + forceqv_spechum,k22,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif !$acc end kernels @@ -2085,6 +2105,34 @@ subroutine cu_c3_deep_run( & ichoice,imid,ipr,itf,ktf, & its,ite, kts,kte,dx,sigmab, & dicycle,xf_dicycle,xf_progsigma) + ! + ! + if (icoldpool > 0 .and. imid ==0) then + buoysrc(:,:)=0. + do i=its,itf + vcpool(i)=0. + wlpool(i)=0. + total_dz=0. + beta_x(i)=0. + if(ierr(i).gt.0)cycle ! exit loopI + do k = kts,jmin(i)-1 + buoysrc(i,k)=beta_x(i)-dellat_d(i,k)*xmb(i)*dtime !/sig(i)*cp + if(buoysrc(i,k) < epsx .or. total_dz .gt. z_detr ) cycle + H_env = heo(i,k) + dz = zo(i,k+1)-zo(i,k) + total_dz = total_dz + dz + vcpool(i) = vcpool(i) + (g*dz*min(mx_buoy2,buoysrc(i,k))/H_env) + wlpool(i) = wlpool(i) + (g*dz*min(mx_buoy2,buoysrc(i,k))/H_env ) + end do + do k = kts,jmin(i)-1 + buoysrc(i,k)=-dellat_d(i,k)*xmb(i)*dtime + end do + vcpool(i) = min(20., Kfr *sqrt(vcpool(i))) + slope_pool(i) = alpha_dd + wlpool(i) = min(10., Kfr *sin( slope_pool(i)*pi/180. )* sqrt(wlpool(i))) + enddo ! i-loop + endif ! icoldpool + !> - Call rain_evap_below_cloudbase() to calculate evaporation below cloud base @@ -2113,6 +2161,48 @@ subroutine cu_c3_deep_run( & endif enddo !$acc end kernels + if (icoldpool > 0 .and. icoldpool /= 2 .and. imid ==0) then + ! --- adding the gust front horizontal speed to the 2-d MCL wind + ! --- only magnitude is augmented, direction is kept the same + do i=its,itf + umcl(i)=0. + vmcl(i)=0. + dpsum=0. + if(ierr(i) > 0 ) cycle + do k=kts+1,ktop(i)-1 + trash =-(po_cup(i,k)-po_cup(i,kts)) + if(trash.gt.300..and. trash.lt.600.)then + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + umcl(i)=umcl(i)+us(i,k)*dp + vmcl(i)=vmcl(i)+us(i,k)*dp + dpsum=dpsum+dp + endif + enddo + if(dpsum > 0.) then + umcl(i)=umcl(i)/dpsum + vmcl(i)=vmcl(i)/dpsum + MCL_speed= sqrt( umcl(i)**2 + vmcl(i)**2 ) + aux = (MCL_speed + vcpool(i))/(MCL_speed+1.e-6) + umcl(i) = aux * umcl(i) + vmcl(i) = aux * vmcl(i) + endif + enddo + ! --- gust front momentum impact + do i=its,itf + if(ierr(i) > 0 .or. vcpool(i) .le.0.) cycle + k=kts + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + outu(i,k) = outu(i,k) + edto(i)*zdo(i,k+1)*umcl(i)*g/dp*xmb(i) + outv(i,k) = outv(i,k) + edto(i)*zdo(i,k+1)*vmcl(i)*g/dp*xmb(i) + do k=kts+1,kdet(i) + dp=100.*(po_cup(i,k)-po_cup(i,k+1)) + outu(i,k) = outu(i,k) + edto(i)*dd_massdetro(i,k)*umcl(i)*g/dp*xmb(i) + outv(i,k) = outv(i,k) + edto(i)*dd_massdetro(i,k)*vmcl(i)*g/dp*xmb(i) + enddo + enddo + endif ! icoldpool + if(icoldpool == 1)vcpool(:)=0. + ! rain evaporation as in sas ! if(irainevap.eq.1)then @@ -2139,6 +2229,8 @@ subroutine cu_c3_deep_run( & if(ierr(i).eq.0)then evef = edt(i) * evfact * sig(i)**2 if(xland(i).gt.0.5 .and. xland(i).lt.1.5) evef = edt(i) * evfactl * sig(i)**2 + !evef=.09 + !evef=.9 !$acc loop seq do k = ktop(i), 1, -1 rain = pwo(i,k) + edto(i) * pwdo(i,k) @@ -4225,7 +4317,7 @@ end subroutine cup_output_ens_3d !> Calculates moisture properties of the updraft. subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & p_cup,kbcon,ktop,dby,clw_all,xland1, & - q,gamma_cup,zu,qes_cup,k22,qe_cup,c0, & + q,gamma_cup,zu,qes_cup,k22,qe_cup,c0,jmin, & zqexec,ccn,ccnclean,rho,c1d,t,autoconv, & up_massentr,up_massdetr,psum,psumh, & itest,itf,ktf, & @@ -4264,7 +4356,7 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & ! entr= entrainment rate integer, dimension (its:) & ,intent (in ) :: & - kbcon,ktop,k22,xland1 + kbcon,ktop,k22,xland1,jmin !$acc declare copyin(p_cup,rho,q,zu,gamma_cup,qe_cup,up_massentr,up_massdetr,dby,qes_cup,z_cup,zqexec,c0,kbcon,ktop,k22,xland1) real(kind=kind_phys), intent (in ) :: & ! HCB ccnclean @@ -4487,16 +4579,17 @@ subroutine cup_up_moisture(name,ierr,z_cup,qc,qrc,pw,pwav, & clw_allh(i,k)=max(0.,qch(i,k)-qrch) qrcb(i,k)=max(0.,(qch(i,k)-qrch)) ! /(1.+c0(i)*dz*zu(i,k)) if(is_deep)then - clwdet=0.1 !0.02 ! 05/11/2021 - !if(k.lt.kklev(i)) clwdet=0. ! 05/05/2021 + clwdet=1.2 !0.1 !0.02 else - clwdet=0.1 !0.02 ! 05/05/2021 - !if(k.lt.kklev(i)) clwdet=0. ! 05/25/2021 + clwdet=1.2 !0.1 !0.02 + endif + if (k.gt.jmin(i))then + clwdet=2. endif if(k.gt.kbcon(i)+1)c1d(i,k)=clwdet*up_massdetr(i,k-1) if(k.gt.kbcon(i)+1)c1d_b(i,k)=clwdet*up_massdetr(i,k-1) - c1d(i,k)=0.005 - c1d_b(i,k)=0.005 + !c1d(i,k)=0.005 + !c1d_b(i,k)=0.005 if(autoconv.eq.2) then ! diff --git a/physics/CONV/C3/cu_c3_driver.F90 b/physics/CONV/C3/cu_c3_driver.F90 index c911ff5e4..c7e1c1f8c 100644 --- a/physics/CONV/C3/cu_c3_driver.F90 +++ b/physics/CONV/C3/cu_c3_driver.F90 @@ -111,18 +111,19 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& real (kind=kind_phys), intent(in) :: g,cp,fv,r_d,xlv,r_v,betascu,betamcu,betadcu logical, intent(in ) :: ldiag3d logical, intent(in ) :: progsigma - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) !$acc declare copy(dtend) integer, intent(in) :: dtidx(:,:), & index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_scnv, index_of_process_dcnv, ntqv, ntcw, ntiw !$acc declare copyin(dtidx) - real(kind=kind_phys), dimension( : , : ), intent(in ) :: forcet,forceqv_spechum,w,phil,delp - real(kind=kind_phys), dimension ( : , : ), intent(in ) :: sigmain,qmicro + real(kind=kind_phys), dimension( : , : ), intent(in ), optional :: forcet,forceqv_spechum + real(kind=kind_phys), dimension( : , : ), intent(in ) :: w,phil,delp + real(kind=kind_phys), dimension ( : , : ), intent(in ), optional :: sigmain,qmicro real(kind=kind_phys), dimension( : , : ), intent(inout ) :: t,us,vs - real(kind=kind_phys), dimension( : , : ), intent(inout ) :: qci_conv + real(kind=kind_phys), dimension( : , : ), intent(inout ), optional :: qci_conv real(kind=kind_phys), dimension( : , : ), intent(out ) :: cnvw_moist,cnvc - real(kind=kind_phys), dimension ( : , : ), intent(out ) :: sigmaout + real(kind=kind_phys), dimension ( : , : ), intent(out ), optional :: sigmaout real(kind=kind_phys), dimension( : , : ), intent(inout ) :: cliw, clcw real(kind=kind_phys), dimension ( : , : , :), intent(in ) :: tmf !$acc declare copyin(forcet,forceqv_spechum,w,phil) @@ -134,27 +135,31 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& integer, intent(in) :: dfi_radar_max_intervals real(kind=kind_phys), intent(in) :: fhour, fh_dfi_radar(:) integer, intent(in) :: num_dfi_radar, ix_dfi_radar(:) - real(kind=kind_phys), intent(in) :: cap_suppress(:,:) + real(kind=kind_phys), intent(in), optional :: cap_suppress(:,:) !$acc declare copyin(fh_dfi_radar,ix_dfi_radar,cap_suppress) integer, dimension (:), intent(out) :: hbot,htop,kcnv integer, dimension (:), intent(in) :: xland - real(kind=kind_phys), dimension (:), intent(in) :: pbl,maxMF + real(kind=kind_phys), dimension (:), intent(in) :: pbl + real(kind=kind_phys), dimension (:), intent(in), optional :: maxMF !$acc declare copyout(hbot,htop,kcnv) !$acc declare copyin(xland,pbl) integer, dimension (im) :: tropics !$acc declare create(tropics) ! ruc variable - real(kind=kind_phys), dimension (:), intent(in) :: hfx2,qfx2,psuri,ca_deep - real(kind=kind_phys), dimension (:,:), intent(out) :: ud_mf,dd_mf,dt_mf - real(kind=kind_phys), dimension (:), intent(out) :: raincv,cld1d,maxupmf,rainevap + real(kind=kind_phys), dimension (:), intent(in) :: hfx2,qfx2,psuri + real(kind=kind_phys), dimension (:), intent(in), optional :: ca_deep + real(kind=kind_phys), dimension (:,:), intent(out), optional :: ud_mf + real(kind=kind_phys), dimension (:,:), intent(out) :: dd_mf,dt_mf + real(kind=kind_phys), dimension (:), intent(out) :: raincv,cld1d,rainevap + real(kind=kind_phys), dimension (:), intent(out), optional :: maxupmf real(kind=kind_phys), dimension (:,:), intent(in) :: t2di,p2di !$acc declare copyin(hfx2,qfx2,psuri,t2di,p2di) !$acc declare copyout(ud_mf,dd_mf,dt_mf,raincv,cld1d) ! Specific humidity from FV3 real(kind=kind_phys), dimension (:,:), intent(in) :: qv2di_spechum real(kind=kind_phys), dimension (:,:), intent(inout) :: qv_spechum - real(kind=kind_phys), dimension (:), intent(inout) :: aod_gf + real(kind=kind_phys), dimension (:), intent(inout), optional :: aod_gf !$acc declare copyin(qv2di_spechum) copy(qv_spechum,aod_gf) ! Local water vapor mixing ratios and cloud water mixing ratios real(kind=kind_phys), dimension (im,km) :: qv2di, qv, forceqv, cnvw @@ -165,7 +170,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& real(kind=kind_phys), intent(in ) :: dt integer, intent(in ) :: imfshalcnv - integer, dimension(:), intent(inout) :: cactiv,cactiv_m + integer, dimension(:), intent(inout), optional :: cactiv,cactiv_m !$acc declare copy(cactiv,cactiv_m) character(len=*), intent(out) :: errmsg @@ -223,10 +228,10 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi,clw_ten real(kind=kind_phys), dimension (im,km) :: tn,qo,tshall,qshall,dz8w,omeg real(kind=kind_phys), dimension (im) :: z1,psur,cuten,cutens,cutenm - real(kind=kind_phys), dimension (im) :: umean,vmean,pmean + real(kind=kind_phys), dimension (im) :: umean,vmean,pmean,mc_thresh real(kind=kind_phys), dimension (im) :: xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv !$acc declare create(qcheck,zo,t2d,q2d,po,p2d,rhoi,clw_ten,tn,qo,tshall,qshall,dz8w,omeg, & -!$acc z1,psur,cuten,cutens,cutenm,umean,vmean,pmean, & +!$acc z1,psur,cuten,cutens,cutenm,umean,vmean,pmean,mc_thresh, & !$acc xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv) integer :: i,j,k,icldck,ipr,jpr,jpr_deep,ipr_deep,uidx,vidx,tidx,qidx @@ -598,6 +603,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& hfx(i)=hfx2(i)*cp*rhoi(i,1) qfx(i)=qfx2(i)*xlv*rhoi(i,1) dx(i) = sqrt(garea(i)) + mc_thresh(i)=3.25/dx(i) enddo do i=its,itf @@ -651,7 +657,9 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& enddo do i = its,itf if(mconv(i).lt.0.)mconv(i)=0. - if((dx(i)<6500.).and.do_mynnedmf.and.(maxMF(i).gt.0.))ierr(i)=555 + if(do_mynnedmf) then + if((dx(i)<6500.).and.(maxMF(i).gt.0.))ierr(i)=555 + endif enddo !$acc end kernels if (dx(its)<6500.) then @@ -783,7 +791,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22m & - ,jminm,tropics) + ,jminm,mc_thresh) !$acc kernels do i=its,itf do k=kts,ktf @@ -841,30 +849,29 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ,ca_deep & ,mconv & ,omeg & - - ,cactiv & - ,cnvwt & - ,zu & - ,zd & - ,zdm & ! hli - ,edt & - ,edtm & ! hli - ,xmb & - ,xmbm & - ,xmbs & - ,pret & - ,outu & - ,outv & - ,outt & - ,outq & - ,outqc & - ,kbcon & - ,ktop & - ,cupclw & - ,frhd & - ,rainevap & - ,ierr & - ,ierrc & + ,cactiv & + ,cnvwt & + ,zu & + ,zd & + ,zdm & ! hli + ,edt & + ,edtm & ! hli + ,xmb & + ,xmbm & + ,xmbs & + ,pret & + ,outu & + ,outv & + ,outt & + ,outq & + ,outqc & + ,kbcon & + ,ktop & + ,cupclw & + ,frhd & + ,rainevap & + ,ierr & + ,ierrc & ! the following should be set to zero if not available ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist ,rand_vmas & ! for stochastics vertmass, if temporal and spatial patterns exist @@ -878,7 +885,7 @@ subroutine cu_c3_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart,& ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22 & - ,jmin,tropics) + ,jmin,mc_thresh) jpr=0 ipr=0 !$acc kernels diff --git a/physics/CONV/C3/cu_c3_driver.meta b/physics/CONV/C3/cu_c3_driver.meta index 5677cdd32..af411cb6b 100644 --- a/physics/CONV/C3/cu_c3_driver.meta +++ b/physics/CONV/C3/cu_c3_driver.meta @@ -156,6 +156,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout + optional = True [cactiv_m] standard_name = counter_for_grell_freitas_mid_level_convection long_name = mid-level cloud convective activity memory @@ -163,6 +164,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout + optional = True [g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -219,6 +221,7 @@ type = real kind = kind_phys intent = in + optional = True [forceqv_spechum] standard_name = tendendy_of_specific_humidity_due_to_nonphysics long_name = moisture tendency due to dynamics only @@ -227,6 +230,7 @@ type = real kind = kind_phys intent = in + optional = True [tmf] standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme @@ -243,6 +247,7 @@ type = real kind = kind_phys intent = in + optional = True [sigmain] standard_name = prognostic_updraft_area_fraction_in_convection long_name = convective updraft area fraction @@ -251,6 +256,7 @@ type = real kind = kind_phys intent = in + optional = True [sigmaout] standard_name = updraft_area_fraction_updated_by_physics long_name = convective updraft area fraction updated by physics @@ -259,6 +265,7 @@ type = real kind = kind_phys intent = out + optional = True [betascu] standard_name = tuning_param_for_shallow_cu long_name = tuning param for shallow cu in case prognostic closure is used @@ -438,6 +445,7 @@ type = real kind = kind_phys intent = inout + optional = True [cliw] standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array @@ -470,6 +478,7 @@ type = real kind = kind_phys intent = out + optional = True [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt @@ -531,6 +540,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -616,6 +626,7 @@ type = real kind = kind_phys intent = inout + optional = True [fhour] standard_name = forecast_time long_name = current forecast time @@ -661,6 +672,7 @@ type = real kind = kind_phys intent = in + optional = True [ca_deep] standard_name = cellular_automata_area_fraction_for_deep_convection_from_coupled_process long_name = fraction of cellular automata for deep convection @@ -669,6 +681,7 @@ type = real kind = kind_phys intent = in + optional = True [rainevap] standard_name = physics_field_for_coupling long_name = physics_field_for_coupling @@ -685,6 +698,7 @@ type = real kind = kind_phys intent = out + optional = True [maxMF] standard_name = maximum_mass_flux long_name = maximum mass flux within a column @@ -693,6 +707,7 @@ type = real kind = kind_phys intent = in + optional = True [do_mynnedmf] standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme long_name = flag to activate MYNN-EDMF diff --git a/physics/CONV/C3/cu_c3_driver_post.F90 b/physics/CONV/C3/cu_c3_driver_post.F90 index d5d2dee3b..8e97e9a04 100644 --- a/physics/CONV/C3/cu_c3_driver_post.F90 +++ b/physics/CONV/C3/cu_c3_driver_post.F90 @@ -34,7 +34,8 @@ subroutine cu_c3_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m real(kind_phys), intent(out) :: conv_act_m(:) ! for Radar reflectivity real(kind_phys), intent(in) :: dt - real(kind_phys), intent(in) :: raincv(:), maxupmf(:) + real(kind_phys), intent(in) :: raincv(:) + real(kind_phys), intent(in) :: maxupmf(:) real(kind_phys), intent(inout) :: refl_10cm(:,:) character(len=*), intent(out) :: errmsg !$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m) diff --git a/physics/CONV/C3/cu_c3_sh.F90 b/physics/CONV/C3/cu_c3_sh.F90 index 736292092..92feb44f7 100644 --- a/physics/CONV/C3/cu_c3_sh.F90 +++ b/physics/CONV/C3/cu_c3_sh.F90 @@ -102,7 +102,11 @@ subroutine cu_c3_sh_run ( & !$acc declare copy(cnvwt,outt,outq,outqc,cupclw,zuo,outu,outv) real(kind=kind_phys), dimension (its:,kts:) & ,intent (in ) :: & - tmf, qmicro, sigmain, forceqv_spechum + tmf + real(kind=kind_phys), dimension (its:,kts:) & + ,intent (in ), optional :: & + qmicro, sigmain, forceqv_spechum + real(kind=kind_phys), dimension (its:) & ,intent (out ) :: & xmb_out @@ -133,9 +137,9 @@ subroutine cu_c3_sh_run ( & real(kind=kind_phys) & ,intent (in ) :: & dtime,tcrit,fv,r_d,betascu,betamcu,betadcu -!$acc declare sigmaout +!$acc declare sigmaout real(kind=kind_phys), dimension (its:,kts:) & - ,intent (out) :: & + ,intent (out), optional :: & sigmaout @@ -979,9 +983,9 @@ subroutine cu_c3_sh_run ( & endif enddo call progsigma_calc(itf,ktf,flag_init,flag_restart,flag_shallow, & - flag_mid,del,tmf,qmicro,dbyo,zdqca,omega_u,zeta,xlv,dtime, & - forceqv_spechum,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, & - sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) + flag_mid,del,tmf,qmicro,dbyo,zdqca,omega_u,zeta,xlv,dtime, & + forceqv_spechum,k22,kbcon,ktop,cnvflg,betascu,betamcu,betadcu, & + sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 index ab7388df8..84a06f377 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.F90 @@ -60,6 +60,7 @@ module cs_conv !DD and precipitation. Decrease for more precip real(kind_phys), public :: precz0, preczh, clmd, clmp, clmdpa + real(kind_phys), public, parameter :: c0t=0.002, d0t=0.002 ! ! Private data ! @@ -199,13 +200,14 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! output arguments ! ! updraft, downdraft, and detrainment mass flux (kg/m2/s) - real(kind_phys), intent(inout), dimension(:,:) :: ud_mf, dd_mf, dt_mf + real(kind_phys), intent(inout), dimension(:,:) :: ud_mf + real(kind_phys), intent(inout), dimension(:,:) :: dd_mf, dt_mf real(kind_phys), intent(out) :: rain1(:) ! lwe thickness of deep convective precipitation amount (m) ! GJF* These variables are conditionally allocated depending on whether the ! Morrison-Gettelman microphysics is used, so they must be declared ! using assumed shape. - real(kind_phys), intent(out), dimension(:,:) :: qlcn, qicn, w_upi,cnv_mfd, & + real(kind_phys), intent(out), dimension(:,:), optional :: qlcn, qicn, w_upi,cnv_mfd, & cnv_dqldt, clcn, cnv_fice, & cnv_ndrop, cnv_nice, cf_upi ! *GJF @@ -225,15 +227,17 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! ! output arguments of CS_CUMLUS ! - real(kind_phys), dimension(IJSDIM,KMAX,nctp) :: vverti + real(kind_phys), dimension(IJSDIM,KMAX+1,nctp) :: vverti, sigmai real(kind_phys) GTT(IJSDIM,KMAX) !< temperature tendency [K/s] real(kind_phys) GTQ(IJSDIM,KMAX,NTR) !< tracer tendency [kg/kg/s] real(kind_phys) GTU(IJSDIM,KMAX) !< zonal velocity tendency [m/s2] real(kind_phys) GTV(IJSDIM,KMAX) !< meridional velocity tendency [m/s2] - real(kind_phys) GTPRP(IJSDIM,KMAX) !< precipitation (including snowfall) flux at interfaces [kg/m2/s] - real(kind_phys) GSNWP(IJSDIM,KMAX) !< snowfall flux at interfaces [kg/m2/s] - + real(kind_phys) CMDET(IJSDIM,KMAX) !< detrainment mass flux [kg/m2/s] + real(kind_phys) GTPRP(IJSDIM,KMAX+1) !< precipitation (including snowfall) flux at interfaces [kg/m2/s] + real(kind_phys) GSNWP(IJSDIM,KMAX+1) !< snowfall flux at interfaces [kg/m2/s] + real(kind_phys) GMFX0(IJSDIM,KMAX+1) !< updraft mass flux [kg/m2/s] + real(kind_phys) GMFX1(IJSDIM,KMAX+1) !< downdraft mass flux [kg/m2/s] integer KT(IJSDIM,nctp) !< cloud top index for each cloud type real(kind_phys) :: cape(IJSDIM) !< convective available potential energy (J/kg) @@ -377,13 +381,14 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & !> -# Initialize the sigma diagnostics do n=1,nctp - do k=1,kmax + do k=1,kmax+1 do i=ists,iens vverti(i,k,n) = zero + sigmai(i,k,n) = zero enddo enddo enddo - do k=1,kmax + do k=1,kmax+1 do i=ists,iens sigma(i,k) = zero enddo @@ -394,9 +399,9 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & otspt(1:ntr,1), otspt(1:ntr,2), & lprnt , ipr , & GTT , GTQ , GTU , GTV , & ! output - dt_mf , & ! output - GTPRP , GSNWP , ud_mf , & ! output - dd_mf , cape , KT , & ! output + CMDET , & ! output + GTPRP , GSNWP , GMFX0 , & ! output + GMFX1 , cape , KT , & ! output CBMFX , & ! modified GDT , GDQ , GDU , GDV , & ! input GDTM , & ! input @@ -404,7 +409,7 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & delp , delpi , & DELTA , DELTI , ISTS , IENS, mype,& ! input fscav, fswtr, wcbmaxm, nctp, & - sigma, vverti, & ! input/output !DDsigma + sigmai, sigma, vverti, & ! input/output !DDsigma do_aw, do_awdd, flx_form) ! ! @@ -432,6 +437,10 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & t(i,k) = GDT(i,k) + GTT(i,k) * delta u(i,k) = GDU(i,k) + GTU(i,k) * delta v(i,k) = GDV(i,k) + GTV(i,k) * delta +! Set the mass fluxes. + ud_mf (i,k) = GMFX0(i,k) + dd_mf (i,k) = GMFX1(i,k) + dt_mf (i,k) = CMDET(i,k) enddo enddo @@ -458,8 +467,8 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! CNV_PRC3(i,k) = 0.0 CNV_NDROP(i,k) = 0.0 CNV_NICE(i,k) = 0.0 - cf_upi(i,k) = max(0.0, min(1.0, 0.5*(sigma(i,k)+sigma(i,kp1)))) - CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft + cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1)) +! CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft !! clcn(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)/delta),0.25)) w_upi(i,k) = 0.0 @@ -492,9 +501,9 @@ subroutine cs_conv_run( IJSDIM , KMAX , ntracp1 , NN, & ! CNV_PRC3(i,k) = 0.0 CNV_NDROP(i,k) = 0.0 CNV_NICE(i,k) = 0.0 - cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.25)) + cf_upi(i,k) = max(0.0,min(0.01*log(1.0+500*ud_mf(i,k)),0.1)) ! & 500*ud_mf(i,k)),0.60)) - CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft +! CLCN(i,k) = cf_upi(i,k) !downdraft is below updraft w_upi(i,k) = ud_mf(i,k)*(t(i,k)+epsvt*gdq(i,k,1)) * rair & / (max(cf_upi(i,k),1.e-12)*gdp(i,k)) @@ -586,11 +595,11 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions GDT , GDQ , GDU , GDV , & ! input GDTM , & ! input GDP , GDPM , GDZ , GDZM , & ! input - delp , delpi , & + delp , delpinv , & DELTA , DELTI , ISTS , IENS, mype,& ! input fscav, fswtr, wcbmaxm, nctp, & ! - sigma, vverti, & ! input/output !DDsigma - do_aw, do_awdd, flx_form ) + sigmai, sigma, vverti, & ! input/output !DDsigma + do_aw, do_awdd, flx_form) ! IMPLICIT NONE @@ -598,6 +607,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions INTEGER, INTENT(IN) :: im, IJSDIM, KMAX, NTR, mype, nctp, ipr !! DD, for GFS, pass in logical, intent(in) :: do_aw, do_awdd, flx_form ! switch to apply Arakawa-Wu to the tendencies logical, intent(in) :: otspt1(ntr), otspt2(ntr), lprnt + REAL(kind_phys),intent(in) :: DELP (IJSDIM, KMAX) + REAL(kind_phys),intent(in) :: DELPINV (IJSDIM, KMAX) ! ! [OUTPUT] REAL(kind_phys), INTENT(OUT) :: GTT (IJSDIM, KMAX ) ! heating rate @@ -605,35 +616,35 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions REAL(kind_phys), INTENT(OUT) :: GTU (IJSDIM, KMAX ) ! tendency of u REAL(kind_phys), INTENT(OUT) :: GTV (IJSDIM, KMAX ) ! tendency of v REAL(kind_phys), INTENT(OUT) :: CMDET (IJSDIM, KMAX ) ! detrainment mass flux - + REAL(kind_phys) :: GTLDET( IJSDIM, KMAX ) ! cloud liquid tendency by detrainment + REAL(kind_phys) :: GTIDET( IJSDIM, KMAX ) ! cloud ice tendency by detrainment ! assuming there is no flux at the top of the atmospherea - Moorthi - REAL(kind_phys), INTENT(OUT) :: GTPRP (IJSDIM, KMAX ) ! rain+snow flux - REAL(kind_phys), INTENT(OUT) :: GSNWP (IJSDIM, KMAX ) ! snowfall flux - REAL(kind_phys), INTENT(OUT) :: GMFX0 (IJSDIM, KMAX ) ! updraft mass flux - REAL(kind_phys), INTENT(OUT) :: GMFX1 (IJSDIM, KMAX ) ! downdraft mass flux + REAL(kind_phys), INTENT(OUT) :: GTPRP (IJSDIM, KMAX+1 ) ! rain+snow flux + REAL(kind_phys), INTENT(OUT) :: GSNWP (IJSDIM, KMAX+1 ) ! snowfall flux + REAL(kind_phys), INTENT(OUT) :: GMFX0 (IJSDIM, KMAX+1 ) ! updraft mass flux + REAL(kind_phys), INTENT(OUT) :: GMFX1 (IJSDIM, KMAX+1 ) ! downdraft mass flux REAL(kind_phys), INTENT(OUT) :: CAPE (IJSDIM ) INTEGER , INTENT(OUT) :: KT (IJSDIM, NCTP ) ! cloud top ! ! [MODIFIED] - REAL(kind_phys), INTENT(INOUT) :: CBMFX (IM, NCTP) ! cloud base mass flux - -!DDsigma - output added for AW sigma diagnostics -! sigma and vert. velocity as a function of cloud type (1==sfc) - real(kind_phys), intent(out), dimension(IM,KMAX) :: sigma !sigma totaled over cloud type - on interfaces (1=sfc) - real(kind_phys), intent(out), dimension(IM,KMAX,nctp) :: vverti + REAL(kind_phys), INTENT(INOUT) :: CBMFX ( IM, NCTP ) !! cloud base mass flux + !DDsigma - output added for AW sigma diagnostics + real(kind_phys), intent(out) :: sigmai(IM,KMAX+1,nctp) !DDsigma sigma by cloud type - on interfaces (1=sfc) + real(kind_phys), intent(out) :: vverti(IM,KMAX+1,nctp) !DDsigma vert. vel. by cloud type - on interfaces (1=sfc) + real(kind_phys), intent(out) :: sigma(IM,KMAX+1) !DDsigma sigma totaled over cloud type - on interfaces (1=sfc) + ! for computing AW flux form of tendencies -! The tendencies are summed over all cloud types -! real(kind_phys), intent(out), dimension(IM,KMAX) :: & !DDsigmadiag - real(kind_phys), allocatable, dimension(:,:) :: sfluxterm, qvfluxterm,& ! tendencies of DSE and water vapor due to eddy mass flux - qlfluxterm, qifluxterm,& ! tendencies of cloud water and cloud ice due to eddy mass flux +! real(kind_phys), dimension(IM,KMAX) :: & !DDsigmadiag +! sfluxterm, qvfluxterm +! real(kind_phys), dimension(IM,KMAX) :: & !DDsigmadiag +! qlfluxterm, qifluxterm +! real(kind_phys), dimension(ijsdim,kmax,ntrq:ntr) :: trfluxterm ! tendencies of tracers due to eddy mass flux + real(kind_phys), dimension(IM,KMAX) :: & !DDsigmadiag + condtermt, condtermq, frzterm, prectermq, prectermfrz + !DDsigma -! The fluxes are for an individual cloud type and reused. -! condtermt, condtermq are eddy flux of temperature and water vapor - condtermt, condtermq, frzterm, & - prectermq, prectermfrz - real(kind_phys), allocatable, dimension(:,:,:) :: trfluxterm ! tendencies of tracers due to eddy mass flux ! ! [INPUT] REAL(kind_phys), INTENT(IN) :: GDT (IJSDIM, KMAX ) ! temperature T @@ -653,137 +664,144 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! ! [INTERNAL WORK] REAL(kind_phys), allocatable :: GPRCC (:, :) ! rainfall -! REAL(kind_phys) GPRCC (IJSDIM, NTR) ! rainfall -! REAL(kind_phys) GSNWC (IJSDIM) ! snowfall -! REAL(kind_phys) CUMCLW(IJSDIM, KMAX) ! cloud water in cumulus -! REAL(kind_phys) CUMFRC(IJSDIM) ! cumulus cloud fraction -! -! REAL(kind_phys) GTCFRC(IJSDIM, KMAX) ! change in cloud fraction -! REAL(kind_phys) FLIQC (IJSDIM, KMAX) ! liquid ratio in cumulus -! -! REAL(kind_phys) GDCFRC(IJSDIM, KMAX) ! cloud fraction -! - REAL(kind_phys) GDW (IJSDIM, KMAX) ! total water - REAL(kind_phys) DELP (IJSDIM, KMAX) - REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GDQS (IJSDIM, KMAX) ! saturate moisture - REAL(kind_phys) FDQS (IJSDIM, KMAX) - REAL(kind_phys) GAM (IJSDIM, KMAX) - REAL(kind_phys) GDS (IJSDIM, KMAX) ! dry static energy - REAL(kind_phys) GDH (IJSDIM, KMAX) ! moist static energy - REAL(kind_phys) GDHS (IJSDIM, KMAX) ! saturate MSE -! - REAL(kind_phys) GCYM (IJSDIM, KMAX, NCTP)! norm. mass flux (half lev) - REAL(kind_phys) GCHB (IJSDIM) ! cloud base MSE-Li*Qi - REAL(kind_phys) GCWB (IJSDIM) ! cloud base total water - REAL(kind_phys) GCUB (IJSDIM) ! cloud base U - REAL(kind_phys) GCVB (IJSDIM) ! cloud base V - REAL(kind_phys) GCIB (IJSDIM) ! cloud base ice - REAL(kind_phys) GCtrB (IJSDIM,ntrq:ntr) ! cloud base tracer - REAL(kind_phys) GCYT (IJSDIM, NCTP) ! norm. mass flux @top - REAL(kind_phys) GCHT (IJSDIM, NCTP) ! cloud top MSE - REAL(kind_phys) GCQT (IJSDIM, NCTP) ! cloud top q - REAL(kind_phys) GCwT (IJSDIM) ! cloud top total water - REAL(kind_phys) GCUT (IJSDIM, NCTP) ! cloud top U - REAL(kind_phys) GCVT (IJSDIM, NCTP) ! cloud top V - REAL(kind_phys) GCLT (IJSDIM, NCTP) ! cloud top cloud water - REAL(kind_phys) GCIT (IJSDIM, NCTP) ! cloud top cloud ice + REAL(kind_phys) GSNWC ( IJSDIM ) ! snowfall + REAL(kind_phys) CUMCLW( IJSDIM, KMAX ) ! cloud water in cumulus + REAL(kind_phys) CUMFRC( IJSDIM ) ! cumulus cloud fraction +!COSP + REAL(kind_phys) QLIQC ( IJSDIM, KMAX ) ! cumulus cloud liquid water [kg/kg] + REAL(kind_phys) QICEC ( IJSDIM, KMAX ) ! cumulus cloud ice [kg/kg] + REAL(kind_phys) GPRCPF( IJSDIM, KMAX ) ! rainfall flux at full level + REAL(kind_phys) GSNWPF( IJSDIM, KMAX ) ! snowfall flux at full level +! + REAL(kind_phys) GTCFRC( IJSDIM, KMAX ) ! change in cloud fraction + REAL(kind_phys) FLIQC ( IJSDIM, KMAX ) ! liquid ratio in cumulus +! +!#ifdef OPT_CHASER +! REAL(kind_phys) RFXC ( IJSDIM, KMAX+1 ) ! precipi. flx [kg/m2/s] +! REAL(kind_phys) SFXC ( IJSDIM, KMAX+1 ) ! ice/snow flx [kg/m2/s] +! INTEGER LEVCUM( IJSDIM, KMAX ) ! flag for cum. cloud top +! REAL(kind_phys) LNFRC ( IJSDIM, KMAX ) ! areal rates of clouds +! REAL(kind_phys) REVC ( IJSDIM, KMAX ) ! evaporation rates +!#endif +! + REAL(kind_phys) GDCFRC( IJSDIM, KMAX ) ! cloud fraction +! +! REAL(kind_phys) GTQL ( IJSDIM, KMAX ) ! tendency of cloud liquid +! + REAL(kind_phys) GDW ( IJSDIM, KMAX ) ! total water + REAL(kind_phys) GDQS ( IJSDIM, KMAX ) ! saturate moisture + REAL(kind_phys) FDQS ( IJSDIM, KMAX ) + REAL(kind_phys) GAM ( IJSDIM, KMAX ) + REAL(kind_phys) GDS ( IJSDIM, KMAX ) ! dry static energy + REAL(kind_phys) GDH ( IJSDIM, KMAX ) ! moist static energy + REAL(kind_phys) GDHS ( IJSDIM, KMAX ) ! saturate MSE +! + REAL(kind_phys) GCYM ( IJSDIM, KMAX, NCTP ) ! norm. mass flux (half lev) + REAL(kind_phys) GCHB ( IJSDIM ) ! cloud base MSE-Li*Qi + REAL(kind_phys) GCWB ( IJSDIM ) ! cloud base total water + REAL(kind_phys) GCtrB ( IJSDIM, ntrq:ntr ) ! cloud base water vapor tracer + REAL(kind_phys) GCUB ( IJSDIM ) ! cloud base U + REAL(kind_phys) GCVB ( IJSDIM ) ! cloud base V + REAL(kind_phys) GCIB ( IJSDIM ) ! cloud base ice + REAL(kind_phys) ELAM ( IJSDIM, KMAX, NCTP ) ! entrainment (rate*massflux) + REAL(kind_phys) GCYT ( IJSDIM, NCTP ) ! norm. mass flux @top + REAL(kind_phys) GCHT ( IJSDIM, NCTP ) ! cloud top MSE + REAL(kind_phys) GCQT ( IJSDIM, NCTP ) ! cloud top q + REAL(kind_phys) GCwT ( IJSDIM ) ! cloud top total water + REAL(kind_phys) GCUT ( IJSDIM, NCTP ) ! cloud top U + REAL(kind_phys) GCVT ( IJSDIM, NCTP ) ! cloud top V + REAL(kind_phys) GCLT ( IJSDIM, NCTP ) ! cloud top cloud water + REAL(kind_phys) GCIT ( IJSDIM, NCTP ) ! cloud top cloud ice REAL(kind_phys) GCtrT (IJSDIM, ntrq:ntr, NCTP) ! cloud top tracer - REAL(kind_phys) GTPRT (IJSDIM, NCTP) ! precipitation/M - REAL(kind_phys) GCLZ (IJSDIM, KMAX) ! cloud liquid for each CTP - REAL(kind_phys) GCIZ (IJSDIM, KMAX) ! cloud ice for each CTP - -! REAL(kind_phys) ACWF (IJSDIM, NCTP) ! cloud work function - REAL(kind_phys) ACWF (IJSDIM ) ! cloud work function - REAL(kind_phys) GPRCIZ(IJSDIM, KMAX) ! precipitation - REAL(kind_phys) GSNWIZ(IJSDIM, KMAX) ! snowfall - REAL(kind_phys) GTPRC0(IJSDIM) ! precip. before evap. - - REAL(kind_phys) GMFLX (IJSDIM, KMAX) ! mass flux (updraft+downdraft) - REAL(kind_phys) QLIQ (IJSDIM, KMAX) ! total cloud liquid - REAL(kind_phys) QICE (IJSDIM, KMAX) ! total cloud ice - REAL(kind_phys) GPRCI (IJSDIM, KMAX) ! rainfall generation - REAL(kind_phys) GSNWI (IJSDIM, KMAX) ! snowfall generation - - REAL(kind_phys) GPRCP (IJSDIM, KMAX) ! rainfall flux -! - REAL(kind_phys) GTEVP (IJSDIM, KMAX) ! evaporation+sublimation - REAL(kind_phys) GMDD (IJSDIM, KMAX) ! downdraft mass flux - -! REAL(kind_phys) CUMHGT(IJSDIM, NCTP) ! cloud top height -! REAL(kind_phys) CTOPP (IJSDIM) ! cloud top pressure - - REAL(kind_phys) GDZTR (IJSDIM) ! tropopause height -! REAL(kind_phys) FLIQOU(IJSDIM, KMAX) ! liquid ratio in cumulus - INTEGER KB (IJSDIM) - INTEGER KSTRT (IJSDIM) ! tropopause level - REAL(kind_phys) GAMX - REAL(kind_phys) CIN (IJSDIM) - INTEGER JBUOY (IJSDIM) - REAL(kind_phys) DELZ, BUOY, DELWC, DELER - REAL(kind_phys) WCBX (IJSDIM) -! REAL(kind_phys) ERMR (NCTP) ! entrainment rate (ASMODE) -! SAVE ERMR - INTEGER KTMX (NCTP) ! max of cloud top - INTEGER KTMXT ! max of cloud top -! REAL(kind_phys) TIMED - REAL(kind_phys) GDCLDX, GDMU2X, GDMU3X -! -! REAL(kind_phys) HBGT (IJSDIM) ! imbalance in column heat -! REAL(kind_phys) WBGT (IJSDIM) ! imbalance in column water + REAL(kind_phys) GTPRT ( IJSDIM, NCTP ) ! precipitation/M + REAL(kind_phys) GCLZ ( IJSDIM, KMAX ) ! cloud liquid for each CTP + REAL(kind_phys) GCIZ ( IJSDIM, KMAX ) ! cloud ice for each CTP + + REAL(kind_phys) ACWF ( IJSDIM ) ! cloud work function + REAL(kind_phys) GPRCIZ( IJSDIM, KMAX+1, NCTP ) ! precipitation + REAL(kind_phys) GSNWIZ( IJSDIM, KMAX+1, NCTP ) ! snowfall + REAL(kind_phys) GTPRC0( IJSDIM ) ! precip. before evap. + + REAL(kind_phys) GMFLX ( IJSDIM, KMAX+1 ) ! mass flux (updraft+downdraft) + REAL(kind_phys) QLIQ ( IJSDIM, KMAX ) ! total cloud liquid + REAL(kind_phys) QICE ( IJSDIM, KMAX ) ! total cloud ice + REAL(kind_phys) GPRCI ( IJSDIM, KMAX ) ! rainfall generation + REAL(kind_phys) GSNWI ( IJSDIM, KMAX ) ! snowfall generation + + REAL(kind_phys) GPRCP ( IJSDIM, KMAX+1 ) ! rainfall flux +! + REAL(kind_phys) GTEVP ( IJSDIM, KMAX ) ! evaporation+sublimation + REAL(kind_phys) GMDD ( IJSDIM, KMAX+1 ) ! downdraft mass flux + + REAL(kind_phys) CUMHGT( IJSDIM, NCTP ) ! cloud top height + REAL(kind_phys) CTOPP ( IJSDIM ) ! cloud top pressure + + REAL(kind_phys) GDZTR ( IJSDIM ) ! tropopause height + REAL(kind_phys) FLIQOU( IJSDIM, KMAX ) ! liquid ratio in cumulus +!#ifdef OPT_CHASER +! REAL(kind_phys) TOPFLX( IJSDIM, NCTP ) !! flux at each cloud top +!#endif + INTEGER KB ( IJSDIM ) + INTEGER KSTRT ( IJSDIM ) ! tropopause level + REAL(kind_phys) GAMX + REAL(kind_phys) CIN ( IJSDIM ) + INTEGER JBUOY ( IJSDIM ) + REAL(kind_phys) DELZ, BUOY, DELWC, DELER +!M REAL(kind_phys) WCB ( NCTP ) ! updraft velocity**2 @base +!M SAVE WCB + REAL(kind_phys) WCBX (IJSDIM) +! REAL(kind_phys) ERMR ( NCTP ) ! entrainment rate (ASMODE) +! SAVE ERMR + INTEGER KTMX ( NCTP ) ! max of cloud top + INTEGER KTMXT ! max of cloud top + REAL(kind_phys) TIMED + REAL(kind_phys) GDCLDX, GDMU2X, GDMU3X +! + LOGICAL OOUT1, OOUT2 + INTEGER KBMX, I, K, CTP, ierr, n, kp1, l, l1, kk, kbi, kmi, km1 + real(kind_phys) tem1, tem2, tem3, cbmfl, mflx_e, teme, tems + + REAL(kind_phys) HBGT ( IJSDIM ) ! imbalance in column heat + REAL(kind_phys) WBGT ( IJSDIM ) ! imbalance in column water -!DDsigma begin local work variables - all on model interfaces (sfc=1) - REAL(kind_phys) lamdai ! lamda for cloud type ctp - REAL(kind_phys) gdqm, gdlm, gdim ! water vapor + !DDsigma begin local work variables - all on model interfaces (sfc=1) + REAL(kind_phys) lamdai( IJSDIM, KMAX+1, nctp ) ! lamda for cloud type ctp + REAL(kind_phys) lamdaprod( IJSDIM, KMAX+1 ) ! product of (1+lamda) through cloud type ctp + REAL(kind_phys) gdrhom ! density + REAL(kind_phys) gdtvm ! virtual temperature + REAL(kind_phys) gdqm, gdwm,gdlm, gdim ! water vaper REAL(kind_phys) gdtrm(ntrq:ntr) ! tracer - -! the following are new arguments to cumup to get them out for AW - REAL(kind_phys) wcv (IJSDIM, KMAX) ! in-cloud vertical velocity - REAL(kind_phys) GCTM (IJSDIM, KMAX) ! cloud T (half lev) !DDsigmadiag make output - REAL(kind_phys) GCQM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GCwM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GCiM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GClM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GChM (IJSDIM, KMAX) ! cloud q (half lev) !DDsigmadiag make output + character(len=4) :: cproc !DDsigmadiag + + ! the following are new arguments to cumup to get them out + REAL(kind_phys) wcv( IJSDIM, KMAX+1, nctp) ! in-cloud vertical velocity + REAL(kind_phys) GCTM ( IJSDIM, KMAX+1 ) ! cloud T (half lev) !DDsigmadiag make output + REAL(kind_phys) GCQM ( IJSDIM, KMAX+1, nctp ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GCwM ( IJSDIM, KMAX+1, nctp ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GCiM ( IJSDIM, KMAX+1 ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GClM ( IJSDIM, KMAX+1 ) ! cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GChM ( IJSDIM, KMAX+1, nctp ) ! cloud q (half lev) !DDsigmadiag make output REAL(kind_phys) GCtrM (IJSDIM, KMAX, ntrq:ntr) ! cloud tracer (half lev) !DDsigmadiag make output - -! eddy flux profiles for dse, water vapor, cloud water, cloud ice - REAL(kind_phys), dimension(Kmax+1) :: sfluxtem, qvfluxtem, qlfluxtem, qifluxtem - REAL(kind_phys), dimension(Kmax+1,ntrq:ntr) :: trfluxtem ! tracer - -! tendency profiles - condensation heating, condensation moistening, heating due to -! freezing, total precip production, frozen precip production - REAL(kind_phys), dimension(ijsdim,Kmax) :: dtcondtem, dqcondtem, dtfrztem, dqprectem,& ! Moorthi - dfrzprectem, lamdaprod !< product of (1+lamda) through cloud type ctp - REAL(kind_phys), dimension(ijsdim,Kmax) :: dtevap, dqevap, dtmelt, dtsubl - -! factor to modify precip rate to force conservation of water. With bug fixes it's -! not doing anything now. - REAL(kind_phys), dimension(ijsdim) :: moistening_aw - real(kind_phys), dimension(ijsdim,kmax) :: gctbl, gcqbl,gcwbl, gcqlbl, gcqibl, & !DDsigmadiag updraft profiles below cloud Base - sigmad ! downdraft area fraction + +! these are the fluxes at the interfaces - AW will operate on them + REAL(kind_phys), dimension(ijsdim,Kmax+1,nctp) :: sfluxtem, qvfluxtem, qlfluxtem, qifluxtem + REAL(kind_phys), dimension(ijsdim,Kmax+1,ntrq:ntr,nctp) :: trfluxtem ! tracer + + REAL(kind_phys), dimension(ijsdim,Kmax+1) :: dtcondtem, dqcondtem, dtfrztem, dqprectem,dfrzprectem + REAL(kind_phys), dimension(ijsdim,Kmax) :: dtevap, dqevap, dtmelt, dtsubl + REAL(kind_phys), dimension(ijsdim) :: moistening_aw + real(kind_phys) rhs_q, rhs_h, sftem, qftem, qlftem, qiftem + real(kind_phys), dimension(ijsdim,kmax+1) :: gctbl, gcqbl,gcwbl, gcqlbl, gcqibl !DDsigmadiag updraft profiles below cloud Base real(kind_phys), dimension(ijsdim,kmax,ntrq:ntr) :: gctrbl !DDsigmadiag tracer updraft profiles below cloud Base -! rhs_q, rhs_h are residuals of condensed water, MSE budgets to compute condensation, -! and heating due to freezing - real(kind_phys) :: rhs_q, rhs_h, fsigma, sigmai, delpinv -! real(kind_phys) :: rhs_q, rhs_h, sftem, qftem, qlftem, qiftem, & -! fsigma ! factor to reduce mass flux terms (1-sigma**2) for AW -!DDsigma end local work variables -! -! profiles of heating due to precip evaporation, melting and sublimation, and the -! evap, melting and sublimation rates. - - REAL(kind_phys), allocatable, dimension(:,:) :: dtdwn, & ! t tendency downdraft detrainment - dqvdwn, & ! qv tendency downdraft detrainment - dqldwn, & ! ql tendency downdraft detrainment - dqidwn ! qi tendency downdraft detrainment - REAL(kind_phys), allocatable, dimension(:,:,:) :: dtrdwn ! tracer tendency downdraft detrainment - + real(kind_phys), dimension(ijsdim,kmax+1) :: sigmad + real(kind_phys) :: fsigma( IJSDIM, KMAX+1 ) ! factor to reduce mass flux terms (1-sigma**2) for AW + real(kind_phys) :: lamdamax ! for sorting lamda values + integer loclamdamax + real(kind_phys) :: pr_tot, pr_ice, pr_liq !DDsigma end local work variables ! ! [INTERNAL PARM] - REAL(kind_phys), parameter :: WCBMIN = zero ! min. of updraft velocity at cloud base - + REAL(kind_phys) :: WCBMIN = 0._kind_phys ! min. of updraft velocity at cloud base !M REAL(kind_phys) :: WCBMAX = 1.4_kind_phys ! max. of updraft velocity at cloud base !M wcbas commented by Moorthi since it is not used !M REAL(kind_phys) :: WCBAS = 2._kind_phys ! updraft velocity**2 at cloud base (ASMODE) @@ -791,22 +809,35 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! used only in OPT_ASMODE !M REAL(kind_phys) :: ERAMAX = 2.e-3_kind_phys ! max. of entrainment rate ! used only in OPT_ASMODE - LOGICAL :: OINICB = .false. ! set 0.d0 to CBMFX when .true. +! downdraft mass flux terms now slot nctp+1 in the *fluxterm arrays + REAL(kind_phys) dtdwn ( IJSDIM, KMAX ) ! t tendency downdraft detrainment + REAL(kind_phys) dqvdwn ( IJSDIM, KMAX ) ! qv tendency downdraft detrainment + REAL(kind_phys) dqldwn ( IJSDIM, KMAX ) ! ql tendency downdraft detrainment + REAL(kind_phys) dqidwn ( IJSDIM, KMAX ) ! qi tendency downdraft detrainment + REAL(kind_phys), dimension(ijsdim,kmax,ntrq:ntr) :: dtrdwn ! tracer tendency downdraft detrainment + + LOGICAL :: OINICB = .false. ! set 0.d0 to CBMFX -! REAL(kind_phys) :: VARMIN = 1.e-13_kind_phys ! minimum of PDF variance -! REAL(kind_phys) :: VARMAX = 5.e-7_kind_phys ! maximum of PDF variance -! REAL(kind_phys) :: SKWMAX = 0.566_kind_phys ! maximum of PDF skewness + REAL(kind_phys) :: VARMIN = 1.e-13_kind_phys ! minimum of PDF variance + REAL(kind_phys) :: VARMAX = 5.e-7_kind_phys ! maximum of PDF variance + REAL(kind_phys) :: SKWMAX = 0.566_kind_phys ! maximum of PDF skewness - REAL(kind_phys) :: PSTRMX = 400.e2_kind_phys ! max P of tropopause - REAL(kind_phys) :: PSTRMN = 50.e2_kind_phys ! min P of tropopause - REAL(kind_phys) :: GCRSTR = 1.e-4_kind_phys ! crit. dT/dz tropopause + REAL(kind_phys) :: PSTRMX = 400.e2_kind_phys ! max P of tropopause + REAL(kind_phys) :: PSTRMN = 50.e2_kind_phys ! min P of tropopause + REAL(kind_phys) :: GCRSTR = 1.e-4_kind_phys ! crit. dT/dz tropopause - real(kind=kind_phys) :: tem, esat, mflx_e, cbmfl, tem1, tem2, tem3 - INTEGER :: KBMX, I, K, CTP, ierr, n, kp1, km1, kk, kbi, l, l1 + ! 0: mass fixer is not applied + ! tracers which may become negative values + ! e.g. subgrid-PDFs + ! 1: mass fixer is applied, total mass may change through cumulus scheme + ! e.g. moisture, liquid cloud, ice cloud, aerosols + ! 2: mass fixer is applied, total mass never change through cumulus scheme + ! e.g. CO2 + real(kind=kind_phys), parameter :: zero=0.0, one=1.0 + real(kind=kind_phys) :: tem, esat ! - LOGICAL, SAVE :: OFIRST = .TRUE. ! called first time? + LOGICAL, SAVE :: OFIRST = .TRUE. ! called first time? ! - IF (OFIRST) THEN OFIRST = .FALSE. IF (OINICB) THEN @@ -814,6 +845,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ENDIF ENDIF ! + + kp1 = kmax + 1 do n=1,ntr do k=1,kmax do i=1,ijsdim @@ -821,65 +854,82 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions enddo enddo enddo - + do k=1,kmax+1 + do i=1,ijsdim + gmflx(i,k) = zero + gmfx0(i,k) = zero + enddo + enddo do k=1,kmax do i=1,ijsdim - gtt(i,k) = zero - gtu(i,k) = zero - gtv(i,k) = zero - gmflx(i,k) = zero - gmfx0(i,k) = zero - gprci(i,k) = zero - gsnwi(i,k) = zero - qliq(i,k) = zero - qice(i,k) = zero -! gtcfrc(i,k) = zero -! cumclw(i,k) = zero -! fliqc(i,k) = zero - sigma(i,k) = zero + gtt(i,k) = zero + gtu(i,k) = zero + gtv(i,k) = zero + gprci(i,k) = zero + gsnwi(i,k) = zero + qliq(i,k) = zero + qice(i,k) = zero +! gtcfrc(i,k) = zero +! cumclw(i,k) = zero +! fliqc(i,k) = zero + fliqou(i,k) = zero + gprcpf(i,k) = zero + gsnwpf(i,k) = zero + cmdet(i,k) = zero enddo enddo if (flx_form) then - allocate(sfluxterm(ijsdim,kmax), qvfluxterm(ijsdim,kmax), qlfluxterm(ijsdim,kmax), & - qifluxterm(ijsdim,kmax), condtermt(ijsdim,kmax), condtermq(ijsdim,kmax), & - frzterm(ijsdim,kmax), prectermq(ijsdim,kmax), prectermfrz(ijsdim,kmax), & - dtdwn(ijsdim,kmax), dqvdwn(ijsdim,kmax), dqldwn(ijsdim,kmax), & - dqidwn(ijsdim,kmax), trfluxterm(ijsdim,kmax,ntrq:ntr), & - dtrdwn(ijsdim,kmax,ntrq:ntr)) - do k=1,kmax - do i=1,ijsdim - sfluxterm(i,k) = zero - qvfluxterm(i,k) = zero - qlfluxterm(i,k) = zero - qifluxterm(i,k) = zero - condtermt(i,k) = zero - condtermq(i,k) = zero - frzterm(i,k) = zero - prectermq(i,k) = zero - prectermfrz(i,k) = zero - dtdwn(i,k) = zero - dqvdwn(i,k) = zero - dqldwn(i,k) = zero - dqidwn(i,k) = zero - cmdet(i,k) = zero + do ctp = 1,nctp + do k=1,kp1 + do i=1,ijsdim + sfluxtem(i,k,ctp) = zero + qvfluxtem(i,k,ctp) = zero + qlfluxtem(i,k,ctp) = zero + qifluxtem(i,k,ctp) = zero + enddo + enddo + do n = ntrq,ntr + do k=1,kp1 + do i=1,ijsdim + trfluxtem(i,k,n,ctp) = zero + enddo + enddo enddo enddo - do n = ntrq,ntr do k=1,kmax do i=1,ijsdim - trfluxterm(i,k,n) = zero - dtrdwn(i,k,n) = zero + condtermt(i,k) = zero + condtermq(i,k) = zero + frzterm(i,k) = zero + prectermq(i,k) = zero + prectermfrz(i,k) = zero enddo enddo - enddo + do k=1,kmax + do i=1,ijsdim + dtdwn(i,k) = zero + dqvdwn(i,k) = zero + dqldwn(i,k) = zero + dqidwn(i,k) = zero + enddo + enddo + do n = ntrq,ntr + do k=1,kmax + do i=1,ijsdim + dtrdwn(i,k,n) = zero + enddo + enddo + enddo endif do i=1,ijsdim -! gprcc(i,:) = zero - gtprc0(i) = zero -! hbgt(i) = zero -! wbgt(i) = zero - gdztr(i) = zero - kstrt(i) = kmax +! gprcc(i,:) = zero +! gmflx(i,kp1) = zero + gmfx0(i,kp1) = zero + gtprc0(i) = zero +! hbgt(i) = zero +! wbgt(i) = zero + gdztr(i) = zero + kstrt(i) = kmax enddo do k=1,kmax @@ -907,9 +957,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! !> -# Compute tropopause height (GDZTR) DO K=1,KMAX - kp1 = k + 1 DO I=ISTS,IENS - GAMX = (GDTM(I,KP1)-GDTM(I,K)) / (GDZM(I,KP1)-GDZM(I,K)) + GAMX = (GDTM(I,K+1)-GDTM(I,K)) / (GDZM(I,K+1)-GDZM(I,K)) IF ((GDP(I,K) < PSTRMX .AND. GAMX > GCRSTR) .OR. GDP(I,K) < PSTRMN) THEN KSTRT(I) = MIN(K, KSTRT(I)) ENDIF @@ -925,12 +974,12 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Call cumbas() to compute cloud base properties CALL CUMBAS(IJSDIM, KMAX , & !DD dimensions - KB , GCYM(1,1,1) , KBMX , & ! output + KB , GCYM(:,:,1) , KBMX , & ! output ntr , ntrq , & GCHB , GCWB , GCUB , GCVB , & ! output GCIB , gctrb, & ! output GDH , GDW , GDHS , GDQS , & ! input - GDQ(1,1,iti) , GDU , GDV , GDZM , & ! input + GDQ(:,:,iti) , GDU , GDV , GDZM , & ! input GDPM , FDQS , GAM , & ! input lprnt, ipr, & ISTS , IENS , & !) ! input @@ -955,7 +1004,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) JBUOY(I) = 2 ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN - CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) + CIN(I) = CIN(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) JBUOY(I) = -1 ENDIF endif @@ -968,12 +1017,25 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !DDsigma some initialization before summing over cloud type !> -# Initialize variables before summing over cloud types - do k=1,kmax ! Moorthi + if(flx_form) then + do k=1,kp1 ! Moorthi do i=1,ijsdim lamdaprod(i,k) = one + sigma(i,k) = 0.0 enddo enddo + do ctp=1,nctp + do k=1,kp1 + do i=1,ijsdim + lamdai(i,k,ctp) = zero + sigmai(i,k,ctp) = zero + vverti(i,k,ctp) = zero + enddo + enddo + enddo + endif + do ctp=2,nctp do k=1,kmax do i=1,ijsdim @@ -990,15 +1052,6 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions WCBX(I) = DELWC * DELWC enddo - do k=1,kmax ! Moorthi - do i=1,ijsdim - dqcondtem(i,k) = zero - dqprectem(i,k) = zero - dfrzprectem(i,k) = zero - dtfrztem(i,k) = zero - dtcondtem(i,k) = zero - enddo - enddo ! getting more incloud profiles of variables to compute eddy flux tendencies ! and condensation rates @@ -1010,51 +1063,48 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Call cumup() to compute in-cloud properties CALL CUMUP(IJSDIM, KMAX, NTR, ntrq, & !DD dimensions ACWF , & ! output - GCLZ , GCIZ , GPRCIZ , GSNWIZ, & ! output - GCYT(1,CTP) , GCHT(1,CTP) , GCQT (1,CTP), & ! output - GCLT(1,CTP) , GCIT(1,CTP) , GTPRT(1,CTP), & ! output - GCUT(1,CTP) , GCVT(1,CTP) , gctrt(1,ntrq:ntr,ctp), & ! output - KT (1,CTP) , KTMX(CTP) , & ! output - GCYM(1,1,CTP) , & ! modified - wcv , & ! !DD-sigma new output + GCLZ , GCIZ , GPRCIZ(:,:,CTP), GSNWIZ(:,:,CTP), & ! output + GCYT(:,CTP) , GCHT(:,CTP) , GCQT (:,CTP), & ! output + GCLT(:,CTP) , GCIT(:,CTP) , GTPRT(:,CTP), & ! output + GCUT(:,CTP) , GCVT(:,CTP) , gctrt(:,ntrq:ntr,ctp), & ! output + KT (:,CTP) , KTMX(CTP) , & ! output + GCYM(:,:,CTP) , & ! modified + wcv(:,:,CTP) , & ! !DD-sigma new output GCHB , GCWB , GCUB , GCVB , & ! input !DDsigmadiag GCIB , gctrb , & ! input GDU , GDV , GDH , GDW , & ! input GDHS , GDQS , GDT , GDTM , & ! input - GDQ , GDQ(1,1,iti) , GDZ , GDZM , & ! input + GDQ , GDQ(:,:,iti) , GDZ , GDZM , & ! input GDPM , FDQS , GAM , GDZTR , & ! input CPRES , WCBX , & ! input KB , CTP , ISTS , IENS , & ! input - gctm , gcqm, gcwm, gchm, gcwt, gclm, gcim, gctrm, & ! additional incloud profiles and cloud top total water + gctm , gcqm(:,:,CTP), gcwm(:,:,CTP), gchm(:,:,CTP),& + gcwt, gclm, gcim, gctrm, & ! additional incloud profiles and cloud top total water lprnt , ipr ) ! !> -# Call cumbmx() to compute cloud base mass flux CALL CUMBMX(IJSDIM, KMAX, & !DD dimensions - CBMFX(1,CTP), & ! modified - ACWF , GCYT(1,CTP), GDZM , & ! input + CBMFX(:,CTP), & ! modified + ACWF , GCYT(:,CTP), GDZM , & ! input GDW , GDQS , DELP , & ! input - KT (1,CTP), KTMX(CTP) , KB , & ! input + KT (:,CTP), KTMX(CTP) , KB , & ! input DELTI , ISTS , IENS ) !DDsigma - begin sigma computation ! At this point cbmfx is updated and we have everything we need to compute sigma - do i=ISTS,IENS - if (flx_form) then -!> -# Initialize eddy fluxes for cloud types - do k=1,kmax+1 - sfluxtem(k) = zero - qvfluxtem(k) = zero - qlfluxtem(k) = zero - qifluxtem(k) = zero - enddo - do n=ntrq,ntr ! tracers - do k=1,kmax+1 - trfluxtem(k,n) = zero - enddo + if (flx_form) then + do k=1,kmax + 1 ! Moorthi + do i=1,ijsdim + dqcondtem(i,k) = zero + dqprectem(i,k) = zero + dfrzprectem(i,k) = zero + dtfrztem(i,k) = zero + dtcondtem(i,k) = zero enddo - endif + enddo + do i=ISTS,IENS cbmfl = cbmfx(i,ctp) kk = kt(i,ctp) ! cloud top index @@ -1062,56 +1112,54 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions kbi = kb(i) ! cloud base index do k=kbi,kk ! loop from cloud base to cloud top km1 = k - 1 - rhs_h = zero - rhs_q = zero -!> -# Interpolate environment variables to layer interface +! get environment variables interpolated to layer interface GDQM = half * (GDQ(I,K,1) + GDQ(I,KM1,1)) ! as computed in cumup ! GDwM = half * (GDw(I,K) + GDw(I,KM1 )) - GDlM = half * (GDQ(I,K,3) + GDQ(I,KM1,3)) - GDiM = half * (GDQ(I,K,2) + GDQ(I,KM1,2)) + GDlM = half * (GDQ(I,K,itl) + GDQ(I,KM1,itl)) + GDiM = half * (GDQ(I,K,iti) + GDQ(I,KM1,iti)) do n = ntrq,NTR GDtrM(n) = half * (GDQ(I,K,n) + GDQ(I,KM1,n)) ! as computed in cumup enddo mflx_e = gcym(i,k,ctp) * cbmfl ! mass flux at level k for cloud ctp - if (do_aw) then !> -# Compute lamda for a cloud type and then updraft area fraction !! (sigmai) following Equations 23 and 12 of !! Arakawa and Wu (2013) \cite arakawa_and_wu_2013 , respectively - lamdai = mflx_e * rair * gdtm(i,k)*(one+epsvt*gdqm) & - / (gdpm(i,k)*wcv(i,k)) - lamdaprod(i,k) = lamdaprod(i,k) * (one+lamdai) - -! vverti(i,k,ctp) = wcv(i,k) -! sigmai(i,k,ctp) = lamdai / lamdaprod(i,k) -! sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,ctp))) - - sigmai = lamdai / lamdaprod(i,k) - sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai)) - vverti(i,k,ctp) = sigmai * wcv(i,k) - else - sigma(i,k) = 0.0 - endif + lamdai(i,k,ctp) = mflx_e * rair * gdtm(i,k)*(one+epsvt*gdqm) & + / (gdpm(i,k)*wcv(i,k,ctp)) + +! just compute lamdai here, we will compute sigma, sigmai, and vverti outside +! the cloud type loop after we can sort lamdai +! lamdaprod(i,k) = lamdaprod(i,k) * (one+lamdai(i,k,ctp)) +! +!! vverti(i,k,ctp) = wcv(i,k) +!! sigmai(i,k,ctp) = lamdai / lamdaprod(i,k) +!! sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,ctp))) +! +! sigmai(i,k,ctp) = lamdai(i,k,ctp) / lamdaprod(i,k) +! sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,ctp))) +! vverti(i,k,ctp) = sigmai(i,k,ctp) * wcv(i,k,ctp) - if (flx_form) then +! sigma effect won't be applied until later, when lamda is sorted ! fsigma = 1.0 ! no aw effect, comment following lines to undo AW - fsigma = one - sigma(i,k) +! fsigma = one - sigma(i,k) !> -# Compute tendencies based on mass flux and condensation ! fsigma is the AW reduction of flux tendencies if(k == kbi) then do l=2,kbi ! compute eddy fluxes below cloud base - tem = - fsigma * gcym(i,l,ctp) * cbmfl +! tem = - fsigma * gcym(i,l,ctp) * cbmfl + tem = - gcym(i,l,ctp) * cbmfl ! first get environment variables at layer interface l1 = l - 1 GDQM = half * (GDQ(I,l,1) + GDQ(I,l1,1)) - GDlM = half * (GDQ(I,l,3) + GDQ(I,l1,3)) - GDiM = half * (GDQ(I,l,2) + GDQ(I,l1,2)) + GDlM = half * (GDQ(I,l,itl) + GDQ(I,l1,itl)) + GDiM = half * (GDQ(I,l,iti) + GDQ(I,l1,iti)) !! GDwM = half * (GDw(I,l) + GDw(I,l1)) do n = ntrq,NTR GDtrM(n) = half * (GDQ(I,l,n) + GDQ(I,l1,n)) ! as computed in cumup @@ -1119,12 +1167,12 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! flux = mass flux * (updraft variable minus environment variable) !centered differences - sfluxtem(l) = tem * (gdtm(i,l)-gctbl(i,l)) - qvfluxtem(l) = tem * (gdqm-gcqbl(i,l)) - qlfluxtem(l) = tem * (gdlm-gcqlbl(i,l)) - qifluxtem(l) = tem * (gdim-gcqibl(i,l)) + sfluxtem(i,l,ctp) = tem * (gdtm(i,l)-gctbl(i,l)) + qvfluxtem(i,l,ctp) = tem * (gdqm-gcqbl(i,l)) + qlfluxtem(i,l,ctp) = tem * (gdlm-gcqlbl(i,l)) + qifluxtem(i,l,ctp) = tem * (gdim-gcqibl(i,l)) do n = ntrq,NTR - trfluxtem(l,n) = tem * (gdtrm(n)-gctrbl(i,l,n)) + trfluxtem(i,l,n,ctp) = tem * (gdtrm(n)-gctrbl(i,l,n)) enddo ! if(lprnt .and. i == ipr) write(0,*)' l=',l,' kbi=',kbi,' tem =', tem,' trfluxtem=',trfluxtem(l,ntr),& ! ' gdtrm=',gdtrm(ntr),' gctrbl=',gctrbl(i,l,ntr),' gq=',GDQ(I,l,ntr),GDQ(I,l1,ntr),' l1=',l1,' ctp=',ctp,& @@ -1146,14 +1194,15 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions else ! flux = mass flux * (updraft variable minus environment variable) - tem = - fsigma * mflx_e +! tem = - fsigma * mflx_e + tem = - mflx_e !centered - sfluxtem(k) = tem * (gdtm(i,k)+gocp*gdzm(i,k)-gctm(i,k)) - qvfluxtem(k) = tem * (gdqm-gcqm(i,k)) - qlfluxtem(k) = tem * (gdlm-gclm(i,k)) - qifluxtem(k) = tem * (gdim-gcim(i,k)) + sfluxtem(i,k,ctp) = tem * (gdtm(i,k)+gocp*gdzm(i,k)-gctm(i,k)) + qvfluxtem(i,k,ctp) = tem * (gdqm-gcqm(i,k,ctp)) + qlfluxtem(i,k,ctp) = tem * (gdlm-gclm(i,k)) + qifluxtem(i,k,ctp) = tem * (gdim-gcim(i,k)) do n = ntrq,NTR - trfluxtem(k,n) = tem * (gdtrm(n)-gctrm(i,k,n)) + trfluxtem(i,k,n,ctp) = tem * (gdtrm(n)-gctrm(i,k,n)) enddo !upstream - This better matches what the original CS tendencies do @@ -1185,117 +1234,57 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ! ' fsigma=',fsigma,' mflx_e=',mflx_e,' trfluxtemk=',trfluxtem(k,ntr),' sigma=',sigma(i,k) -! the condensation terms - these come from the MSE and condensed water budgets for -! an entraining updraft -! if(k > kb(i)) then ! comment for test -! if(k <= kk) then ! Moorthi -! if(k < kt(i,ctp)) then -! rhs_h = cbmfl*(gcym(i,k)*gchm(i,k) - (gcym(i,km1)*gchm(i,km1) & -! + GDH(I,Km1 )*(gcym(i,k)-gcym(i,km1))) ) -! rhs_q = cbmfl*(gcym(i,k)*(gcwm(i,k)-gcqm(i,k)) & -! - (gcym(i,km1)*(gcwm(i,km1)-gcqm(i,km1)) & -! + (GDw( I,Km1 )-gdq(i,km1,1))*(gcym(i,k)-gcym(i,km1))) ) -! tem = cbmfl * (one - sigma(i,k)) - tem = cbmfl * (one - 0.5*(sigma(i,k)+sigma(i,km1))) - tem1 = gcym(i,k,ctp) * (one - sigma(i,k)) - tem2 = gcym(i,km1,ctp) * (one - sigma(i,km1)) - rhs_h = cbmfl * (tem1*gchm(i,k) - (tem2*gchm(i,km1) & - + GDH(I,Km1)*(tem1-tem2)) ) - rhs_q = cbmfl * (tem1*(gcwm(i,k)-gcqm(i,k)) & - - (tem2*(gcwm(i,km1)-gcqm(i,km1)) & - + (GDw(I,Km1)-gdq(i,km1,1))*(tem1-tem2)) ) - -! ELSE -! rhs_h = cbmfl*(gcht(i,ctp) - (gcym(i,k-1)*gchm(i,k-1) + GDH( I,K-1 )*(gcyt(i,ctp)-gcym(i,k-1))) ) -! rhs_q = cbmfl*((gcwt(i)-gcqt(i,ctp)) - (gcym(i,k-1)*(gcwm(i,k-1)-gcqm(i,k-1)) + (GDw( I,K-1 )-gdq(i,k-1,1))*(gcyt(i,ctp)-gcym(i,k-1))) ) -! endif - -!> -# Compute condensation, total precipitation production, frozen precipitation production, -!! heating due to freezing, and total temperature tendency due to in-cloud microphysics - dqcondtem(i,km1) = -rhs_q ! condensation -! dqprectem(i,km1) = cbmfl * (GPRCIZ(i,k) + GSNWIZ(i,k)) - dqprectem(i,km1) = tem * (GPRCIZ(i,k) + GSNWIZ(i,k)) ! total precip production -! dfrzprectem(i,km1) = cbmfl * GSNWIZ(i,k) - dfrzprectem(i,km1) = tem * GSNWIZ(i,k) ! production of frozen precip - dtfrztem(i,km1) = rhs_h*oneocp ! heating due to freezing - dtcondtem(i,km1) = - elocp * dqcondtem(i,km1) + dtfrztem(i,km1) - endif ! if(k > kbi) then - endif ! if (flx_form) enddo ! end of k=kbi,kk loop endif ! end of if(cbmfl > zero) -! get tendencies by difference of fluxes, sum over cloud type - - if (flx_form) then - do k = 1,kk - delpinv = delpi(i,k) -!> -# Sum single cloud microphysical tendencies over all cloud types - condtermt(i,k) = condtermt(i,k) + dtcondtem(i,k) * delpinv - condtermq(i,k) = condtermq(i,k) + dqcondtem(i,k) * delpinv - prectermq(i,k) = prectermq(i,k) + dqprectem(i,k) * delpinv - prectermfrz(i,k) = prectermfrz(i,k) + dfrzprectem(i,k) * delpinv - frzterm(i,k) = frzterm(i,k) + dtfrztem(i,k) * delpinv - -!> -# Compute flux tendencies and vertical flux divergence - sfluxterm(i,k) = sfluxterm(i,k) - (sfluxtem(k+1) - sfluxtem(k)) * delpinv - qvfluxterm(i,k) = qvfluxterm(i,k) - (qvfluxtem(k+1) - qvfluxtem(k)) * delpinv - qlfluxterm(i,k) = qlfluxterm(i,k) - (qlfluxtem(k+1) - qlfluxtem(k)) * delpinv - qifluxterm(i,k) = qifluxterm(i,k) - (qifluxtem(k+1) - qifluxtem(k)) * delpinv - do n = ntrq,ntr - trfluxterm(i,k,n) = trfluxterm(i,k,n) - (trfluxtem(k+1,n) - trfluxtem(k,n)) * delpinv - enddo -! if (lprnt .and. i == ipr) write(0,*)' k=',k,' trfluxtem=',trfluxtem(k+1,ntr),trfluxtem(k,ntr),& -! ' ctp=',ctp,' trfluxterm=',trfluxterm(i,k,ntr) - enddo - endif ! if (flx_form) enddo ! end of i loop -! - do i=ists,iens - if (cbmfx(i,ctp) > zero) then - tem = one - sigma(i,kt(i,ctp)) - gcyt(i,ctp) = tem * gcyt(i,ctp) - gtprt(i,ctp) = tem * gtprt(i,ctp) - gclt(i,ctp) = tem * gclt(i,ctp) - gcht(i,ctp) = tem * gcht(i,ctp) - gcqt(i,ctp) = tem * gcqt(i,ctp) - gcit(i,ctp) = tem * gcit(i,ctp) - if (.not. flx_form) then - do n = ntrq,ntr - gctrt(i,n,ctp) = tem * gctrt(i,n,ctp) - enddo - end if - gcut(i,ctp) = tem * gcut(i,ctp) - gcvt(i,ctp) = tem * gcvt(i,ctp) - do k=1,kmax - kk = kb(i) - if (k < kk) then - tem = one - sigma(i,kk) - tem1 = tem - else - tem = one - sigma(i,k) - tem1 = one - 0.5*(sigma(i,k)+sigma(i,k-1)) - endif - gcym(i,k,ctp) = tem * gcym(i,k,ctp) - gprciz(i,k) = tem1 * gprciz(i,k) - gsnwiz(i,k) = tem1 * gsnwiz(i,k) - gclz(i,k) = tem1 * gclz(i,k) - gciz(i,k) = tem1 * gciz(i,k) - enddo - endif - enddo + endif ! if (flx_form) +! +! we don't reduce these values in AW, just the tendencies due to fluxes +! do i=ists,iens +! if (cbmfx(i,ctp) > zero) then +! tem = one - sigma(i,kt(i,ctp)) +! gcyt(i,ctp) = tem * gcyt(i,ctp) +! gtprt(i,ctp) = tem * gtprt(i,ctp) +! gclt(i,ctp) = tem * gclt(i,ctp) +! gcht(i,ctp) = tem * gcht(i,ctp) +! gcqt(i,ctp) = tem * gcqt(i,ctp) +! gcit(i,ctp) = tem * gcit(i,ctp) +! do n = ntrq,ntr +! gctrt(i,n,ctp) = tem * gctrt(i,n,ctp) +! enddo +! gcut(i,ctp) = tem * gcut(i,ctp) +! gcvt(i,ctp) = tem * gcvt(i,ctp) +! do k=1,kmax +! kk = kb(i) +! if (k < kk) then +! tem = one - sigma(i,kk) +! tem1 = tem +! else +! tem = one - sigma(i,k) +! tem1 = one - 0.5*(sigma(i,k)+sigma(i,k-1)) +! endif +! gcym(i,k,ctp) = tem * gcym(i,k,ctp) +! gprciz(i,k) = tem1 * gprciz(i,k) +! gsnwiz(i,k) = tem1 * gsnwiz(i,k) +! gclz(i,k) = tem1 * gclz(i,k) +! gciz(i,k) = tem1 * gciz(i,k) +! enddo +! endif +! enddo ! !> -# Call cumflx() to compute cloud mass flux and precipitation CALL CUMFLX(IM , IJSDIM, KMAX , & !DD dimensions GMFX0 , GPRCI , GSNWI , CMDET, & ! output QLIQ , QICE , GTPRC0, & ! output - CBMFX(1,CTP) , GCYM(1,1,ctp), GPRCIZ , GSNWIZ , & ! input - GTPRT(1,CTP) , GCLZ , GCIZ , GCYT(1,ctp),& ! input - KB , KT(1,CTP) , KTMX(CTP) , & ! input + CBMFX(:,CTP) , GCYM(:,:,ctp), GPRCIZ(:,:,CTP), GSNWIZ(:,:,CTP) , & ! input + GTPRT(:,CTP) , GCLZ , GCIZ , GCYT(:,ctp),& ! input + KB , KT(:,CTP) , KTMX(CTP) , & ! input ISTS , IENS ) ! input ENDDO ! end of cloud type ctp loop @@ -1333,46 +1322,127 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions GDH , GDQ , GDU , GDV , & ! input ! GTT , GTQ , GTCFRC, GTU , GTV , & ! modified ! GDH , GDQ , GDCFRC, GDU , GDV , & ! input - CBMFX , GCYT , DELPI , GCHT , GCQT , & ! input - GCLT , GCIT , GCUT , GCVT , GDQ(1,1,iti),& ! input + CBMFX , GCYT , DELPInv , GCHT , GCQT , & ! input + GCLT , GCIT , GCUT , GCVT , GDQ(:,:,iti),& ! input gctrt , & KT , ISTS , IENS, nctp ) ! input endif !for now area fraction of the downdraft is zero, it will be computed -! within cumdwn and applied there -! Get AW downdraft eddy flux and microphysical tendencies out of downdraft code. +! within cumdwn and applied there. So we will get the total sigma now before calling it, +! and apply to the diabatic terms from the updrafts. - do k=1,kmax - do i=ists,iens - sigmad(i,k) = zero - enddo - enddo +! if (do_aw.and.flx_form) then + if (flx_form) then + do k=1,kp1 + do i=ists,iens + lamdamax = maxval(lamdai(i,k,:)) + do while (lamdamax > zero) + loclamdamax = maxloc(lamdai(i,k,:),dim=1) + lamdaprod(i,k) = lamdaprod(i,k) * (one+lamdai(i,k,loclamdamax)) + sigmai(i,k,loclamdamax) = lamdai(i,k,loclamdamax) / lamdaprod(i,k) + sigma(i,k) = max(zero, min(one, sigma(i,k) + sigmai(i,k,loclamdamax))) + vverti(i,k,loclamdamax) = sigmai(i,k,loclamdamax) * wcv(i,k,loclamdamax) + + ! make this lamdai negative so it won't be counted again + lamdai(i,k,loclamdamax) = -lamdai(i,k,loclamdamax) + ! get new lamdamax + lamdamax = maxval(lamdai(i,k,:)) + enddo + ! restore original values of lamdai + lamdai(i,k,:) = abs(lamdai(i,k,:)) +! write(6,'(i2,14f7.4)') k,sigmai(i,k,:) + enddo + enddo + endif + +! the condensation terms - these come from the MSE and condensed water budgets for +! an entraining updraft + if(flx_form) then + DO CTP=1,NCTP ! loop over cloud types + dtcondtem(:,:) = zero + dqcondtem(:,:) = zero + dqprectem(:,:) = zero + dfrzprectem(:,:) = zero + dtfrztem(:,:) = zero + do i=ISTS,IENS + cbmfl = cbmfx(i,ctp) + kk = kt(i,ctp) ! cloud top index + if(cbmfl > zero) then ! this should avoid zero wcv in the denominator + kbi = kb(i) ! cloud base index + do k=kbi,kk ! loop from cloud base to cloud top + km1 = k - 1 + rhs_h = zero + rhs_q = zero + if(k > kbi) then +! tem = cbmfl * (one - sigma(i,k)) + tem = cbmfl * (one - 0.5*(sigma(i,k)+sigma(i,km1))) + tem1 = gcym(i,k,ctp) * (one - sigma(i,k)) + tem2 = gcym(i,km1,ctp) * (one - sigma(i,km1)) + rhs_h = cbmfl * (tem1*gchm(i,k,ctp) - (tem2*gchm(i,km1,ctp) & + + GDH(I,Km1)*(tem1-tem2)) ) + rhs_q = cbmfl * (tem1*(gcwm(i,k,ctp)-gcqm(i,k,ctp)) & + - (tem2*(gcwm(i,km1,ctp)-gcqm(i,km1,ctp)) & + + (GDw(I,Km1)-gdq(i,km1,1))*(tem1-tem2)) ) +! + dqcondtem(i,km1) = -rhs_q ! condensation + dqprectem(i,km1) = tem * (GPRCIZ(i,k,ctp) + GSNWIZ(i,k,ctp)) ! total precip production + dfrzprectem(i,km1) = tem * GSNWIZ(i,k,ctp) ! production of frozen precip + dtfrztem(i,km1) = rhs_h*oneocp ! heating due to freezing +! total temperature tendency due to in cloud microphysics + dtcondtem(i,km1) = - elocp * dqcondtem(i,km1) + dtfrztem(i,km1) + + endif ! if(k > kbi) then + enddo ! end of k=kbi,kk loop + + endif ! end of if(cbmfl > zero) + + +! get tendencies by difference of fluxes, sum over cloud type + + do k = 1,kk +! sum single cloud microphysical tendencies over all cloud types + condtermt(i,k) = condtermt(i,k) + dtcondtem(i,k) * delpinv(i,k) + condtermq(i,k) = condtermq(i,k) + dqcondtem(i,k) * delpinv(i,k) + prectermq(i,k) = prectermq(i,k) + dqprectem(i,k) * delpinv(i,k) + prectermfrz(i,k) = prectermfrz(i,k) + dfrzprectem(i,k) * delpinv(i,k) + frzterm(i,k) = frzterm(i,k) + dtfrztem(i,k) * delpinv(i,k) + +! if (lprnt .and. i == ipr) write(0,*)' k=',k,' trfluxtem=',trfluxtem(k+1,ntr),trfluxtem(k,ntr),& +! ' ctp=',ctp,' trfluxterm=',trfluxterm(i,k,ntr) + enddo + + enddo ! end of i loop + enddo ! end of nctp loop + endif +!downdraft sigma and mass-flux tendency terms are now put into +! the nctp+1 slot of the cloud-type dimensiond variables + + do k=1,kmax + do i=ists,iens + sigmad(i,k) = zero + enddo + enddo !> -# Call cumdwn() to compute cumulus downdraft and assocated melt, freeze !! and evaporation - CALL CUMDWN(IM , IJSDIM, KMAX , NTR , ntrq , & ! DD dimensions + CALL CUMDWN(IM, IJSDIM, KMAX, NTR, ntrq, nctp, & ! DD dimensions GTT , GTQ , GTU , GTV , & ! modified GMFLX , & ! modified updraft+downdraft flux GPRCP , GSNWP , GTEVP , GMDD , & ! output GPRCI , GSNWI , & ! input - GDH , GDW , GDQ , GDQ(1,1,iti) , & ! input + GDH , GDW , GDQ , GDQ(:,:,iti) , & ! input GDQS , GDS , GDHS , GDT , & ! input GDU , GDV , GDZ , & ! input - GDZM , FDQS , DELP , DELPI , & ! input + GDZM , FDQS , DELP , DELPInv , & ! input sigmad, do_aw , do_awdd, flx_form, & ! DDsigma input dtmelt, dtevap, dtsubl, & ! DDsigma input dtdwn , dqvdwn, dqldwn, dqidwn, & ! DDsigma input dtrdwn, & KB , KTMXT , ISTS , IENS ) ! input -! here we substitute the AW tendencies into tendencies to be passed out -! if (do_aw) then -! do k=1,kmax -! do i=ists,iens -! sigma(i,k) = sigma(i,k) + sigmad(i,k) -! enddo -! enddo + +! sigma = sigma + sigmad !> -# Call cumsbw() to compute cloud subsidence heating if (.not. flx_form) then @@ -1381,20 +1451,20 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions CALL CUMSBH(IM , IJSDIM, KMAX , NTR , ntrq , & !DD dimensions GTT , GTQ , & ! modified GTU , GTV , & ! modified - GDH , GDQ , GDQ(1,1,iti) , & ! input + GDH , GDQ , GDQ(:,:,iti) , & ! input GDU , GDV , & ! input - DELPI , GMFLX , GMFX0 , & ! input + DELPINV , GMFLX , GMFX0 , & ! input KTMXT , CPRES , kb, ISTS , IENS ) ! input else CALL CUMSBW(IM , IJSDIM, KMAX , & !DD dimensions GTU , GTV , & ! modified GDU , GDV , & ! input - DELPI , GMFLX , GMFX0 , & ! input + DELPINV , GMFLX , GMFX0 , & ! input KTMXT , CPRES , kb, ISTS , IENS ) ! input endif ! -! for now the following routines appear to be of no consequence to AW - DD +! for now the following routines appear to be of no consequence - DD ! if (.not. flx_form) then ! Tracer Updraft properties @@ -1411,20 +1481,20 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions GCYM , GCYT , GCQT , GCLT , GCIT , & ! input GTPRT , GTEVP , GTPRC0, & ! input KB , KBMX , KT , KTMX , KTMXT , & ! input - DELPI , OTSPT1, ISTS , IENS, & ! input + DELPInv , OTSPT1, ISTS , IENS, & ! input fscav , fswtr, nctp) ! ! Tracer Change due to Downdraft ! --------------- CALL CUMDNR(im ,IJSDIM , KMAX , NTR , & !DD dimensions GTQ , & ! modified - GDQ , GMDD , DELPI , & ! input + GDQ , GMDD , DELPInv , & ! input KTMXT , OTSPT1, ISTS , IENS ) ! input !! !! Tracer change due to Subsidence !! --------------- !! This will be done by cumsbh, now DD 20170907 -! CALL CUMSBR(im , IJSDIM, KMAX , NTR , & !DD dimensions +! CALL CUMSBR(im , IJSDIM, KMAX , NTR ,NCTP, & !DD dimensions ! GTQ , & ! modified ! GDQ , DELPI , & ! input ! GMFLX , KTMXT , OTSPT2, & ! input @@ -1447,6 +1517,60 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Compute AW tendencies of T, ql and qi if(flx_form) then ! compute AW tendencies ! AW lump all heating together, compute qv term + +! sigma interpolated to the layer for condensation, etc. terms, precipitation + if(do_aw) then + do k=1,kmax + kp1 = k+1 + do i=1,ijsdim + fsigma(i,k) = one - half*(sigma(i,k)+sigma(i,kp1)) + enddo + enddo + else + do k=1,kmax+1 + do i=1,ijsdim + fsigma(i,k) = one + enddo + enddo + endif + +! AW adjustment of precip fluxes from downdraft model + if(do_aw) then + kp1 = kmax+1 + DO I=ISTS,IENS + GSNWP( I,kp1 ) = zero + GPRCP( I,kp1 ) = zero + ENDDO + tem1 = cpoemelt/grav + tem2 = cpoel/grav + tem3 = cpoesub/grav + DO K=KMAX,1,-1 + kp1 = k+1 + DO I=ISTS,IENS + tem = -dtmelt(i,k) * delp(i,k) * tem1 + teme = -dtevap(i,k) * delp(i,k) * tem2 + tems = -dtsubl(i,k) * delp(i,k) * tem3 + GSNWP(I,k) = GSNWP(I,kp1) + fsigma(i,k) * (GSNWI(i,k) - tem - tems) + GPRCP(I,k) = GPRCP(I,kp1) + fsigma(i,k) * (GPRCI(i,k) + tem - teme) + ENDDO + ENDDO + endif + + +! some of the above routines have set the tendencies and they need to be +! reinitialized, gtt not needed, but gtq needed Anning 5/25/2020 + do n=1,ntr + do k=1,kmax + do i=1,ijsdim + gtq(i,k,n) = zero + enddo + enddo + enddo +! do k=1,kmax +! do i=1,ijsdim +! gtt(i,k) = zero +! enddo +! enddo do k=1,kmax do i=ists,iens dqevap(i,k) = - dtevap(i,k)*cpoel - dtsubl(i,k)*cpoesub @@ -1454,25 +1578,70 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions dtsubl(i,k) = zero enddo enddo - do i=1,ijsdim - moistening_aw(i) = zero - enddo - tem2 = one / delta + + +! diabatic terms from updraft and downdraft models DO K=1,KMAX DO I=ISTS,IENS tem = frzterm(i,k)*cpoEMELT - prectermfrz(i,k) - gtt(i,k) = dtdwn(i,k) + sfluxterm(i,k) + condtermt(i,k) & - + dtmelt(i,k) + dtevap(i,k) - gtq(i,k,1) = dqvdwn(i,k) + qvfluxterm(i,k) + condtermq(i,k) & - + dqevap(i,k) - gtq(i,k,itl) = dqldwn(i,k) + qlfluxterm(i,k) - condtermq(i,k) & +! gtt(i,k) = gtt(i,k) + fsigma(i,k)*(dtmelt(i,k) + dtevap(i,k)) + condtermt(i,k) +! gtq(i,k,1) = gtq(i,k,1) + fsigma(i,k)*dqevap(i,k) + condtermq(i,k) +! gtq(i,k,itl) = gtq(i,k,itl) - (condtermq(i,k) + prectermq(i,k) + tem) +! gtq(i,k,iti) = gtq(i,k,iti) + tem + gtt(i,k) = dtdwn(i,k) + condtermt(i,k) & + + fsigma(i,k)*(dtmelt(i,k) + dtevap(i,k)) + gtq(i,k,1) = dqvdwn(i,k) + condtermq(i,k) & + + fsigma(i,k) * dqevap(i,k) + gtq(i,k,itl) = dqldwn(i,k) - condtermq(i,k) & - prectermq(i,k) - tem - gtq(i,k,iti) = dqidwn(i,k) + qifluxterm(i,k) + tem + gtq(i,k,iti) = dqidwn(i,k) + tem + ! detrainment terms get zeroed ! gtldet(i,k) = zero ! gtidet(i,k) = zero + ENDDO + ENDDO +!! flux tendencies - compute the vertical flux divergence + DO ctp =1,nctp + DO I=ISTS,IENS + cbmfl = cbmfx(i,ctp) + kk = kt(i,ctp) ! cloud top index + if(cbmfl > zero) then ! this should avoid zero wcv in the denominator + DO K=1,kk + kp1 = k+1 + gtt(i,k) = gtt(i,k) - (fsigma(i,kp1)*sfluxtem(i,kp1,ctp) & + - fsigma(i,k)*sfluxtem(i,k,ctp)) * delpinv(i,k) + gtq(i,k,1) = gtq(i,k,1) - (fsigma(i,kp1)*qvfluxtem(i,kp1,ctp) & + - fsigma(i,k)*qvfluxtem(i,k,ctp)) * delpinv(i,k) + gtq(i,k,itl) = gtq(i,k,itl) - (fsigma(i,kp1)*qlfluxtem(i,kp1,ctp) & + - fsigma(i,k)*qlfluxtem(i,k,ctp)) * delpinv(i,k) + gtq(i,k,iti) = gtq(i,k,iti) - (fsigma(i,kp1)*qifluxtem(i,kp1,ctp) & + - fsigma(i,k)*qifluxtem(i,k,ctp)) * delpinv(i,k) + ENDDO +! replace tracer tendency only if to be advected. + DO n = ntrq,NTR + if (OTSPT2(n)) then + DO K=1,kk + kp1 = k+1 + gtq(i,k,n) = - (fsigma(i,kp1)*trfluxtem(i,kp1,n,ctp) & + - fsigma(i,k)*trfluxtem(i,k,n,ctp)) * delpinv(i,k) + ENDDO + endif + ENDDO + end if + ENDDO + ENDDO +! if(kdt>4) stop 1000 + DO I=ISTS,IENS + moistening_aw(i) = zero + enddo + +! adjust tendencies that will lead to negative water mixing ratios + tem2 = one / delta + DO K=1,KMAX + DO I=ISTS,IENS tem1 = - gdq(i,k,itl)*tem2 if (gtq(i,k,itl) < tem1) then tem3 = gtq(i,k,itl) - tem1 @@ -1504,7 +1673,7 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions if (OTSPT2(n)) then DO K=1,KMAX DO I=ISTS,IENS - gtq(i,k,n) = dtrdwn(i,k,n) + trfluxterm(i,k,n) + gtq(i,k,n) = gtq(i,k,n) + dtrdwn(i,k,n) ENDDO ENDDO endif @@ -1597,46 +1766,74 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions !> -# Ensures conservation of water. !In fact, no adjustment of the precip ! is occuring now which is a good sign! DD - if(flx_form .and. adjustp) then + if(flx_form) then DO I = ISTS, IENS if(gprcp(i,1)+gsnwp(i,1) > 1.e-12_kind_phys) then - moistening_aw(i) = - moistening_aw(i) / (gprcp(i,1)+gsnwp(i,1)) - else - moistening_aw(i) = 1.0 + moistening_aw(i) = -moistening_aw(i) / (gprcp(i,1)+gsnwp(i,1)) +! print*,'moistening_aw',moistening_aw(i) + gprcp(i,:) = gprcp(i,:) * moistening_aw(i) + gsnwp(i,:) = gsnwp(i,:) * moistening_aw(i) endif - ENDDO - do k=1,kmax - DO I = ISTS, IENS - gprcp(i,k) = max(0.0, gprcp(i,k) * moistening_aw(i)) - gsnwp(i,k) = max(0.0, gsnwp(i,k) * moistening_aw(i)) - ENDDO - enddo - + END DO endif + +! second method of determining sfc precip only +! if(flx_form) then +! DO I = ISTS, IENS +! pr_tot = zero +! pr_liq = zero +! pr_ice = zero +! do k = 1,kmax +! pr_tot = pr_tot - (gtq(i,k,1)+gtq(i,k,itl)+gtq(i,k,iti)) * delp(i,k) * gravi +! pr_ice = pr_ice + ( cp*gtt(i,k) + el*gtq(i,k,1) - emelt*gtq(i,k,iti) ) & +! * delp(i,k)*gravi +! enddo + !pr_ice = max( min(pr_tot, pr_ice / (emelt)),zero) +! pr_ice = pr_ice / emelt +! pr_liq = pr_tot - pr_ice +! END DO +! print *,'precip1',pr_tot*86400.,gprcp(1,1)*86400.,gsnwp(1,1)*86400. +! print *,'precip2',pr_tot*86400.,pr_liq*86400.,pr_ice*86400. +! endif + + DO K = 1, KMAX + DO I = ISTS, IENS + GPRCPF( I,K ) = 0.5*( GPRCP( I,K )+GPRCP( I,K+1 ) ) + GSNWPF( I,K ) = 0.5*( GSNWP( I,K )+GSNWP( I,K+1 ) ) + END DO + END DO + ! -! do i=ISTS,IENS -! GPRCC(I,1) = GPRCP(I,1) -! GSNWC(I ) = GSNWP(I,1) -! enddo - do k=1,kmax +! do i=ISTS,IENS +! GPRCC( I,1 ) = GPRCP( I,1 ) +! GSNWC( I ) = GSNWP( I,1 ) +! enddo + +! adjust sfc precip consistently with vertically integrated +! temperature and moisture tendencies + + do k=1,kmax+1 do i=ISTS,IENS GTPRP(I,k) = GPRCP(I,k) + GSNWP(I,k) enddo enddo ! !DD provide GFS with a separate downdraft mass flux - DO K=1,KMAX - DO I=ISTS,IENS - GMFX1(I,K) = GMFX0(I,K) - GMFLX(I,K) - ENDDO - ENDDO -! - if (flx_form) then - deallocate(sfluxterm, qvfluxterm, qlfluxterm, qifluxterm,& - condtermt, condtermq, frzterm, prectermq, & - prectermfrz, dtdwn, dqvdwn, dqldwn, & - dqidwn, trfluxterm, dtrdwn) - endif + if(do_aw) then + DO K = 1, KMAX+1 + DO I = ISTS, IENS + fsigma(i,k) = one - sigma(i,k) + GMFX0( I,K ) = GMFX0( I,K ) * fsigma(i,k) + GMFLX( I,K ) = GMFLX( I,K ) * fsigma(i,k) + END DO + END DO + endif + DO K = 1, KMAX+1 + DO I = ISTS, IENS + GMFX1( I,K ) = GMFX0( I,K ) - GMFLX( I,K ) + END DO + END DO + if (allocated(gprcc)) deallocate(gprcc) ! @@ -1748,28 +1945,6 @@ SUBROUTINE CUMBAS & ! cloud base ENDIF ENDDO ENDDO - DO K=KLCLB+1,KBMAX-1 - DO I=ISTS,IENS - spbl(i) = one - gdpm(i,k) * tx1(i) - IF (kb(i) > k .and. spbl(i) > spblmax) THEN - KB(I) = K - ENDIF - ENDDO - ENDDO -! DO K=KBMAX-1,KLCLB+1,-1 -! DO I=ISTS,IENS -! GAMX = FDQS(I,K) / (one+GAM(I,K)) * oneocp -! QSL(i) = GDQS(I,K) + GAMX * (GDH(I,KLCLB)-GDHS(I,K)) -! spbl(i) = one - gdpm(i,k) * tx1(i) -! IF (GDW(I,KLCLB) >= QSL(i) .and. spbl(i) >= spblcrit & -! .and. spbl(i) < spblcrit*6.0) THEN -! .and. spbl(i) < spblcrit*8.0) THEN -! KB(I) = K + KBOFS -! ENDIF -! ENDDO -! if(lprnt) write(0,*)' k=',k,' gdh1=',gdh(ipr,klclb),' gdhs=',gdhs(ipr,k),' kb=',kb(ipr) & -! ,' GDQS=',GDQS(ipr,k),' GDW=',GDW(ipr,KLCLB),' gdpm=',gdpm(ipr,k),' spbl=',spbl(ipr),' qsl=',qsl(ipr) -! ENDDO ENDIF ! do i=ists,iens @@ -1910,8 +2085,8 @@ SUBROUTINE CUMUP & !! in-cloud properties REAL(kind_phys) ACWF (IJSDIM) !< cloud work function REAL(kind_phys) GCLZ (IJSDIM, KMAX) !< cloud liquid water*eta REAL(kind_phys) GCIZ (IJSDIM, KMAX) !< cloud ice*eta - REAL(kind_phys) GPRCIZ(IJSDIM, KMAX) !< rain generation*eta - REAL(kind_phys) GSNWIZ(IJSDIM, KMAX) !< snow generation*eta + REAL(kind_phys) GPRCIZ(IJSDIM, KMAX+1) !< rain generation*eta + REAL(kind_phys) GSNWIZ(IJSDIM, KMAX+1) !< snow generation*eta REAL(kind_phys) GCYT (IJSDIM) !< norm. mass flux @top REAL(kind_phys) GCHT (IJSDIM) !< cloud top MSE*eta REAL(kind_phys) GCQT (IJSDIM) !< cloud top moisture*eta @@ -1924,7 +2099,7 @@ SUBROUTINE CUMUP & !! in-cloud properties REAL(kind_phys) GCwT (IJSDIM) !< cloud top v*eta INTEGER KT (IJSDIM) !< cloud top INTEGER KTMX !< max of cloud top - REAL(kind_phys) WCV (IJSDIM, KMAX) !< updraft velocity (half lev) !DD sigma make output + REAL(kind_phys) WCV (IJSDIM, KMAX+1) !< updraft velocity (half lev) !DD sigma make output ! ! [MODIFIED] REAL(kind_phys) GCYM (IJSDIM, KMAX) !< norm. mass flux @@ -1980,12 +2155,12 @@ SUBROUTINE CUMUP & !! in-cloud properties ! REAL(kind_phys) ELAR (IJSDIM, KMAX) !< entrainment rate REAL(kind_phys) ELAR !< entrainment rate at mid layer ! - REAL(kind_phys) GCHM (IJSDIM, KMAX) !< cloud MSE (half lev) - REAL(kind_phys) GCWM (IJSDIM, KMAX) !< cloud Qt (half lev) !DDsigmadiag - REAL(kind_phys) GCTM (IJSDIM, KMAX) !< cloud T (half lev) !DDsigmadiag make output - REAL(kind_phys) GCQM (IJSDIM, KMAX) !< cloud q (half lev) !DDsigmadiag make output - REAL(kind_phys) GCLM (IJSDIM, KMAX) !< cloud liquid ( half lev) - REAL(kind_phys) GCIM (IJSDIM, KMAX) !< cloud ice (half lev) + REAL(kind_phys) GCHM (IJSDIM, KMAX+1) !< cloud MSE (half lev) + REAL(kind_phys) GCWM (IJSDIM, KMAX+1) !< cloud Qt (half lev) !DDsigmadiag + REAL(kind_phys) GCTM (IJSDIM, KMAX+1) !< cloud T (half lev) !DDsigmadiag make output + REAL(kind_phys) GCQM (IJSDIM, KMAX+1) !< cloud q (half lev) !DDsigmadiag make output + REAL(kind_phys) GCLM (IJSDIM, KMAX+1) !< cloud liquid ( half lev) + REAL(kind_phys) GCIM (IJSDIM, KMAX+1) !< cloud ice (half lev) REAL(kind_phys) GCUM (IJSDIM, KMAX) !< cloud U (half lev) REAL(kind_phys) GCVM (IJSDIM, KMAX) !< cloud V (half lev) REAL(kind_phys) GCtrM (IJSDIM, KMAX,ntrq:ntr) !< cloud tracer (half lev) @@ -2021,8 +2196,9 @@ SUBROUTINE CUMUP & !! in-cloud properties ! REAL(kind_phys) :: WCCRT = zero !m REAL(kind_phys) :: WCCRT = 0.01 REAL(kind_phys) :: WCCRT = 1.0e-6_kind_phys, wvcrt=1.0e-3_kind_phys - REAL(kind_phys) :: TSICE = 268.15_kind_phys ! compatible with macrop_driver - REAL(kind_phys) :: TWICE = 238.15_kind_phys ! compatible with macrop_driver + REAL(kind_phys) :: TSICE = 273.15_kind_phys ! compatible with macrop_driver + REAL(kind_phys) :: TWICE = 233.15_kind_phys ! compatible with macrop_driver + REAL(kind_phys) :: c1t ! REAL(kind_phys) :: wfn_neg = 0.1 REAL(kind_phys) :: wfn_neg = 0.15 @@ -2033,10 +2209,15 @@ SUBROUTINE CUMUP & !! in-cloud properties REAL(kind_phys) :: esat, tem ! REAL(kind_phys) :: esat, tem, rhs_h, rhs_q ! +! [INTERNAL FUNC] + REAL(kind_phys) FPREC ! precipitation ratio in condensate + REAL(kind_phys) FRICE ! ice ratio in cloud water REAL(kind_phys) Z ! altitude REAL(kind_phys) ZH ! scale height REAL(kind_phys) T ! temperature ! + FPREC(Z,ZH) = MIN(MAX(one-EXP(-(Z-PRECZ0)/ZH), zero), one) + FRICE(T) = MIN(MAX((TSICE-T)/(TSICE-TWICE), zero), one) ! ! Note: iteration is not made to diagnose cloud ice for simplicity ! @@ -2052,14 +2233,25 @@ SUBROUTINE CUMUP & !! in-cloud properties GCVT (I) = zero GCwT (I) = zero enddo + do k=1,kmax+1 + do i=ists,iens + GPRCIZ(I,k) = zero + GSNWIZ(I,k) = zero + enddo + enddo + do k=1,kmax + do i=ists,iens + WCV (I,k) = unset_kind_phys + GCLM (I,k) = unset_kind_phys + GCIM (I,k) = unset_kind_phys + enddo + enddo do k=1,kmax do i=ists,iens ACWFK (I,k) = unset_kind_phys ACWFN (I,k) = unset_kind_phys GCLZ (I,k) = zero GCIZ (I,k) = zero - GPRCIZ(I,k) = zero - GSNWIZ(I,k) = zero ! GCHMZ (I,k) = zero GCWMZ (I,k) = zero @@ -2070,15 +2262,12 @@ SUBROUTINE CUMUP & !! in-cloud properties ! BUOY (I,k) = unset_kind_phys BUOYM (I,k) = unset_kind_phys - WCV (I,k) = unset_kind_phys GCY (I,k) = unset_kind_phys ! GCHM (I,k) = unset_kind_phys GCWM (I,k) = unset_kind_phys GCTM (I,k) = unset_kind_phys GCQM (I,k) = unset_kind_phys - GCLM (I,k) = unset_kind_phys - GCIM (I,k) = unset_kind_phys GCUM (I,k) = unset_kind_phys GCVM (I,k) = unset_kind_phys enddo @@ -2199,13 +2388,24 @@ SUBROUTINE CUMUP & !! in-cloud properties FDQSM = GDQSM * tem * (fact1 + fact2*tem) ! calculate d(qs)/dT CPGMI = one / (CP + EL*FDQSM) - PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) - PRECR = FPREC(GDZM(I,K)-GDZMKB(I), PRCZH ) ! wrk = one / GCYM(I,K) DCTM = (GCHMZ(I,K)*wrk - GDHSM) * CPGMI GCQMZ(i) = min((GDQSM+FDQSM*DCTM)*GCYM(I,K), GCWMZ(I,K)) - GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + if(PRECZH > zero) then + PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) + PRECR = FPREC(GDZM(I,K)-GDZMKB(I), PRCZH ) + GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + else + DELC=GDZ(I,K)-GDZ(I,KM1) + if(gdtm(i,k)>TSICE) then + c1t=c0t*delc + else + c1t=c0t*exp(d0t*(gdtm(i,k)-TSICE))*delc + end if + c1t=min(c1t, one) + GTPRMZ(I,K) = c1t * (GCWMZ(I,K)-GCQMZ(i)) + end if GTPRMZ(I,K) = MAX(GTPRMZ(I,K), GTPRMZ(I,KM1)) GCCMZ = GCWMZ(I,K) - GCQMZ(i) - GTPRMZ(I,K ) DELC = MIN(GCCMZ, zero) @@ -2274,7 +2474,11 @@ SUBROUTINE CUMUP & !! in-cloud properties wrk = one / GCYM(I,K) DCTM = (GCHMZ(I,K)*wrk - GDHSM) * CPGMI GCQMZ(i) = min((GDQSM+FDQSM*DCTM)*GCYM(I,K), GCWMZ(I,K)) - GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + if(PRECZH > zero) then + GTPRMZ(I,K) = PRECR * (GCWMZ(I,K)-GCQMZ(i)) + else + GTPRMZ(I,K) = c1t * (GCWMZ(I,K)-GCQMZ(i)) + end if GTPRMZ(I,K) = MAX(GTPRMZ(I,K), GTPRMZ(I,KM1)) GCCMZ = GCWMZ(I,K) - GCQMZ(i) - GTPRMZ(I,K) DELC = MIN(GCCMZ, zero) @@ -2399,8 +2603,19 @@ SUBROUTINE CUMUP & !! in-cloud properties wrk = one / gcyt(i) DCT = (GCHT(I)*wrk - GDHS(I,K)) / (CP*(one + GAM(I,K))) GCQT(I) = min((GDQS(I,K) + FDQS(I,K)*DCT) * GCYT(I), GCWT(i)) - PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) - GTPRT(I) = FPREC(GDZ(I,K)-GDZMKB(I), PRCZH) * (GCWT(i)-GCQT(I)) + if(PRECZH > zero) then + PRCZH = PRECZH * MIN(GDZTR(I)*ZTREFI, one) + GTPRT(I) = FPREC(GDZ(I,K)-GDZMKB(I), PRCZH) * (GCWT(i)-GCQT(I)) + else + DELC=GDZ(I,K)-GDZ(I,K-1) + if(gdtm(i,k)>TSICE) then + c1t=c0t*delc + else + c1t=c0t*exp(d0t*(gdtm(i,k)-TSICE))*delc + end if + c1t=min(c1t, one) + GTPRT(I) = c1t * (GCWT(i)-GCQT(I)) + end if GTPRT(I) = MAX(GTPRT(I), GTPRMZ(I,K)) GCCT = GCWT(i) - GCQT(I) - GTPRT(I) DELC = MIN(GCCT, zero) @@ -2503,24 +2718,6 @@ SUBROUTINE CUMUP & !! in-cloud properties ! ! WRITE( CTNUM, '(I2.2)' ) CTP ! - -contains - - pure function FPREC(Z,ZH) - implicit none - real(kind_phys), intent(in) :: Z - real(kind_phys), intent(in) :: ZH - real(kind_phys) :: FPREC - FPREC = MIN(MAX(one-EXP(-(Z-PRECZ0)/ZH), zero), one) - end function FPREC - - pure function FRICE(T) - implicit none - real(kind_phys), intent(in) :: T - real(kind_phys) :: FRICE - FRICE = MIN(MAX((TSICE-T)/(TSICE-TWICE), zero), one) - end function FRICE - END SUBROUTINE CUMUP !*********************************************************************** !>\ingroup cs_scheme @@ -2562,8 +2759,8 @@ SUBROUTINE CUMBMX & !! cloud base mass flux ! [INTERNAL PARAM] REAL(kind_phys) :: FMAX = 1.5e-2_kind_phys ! maximum flux ! REAL(kind_phys) :: RHMCRT = zero ! critical val. of cloud mean RH -! REAL(kind_phys) :: RHMCRT = 0.25_kind_phys ! critical val. of cloud mean RH - REAL(kind_phys) :: RHMCRT = 0.50_kind_phys ! critical val. of cloud mean RH + REAL(kind_phys) :: RHMCRT = 0.25_kind_phys ! critical val. of cloud mean RH +! REAL(kind_phys) :: RHMCRT = 0.50_kind_phys ! critical val. of cloud mean RH REAL(kind_phys) :: ALP1 = zero REAL(kind_phys) :: TAUD = 1.e3_kind_phys ! REAL(kind_phys) :: TAUD = 6.e2_kind_phys @@ -2624,7 +2821,7 @@ SUBROUTINE CUMFLX & !! cloud mass flux INTEGER, INTENT(IN) :: IJSDIM, KMAX, IM !! DD, for GFS, pass in ! ! [OUTPUT] - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux REAL(kind_phys) CMDET (IJSDIM, KMAX) !< detrainment mass flux REAL(kind_phys) GPRCI (IJSDIM, KMAX) !< rainfall generation REAL(kind_phys) GSNWI (IJSDIM, KMAX) !< snowfall generation @@ -2636,8 +2833,8 @@ SUBROUTINE CUMFLX & !! cloud mass flux REAL(kind_phys) CBMFX (IJSDIM) !< cloud base mass flux REAL(kind_phys) GCYM (IJSDIM, KMAX) !< normalized mass flux REAL(kind_phys) GCYT (IJSDIM) !< detraining mass flux - REAL(kind_phys) GPRCIZ(IJSDIM, KMAX) !< precipitation/M - REAL(kind_phys) GSNWIZ(IJSDIM, KMAX) !< snowfall/M + REAL(kind_phys) GPRCIZ(IJSDIM, KMAX+1) !< precipitation/M + REAL(kind_phys) GSNWIZ(IJSDIM, KMAX+1) !< snowfall/M REAL(kind_phys) GTPRT (IJSDIM) !< rain+snow @top REAL(kind_phys) GCLZ (IJSDIM, KMAX) !< cloud liquid/M REAL(kind_phys) GCIZ (IJSDIM, KMAX) !< cloud ice/M @@ -2773,8 +2970,8 @@ SUBROUTINE CUMSBH & !! adiabat. descent REAL(kind_phys) GDU (IJSDIM, KMAX) REAL(kind_phys) GDV (IJSDIM, KMAX) REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux (updraft+downdraft) - REAL(kind_phys) GMFX0 (IJSDIM, KMAX) !< mass flux (updraft only) + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux (updraft+downdraft) + REAL(kind_phys) GMFX0 (IJSDIM, KMAX+1) !< mass flux (updraft only) INTEGER KB(IJSDIM) !< cloud base index - negative means no convection INTEGER KTMX REAL(kind_phys) CPRES !< pressure factor for cumulus friction @@ -2890,8 +3087,8 @@ SUBROUTINE CUMSBW & !! adiabat. descent REAL(kind_phys) GDU (IJSDIM, KMAX) REAL(kind_phys) GDV (IJSDIM, KMAX) REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux (updraft+downdraft) - REAL(kind_phys) GMFX0 (IJSDIM, KMAX) !< mass flux (updraft only) + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux (updraft+downdraft) + REAL(kind_phys) GMFX0 (IJSDIM, KMAX+1) !< mass flux (updraft only) INTEGER KB(IJSDIM) !< cloud base index - negative means no convection INTEGER KTMX, ISTS, IENS REAL(kind_phys) CPRES !< pressure factor for cumulus friction @@ -2942,7 +3139,7 @@ END SUBROUTINE CUMSBW !>\ingroup cs_scheme !! This subroution calculates freeze, melt and evaporation in cumulus downdraft. SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation - ( IM , IJSDIM, KMAX , NTR , ntrq, & !DD dimensions + ( IM , IJSDIM, KMAX , NTR,ntrq,nctp, & !DD dimensions GTT , GTQ , GTU , GTV , & ! modified GMFLX , & ! modified GPRCP , GSNWP , GTEVP , GMDD , & ! output @@ -2962,7 +3159,7 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation ! IMPLICIT NONE - INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR, ntrq ! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR , ntrq, nctp !! DD, for GFS, pass in logical, intent(in) :: do_aw, do_awdd, flx_form ! ! [MODIFY] @@ -2970,13 +3167,13 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation REAL(kind_phys) GTQ (IJSDIM, KMAX, NTR) !< Moisture etc tendency REAL(kind_phys) GTU (IJSDIM, KMAX) !< u tendency REAL(kind_phys) GTV (IJSDIM, KMAX) !< v tendency - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !< mass flux + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !< mass flux ! ! [OUTPUT] - REAL(kind_phys) GPRCP (IJSDIM, KMAX) !< rainfall flux - REAL(kind_phys) GSNWP (IJSDIM, KMAX) !< snowfall flux + REAL(kind_phys) GPRCP (IJSDIM, KMAX+1) !< rainfall flux + REAL(kind_phys) GSNWP (IJSDIM, KMAX+1) !< snowfall flux REAL(kind_phys) GTEVP (IJSDIM, KMAX) !< evaporation+sublimation - REAL(kind_phys) GMDD (IJSDIM, KMAX) !< downdraft mass flux + REAL(kind_phys) GMDD (IJSDIM, KMAX+1) !< downdraft mass flux !AW microphysical tendencies REAL(kind_phys) gtmelt (IJSDIM, KMAX) !< t tendency ice-liq @@ -2988,8 +3185,6 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation REAL(kind_phys) dqldwn (IJSDIM, KMAX) !< ql tendency downdraft detrainment REAL(kind_phys) dqidwn (IJSDIM, KMAX) !< qi tendency downdraft detrainment REAL(kind_phys) dtrdwn (IJSDIM, KMAX, ntrq:ntr) !< tracer tendency downdraft detrainment -! AW downdraft area fraction (assumed zero for now) - REAL(kind_phys) sigmad (IJSDIM,KMAX) !< DDsigma cloud downdraft area fraction ! [INPUT] REAL(kind_phys) GPRCI (IJSDIM, KMAX) !< rainfall generation @@ -3011,6 +3206,8 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation REAL(kind_phys) DELPI (IJSDIM, KMAX) INTEGER KB (IJSDIM) INTEGER KTMX, ISTS, IENS + REAL(kind_phys) sigmad (IM,KMAX+1) !< DDsigma cloud downdraft area fraction + ! ! [INTERNAL WORK] ! Note: Some variables have 3-dimensions for the purpose of budget check. @@ -3031,27 +3228,33 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation ! profiles of downdraft variables for AW flux tendencies REAL(kind_phys) GCdseD(ISTS:IENS, KMAX) !< downdraft dse REAL(kind_phys) GCqvD (ISTS:IENS, KMAX) !< downdraft qv -! REAL(kind_phys) GCqlD (ISTS:IENS, KMAX) !< downdraft ql -! REAL(kind_phys) GCqiD (ISTS:IENS, KMAX) !< downdraft qi + REAL(kind_phys) GCqlD (ISTS:IENS, KMAX) !< downdraft ql + REAL(kind_phys) GCqiD (ISTS:IENS, KMAX) !< downdraft qi REAL(kind_phys) GCtrD (ISTS:IENS, ntrq:ntr) !< downdraft tracer REAL(kind_phys) GCUD (ISTS:IENS) !< downdraft u REAL(kind_phys) GCVD (ISTS:IENS) !< downdraft v REAL(kind_phys) FSNOW (ISTS:IENS) REAL(kind_phys) GMDDD (ISTS:IENS) - - REAL(kind_phys) GDTW, GCHX, GCTX, GCQSX, GTPRP, EVSU, GTEVE, LVIC, & - DQW, DTW, GDQW, DZ, GCSD, FDET, GDHI, GMDDX, & - GMDDMX, GCHDX, GCWDX, GCUDD, GCVDD, GTHCI, GTQVCI, & - wrk, wrk1, wrk2, wrk3, wrk4, tx1, & - WMX, HMX, DDWMX, DDHMX, dp_above, dp_below, fsigma, & - fmelt, fevp, wrkn, gctrdd(ntrq:ntr) - + INTEGER I, K + REAL(kind_phys) GDTW + REAL(kind_phys) GCHX, GCTX, GCQSX, GTPRP, EVSU, GTEVE, LVIC + REAL(kind_phys) DQW, DTW, GDQW, DZ, GCSD, FDET, GDHI + REAL(kind_phys) GMDDX, GMDDMX + REAL(kind_phys) GCHDX, GCWDX + REAL(kind_phys) GCUDD, GCVDD + REAL(kind_phys) GTHCI, GTQVCI, GTQLCI, GTQICI !M REAL(kind_phys) GTHCI, GTQVCI, GTQLCI, GTQICI, GTUCI, GTVCI + real(kind_phys) wrk, fmelt, fevp, gctrdd(ntrq:ntr) !DD#ifdef OPT_CUMBGT -! Water, energy, downdraft water and downdraft energy budgets -! REAL(kind_phys), dimension(ISTS:IENS) :: WBGT, HBGT, DDWBGT, DDHBGT - integer ij, i, k, kp1, n + REAL(kind_phys) WBGT ( ISTS:IENS ) !! water budget + REAL(kind_phys) HBGT ( ISTS:IENS ) !! energy budget + REAL(kind_phys) DDWBGT( ISTS:IENS ) !! downdraft water budget + REAL(kind_phys) DDHBGT( ISTS:IENS ) !! downdraft energy budget + REAL(kind_phys) WMX, HMX, DDWMX, DDHMX, tx1, wrk1, wrk2, wrk3, wrk4, wrkn + REAL(kind_phys) dp_above, dp_below + real(kind_phys) fsigma + integer ij, n, kp1 !DD#endif ! ! [INTERNAL PARM] @@ -3109,46 +3312,23 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation gtsubl(I,k) = zero enddo enddo -! testing on oct 17 2016 - if (flx_form) then - if (.not. do_awdd) then - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtdwn (i,k) = gtt(i,k) - dqvdwn(i,k) = gtq(i,k,1) - dqldwn(i,k) = gtq(i,k,itl) - dqidwn(i,k) = gtq(i,k,iti) - endif - enddo - enddo - do n=ntrq,ntr - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtrdwn(i,k,n) = gtq(i,k,n) - endif - enddo - enddo - enddo - else - do k=1,kmax - do i=ists,iens - dtdwn (I,k) = zero - dqvdwn(I,k) = zero - dqldwn(I,k) = zero - dqidwn(I,k) = zero - enddo - enddo - do n=ntrq,ntr - do k=1,kmax - do i=ists,iens - dtrdwn(i,k,n) = zero - enddo - enddo - enddo - endif - endif + +! These are zeroed by the calling routine, cs_cumlus +! do k=1,kmax +! do i=ists,iens +! dtdwn (I,k) = zero +! dqvdwn(I,k) = zero +! dqldwn(I,k) = zero +! dqidwn(I,k) = zero +! enddo +! enddo +! do n=ntrq,ntr +! do k=1,kmax +! do i=ists,iens +! dtrdwn(i,k,n) = zero +! enddo +! enddo +! enddo ! do i=ists,iens GCHD(I) = zero @@ -3178,20 +3358,19 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation LVIC = ELocp + EMELTocp*FSNOW(I) GDTW = GDT(I,K) - LVIC*(GDQS(I,K) - GDQ(I,K,1)) & / (one + LVIC*FDQS(I,K)) + + DZ = GDZM(I,KP1) - GDZM(I,K) + FMELT = (one + FTMLT*(GDTW - TWSNOW)) & + * (one - TANH(GMFLX(I,KP1)/GMFLXC)) & + * (one - TANH(VTERMS*MELTAU/DZ)) IF (GDTW < TWSNOW) THEN - GSNWP(I,K) = GSNWP(I,KP1) + GPRCI(I,K) + GSNWI(I,K) - GTTEV(I,K) = EMELToCP * GPRCI(I,K) * DELPI(I,K) - SNMLT(I,K) = -GPRCI(I,K) + SNMLT(I,K) = GPRCP(I,KP1)*min(max(FMELT, one), zero) ELSE - DZ = GDZM(I,KP1) - GDZM(I,K) - FMELT = (one + FTMLT*(GDTW - TWSNOW)) & - * (one - TANH(GMFLX(I,KP1)/GMFLXC)) & - * (one - TANH(VTERMS*MELTAU/DZ)) SNMLT(I,K) = GSNWP(I,KP1)*max(min(FMELT, one), zero) - GSNWP(I,K) = GSNWP(I,KP1)+GSNWI(I,K) - SNMLT(I,K) - GPRCP(I,K) = GPRCP(I,KP1)+GPRCI(I,K) + SNMLT(I,K) - GTTEV(I,K) = -EMELToCP * SNMLT(I,K) * DELPI(I,K) ENDIF + GSNWP(I,K) = GSNWP(I,KP1)+GSNWI(I,K) - SNMLT(I,K) + GPRCP(I,K) = GPRCP(I,KP1)+GPRCI(I,K) + SNMLT(I,K) + GTTEV(I,K) = -EMELToCP * SNMLT(I,K) * DELPI(I,K) !DD heating rate due to precip melting for AW gtmelt(i,k) = gtmelt(i,k) + GTTEV(I,K) endif @@ -3350,8 +3529,15 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation GTQ(I,K,1) = GTQ(I,K,1) + GTQEV(I,K) ! GMFLX(I,K) = GMFLX(I,K) - GMDD(I,K) + endif + ENDDO ! end of i loop + ENDDO ! end of k loop ! AW tendencies due to vertical divergence of eddy fluxes + DO K=2,KTMX + kp1 = min(k+1,kmax) + DO I=ISTS,IENS + if (kb(i) > 0) then if (k > 1 .and. flx_form) then fsigma = one - sigmad(i,kp1) dp_below = wrk * (one - sigmad(i,k)) @@ -3381,28 +3567,6 @@ SUBROUTINE CUMDWN & ! Freeze & Melt & Evaporation endif ENDDO ! end of i loop ENDDO ! end of k loop -! - if (.not. do_awdd .and. flx_form) then - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtdwn(i,k) = gtt(i,k) - dtdwn(i,k) - dqvdwn(i,k) = gtq(i,k,1) - dqvdwn(i,k) - dqldwn(i,k) = gtq(i,k,itl) - dqldwn(i,k) - dqidwn(i,k) = gtq(i,k,iti) - dqidwn(i,k) - endif - enddo - enddo - do n=ntrq,ntr - do k=1,kmax - do i=ists,iens - if (kb(i) > 0) then - dtrdwn(i,k,n) = gtq(i,k,n) - dtrdwn(i,k,n) - endif - enddo - enddo - enddo - endif ! END SUBROUTINE CUMDWN !*********************************************************************** @@ -3428,22 +3592,28 @@ SUBROUTINE CUMCLD & !! cloudiness REAL(kind_phys) FLIQC (IJSDIM, KMAX) !< liquid ratio in cumulus ! ! [INPUT] - REAL(kind_phys) GMFLX (IJSDIM, KMAX) ! cumulus mass flux + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) ! cumulus mass flux INTEGER KTMX INTEGER ISTS, IENS ! ! [WORK] INTEGER I, K REAL(kind_phys) CUMF, QC, wrk + LOGICAL, SAVE :: OFIRST = .TRUE. ! ! [INTERNAL PARAM] - REAL(kind_phys), parameter :: CMFMIN = 2.e-3_kind_phys, &!< Mc->cloudiness - CMFMAX = 3.e-1_kind_phys, &!< Mc->cloudiness - CLMIN = 1.e-3_kind_phys, &!< cloudiness Min. - CLMAX = 0.1_kind_phys, &!< cloudiness Max. - FACLW = 0.1_kind_phys, &!< Mc->CLW - FACLF = (CLMAX-CLMIN)/LOG(CMFMAX/CMFMIN) -! + REAL(kind_phys) :: FACLW = 0.1_kind_phys !> Mc->CLW + REAL(kind_phys) :: CMFMIN = 2.e-3_kind_phys !> Mc->cloudiness + REAL(kind_phys) :: CMFMAX = 3.e-1_kind_phys !> Mc->cloudiness + REAL(kind_phys) :: CLMIN = 1.e-3_kind_phys !> cloudiness Min. + REAL(kind_phys) :: CLMAX = 0.1_kind_phys !> cloudiness Max. + REAL(kind_phys), SAVE :: FACLF +! + IF ( OFIRST ) THEN + FACLF = (CLMAX-CLMIN)/LOG(CMFMAX/CMFMIN) + OFIRST = .FALSE. + END IF + CUMFRC(ISTS:IENS) = zero DO K=1,KTMX DO I=ISTS,IENS @@ -3668,26 +3838,28 @@ END SUBROUTINE CUMDNR !*********************************************************************** !>\ingroup cs_scheme SUBROUTINE CUMSBR & !! Tracer Subsidence - ( IM , IJSDIM, KMAX , NTR , & !DD dimensions + ( IM , IJSDIM, KMAX, NTR, NCTP, & !DD dimensions GTR , & ! modified - GDR , DELPI , & ! input + GDR , DELP , & ! input GMFLX , KTMX , OTSPT , & ! input + sigmai , sigma , & !DDsigma input ISTS, IENS ) ! input ! IMPLICIT NONE - INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR !! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, NTR, nctp !! DD, for GFS, pass in ! ! [MODIFY] REAL(kind_phys) GTR (IJSDIM, KMAX, NTR) !! tracer tendency ! ! [INPUT] REAL(kind_phys) GDR (IJSDIM, KMAX, NTR) !! tracer - REAL(kind_phys) DELPI (IJSDIM, KMAX) - REAL(kind_phys) GMFLX (IJSDIM, KMAX) !! mass flux + REAL(kind_phys) DELP (IJSDIM, KMAX) + REAL(kind_phys) GMFLX (IJSDIM, KMAX+1) !! mass flux INTEGER KTMX LOGICAL OTSPT (NTR) !! tracer transport on/off INTEGER ISTS, IENS + REAL(kind_phys) sigmai (IM,KMAX+1,NCTP), sigma(IM,KMAX+1) !!DDsigma cloud updraft fraction ! ! [INTERNAL WORK] INTEGER I, K, KM, KP, LT @@ -3703,14 +3875,14 @@ SUBROUTINE CUMSBR & !! Tracer Subsidence KM = MAX(K-1, 1) KP = MIN(K+1, KMAX) DO I=ISTS,IENS - SBR0 = GMFLX(I,KP) * (GDR(I,KP,LT) - GDR(I,K,LT)) - SBR1 = GMFLX(I,K) * (GDR(I,K,LT) - GDR(I,KM,LT)) - IF (GMFLX(I,K) > GMFLX(I,KP)) THEN + SBR0 = GMFLX(I,K+1) * (GDR(I,KP,LT) - GDR(I,K,LT)) + SBR1 = GMFLX(I,K) * (GDR(I,K,LT) - GDR(I,KM,LT)) + IF (GMFLX(I,K) > GMFLX(I,K+1)) THEN FX1 = half ELSE FX1 = zero END IF - GTR(I,K,LT) = GTR(I,K,LT) + DELPI(I,K) & + GTR(I,K,LT) = GTR(I,K,LT) + GRAV/DELP(I,K) & * ((one-FX(I))*SBR0 + FX1*SBR1) FX(I) = FX1 ENDDO @@ -3815,14 +3987,14 @@ END SUBROUTINE CUMFXR !********************************************************************* !>\ingroup cs_scheme SUBROUTINE CUMFXR1 & ! Tracer mass fixer - ( IM , IJSDIM, KMAX , & !DD dimensions + ( IM , IJSDIM, KMAX ,nctp, & !DD dimensions GTR , & ! modified GDR , DELP , DELTA , KTMX , IMFXR , & ! input ISTS , IENS ) ! input ! IMPLICIT NONE - INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX ! DD, for GFS, pass in + INTEGER, INTENT(IN) :: IM, IJSDIM, KMAX, nctp !! DD, for GFS, pass in ! ! [MODIFY] REAL(kind_phys) GTR (IJSDIM, KMAX) ! tracer tendency diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv.meta b/physics/CONV/Chikira_Sugiyama/cs_conv.meta index 49e460ed6..5211b939e 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv.meta @@ -258,7 +258,7 @@ standard_name = convective_updraft_area_fraction_at_model_interfaces long_name = convective updraft area fraction at model interfaces units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = out @@ -312,6 +312,7 @@ type = real kind = kind_phys intent = out + optional = True [qicn] standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water @@ -320,6 +321,7 @@ type = real kind = kind_phys intent = out + optional = True [w_upi] standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft @@ -328,6 +330,7 @@ type = real kind = kind_phys intent = out + optional = True [cf_upi] standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics @@ -336,6 +339,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_mfd] standard_name = detrained_mass_flux long_name = detrained mass flux @@ -344,6 +348,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_dqldt] standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics @@ -352,6 +357,7 @@ type = real kind = kind_phys intent = out + optional = True [clcn] standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction @@ -360,6 +366,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_fice] standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower @@ -368,6 +375,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_ndrop] standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment @@ -376,6 +384,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_nice] standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment @@ -384,6 +393,7 @@ type = real kind = kind_phys intent = out + optional = True [mp_phys] standard_name = control_for_microphysics_scheme long_name = flag for microphysics scheme diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 index bd0444bab..2d74779d1 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.F90 @@ -40,8 +40,8 @@ subroutine cs_conv_aw_adj_run(im, levs, do_cscnv, do_aw, do_shoc, & real(kind_phys), dimension(:,:), intent(in) :: save_t real(kind_phys), dimension(:,:,:), intent(in) :: save_q real(kind_phys), dimension(:,:), intent(in) :: prsi - real(kind_phys), dimension(:,:), intent(inout) :: cldfrac - real(kind_phys), dimension(:,:), intent(inout) :: subcldfrac + real(kind_phys), dimension(:,:), intent(inout), optional :: cldfrac + real(kind_phys), dimension(:,:), intent(inout), optional :: subcldfrac real(kind_phys), dimension(:), intent(inout) :: prcp integer, intent(in ) :: imp_physics, imp_physics_mg character(len=*), intent( out) :: errmsg diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta index 54350dbac..88c3d27c7 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_aw_adj.meta @@ -134,6 +134,7 @@ type = real kind = kind_phys intent = inout + optional = True [subcldfrac] standard_name = subgrid_scale_cloud_fraction_from_shoc long_name = subgrid-scale cloud fraction from the SHOC scheme @@ -142,6 +143,7 @@ type = real kind = kind_phys intent = inout + optional = True [prcp] standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep diff --git a/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta b/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta index 75de3fca7..5877c051b 100644 --- a/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta +++ b/physics/CONV/Chikira_Sugiyama/cs_conv_post.meta @@ -33,7 +33,7 @@ standard_name = convective_updraft_area_fraction_at_model_interfaces long_name = convective updraft area fraction at model interfaces units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in diff --git a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 index cbf02effb..5da78d9ec 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_deep.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_deep.F90 @@ -1,6 +1,7 @@ !>\file cu_gf_deep.F90 !! This file is the Grell-Freitas deep convection scheme. +!> This module contains the Grell_Freitas deep convection scheme module cu_gf_deep use machine , only : kind_phys use physcons, only : qamin @@ -142,7 +143,7 @@ subroutine cu_gf_deep_run( & !! betwee -1 and +1 ,do_capsuppress,cap_suppress_j & ! ,k22 & ! - ,jmin,kdt,tropics) ! + ,jmin,kdt,mc_thresh) ! implicit none @@ -158,7 +159,7 @@ subroutine cu_gf_deep_run( & !$acc declare copyin(rand_clos,rand_mom,rand_vmas) integer, intent(in) :: do_capsuppress - real(kind=kind_phys), intent(in), dimension(:) :: cap_suppress_j + real(kind=kind_phys), intent(in), dimension(:), optional :: cap_suppress_j !$acc declare create(cap_suppress_j) ! ! @@ -181,16 +182,16 @@ subroutine cu_gf_deep_run( & !$acc declare copy(cnvwt,outu,outv,outt,outq,outqc,cupclw,frh_out,pre,xmb_out) real(kind=kind_phys), dimension (its:ite) & ,intent (in ) :: & - hfx,qfx,xmbm_in,xmbs_in -!$acc declare copyin(hfx,qfx,xmbm_in,xmbs_in) + mc_thresh,hfx,qfx,xmbm_in,xmbs_in +!$acc declare copyin(mc_thresh,hfx,qfx,xmbm_in,xmbs_in) integer, dimension (its:ite) & ,intent (inout ) :: & kbcon,ktop !$acc declare copy(kbcon,ktop) integer, dimension (its:ite) & ,intent (in ) :: & - kpbl,tropics -!$acc declare copyin(kpbl,tropics) + kpbl +!$acc declare copyin(kpbl) ! ! basic environmental input includes moisture convergence (mconv) ! omega (omeg), windspeed (us,vs), and a flag (ierr) to turn off @@ -217,11 +218,11 @@ subroutine cu_gf_deep_run( & mconv,ccn !$acc declare copy(mconv,ccn) real(kind=kind_phys), dimension (:,:,:) & - ,intent (inout) :: & + ,intent (inout), optional :: & chem3d logical, intent (in) :: do_smoke_transport real(kind=kind_phys), dimension (:,:) & - , intent (out) :: wetdpc_deep + , intent (out), optional :: wetdpc_deep real(kind=kind_phys), intent (in) :: fscav(:) !$acc declare copy(chem3d) copyout(wetdpc_deep) copyin(fscav) @@ -316,7 +317,7 @@ subroutine cu_gf_deep_run( & real(kind=kind_phys), dimension (its:ite,kts:kte) :: pwdper, massflx integer :: nv !$acc declare create(chem,chem_cup,chem_up,chem_down,dellac,dellac2,chem_c,chem_pw,chem_pwd, & -!$acc chem_pwav,chem_psum,pwdper,massflux) +!$acc chem_pwav,chem_psum,pwdper,massflx) real(kind=kind_phys), dimension (its:ite,kts:kte) :: & entr_rate_2d,mentrd_rate_2d,he,hes,qes,z, heo,heso,qeso,zo, & @@ -376,7 +377,7 @@ subroutine cu_gf_deep_run( & !$acc ktopdby,kbconx,ierr2,ierr3,kbmax) integer, dimension (its:ite), intent(inout) :: ierr - integer, dimension (its:ite), intent(in) :: csum + integer, dimension (its:ite), intent(in), optional :: csum !$acc declare copy(ierr) copyin(csum) integer :: & iloop,nens3,ki,kk,i,k @@ -496,7 +497,7 @@ subroutine cu_gf_deep_run( & if(imid.eq.1)then c0(i)=0.002 endif - if(kdt.le.(4500./dtime))rrfs_factor(i)=1.-(float(kdt)/(4500./dtime)-1.)**2 +! if(kdt.le.(4500./dtime))rrfs_factor(i)=1.-(float(kdt)/(4500./dtime)-1.)**2 enddo !$acc end kernels @@ -573,15 +574,15 @@ subroutine cu_gf_deep_run( & ! !$acc kernels start_level(:)=kte + frh_out(:) = 0. !$acc end kernels !$acc kernels !$acc loop private(radius,frh) do i=its,ite c1d(i,:)= 0. !c1 ! 0. ! c1 ! max(.003,c1+float(csum(i))*.0001) - entr_rate(i)=7.e-5 - min(20.,float(csum(i))) * 3.e-6 - if(xland1(i) == 0)entr_rate(i)=7.e-5 - if(dx(i)\file cu_gf_driver.F90 !! This file is scale-aware Grell-Freitas cumulus scheme driver. - +!> This module contains the scale-aware Grell-Freitas cumulus scheme driver. module cu_gf_driver ! DH* TODO: replace constants with arguments to cu_gf_driver_run @@ -82,7 +82,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co integer :: ichoicem=13 ! 0 2 5 13 integer :: ichoice_s=3 ! 0 1 2 3 integer, intent(in) :: spp_cu_deep ! flag for using SPP perturbations - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), optional, intent(in) :: & & spp_wts_cu_deep real(kind=kind_phys) :: spp_wts_cu_deep_tmp @@ -102,15 +102,16 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co real (kind=kind_phys), intent(in) :: g,cp,xlv,r_v logical, intent(in ) :: ldiag3d - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) !$acc declare copy(dtend) integer, intent(in) :: dtidx(:,:), & index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_scnv, index_of_process_dcnv, ntqv, ntcw, ntiw !$acc declare copyin(dtidx) - real(kind=kind_phys), dimension( : , : ), intent(in ) :: forcet,forceqv_spechum,w,phil + real(kind=kind_phys), dimension( : , : ), intent(in ), optional :: forcet,forceqv_spechum + real(kind=kind_phys), dimension( : , : ), intent(in ) :: w,phil real(kind=kind_phys), dimension( : , : ), intent(inout ) :: t,us,vs - real(kind=kind_phys), dimension( : , : ), intent(inout ) :: qci_conv + real(kind=kind_phys), dimension( : , : ), intent(inout ), optional :: qci_conv real(kind=kind_phys), dimension( : , : ), intent(out ) :: cnvw_moist,cnvc real(kind=kind_phys), dimension( : , : ), intent(inout ) :: cliw, clcw !$acc declare copyin(forcet,forceqv_spechum,w,phil) @@ -122,27 +123,30 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co integer, intent(in) :: dfi_radar_max_intervals real(kind=kind_phys), intent(in) :: fhour, fh_dfi_radar(:) integer, intent(in) :: num_dfi_radar, ix_dfi_radar(:) - real(kind=kind_phys), intent(in) :: cap_suppress(:,:) + real(kind=kind_phys), intent(in), optional :: cap_suppress(:,:) !$acc declare copyin(fh_dfi_radar,ix_dfi_radar,cap_suppress) integer, dimension (:), intent(out) :: hbot,htop,kcnv integer, dimension (:), intent(in) :: xland - real(kind=kind_phys), dimension (:), intent(in) :: pbl,maxMF + real(kind=kind_phys), dimension (:), intent(in) :: pbl + real(kind=kind_phys), dimension (:), intent(in) :: maxMF !$acc declare copyout(hbot,htop,kcnv) !$acc declare copyin(xland,pbl) integer, dimension (im) :: tropics !$acc declare create(tropics) ! ruc variable real(kind=kind_phys), dimension (:), intent(in) :: hfx2,qfx2,psuri - real(kind=kind_phys), dimension (:,:), intent(out) :: ud_mf,dd_mf,dt_mf - real(kind=kind_phys), dimension (:), intent(out) :: raincv,cld1d,maxupmf + real(kind=kind_phys), dimension (:,:), intent(out) :: dd_mf,dt_mf + real(kind=kind_phys), dimension (:,:), intent(out), optional :: ud_mf + real(kind=kind_phys), dimension (:), intent(out) :: raincv,cld1d + real(kind=kind_phys), dimension (:), intent(out), optional :: maxupmf real(kind=kind_phys), dimension (:,:), intent(in) :: t2di,p2di !$acc declare copyin(hfx2,qfx2,psuri,t2di,p2di) !$acc declare copyout(ud_mf,dd_mf,dt_mf,raincv,cld1d) ! Specific humidity from FV3 real(kind=kind_phys), dimension (:,:), intent(in) :: qv2di_spechum real(kind=kind_phys), dimension (:,:), intent(inout) :: qv_spechum - real(kind=kind_phys), dimension (:), intent(inout) :: aod_gf + real(kind=kind_phys), dimension (:), intent(inout), optional :: aod_gf !$acc declare copyin(qv2di_spechum) copy(qv_spechum,aod_gf) ! Local water vapor mixing ratios and cloud water mixing ratios real(kind=kind_phys), dimension (im,km) :: qv2di, qv, forceqv, cnvw @@ -153,11 +157,11 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co real(kind=kind_phys), intent(in ) :: dt integer, intent(in ) :: imfshalcnv - integer, dimension(:), intent(inout) :: cactiv,cactiv_m + integer, dimension(:), intent(inout), optional :: cactiv,cactiv_m real(kind_phys), dimension(:), intent(in) :: fscav !$acc declare copyin(fscav) - real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d - real(kind_phys), dimension(:,:), intent(inout) :: wetdpc_deep + real(kind_phys), dimension(:,:,:), intent(inout), optional :: chem3d + real(kind_phys), dimension(:,:), intent(inout), optional :: wetdpc_deep !$acc declare copy(cactiv,cactiv_m,chem3d,wetdpc_deep) character(len=*), intent(out) :: errmsg @@ -216,10 +220,10 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co real(kind=kind_phys), dimension (im,km) :: qcheck,zo,t2d,q2d,po,p2d,rhoi,clw_ten real(kind=kind_phys), dimension (im,km) :: tn,qo,tshall,qshall,dz8w,omeg real(kind=kind_phys), dimension (im) :: z1,psur,cuten,cutens,cutenm - real(kind=kind_phys), dimension (im) :: umean,vmean,pmean + real(kind=kind_phys), dimension (im) :: umean,vmean,pmean,mc_thresh real(kind=kind_phys), dimension (im) :: xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv !$acc declare create(qcheck,zo,t2d,q2d,po,p2d,rhoi,clw_ten,tn,qo,tshall,qshall,dz8w,omeg, & -!$acc z1,psur,cuten,cutens,cutenm,umean,vmean,pmean, & +!$acc z1,psur,cuten,cutens,cutenm,umean,vmean,pmean,mc_thresh, & !$acc xmbs,xmbs2,xmb,xmbm,xmb_dumm,mconv) integer :: i,j,k,icldck,ipr,jpr,jpr_deep,ipr_deep,uidx,vidx,tidx,qidx @@ -592,6 +596,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co hfx(i)=hfx2(i)*cp*rhoi(i,1) qfx(i)=qfx2(i)*xlv*rhoi(i,1) dx(i) = sqrt(garea(i)) + mc_thresh(i)=3.25/dx(i) enddo do i=its,itf @@ -766,7 +771,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22m & - ,jminm,kdt,tropics) + ,jminm,kdt,mc_thresh) !$acc kernels do i=its,itf do k=kts,ktf @@ -812,33 +817,32 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co ,dx & ,mconv & ,omeg & - - ,cactiv & - ,cnvwt & - ,zu & - ,zd & - ,zdm & ! hli - ,edt & - ,edtm & ! hli - ,xmb & - ,xmbm & - ,xmbs & - ,pret & - ,outu & - ,outv & - ,outt & - ,outq & - ,outqc & - ,kbcon & - ,ktop & - ,cupclw & - ,frhd & - ,ierr & - ,ierrc & - ,nchem & - ,fscav & - ,chem3d & - ,wetdpc_deep & + ,cactiv & + ,cnvwt & + ,zu & + ,zd & + ,zdm & ! hli + ,edt & + ,edtm & ! hli + ,xmb & + ,xmbm & + ,xmbs & + ,pret & + ,outu & + ,outv & + ,outt & + ,outq & + ,outqc & + ,kbcon & + ,ktop & + ,cupclw & + ,frhd & + ,ierr & + ,ierrc & + ,nchem & + ,fscav & + ,chem3d & + ,wetdpc_deep & ,do_smoke_transport & ! the following should be set to zero if not available ,rand_mom & ! for stochastics mom, if temporal and spatial patterns exist @@ -853,7 +857,7 @@ subroutine cu_gf_driver_run(ntracer,garea,im,km,dt,flag_init,flag_restart, gf_co ! betwee -1 and +1 ,do_cap_suppress_here,cap_suppress_j & ,k22 & - ,jmin,kdt,tropics) + ,jmin,kdt,mc_thresh) jpr=0 ipr=0 !$acc kernels diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver.meta b/physics/CONV/Grell_Freitas/cu_gf_driver.meta index 57b4e900b..39a20f755 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver.meta @@ -128,6 +128,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout + optional = True [cactiv_m] standard_name = counter_for_grell_freitas_mid_level_convection long_name = mid-level cloud convective activity memory @@ -135,6 +136,7 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout + optional = True [g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -175,6 +177,7 @@ type = real kind = kind_phys intent = in + optional = True [forceqv_spechum] standard_name = tendendy_of_specific_humidity_due_to_nonphysics long_name = moisture tendency due to dynamics only @@ -183,6 +186,7 @@ type = real kind = kind_phys intent = in + optional = True [phil] standard_name = geopotential long_name = layer geopotential @@ -363,6 +367,7 @@ type = real kind = kind_phys intent = out + optional = True [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt @@ -424,6 +429,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -509,6 +515,7 @@ type = real kind = kind_phys intent = inout + optional = True [fhour] standard_name = forecast_time long_name = current forecast time @@ -554,6 +561,7 @@ type = real kind = kind_phys intent = in + optional = True [maxupmf] standard_name = maximum_convective_updraft_mass_flux long_name = maximum convective updraft mass flux within a column @@ -562,6 +570,7 @@ type = real kind = kind_phys intent = out + optional = True [maxMF] standard_name = maximum_mass_flux long_name = maximum mass flux within a column @@ -570,6 +579,7 @@ type = real kind = kind_phys intent = in + optional = True [do_mynnedmf] standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme long_name = flag to activate MYNN-EDMF @@ -613,6 +623,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_cu_deep] standard_name = control_for_deep_convection_spp_perturbations long_name = control for deep convection spp perturbations @@ -635,6 +646,7 @@ type = real kind = kind_phys intent = inout + optional = True [fscav] standard_name = smoke_dust_conv_wet_coef long_name = smoke dust convetive wet scavanging coefficents @@ -658,6 +670,7 @@ type = real kind = kind_phys intent = inout + optional = True [kdt] standard_name = index_of_timestep long_name = current forecast iteration diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver_post.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver_post.F90 index 6ed1321bc..d01991088 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver_post.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_post.F90 @@ -1,6 +1,7 @@ !> \file cu_gf_driver_post.F90 !! Contains code related to GF convective schemes to be used within the GFS physics suite. +!> This module contains code related to GF convective schemes to be used within the GFS physics suite module cu_gf_driver_post implicit none @@ -15,7 +16,7 @@ module cu_gf_driver_post !> \section arg_table_cu_gf_driver_post_run Argument Table !! \htmlinclude cu_gf_driver_post_run.html !! - subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, rrfs_sd, ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, errmsg, errflg) + subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m, conv_act, conv_act_m, ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, errmsg, errflg) use machine, only: kind_phys @@ -31,9 +32,9 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m integer, intent(in) :: cactiv_m(:) real(kind_phys), intent(out) :: conv_act(:) real(kind_phys), intent(out) :: conv_act_m(:) - logical, intent(in) :: rrfs_sd integer, intent(in) :: ntsmoke, ntdust, ntcoarsepm - real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:) + real(kind_phys), intent(inout), optional :: chem3d(:,:,:) + real(kind_phys), intent(inout) :: gq0(:,:,:) character(len=*), intent(out) :: errmsg !$acc declare copyin(t,q,cactiv,cactiv_m) copyout(prevst,prevsq,conv_act,conv_act_m,chem3d,gq0) integer, intent(out) :: errflg @@ -62,7 +63,7 @@ subroutine cu_gf_driver_post_run (im, km, t, q, prevst, prevsq, cactiv, cactiv_m endif enddo - if (rrfs_sd) then + if (present(chem3d)) then gq0(:,:,ntsmoke ) = chem3d(:,:,1) gq0(:,:,ntdust ) = chem3d(:,:,2) gq0(:,:,ntcoarsepm) = chem3d(:,:,3) diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta b/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta index 478d48987..f1113302c 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_post.meta @@ -83,13 +83,6 @@ type = real kind = kind_phys intent = out -[rrfs_sd] - standard_name = do_smoke_coupling - long_name = flag controlling rrfs_sd collection - units = flag - dimensions = () - type = logical - intent = in [ntsmoke] standard_name = index_for_smoke_in_tracer_concentration_array long_name = tracer index for smoke @@ -127,6 +120,7 @@ type = real kind = kind_phys intent = inout + optional = True [gq0] standard_name = tracer_concentration_of_new_state long_name = tracer concentration updated by physics diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90 b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90 index f48daa112..58e1667d4 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.F90 @@ -1,6 +1,7 @@ !> \file cu_gf_driver_pre.F90 !! Contains code related to GF convective schemes to be used within the GFS physics suite. +!> This module contains code related to GF convective schemes to be used within the GFS physics suite. module cu_gf_driver_pre implicit none @@ -17,8 +18,7 @@ module cu_gf_driver_pre !! subroutine cu_gf_driver_pre_run (flag_init, flag_restart, gf_coldstart, kdt, fhour, dtp, t, q, prevst, prevsq, & forcet, forceq, cactiv, cactiv_m, conv_act, conv_act_m, & - rrfs_sd, ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, & - errmsg, errflg) + ntsmoke, ntdust, ntcoarsepm, chem3d, gq0, errmsg, errflg) use machine, only: kind_phys @@ -26,8 +26,7 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, gf_coldstart, kdt, fho logical, intent(in) :: flag_init logical, intent(in) :: flag_restart - logical, intent(in) :: gf_coldstart - logical, intent(in) :: rrfs_sd + logical, intent(in) :: gf_coldstart integer, intent(in) :: kdt real(kind_phys), intent(in) :: fhour real(kind_phys), intent(in) :: dtp @@ -44,7 +43,8 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, gf_coldstart, kdt, fho !$acc declare copyout(forcet,forceq,cactiv,cactiv_m) real(kind_phys), intent(in) :: conv_act(:) real(kind_phys), intent(in) :: conv_act_m(:) - real(kind_phys), intent(inout) :: chem3d(:,:,:), gq0(:,:,:) + real(kind_phys), intent(inout), optional :: chem3d(:,:,:) + real(kind_phys), intent(inout) :: gq0(:,:,:) !$acc declare copyin(conv_act,conv_act_m) copy(chem3d,gq0) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -83,7 +83,7 @@ subroutine cu_gf_driver_pre_run (flag_init, flag_restart, gf_coldstart, kdt, fho cactiv(:)=nint(conv_act(:)) cactiv_m(:)=nint(conv_act_m(:)) - if (rrfs_sd) then + if (present(chem3d)) then chem3d(:,:,1) = gq0(:,:,ntsmoke) chem3d(:,:,2) = gq0(:,:,ntdust) chem3d(:,:,3) = gq0(:,:,ntcoarsepm) diff --git a/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta index b86a378b6..7635e3170 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta +++ b/physics/CONV/Grell_Freitas/cu_gf_driver_pre.meta @@ -129,13 +129,6 @@ dimensions = () type = logical intent = in -[rrfs_sd] - standard_name = do_smoke_coupling - long_name = flag controlling rrfs_sd collection - units = flag - dimensions = () - type = logical - intent = in [ntsmoke] standard_name = index_for_smoke_in_tracer_concentration_array long_name = tracer index for smoke @@ -165,6 +158,7 @@ type = real kind = kind_phys intent = inout + optional = True [gq0] standard_name = tracer_concentration_of_new_state long_name = tracer concentration updated by physics diff --git a/physics/CONV/Grell_Freitas/cu_gf_sh.F90 b/physics/CONV/Grell_Freitas/cu_gf_sh.F90 index 9af9567ad..527b662e5 100644 --- a/physics/CONV/Grell_Freitas/cu_gf_sh.F90 +++ b/physics/CONV/Grell_Freitas/cu_gf_sh.F90 @@ -1,6 +1,7 @@ !>\file cu_gf_sh.F90 !! This file contains Grell-Freitas shallow convection scheme. +!> This module contains the Grell-Freitas shallow convection scheme module cu_gf_sh use machine , only : kind_phys !real(kind=kind_phys), parameter:: c1_shal=0.0015! .0005 diff --git a/physics/CONV/RAS/rascnv.F90 b/physics/CONV/RAS/rascnv.F90 index 0b57de1fe..37945bed4 100644 --- a/physics/CONV/RAS/rascnv.F90 +++ b/physics/CONV/RAS/rascnv.F90 @@ -331,14 +331,16 @@ subroutine rascnv_run(IM, k, itc, ntc, ntr, dt, dtf & real(kind=kind_phys), dimension(:,:), intent(inout) :: tin, qin, uin, vin real(kind=kind_phys), dimension(:,:), intent(in) :: prsl, prslk, phil & &, rhc - real(kind=kind_phys), dimension(:,:), intent(out) :: ud_mf, dd_mf, dt_mf - real(kind=kind_phys), dimension(:,:), intent(inout) :: qlcn, qicn, w_upi & + real(kind=kind_phys), dimension(:,:), intent(out) :: ud_mf + real(kind=kind_phys), dimension(:,:), intent(out) :: dd_mf, dt_mf + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: qlcn, qicn, w_upi & &, cnv_mfd & &, cnv_dqldt, clcn & &, cnv_fice, cnv_ndrop & &, cnv_nice, cf_upi real(kind=kind_phys), dimension(:) , intent(in) :: area, cdrag - real(kind=kind_phys), dimension(:) , intent(out) :: rainc, ddvel + real(kind=kind_phys), dimension(:) , intent(out) :: rainc + real(kind=kind_phys), dimension(:) , intent(out) :: ddvel real(kind=kind_phys), dimension(:,:), intent(in) :: rannum real(kind=kind_phys), intent(inout) :: ccin(:,:,:) real(kind=kind_phys), intent(in) :: dt, dtf diff --git a/physics/CONV/RAS/rascnv.meta b/physics/CONV/RAS/rascnv.meta index f5a707ded..9969e10b5 100644 --- a/physics/CONV/RAS/rascnv.meta +++ b/physics/CONV/RAS/rascnv.meta @@ -514,6 +514,7 @@ type = real kind = kind_phys intent = inout + optional = True [qicn] standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water @@ -522,6 +523,7 @@ type = real kind = kind_phys intent = inout + optional = True [w_upi] standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft @@ -530,6 +532,7 @@ type = real kind = kind_phys intent = inout + optional = True [cf_upi] standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics @@ -538,6 +541,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_mfd] standard_name = detrained_mass_flux long_name = detrained mass flux @@ -546,6 +550,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_dqldt] standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics @@ -554,6 +559,7 @@ type = real kind = kind_phys intent = inout + optional = True [clcn] standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction @@ -562,6 +568,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_fice] standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower @@ -570,6 +577,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_ndrop] standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment @@ -578,6 +586,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_nice] standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment @@ -586,6 +595,7 @@ type = real kind = kind_phys intent = inout + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/CONV/SAMF/samfaerosols.F b/physics/CONV/SAMF/samfaerosols.F index 66faf1fb9..ade8f1b5a 100644 --- a/physics/CONV/SAMF/samfaerosols.F +++ b/physics/CONV/SAMF/samfaerosols.F @@ -1,3 +1,5 @@ +!>\file samfaerosols.F +!! module samfcnv_aerosols implicit none diff --git a/physics/CONV/SAMF/samfdeepcnv.f b/physics/CONV/SAMF/samfdeepcnv.f index beeafcd14..1ccff17e5 100644 --- a/physics/CONV/SAMF/samfdeepcnv.f +++ b/physics/CONV/SAMF/samfdeepcnv.f @@ -8,7 +8,8 @@ module samfdeepcnv use samfcnv_aerosols, only : samfdeepcnv_aerosols use progsigma, only : progsigma_calc - + use progomega, only : progomega_calc + contains subroutine samfdeepcnv_init(imfdeepcnv,imfdeepcnv_samf, & @@ -76,15 +77,16 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & & tmf,qmicro,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp, & - & prslp,psp,phil,qtr,prevsq,q,q1,t1,u1,v1,fscav, & - & hwrf_samfdeep,progsigma,cldwrk,rn,kbot,ktop,kcnv, & + & prslp,psp,phil,tkeh,qtr,prevsq,q,q1,t1,u1,v1,fscav, & + & hwrf_samfdeep,progsigma,progomega,cldwrk,rn,kbot,ktop,kcnv, & & islimsk,garea,dot,ncloud,hpbl,ud_mf,dd_mf,dt_mf,cnvw,cnvc, & & QLCN, QICN, w_upi, cf_upi, CNV_MFD, & & CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE,mp_phys,mp_phys_mg,& - & clam,c0s,c1,betal,betas,evef,pgcon,asolfac, & + & clam,c0s,c1,betal,betas,evef,pgcon,asolfac,cscale, & & do_ca, ca_closure, ca_entr, ca_trigger, nthresh,ca_deep, & - & rainevap,sigmain,sigmaout,betadcu,betamcu,betascu, & - & maxMF, do_mynnedmf,sigmab_coldstart,errmsg,errflg) + & rainevap,sigmain,sigmaout,omegain,omegaout,betadcu,betamcu, & + & betascu,maxMF,do_mynnedmf,sigmab_coldstart,errmsg,errflg) + ! use machine , only : kind_phys use funcphys , only : fpvs @@ -95,36 +97,38 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & integer, intent(in) :: islimsk(:) real(kind=kind_phys), intent(in) :: cliq, cp, cvap, eps, epsm1, & & fv, grav, hvap, rd, rv, t0c - real(kind=kind_phys), intent(in) :: delt + real(kind=kind_phys), intent(in) :: delt, cscale real(kind=kind_phys), intent(in) :: psp(:), delp(:,:), & - & prslp(:,:), garea(:), hpbl(:), dot(:,:), phil(:,:) + & prslp(:,:), garea(:), hpbl(:), dot(:,:), phil(:,:) real(kind=kind_phys), dimension(:), intent(in) :: fscav logical, intent(in) :: first_time_step,restart,hwrf_samfdeep, & - & progsigma,do_mynnedmf,sigmab_coldstart + & progsigma,progomega,do_mynnedmf,sigmab_coldstart real(kind=kind_phys), intent(in) :: nthresh,betadcu,betamcu, & & betascu - real(kind=kind_phys), intent(in) :: ca_deep(:) - real(kind=kind_phys), intent(in) :: sigmain(:,:),qmicro(:,:), & - & tmf(:,:,:),q(:,:), prevsq(:,:) - real(kind=kind_phys), dimension (:), intent(in) :: maxMF + real(kind=kind_phys), intent(in), optional :: ca_deep(:) + real(kind=kind_phys), intent(in), optional :: sigmain(:,:), & + & qmicro(:,:), prevsq(:,:), omegain(:,:) + real(kind=kind_phys), intent(in) :: tmf(:,:,:),q(:,:) + real(kind=kind_phys), dimension (:), intent(in), optional :: maxMF real(kind=kind_phys), intent(out) :: rainevap(:) - real(kind=kind_phys), intent(out) :: sigmaout(:,:) + real(kind=kind_phys), intent(inout), optional :: sigmaout(:,:), & + & omegaout(:,:) logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger integer, intent(inout) :: kcnv(:) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH real(kind=kind_phys), intent(inout) :: qtr(:,:,:), & & q1(:,:), t1(:,:), u1(:,:), v1(:,:), & - & cnvw(:,:), cnvc(:,:) + & cnvw(:,:), cnvc(:,:), tkeh(:,:) integer, intent(out) :: kbot(:), ktop(:) real(kind=kind_phys), intent(out) :: cldwrk(:), & & rn(:), & - & ud_mf(:,:),dd_mf(:,:), dt_mf(:,:) - + & dd_mf(:,:), dt_mf(:,:) + real(kind=kind_phys), intent(out) :: ud_mf(:,:) ! GJF* These variables are conditionally allocated depending on whether the ! Morrison-Gettelman microphysics is used, so they must be declared ! using assumed shape. - real(kind=kind_phys), dimension(:,:), intent(inout) :: & + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: & & qlcn, qicn, w_upi, cnv_mfd, cnv_dqldt, clcn & &, cnv_fice, cnv_ndrop, cnv_nice, cf_upi ! *GJF @@ -214,7 +218,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & ! ! parameters for prognostic sigma closure real(kind=kind_phys) omega_u(im,km),zdqca(im,km),tmfq(im,km), - & omegac(im),zeta(im,km),dbyo1(im,km),sigmab(im),qadv(im,km) + & omegac(im),zeta(im,km),dbyo1(im,km),sigmab(im),qadv(im,km), + & tentr(im,km) real(kind=kind_phys) gravinv,invdelt,sigmind,sigminm,sigmins parameter(sigmind=0.01,sigmins=0.03,sigminm=0.01) logical flag_shallow, flag_mid @@ -331,6 +336,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & c----------------------------------------------------------------------- !> ## Compute preliminary quantities needed for static, dynamic, and feedback control portions of the algorithm. !> - Convert input pressure terms to centibar units. + !************************************************************************ ! convert input Pa terms to Cb terms -- Moorthi ps = psp * 0.001 @@ -951,8 +957,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & if(cnvflg(i)) then if(k >= kb(i) .and. k < kbcon(i)) then dz = zo(i,k+1) - zo(i,k) - tem = 0.5 * (qtr(i,k,ntk)+qtr(i,k+1,ntk)) - tkemean(i) = tkemean(i) + tem * dz + tkemean(i) = tkemean(i) + tkeh(i,k) * dz sumx(i) = sumx(i) + dz endif endif @@ -1105,8 +1110,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & if(cnvflg(i).and. & (k > kbcon(i) .and. k < kmax(i))) then tem = qeso(i,k)/qeso(i,kbcon(i)) - fent1(i,k) = tem**2 - fent2(i,k) = tem**3 + fent1(i,k) = min(tem**2, 3.0) + fent2(i,k) = min(tem**3, 5.2) endif enddo enddo @@ -1129,7 +1134,8 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & do k = 2, km1 do i=1,im if(cnvflg(i) .and. - & (k > kbcon(i) .and. k < kmax(i))) then + & (k > kbcon(i) .and. k < kmax(i))) then + tentr(i,k)=xlamue(i,k)*fent1(i,k) tem = cxlamet(i) * frh(i,k) * fent2(i,k) xlamue(i,k) = xlamue(i,k)*fent1(i,k) + tem tem1 = cxlamdt(i) * frh(i,k) @@ -1284,6 +1290,24 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & enddo enddo enddo + if(ntk > 2) then + kk = ntk -2 + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k > kb(i) .and. k < kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.25 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem = cq * tem + factor = 1. + tem + ecko(i,k,kk) = ((1. - tem) * ecko(i,k-1,kk) + tem * + & (ctro(i,k,kk) + ctro(i,k-1,kk))) / factor + ercko(i,k,kk) = ecko(i,k,kk) + endif + endif + enddo + enddo + endif endif endif c @@ -1649,9 +1673,9 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & if(totflg) return !! c -c estimate the onvective overshooting as the level +c Estimate the convective overshooting as the level c where the [aafac * cloud work function] becomes zero, -c which is the final cloud top +c which is the final cloud top. c !> - Continue calculating the cloud work function past the point of neutral buoyancy to represent overshooting according to Han and Pan (2011) \cite han_and_pan_2011 . Convective overshooting stops when \f$ cA_u < 0\f$ where \f$c\f$ is currently 10%, or when 10% of the updraft cloud work function has been consumed by the stable buoyancy force. do i = 1, im @@ -1741,43 +1765,64 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & enddo ! ! compute updraft velocity square(wu2) -!> - Calculate updraft velocity square(wu2) according to Han et al.'s (2017) \cite han_et_al_2017 equation 7. -! +!> - Calculate diagnostic updraft velocity square(wu2) according to Han et al.'s (2017) \cite han_et_al_2017 equation 7. +!> - if progomega = true, calculate prognostic updraft velocity (Pa/s) according to progomega routine. + if (hwrf_samfdeep) then - do i = 1, im - if (cnvflg(i)) then - k = kbcon1(i) - tem = po(i,k) / (rd * to(i,k)) - wucb = -0.01 * dot(i,k) / (tem * grav) - if(wucb.gt.0.) then - wu2(i,k) = wucb * wucb - else - wu2(i,k) = 0. - endif - endif - enddo - endif -! - do k = 2, km1 - do i = 1, im - if (cnvflg(i)) then - if(k > kbcon1(i) .and. k < ktcon(i)) then - dz = zi(i,k) - zi(i,k-1) - tem = 0.25 * bb1 * (drag(i,k-1)+drag(i,k)) * dz - tem1 = 0.5 * bb2 * (buo(i,k-1)+buo(i,k)) - tem2 = wush(i,k) * sqrt(wu2(i,k-1)) - tem2 = (tem1 - tem2) * dz - ptem = (1. - tem) * wu2(i,k-1) - ptem1 = 1. + tem - wu2(i,k) = (ptem + tem2) / ptem1 - wu2(i,k) = max(wu2(i,k), 0.) + do i = 1, im + if (cnvflg(i)) then + k = kbcon1(i) + tem = po(i,k) / (rd * to(i,k)) + wucb = -0.01 * dot(i,k) / (tem * grav) + if(wucb.gt.0.) then + wu2(i,k) = wucb * wucb + else + wu2(i,k) = 0. + endif endif - endif - enddo - enddo - - if(progsigma)then - do k = 2, km1 + enddo + endif +! + if (progomega) then + call progomega_calc(first_time_step,restart,im,km, + & kbcon1,ktcon,omegain,delt,del,zi,cnvflg,omegaout, + & grav,buo,drag,wush,tentr,bb1,bb2) + do k = 1, km + do i = 1, im + if (cnvflg(i)) then + if(k > kbcon1(i) .and. k < ktcon(i)) then + omega_u(i,k)=omegaout(i,k) + omega_u(i,k)=MAX(omega_u(i,k),-80.) +! Convert to m/s for use in convective time-scale: + rho = po(i,k)*100. / (rd * to(i,k)) + tem = (-omega_u(i,k)) / ((rho * grav)) + wu2(i,k) = tem**2 + wu2(i,k) = max(wu2(i,k), 0.) + endif + endif + enddo + enddo + else +! diagnostic method: + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k > kbcon1(i) .and. k < ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.25 * bb1 * (drag(i,k-1)+drag(i,k)) * dz + tem1 = 0.5 * bb2 * (buo(i,k-1)+buo(i,k)) + tem2 = wush(i,k) * sqrt(wu2(i,k-1)) + tem2 = (tem1 - tem2) * dz + ptem = (1. - tem) * wu2(i,k-1) + ptem1 = 1. + tem + wu2(i,k) = (ptem + tem2) / ptem1 + wu2(i,k) = max(wu2(i,k), 0.) + endif + endif + enddo + enddo +! convert to Pa/s for use in closure + do k = 1, km do i = 1, im if (cnvflg(i)) then if(k > kbcon1(i) .and. k < ktcon(i)) then @@ -1788,10 +1833,11 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & endif enddo enddo - endif + + endif !progomega + ! ! compute updraft velocity average over the whole cumulus -! !> - Calculate the mean updraft velocity within the cloud (wc). do i = 1, im wc(i) = 0. @@ -1819,11 +1865,10 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & val = 1.e-4 if (wc(i) < val) cnvflg(i)=.false. endif - enddo + enddo c - !> - For progsigma = T, calculate the mean updraft velocity within the cloud (omegac),cast in pressure coordinates. - if(progsigma)then + if(progsigma)then do i = 1, im omegac(i) = 0. sumx(i) = 0. @@ -2492,10 +2537,10 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & c c------- final changed variable per unit mass flux c -!> - If grid size is less than a threshold value (dxcrtas: currently 8km if progsigma is not used and 30km if progsigma is used), the quasi-equilibrium assumption of Arakawa-Schubert is not used any longer. +!> - If grid size is less than a threshold value (dxcrtas: currently 8km if progsigma is not used), or progsigma = true, the quasi-equilibrium assumption of Arakawa-Schubert is not used any longer. ! if(progsigma)then - dxcrtas=30.e3 + dxcrtas=500.e3 dxcrtuf=10.e3 else dxcrtas=8.e3 @@ -2910,10 +2955,9 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & advfac(i) = min(advfac(i), 1.) endif enddo - + !> - From Bengtsson et al. (2022) \cite Bengtsson_2022 prognostic closure scheme, equation 8, call progsigma_calc() to compute updraft area fraction based on a moisture budget if(progsigma)then - !Initial computations, dynamic q-tendency if(first_time_step .and. (.not.restart & .or. sigmab_coldstart))then @@ -2940,7 +2984,7 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & flag_mid = .false. call progsigma_calc(im,km,first_time_step,restart,flag_shallow, & flag_mid,del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, - & delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, + & delt,qadv,kb,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, & sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif @@ -3423,17 +3467,20 @@ subroutine samfdeepcnv_run (im,km,first_time_step,restart, & endif enddo c -c convective cloud water -c !> - Calculate convective cloud water. do k = 1, km - do i = 1, im - if (cnvflg(i) .and. rn(i) > 0.) then - if (k >= kbcon(i) .and. k < ktcon(i)) then - cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + do i = 1, im + if (cnvflg(i) .and. rn(i) > 0.) then + if (k >= kbcon(i) .and. k < ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + if(progsigma)then + cnvw(i,k) = cnvw(i,k) * cscale + else + cnvw(i,k) = cnvw(i,k) * cscale + endif + endif endif - endif - enddo + enddo enddo c c convective cloud cover diff --git a/physics/CONV/SAMF/samfdeepcnv.meta b/physics/CONV/SAMF/samfdeepcnv.meta index f015de39e..1fc5fdf62 100644 --- a/physics/CONV/SAMF/samfdeepcnv.meta +++ b/physics/CONV/SAMF/samfdeepcnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = samfdeepcnv type = scheme - dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,samfaerosols.F,../progsigma_calc.f90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,samfaerosols.F,../progsigma_calc.f90,../progomega_calc.f90 ######################################################################## [ccpp-arg-table] @@ -85,6 +85,7 @@ type = real kind = kind_phys intent = in + optional = True [itc] standard_name = index_of_first_chemical_tracer_for_convection long_name = index of first chemical tracer transported/scavenged by convection @@ -187,6 +188,14 @@ type = real kind = kind_phys intent = in +[cscale] + standard_name = multiplicative_tuning_parameter_for_convective_cloud_water + long_name = multiplicative tuning parameter for convective cloud_water + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [delt] standard_name = timestep_for_physics long_name = physics time step @@ -241,6 +250,14 @@ type = real kind = kind_phys intent = in +[tkeh] + standard_name = vertical_turbulent_kinetic_energy_at_interface + long_name = vertical turbulent kinetic energy at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout [qtr] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers @@ -257,6 +274,7 @@ type = real kind = kind_phys intent = in + optional = True [q] standard_name = specific_humidity long_name = water vapor specific humidity @@ -319,6 +337,13 @@ dimensions = () type = logical intent = in +[progomega] + standard_name = do_prognostic_updraft_velocity + long_name = flag for prognostic omega in cumuls scheme + units = flag + dimensions = () + type = logical + intent = in [cldwrk] standard_name = cloud_work_function long_name = cloud work function @@ -442,6 +467,7 @@ type = real kind = kind_phys intent = in + optional = True [sigmaout] standard_name = updraft_area_fraction_updated_by_physics long_name = convective updraft area fraction updated by physics @@ -449,7 +475,26 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout + optional = True +[omegain] + standard_name = prognostic_updraft_velocity_in_convection + long_name = convective updraft velocity + units = Pa s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[omegaout] + standard_name = updraft_velocity_updated_by_physics + long_name = convective updraft velocity updated by physics + units = Pa s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True [betascu] standard_name = tuning_param_for_shallow_cu long_name = tuning param for shallow cu in case prognostic closure is used @@ -481,6 +526,7 @@ type = real kind = kind_phys intent = in + optional = True [do_mynnedmf] standard_name = flag_for_mellor_yamada_nakanishi_niino_pbl_scheme long_name = flag to activate MYNN-EDMF @@ -503,6 +549,7 @@ type = real kind = kind_phys intent = inout + optional = True [qicn] standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water @@ -511,6 +558,7 @@ type = real kind = kind_phys intent = inout + optional = True [w_upi] standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft @@ -519,6 +567,7 @@ type = real kind = kind_phys intent = inout + optional = True [cf_upi] standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics @@ -527,6 +576,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_mfd] standard_name = detrained_mass_flux long_name = detrained mass flux @@ -535,6 +585,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_dqldt] standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics @@ -543,6 +594,7 @@ type = real kind = kind_phys intent = inout + optional = True [clcn] standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction @@ -551,6 +603,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_fice] standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower @@ -559,6 +612,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_ndrop] standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment @@ -567,6 +621,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_nice] standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment @@ -575,6 +630,7 @@ type = real kind = kind_phys intent = inout + optional = True [mp_phys] standard_name = control_for_microphysics_scheme long_name = choice of microphysics scheme @@ -697,6 +753,7 @@ type = real kind = kind_phys intent = in + optional = True [rainevap] standard_name = physics_field_for_coupling long_name = physics_field_for_coupling diff --git a/physics/CONV/SAMF/samfshalcnv.f b/physics/CONV/SAMF/samfshalcnv.f index d0bab05dd..bc69f0ebb 100644 --- a/physics/CONV/SAMF/samfshalcnv.f +++ b/physics/CONV/SAMF/samfshalcnv.f @@ -1,11 +1,12 @@ !> \file samfshalcnv.f -!! This file contains the Scale-Aware mass flux Shallow Convection scheme. +!! +!> This module contains the Scale-Aware mass flux Shallow Convection scheme. module samfshalcnv use samfcnv_aerosols, only : samfshalcnv_aerosols use progsigma, only : progsigma_calc - + use progomega, only : progomega_calc contains subroutine samfshalcnv_init(imfshalcnv, imfshalcnv_samf, & @@ -52,12 +53,13 @@ end subroutine samfshalcnv_init subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp,first_time_step,restart, & - & tmf,qmicro,progsigma, & - & prslp,psp,phil,qtr,prevsq,q,q1,t1,u1,v1,fscav, & - & rn,kbot,ktop,kcnv,islimsk,garea, & + & tmf,qmicro,progsigma,progomega, & + & prslp,psp,phil,tkeh,qtr,prevsq,q,q1,t1,u1,v1,fscav, & + & rn,kbot,ktop,kcnv,islimsk,garea,cscale, & & dot,ncloud,hpbl,ud_mf,dt_mf,cnvw,cnvc, & & clam,c0s,c1,evef,pgcon,asolfac,hwrf_samfshal, & - & sigmain,sigmaout,betadcu,betamcu,betascu,errmsg,errflg) + & sigmain,sigmaout,omegain,omegaout,betadcu,betamcu,betascu, & + & errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -69,27 +71,33 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & real(kind=kind_phys), intent(in) :: cliq, cp, cvap, & & eps, epsm1, fv, grav, hvap, rd, rv, t0c, betascu, betadcu, & & betamcu - real(kind=kind_phys), intent(in) :: delt + real(kind=kind_phys), intent(in) :: delt, cscale real(kind=kind_phys), intent(in) :: psp(:), delp(:,:), & & prslp(:,:), garea(:), hpbl(:), dot(:,:), phil(:,:), & - & qmicro(:,:),tmf(:,:,:),prevsq(:,:),q(:,:) - - real(kind=kind_phys), intent(in) :: sigmain(:,:) + & tmf(:,:,:), q(:,:) + real(kind=kind_phys), intent(in), optional :: qmicro(:,:), & + & prevsq(:,:) + real(kind=kind_phys), intent(in), optional :: sigmain(:,:), & + & omegain(:,:) ! real(kind=kind_phys), dimension(:), intent(in) :: fscav integer, intent(inout) :: kcnv(:) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH real(kind=kind_phys), intent(inout) :: qtr(:,:,:), & - & q1(:,:), t1(:,:), u1(:,:), v1(:,:) + & q1(:,:), t1(:,:), u1(:,:), v1(:,:), tkeh(:,:) ! integer, intent(out) :: kbot(:), ktop(:) real(kind=kind_phys), intent(out) :: rn(:), & - & cnvw(:,:), cnvc(:,:), ud_mf(:,:), dt_mf(:,:), sigmaout(:,:) + & cnvw(:,:), cnvc(:,:), dt_mf(:,:) ! + real(kind=kind_phys), intent(out) :: ud_mf(:,:) + real(kind=kind_phys), intent(inout), optional :: sigmaout(:,:), & + & omegaout(:,:) + real(kind=kind_phys), intent(in) :: clam, c0s, c1, & & asolfac, evef, pgcon logical, intent(in) :: hwrf_samfshal,first_time_step, & - & restart,progsigma + & restart,progsigma,progomega character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -196,7 +204,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & parameter(betaw=.03,dxcrtc0=9.e3) parameter(h1=0.33333333) ! progsigma - parameter(dxcrtas=30.e3,sigmind=0.01,sigmins=0.03,sigminm=0.01) + parameter(dxcrtas=500.e3,sigmind=0.01,sigmins=0.03,sigminm=0.01) c local variables and arrays real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), & uo(im,km), vo(im,km), qeso(im,km), @@ -345,8 +353,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & xmb(i) = 0. enddo endif -!! - +!! !> - Return to the calling routine if deep convection is present or the surface buoyancy flux is negative. totflg = .true. do i=1,im @@ -869,14 +876,13 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & tkemean(i) = 0. endif enddo - +! do k = 1, km1 do i = 1, im if(cnvflg(i)) then if(k >= kb(i) .and. k < kbcon(i)) then dz = zo(i,k+1) - zo(i,k) - tem = 0.5 * (qtr(i,k,ntk)+qtr(i,k+1,ntk)) - tkemean(i) = tkemean(i) + tem * dz + tkemean(i) = tkemean(i) + tkeh(i,k) * dz sumx(i) = sumx(i) + dz endif endif @@ -1090,6 +1096,24 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & enddo enddo enddo + if(ntk > 2) then + kk = ntk -2 + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k > kb(i) .and. k < kmax(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.25 * (xlamue(i,k)+xlamue(i,k-1)) * dz + tem = cq * tem + factor = 1. + tem + ecko(i,k,kk) = ((1. - tem) * ecko(i,k-1,kk) + tem * + & (ctro(i,k,kk) + ctro(i,k-1,kk))) / factor + ercko(i,k,kk) = ecko(i,k,kk) + endif + endif + enddo + enddo + endif endif endif c @@ -1475,7 +1499,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & ! ! compute updraft velocity square(wu2) !> - Calculate updraft velocity square(wu2) according to Han et al.'s (2017) \cite han_et_al_2017 equation 7. -! +!!> - if progomega = true, calculate prognostic updraft velocity (Pa/s) according to progomega routine. if (hwrf_samfshal) then do i = 1, im if (cnvflg(i)) then @@ -1490,26 +1514,48 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo endif - do k = 2, km1 - do i = 1, im - if (cnvflg(i)) then - if(k > kbcon1(i) .and. k < ktcon(i)) then - dz = zi(i,k) - zi(i,k-1) - tem = 0.25 * bb1 * (drag(i,k-1)+drag(i,k)) * dz - tem1 = 0.5 * bb2 * (buo(i,k-1)+buo(i,k)) - tem2 = wush(i,k) * sqrt(wu2(i,k-1)) - tem2 = (tem1 - tem2) * dz - ptem = (1. - tem) * wu2(i,k-1) - ptem1 = 1. + tem - wu2(i,k) = (ptem + tem2) / ptem1 - wu2(i,k) = max(wu2(i,k), 0.) - endif - endif - enddo - enddo ! - if(progsigma)then - do k = 2, km1 + if (progomega) then + call progomega_calc(first_time_step,restart,im,km, + & kbcon1,ktcon,omegain,delt,del,zi,cnvflg,omegaout, + & grav,buo,drag,wush,xlamue,bb1,bb2) + do k = 1, km + do i = 1, im + if (cnvflg(i)) then + if(k > kbcon1(i) .and. k < ktcon(i)) then + omega_u(i,k)=omegaout(i,k) + omega_u(i,k)=MAX(omega_u(i,k),-80.) +! Convert to m/s for use in convective time-scale: + rho = po(i,k)*100. / (rd * to(i,k)) + tem = (-omega_u(i,k)) / ((rho * grav)) + wu2(i,k) = tem**2 + wu2(i,k) = max(wu2(i,k), 0.) + endif + endif + enddo + enddo + + else +! diagnostic updraft velocity + do k = 2, km1 + do i = 1, im + if (cnvflg(i)) then + if(k > kbcon1(i) .and. k < ktcon(i)) then + dz = zi(i,k) - zi(i,k-1) + tem = 0.25 * bb1 * (drag(i,k-1)+drag(i,k)) * dz + tem1 = 0.5 * bb2 * (buo(i,k-1)+buo(i,k)) + tem2 = wush(i,k) * sqrt(wu2(i,k-1)) + tem2 = (tem1 - tem2) * dz + ptem = (1. - tem) * wu2(i,k-1) + ptem1 = 1. + tem + wu2(i,k) = (ptem + tem2) / ptem1 + wu2(i,k) = max(wu2(i,k), 0.) + endif + endif + enddo + enddo +!convert to Pa/s for use in closure + do k = 2, km1 do i = 1, im if (cnvflg(i)) then if(k > kbcon1(i) .and. k < ktcon(i)) then @@ -1520,8 +1566,9 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo - endif + endif !progomega + ! compute updraft velocity averaged over the whole cumulus ! !> - Calculate the mean updraft velocity within the cloud (wc). @@ -1979,7 +2026,7 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & flag_mid = .false. call progsigma_calc(im,km,first_time_step,restart,flag_shallow, & flag_mid,del,tmfq,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, - & delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, + & delt,qadv,kb,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, & sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) endif @@ -2394,20 +2441,22 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & endif enddo c -c convective cloud water -c -!> - Calculate shallow convective cloud water. +c convective cloud water do k = 1, km - do i = 1, im - if (cnvflg(i)) then - if (k >= kbcon(i) .and. k < ktcon(i)) then - cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + do i = 1, im + if (cnvflg(i)) then + if (k >= kbcon(i) .and. k < ktcon(i)) then + cnvw(i,k) = cnvwt(i,k) * xmb(i) * dt2 + if (progsigma) then + cnvw(i,k) = cnvw(i,k) * cscale + else + cnvw(i,k) = cnvw(i,k) * cscale + endif + endif endif - endif - enddo + enddo enddo - -c +c c convective cloud cover c !> - Calculate convective cloud cover, which is used when pdf-based cloud fraction is used (i.e., pdfcld=.true.). diff --git a/physics/CONV/SAMF/samfshalcnv.meta b/physics/CONV/SAMF/samfshalcnv.meta index 4b913a05d..b96a742f2 100644 --- a/physics/CONV/SAMF/samfshalcnv.meta +++ b/physics/CONV/SAMF/samfshalcnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = samfshalcnv type = scheme - dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,samfaerosols.F,../progsigma_calc.f90 + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,samfaerosols.F,../progsigma_calc.f90,../progomega_calc.f90 ######################################################################## [ccpp-arg-table] @@ -85,6 +85,7 @@ type = real kind = kind_phys intent = in + optional = True [itc] standard_name = index_of_first_chemical_tracer_for_convection long_name = index of first chemical tracer transported/scavenged by convection @@ -187,6 +188,14 @@ type = real kind = kind_phys intent = in +[cscale] + standard_name = multiplicative_tuning_parameter_for_convective_cloud_water + long_name = multiplicative tuning parameter for convective cloud water + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [delt] standard_name = timestep_for_physics long_name = physics time step @@ -241,6 +250,14 @@ type = real kind = kind_phys intent = in +[tkeh] + standard_name = vertical_turbulent_kinetic_energy_at_interface + long_name = vertical turbulent kinetic energy at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout [qtr] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers @@ -257,6 +274,7 @@ type = real kind = kind_phys intent = in + optional = True [q] standard_name = specific_humidity long_name = water vapor specific humidity @@ -466,6 +484,13 @@ dimensions = () type = logical intent = in +[progomega] + standard_name = do_prognostic_updraft_velocity + long_name = flag for prognostic omega in cumuls scheme + units = flag + dimensions = () + type = logical + intent = in [sigmain] standard_name = prognostic_updraft_area_fraction_in_convection long_name = convective updraft area fraction @@ -474,6 +499,7 @@ type = real kind = kind_phys intent = in + optional = True [sigmaout] standard_name = updraft_area_fraction_updated_by_physics long_name = convective updraft area fraction updated by physics @@ -481,7 +507,26 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = out + intent = inout + optional = True +[omegain] + standard_name = prognostic_updraft_velocity_in_convection + long_name = convective updraft velocity + units = Pa s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[omegaout] + standard_name = updraft_velocity_updated_by_physics + long_name = convective updraft velocity updated by physics + units = Pa s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True [betascu] standard_name = tuning_param_for_shallow_cu long_name = tuning param for shallow cu in case prognostic closure is used diff --git a/physics/CONV/SAS/sascnvn.F b/physics/CONV/SAS/sascnvn.F index 673231e05..8a78d63ff 100644 --- a/physics/CONV/SAS/sascnvn.F +++ b/physics/CONV/SAS/sascnvn.F @@ -126,9 +126,9 @@ subroutine sascnvn_run( & u1(:,:), v1(:,:), & & cnvw(:,:), cnvc(:,:) real(kind=kind_phys), intent(out) :: cldwrk(:), rn(:), & - & ud_mf(:,:), dd_mf(:,:), & - & dt_mf(:,:) - real(kind=kind_phys), intent(inout) :: & + & dt_mf(:,:), dd_mf(:,:) + real(kind=kind_phys), intent(out) :: ud_mf(:,:) + real(kind=kind_phys), intent(inout), optional :: & & qlcn(:,:), qicn(:,:), & & w_upi(:,:), cnv_mfd(:,:), & & cnv_dqldt(:,:), clcn(:,:), & @@ -974,9 +974,9 @@ subroutine sascnvn_run( if(totflg) return !! ! -! estimate the onvective overshooting as the level +! Estimate the convective overshooting as the level ! where the [aafac * cloud work function] becomes zero, -! which is the final cloud top +! which is the final cloud top. ! !> - Continue calculating the cloud work function past the point of neutral buoyancy to represent overshooting according to Han and Pan (2011) \cite han_and_pan_2011 . Convective overshooting stops when \f$ cA_u < 0\f$ where \f$c\f$ is currently 10%, or when 10% of the updraft cloud work function has been consumed by the stable buoyancy force. do i = 1, im @@ -1001,7 +1001,7 @@ subroutine sascnvn_run( & dz1 * (g / (cp * to(i,k))) & * dbyo(i,k) / (1. + gamma) & * rfact -!NRL MNM: Limit overshooting not to be deeper than the actual cloud +!NRL MNM: Limit overshooting not to be deeper than half the actual cloud tem = 0.5 * (zi(i,ktcon(i))-zi(i,kbcon(i))) tem1 = zi(i,k)-zi(i,ktcon(i)) if(aa2(i) < 0. .or. tem1 >= tem) then diff --git a/physics/CONV/SAS/sascnvn.meta b/physics/CONV/SAS/sascnvn.meta index fefa2823a..b73dc5f47 100644 --- a/physics/CONV/SAS/sascnvn.meta +++ b/physics/CONV/SAS/sascnvn.meta @@ -345,6 +345,7 @@ type = real kind = kind_phys intent = inout + optional = True [qicn] standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water @@ -353,6 +354,7 @@ type = real kind = kind_phys intent = inout + optional = True [w_upi] standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft @@ -361,6 +363,7 @@ type = real kind = kind_phys intent = inout + optional = True [cf_upi] standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics @@ -369,6 +372,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_mfd] standard_name = detrained_mass_flux long_name = detrained mass flux @@ -377,6 +381,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_dqldt] standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics @@ -385,6 +390,7 @@ type = real kind = kind_phys intent = inout + optional = True [clcn] standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction @@ -393,6 +399,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_fice] standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower @@ -401,6 +408,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_ndrop] standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment @@ -409,6 +417,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnv_nice] standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment @@ -417,6 +426,7 @@ type = real kind = kind_phys intent = inout + optional = True [mp_phys] standard_name = control_for_microphysics_scheme long_name = choice of microphysics scheme diff --git a/physics/CONV/SAS/shalcnv.F b/physics/CONV/SAS/shalcnv.F index 3b8d706cd..872b6d694 100644 --- a/physics/CONV/SAS/shalcnv.F +++ b/physics/CONV/SAS/shalcnv.F @@ -1,16 +1,12 @@ -!> \defgroup SASHAL Mass-Flux Shallow Convection -!! @{ -!! \brief The Mass-Flux shallow convection scheme parameterizes the effect of shallow convection on the environment much like the \ref SAS scheme with a few key modifications. Perhaps most importantly, no quasi-equilibrium assumption is necessary since the shallow cloud base mass flux is parameterized from the surface buoyancy flux. Further, there are no convective downdrafts, the entrainment rate is greater than for deep convection, and the shallow convection is limited to not extend over the level where \f$p=0.7p_{sfc}\f$. +!> \file shalcnv.F +!! Contains the entire SAS shallow convection scheme. + +!> \brief The Mass-Flux shallow convection scheme parameterizes the effect of shallow convection on the environment much like the \ref SAS scheme with a few key modifications. Perhaps most importantly, no quasi-equilibrium assumption is necessary since the shallow cloud base mass flux is parameterized from the surface buoyancy flux. Further, there are no convective downdrafts, the entrainment rate is greater than for deep convection, and the shallow convection is limited to not extend over the level where \f$p=0.7p_{sfc}\f$. !! !! This scheme was designed to replace the previous eddy-diffusivity approach to shallow convection with a mass-flux based approach as it is used for deep convection. Differences between the shallow and deep SAS schemes are presented in Han and Pan (2011) \cite han_and_pan_2011 . Like the deep scheme, it uses the working concepts put forth in Arakawa and Schubert (1974) \cite arakawa_and_schubert_1974 but includes modifications and simplifications from Grell (1993) \cite grell_1993 such as only one cloud type (the deepest possible, up to \f$p=0.7p_{sfc}\f$), rather than a spectrum based on cloud top heights or assumed entrainment rates, although it assumes no convective downdrafts. It contains many modifications associated with deep scheme as discussed in Han and Pan (2011) \cite han_and_pan_2011 , including the calculation of cloud top, a greater CFL-criterion-based maximum cloud base mass flux, and the inclusion of convective overshooting. !! -!! \section diagram Calling Hierarchy Diagram +!! \section diagram_sashal Calling Hierarchy Diagram !! \image html Shallow_SAS_Flowchart.png "Diagram depicting how the SAS shallow convection scheme is called from the GSM physics time loop" height=2cm -!! \section intraphysics Intraphysics Communication -!! This space is reserved for a description of how this scheme uses information from other scheme types and/or how information calculated in this scheme is used in other scheme types. - -!> \file shalcnv.F -!! Contains the entire SAS shallow convection scheme. module shalcnv implicit none @@ -80,17 +76,17 @@ end subroutine shalcnv_init !! \param[out] cnvw convective cloud water (kg/kg) !! \param[out] cnvc convective cloud cover (unitless) !! -!! \section general General Algorithm +!! \section general_shalcnv General Algorithm !! -# Compute preliminary quantities needed for the static and feedback control portions of the algorithm. !! -# Perform calculations related to the updraft of the entraining/detraining cloud model ("static control"). !! -# Calculate the tendencies of the state variables (per unit cloud base mass flux) and the cloud base mass flux. !! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. -!! \section detailed Detailed Algorithm +!! \section detailed_shalcnv Detailed Algorithm !! !! \section arg_table_shalcnv_run Argument Table !! \htmlinclude shalcnv_run.html !! -!! @{ +!> @{ subroutine shalcnv_run( & & grav,cp,hvap,rv,fv,t0c,rd,cvap,cliq,eps,epsm1, & & im,km,jcap,delt,delp,prslp,psp,phil,qlc,qli, & @@ -123,7 +119,8 @@ subroutine shalcnv_run( & & q1(:,:), t1(:,:), & & u1(:,:), v1(:,:), & & cnvw(:,:), cnvc(:,:) - real(kind=kind_phys), intent(out) :: rn(:), ud_mf(:,:), dt_mf(:,:) + real(kind=kind_phys), intent(out) :: rn(:), dt_mf(:,:) + real(kind=kind_phys), intent(out) :: ud_mf(:,:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -1340,4 +1337,3 @@ end subroutine shalcnv_run end module shalcnv !> @} -!! @} diff --git a/physics/CONV/nTiedtke/cu_ntiedtke.F90 b/physics/CONV/nTiedtke/cu_ntiedtke.F90 index 0be7df95a..1de9de72b 100644 --- a/physics/CONV/nTiedtke/cu_ntiedtke.F90 +++ b/physics/CONV/nTiedtke/cu_ntiedtke.F90 @@ -14,27 +14,29 @@ module cu_ntiedtke ! this also requires redefining derived constants in the ! parameter section below use physcons, only:rd=>con_rd, rv=>con_rv, g=>con_g, & - & cpd=>con_cp, alv=>con_hvap, alf=>con_hfus + & cpd=>con_cp, alv=>con_hvap, alf=>con_hfus implicit none - real(kind=kind_phys),private :: rcpd,vtmpc1,tmelt,als,t13, & - c1es,c2es,c3les,c3ies,c4les,c4ies,c5les,c5ies,zrg - - real(kind=kind_phys),private :: rovcp,r5alvcp,r5alscp,ralvdcp,ralsdcp,ralfdcp,rtwat,rtber,rtice - real(kind=kind_phys),private :: entrdd,cmfcmax,cmfcmin,cmfdeps,zdnoprc,cprcon - integer,private :: momtrans,p650 - + real(kind=kind_phys),private :: rcpd,vtmpc1,als, & + c2es,c5les,c5ies,zrg + + real(kind=kind_phys),private :: rovcp,r5alvcp,r5alscp,ralvdcp,ralsdcp,ralfdcp + + real(kind=kind_phys),parameter:: t13 = 0.333333333 + real(kind=kind_phys),parameter:: tmelt = 273.16 + real(kind=kind_phys),parameter:: c1es = 610.78 + real(kind=kind_phys),parameter:: c3les = 17.2693882 + real(kind=kind_phys),parameter:: c3ies = 21.875 + real(kind=kind_phys),parameter:: c4les = 35.86 + real(kind=kind_phys),parameter:: c4ies = 7.66 + + real(kind=kind_phys),parameter:: rtwat = tmelt + real(kind=kind_phys),parameter:: rtber = tmelt-5. + real(kind=kind_phys),parameter:: rtice = tmelt-23. parameter( & - t13 = 0.333333333,& rcpd=1.0/cpd, & - tmelt=273.16, & zrg=1.0/g, & - c1es=610.78, & c2es=c1es*rd/rv, & - c3les=17.2693882, & - c3ies=21.875, & - c4les=35.86, & - c4ies=7.66, & als = alv+alf, & c5les=c3les*(tmelt-c4les), & c5ies=c3ies*(tmelt-c4ies), & @@ -43,62 +45,74 @@ module cu_ntiedtke ralvdcp=alv*rcpd, & ralsdcp=als*rcpd, & ralfdcp=alf*rcpd, & - rtwat=tmelt, & - rtber=tmelt-5., & - rtice=tmelt-23., & vtmpc1=rv/rd-1.0, & rovcp = rd*rcpd ) -! -! entrdd: average entrainment & detrainment rate for downdrafts + +! momtrans: momentum transport method ( 1 = IFS40r1 method; 2 = new method ) +! ------- + integer,parameter:: momtrans = 2 + +! entrdd: average turbulent entrainment & detrainment rate for downdrafts (Eq. 6.15 IFS Cy48r1) ! ------ -! - parameter(entrdd = 2.0e-4) -! + real(kind=kind_phys),parameter:: entrdd = 2.0e-4 + ! cmfcmax: maximum massflux value allowed for updrafts etc ! ------- -! - parameter(cmfcmax = 1.0) -! + real(kind=kind_phys),parameter:: cmfcmax = 1.0 + ! cmfcmin: minimum massflux value (for safety) ! ------- -! - parameter(cmfcmin = 1.e-10) -! + real(kind=kind_phys),parameter:: cmfcmin = 1.e-10 + ! cmfdeps: fractional massflux for downdrafts at lfs ! ------- -! - parameter(cmfdeps = 0.30) + real(kind=kind_phys),parameter:: cmfdeps = 0.30 ! zdnoprc: deep cloud is thicker than this height (Unit:Pa) -! - parameter(zdnoprc = 2.0e4) +! NRL changed from 2.0e4 to 1.5e4 as a result of NEPTUNE tuning experiments, +! see https://github.nrlmry.navy.mil/NEPTUNE/ccpp-physics/pull/28 ! ------- -! + real(kind=kind_phys),parameter:: zdnoprc = 1.5e4 + ! cprcon: coefficient from cloud water to rain water -! - parameter(cprcon = 1.4e-3) ! ------- -! -! momtrans: momentum transport method -! ( 1 = IFS40r1 method; 2 = new method ) -! - parameter(momtrans = 2 ) + real(kind=kind_phys),parameter:: cprcon = 1.4e-3 + +! pgcoef: 0.7 to 1.0 is good depends on the basin ! ------- -! - logical :: isequil + real(kind=kind_phys),parameter:: pgcoef = 0.7 + +! entorg: organized updraft entrainment scaling factor (Eq. 6.7 IFS Cy48r1) +! NRL changed from 1.75e-3 to 2.10e-3 as a result of NEPTUNE tuning experiments, +! see https://github.nrlmry.navy.mil/NEPTUNE/ccpp-physics/pull/28 +! ------- + real(kind=kind_phys),parameter:: entorg = 2.1e-3 ! exp 2.4, 2.1, and 1.4, orig. 1.75 + +! detturb: turbulent detrainment scaling factor (Eq. 6.8 IFS Cy48r1) +! ------- + real(kind=kind_phys),parameter:: detturb = 0.75e-4 + ! isequil: representing equilibrium and nonequilibrium convection ! ( .false. [default]; .true. [experimental]. Ref. Bechtold et al. 2014 JAS ) -! - parameter(isequil = .false. ) +! Note for the diurnal simulation of precipitaton +! When isequil = .true., the CAPE is relaxed toward to a value from PBL +! It can improve the diurnal precipitation over land. +! ------- + logical,parameter:: isequil = .false. ! !-------------------- ! switches for deep, mid, shallow convections, downdraft, and momemtum transport ! ------------------ - logical :: lmfpen,lmfmid,lmfscv,lmfdd,lmfdudv - parameter(lmfpen=.true.,lmfmid=.true.,lmfscv=.true.,lmfdd=.true.,lmfdudv=.true.) -!-------------------- + logical,parameter:: lmfpen = .true. + logical,parameter:: lmfmid = .true. + logical,parameter:: lmfscv = .true. + logical,parameter:: lmfdd = .true. + logical,parameter:: lmfdudv = .true. + + +!================================================================================================================= !#################### end of variables definition########################## -!----------------------------------------------------------------------- +!================================================================================================================= ! contains !> \brief Brief description of the subroutine @@ -112,16 +126,16 @@ subroutine cu_ntiedtke_init(imfshalcnv, imfshalcnv_ntiedtke, imfdeepcnv, & implicit none integer, intent(in) :: imfshalcnv, imfshalcnv_ntiedtke - integer, intent(in) :: imfdeepcnv, imfdeepcnv_ntiedtke + integer, intent(in) :: imfdeepcnv, imfdeepcnv_ntiedtke integer, intent(in) :: mpirank integer, intent(in) :: mpiroot character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg - + ! initialize ccpp error handling variables errmsg = '' errflg = 0 - + ! DH* temporary if (mpirank==mpiroot) then write(0,*) ' -----------------------------------------------------------------------------------------------------------------------------' @@ -144,64 +158,92 @@ subroutine cu_ntiedtke_init(imfshalcnv, imfshalcnv_ntiedtke, imfdeepcnv, & errflg = 1 return end if - + end subroutine cu_ntiedtke_init -! Tiedtke cumulus scheme from WRF with small modifications -! This scheme includes both deep and shallow convections !=================== ! !> \section arg_table_cu_ntiedtke_run Argument Table !! \htmlinclude cu_ntiedtke_run.html !! -!----------------------------------------------------------------------- -! level 1 subroutine 'tiecnvn' -!----------------------------------------------------------------- +!================================================================================================================= +! level 1 subroutine 'cu_ntiedkte_run' subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & evap,hfx,zprecc,lmask,lq,km,dt,dx,kbot,ktop,kcnv, & ktrac,ud_mf,dd_mf,dt_mf,cnvw,cnvc,errmsg,errflg) -!----------------------------------------------------------------- -! this is the interface between the model and the mass -! flux convection module -!----------------------------------------------------------------- +!================================================================================================================= +! this is the interface between the model and the mass flux convection module +! m.tiedtke e.c.m.w.f. 1989 +! j.morcrette 1992 +!-------------------------------------------- +! modifications +! C. zhang & Yuqing Wang 2011-2017 +! +! modified from IPRC IRAM - yuqing wang, university of hawaii (ICTP REGCM4.4). +! +! The current version is stable. There are many updates to the old Tiedtke scheme (cu_physics=6) +! update notes: +! the new Tiedtke scheme is similar to the Tiedtke scheme used in REGCM4 and ECMWF cy40r1. +! the major differences to the old Tiedtke (cu_physics=6) scheme are, +! (a) New trigger functions for deep and shallow convections (Jakob and Siebesma 2003; +! Bechtold et al. 2004, 2008, 2014). +! (b) Non-equilibrium situations are considered in the closure for deep convection +! (Bechtold et al. 2014). +! (c) New convection time scale for the deep convection closure (Bechtold et al. 2008). +! (d) New entrainment and detrainment rates for all convection types (Bechtold et al. 2008). +! (e) New formula for the conversion from cloud water/ice to rain/snow (Sundqvist 1978). +! (f) Different way to include cloud scale pressure gradients (Gregory et al. 1997; +! Wu and Yanai 1994) +! +! other reference: tiedtke (1989, mwr, 117, 1779-1800) +! IFS documentation - cy33r1, cy37r2, cy38r1, cy40r1 +! implicit none -! in&out variables - integer, intent(in) :: lq, km, ktrac - real(kind=kind_phys), intent(in ) :: dt - integer, dimension( : ), intent(in) :: lmask - real(kind=kind_phys), dimension( : ), intent(in ) :: evap, hfx, dx - real(kind=kind_phys), dimension( :, : ), intent(inout) :: pu, pv, pt, pqv - real(kind=kind_phys), dimension( :, :), intent(in ) :: tdi, qvdi, poz, prsl, pomg, pqvf, ptf - real(kind=kind_phys), dimension( :, : ), intent(in ) :: pzz, prsi - real(kind=kind_phys), dimension( :, :, : ), intent(inout ) :: clw - - integer, dimension( : ), intent(out) :: kbot, ktop, kcnv - real(kind=kind_phys), dimension( : ), intent(out) :: zprecc - real(kind=kind_phys), dimension (:, :), intent(out) :: ud_mf, dd_mf, dt_mf, cnvw, cnvc - +!--- input arguments: + integer, intent(in) :: lq, km, ktrac + integer, intent(in), dimension(:) :: lmask + + real(kind=kind_phys), intent(in) :: dt + real(kind=kind_phys), dimension(:), intent(in) :: evap, hfx, dx + real(kind=kind_phys), dimension(:,:), intent(in) :: tdi, qvdi, poz, prsl, pomg + real(kind=kind_phys), dimension(:,:), intent(in), optional :: pqvf, ptf + real(kind=kind_phys), dimension(:,:),intent(in) :: pzz, prsi + +!--- inout arguments: + real(kind=kind_phys), dimension(:,:,:), intent(inout ) :: clw + real(kind=kind_phys), dimension(:,:), intent(inout) :: pu, pv, pt, pqv + +!--- output arguments: + real(kind=kind_phys), dimension(:), intent(out) :: zprecc + integer, dimension(:), intent(out) :: kbot, ktop, kcnv + real(kind=kind_phys), dimension (:,:), intent(out), optional :: ud_mf + real(kind=kind_phys), dimension (:,:), intent(out) :: dd_mf, dt_mf, cnvw, cnvc + ! error messages - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! local variables - real(kind=kind_phys) pum1(lq,km), pvm1(lq,km), ztt(lq,km), & - & ptte(lq,km), pqte(lq,km), pvom(lq,km), pvol(lq,km), & - & pverv(lq,km), pgeo(lq,km), pap(lq,km), paph(lq,km+1) - real(kind=kind_phys) pqhfl(lq), zqq(lq,km), & - & prsfc(lq), pssfc(lq), pcte(lq,km), & - & phhfl(lq), pgeoh(lq,km+1) - real(kind=kind_phys) ztp1(lq,km), zqp1(lq,km), ztu(lq,km), zqu(lq,km),& - & zlu(lq,km), zlude(lq,km), zmfu(lq,km), zmfd(lq,km), zmfude_rate(lq,km),& - & zqsat(lq,km), zrain(lq) - real(kind=kind_phys),allocatable :: pcen(:,:,:),ptenc(:,:,:) - - integer icbot(lq), ictop(lq), ktype(lq), lndj(lq) - logical locum(lq) -! - real(kind=kind_phys) ztmst,fliq,fice,ztc,zalf,tt - integer i,j,k,k1,n,km1,ktracer - real(kind=kind_phys) ztpp1 - real(kind=kind_phys) zew,zqs,zcor + real(kind=kind_phys),allocatable :: pcen(:,:,:),ptenc(:,:,:) + integer,dimension(lq):: lndj + logical,dimension(lq):: locum + integer:: i,j,k + integer:: k1,n,km1,ktracer + integer,dimension(lq):: icbot,ictop,ktype + + real(kind=kind_phys):: ztmst,fliq,fice,ztc,zalf,tt + real(kind=kind_phys):: ztpp1,zew,zqs,zcor + real(kind=kind_phys):: dxref + + real(kind=kind_phys),dimension(lq):: pqhfl,prsfc,pssfc,phhfl,zrain + real(kind=kind_phys),dimension(lq):: scale_fac,scale_fac2 + + real(kind=kind_phys),dimension(lq,km):: pum1,pvm1,ztt,ptte,pqte,pvom,pvol,pverv,pgeo + real(kind=kind_phys),dimension(lq,km):: zqq,pcte + real(kind=kind_phys),dimension(lq,km):: ztp1,zqp1,ztu,zqu,zlu,zlude,zmfu,zmfd,zqsat,zmfude_rate,pap + real(kind=kind_phys),dimension(lq,km+1):: pgeoh,paph + +!----------------------------------------------------------------------------------------------------------------- ! ! Initialize CCPP error handling variables errmsg = '' @@ -210,6 +252,19 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, km1 = km + 1 ztmst=dt ! +! set scale-dependency factor when dx is < 15 km +! + dxref = 15000. + do j=1,lq + if (dx(j).lt.dxref) then + scale_fac(j) = (1.06133+log(dxref/dx(j)))**3 + scale_fac2(j) = scale_fac(j)**0.5 + else + scale_fac(j) = 1.+1.33e-5*dx(j) + scale_fac2(j) = 1. + end if + end do +! ! masv flux diagnostics. ! do j=1,lq @@ -220,7 +275,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, pqhfl(j)=evap(j) phhfl(j)=hfx(j) pgeoh(j,km1)=pzz(j,1) - paph(j,km1)=prsi(j,1) + paph(j,km1)=prsi(j,1) if(lmask(j).eq.1) then lndj(j)=1 else @@ -246,12 +301,12 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, pap(j,k1)=prsl(j,k) paph(j,k1)=prsi(j,k+1) tt=ztp1(j,k1) - zew = foeewm(tt) - zqs = zew/pap(j,k1) - zqs = min(0.5,zqs) - zcor = 1./(1.-vtmpc1*zqs) - zqsat(j,k1)=zqs*zcor - pqte(j,k1)=pqvf(j,k)+(pqv(j,k)-qvdi(j,k))/ztmst + zew = foeewm(tt) + zqs = zew/pap(j,k1) + zqs = min(0.5,zqs) + zcor = 1./(1.-vtmpc1*zqs) + zqsat(j,k1)=zqs*zcor + pqte(j,k1)=pqvf(j,k)+(pqv(j,k)-qvdi(j,k))/ztmst zqq(j,k1) =pqte(j,k1) ptte(j,k1)=ptf(j,k)+(pt(j,k)-tdi(j,k))/ztmst ztt(j,k1) =ptte(j,k1) @@ -289,13 +344,13 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, end do end do end if - + ! print *, "pgeo=",pgeo(1,:) ! print *, "pgeoh=",pgeoh(1,:) ! print *, "pap=",pap(1,:) ! print *, "paph=",paph(1,:) ! print *, "ztp1=",ztp1(1,:) -! print *, "zqp1=",zqp1(1,:) +! print *, "zqp1=",zqp1(1,:) ! print *, "pum1=",pum1(1,:) ! print *, "pvm1=",pvm1(1,:) ! print *, "pverv=",pverv(1,:) @@ -307,14 +362,15 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, !* 2. call 'cumastrn'(master-routine for cumulus parameterization) ! call cumastrn & - & (lq, km, km1, km-1, ztp1, & - & zqp1, pum1, pvm1, pverv, zqsat,& - & pqhfl, ztmst, pap, paph, pgeo, & - & ptte, pqte, pvom, pvol, prsfc,& - & pssfc, locum, ktracer, pcen, ptenc,& - & ktype, icbot, ictop, ztu, zqu, & - & zlu, zlude, zmfu, zmfd, zrain,& - & pcte, phhfl, lndj, pgeoh, zmfude_rate, dx) + & (lq, km, km1, km-1, ztp1, & + & zqp1, pum1, pvm1, pverv, zqsat, & + & pqhfl, ztmst, pap, paph, pgeo, & + & ptte, pqte, pvom, pvol, prsfc, & + & pssfc, locum, ktracer, pcen, ptenc, & + & ktype, icbot, ictop, ztu, zqu, & + & zlu, zlude, zmfu, zmfd, zrain, & + & pcte, phhfl, lndj, pgeoh, zmfude_rate, dx, & + & scale_fac, scale_fac2) ! ! to include the cloud water and cloud ice detrained from convection ! @@ -334,7 +390,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, k1 = km-k+1 do j=1,lq pt(j,k) = ztp1(j,k1)+(ptte(j,k1)-ztt(j,k1))*ztmst - pqv(j,k)= zqp1(j,k1)+(pqte(j,k1)-zqq(j,k1))*ztmst + pqv(j,k) = zqp1(j,k1)+(pqte(j,k1)-zqq(j,k1))*ztmst ud_mf(j,k)= zmfu(j,k1)*ztmst dd_mf(j,k)= -zmfd(j,k1)*ztmst dt_mf(j,k)= zmfude_rate(j,k1)*ztmst @@ -349,8 +405,9 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, zprecc(j)=amax1(0.0,(prsfc(j)+pssfc(j))*ztmst*0.001) kbot(j) = km-icbot(j)+1 ktop(j) = km-ictop(j)+1 + ! deep convection flag if(ktype(j).eq.1 .or. ktype(j).eq.3) then - kcnv(j)=1 + kcnv(j)=1 else kcnv(j)=0 end if @@ -365,21 +422,9 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi, end do end do endif - ! -! Currently, vertical mixing of tracers are turned off -! if(ktrac > 2) then -! do n=1,ktrac-2 -! do k=1,km -! k1=km-k+1 -! do j=1,lq -! clw(j,k,n+2)=pcen(j,k,n)+ptenc(j,k1,n)*ztmst -! end do -! end do -! end do -! end if - deallocate(pcen) - deallocate(ptenc) + errmsg = 'cu_ntiedtke_run OK' + errflg = 0 ! return end subroutine cu_ntiedtke_run @@ -393,14 +438,15 @@ end subroutine cu_ntiedtke_run ! subroutine cumastrn !*********************************************************** subroutine cumastrn & - & (klon, klev, klevp1, klevm1, pten, & - & pqen, puen, pven, pverv, pqsen,& - & pqhfl, ztmst, pap, paph, pgeo, & - & ptte, pqte, pvom, pvol, prsfc,& - & pssfc, ldcum, ktrac, pcen, ptenc,& - & ktype, kcbot, kctop, ptu, pqu,& - & plu, plude, pmfu, pmfd, prain,& - & pcte, phhfl, lndj, zgeoh, pmfude_rate, dx) + & (klon, klev, klevp1, klevm1, pten, & + & pqen, puen, pven, pverv, pqsen, & + & pqhfl, ztmst, pap, paph, pgeo, & + & ptte, pqte, pvom, pvol, prsfc, & + & pssfc, ldcum, ktrac, pcen, ptenc, & + & ktype, kcbot, kctop, ptu, pqu, & + & plu, plude, pmfu, pmfd, prain, & + & pcte, phhfl, lndj, zgeoh, pmfude_rate, dx, & + & scale_fac, scale_fac2) implicit none ! !***cumastrn* master routine for cumulus massflux-scheme @@ -460,92 +506,81 @@ subroutine cumastrn & ! ---------- ! paper on massflux scheme (tiedtke,1989) !----------------------------------------------------------------- - integer klev,klon,ktrac,klevp1,klevm1 - real(kind=kind_phys) pten(klon,klev), pqen(klon,klev),& - & puen(klon,klev), pven(klon,klev),& - & ptte(klon,klev), pqte(klon,klev),& - & pvom(klon,klev), pvol(klon,klev),& - & pqsen(klon,klev), pgeo(klon,klev),& - & pap(klon,klev), paph(klon,klevp1),& - & pverv(klon,klev), pqhfl(klon),& - & phhfl(klon) - real(kind=kind_phys) ptu(klon,klev), pqu(klon,klev),& - & plu(klon,klev), plude(klon,klev),& - & pmfu(klon,klev), pmfd(klon,klev),& - & prain(klon),& - & prsfc(klon), pssfc(klon) - real(kind=kind_phys) ztenh(klon,klev), zqenh(klon,klev),& - & zgeoh(klon,klevp1), zqsenh(klon,klev),& - & ztd(klon,klev), zqd(klon,klev),& - & zmfus(klon,klev), zmfds(klon,klev),& - & zmfuq(klon,klev), zmfdq(klon,klev),& - & zdmfup(klon,klev), zdmfdp(klon,klev),& - & zmful(klon,klev), zrfl(klon),& - & zuu(klon,klev), zvu(klon,klev),& - & zud(klon,klev), zvd(klon,klev),& - & zlglac(klon,klev) - real(kind=kind_phys) pmflxr(klon,klevp1), pmflxs(klon,klevp1) - real(kind=kind_phys) zhcbase(klon),& - & zmfub(klon), zmfub1(klon),& - & zdhpbl(klon) - real(kind=kind_phys) zsfl(klon), zdpmel(klon,klev),& - & pcte(klon,klev), zcape(klon),& - & zcape1(klon), zcape2(klon),& - & ztauc(klon), ztaubl(klon),& - & zheat(klon) - real(kind=kind_phys) pcen(klon,klev,ktrac), ptenc(klon,klev,ktrac) - real(kind=kind_phys) wup(klon), zdqcv(klon) - real(kind=kind_phys) wbase(klon), zmfuub(klon) - real(kind=kind_phys) upbl(klon) - real(kind=kind_phys) dx(klon) - real(kind=kind_phys) pmfude_rate(klon,klev), pmfdde_rate(klon,klev) - real(kind=kind_phys) zmfuus(klon,klev), zmfdus(klon,klev) - real(kind=kind_phys) zmfudr(klon,klev), zmfddr(klon,klev) - real(kind=kind_phys) zuv2(klon,klev),ztenu(klon,klev),ztenv(klon,klev) - real(kind=kind_phys) zmfuvb(klon),zsum12(klon),zsum22(klon) - integer ilab(klon,klev), idtop(klon),& - & ictop0(klon), ilwmin(klon) - integer kdpl(klon) - integer kcbot(klon), kctop(klon),& - & ktype(klon), lndj(klon) - logical ldcum(klon), lldcum(klon) - logical loddraf(klon), llddraf3(klon), llo1, llo2(klon) - -! local varaiables - real(kind=kind_phys) zcons,zcons2,zqumqe,zdqmin,zdh,zmfmax - real(kind=kind_phys) zalfaw,zalv,zqalv,zc5ldcp,zc4les,zhsat,zgam,zzz,zhhat - real(kind=kind_phys) zpbmpt,zro,zdz,zdp,zeps,zfac,wspeed - integer jl,jk,ik - integer ikb,ikt,icum,itopm2 - real(kind=kind_phys) ztmst,ztau,zerate,zderate,zmfa - real(kind=kind_phys) zmfs(klon),pmean(klev),zlon - real(kind=kind_phys) zduten,zdvten,ztdis,pgf_u,pgf_v + +!--- input arguments: + integer,intent(in):: klev,klon,klevp1,klevm1 + integer,intent(in):: ktrac + integer,intent(in),dimension(klon):: lndj + + real(kind=kind_phys),intent(in):: ztmst + real(kind=kind_phys),intent(in),dimension(klon):: dx + real(kind=kind_phys),intent(in),dimension(klon):: pqhfl,phhfl + real(kind=kind_phys),intent(in),dimension(klon):: scale_fac,scale_fac2 + real(kind=kind_phys),intent(in),dimension(klon,klev):: pten,pqen,puen,pven,pverv + real(kind=kind_phys),intent(in),dimension(klon,klev):: pap,pgeo + real(kind=kind_phys),intent(in),dimension(klon,klevp1):: paph,zgeoh + +!--- inout arguments: + integer,intent(inout),dimension(klon):: ktype,kcbot,kctop + logical,intent(inout),dimension(klon):: ldcum + + real(kind=kind_phys),intent(inout),dimension(klon):: pqsen + real(kind=kind_phys),intent(inout),dimension(klon):: prsfc,pssfc,prain + real(kind=kind_phys),intent(inout),dimension(klon,klev):: pcte,ptte,pqte,pvom,pvol + real(kind=kind_phys),intent(inout),dimension(klon,klev):: ptu,pqu,plu,plude,pmfu,pmfd + +!--- local variables and arrays: + logical:: llo1 + logical,dimension(klon):: loddraf,llo2 + logical,dimension(klon):: lldcum,llddraf3 + + integer:: jl,jk,ik + integer:: ikb,ikt,icum,itopm2 + integer,dimension(klon):: kdpl,idtop,ictop0,ilwmin + integer,dimension(klon,klev):: ilab + + real(kind=kind_phys):: zcons,zcons2,zqumqe,zdqmin,zdh,zmfmax + real(kind=kind_phys):: zalfaw,zalv,zqalv,zc5ldcp,zc4les,zhsat,zgam,zzz,zhhat + real(kind=kind_phys):: zpbmpt,zro,zdz,zdp,zeps,zfac,wspeed + real(kind=kind_phys):: zduten,zdvten,ztdis,pgf_u,pgf_v + real(kind=kind_phys):: zlon + real(kind=kind_phys):: ztau,zerate,zderate,zmfa + real(kind=kind_phys),dimension(klon):: zmfs + real(kind=kind_phys),dimension(klon):: zsfl,zcape,zcape1,zcape2,ztauc,ztaubl,zheat + real(kind=kind_phys),dimension(klon):: wup,zdqcv + real(kind=kind_phys),dimension(klon):: wbase,zmfuub + real(kind=kind_phys),dimension(klon):: upbl + real(kind=kind_phys),dimension(klon):: zhcbase,zmfub,zmfub1,zdhpbl + real(kind=kind_phys),dimension(klon):: zmfuvb,zsum12,zsum22 + real(kind=kind_phys),dimension(klon):: zrfl + real(kind=kind_phys),dimension(klev):: pmean + real(kind=kind_phys),dimension(klon,klev):: pmfude_rate,pmfdde_rate + real(kind=kind_phys),dimension(klon,klev,ktrac):: pcen, ptenc + real(kind=kind_phys),dimension(klon,klev):: zdpmel + real(kind=kind_phys),dimension(klon,klev):: zmfuus,zmfdus,zuv2,ztenu,ztenv + real(kind=kind_phys),dimension(klon,klev):: zmfudr,zmfddr + real(kind=kind_phys),dimension(klon,klev):: ztenh,zqenh,zqsenh,ztd,zqd + real(kind=kind_phys),dimension(klon,klev):: zmfus,zmfds,zmfuq,zmfdq,zdmfup,zdmfdp,zmful + real(kind=kind_phys),dimension(klon,klev):: zuu,zvu,zud,zvd,zlglac + real(kind=kind_phys),dimension(klon,klevp1):: pmflxr,pmflxs + !------------------------------------------- ! 1. specify constants and parameters !------------------------------------------- zcons=1./(g*ztmst) zcons2=3./(g*ztmst) - zlon = real(klon) - do jk = klev , 1 , -1 - pmean(jk) = sum(pap(:,jk))/zlon - end do - p650 = klev-2 - do jk = klev , 3 , -1 - if ( pmean(jk)/pmean(klev)*1.013250e5 > 650.e2 ) p650 = jk - end do - !-------------------------------------------------------------- !* 2. initialize values at vertical grid points in 'cuini' !-------------------------------------------------------------- call cuinin & - & (klon, klev, klevp1, klevm1, pten, & - & pqen, pqsen, puen, pven, pverv,& - & pgeo, paph, zgeoh, ztenh, zqenh,& - & zqsenh, ilwmin, ptu, pqu, ztd, & - & zqd, zuu, zvu, zud, zvd, & - & pmfu, pmfd, zmfus, zmfds, zmfuq,& - & zmfdq, zdmfup, zdmfdp, zdpmel, plu, & + & (klon, klev, klevp1, klevm1, pten, & + & pqen, pqsen, puen, pven, pverv, & + & pgeo, paph, zgeoh, ztenh, zqenh, & + & zqsenh, ilwmin, ptu, pqu, ztd, & + & zqd, zuu, zvu, zud, zvd, & + & pmfu, pmfd, zmfus, zmfds, zmfuq, & + & zmfdq, zdmfup, zdmfdp, zdpmel, plu, & & plude, ilab) !---------------------------------- @@ -555,11 +590,12 @@ subroutine cumastrn & ! and the cumulus type 1 or 2 ! ------------------------------------------- call cutypen & - & ( klon, klev, klevp1, klevm1, pqen,& - & ztenh, zqenh, zqsenh, zgeoh, paph,& - & phhfl, pqhfl, pgeo, pqsen, pap,& - & pten, lndj, ptu, pqu, ilab,& - & ldcum, kcbot, ictop0, ktype, wbase, plu, kdpl) + & ( klon, klev, klevp1, klevm1, pqen, & + & ztenh, zqenh, zqsenh, zgeoh, paph, & + & phhfl, pqhfl, pgeo, pqsen, pap, & + & pten, lndj, ptu, pqu, ilab, & + & ldcum, kcbot, ictop0, ktype, wbase, & + & plu, kdpl) !* (b) assign the first guess mass flux at cloud base ! ------------------------------------------ @@ -569,41 +605,74 @@ subroutine cumastrn & idtop(jl)=0 end do + !----------------------------------------------- + ! Calculate moist static energy and kinetic + ! energy within the subcloud layer for the + ! environment + !----------------------------------------------- do jk=2,klev do jl=1,klon + if(jk.ge.kcbot(jl) .and. ldcum(jl)) then - zdhpbl(jl)=zdhpbl(jl)+(alv*pqte(jl,jk)+cpd*ptte(jl,jk))& - & *(paph(jl,jk+1)-paph(jl,jk)) + ! sum subcloud layer moist static energy + zdhpbl(jl) = zdhpbl(jl) + (alv*pqte(jl,jk)+cpd*ptte(jl,jk)) * (paph(jl,jk+1)-paph(jl,jk)) + if(lndj(jl) .eq. 0) then - wspeed = sqrt(puen(jl,jk)**2 + pven(jl,jk)**2) + wspeed = sqrt(puen(jl,jk)**2 + pven(jl,jk)**2) upbl(jl) = upbl(jl) + wspeed*(paph(jl,jk+1)-paph(jl,jk)) end if + end if + end do end do + !----------------------------------------------- + ! Calculate first guess cloud base mass flux + !----------------------------------------------- do jl=1,klon + if(ldcum(jl)) then - ikb=kcbot(jl) + + ikb = kcbot(jl) zmfmax = (paph(jl,ikb)-paph(jl,ikb-1))*zcons2 + !----------------------------------------------- + ! Deep convection. + ! Initial updraft mass flux is 10% of its maximum + ! value, which is determined by the layer thickness + ! and time step. + !----------------------------------------------- if(ktype(jl) == 1) then + zmfub(jl)= 0.1*zmfmax + !----------------------------------------------- + ! Shallow convection. + ! Initial updraft mass flux is determined by + ! a balance of moist static energy in the + ! boundary layer. + !----------------------------------------------- else if ( ktype(jl) == 2 ) then + zqumqe = pqu(jl,ikb) + plu(jl,ikb) - zqenh(jl,ikb) zdqmin = max(0.01*zqenh(jl,ikb),1.e-10) zdh = cpd*(ptu(jl,ikb)-ztenh(jl,ikb)) + alv*zqumqe - zdh = g*max(zdh,1.e5*zdqmin) + !zdh = g*max(zdh,1.e5*zdqmin) + zdh = g*max(zdh,0.75*cpd) ! limiter updated to be consistent with IFS documentation + if ( zdhpbl(jl) > 0. ) then - zmfub(jl) = zdhpbl(jl)/zdh + zmfub(jl) = zdhpbl(jl) / zdh zmfub(jl) = min(zmfub(jl),zmfmax) else zmfub(jl) = 0.1*zmfmax ldcum(jl) = .false. end if - end if + + end if + else zmfub(jl) = 0. end if + end do !------------------------------------------------------ !* 4.0 determine cloud ascent for entraining plume @@ -611,15 +680,16 @@ subroutine cumastrn & !* (a) do ascent in 'cuasc'in absence of downdrafts !---------------------------------------------------------- call cuascn & - & (klon, klev, klevp1, klevm1, ztenh,& - & zqenh, puen, pven, pten, pqen,& - & pqsen, pgeo, zgeoh, pap, paph,& - & pqte, pverv, ilwmin, ldcum, zhcbase,& - & ktype, ilab, ptu, pqu, plu,& - & zuu, zvu, pmfu, zmfub,& - & zmfus, zmfuq, zmful, plude, zdmfup,& - & kcbot, kctop, ictop0, icum, ztmst,& - & zqsenh, zlglac, lndj, wup, wbase, kdpl, pmfude_rate ) + & (klon, klev, klevp1, klevm1, ztenh, & + & zqenh, puen, pven, pten, pqen, & + & pqsen, pgeo, zgeoh, pap, paph, & + & pqte, pverv, ilwmin, ldcum, zhcbase, & + & ktype, ilab, ptu, pqu, plu, & + & zuu, zvu, pmfu, zmfub, & + & zmfus, zmfuq, zmful, plude, zdmfup, & + & kcbot, kctop, ictop0, icum, ztmst, & + & zqsenh, zlglac, lndj, wup, wbase, & + & kdpl, pmfude_rate) !* (b) check cloud depth and change entrainment rate accordingly ! calculate precipitation rate (for downdraft calculation) @@ -658,24 +728,24 @@ subroutine cumastrn & if(lmfdd) then !* (a) determine lfs in 'cudlfsn' !-------------------------------------- - call cudlfsn & + call cudlfsn & & (klon, klev,& - & kcbot, kctop, lndj, ldcum, & - & ztenh, zqenh, puen, pven, & - & pten, pqsen, pgeo, & - & zgeoh, paph, ptu, pqu, plu, & - & zuu, zvu, zmfub, zrfl, & - & ztd, zqd, zud, zvd, & - & pmfd, zmfds, zmfdq, zdmfdp, & + & kcbot, kctop, lndj, ldcum, & + & ztenh, zqenh, puen, pven, & + & pten, pqsen, pgeo, & + & zgeoh, paph, ptu, pqu, plu, & + & zuu, zvu, zmfub, zrfl, & + & ztd, zqd, zud, zvd, & + & pmfd, zmfds, zmfdq, zdmfdp, & & idtop, loddraf) !* (b) determine downdraft t,q and fluxes in 'cuddrafn' !------------------------------------------------------------ - call cuddrafn & - & ( klon, klev, loddraf, & - & ztenh, zqenh, puen, pven, & - & pgeo, zgeoh, paph, zrfl, & - & ztd, zqd, zud, zvd, pmfu, & - & pmfd, zmfds, zmfdq, zdmfdp, pmfdde_rate ) + call cuddrafn & + & (klon, klev, loddraf, & + & ztenh, zqenh, puen, pven, & + & pgeo, zgeoh, paph, zrfl, & + & ztd, zqd, zud, zvd, pmfu, & + & pmfd, zmfds, zmfdq, zdmfdp, pmfdde_rate) !----------------------------------------------------------- end if ! @@ -683,7 +753,7 @@ subroutine cumastrn & !* 6.0 closure and clean work ! ------ !-- 6.1 recalculate cloud base massflux from a cape closure -! for deep convection (ktype=1) +! for deep convection (ktype=1) ! do jl=1,klon if(ldcum(jl) .and. ktype(jl) .eq. 1) then @@ -694,19 +764,19 @@ subroutine cumastrn & zcape1(jl)=0.0 zcape2(jl)=0.0 zmfub1(jl)=zmfub(jl) - + ztauc(jl) = (zgeoh(jl,ikt)-zgeoh(jl,ikb)) / & ((2.+ min(15.0,wup(jl)))*g) - if(lndj(jl) .eq. 0) then + if(lndj(jl) .eq. 0) then upbl(jl) = 2.+ upbl(jl)/(paph(jl,klev+1)-paph(jl,ikb)) ztaubl(jl) = (zgeoh(jl,ikb)-zgeoh(jl,klev+1))/(g*upbl(jl)) ztaubl(jl) = min(300., ztaubl(jl)) else ztaubl(jl) = ztauc(jl) end if - end if + end if end do -! + do jk = 1 , klev do jl = 1 , klon llo1 = ldcum(jl) .and. ktype(jl) .eq. 1 @@ -725,7 +795,7 @@ subroutine cumastrn & if((paph(jl,klev+1)-paph(jl,kdpl(jl)))<50.e2) then zdp = paph(jl,jk+1)-paph(jl,jk) zcape2(jl) = zcape2(jl) + ztaubl(jl)* & - ((1.+vtmpc1*pqen(jl,jk))*ptte(jl,jk)+vtmpc1*pten(jl,jk)*pqte(jl,jk))*zdp + ((1.+vtmpc1*pqen(jl,jk))*ptte(jl,jk)+vtmpc1*pten(jl,jk)*pqte(jl,jk))*zdp end if end if end do @@ -735,10 +805,10 @@ subroutine cumastrn & if(ldcum(jl).and.ktype(jl).eq.1) then ikb = kcbot(jl) ikt = kctop(jl) - ztau = ztauc(jl) * (1.+1.33e-5*dx(jl)) - ztau = max(ztmst,ztau) - ztau = max(720.,ztau) - ztau = min(10800.,ztau) + ztauc(jl) = max(ztmst,ztauc(jl)) + ztauc(jl) = max(360.,ztauc(jl)) + ztauc(jl) = min(10800.,ztauc(jl)) + ztau = ztauc(jl) * scale_fac(jl) if(isequil) then zcape2(jl)= max(0.,zcape2(jl)) zcape(jl) = max(0.,min(zcape1(jl)-zcape2(jl),5000.)) @@ -752,44 +822,52 @@ subroutine cumastrn & zmfub1(jl)=min(zmfub1(jl),zmfmax) end if end do -! -!* 6.2 recalculate convective fluxes due to effect of -! downdrafts on boundary layer moist static energy budget (ktype=2) -!-------------------------------------------------------- + ! + !* 6.2 recalculate convective fluxes due to effect of + ! downdrafts on boundary layer moist static energy budget (ktype=2) + !-------------------------------------------------------- do jl=1,klon + if(ldcum(jl) .and. ktype(jl) .eq. 2) then + ikb=kcbot(jl) + if(pmfd(jl,ikb).lt.0.0 .and. loddraf(jl)) then zeps=-pmfd(jl,ikb)/max(zmfub(jl),cmfcmin) else zeps=0. endif + zqumqe=pqu(jl,ikb)+plu(jl,ikb)- & - & zeps*zqd(jl,ikb)-(1.-zeps)*zqenh(jl,ikb) + zeps*zqd(jl,ikb)-(1.-zeps)*zqenh(jl,ikb) zdqmin=max(0.01*zqenh(jl,ikb),cmfcmin) zmfmax=(paph(jl,ikb)-paph(jl,ikb-1))*zcons2 -! using moist static engergy closure instead of moisture closure - zdh=cpd*(ptu(jl,ikb)-zeps*ztd(jl,ikb)- & - & (1.-zeps)*ztenh(jl,ikb))+alv*zqumqe - zdh=g*max(zdh,1.e5*zdqmin) + ! using moist static engergy closure instead of moisture closure + zdh = cpd*(ptu(jl,ikb)-zeps*ztd(jl,ikb)- & + (1.-zeps)*ztenh(jl,ikb))+alv*zqumqe + !zdh=g*max(zdh,1.e5*zdqmin) + zdh = g*max(zdh,0.75*cpd) ! limiter updated to be consistent with IFS documentation + if(zdhpbl(jl).gt.0.)then - zmfub1(jl)=zdhpbl(jl)/zdh + zmfub1(jl) = zdhpbl(jl)/zdh else zmfub1(jl) = zmfub(jl) end if + + zmfub1(jl) = zmfub1(jl)/scale_fac2(jl) zmfub1(jl) = min(zmfub1(jl),zmfmax) end if -!* 6.3 mid-level convection - nothing special -!--------------------------------------------------------- + !* 6.3 mid-level convection - nothing special + !--------------------------------------------------------- if(ldcum(jl) .and. ktype(jl) .eq. 3 ) then zmfub1(jl) = zmfub(jl) end if end do -!* 6.4 scaling the downdraft mass flux -!--------------------------------------------------------- + !* 6.4 scaling the downdraft mass flux + !--------------------------------------------------------- do jk=1,klev do jl=1,klon if( ldcum(jl) ) then @@ -803,8 +881,8 @@ subroutine cumastrn & end do end do -!* 6.5 scaling the updraft mass flux -! -------------------------------------------------------- + !* 6.5 scaling the updraft mass flux + ! -------------------------------------------------------- do jl = 1,klon if ( ldcum(jl) ) zmfs(jl) = zmfub1(jl)/max(cmfcmin,zmfub(jl)) end do @@ -837,8 +915,8 @@ subroutine cumastrn & end do end do -!* 6.6 if ktype = 2, kcbot=kctop is not allowed -! --------------------------------------------------- + !* 6.6 if ktype = 2, kcbot=kctop is not allowed + ! --------------------------------------------------- do jl = 1,klon if ( ktype(jl) == 2 .and. & kcbot(jl) == kctop(jl) .and. kcbot(jl) >= klev-1 ) then @@ -858,8 +936,8 @@ subroutine cumastrn & end do end if -!* 6.7 set downdraft mass fluxes to zero above cloud top -!---------------------------------------------------- + !* 6.7 set downdraft mass fluxes to zero above cloud top + !---------------------------------------------------- do jl = 1,klon if ( loddraf(jl) .and. idtop(jl) <= kctop(jl) ) then idtop(jl) = kctop(jl) + 1 @@ -880,21 +958,19 @@ subroutine cumastrn & end if end do end do - - itopm2 = 2 !---------------------------------------------------------- !* 7.0 determine final convective fluxes in 'cuflx' !---------------------------------------------------------- - call cuflxn & - & ( klon, klev, ztmst & - & , pten, pqen, pqsen, ztenh, zqenh & - & , paph, pap, zgeoh, lndj, ldcum & - & , kcbot, kctop, idtop, itopm2 & - & , ktype, loddraf & - & , pmfu, pmfd, zmfus, zmfds & - & , zmfuq, zmfdq, zmful, plude & - & , zdmfup, zdmfdp, zdpmel, zlglac & - & , prain, pmfdde_rate, pmflxr, pmflxs ) + call cuflxn & + & ( klon, klev, ztmst & + & , pten, pqen, pqsen, ztenh, zqenh & + & , paph, pap, zgeoh, lndj, ldcum & + & , kcbot, kctop, idtop, itopm2 & + & , ktype, loddraf & + & , pmfu, pmfd, zmfus, zmfds & + & , zmfuq, zmfdq, zmful, plude & + & , zdmfup, zdmfdp, zdpmel, zlglac & + & , prain, pmfdde_rate, pmflxr, pmflxs ) ! some adjustments needed do jl=1,klon @@ -985,9 +1061,9 @@ subroutine cumastrn & !---------------------------------------------------------------- !* 8.0 update tendencies for t and q in subroutine cudtdq !---------------------------------------------------------------- - call cudtdqn(klon,klev,itopm2,kctop,idtop,ldcum,loddraf, & - ztmst,paph,zgeoh,pgeo,pten,ztenh,pqen,zqenh,pqsen, & - zlglac,plude,pmfu,pmfd,zmfus,zmfds,zmfuq,zmfdq,zmful, & + call cudtdqn(klon,klev,itopm2,kctop,idtop,ldcum,loddraf, & + ztmst,paph,zgeoh,pgeo,pten,ztenh,pqen,zqenh,pqsen, & + zlglac,plude,pmfu,pmfd,zmfus,zmfds,zmfuq,zmfdq,zmful, & zdmfup,zdmfdp,zdpmel,ptte,pqte,pcte) !---------------------------------------------------------------- !* 9.0 update tendencies for u and u in subroutine cududv @@ -1019,15 +1095,10 @@ subroutine cumastrn & zvu(jl,jk) = (zvu(jl,ik)*pmfu(jl,ik) + & zerate*pven(jl,jk)-zderate*zvu(jl,ik))*zmfa else - if(ktype(jl) == 1 .or. ktype(jl) == 3) then - pgf_u = -0.7*0.5*(pmfu(jl,ik)*(puen(jl,ik)-puen(jl,jk))+& + pgf_u = -pgcoef*0.5*(pmfu(jl,ik)*(puen(jl,ik)-puen(jl,jk))+& pmfu(jl,jk)*(puen(jl,jk)-puen(jl,jk-1))) - pgf_v = -0.7*0.5*(pmfu(jl,ik)*(pven(jl,ik)-pven(jl,jk))+& + pgf_v = -pgcoef*0.5*(pmfu(jl,ik)*(pven(jl,ik)-pven(jl,jk))+& pmfu(jl,jk)*(pven(jl,jk)-pven(jl,jk-1))) - else - pgf_u = 0. - pgf_v = 0. - end if zerate = pmfu(jl,jk) - pmfu(jl,ik) + pmfude_rate(jl,jk) zderate = pmfude_rate(jl,jk) zmfa = 1./max(cmfcmin,pmfu(jl,jk)) @@ -1213,13 +1284,13 @@ end subroutine cumastrn !********************************************** ! subroutine cuinin & - & (klon, klev, klevp1, klevm1, pten,& - & pqen, pqsen, puen, pven, pverv,& - & pgeo, paph, pgeoh, ptenh, pqenh,& - & pqsenh, klwmin, ptu, pqu, ptd,& - & pqd, puu, pvu, pud, pvd,& - & pmfu, pmfd, pmfus, pmfds, pmfuq,& - & pmfdq, pdmfup, pdmfdp, pdpmel, plu,& + & (klon, klev, klevp1, klevm1, pten, & + & pqen, pqsen, puen, pven, pverv, & + & pgeo, paph, pgeoh, ptenh, pqenh, & + & pqsenh, klwmin, ptu, pqu, ptd, & + & pqd, puu, pvu, pud, pvd, & + & pmfu, pmfd, pmfus, pmfds, pmfuq, & + & pmfdq, pdmfup, pdmfdp, pdpmel, plu, & & plude, klab) implicit none ! m.tiedtke e.c.m.w.f. 12/89 @@ -1238,30 +1309,33 @@ subroutine cuinin & ! --------- ! *cuadjtq* to specify qs at half levels ! ---------------------------------------------------------------- - integer klon,klev,klevp1,klevm1 - real(kind=kind_phys) pten(klon,klev), pqen(klon,klev),& - & puen(klon,klev), pven(klon,klev),& - & pqsen(klon,klev), pverv(klon,klev),& - & pgeo(klon,klev), pgeoh(klon,klevp1),& - & paph(klon,klevp1), ptenh(klon,klev),& - & pqenh(klon,klev), pqsenh(klon,klev) - real(kind=kind_phys) ptu(klon,klev), pqu(klon,klev),& - & ptd(klon,klev), pqd(klon,klev),& - & puu(klon,klev), pud(klon,klev),& - & pvu(klon,klev), pvd(klon,klev),& - & pmfu(klon,klev), pmfd(klon,klev),& - & pmfus(klon,klev), pmfds(klon,klev),& - & pmfuq(klon,klev), pmfdq(klon,klev),& - & pdmfup(klon,klev), pdmfdp(klon,klev),& - & plu(klon,klev), plude(klon,klev) - real(kind=kind_phys) zwmax(klon), zph(klon), & - & pdpmel(klon,klev) - integer klab(klon,klev), klwmin(klon) - logical loflag(klon) -! local variables - integer jl,jk - integer icall,ik - real(kind=kind_phys) zzs + +!--- input arguments: + integer,intent(in):: klon,klev,klevp1,klevm1 + + real(kind=kind_phys),intent(in),dimension(klon,klev):: pten,pqen,pqsen,puen,pven + real(kind=kind_phys),intent(in),dimension(klon,klev):: pgeo,pverv + real(kind=kind_phys),intent(in),dimension(klon,klev+1):: paph,pgeoh + +!--- output arguments: + integer,intent(out),dimension(klon):: klwmin + integer,intent(out),dimension(klon,klev):: klab + + real(kind=kind_phys),intent(out),dimension(klon,klev):: ptenh,pqenh,pqsenh + real(kind=kind_phys),intent(out),dimension(klon,klev):: ptu,ptd,pqu,pqd,plu + real(kind=kind_phys),intent(out),dimension(klon,klev):: puu,pud,pvu,pvd + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(klon,klev):: pmfu,pmfd,pmfus,pmfds,pmfuq,pmfdq + real(kind=kind_phys),intent(inout),dimension(klon,klev):: pdmfup,pdmfdp,plude,pdpmel + +!--- local variables and arrays: + logical,dimension(klon):: loflag + integer:: jl,jk + integer:: icall,ik + real(kind=kind_phys):: zzs + real(kind=kind_phys),dimension(klon):: zph,zwmax + !------------------------------------------------------------ !* 1. specify large scale parameters at half levels !* adjust temperature fields if staticly unstable @@ -1337,14 +1411,15 @@ subroutine cuinin & end subroutine cuinin !--------------------------------------------------------- -! level 3 souroutines +! level 3 subroutines !-------------------------------------------------------- - subroutine cutypen & - & ( klon, klev, klevp1, klevm1, pqen,& - & ptenh, pqenh, pqsenh, pgeoh, paph,& - & hfx, qfx, pgeo, pqsen, pap,& - & pten, lndj, cutu, cuqu, culab,& - & ldcum, cubot, cutop, ktype, wbase, culu, kdpl ) + subroutine cutypen & + & ( klon, klev, klevp1, klevm1, pqen, & + & ptenh, pqenh, pqsenh, pgeoh, paph, & + & hfx, qfx, pgeo, pqsen, pap, & + & pten, lndj, cutu, cuqu, culab, & + & ldcum, cubot, cutop, ktype, wbase, & + & culu, kdpl) ! zhang & wang iprc 2011-2013 !***purpose. ! -------- @@ -1370,7 +1445,7 @@ subroutine cutypen & ! climate, mon.wea.rev. ! 131, 2765-2778 ! and -! ifs documentation - cy36r1,cy38r1 +! ifs documentation - cy36r1,cy38r1 !***input variables: ! ptenh [ztenh] - environment temperature on half levels. (cuini) ! pqenh [zqenh] - env. specific humidity on half levels. (cuini) @@ -1388,52 +1463,53 @@ subroutine cutypen & !------------------------------------------------------------------- implicit none !------------------------------------------------------------------- - integer klon, klev, klevp1, klevm1 - real(kind=kind_phys) ptenh(klon,klev), pqenh(klon,klev),& - & pqsen(klon,klev), pqsenh(klon,klev),& - & pgeoh(klon,klevp1), paph(klon,klevp1),& - & pap(klon,klev), pqen(klon,klev) - real(kind=kind_phys) pten(klon,klev) - real(kind=kind_phys) ptu(klon,klev),pqu(klon,klev),plu(klon,klev) - real(kind=kind_phys) pgeo(klon,klev) - integer klab(klon,klev) - integer kctop(klon),kcbot(klon) - - real(kind=kind_phys) qfx(klon),hfx(klon) - real(kind=kind_phys) zph(klon) - integer lndj(klon) - logical loflag(klon), deepflag(klon), resetflag(klon) - -! output variables - real(kind=kind_phys) cutu(klon,klev), cuqu(klon,klev), culu(klon,klev) - integer culab(klon,klev) - real(kind=kind_phys) wbase(klon) - integer ktype(klon),cubot(klon),cutop(klon),kdpl(klon) - logical ldcum(klon) -! local variables - real(kind=kind_phys) zqold(klon) - real(kind=kind_phys) rho, part1, part2, root, conw, deltt, deltq - real(kind=kind_phys) eta(klon),dz(klon),coef(klon) - real(kind=kind_phys) dhen(klon,klev), dh(klon,klev) - real(kind=kind_phys) plude(klon,klev) - real(kind=kind_phys) kup(klon,klev) - real(kind=kind_phys) vptu(klon,klev),vten(klon,klev) - real(kind=kind_phys) zbuo(klon,klev),abuoy(klon,klev) - - real(kind=kind_phys) zz,zdken,zdq - real(kind=kind_phys) fscale,crirh1,pp - real(kind=kind_phys) atop1,atop2,abot - real(kind=kind_phys) tmix,zmix,qmix,pmix - real(kind=kind_phys) zlglac,dp - integer nk,is,ikb,ikt - - real(kind=kind_phys) zqsu,zcor,zdp,zesdp,zalfaw,zfacw,zfaci,zfac,zdsdp,zdqsdt,zdtdp - real(kind=kind_phys) zpdifftop, zpdiffbot - integer zcbase(klon), itoppacel(klon) - integer jl,jk,ik,icall,levels - logical needreset, lldcum(klon) -!-------------------------------------------------------------- +!--- input arguments: + integer,intent(in):: klon,klev,klevp1,klevm1 + integer,intent(in),dimension(klon):: lndj + + real(kind=kind_phys),dimension(klon):: qfx,hfx + real(kind=kind_phys),intent(in),dimension(klon,klev):: pap,pgeo + real(kind=kind_phys),intent(in),dimension(klon,klev):: pten,pqen,pqsen + real(kind=kind_phys),intent(in),dimension(klon,klev):: ptenh,pqenh,pqsenh + real(kind=kind_phys),intent(in),dimension(klon,klevp1):: paph,pgeoh + +!--- output arguments: + logical,intent(out),dimension(klon):: ldcum + + integer,intent(out),dimension(klon):: ktype + integer,intent(out),dimension(klon):: cubot,cutop,kdpl + integer,intent(out),dimension(klon,klev):: culab + + real(kind=kind_phys),intent(out),dimension(klon):: wbase + real(kind=kind_phys),intent(out),dimension(klon,klev):: cutu,cuqu,culu + +!--- local variables and arrays: + logical:: needreset + logical,dimension(klon):: lldcum + logical,dimension(klon):: loflag,deepflag,resetflag + + integer:: jl,jk,ik,icall,levels + integer:: nk,is,ikb,ikt + integer,dimension(klon):: kctop,kcbot + integer,dimension(klon):: zcbase,itoppacel + integer,dimension(klon,klev):: klab + + real(kind=kind_phys):: rho,part1,part2,root,conw,deltt,deltq + real(kind=kind_phys):: zz,zdken,zdq + real(kind=kind_phys):: fscale,crirh1,pp + real(kind=kind_phys):: atop1,atop2,abot + real(kind=kind_phys):: tmix,zmix,qmix,pmix + real(kind=kind_phys):: zlglac,dp + real(kind=kind_phys):: zqsu,zcor,zdp,zesdp,zalfaw,zfacw,zfaci,zfac,zdsdp,zdqsdt,zdtdp + real(kind=kind_phys):: zpdifftop, zpdiffbot + + real(kind=kind_phys),dimension(klon):: eta,dz,coef,zqold,zph + real(kind=kind_phys),dimension(klon,klev):: dh,dhen,kup,vptu,vten + real(kind=kind_phys),dimension(klon,klev):: ptu,pqu,plu + real(kind=kind_phys),dimension(klon,klev):: zbuo,abuoy,plude + + !-------------------------------------------------------------- do jl=1,klon kcbot(jl)=klev kctop(jl)=klev @@ -1443,24 +1519,23 @@ subroutine cutypen & ldcum(jl)=.false. end do -!----------------------------------------------------------- -! let's do test,and check the shallow convection first -! the first level is klev -! define deltat and deltaq -!----------------------------------------------------------- + !----------------------------------------------------------- + ! let's do test,and check the shallow convection first + ! the first level is klev + !----------------------------------------------------------- do jk=1,klev do jl=1,klon - plu(jl,jk)=culu(jl,jk) ! parcel liquid water - ptu(jl,jk)=cutu(jl,jk) ! parcel temperature - pqu(jl,jk)=cuqu(jl,jk) ! parcel specific humidity - klab(jl,jk)=culab(jl,jk) - dh(jl,jk)=0.0 ! parcel dry static energy - dhen(jl,jk)=0.0 ! environment dry static energy - kup(jl,jk)=0.0 ! updraught kinetic energy for parcel - vptu(jl,jk)=0.0 ! parcel virtual temperature considering water-loading - vten(jl,jk)=0.0 ! environment virtual temperature - zbuo(jl,jk)=0.0 ! parcel buoyancy - abuoy(jl,jk)=0.0 + plu(jl,jk) = culu(jl,jk) ! parcel liquid water + ptu(jl,jk) = cutu(jl,jk) ! parcel temperature + pqu(jl,jk) = cuqu(jl,jk) ! parcel specific humidity + klab(jl,jk) = culab(jl,jk) + dh(jl,jk) = 0.0 ! parcel dry static energy + dhen(jl,jk) = 0.0 ! environment dry static energy + kup(jl,jk) = 0.0 ! updraught kinetic energy for parcel + vptu(jl,jk) = 0.0 ! parcel virtual temperature considering water-loading + vten(jl,jk) = 0.0 ! environment virtual temperature + zbuo(jl,jk) = 0.0 ! parcel buoyancy + abuoy(jl,jk) = 0.0 end do end do @@ -1470,76 +1545,100 @@ subroutine cutypen & loflag(jl) = .true. end do -! check the levels from lowest level to second top level + ! check the levels from lowest level to second top level do jk=klevm1,2,-1 -! define the variables at the first level + ! define the variables at the first level if(jk .eq. klevm1) then + do jl=1,klon - rho=pap(jl,klev)/ & - & (rd*(pten(jl,klev)*(1.+vtmpc1*pqen(jl,klev)))) + + rho = pap(jl,klev) / & + (rd*(pten(jl,klev)*(1.+vtmpc1*pqen(jl,klev)))) hfx(jl) = hfx(jl)*rho*cpd qfx(jl) = qfx(jl)*rho part1 = 1.5*0.4*pgeo(jl,klev)/ & - & (rho*pten(jl,klev)) + (rho*pten(jl,klev)) part2 = -hfx(jl)*rcpd-vtmpc1*pten(jl,klev)*qfx(jl) root = 0.001-part1*part2 + if(part2 .lt. 0.) then conw = 1.2*(root)**t13 deltt = max(1.5*hfx(jl)/(rho*cpd*conw),0.) deltq = max(1.5*qfx(jl)/(rho*conw),0.) kup(jl,klev) = 0.5*(conw**2) - pqu(jl,klev)= pqenh(jl,klev) + deltq - dhen(jl,klev)= pgeoh(jl,klev) + ptenh(jl,klev)*cpd + pqu(jl,klev) = pqenh(jl,klev) + deltq + dhen(jl,klev) = pgeoh(jl,klev) + ptenh(jl,klev)*cpd dh(jl,klev) = dhen(jl,klev) + deltt*cpd - ptu(jl,klev) = (dh(jl,klev)-pgeoh(jl,klev))*rcpd - vptu(jl,klev)=ptu(jl,klev)*(1.+vtmpc1*pqu(jl,klev)) - vten(jl,klev)=ptenh(jl,klev)*(1.+vtmpc1*pqenh(jl,klev)) - zbuo(jl,klev)=(vptu(jl,klev)-vten(jl,klev))/vten(jl,klev) + ptu(jl,klev) = (dh(jl,klev)-pgeoh(jl,klev))*rcpd + vptu(jl,klev) = ptu(jl,klev)*(1.+vtmpc1*pqu(jl,klev)) + vten(jl,klev) = ptenh(jl,klev)*(1.+vtmpc1*pqenh(jl,klev)) + zbuo(jl,klev) = (vptu(jl,klev)-vten(jl,klev))/vten(jl,klev) klab(jl,klev) = 1 else loflag(jl) = .false. end if + end do - end if - + + end if ! end if(jk .eq. klevm1) + is=0 do jl=1,klon if(loflag(jl))then is=is+1 endif enddo + if(is.eq.0) exit -! the next levels, we use the variables at the first level as initial values + ! the next levels, we use the variables at the first level as initial values do jl=1,klon if(loflag(jl)) then - eta(jl) = 0.55/(pgeo(jl,jk)*zrg)+1.e-4 + !---------------------------------------- + ! Parcel entrainment rate for shallow convection. + ! Used to determine whether or not shallow + ! convection is triggered. Final entrainment + ! rate is calculated later. + !---------------------------------------- + eta(jl) = 0.8 / (pgeo(jl,jk)*zrg) + 2.e-4 + dz(jl) = (pgeoh(jl,jk)-pgeoh(jl,jk+1))*zrg + coef(jl)= 0.5*eta(jl)*dz(jl) + dhen(jl,jk) = pgeoh(jl,jk) + cpd*ptenh(jl,jk) + dh(jl,jk) = (coef(jl)*(dhen(jl,jk+1)+dhen(jl,jk))& - & +(1.-coef(jl))*dh(jl,jk+1))/(1.+coef(jl)) + + (1.-coef(jl))*dh(jl,jk+1))/(1.+coef(jl)) + pqu(jl,jk) =(coef(jl)*(pqenh(jl,jk+1)+pqenh(jl,jk))& - & +(1.-coef(jl))*pqu(jl,jk+1))/(1.+coef(jl)) + + (1.-coef(jl))*pqu(jl,jk+1))/(1.+coef(jl)) + ptu(jl,jk) = (dh(jl,jk)-pgeoh(jl,jk))*rcpd + zqold(jl) = pqu(jl,jk) + zph(jl)=paph(jl,jk) + end if end do -! check if the parcel is saturated + ! check if the parcel is saturated ik=jk icall=1 + call cuadjtqn(klon,klev,ik,zph,ptu,pqu,loflag,icall) + do jl=1,klon if( loflag(jl) ) then + zdq = max((zqold(jl) - pqu(jl,jk)),0.) plu(jl,jk) = plu(jl,jk+1) + zdq zlglac=zdq*((1.-foealfa(ptu(jl,jk))) - & (1.-foealfa(ptu(jl,jk+1)))) plu(jl,jk) = min(plu(jl,jk),5.e-3) dh(jl,jk) = pgeoh(jl,jk) + cpd*(ptu(jl,jk)+ralfdcp*zlglac) -! compute the updraft speed + ! compute the updraft speed vptu(jl,jk) = ptu(jl,jk)*(1.+vtmpc1*pqu(jl,jk)-plu(jl,jk))+& ralfdcp*zlglac vten(jl,jk) = ptenh(jl,jk)*(1.+vtmpc1*pqenh(jl,jk)) @@ -1550,8 +1649,8 @@ subroutine cutypen & abot = 1.0 + 2.*coef(jl) kup(jl,jk) = (atop1*kup(jl,jk+1) + atop2) / abot -! let's find the exact cloud base - if ( plu(jl,jk) > 0. .and. klab(jl,jk+1) == 1 ) then + ! let's find the exact cloud base + if( plu(jl,jk) > 0. .and. klab(jl,jk+1) == 1 ) then ik = jk + 1 zqsu = foeewm(ptu(jl,ik))/paph(jl,ik) zqsu = min(0.5,zqsu) @@ -1568,9 +1667,10 @@ subroutine cutypen & zdtdp = rd*ptu(jl,ik)/(cpd*paph(jl,ik)) zdp = zdq/(zdqsdt*zdtdp) zcbase(jl) = paph(jl,ik) + zdp -! chose nearest half level as cloud base (jk or jk+1) + ! chose nearest half level as cloud base (jk or jk+1) zpdifftop = zcbase(jl) - paph(jl,jk) zpdiffbot = paph(jl,jk+1) - zcbase(jl) + if ( zpdifftop > zpdiffbot .and. kup(jl,jk+1) > 0. ) then ikb = min(klev-1,jk+1) klab(jl,ikb) = 2 @@ -1581,6 +1681,7 @@ subroutine cutypen & klab(jl,jk) = 2 kcbot(jl) = jk end if + end if if(kup(jl,jk) .lt. 0.)then @@ -1591,7 +1692,7 @@ subroutine cutypen & else lldcum(jl) = .false. end if - else + else if(plu(jl,jk) .gt. 0.)then klab(jl,jk)=2 else @@ -1604,9 +1705,13 @@ subroutine cutypen & end do ! end all the levels do jl=1,klon + ikb = kcbot(jl) ikt = kctop(jl) + if(paph(jl,ikb) - paph(jl,ikt) > zdnoprc) lldcum(jl) = .false. + + ! if shallow cumulus is found, define some properties if(lldcum(jl)) then ktype(jl) = 2 ldcum(jl) = .true. @@ -1621,6 +1726,7 @@ subroutine cutypen & ldcum(jl) = .false. wbase(jl) = 0. end if + end do do jk=klev,1,-1 @@ -1634,16 +1740,17 @@ subroutine cutypen & end if end do end do - -!----------------------------------------------------------- -! next, let's check the deep convection -! the first level is klevm1-1 -! define deltat and deltaq -!---------------------------------------------------------- -! we check the parcel starting level by level -! assume the mix-layer is 60hPa - deltt = 0.2 - deltq = 1.0e-4 + + !----------------------------------------------------------- + ! next, let's check the deep convection + ! the first level is klevm1-1 + ! define deltat and deltaq + !---------------------------------------------------------- + ! we check the parcel starting level by level + ! assume the mix-layer is 60hPa + deltt = 0.2 ! give parcel a small temperature perturbation at surface (Eq. 6.21 IFS Cy48r1) + deltq = 1.0e-4 ! give parcel a small humidity perturbation at surface (Eq. 6.21 IFS Cy48r1) + do jl=1,klon deepflag(jl) = .false. end do @@ -1654,20 +1761,21 @@ subroutine cutypen & end do end do - do levels=klevm1-1,klevm1-20,-1 ! loop starts + do levels = klevm1-1, klev/2+1, -1 ! loop starts + do jk=1,klev do jl=1,klon - plu(jl,jk)=0.0 ! parcel liquid water - ptu(jl,jk)=0.0 ! parcel temperature - pqu(jl,jk)=0.0 ! parcel specific humidity - dh(jl,jk)=0.0 ! parcel dry static energy - dhen(jl,jk)=0.0 ! environment dry static energy - kup(jl,jk)=0.0 ! updraught kinetic energy for parcel - vptu(jl,jk)=0.0 ! parcel virtual temperature consideringwater-loading - vten(jl,jk)=0.0 ! environment virtual temperature - abuoy(jl,jk)=0.0 - zbuo(jl,jk)=0.0 - klab(jl,jk)=0 + plu(jl,jk) = 0.0 ! parcel liquid water + ptu(jl,jk) = 0.0 ! parcel temperature + pqu(jl,jk) = 0.0 ! parcel specific humidity + dh(jl,jk) = 0.0 ! parcel dry static energy + dhen(jl,jk) = 0.0 ! environment dry static energy + kup(jl,jk) = 0.0 ! updraught kinetic energy for parcel + vptu(jl,jk) = 0.0 ! parcel virtual temperature consideringwater-loading + vten(jl,jk) = 0.0 ! environment virtual temperature + abuoy(jl,jk) = 0.0 + zbuo(jl,jk) = 0.0 + klab(jl,jk) = 0 end do end do @@ -1680,79 +1788,95 @@ subroutine cutypen & loflag(jl) = (.not. deepflag(jl)) .and. (levels.ge.itoppacel(jl)) end do -! start the inner loop to search the deep convection points - do jk=levels,2,-1 - is=0 + ! start the inner loop to search the deep convection points + do jk = levels,2,-1 + + is = 0 + do jl=1,klon if(loflag(jl))then - is=is+1 + is = is + 1 endif enddo + if(is.eq.0) exit -! define the variables at the departure level + ! define the variables at the departure level if(jk .eq. levels) then do jl=1,klon if(loflag(jl)) then if((paph(jl,klev+1)-paph(jl,jk)) < 60.e2) then - tmix=0. - qmix=0. - zmix=0. - pmix=0. + + tmix = 0. + qmix = 0. + zmix = 0. + pmix = 0. + do nk=jk+2,jk,-1 if(pmix < 50.e2) then dp = paph(jl,nk) - paph(jl,nk-1) - tmix=tmix+dp*ptenh(jl,nk) - qmix=qmix+dp*pqenh(jl,nk) - zmix=zmix+dp*pgeoh(jl,nk) - pmix=pmix+dp + tmix = tmix + dp*ptenh(jl,nk) + qmix = qmix + dp*pqenh(jl,nk) + zmix = zmix + dp*pgeoh(jl,nk) + pmix = pmix + dp end if end do - tmix=tmix/pmix - qmix=qmix/pmix - zmix=zmix/pmix - else - tmix=ptenh(jl,jk+1) - qmix=pqenh(jl,jk+1) - zmix=pgeoh(jl,jk+1) + + tmix = tmix / pmix + qmix = qmix / pmix + zmix = zmix / pmix + + else + tmix = ptenh(jl,jk+1) + qmix = pqenh(jl,jk+1) + zmix = pgeoh(jl,jk+1) end if pqu(jl,jk+1) = qmix + deltq dhen(jl,jk+1)= zmix + tmix*cpd dh(jl,jk+1) = dhen(jl,jk+1) + deltt*cpd - ptu(jl,jk+1) = (dh(jl,jk+1)-pgeoh(jl,jk+1))*rcpd + ptu(jl,jk+1) = (dh(jl,jk+1)-pgeoh(jl,jk+1)) * rcpd kup(jl,jk+1) = 0.5 klab(jl,jk+1)= 1 - vptu(jl,jk+1)=ptu(jl,jk+1)*(1.+vtmpc1*pqu(jl,jk+1)) - vten(jl,jk+1)=ptenh(jl,jk+1)*(1.+vtmpc1*pqenh(jl,jk+1)) - zbuo(jl,jk+1)=(vptu(jl,jk+1)-vten(jl,jk+1))/vten(jl,jk+1) + vptu(jl,jk+1) = ptu(jl,jk+1) * (1.+vtmpc1*pqu(jl,jk+1)) + vten(jl,jk+1) = ptenh(jl,jk+1) * (1.+vtmpc1*pqenh(jl,jk+1)) + zbuo(jl,jk+1) = (vptu(jl,jk+1)-vten(jl,jk+1)) / vten(jl,jk+1) end if end do - end if + end if ! end if(jk .eq. levels) then -! the next levels, we use the variables at the first level as initial values + ! the next levels, we use the variables at the first level as initial values do jl=1,klon if(loflag(jl)) then -! define the fscale - fscale = min(1.,(pqsen(jl,jk)/pqsen(jl,levels))**3) - eta(jl) = 1.75e-3*fscale - dz(jl) = (pgeoh(jl,jk)-pgeoh(jl,jk+1))*zrg - coef(jl)= 0.5*eta(jl)*dz(jl) + + ! calculate parcel entrainment rate for deep convection + fscale = min(1.,(pqsen(jl,jk)/pqsen(jl,levels))**3) ! (env. qvsat / (env. qvsat at cloud base))**3 + !eta(jl) = 1.75e-3 * (0.3-(min(1.,pqen(jl,jk) /pqsen(jl,jk))-1.)) * fscale ! entrainment rate + eta(jl) = entorg * fscale ! entrainment rate + dz(jl) = (pgeoh(jl,jk)-pgeoh(jl,jk+1)) * zrg ! convert from geopotential to height + !coef(jl) = eta(jl) * dz(jl) + coef(jl) = 0.5 * eta(jl) * dz(jl) + + ! dry static energy of environment dhen(jl,jk) = pgeoh(jl,jk) + cpd*ptenh(jl,jk) - dh(jl,jk) = (coef(jl)*(dhen(jl,jk+1)+dhen(jl,jk))& - & +(1.-coef(jl))*dh(jl,jk+1))/(1.+coef(jl)) - pqu(jl,jk) =(coef(jl)*(pqenh(jl,jk+1)+pqenh(jl,jk))& - & +(1.-coef(jl))*pqu(jl,jk+1))/(1.+coef(jl)) + ! dry static energy for entraining parcel + dh(jl,jk) = (coef(jl)*(dhen(jl,jk+1)+dhen(jl,jk)) + (1.-coef(jl))*dh(jl,jk+1)) / (1.+coef(jl)) + ! mixing ratio for entraining parcel + pqu(jl,jk) = ( coef(jl)*(pqenh(jl,jk+1)+pqenh(jl,jk)) + (1.-coef(jl))*pqu(jl,jk+1) ) / (1.+coef(jl)) + ! temperature for entraining parcel ptu(jl,jk) = (dh(jl,jk)-pgeoh(jl,jk))*rcpd + zqold(jl) = pqu(jl,jk) - zph(jl)=paph(jl,jk) + zph(jl) = paph(jl,jk) + end if end do -! check if the parcel is saturated + + ! check if the parcel is saturated ik=jk icall=1 call cuadjtqn(klon,klev,ik,zph,ptu,pqu,loflag,icall) - + do jl=1,klon if( loflag(jl) ) then zdq = max((zqold(jl) - pqu(jl,jk)),0.) @@ -1761,18 +1885,19 @@ subroutine cutypen & (1.-foealfa(ptu(jl,jk+1)))) plu(jl,jk) = 0.5*plu(jl,jk) dh(jl,jk) = pgeoh(jl,jk) + cpd*(ptu(jl,jk)+ralfdcp*zlglac) -! compute the updraft speed - vptu(jl,jk) = ptu(jl,jk)*(1.+vtmpc1*pqu(jl,jk)-plu(jl,jk))+& - ralfdcp*zlglac + ! compute the updraft speed + vptu(jl,jk) = ptu(jl,jk)*(1.+vtmpc1*pqu(jl,jk)-plu(jl,jk)) + ralfdcp*zlglac vten(jl,jk) = ptenh(jl,jk)*(1.+vtmpc1*pqenh(jl,jk)) - zbuo(jl,jk) = (vptu(jl,jk) - vten(jl,jk))/vten(jl,jk) - abuoy(jl,jk)=(zbuo(jl,jk)+zbuo(jl,jk+1))*0.5*g + zbuo(jl,jk) = (vptu(jl,jk) - vten(jl,jk)) / vten(jl,jk) + abuoy(jl,jk) = (zbuo(jl,jk)+zbuo(jl,jk+1))*0.5*g atop1 = 1.0 - 2.*coef(jl) - atop2 = 2.0*dz(jl)*abuoy(jl,jk) + atop2 = 2.0 * dz(jl) * abuoy(jl,jk) abot = 1.0 + 2.*coef(jl) kup(jl,jk) = (atop1*kup(jl,jk+1) + atop2) / abot -! let's find the exact cloud base - if ( plu(jl,jk) > 0. .and. klab(jl,jk+1) == 1 ) then + + ! let's find the exact cloud base + if( plu(jl,jk) > 0. .and. klab(jl,jk+1) == 1 ) then + ik = jk + 1 zqsu = foeewm(ptu(jl,ik))/paph(jl,ik) zqsu = min(0.5,zqsu) @@ -1789,9 +1914,10 @@ subroutine cutypen & zdtdp = rd*ptu(jl,ik)/(cpd*paph(jl,ik)) zdp = zdq/(zdqsdt*zdtdp) zcbase(jl) = paph(jl,ik) + zdp -! chose nearest half level as cloud base (jk or jk+1) + ! choose nearest half level as cloud base (jk or jk+1) zpdifftop = zcbase(jl) - paph(jl,jk) zpdiffbot = paph(jl,jk+1) - zcbase(jl) + if ( zpdifftop > zpdiffbot .and. kup(jl,jk+1) > 0. ) then ikb = min(klev-1,jk+1) klab(jl,ikb) = 2 @@ -1802,6 +1928,7 @@ subroutine cutypen & klab(jl,jk) = 2 kcbot(jl) = jk end if + end if if(kup(jl,jk) .lt. 0.)then @@ -1812,7 +1939,7 @@ subroutine cutypen & else lldcum(jl) = .false. end if - else + else if(plu(jl,jk) .gt. 0.)then klab(jl,jk)=2 else @@ -1829,7 +1956,7 @@ subroutine cutypen & ikb = kcbot(jl) ikt = kctop(jl) if(paph(jl,ikb) - paph(jl,ikt) < zdnoprc) lldcum(jl) = .false. - if(lldcum(jl)) then + if(lldcum(jl)) then ktype(jl) = 1 ldcum(jl) = .true. deepflag(jl) = .true. @@ -1874,15 +2001,17 @@ end subroutine cutypen ! level 3 subroutines 'cuascn' !----------------------------------------------------------------- subroutine cuascn & - & (klon, klev, klevp1, klevm1, ptenh,& - & pqenh, puen, pven, pten, pqen,& - & pqsen, pgeo, pgeoh, pap, paph,& - & pqte, pverv, klwmin, ldcum, phcbase,& - & ktype, klab, ptu, pqu, plu,& - & puu, pvu, pmfu, pmfub, & - & pmfus, pmfuq, pmful, plude, pdmfup,& - & kcbot, kctop, kctop0, kcum, ztmst,& - & pqsenh, plglac, lndj, wup, wbase, kdpl, pmfude_rate) + & (klon, klev, klevp1, klevm1, ptenh, & + & pqenh, puen, pven, pten, pqen, & + & pqsen, pgeo, pgeoh, pap, paph, & + & pqte, pverv, klwmin, ldcum, phcbase, & + & ktype, klab, ptu, pqu, plu, & + & puu, pvu, pmfu, pmfub, & + & pmfus, pmfuq, pmful, plude, pdmfup, & + & kcbot, kctop, kctop0, kcum, ztmst, & + & pqsenh, plglac, lndj, wup, wbase, & + & kdpl, pmfude_rate) + implicit none ! this routine does the calculations for cloud ascents ! for cumulus parameterization @@ -1954,68 +2083,71 @@ subroutine cuascn & ! kctop0 [ictop0] - estimate of cloud top. (cumastr) ! kcum [icum] - flag to control the call - integer klev,klon,klevp1,klevm1 - real(kind=kind_phys) ptenh(klon,klev), pqenh(klon,klev), & - & puen(klon,klev), pven(klon,klev),& - & pten(klon,klev), pqen(klon,klev),& - & pgeo(klon,klev), pgeoh(klon,klevp1),& - & pap(klon,klev), paph(klon,klevp1),& - & pqsen(klon,klev), pqte(klon,klev),& - & pverv(klon,klev), pqsenh(klon,klev) - real(kind=kind_phys) ptu(klon,klev), pqu(klon,klev),& - & puu(klon,klev), pvu(klon,klev),& - & pmfu(klon,klev), zph(klon),& - & pmfub(klon), & - & pmfus(klon,klev), pmfuq(klon,klev),& - & plu(klon,klev), plude(klon,klev),& - & pmful(klon,klev), pdmfup(klon,klev) - real(kind=kind_phys) zdmfen(klon), zdmfde(klon),& - & zmfuu(klon), zmfuv(klon),& - & zpbase(klon), zqold(klon) - real(kind=kind_phys) phcbase(klon), zluold(klon) - real(kind=kind_phys) zprecip(klon), zlrain(klon,klev) - real(kind=kind_phys) zbuo(klon,klev), kup(klon,klev) - real(kind=kind_phys) wup(klon) - real(kind=kind_phys) wbase(klon), zodetr(klon,klev) - real(kind=kind_phys) plglac(klon,klev) - - real(kind=kind_phys) eta(klon),dz(klon) - - integer klwmin(klon), ktype(klon),& - & klab(klon,klev), kcbot(klon),& - & kctop(klon), kctop0(klon) - integer lndj(klon) - logical ldcum(klon), loflag(klon) - logical llo2,llo3, llo1(klon) - - integer kdpl(klon) - real(kind=kind_phys) zoentr(klon), zdpmean(klon) - real(kind=kind_phys) pdmfen(klon,klev), pmfude_rate(klon,klev) -! local variables - integer jl,jk - integer ikb,icum,itopm2,ik,icall,is,kcum,jlm,jll - integer jlx(klon) - real(kind=kind_phys) ztmst,zcons2,zfacbuo,zprcdgw,z_cwdrag,z_cldmax,z_cwifrac,z_cprc2 - real(kind=kind_phys) zmftest,zmfmax,zqeen,zseen,zscde,zqude - real(kind=kind_phys) zmfusk,zmfuqk,zmfulk - real(kind=kind_phys) zbc,zbe,zkedke,zmfun,zwu,zprcon,zdt,zcbf,zzco - real(kind=kind_phys) zlcrit,zdfi,zc,zd,zint,zlnew,zvw,zvi,zalfaw,zrold - real(kind=kind_phys) zrnew,zz,zdmfeu,zdmfdu,dp - real(kind=kind_phys) zfac,zbuoc,zdkbuo,zdken,zvv,zarg,zchange,zxe,zxs,zdshrd - real(kind=kind_phys) atop1,atop2,abot -!-------------------------------- -!* 1. specify parameters -!-------------------------------- - zcons2=3./(g*ztmst) - zfacbuo = 0.5/(1.+0.5) + !--- input arguments: + integer,intent(in):: klev,klon,klevp1,klevm1 + integer,intent(in),dimension(klon):: lndj + integer,intent(in),dimension(klon):: klwmin + integer,intent(in),dimension(klon):: kdpl + + real(kind=kind_phys),intent(in):: ztmst + real(kind=kind_phys),intent(in),dimension(klon):: wbase + real(kind=kind_phys),intent(in),dimension(klon,klev):: pten,pqen,pqsen,puen,pven,pqte,pverv + real(kind=kind_phys),intent(in),dimension(klon,klev):: pap,pgeo + real(kind=kind_phys),intent(in),dimension(klon,klevp1):: paph,pgeoh + + !--- inout arguments: + logical,intent(inout),dimension(klon):: ldcum + + integer,intent(inout):: kcum + integer,intent(inout),dimension(klon):: kcbot,kctop,kctop0 + integer,intent(inout),dimension(klon,klev):: klab + + real(kind=kind_phys),intent(inout),dimension(klon):: phcbase + real(kind=kind_phys),intent(inout),dimension(klon):: pmfub + real(kind=kind_phys),intent(inout),dimension(klon,klev):: ptenh,pqenh,pqsenh + real(kind=kind_phys),intent(inout),dimension(klon,klev):: ptu,pqu,plu,puu,pvu + real(kind=kind_phys),intent(inout),dimension(klon,klev):: pmfu,pmfus,pmfuq,pmful,plude,pdmfup + + !--- output arguments: + integer,intent(out),dimension(klon):: ktype + + real(kind=kind_phys),intent(out),dimension(klon):: wup + real(kind=kind_phys),intent(out),dimension(klon,klev):: plglac,pmfude_rate + + !--- local variables and arrays: + logical:: llo2,llo3 + logical,dimension(klon):: loflag,llo1 + + integer:: jl,jk + integer::ikb,icum,itopm2,ik,icall,is,jlm,jll + integer,dimension(klon):: jlx + + real(kind=kind_phys):: zcons2,zfacbuo,zprcdgw,z_cwdrag,z_cldmax,z_cwifrac,z_cprc2 + real(kind=kind_phys):: zmftest,zmfmax,zqeen,zseen,zscde,zqude + real(kind=kind_phys):: zmfusk,zmfuqk,zmfulk + real(kind=kind_phys):: zbc,zbe,zkedke,zmfun,zwu,zprcon,zdt,zcbf,zzco + real(kind=kind_phys):: zlcrit,zdfi,zc,zd,zint,zlnew,zvw,zvi,zalfaw,zrold + real(kind=kind_phys):: zrnew,zz,zdmfeu,zdmfdu,dp + real(kind=kind_phys):: zfac,zbuoc,zdkbuo,zdken,zvv,zarg,zchange,zxe,zxs,zdshrd + real(kind=kind_phys):: atop1,atop2,abot + + real(kind=kind_phys),dimension(klon):: eta,dz,zoentr,zdpmean + real(kind=kind_phys),dimension(klon):: zph,zdmfen,zdmfde,zmfuu,zmfuv,zpbase,zqold,zluold,zprecip + real(kind=kind_phys),dimension(klon,klev):: zlrain,zbuo,kup,zodetr,pdmfen + + !-------------------------------- + !* 1. specify parameters + !-------------------------------- + zcons2 = 3./ (g*ztmst) + zfacbuo = 0.5 / (1.+0.5) zprcdgw = cprcon*zrg z_cldmax = 5.e-3 z_cwifrac = 0.5 z_cprc2 = 0.5 z_cwdrag = (3.0/8.0)*0.506/0.2 -!--------------------------------- -! 2. set default values -!--------------------------------- + !--------------------------------- + ! 2. set default values + !--------------------------------- llo3 = .false. do jl=1,klon zluold(jl)=0. @@ -2030,7 +2162,7 @@ subroutine cuascn & end if end do - ! initialize variout quantities + ! initialize variout quantities do jk=1,klev do jl=1,klon if(jk.ne.kcbot(jl)) plu(jl,jk)=0. @@ -2054,9 +2186,9 @@ subroutine cuascn & do jl = 1,klon if ( ktype(jl) == 3 ) ldcum(jl) = .false. end do -!------------------------------------------------ -! 3.0 initialize values at cloud base level -!------------------------------------------------ + !------------------------------------------------ + ! 3.0 initialize values at cloud base level + !------------------------------------------------ do jl=1,klon kctop(jl)=kcbot(jl) if(ldcum(jl)) then @@ -2068,25 +2200,24 @@ subroutine cuascn & pmful(jl,ikb) = pmfub(jl)*plu(jl,ikb) end if end do -! -!----------------------------------------------------------------- -! 4. do ascent: subcloud layer (klab=1) ,clouds (klab=2) -! by doing first dry-adiabatic ascent and then -! by adjusting t,q and l accordingly in *cuadjtqn*, -! then check for buoyancy and set flags accordingly -!----------------------------------------------------------------- -! + !----------------------------------------------------------------- + ! 4. do ascent: subcloud layer (klab=1) ,clouds (klab=2) + ! by doing first dry-adiabatic ascent and then + ! by adjusting t,q and l accordingly in *cuadjtqn*, + ! then check for buoyancy and set flags accordingly + !----------------------------------------------------------------- do jk=klevm1,3,-1 -! specify cloud base values for midlevel convection -! in *cubasmc* in case there is not already convection -! --------------------------------------------------------------------- + ! ----------------------------------------------------- + ! specify cloud base values for midlevel convection + ! in *cubasmc* in case there is not already convection + ! ----------------------------------------------------- ik=jk call cubasmcn& - & (klon, klev, klevm1, ik, pten,& - & pqen, pqsen, puen, pven, pverv,& - & pgeo, pgeoh, ldcum, ktype, klab, zlrain,& - & pmfu, pmfub, kcbot, ptu,& - & pqu, plu, puu, pvu, pmfus,& + & (klon, klev, klevm1, ik, pten, & + & pqen, pqsen, puen, pven, pverv, & + & pgeo, pgeoh, ldcum, ktype, klab, zlrain, & + & pmfu, pmfub, kcbot, ptu, & + & pqu, plu, puu, pvu, pmfus, & & pmfuq, pmful, pdmfup) is = 0 jlm = 0 @@ -2117,40 +2248,67 @@ subroutine cuascn & end do if(is.gt.0) llo3 = .true. -! -!* specify entrainment rates in *cuentr* -! ------------------------------------- - ik=jk + ! + !* specify entrainment rates in *cuentr* + ! ------------------------------------- + ik = jk call cuentrn(klon,klev,ik,kcbot,ldcum,llo3, & pgeoh,pmfu,zdmfen,zdmfde) -! -! do adiabatic ascent for entraining/detraining plume + ! ------------------------------------------------------- + ! do adiabatic ascent for entraining/detraining plume if(llo3) then -! ------------------------------------------------------- -! + do jl = 1,klon zqold(jl) = 0. end do + do jll = 1 , jlm + jl = jlx(jll) zdmfde(jl) = min(zdmfde(jl),0.75*pmfu(jl,jk+1)) + !--------------------------------------- + ! Entrainment parameter at cloud base + ! Why is it negative? + !--------------------------------------- if ( jk == kcbot(jl) ) then - zoentr(jl) = -1.75e-3*(min(1.,pqen(jl,jk)/pqsen(jl,jk)) - & + + zoentr(jl) = -entorg*(min(1.,pqen(jl,jk)/pqsen(jl,jk)) - & 1.)*(pgeoh(jl,jk)-pgeoh(jl,jk+1))*zrg zoentr(jl) = min(0.4,zoentr(jl))*pmfu(jl,jk+1) end if + !--------------------------------------- + ! If within the cloud layer + !--------------------------------------- if ( jk < kcbot(jl) ) then + zmfmax = (paph(jl,jk)-paph(jl,jk-1))*zcons2 zxs = max(pmfu(jl,jk+1)-zmfmax,0.) wup(jl) = wup(jl) + kup(jl,jk+1)*(pap(jl,jk+1)-pap(jl,jk)) zdpmean(jl) = zdpmean(jl) + pap(jl,jk+1) - pap(jl,jk) + + ! current level's entrainment is equal to zoentr value of level below zdmfen(jl) = zoentr(jl) + !--------------------------------------- + ! Set entrainment/detrainment rates for + ! shallow or mid-level convection. This + ! overwrites the values from the call + ! to cuentr. + !--------------------------------------- if ( ktype(jl) >= 2 ) then + ! double the entrainment rate for shallow convection zdmfen(jl) = 2.0*zdmfen(jl) + ! set turbulent detrainment equal to entrainment for shallow convection zdmfde(jl) = zdmfen(jl) end if - zdmfde(jl) = zdmfde(jl) * & - (1.6-min(1.,pqen(jl,jk)/pqsen(jl,jk))) + !--------------------------------------- + ! Multiply detrainment rate by (1.6-RH) + ! (Eq. 6.8/6.9 IFS Cy48r1) + ! For deep convection, will be value + ! from call to cuentr. + ! For shallow convection, value is set above. + !--------------------------------------- + zdmfde(jl) = zdmfde(jl) * (1.6-min(1.,pqen(jl,jk)/pqsen(jl,jk))) + zmftest = pmfu(jl,jk+1) + zdmfen(jl) - zdmfde(jl) zchange = max(zmftest-zmfmax,0.) zxe = max(zchange-zxs,0.) @@ -2158,28 +2316,45 @@ subroutine cuascn & zchange = zchange - zxe zdmfde(jl) = zdmfde(jl) + zchange end if - pdmfen(jl,jk) = zdmfen(jl) - zdmfde(jl) - pmfu(jl,jk) = pmfu(jl,jk+1) + zdmfen(jl) - zdmfde(jl) - zqeen = pqenh(jl,jk+1)*zdmfen(jl) - zseen = (cpd*ptenh(jl,jk+1)+pgeoh(jl,jk+1))*zdmfen(jl) - zscde = (cpd*ptu(jl,jk+1)+pgeoh(jl,jk+1))*zdmfde(jl) - zqude = pqu(jl,jk+1)*zdmfde(jl) - plude(jl,jk) = plu(jl,jk+1)*zdmfde(jl) - zmfusk = pmfus(jl,jk+1) + zseen - zscde - zmfuqk = pmfuq(jl,jk+1) + zqeen - zqude - zmfulk = pmful(jl,jk+1) - plude(jl,jk) + !--------------------------------------- + ! Calculate rates of change of + ! mass flux due to entrainment/detrainment + ! for state variables within updrafts + !--------------------------------------- + pdmfen(jl,jk) = zdmfen(jl) - zdmfde(jl) ! net rate = entrainment minus detrainment + pmfu(jl,jk) = pmfu(jl,jk+1) + zdmfen(jl) - zdmfde(jl) ! massflux = massflux at lower level + entr - detr + + zqeen = pqenh(jl,jk+1) * zdmfen(jl) ! entr rate of env moisture into parcel + zseen = (cpd*ptenh(jl,jk+1)+pgeoh(jl,jk+1)) * zdmfen(jl) ! entr rate of env dry static energy into parcel + zscde = (cpd*ptu(jl,jk+1)+pgeoh(jl,jk+1)) * zdmfde(jl) ! detr rate of dry static energy from parcel + zqude = pqu(jl,jk+1) * zdmfde(jl) ! detr rate of moisture from parcel + plude(jl,jk) = plu(jl,jk+1) * zdmfde(jl) ! detr rate of cloud liquid water from parcel + + zmfusk = pmfus(jl,jk+1) + zseen - zscde ! net flux of updraft dry static energy at index k + zmfuqk = pmfuq(jl,jk+1) + zqeen - zqude ! net flux of updraft moisture at index k + zmfulk = pmful(jl,jk+1) - plude(jl,jk) ! net flux of updraft cloud liquid water at index k + !--------------------------------------- + ! Update updraft properties + ! due to entrainment/detrainment + !--------------------------------------- plu(jl,jk) = zmfulk*(1./max(cmfcmin,pmfu(jl,jk))) pqu(jl,jk) = zmfuqk*(1./max(cmfcmin,pmfu(jl,jk))) ptu(jl,jk) = (zmfusk * & (1./max(cmfcmin,pmfu(jl,jk)))-pgeoh(jl,jk))*rcpd - ptu(jl,jk) = max(100.,ptu(jl,jk)) - ptu(jl,jk) = min(400.,ptu(jl,jk)) - zqold(jl) = pqu(jl,jk) + ptu(jl,jk) = max(100.,ptu(jl,jk)) ! updraft can't get colder than 100 K + ptu(jl,jk) = min(400.,ptu(jl,jk)) ! updraft can't get warmer than 400 K + + zqold(jl) = pqu(jl,jk) ! store parcel humidity, used later to determine how much + ! cloud water to condense after adjusting 'pqu' for saturation + zlrain(jl,jk) = zlrain(jl,jk+1)*(pmfu(jl,jk+1)-zdmfde(jl)) * & (1./max(cmfcmin,pmfu(jl,jk))) zluold(jl) = plu(jl,jk) end do -! reset to environmental values if below departure level + !--------------------------------------- + ! Reset parcel values to environmental + ! values if below departure level + !--------------------------------------- do jl = 1,klon if ( jk > kdpl(jl) ) then ptu(jl,jk) = ptenh(jl,jk) @@ -2188,16 +2363,19 @@ subroutine cuascn & zluold(jl) = plu(jl,jk) end if end do -!* do corrections for moist ascent -!* by adjusting t,q and l in *cuadjtq* -!------------------------------------------------ - ik=jk - icall=1 -! + !------------------------------------------------ + ! Do corrections for moist ascent + ! by adjusting t,q and l in *cuadjtq* + ! to account for condensation + !------------------------------------------------ + ik = jk + icall = 1 ! flag for condensation in updrafts + if ( jlm > 0 ) then call cuadjtqn(klon,klev,ik,zph,ptu,pqu,loflag,icall) end if -! compute the upfraft speed in cloud layer + + ! compute the updraft speed in cloud layer do jll = 1 , jlm jl = jlx(jll) if ( pqu(jl,jk) /= zqold(jl) ) then @@ -2207,16 +2385,20 @@ subroutine cuascn & ptu(jl,jk) = ptu(jl,jk) + ralfdcp*plglac(jl,jk) end if end do + do jll = 1 , jlm jl = jlx(jll) + !------------------------------------------------ + ! If condensation has occurred + !------------------------------------------------ if ( pqu(jl,jk) /= zqold(jl) ) then - klab(jl,jk) = 2 - plu(jl,jk) = plu(jl,jk) + zqold(jl) - pqu(jl,jk) - zbc = ptu(jl,jk)*(1.+vtmpc1*pqu(jl,jk)-plu(jl,jk+1) - & + klab(jl,jk) = 2 ! we are now inside the cloud + plu(jl,jk) = plu(jl,jk) + zqold(jl) - pqu(jl,jk) ! add condensed water vapor to cloud water + zbc = ptu(jl,jk)*(1.+vtmpc1*pqu(jl,jk)-plu(jl,jk+1) - & ! parcel virtual temperature zlrain(jl,jk+1)) - zbe = ptenh(jl,jk)*(1.+vtmpc1*pqenh(jl,jk)) - zbuo(jl,jk) = zbc - zbe -! set flags for the case of midlevel convection + zbe = ptenh(jl,jk)*(1.+vtmpc1*pqenh(jl,jk)) ! environmental virtual temperature + zbuo(jl,jk) = zbc - zbe ! parcel buoyancy (K) + ! set flags for the case of midlevel convection if ( ktype(jl) == 3 .and. klab(jl,jk+1) == 1 ) then if ( zbuo(jl,jk) > -0.5 ) then ldcum(jl) = .true. @@ -2229,6 +2411,9 @@ subroutine cuascn & plu(jl,jk) = 0. end if end if + !---------------------------------------------- + ! If layer below is within the cloud layer + !---------------------------------------------- if ( klab(jl,jk+1) == 2 ) then if ( zbuo(jl,jk) < 0. ) then ptenh(jl,jk) = 0.5*(pten(jl,jk)+pten(jl,jk-1)) @@ -2239,7 +2424,8 @@ subroutine cuascn & (ptenh(jl,jk)*(1.+vtmpc1*pqenh(jl,jk)))+zbuo(jl,jk+1) / & (ptenh(jl,jk+1)*(1.+vtmpc1*pqenh(jl,jk+1))))*0.5 zdkbuo = (pgeoh(jl,jk)-pgeoh(jl,jk+1))*zfacbuo*zbuoc -! mixing and "pressure" gradient term in upper troposphere + + ! mixing and "pressure" gradient term in upper troposphere if ( zdmfen(jl) > 0. ) then zdken = min(1.,(1.+z_cwdrag)*zdmfen(jl) / & max(cmfcmin,pmfu(jl,jk+1))) @@ -2247,31 +2433,60 @@ subroutine cuascn & zdken = min(1.,(1.+z_cwdrag)*zdmfde(jl) / & max(cmfcmin,pmfu(jl,jk+1))) end if + kup(jl,jk) = (kup(jl,jk+1)*(1.-zdken)+zdkbuo) / & (1.+zdken) + !---------------------------------------------- + ! Organized detrainment for negatively buoyant + ! updraft (generally at cloud top) based + ! on the decrease of updraft velocity with height + ! (Eq. 6.12 IFS Cy48r1 without RH term) + ! + ! Is stable -> no org. entrainment. This overwrites + ! PMFU for current level which has been calculated + ! above with organised entrainment (ICON comment) + !---------------------------------------------- if ( zbuo(jl,jk) < 0. ) then zkedke = kup(jl,jk)/max(1.e-10,kup(jl,jk+1)) zkedke = max(0.,min(1.,zkedke)) - zmfun = sqrt(zkedke)*pmfu(jl,jk+1) !* (1.6-min(1.,pqen(jl,jk) / & - ! pqsen(jl,jk))) + zmfun = sqrt(zkedke) * pmfu(jl,jk+1) zdmfde(jl) = max(zdmfde(jl),pmfu(jl,jk+1)-zmfun) plude(jl,jk) = plu(jl,jk+1)*zdmfde(jl) + ! mass flux = mass flux at layer below plus entr minus detr pmfu(jl,jk) = pmfu(jl,jk+1) + zdmfen(jl) - zdmfde(jl) end if + !---------------------------------------------- + ! Calculate parcel entrainment rate given + ! a sufficiently buoyant updraft, otherwise + ! set to zero (Eq. 6.7 IFS Cy48r1) + !---------------------------------------------- if ( zbuo(jl,jk) > -0.2 ) then + ! when positively buoyant, have organised entrainment + ! which increases MF with height, while detrainment + ! is pretty small and constant (ICON comment) ikb = kcbot(jl) - zoentr(jl) = 1.75e-3*(0.3-(min(1.,pqen(jl,jk-1) / & + ! zoentr is overwritten, but not used until + ! the next jk level in the loop (ICON comment) + zoentr(jl) = entorg*(0.3-(min(1.,pqen(jl,jk-1) / & pqsen(jl,jk-1))-1.))*(pgeoh(jl,jk-1)-pgeoh(jl,jk)) * & zrg*min(1.,pqsen(jl,jk)/pqsen(jl,ikb))**3 + zoentr(jl) = min(0.4,zoentr(jl))*pmfu(jl,jk) else zoentr(jl) = 0. end if -! erase values if below departure level + + ! erase values if below departure level if ( jk > kdpl(jl) ) then pmfu(jl,jk) = pmfu(jl,jk+1) kup(jl,jk) = 0.5 end if + !------------------------------------------- + ! determine convection top level; + ! the last set of criteria serves to limit + ! the overshooting of updrafts + ! through the tropopause (ICON comment) + !------------------------------------------- if ( kup(jl,jk) > 0. .and. pmfu(jl,jk) > 0. ) then kctop(jl) = jk llo1(jl) = .true. @@ -2282,7 +2497,7 @@ subroutine cuascn & zdmfde(jl) = pmfu(jl,jk+1) plude(jl,jk) = plu(jl,jk+1)*zdmfde(jl) end if -! save detrainment rates for updraught + ! save detrainment rates for updraught if ( pmfu(jl,jk+1) > 0. ) pmfude_rate(jl,jk) = zdmfde(jl) end if else if ( ktype(jl) == 2 .and. pqu(jl,jk) == zqold(jl) ) then @@ -2294,12 +2509,14 @@ subroutine cuascn & pmfude_rate(jl,jk) = zdmfde(jl) end if end do - + !---------------------------------------------------- + ! Calculate precipitation rates + !---------------------------------------------------- do jl = 1,klon if ( llo1(jl) ) then -! conversions only proceeds if plu is greater than a threshold liquid water -! content of 0.3 g/kg over water and 0.5 g/kg over land to prevent precipitation -! generation from small water contents. + ! conversions only proceeds if plu is greater than a threshold liquid water + ! content of 0.3 g/kg over water and 0.5 g/kg over land to prevent precipitation + ! generation from small water contents. if ( lndj(jl).eq.1 ) then zdshrd = 5.e-4 else @@ -2307,10 +2524,9 @@ subroutine cuascn & end if ikb=kcbot(jl) if ( plu(jl,jk) > zdshrd )then -! if ((paph(jl,ikb)-paph(jl,jk))>zdnoprc) then zwu = min(15.0,sqrt(2.*max(0.1,kup(jl,jk+1)))) zprcon = zprcdgw/(0.75*zwu) -! PARAMETERS FOR BERGERON-FINDEISEN PROCESS (T < -5C) + ! PARAMETERS FOR BERGERON-FINDEISEN PROCESS (T < -5C) zdt = min(rtber-rtice,max(rtber-ptu(jl,jk),0.)) zcbf = 1. + z_cprc2*sqrt(zdt) zzco = zprcon*zcbf @@ -2334,6 +2550,7 @@ subroutine cuascn & end if end if end do + do jl = 1, klon if ( llo1(jl) ) then if ( zlrain(jl,jk) > 0. ) then @@ -2352,17 +2569,20 @@ subroutine cuascn & end if end if end do + do jll = 1 , jlm jl = jlx(jll) pmful(jl,jk) = plu(jl,jk)*pmfu(jl,jk) pmfus(jl,jk) = (cpd*ptu(jl,jk)+pgeoh(jl,jk))*pmfu(jl,jk) pmfuq(jl,jk) = pqu(jl,jk)*pmfu(jl,jk) end do + end if end do -!---------------------------------------------------------------------- -! 5. final calculations -! ------------------ + + !---------------------------------------------------------------------- + ! 5. final calculations + ! ------------------ do jl = 1,klon if ( kctop(jl) == -1 ) ldcum(jl) = .false. kcbot(jl) = max(kcbot(jl),kctop(jl)) @@ -2375,164 +2595,168 @@ subroutine cuascn & return end subroutine cuascn !--------------------------------------------------------- -! level 3 souroutines +! level 3 souroutines !-------------------------------------------------------- - subroutine cudlfsn & - & (klon, klev, & - & kcbot, kctop, lndj, ldcum, & - & ptenh, pqenh, puen, pven, & - & pten, pqsen, pgeo, & - & pgeoh, paph, ptu, pqu, plu,& - & puu, pvu, pmfub, prfl, & - & ptd, pqd, pud, pvd, & - & pmfd, pmfds, pmfdq, pdmfdp, & - & kdtop, lddraf) - -! this routine calculates level of free sinking for -! cumulus downdrafts and specifies t,q,u and v values - -! m.tiedtke e.c.m.w.f. 12/86 modif. 12/89 - -! purpose. -! -------- -! to produce lfs-values for cumulus downdrafts -! for massflux cumulus parameterization - -! interface -! --------- -! this routine is called from *cumastr*. -! input are environmental values of t,q,u,v,p,phi -! and updraft values t,q,u and v and also -! cloud base massflux and cu-precipitation rate. -! it returns t,q,u and v values and massflux at lfs. - -! method. - -! check for negative buoyancy of air of equal parts of -! moist environmental air and cloud air. - -! parameter description units -! --------- ----------- ----- -! input parameters (integer): - -! *klon* number of grid points per packet -! *klev* number of levels -! *kcbot* cloud base level -! *kctop* cloud top level - -! input parameters (logical): - -! *lndj* land sea mask (1 for land) -! *ldcum* flag: .true. for convective points - -! input parameters (real(kind=kind_phys)): - -! *ptenh* env. temperature (t+1) on half levels k -! *pqenh* env. spec. humidity (t+1) on half levels kg/kg -! *puen* provisional environment u-velocity (t+1) m/s -! *pven* provisional environment v-velocity (t+1) m/s -! *pten* provisional environment temperature (t+1) k -! *pqsen* environment spec. saturation humidity (t+1) kg/kg -! *pgeo* geopotential m2/s2 -! *pgeoh* geopotential on half levels m2/s2 -! *paph* provisional pressure on half levels pa -! *ptu* temperature in updrafts k -! *pqu* spec. humidity in updrafts kg/kg -! *plu* liquid water content in updrafts kg/kg -! *puu* u-velocity in updrafts m/s -! *pvu* v-velocity in updrafts m/s -! *pmfub* massflux in updrafts at cloud base kg/(m2*s) - -! updated parameters (real(kind=kind_phys)): - -! *prfl* precipitation rate kg/(m2*s) - -! output parameters (real(kind=kind_phys)): - -! *ptd* temperature in downdrafts k -! *pqd* spec. humidity in downdrafts kg/kg -! *pud* u-velocity in downdrafts m/s -! *pvd* v-velocity in downdrafts m/s -! *pmfd* massflux in downdrafts kg/(m2*s) -! *pmfds* flux of dry static energy in downdrafts j/(m2*s) -! *pmfdq* flux of spec. humidity in downdrafts kg/(m2*s) -! *pdmfdp* flux difference of precip. in downdrafts kg/(m2*s) - -! output parameters (integer): - -! *kdtop* top level of downdrafts - -! output parameters (logical): - -! *lddraf* .true. if downdrafts exist - -! externals -! --------- -! *cuadjtq* for calculating wet bulb t and q at lfs -!---------------------------------------------------------------------- - implicit none - - integer klev,klon - real(kind=kind_phys) ptenh(klon,klev), pqenh(klon,klev), & - & puen(klon,klev), pven(klon,klev), & - & pten(klon,klev), pqsen(klon,klev), & - & pgeo(klon,klev), & - & pgeoh(klon,klev+1), paph(klon,klev+1),& - & ptu(klon,klev), pqu(klon,klev), & - & puu(klon,klev), pvu(klon,klev), & - & plu(klon,klev), & - & pmfub(klon), prfl(klon) - - real(kind=kind_phys) ptd(klon,klev), pqd(klon,klev), & - & pud(klon,klev), pvd(klon,klev), & - & pmfd(klon,klev), pmfds(klon,klev), & - & pmfdq(klon,klev), pdmfdp(klon,klev) - integer kcbot(klon), kctop(klon), & - & kdtop(klon), ikhsmin(klon) - logical ldcum(klon), & - & lddraf(klon) - integer lndj(klon) - - real(kind=kind_phys) ztenwb(klon,klev), zqenwb(klon,klev), & - & zcond(klon), zph(klon), & - & zhsmin(klon) - logical llo2(klon) -! local variables - integer jl,jk - integer is,ik,icall,ike - real(kind=kind_phys) zhsk,zttest,zqtest,zbuo,zmftop - -!---------------------------------------------------------------------- - -! 1. set default values for downdrafts -! --------------------------------- - do jl=1,klon - lddraf(jl)=.false. - kdtop(jl)=klev+1 + subroutine cudlfsn & + & (klon, klev, & + & kcbot, kctop, lndj, ldcum, & + & ptenh, pqenh, puen, pven, & + & pten, pqsen, pgeo, & + & pgeoh, paph, ptu, pqu, plu, & + & puu, pvu, pmfub, prfl, & + & ptd, pqd, pud, pvd, & + & pmfd, pmfds, pmfdq, pdmfdp, & + & kdtop, lddraf) + +! this routine calculates level of free sinking for +! cumulus downdrafts and specifies t,q,u and v values + +! m.tiedtke e.c.m.w.f. 12/86 modif. 12/89 + +! purpose. +! -------- +! to produce lfs-values for cumulus downdrafts +! for massflux cumulus parameterization + +! interface +! --------- +! this routine is called from *cumastr*. +! input are environmental values of t,q,u,v,p,phi +! and updraft values t,q,u and v and also +! cloud base massflux and cu-precipitation rate. +! it returns t,q,u and v values and massflux at lfs. +! method. + +! check for negative buoyancy of air of equal parts of +! moist environmental air and cloud air. + +! parameter description units +! --------- ----------- ----- +! input parameters (integer): + +! *klon* number of grid points per packet +! *klev* number of levels +! *kcbot* cloud base level +! *kctop* cloud top level + +! input parameters (logical): + +! *lndj* land sea mask (1 for land) +! *ldcum* flag: .true. for convective points + +! input parameters (real): + +! *ptenh* env. temperature (t+1) on half levels k +! *pqenh* env. spec. humidity (t+1) on half levels kg/kg +! *puen* provisional environment u-velocity (t+1) m/s +! *pven* provisional environment v-velocity (t+1) m/s +! *pten* provisional environment temperature (t+1) k +! *pqsen* environment spec. saturation humidity (t+1) kg/kg +! *pgeo* geopotential m2/s2 +! *pgeoh* geopotential on half levels m2/s2 +! *paph* provisional pressure on half levels pa +! *ptu* temperature in updrafts k +! *pqu* spec. humidity in updrafts kg/kg +! *plu* liquid water content in updrafts kg/kg +! *puu* u-velocity in updrafts m/s +! *pvu* v-velocity in updrafts m/s +! *pmfub* massflux in updrafts at cloud base kg/(m2*s) + +! updated parameters (real): + +! *prfl* precipitation rate kg/(m2*s) + +! output parameters (real): + +! *ptd* temperature in downdrafts k +! *pqd* spec. humidity in downdrafts kg/kg +! *pud* u-velocity in downdrafts m/s +! *pvd* v-velocity in downdrafts m/s +! *pmfd* massflux in downdrafts kg/(m2*s) +! *pmfds* flux of dry static energy in downdrafts j/(m2*s) +! *pmfdq* flux of spec. humidity in downdrafts kg/(m2*s) +! *pdmfdp* flux difference of precip. in downdrafts kg/(m2*s) + +! output parameters (integer): + +! *kdtop* top level of downdrafts + +! output parameters (logical): + +! *lddraf* .true. if downdrafts exist + +! externals +! --------- +! *cuadjtq* for calculating wet bulb t and q at lfs +!---------------------------------------------------------------------- + + implicit none + +!--- input arguments: + integer,intent(in):: klon + logical,intent(in),dimension(klon):: ldcum + + integer,intent(in):: klev + integer,intent(in),dimension(klon):: lndj + integer,intent(in),dimension(klon):: kcbot,kctop + + real(kind=kind_phys),intent(in),dimension(klon):: pmfub + real(kind=kind_phys),intent(in),dimension(klon,klev):: pten,pqsen,pgeo,puen,pven + real(kind=kind_phys),intent(in),dimension(klon,klev):: ptenh,pqenh + real(kind=kind_phys),intent(in),dimension(klon,klev):: ptu,pqu,puu,pvu,plu + real(kind=kind_phys),intent(in),dimension(klon,klev+1):: pgeoh,paph + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(klon):: prfl + real(kind=kind_phys),intent(inout),dimension(klon,klev):: pud,pvd + +!--- output arguments: + logical,intent(out),dimension(klon):: lddraf + integer,intent(out),dimension(klon):: kdtop + + real(kind=kind_phys),intent(out),dimension(klon,klev):: ptd,pqd,pmfd,pmfds,pmfdq,pdmfdp + +!--- local variables and arrays: + logical,dimension(klon):: llo2 + integer:: jl,jk + integer:: is,ik,icall,ike + integer,dimension(klon):: ikhsmin + + real(kind=kind_phys):: zhsk,zttest,zqtest,zbuo,zmftop + real(kind=kind_phys),dimension(klon):: zcond,zph,zhsmin + real(kind=kind_phys),dimension(klon,klev):: ztenwb,zqenwb + +!---------------------------------------------------------------------- + +! 1. set default values for downdrafts +! --------------------------------- + do jl=1,klon + lddraf(jl)=.false. + kdtop(jl)=klev+1 ikhsmin(jl)=klev+1 - zhsmin(jl)=1.e8 - enddo -!---------------------------------------------------------------------- - -! 2. determine level of free sinking: -! downdrafts shall start at model level of minimum -! of saturation moist static energy or below -! respectively - -! for every point and proceed as follows: - -! (1) determine level of minimum of hs -! (2) determine wet bulb environmental t and q -! (3) do mixing with cumulus cloud air -! (4) check for negative buoyancy -! (5) if buoyancy>0 repeat (2) to (4) for next -! level below - -! the assumption is that air of downdrafts is mixture -! of 50% cloud air + 50% environmental air at wet bulb -! temperature (i.e. which became saturated due to -! evaporation of rain and cloud water) -! ---------------------------------------------------- + zhsmin(jl)=1.e8 + enddo +!---------------------------------------------------------------------- + +! 2. determine level of free sinking: +! downdrafts shall start at model level of minimum +! of saturation moist static energy or below +! respectively + +! for every point and proceed as follows: + +! (1) determine level of minimum of hs +! (2) determine wet bulb environmental t and q +! (3) do mixing with cumulus cloud air +! (4) check for negative buoyancy +! (5) if buoyancy>0 repeat (2) to (4) for next +! level below + +! the assumption is that air of downdrafts is mixture +! of 50% cloud air + 50% environmental air at wet bulb +! temperature (i.e. which became saturated due to +! evaporation of rain and cloud water) +! ---------------------------------------------------- do jk=3,klev-2 do jl=1,klon zhsk=cpd*pten(jl,jk)+pgeo(jl,jk) + & @@ -2545,211 +2769,215 @@ subroutine cudlfsn & end do - ike=klev-3 - do jk=3,ike - -! 2.1 calculate wet-bulb temperature and moisture -! for environmental air in *cuadjtq* -! ------------------------------------------- - is=0 - do jl=1,klon - ztenwb(jl,jk)=ptenh(jl,jk) - zqenwb(jl,jk)=pqenh(jl,jk) - zph(jl)=paph(jl,jk) - llo2(jl)=ldcum(jl).and.prfl(jl).gt.0..and..not.lddraf(jl).and. & - & (jk.lt.kcbot(jl).and.jk.gt.kctop(jl)).and. jk.ge.ikhsmin(jl) - if(llo2(jl))then - is=is+1 - endif - enddo - if(is.eq.0) cycle - - ik=jk - icall=2 - call cuadjtqn & - & ( klon, klev, ik, zph, ztenwb, zqenwb, llo2, icall) - -! 2.2 do mixing of cumulus and environmental air -! and check for negative buoyancy. -! then set values for downdraft at lfs. -! ---------------------------------------- - do jl=1,klon - if(llo2(jl)) then - zttest=0.5*(ptu(jl,jk)+ztenwb(jl,jk)) - zqtest=0.5*(pqu(jl,jk)+zqenwb(jl,jk)) - zbuo=zttest*(1.+vtmpc1 *zqtest)- & - & ptenh(jl,jk)*(1.+vtmpc1 *pqenh(jl,jk)) - zcond(jl)=pqenh(jl,jk)-zqenwb(jl,jk) - zmftop=-cmfdeps*pmfub(jl) - if(zbuo.lt.0..and.prfl(jl).gt.10.*zmftop*zcond(jl)) then - kdtop(jl)=jk - lddraf(jl)=.true. - ptd(jl,jk)=zttest - pqd(jl,jk)=zqtest - pmfd(jl,jk)=zmftop - pmfds(jl,jk)=pmfd(jl,jk)*(cpd*ptd(jl,jk)+pgeoh(jl,jk)) - pmfdq(jl,jk)=pmfd(jl,jk)*pqd(jl,jk) - pdmfdp(jl,jk-1)=-0.5*pmfd(jl,jk)*zcond(jl) - prfl(jl)=prfl(jl)+pdmfdp(jl,jk-1) - endif - endif - enddo - - enddo - - return - end subroutine cudlfsn + ike=klev-3 + do jk=3,ike + +! 2.1 calculate wet-bulb temperature and moisture +! for environmental air in *cuadjtq* +! ------------------------------------------- + is=0 + do jl=1,klon + ztenwb(jl,jk)=ptenh(jl,jk) + zqenwb(jl,jk)=pqenh(jl,jk) + zph(jl)=paph(jl,jk) + llo2(jl)=ldcum(jl).and.prfl(jl).gt.0..and..not.lddraf(jl).and. & + & (jk.lt.kcbot(jl).and.jk.gt.kctop(jl)).and. jk.ge.ikhsmin(jl) + if(llo2(jl))then + is=is+1 + endif + enddo + if(is.eq.0) cycle + + ik=jk + icall=2 + call cuadjtqn & + & ( klon, klev, ik, zph, ztenwb, zqenwb, llo2, icall) + +! 2.2 do mixing of cumulus and environmental air +! and check for negative buoyancy. +! then set values for downdraft at lfs. +! ---------------------------------------- + do jl=1,klon + if(llo2(jl)) then + zttest=0.5*(ptu(jl,jk)+ztenwb(jl,jk)) + zqtest=0.5*(pqu(jl,jk)+zqenwb(jl,jk)) + zbuo=zttest*(1.+vtmpc1 *zqtest)- & + & ptenh(jl,jk)*(1.+vtmpc1 *pqenh(jl,jk)) + zcond(jl)=pqenh(jl,jk)-zqenwb(jl,jk) + zmftop=-cmfdeps*pmfub(jl) + if(zbuo.lt.0..and.prfl(jl).gt.10.*zmftop*zcond(jl)) then + kdtop(jl)=jk + lddraf(jl)=.true. + ptd(jl,jk)=zttest + pqd(jl,jk)=zqtest + pmfd(jl,jk)=zmftop + pmfds(jl,jk)=pmfd(jl,jk)*(cpd*ptd(jl,jk)+pgeoh(jl,jk)) + pmfdq(jl,jk)=pmfd(jl,jk)*pqd(jl,jk) + pdmfdp(jl,jk-1)=-0.5*pmfd(jl,jk)*zcond(jl) + prfl(jl)=prfl(jl)+pdmfdp(jl,jk-1) + endif + endif + enddo + + enddo + + return + end subroutine cudlfsn !--------------------------------------------------------- -! level 3 souroutines +! level 3 souroutines !-------------------------------------------------------- !********************************************** ! subroutine cuddrafn !********************************************** - subroutine cuddrafn & - & ( klon, klev, lddraf & - & , ptenh, pqenh, puen, pven & - & , pgeo, pgeoh, paph, prfl & - & , ptd, pqd, pud, pvd, pmfu & - & , pmfd, pmfds, pmfdq, pdmfdp, pmfdde_rate ) - -! this routine calculates cumulus downdraft descent - -! m.tiedtke e.c.m.w.f. 12/86 modif. 12/89 - -! purpose. -! -------- -! to produce the vertical profiles for cumulus downdrafts -! (i.e. t,q,u and v and fluxes) - -! interface -! --------- - -! this routine is called from *cumastr*. -! input is t,q,p,phi,u,v at half levels. -! it returns fluxes of s,q and evaporation rate -! and u,v at levels where downdraft occurs - -! method. -! -------- -! calculate moist descent for entraining/detraining plume by -! a) moving air dry-adiabatically to next level below and -! b) correcting for evaporation to obtain saturated state. - -! parameter description units -! --------- ----------- ----- -! input parameters (integer): - -! *klon* number of grid points per packet -! *klev* number of levels - -! input parameters (logical): - -! *lddraf* .true. if downdrafts exist - -! input parameters (real(kind=kind_phys)): - -! *ptenh* env. temperature (t+1) on half levels k -! *pqenh* env. spec. humidity (t+1) on half levels kg/kg -! *puen* provisional environment u-velocity (t+1) m/s -! *pven* provisional environment v-velocity (t+1) m/s -! *pgeo* geopotential m2/s2 -! *pgeoh* geopotential on half levels m2/s2 -! *paph* provisional pressure on half levels pa -! *pmfu* massflux updrafts kg/(m2*s) - -! updated parameters (real(kind=kind_phys)): - + subroutine cuddrafn & + & ( klon, klev, lddraf & + & , ptenh, pqenh, puen, pven & + & , pgeo, pgeoh, paph, prfl & + & , ptd, pqd, pud, pvd, pmfu & + & , pmfd, pmfds, pmfdq, pdmfdp, pmfdde_rate ) + +! this routine calculates cumulus downdraft descent + +! m.tiedtke e.c.m.w.f. 12/86 modif. 12/89 + +! purpose. +! -------- +! to produce the vertical profiles for cumulus downdrafts +! (i.e. t,q,u and v and fluxes) + +! interface +! --------- + +! this routine is called from *cumastr*. +! input is t,q,p,phi,u,v at half levels. +! it returns fluxes of s,q and evaporation rate +! and u,v at levels where downdraft occurs + +! method. +! -------- +! calculate moist descent for entraining/detraining plume by +! a) moving air dry-adiabatically to next level below and +! b) correcting for evaporation to obtain saturated state. + +! parameter description units +! --------- ----------- ----- +! input parameters (integer): + +! *klon* number of grid points per packet +! *klev* number of levels + +! input parameters (logical): + +! *lddraf* .true. if downdrafts exist + +! input parameters (real): + +! *ptenh* env. temperature (t+1) on half levels k +! *pqenh* env. spec. humidity (t+1) on half levels kg/kg +! *puen* provisional environment u-velocity (t+1) m/s +! *pven* provisional environment v-velocity (t+1) m/s +! *pgeo* geopotential m2/s2 +! *pgeoh* geopotential on half levels m2/s2 +! *paph* provisional pressure on half levels pa +! *pmfu* massflux updrafts kg/(m2*s) + +! updated parameters (real): + ! *prfl* precipitation rate kg/(m2*s) - -! output parameters (real(kind=kind_phys)): - -! *ptd* temperature in downdrafts k -! *pqd* spec. humidity in downdrafts kg/kg -! *pud* u-velocity in downdrafts m/s -! *pvd* v-velocity in downdrafts m/s + +! output parameters (real): + +! *ptd* temperature in downdrafts k +! *pqd* spec. humidity in downdrafts kg/kg +! *pud* u-velocity in downdrafts m/s +! *pvd* v-velocity in downdrafts m/s ! *pmfd* massflux in downdrafts kg/(m2*s) ! *pmfds* flux of dry static energy in downdrafts j/(m2*s) ! *pmfdq* flux of spec. humidity in downdrafts kg/(m2*s) ! *pdmfdp* flux difference of precip. in downdrafts kg/(m2*s) - -! externals -! --------- -! *cuadjtq* for adjusting t and q due to evaporation in -! saturated descent -!---------------------------------------------------------------------- + +! externals +! --------- +! *cuadjtq* for adjusting t and q due to evaporation in +! saturated descent +!---------------------------------------------------------------------- implicit none - - integer klev,klon - real(kind=kind_phys) ptenh(klon,klev), pqenh(klon,klev), & - & puen(klon,klev), pven(klon,klev), & - & pgeoh(klon,klev+1), paph(klon,klev+1), & - & pgeo(klon,klev), pmfu(klon,klev) - - real(kind=kind_phys) ptd(klon,klev), pqd(klon,klev), & - & pud(klon,klev), pvd(klon,klev), & - & pmfd(klon,klev), pmfds(klon,klev), & - & pmfdq(klon,klev), pdmfdp(klon,klev), & - & prfl(klon) - real(kind=kind_phys) pmfdde_rate(klon,klev) - logical lddraf(klon) - - real(kind=kind_phys) zdmfen(klon), zdmfde(klon), & - & zcond(klon), zoentr(klon), & - & zbuoy(klon) - real(kind=kind_phys) zph(klon) - logical llo2(klon) - logical llo1 -! local variables - integer jl,jk - integer is,ik,icall,ike, itopde(klon) - real(kind=kind_phys) zentr,zdz,zzentr,zseen,zqeen,zsdde,zqdde,zdmfdp - real(kind=kind_phys) zmfdsk,zmfdqk,zbuo,zrain,zbuoyz,zmfduk,zmfdvk - -!---------------------------------------------------------------------- -! 1. calculate moist descent for cumulus downdraft by -! (a) calculating entrainment/detrainment rates, -! including organized entrainment dependent on -! negative buoyancy and assuming -! linear decrease of massflux in pbl -! (b) doing moist descent - evaporative cooling -! and moistening is calculated in *cuadjtq* -! (c) checking for negative buoyancy and -! specifying final t,q,u,v and downward fluxes -! ------------------------------------------------- - do jl=1,klon - zoentr(jl)=0. - zbuoy(jl)=0. - zdmfen(jl)=0. + +!--- input arguments: + integer,intent(in)::klon + logical,intent(in),dimension(klon):: lddraf + + integer,intent(in)::klev + + real(kind=kind_phys),intent(in),dimension(klon,klev):: ptenh,pqenh,puen,pven + real(kind=kind_phys),intent(in),dimension(klon,klev):: pgeo,pmfu + real(kind=kind_phys),intent(in),dimension(klon,klev+1):: pgeoh,paph + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(klon):: prfl + real(kind=kind_phys),intent(inout),dimension(klon,klev):: ptd,pqd,pud,pvd + real(kind=kind_phys),intent(inout),dimension(klon,klev):: pmfd,pmfds,pmfdq,pdmfdp + +!--- output arguments: + real(kind=kind_phys),intent(inout),dimension(klon,klev):: pmfdde_rate + +!--- local variables and arrays: + logical:: llo1 + logical,dimension(klon):: llo2 + + integer:: jl,jk + integer:: is,ik,icall,ike + integer,dimension(klon):: itopde + + real(kind=kind_phys):: zentr,zdz,zzentr,zseen,zqeen,zsdde,zqdde,zdmfdp + real(kind=kind_phys):: zmfdsk,zmfdqk,zbuo,zrain,zbuoyz,zmfduk,zmfdvk + real(kind=kind_phys),dimension(klon):: zdmfen,zdmfde,zcond,zoentr,zbuoy,zph + +!---------------------------------------------------------------------- +! 1. calculate moist descent for cumulus downdraft by +! (a) calculating entrainment/detrainment rates, +! including organized entrainment dependent on +! negative buoyancy and assuming +! linear decrease of massflux in pbl +! (b) doing moist descent - evaporative cooling +! and moistening is calculated in *cuadjtq* +! (c) checking for negative buoyancy and +! specifying final t,q,u,v and downward fluxes +! ------------------------------------------------- + do jl=1,klon + zoentr(jl)=0. + zbuoy(jl)=0. + zdmfen(jl)=0. zdmfde(jl)=0. - enddo + enddo do jk=klev,1,-1 do jl=1,klon pmfdde_rate(jl,jk) = 0. if((paph(jl,klev+1)-paph(jl,jk)).lt. 60.e2) itopde(jl) = jk end do - end do - - do jk=3,klev - is=0 - do jl=1,klon - zph(jl)=paph(jl,jk) - llo2(jl)=lddraf(jl).and.pmfd(jl,jk-1).lt.0. - if(llo2(jl)) then - is=is+1 - endif - enddo - if(is.eq.0) cycle - - do jl=1,klon - if(llo2(jl)) then + end do + + do jk=3,klev + is=0 + do jl=1,klon + zph(jl)=paph(jl,jk) + llo2(jl)=lddraf(jl).and.pmfd(jl,jk-1).lt.0. + if(llo2(jl)) then + is=is+1 + endif + enddo + if(is.eq.0) cycle + + do jl=1,klon + if(llo2(jl)) then zentr = entrdd*pmfd(jl,jk-1)*(pgeoh(jl,jk-1)-pgeoh(jl,jk))*zrg - zdmfen(jl)=zentr - zdmfde(jl)=zentr - endif - enddo - + zdmfen(jl)=zentr + zdmfde(jl)=zentr + endif + enddo + do jl=1,klon if(llo2(jl)) then if(jk.gt.itopde(jl)) then @@ -2775,182 +3003,195 @@ subroutine cuddrafn & endif enddo - do jl=1,klon - if(llo2(jl)) then + do jl=1,klon + if(llo2(jl)) then pmfd(jl,jk)=pmfd(jl,jk-1)+zdmfen(jl)-zdmfde(jl) - zseen=(cpd*ptenh(jl,jk-1)+pgeoh(jl,jk-1))*zdmfen(jl) - zqeen=pqenh(jl,jk-1)*zdmfen(jl) - zsdde=(cpd*ptd(jl,jk-1)+pgeoh(jl,jk-1))*zdmfde(jl) - zqdde=pqd(jl,jk-1)*zdmfde(jl) - zmfdsk=pmfds(jl,jk-1)+zseen-zsdde - zmfdqk=pmfdq(jl,jk-1)+zqeen-zqdde - pqd(jl,jk)=zmfdqk*(1./min(-cmfcmin,pmfd(jl,jk))) - ptd(jl,jk)=(zmfdsk*(1./min(-cmfcmin,pmfd(jl,jk)))-& - & pgeoh(jl,jk))*rcpd - ptd(jl,jk)=min(400.,ptd(jl,jk)) - ptd(jl,jk)=max(100.,ptd(jl,jk)) - zcond(jl)=pqd(jl,jk) - endif - enddo - - ik=jk - icall=2 - call cuadjtqn(klon, klev, ik, zph, ptd, pqd, llo2, icall ) - - do jl=1,klon - if(llo2(jl)) then + zseen=(cpd*ptenh(jl,jk-1)+pgeoh(jl,jk-1))*zdmfen(jl) + zqeen=pqenh(jl,jk-1)*zdmfen(jl) + zsdde=(cpd*ptd(jl,jk-1)+pgeoh(jl,jk-1))*zdmfde(jl) + zqdde=pqd(jl,jk-1)*zdmfde(jl) + zmfdsk=pmfds(jl,jk-1)+zseen-zsdde + zmfdqk=pmfdq(jl,jk-1)+zqeen-zqdde + pqd(jl,jk)=zmfdqk*(1./min(-cmfcmin,pmfd(jl,jk))) + ptd(jl,jk)=(zmfdsk*(1./min(-cmfcmin,pmfd(jl,jk)))-& + & pgeoh(jl,jk))*rcpd + ptd(jl,jk)=min(400.,ptd(jl,jk)) + ptd(jl,jk)=max(100.,ptd(jl,jk)) + zcond(jl)=pqd(jl,jk) + endif + enddo + + ik=jk + icall=2 + call cuadjtqn(klon, klev, ik, zph, ptd, pqd, llo2, icall ) + + do jl=1,klon + if(llo2(jl)) then zcond(jl)=zcond(jl)-pqd(jl,jk) - zbuo=ptd(jl,jk)*(1.+vtmpc1 *pqd(jl,jk))- & - & ptenh(jl,jk)*(1.+vtmpc1 *pqenh(jl,jk)) - if(prfl(jl).gt.0..and.pmfu(jl,jk).gt.0.) then - zrain=prfl(jl)/pmfu(jl,jk) + zbuo=ptd(jl,jk)*(1.+vtmpc1 *pqd(jl,jk))- & + & ptenh(jl,jk)*(1.+vtmpc1 *pqenh(jl,jk)) + if(prfl(jl).gt.0..and.pmfu(jl,jk).gt.0.) then + zrain=prfl(jl)/pmfu(jl,jk) zbuo=zbuo-ptd(jl,jk)*zrain - endif - if(zbuo.ge.0 .or. prfl(jl).le.(pmfd(jl,jk)*zcond(jl))) then + endif + if(zbuo.ge.0 .or. prfl(jl).le.(pmfd(jl,jk)*zcond(jl))) then pmfd(jl,jk)=0. - zbuo=0. + zbuo=0. endif - pmfds(jl,jk)=(cpd*ptd(jl,jk)+pgeoh(jl,jk))*pmfd(jl,jk) - pmfdq(jl,jk)=pqd(jl,jk)*pmfd(jl,jk) - zdmfdp=-pmfd(jl,jk)*zcond(jl) - pdmfdp(jl,jk-1)=zdmfdp - prfl(jl)=prfl(jl)+zdmfdp - -! compute organized entrainment for use at next level - zbuoyz=zbuo/ptenh(jl,jk) - zbuoyz=min(zbuoyz,0.0) + pmfds(jl,jk)=(cpd*ptd(jl,jk)+pgeoh(jl,jk))*pmfd(jl,jk) + pmfdq(jl,jk)=pqd(jl,jk)*pmfd(jl,jk) + zdmfdp=-pmfd(jl,jk)*zcond(jl) + pdmfdp(jl,jk-1)=zdmfdp + prfl(jl)=prfl(jl)+zdmfdp + +! compute organized entrainment for use at next level + zbuoyz=zbuo/ptenh(jl,jk) + zbuoyz=min(zbuoyz,0.0) zdz=-(pgeo(jl,jk-1)-pgeo(jl,jk)) zbuoy(jl)=zbuoy(jl)+zbuoyz*zdz - zoentr(jl)=g*zbuoyz*0.5/(1.+zbuoy(jl)) + zoentr(jl)=g*zbuoyz*0.5/(1.+zbuoy(jl)) pmfdde_rate(jl,jk) = -zdmfde(jl) - endif + endif enddo - - enddo - - return + + enddo + + return end subroutine cuddrafn !--------------------------------------------------------- -! level 3 souroutines +! level 3 souroutines !-------------------------------------------------------- - subroutine cuflxn & - & ( klon, klev, ztmst & - & , pten, pqen, pqsen, ptenh, pqenh & - & , paph, pap, pgeoh, lndj, ldcum & - & , kcbot, kctop, kdtop, ktopm2 & - & , ktype, lddraf & - & , pmfu, pmfd, pmfus, pmfds & - & , pmfuq, pmfdq, pmful, plude & - & , pdmfup, pdmfdp, pdpmel, plglac & - & , prain, pmfdde_rate, pmflxr, pmflxs ) - -! m.tiedtke e.c.m.w.f. 7/86 modif. 12/89 - -! purpose -! ------- - -! this routine does the final calculation of convective -! fluxes in the cloud layer and in the subcloud layer - -! interface -! --------- -! this routine is called from *cumastr*. - - -! parameter description units -! --------- ----------- ----- -! input parameters (integer): - -! *klon* number of grid points per packet -! *klev* number of levels -! *kcbot* cloud base level -! *kctop* cloud top level -! *kdtop* top level of downdrafts - -! input parameters (logical): - -! *lndj* land sea mask (1 for land) -! *ldcum* flag: .true. for convective points - -! input parameters (real(kind=kind_phys)): - -! *ztmst* time step for the physics s -! *pten* provisional environment temperature (t+1) k -! *pqen* provisional environment spec. humidity (t+1) kg/kg -! *pqsen* environment spec. saturation humidity (t+1) kg/kg -! *ptenh* env. temperature (t+1) on half levels k -! *pqenh* env. spec. humidity (t+1) on half levels kg/kg -! *paph* provisional pressure on half levels pa -! *pap* provisional pressure on full levels pa -! *pgeoh* geopotential on half levels m2/s2 - -! updated parameters (integer): - -! *ktype* set to zero if ldcum=.false. - -! updated parameters (logical): - -! *lddraf* set to .false. if ldcum=.false. or kdtop\file progomega_calc.f90 +!! This file contains the subroutine that calculates the prognostic +!! updraft vertical velocity that is used for closure computations in +!! saSAS and C3 deep and shallow convection. + +!>\ingroup SAMFdeep +!>\ingroup SAMF_shal +!> This subroutine computes a prognostic updraft vertical velocity +!! used in the closure computations in the samfdeepcnv.f and cu_c3_conv.f scheme +!! This subroutine computes a prognostic updraft vertical velocity +!! used in the closure computations in the samfshalcnv. and cu_c3_shal scheme +!!\section gen_progomega progomega_calc General Algorithm + + subroutine progomega_calc(first_time_step,flag_restart,im,km,kbcon1,ktcon,omegain,delt,del, & + zi,cnvflg,omegaout,grav,buo,drag,wush,tentr,bb1,bb2) + + use machine, only : kind_phys + use funcphys, only : fpvs + implicit none + + integer, intent(in) :: im, km + integer, intent(in) :: kbcon1(im),ktcon(im) + real(kind=kind_phys), intent(in) :: delt,grav,bb1,bb2 + real(kind=kind_phys), intent(in) :: omegain(im,km), del(im,km),zi(im,km) + real(kind=kind_phys), intent(in) :: drag(im,km),buo(im,km),wush(im,km),tentr(im,km) + real(kind=kind_phys), intent(inout) :: omegaout(im,km) + logical, intent(in) :: cnvflg(im),first_time_step,flag_restart + real(kind=kind_phys) :: termA(im,km),termB(im,km),termC(im,km),omega(im,km) + real(kind=kind_phys) :: RHS(im,km),Kd(im,km) + real(kind=kind_phys) :: dp,dz,entrn,Kdn,discr,wush_pa,lbb1,lbb2,lbb3 + integer :: i,k + + entrn = 0.8E-4 !0.5E-4 !m^-1 + Kdn = 0.5E-4 !2.9E-4 !m^-1 + lbb1 = 0.5 !1.0 + lbb2 = 3.2 !3.0 + lbb3 = 0.5 !0.5 + + + !Initialization 2D + do k = 1,km + do i = 1,im + termA(i,k)=0. + termB(i,k)=0. + termC(i,k)=0. + RHS(i,k)=0. + omega(i,k)=omegain(i,k) + enddo + enddo + + if(first_time_step .and. .not. flag_restart)then + do k = 1,km + do i = 1,im + if(cnvflg(i))then + omega(i,k)=-1.2 !Pa/s + endif + enddo + enddo + endif + + ! Compute RHS terms + !Lisa Bengtsson: ! compute updraft velocity omega (Pa/s) + !> - Expand the steady state solution of updraft velocity from Han et al.'s (2017) + !> \cite han_et_al_2017 equation 7 to include the time-derivative, and an aerodynamic + !> drag term from Gueremy 2016. + !> Solve using implicit time-stepping scheme, solving the quadratic equation for omega. + + do k = 2, km + do i = 1, im + if (cnvflg(i)) then + if (k > kbcon1(i) .and. k < ktcon(i)) then + + ! Aerodynamic drag parameter + Kd(i,k) = (tentr(i,k)/entrn)*Kdn + + ! Scale by dp/dz to have equation in Pa/s + !(dp/dz > 0) + dp = 1000. * del(i,k) + dz = zi(i,k+1) - zi(i,k) + + !termA - Ensures quadratic damping (drag). + !termB - Ensures linear damping from wind shear. + !termC - Adds buoyancy forcing + + !Coefficients for the quadratic equation + termA(i,k) = delt * ((lbb1 * drag(i,k) * (dp/dz)) + (Kd(i,k) * (dp/dz))) + termB(i,k) = -1.0 - delt * lbb3 * wush(i,k) * dp/dz + termC(i,k) = omega(i,k) - delt * lbb2 * buo(i,k) * (dp/dz) & + - delt * omega(i,k) * (omega(i,k-1) - omega(i,k)) / dp + !Compute the discriminant + discr = termB(i,k)**2 - 4.0 * termA(i,k) * termC(i,k) + + ! Check if discriminant is non-negative + if (discr >= 0.0) then + ! Solve quadratic equation, take the negative root + omegaout(i,k) = (-termB(i,k) - sqrt(discr)) / (2.0 * termA(i,k)) + else + omegaout(i,k) = omega(i,k) + endif + + omegaout(i,k) = MAX(MIN(omegaout(i,k), -1.2), -80.0) + + endif + endif + enddo + enddo + + end subroutine progomega_calc +end module progomega diff --git a/physics/CONV/progsigma_calc.f90 b/physics/CONV/progsigma_calc.f90 index f1415e89f..40e1631ea 100644 --- a/physics/CONV/progsigma_calc.f90 +++ b/physics/CONV/progsigma_calc.f90 @@ -1,3 +1,9 @@ +!>\file progsigma_calc.f90 + +!> This module contains the subroutine that calculates the prognostic +!! updraft area fraction that is used for closure computations in +!! saSAS deep and shallow convection, based on a moisture budget +!! as described in Bengtsson et al. 2022 \cite Bengtsson_2022. module progsigma implicit none @@ -6,14 +12,6 @@ module progsigma contains -!>\file progsigma_calc.f90 -!! This file contains the subroutine that calculates the prognostic -!! updraft area fraction that is used for closure computations in -!! saSAS deep and shallow convection, based on a moisture budget -!! as described in Bengtsson et al. 2022 \cite Bengtsson_2022. - -!>\ingroup SAMFdeep -!>\ingroup SAMF_shal !> This subroutine computes a prognostic updraft area fraction !! used in the closure computations in the samfdeepcnv.f scheme !! This subroutine computes a prognostic updraft area fracftion @@ -21,7 +19,7 @@ module progsigma !!\section gen_progsigma progsigma_calc General Algorithm subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& flag_mid,del,tmf,qmicro,dbyo1,zdqca,omega_u,zeta,hvap, & - delt,qadv,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, & + delt,qadv,kb,kbcon1,ktcon,cnvflg,betascu,betamcu,betadcu, & sigmind,sigminm,sigmins,sigmain,sigmaout,sigmab) ! ! @@ -31,7 +29,7 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& implicit none ! intent in - integer, intent(in) :: im,km,kbcon1(im),ktcon(im) + integer, intent(in) :: im,km,kb(im),kbcon1(im),ktcon(im) real(kind=kind_phys), intent(in) :: hvap,delt,betascu,betamcu,betadcu, & sigmind,sigminm,sigmins real(kind=kind_phys), intent(in) :: qadv(im,km),del(im,km), & @@ -41,16 +39,16 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& real(kind=kind_phys), intent(in) :: sigmain(im,km) ! intent out - real(kind=kind_phys), intent(out) :: sigmaout(im,km) + real(kind=kind_phys), intent(inout) :: sigmaout(im,km) real(kind=kind_phys), intent(out) :: sigmab(im) ! Local variables integer :: i,k,km1 real(kind=kind_phys) :: termA(im),termB(im),termC(im),termD(im) - real(kind=kind_phys) :: mcons(im),fdqa(im),form(im,km), & + real(kind=kind_phys) :: fdqa(im),form(im,km), & dp(im,km),inbu(im,km) - + real(kind=kind_phys) :: sumx(im) real(kind=kind_phys) :: gcvalmx,epsilon,ZZ,cvg,mcon,buy2, & fdqb,dtdyn,dxlim,rmulacvg,tem, & @@ -63,7 +61,7 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& km1=km-1 invdelt = 1./delt - if (flag_init) then + if(flag_init .and. .not. flag_restart) then sigmind_new=0.0 else sigmind_new=sigmind @@ -86,7 +84,7 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& termC(i)=0. termD(i)=0. fdqa(i)=0. - mcons(i)=0. + sumx(i)=0. enddo do k = 2,km1 @@ -95,47 +93,49 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& dp(i,k) = 1000. * del(i,k) endif enddo - enddo + enddo - !Initial computations, place maximum sigmain in sigmab - do i=1,im +!compute sigmain averaged over cloud layers after advection and place it in sigmab + do k=2,km1 + do i=1,im if(cnvflg(i))then - do k=2,km - if(sigmain(i,k)>sigmab(i))then - sigmab(i)=sigmain(i,k) - endif - enddo - endif - enddo - - do i=1,im - if(cnvflg(i))then - if(sigmab(i) < 1.E-5)then !after advection - sigmab(i)=0. + if(k > kbcon1(i) .and. k < ktcon(i)) then + sigmab(i) = sigmab(i) + sigmain(i,k) * dp(i,k) + sumx(i) = sumx(i) + dp(i,k) endif - endif + endif + enddo + enddo + do i = 1, im + if(cnvflg(i)) then + if(sumx(i) == 0.) then + k = kbcon1(i) + sigmab(i) = sigmain(i,k) + else + sigmab(i) = sigmab(i) / sumx(i) + sigmab(i) = min(sigmab(i), 1._kind_phys) + if(sigmab(i) < 1.E-5) sigmab(i)=0. + endif + endif enddo !compute termD "The vertical integral of the latent heat convergence is limited to the - !buoyant layers with positive moisture convergence (accumulated from the surface). - !Lowest level: - do i = 1,im - dp1 = 1000. * del(i,1) - mcons(i)=(hvap*(qadv(i,1)+tmf(i,1)+qmicro(i,1))*dp1) - enddo - !Levels above: - do k = 2,km1 + ! layers with positive moisture convergence (accumulated from the updraft starting level). + do k = 1,km1 do i = 1,im if(cnvflg(i))then - mcon = (hvap*(qadv(i,k)+tmf(i,k)+qmicro(i,k))*dp(i,k)) - buy2 = termD(i)+mcon+mcons(i) -! Do the integral over buoyant layers with positive mcon acc from surface - if(dbyo1(i,k)>0 .and. buy2 > 0.)then + if(k >= kb(i) .and. k < ktcon(i)) then + mcon = (hvap*(qadv(i,k)+tmf(i,k)+qmicro(i,k))*dp(i,k)) + buy2 = termD(i)+mcon +! +! Do the integral over buoyant layers with positive mcon acc from +! updraft starting level +! + if(buy2 > 0.)then inbu(i,k)=1. - endif - inbu(i,k-1)=MAX(inbu(i,k-1),inbu(i,k)) - termD(i) = termD(i) + inbu(i,k-1)*mcons(i) - mcons(i)=mcon + termD(i) = termD(i) + mcon + endif + endif endif enddo enddo @@ -144,8 +144,10 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& do k = 2,km1 do i = 1,im if(cnvflg(i))then + if(k >= kbcon1(i) .and. k < ktcon(i)) then tem=sigmab(i)*zeta(i,k)*inbu(i,k)*dbyo1(i,k)*dp(i,k) termA(i)=termA(i)+tem + endif endif enddo enddo @@ -154,8 +156,10 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& do k = 2,km1 do i = 1,im if(cnvflg(i))then + if(k >= kbcon1(i) .and. k < ktcon(i)) then tem=zeta(i,k)*dbyo1(i,k)*inbu(i,k)*dp(i,k) termB(i)=termB(i)+tem + endif endif enddo enddo @@ -164,31 +168,33 @@ subroutine progsigma_calc (im,km,flag_init,flag_restart,flag_shallow,& do k = 2,km1 do i = 1,im if(cnvflg(i))then + if(k >= kbcon1(i) .and. k < ktcon(i)) then form(i,k)=-1.0*inbu(i,k)*(omega_u(i,k)*delt) fdqb=0.5*((form(i,k)*zdqca(i,k))) termC(i)=termC(i)+inbu(i,k)* & (fdqb+fdqa(i))*hvap*zeta(i,k) fdqa(i)=fdqb + endif endif enddo enddo !sigmab - do i = 1,im - if(cnvflg(i))then - DEN=MIN(termC(i)+termB(i),1.E8) - cvg=termD(i)*delt - ZZ=MAX(0.0,SIGN(1.0,termA(i))) & - *MAX(0.0,SIGN(1.0,termB(i))) & - *MAX(0.0,SIGN(1.0,termC(i)-epsilon)) - cvg=MAX(0.0,cvg) - sigmab(i)=(ZZ*(termA(i)+cvg))/(DEN+(1.0-ZZ)) - if(sigmab(i)>0.)then - sigmab(i)=MIN(sigmab(i),0.95) - sigmab(i)=MAX(sigmab(i),sigmind_new) - endif - endif!cnvflg - enddo + do i = 1,im + if(cnvflg(i))then + DEN=MIN(termC(i)+termB(i),1.e8_kind_phys) + cvg=termD(i)*delt + ZZ=MAX(0.0,SIGN(1.0,termA(i))) & + *MAX(0.0,SIGN(1.0,termB(i))) & + *MAX(0.0,SIGN(1.0,termC(i)-epsilon)) + cvg=MAX(0.0,cvg) + sigmab(i)=(ZZ*(termA(i)+cvg))/(DEN+(1.0-ZZ)) + if(sigmab(i)>0.)then + sigmab(i)=MIN(sigmab(i),0.95) + sigmab(i)=MAX(sigmab(i),sigmind_new) + endif + endif!cnvflg + enddo do k=1,km do i=1,im diff --git a/physics/GWD/cires_orowam2017.f b/physics/GWD/cires_orowam2017.f index 9f04ac3b0..8f9599f24 100644 --- a/physics/GWD/cires_orowam2017.f +++ b/physics/GWD/cires_orowam2017.f @@ -1,12 +1,12 @@ !>\file cires_orowam2017.f +!! - +!> This module includes the OROGW solver of WAM2017. module cires_orowam2017 contains !>\defgroup cires_orowam2017_mod CIRES UGWP orowam2017 Module !>This is the OROGW-solver of WAM2017. -!>@{ !> subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, @@ -394,4 +394,3 @@ subroutine ugwpv0_tofd1d(levs, sigflt, elvmax, zsurf, ! end subroutine ugwpv0_tofd1d end module cires_orowam2017 -!>@} diff --git a/physics/GWD/cires_tauamf_data.F90 b/physics/GWD/cires_tauamf_data.F90 index 77c74b1a9..323cea9a8 100644 --- a/physics/GWD/cires_tauamf_data.F90 +++ b/physics/GWD/cires_tauamf_data.F90 @@ -1,3 +1,6 @@ +!>\file cires_tauamf_data.F90 +!! + module cires_tauamf_data use machine, only: kind_phys @@ -16,6 +19,7 @@ module cires_tauamf_data contains +!> subroutine read_tau_amf(me, master, errmsg, errflg) use netcdf @@ -32,7 +36,7 @@ subroutine read_tau_amf(me, master, errmsg, errflg) if(iernc.ne.0) then write(errmsg,'(*(a))') "read_tau_amf: cannot open file_limb_tab data-file ", & trim(ugwp_taufile) - print *, 'cannot open ugwp-v1 tau-file=',trim(ugwp_taufile) + print *, 'cannot open ugwp-v1 tau-file=',trim(ugwp_taufile) errflg = 1 return else @@ -47,29 +51,30 @@ subroutine read_tau_amf(me, master, errmsg, errflg) status = nf90_inquire_dimension(ncid, DimID, len =ntau_d2t ) if (me == master) print *, ntau_d1y, ntau_d2t, ' dimd of tau_ngw ugwp-v1 ' - if (ntau_d2t .le. 0 .or. ntau_d1y .le. 0) then - print *, 'ugwp-v1 tau-file=', trim(ugwp_taufile) - print *, ' ugwp-v1: ', 'ntau_d2t=',ntau_d2t, 'ntau_d2t=',ntau_d1y - stop - endif + if (ntau_d2t .le. 0 .or. ntau_d1y .le. 0) then + print *, 'ugwp-v1 tau-file=', trim(ugwp_taufile) + print *, ' ugwp-v1: ', 'ntau_d2t=',ntau_d2t, 'ntau_d2t=',ntau_d1y + stop + endif if (.not.allocated(ugwp_taulat)) allocate (ugwp_taulat(ntau_d1y )) if (.not.allocated(days_limb)) allocate (days_limb(ntau_d2t)) - if (.not.allocated(tau_limb)) allocate (tau_limb(ntau_d1y, ntau_d2t )) + if (.not.allocated(tau_limb)) allocate (tau_limb(ntau_d1y, ntau_d2t )) - iernc=nf90_inq_varid( ncid, 'DAYS', vid ) + iernc=nf90_inq_varid( ncid, 'DAYS', vid ) iernc= nf90_get_var( ncid, vid, days_limb) - iernc=nf90_inq_varid( ncid, 'LATS', vid ) + iernc=nf90_inq_varid( ncid, 'LATS', vid ) iernc= nf90_get_var( ncid, vid, ugwp_taulat) - iernc=nf90_inq_varid( ncid, 'ABSMF', vid ) + iernc=nf90_inq_varid( ncid, 'ABSMF', vid ) iernc= nf90_get_var( ncid, vid, tau_limb) - iernc=nf90_close(ncid) + iernc=nf90_close(ncid) - endif + endif end subroutine read_tau_amf +!> subroutine cires_indx_ugwp (npts, me, master, dlat,j1_tau,j2_tau, w1_j1tau, w2_j2tau) use machine, only: kind_phys @@ -97,21 +102,22 @@ subroutine cires_indx_ugwp (npts, me, master, dlat,j1_tau,j2_tau, w1_j1tau, w2_j j2_tau(j) = min(j2_tau(j),ntau_d1y) - j1_tau(j) = max(j2_tau(j)-1,1) + j1_tau(j) = max(j2_tau(j)-1,1) if (j1_tau(j) /= j2_tau(j) ) then w2_j2tau(j) = (dlat(j) - ugwp_taulat(j1_tau(j))) & - / (ugwp_taulat(j2_tau(j))-ugwp_taulat(j1_tau(j))) + / (ugwp_taulat(j2_tau(j))-ugwp_taulat(j1_tau(j))) else w2_j2tau(j) = 1.0 endif - w1_j1tau(j) = 1.0 - w2_j2tau(j) + w1_j1tau(j) = 1.0 - w2_j2tau(j) enddo return end subroutine cires_indx_ugwp +!> subroutine tau_amf_interp(me, master, im, idate, fhour, j1_tau,j2_tau, ddy_j1, ddy_j2, tau_ddd) - use machine, only: kind_phys + use machine, only: kind_phys implicit none !input @@ -135,37 +141,38 @@ subroutine tau_amf_interp(me, master, im, idate, fhour, j1_tau,j2_tau, ddy_j1, d it1 = 2 do iday=1, ntau_d2t - if (fddd .lt. days_limb(iday) ) then - it2 = iday - exit - endif - enddo + if (fddd .lt. days_limb(iday) ) then + it2 = iday + exit + endif + enddo - it2 = min(it2,ntau_d2t) - it1 = max(it2-1,1) - if (it2 > ntau_d2t ) then - print *, ' Error in time-interpolation for tau_amf_interp ' - print *, ' it1, it2, ntau_d2t ', it1, it2, ntau_d2t - print *, ' Error in time-interpolation see cires_tauamf_data.F90 ' - stop - endif + it2 = min(it2,ntau_d2t) + it1 = max(it2-1,1) + if (it2 > ntau_d2t ) then + print *, ' Error in time-interpolation for tau_amf_interp ' + print *, ' it1, it2, ntau_d2t ', it1, it2, ntau_d2t + print *, ' Error in time-interpolation see cires_tauamf_data.F90 ' + stop + endif - w2 = (fddd-days_limb(it1))/(days_limb(it2)-days_limb(it1)) - w1 = 1.0-w2 + w2 = (fddd-days_limb(it1))/(days_limb(it2)-days_limb(it1)) + w1 = 1.0-w2 - do i=1, im - j1 = j1_tau(i) - j2 = j2_tau(i) - tx1 = tau_limb(j1, it1)*ddy_j1(i)+tau_limb(j2, it1)*ddy_j2(i) - tx2 = tau_limb(j1, it2)*ddy_j1(i)+tau_limb(j2, it2)*ddy_j2(i) - tau_ddd(i) = tx1*w1 + w2*tx2 + do i=1, im + j1 = j1_tau(i) + j2 = j2_tau(i) + tx1 = tau_limb(j1, it1)*ddy_j1(i)+tau_limb(j2, it1)*ddy_j2(i) + tx2 = tau_limb(j1, it2)*ddy_j1(i)+tau_limb(j2, it2)*ddy_j2(i) + tau_ddd(i) = tx1*w1 + w2*tx2 enddo end subroutine tau_amf_interp +!> subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) - use machine, only: kind_phys + use machine, only: kind_phys implicit none ! input integer, intent(in) :: idate(4) @@ -180,7 +187,6 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) integer :: jdow, jdoy, jday real(8) :: rinc(5) real(4) :: rinc4(5) - integer :: w3kindreal, w3kindint integer :: iw3jdn integer :: jd1, jddd @@ -196,13 +202,7 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) rinc(1:5) = 0. rinc(2) = fhour ! - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4 = rinc - call w3movdat(rinc4, idat,jdat) - else - call w3movdat(rinc, idat,jdat) - endif + call w3movdat(rinc, idat,jdat) ! jdate(8)- date and time (yr, mo, day, [tz], hr, min, sec) jdow = 0 jdoy = 0 diff --git a/physics/GWD/cires_ugwp.F90 b/physics/GWD/cires_ugwp.F90 index c648d9647..beb7dbbc7 100644 --- a/physics/GWD/cires_ugwp.F90 +++ b/physics/GWD/cires_ugwp.F90 @@ -1,16 +1,17 @@ !> \file cires_ugwp.F90 !! This file contains the Unified Gravity Wave Physics (UGWP) scheme by Valery Yudin (University of Colorado, CIRES) + +!> This module contains the UGWP v0 scheme by Valery Yudin (University of Colorado, CIRES) +!! !! See Valery Yudin's presentation at 2017 NGGPS PI meeting: !! Gravity waves (GWs): Mesoscale GWs transport momentum, energy (heat) , and create eddy mixing in the whole atmosphere domain; Breaking and dissipating GWs deposit: (a) momentum; (b) heat (energy); and create (c) turbulent mixing of momentum, heat, and tracers !! To properly incorporate GW effects (a-c) unresolved by DYCOREs we need GW physics !! "Unified": a) all GW effects due to both dissipation/breaking; b) identical GW solvers for all GW sources; c) ability to replace solvers. !! Unified Formalism: -!! 1. GW Sources: Stochastic and physics based mechanisms for GW-excitations in the lower atmosphere, calibrated by the high-res analyses/forecasts, and observations (3 types of GW sources: orography, convection, fronts/jets). -!! 2. GW Propagation: Unified solver for "propagation, dissipation and breaking" excited from all type of GW sources. -!! 3. GW Effects: Unified representation of GW impacts on the "resolved" flow for all sources (energy-balanced schemes for momentum, heat and mixing). +!! - GW Sources: Stochastic and physics based mechanisms for GW-excitations in the lower atmosphere, calibrated by the high-res analyses/forecasts, and observations (3 types of GW sources: orography, convection, fronts/jets). +!! - GW Propagation: Unified solver for "propagation, dissipation and breaking" excited from all type of GW sources. +!! - GW Effects: Unified representation of GW impacts on the "resolved" flow for all sources (energy-balanced schemes for momentum, heat and mixing). !! https://www.weather.gov/media/sti/nggps/Presentations%202017/02%20NGGPS_VYUDIN_2017_.pdf - - module cires_ugwp use machine, only: kind_phys @@ -33,9 +34,7 @@ module cires_ugwp ! ------------------------------------------------------------------------ ! CCPP entry points for CIRES Unified Gravity Wave Physics (UGWP) scheme v0 ! ------------------------------------------------------------------------ -!>\defgroup cires_ugwp_run_mod CIRES Unified Gravity Wave Physics v0 Module -!> @{ -!>@ The subroutine initializes the CIRES UGWP V0. +!> The subroutine initializes the CIRES UGWP V0. !> \section arg_table_cires_ugwp_init Argument Table !! \htmlinclude cires_ugwp_init.html !! @@ -112,7 +111,7 @@ end subroutine cires_ugwp_init ! finalize of cires_ugwp (_finalize) ! ----------------------------------------------------------------------- -!>@brief The subroutine finalizes the CIRES UGWP +!> The subroutine finalizes the CIRES UGWP #if 0 !> \section arg_table_cires_ugwp_finalize Argument Table !! \htmlinclude cires_ugwp_finalize.html @@ -229,13 +228,14 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr real(kind=kind_phys), intent(out), dimension(:) :: zmtb, zlwb, zogw, rdxzb real(kind=kind_phys), intent(out), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw real(kind=kind_phys), intent(out), dimension(:, :):: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis - real(kind=kind_phys), intent(out), dimension(:, :):: dudt_mtb, dudt_ogw, dudt_tms - real(kind=kind_phys), intent(out), dimension(:) :: dusfc_ms, dvsfc_ms, dusfc_bl, dvsfc_bl - real(kind=kind_phys), intent(out), dimension(:, :) :: dtauy2d_ms - real(kind=kind_phys), intent(out), dimension(:, :) :: dtaux2d_bl, dtauy2d_bl + real(kind=kind_phys), intent(out), dimension(:, :):: dudt_mtb, dudt_tms + real(kind=kind_phys), intent(out), dimension(:, :), optional :: dudt_ogw + real(kind=kind_phys), intent(out), dimension(:), optional :: dusfc_ms, dvsfc_ms, dusfc_bl, dvsfc_bl + real(kind=kind_phys), intent(out), dimension(:, :), optional :: dtauy2d_ms + real(kind=kind_phys), intent(out), dimension(:, :), optional :: dtaux2d_bl, dtauy2d_bl ! dtend is only allocated if ldiag=.true. - real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), & index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_orographic_gwd, index_of_process_nonorographic_gwd @@ -243,7 +243,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr logical, intent(in) :: ldiag3d, lssav ! These arrays only allocated if ldiag_ugwp = .true. - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms real(kind=kind_phys), intent(inout), dimension(:, :):: dudt, dvdt, dtdt @@ -444,5 +444,4 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr endif end subroutine cires_ugwp_run -!> @} end module cires_ugwp diff --git a/physics/GWD/cires_ugwp.meta b/physics/GWD/cires_ugwp.meta index cd0192ca7..b0b1a8615 100644 --- a/physics/GWD/cires_ugwp.meta +++ b/physics/GWD/cires_ugwp.meta @@ -604,6 +604,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_ms] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from mesoscale gwd @@ -612,6 +613,7 @@ type = real kind = kind_phys intent = out + optional = True [dusfc_bl] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -620,6 +622,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_bl] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -628,6 +631,7 @@ type = real kind = kind_phys intent = out + optional = True [dudt_ogw] standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in x wind due to orographic gw drag @@ -636,6 +640,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_ms] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in y wind due to orographic gw drag @@ -644,6 +649,7 @@ type = real kind = kind_phys intent = out + optional = True [dtaux2d_bl] standard_name = tendency_of_x_wind_due_to_blocking_drag long_name = x wind tendency from blocking drag @@ -652,6 +658,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_bl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -660,6 +667,7 @@ type = real kind = kind_phys intent = out + optional = True [dudt_mtb] standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag long_name = instantaneous change in x wind due to mountain blocking drag @@ -684,6 +692,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ogw] standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag @@ -692,6 +701,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_tms] standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD @@ -700,6 +710,7 @@ type = real kind = kind_phys intent = inout + optional = True [dudt] standard_name = process_split_cumulative_tendency_of_x_wind long_name = zonal wind tendency due to model physics @@ -840,8 +851,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - active = (flag_for_diagnostics_3D) intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/GWD/cires_ugwp_initialize.F90 b/physics/GWD/cires_ugwp_initialize.F90 index ddcbdadf7..ae923671d 100644 --- a/physics/GWD/cires_ugwp_initialize.F90 +++ b/physics/GWD/cires_ugwp_initialize.F90 @@ -6,7 +6,7 @@ ! init gw-background dissipation !=============================== -!> Define constants +!> This module contains UGWP v0 initialization schemes module ugwp_common_v0 ! use machine, only: kind_phys @@ -95,6 +95,7 @@ end subroutine init_global_gwdis_v0 ! ugwpv0_oro_init ! !========================================================================= +!> This module contains orographic wave source schemes for UGWP v0. module ugwpv0_oro_init use ugwp_common_v0, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi @@ -225,6 +226,7 @@ end module ugwpv0_oro_init ! Part -3 init wave solvers !=============================== +!> This module contains initialization of wave solvers for UGWP v0 module ugwpv0_lsatdis_init implicit none @@ -270,6 +272,7 @@ end subroutine initsolv_lsatdis_v0 end module ugwpv0_lsatdis_init ! ! +!>This module contains init-solvers for "broad" non-stationary multi-wave spectra module ugwpv0_wmsdis_init use ugwp_common_v0, only : pi, pi2 diff --git a/physics/GWD/cires_ugwp_module.F90 b/physics/GWD/cires_ugwp_module.F90 index 3b3ce3114..a454a5eae 100644 --- a/physics/GWD/cires_ugwp_module.F90 +++ b/physics/GWD/cires_ugwp_module.F90 @@ -1,5 +1,7 @@ !>\file cires_ugwp_module.F90 +!! +!>This module contains the UGWPv0 driver module cires_ugwpv0_module ! @@ -9,8 +11,8 @@ module cires_ugwpv0_module implicit none logical :: module_is_initialized - logical :: do_physb_gwsrcs = .false. ! control for physics-based GW-sources - logical :: do_rfdamp = .false. ! control for Rayleigh friction inside ugwp_driver + logical :: do_physb_gwsrcs = .false. !< control for physics-based GW-sources + logical :: do_rfdamp = .false. !< control for Rayleigh friction inside ugwp_driver real, parameter :: arad=6370.e3 real, parameter :: pi = atan(1.0) @@ -18,24 +20,24 @@ module cires_ugwpv0_module real, parameter :: hps = 7000. real, parameter :: hpskm = hps/1000. ! - real :: kxw = 6.28e-3/100. ! single horizontal wavenumber of ugwp schemes + real :: kxw = 6.28e-3/100. !< single horizontal wavenumber of ugwp schemes real, parameter :: ricrit = 0.25 real, parameter :: frcrit = 0.50 real, parameter :: linsat = 1.00 real, parameter :: linsat2 = linsat*linsat ! - integer :: knob_ugwp_solver=1 ! 1, 2, 3, 4 - (linsat, ifs_2010, ad_gfdl, dsp_dis) - integer, dimension(4) :: knob_ugwp_source ! [1,1,1,0] - (oro, fronts, conv, imbf-owp] - integer, dimension(4) :: knob_ugwp_wvspec ! number of waves for- (oro, fronts, conv, imbf-owp] - integer, dimension(4) :: knob_ugwp_azdir ! number of wave azimuths for- (oro, fronts, conv, imbf-owp] - integer, dimension(4) :: knob_ugwp_stoch ! 1 - deterministic ; 0 - stochastic - real, dimension(4) :: knob_ugwp_effac ! efficiency factors for- (oro, fronts, conv, imbf-owp] + integer :: knob_ugwp_solver=1 !< 1, 2, 3, 4 - (linsat, ifs_2010, ad_gfdl, dsp_dis) + integer, dimension(4) :: knob_ugwp_source !< [1,1,1,0] - (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_wvspec !< number of waves for- (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_azdir !< number of wave azimuths for- (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_stoch !< 1 - deterministic ; 0 - stochastic + real, dimension(4) :: knob_ugwp_effac !< efficiency factors for- (oro, fronts, conv, imbf-owp] - integer :: knob_ugwp_doaxyz=1 ! 1 -gwdrag - integer :: knob_ugwp_doheat=1 ! 1 -gwheat - integer :: knob_ugwp_dokdis=0 ! 1 -gwmixing - integer :: knob_ugwp_ndx4lh = 2 ! n-number of "unresolved" "n*dx" for lh_gw + integer :: knob_ugwp_doaxyz=1 !< 1 -gwdrag + integer :: knob_ugwp_doheat=1 !< 1 -gwheat + integer :: knob_ugwp_dokdis=0 !< 1 -gwmixing + integer :: knob_ugwp_ndx4lh = 2 !< n-number of "unresolved" "n*dx" for lh_gw ! integer :: ugwp_azdir integer :: ugwp_stoch @@ -45,12 +47,12 @@ module cires_ugwpv0_module real :: ugwp_effac ! - data knob_ugwp_source / 1,0, 1, 0 / ! oro-conv-fjet-okw-taub_lat: 1-active 0-off - data knob_ugwp_wvspec /1,32,32,32/ ! number of waves for- (oro, fronts, conv, imbf-owp, taulat] - data knob_ugwp_azdir /2, 4, 4,4/ ! number of wave azimuths for- (oro, fronts, conv, imbf-okwp] - data knob_ugwp_stoch /0, 0, 0,0/ ! 0 - deterministic ; 1 - stochastic, non-activated option - data knob_ugwp_effac /1.,1.,1.,1./ ! efficiency factors for- (oro, fronts, conv, imbf-owp] - integer :: knob_ugwp_version = 0 ! version control had sense under IPD in CCPP=> to SUITES + data knob_ugwp_source / 1,0, 1, 0 / !< oro-conv-fjet-okw-taub_lat: 1-active 0-off + data knob_ugwp_wvspec /1,32,32,32/ !< number of waves for- (oro, fronts, conv, imbf-owp, taulat] + data knob_ugwp_azdir /2, 4, 4,4/ !< number of wave azimuths for- (oro, fronts, conv, imbf-okwp] + data knob_ugwp_stoch /0, 0, 0,0/ !< 0 - deterministic ; 1 - stochastic, non-activated option + data knob_ugwp_effac /1.,1.,1.,1./ !< efficiency factors for- (oro, fronts, conv, imbf-owp] + integer :: knob_ugwp_version = 0 !< version control had sense under IPD in CCPP=> to SUITES integer :: launch_level = 55 ! namelist /cires_ugwp_nml/ knob_ugwp_solver, knob_ugwp_source,knob_ugwp_wvspec, knob_ugwp_azdir, & diff --git a/physics/GWD/cires_ugwp_post.F90 b/physics/GWD/cires_ugwp_post.F90 index f12237e2f..f77bf5810 100644 --- a/physics/GWD/cires_ugwp_post.F90 +++ b/physics/GWD/cires_ugwp_post.F90 @@ -1,6 +1,7 @@ !> \file cires_ugwp_post.F90 -!! This file contains +!! This file contains the calcualtion of the UGWP v0 diagnostics +!> This module contains the calculation of the UGWP v0 diagnostics (ldiag_ugwp) module cires_ugwp_post contains @@ -33,8 +34,9 @@ subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & real(kind=kind_phys), intent(in), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw - real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb, dudt_ogw, dudt_tms - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw + real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb, dudt_tms + real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_ogw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt character(len=*), intent(out) :: errmsg diff --git a/physics/GWD/cires_ugwp_post.meta b/physics/GWD/cires_ugwp_post.meta index dabc40082..5d2a6a3d1 100644 --- a/physics/GWD/cires_ugwp_post.meta +++ b/physics/GWD/cires_ugwp_post.meta @@ -204,6 +204,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ogw] standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag @@ -212,6 +213,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_tms] standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD @@ -220,6 +222,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ngw] standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in x wind due to NGW @@ -228,6 +231,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3dt_ngw] standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in y wind due to NGW @@ -236,6 +240,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtdt] standard_name = process_split_cumulative_tendency_of_air_temperature long_name = air temperature tendency due to model physics diff --git a/physics/GWD/cires_ugwp_triggers.F90 b/physics/GWD/cires_ugwp_triggers.F90 index ba7483eca..95cb79684 100644 --- a/physics/GWD/cires_ugwp_triggers.F90 +++ b/physics/GWD/cires_ugwp_triggers.F90 @@ -1,10 +1,13 @@ !>\file cires_ugwp_triggers.F90 !! +!> This module contains routines describing the the latitudinal shape of +!! vertical momentum flux function in UGWP v0. module cires_ugwp_triggers contains ! +!> subroutine slat_geos5_tamp_v0(im, tau_amp, xlatdeg, tau_gw) !================= ! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* @@ -38,6 +41,7 @@ subroutine slat_geos5_tamp_v0(im, tau_amp, xlatdeg, tau_gw) ! end subroutine slat_geos5_tamp_v0 +!> subroutine slat_geos5_v0(im, xlatdeg, tau_gw) !================= ! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* @@ -76,7 +80,8 @@ subroutine slat_geos5_v0(im, xlatdeg, tau_gw) enddo ! end subroutine slat_geos5_v0 -! + +!> subroutine init_nazdir_v0(naz, xaz, yaz) use ugwp_common_v0 , only : pi2 implicit none diff --git a/physics/GWD/cires_ugwpv1_initialize.F90 b/physics/GWD/cires_ugwpv1_initialize.F90 index aa54a46f3..daa850550 100644 --- a/physics/GWD/cires_ugwpv1_initialize.F90 +++ b/physics/GWD/cires_ugwpv1_initialize.F90 @@ -12,11 +12,11 @@ ! Part-0 specifications of common constants, limiters and "criiical" values ! ! - +!> This module contains common constants, limiters and "critical" values in module ugwp_common ! use machine, only : kind_phys - + implicit none real(kind=kind_phys) :: pi, pi2, pih, rad_to_deg, deg_to_rad @@ -60,12 +60,11 @@ module ugwp_common ! real(kind=kind_phys), parameter :: fv = rv/rd - 1.0 ! real(kind=kind_phys), parameter :: arad = 6370.e3 - end module ugwp_common - + contains + subroutine init_nazdir(naz, xaz, yaz) use machine, only : kind_phys - use ugwp_common, only : pi2 implicit none @@ -103,7 +102,6 @@ end subroutine init_nazdir subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, me, master) ! use machine , only : kind_phys - use ugwp_common, only : pih, pi implicit none integer , intent(in) :: me, master @@ -185,6 +183,8 @@ subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, me, master) ! 132 format( 2x, F8.3,' dis-scales:', 4(2x, E10.3)) end subroutine init_global_gwdis + + end module ugwp_common ! ! ======================================================================== ! Part 2 - sources @@ -353,7 +353,7 @@ module ugwp_conv_init ! subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) ! - use ugwp_common, only : pi2, arad + use ugwp_common, only : pi2, arad, init_nazdir implicit none @@ -433,8 +433,8 @@ module ugwp_fjet_init subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac,lonr, kxw) - use ugwp_common, only : pi2, arad - + use ugwp_common, only : pi2, arad, init_nazdir + implicit none integer :: nwaves, nazdir, nstoch @@ -492,7 +492,7 @@ module ugwp_okw_init subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) - use ugwp_common, only : pi2, arad + use ugwp_common, only : pi2, arad, init_nazdir implicit none diff --git a/physics/GWD/cires_ugwpv1_module.F90 b/physics/GWD/cires_ugwpv1_module.F90 index 9c3fa24ee..c0e866dc5 100644 --- a/physics/GWD/cires_ugwpv1_module.F90 +++ b/physics/GWD/cires_ugwpv1_module.F90 @@ -151,6 +151,7 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & ! input_nml_file ='input.nml'=fn_nml ..... OLD_namelist and cdmvgwd(4) Corrected Bug Oct 4 ! use netcdf + use ugwp_common, only : init_global_gwdis use ugwp_oro_init, only : init_oro_gws use ugwp_conv_init, only : init_conv_gws use ugwp_fjet_init, only : init_fjet_gws diff --git a/physics/GWD/cires_ugwpv1_oro.F90 b/physics/GWD/cires_ugwpv1_oro.F90 index 423a21348..cdbb38a4f 100644 --- a/physics/GWD/cires_ugwpv1_oro.F90 +++ b/physics/GWD/cires_ugwpv1_oro.F90 @@ -120,7 +120,7 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & real(kind=kind_phys),dimension(im),intent(out) :: zobl, zogw, zlwb, tau_ogw character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(out) :: errflg ! ! ! locals vars for SSO @@ -222,7 +222,8 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & dusfc(i) = 0.0 dvsfc(i) = 0.0 ipt(i) = 0 - enddo + enddo + zlwb(:) = 0.0 ! ---- for lm and gwd calculation points !cires_ugwp_initialize.F90: real, parameter :: hpmax=2400.0, hpmin=25.0 @@ -1008,13 +1009,12 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & endif endif - return end subroutine orogw_v1 ! ! subroutine ugwp_tofd1d(levs, con_cp, dtp, sigflt, zsurf, zpbl, u, v, & zmid, utofd, vtofd, epstofd, krf_tofd) - + use machine , only : kind_phys use ugwp_oro_init, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd ! diff --git a/physics/GWD/cires_ugwpv1_triggers.F90 b/physics/GWD/cires_ugwpv1_triggers.F90 index 009d91775..29d66f823 100644 --- a/physics/GWD/cires_ugwpv1_triggers.F90 +++ b/physics/GWD/cires_ugwpv1_triggers.F90 @@ -298,7 +298,7 @@ subroutine get_spectra_tau_okw(nw, im, levs, trig_okw, xlatd, sinlat, coslat, t if (dmax >= tlim_okw) kex = kex+1 do k=klow+1, ktop dtot = abs(trig_okw(i,k)) - if (dtot >= tlim_fgf ) kex = kex+1 + if (dtot >= tlim_okw ) kex = kex+1 if ( dtot > dmax) then klev(i) = k dmax = dtot diff --git a/physics/GWD/drag_suite.F90 b/physics/GWD/drag_suite.F90 index 71bb0a64f..609074c4b 100644 --- a/physics/GWD/drag_suite.F90 +++ b/physics/GWD/drag_suite.F90 @@ -1,17 +1,12 @@ !> \file drag_suite.F90 -!! This file is the parameterization of orographic gravity wave +!! This file is the parameterization of orographic drag !! drag, mountain blocking, and form drag. +!> This module contains the orographic drag scheme module drag_suite contains -!> \defgroup gfs_drag_suite_mod GSL drag_suite Module -!> This module contains the CCPP-compliant GSL orographic gravity wave drag scheme. -!> @{ -!! -!> \brief This subroutine initializes the orographic gravity wave drag scheme. -!! !> \section arg_table_drag_suite_init Argument Table !! \htmlinclude drag_suite_init.html !! @@ -35,7 +30,7 @@ subroutine drag_suite_init(gwd_opt, errmsg, errflg) end if end subroutine drag_suite_init -!> \brief This subroutine includes orographic gravity wave drag, mountain +!> This subroutine includes orographic drag, mountain !! blocking, and form drag. !! !> The time tendencies of zonal and meridional wind are altered to @@ -46,7 +41,7 @@ end subroutine drag_suite_init !> \section arg_table_drag_suite_run Argument Table !! \htmlinclude drag_suite_run.html !! -!> \section gen_drag_suite GFS Orographic GWD Scheme General Algorithm +!> \section gen_drag_suite Orographic drag Scheme General Algorithm !! -# Calculate subgrid mountain blocking !! -# Calculate orographic wave drag !! @@ -219,8 +214,8 @@ subroutine drag_suite_run( & & dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl, & & dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & & slmsk,br1,hpbl, & - & g, cp, rd, rv, fv, pi, imx, cdmbgwd, me, master, & - & lprnt, ipr, rdxzb, dx, gwd_opt, & + & g, cp, rd, rv, fv, pi, imx, cdmbgwd, alpha_fd, & + & me, master, lprnt, ipr, rdxzb, dx, gwd_opt, & & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & & dtend, dtidx, index_of_process_orographic_gwd, & & index_of_temperature, index_of_x_wind, & @@ -327,8 +322,9 @@ subroutine drag_suite_run( & integer, intent(in) :: gwd_opt logical, intent(in) :: lprnt integer, intent(in) :: KPBL(:) - real(kind=kind_phys), intent(in) :: deltim, G, CP, RD, RV, cdmbgwd(:) - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(in) :: deltim, G, CP, RD, RV, & + & cdmbgwd(:), alpha_fd + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) logical, intent(in) :: ldiag3d integer, intent(in) :: dtidx(:,:), index_of_temperature, & & index_of_process_orographic_gwd, index_of_x_wind, index_of_y_wind @@ -337,7 +333,7 @@ subroutine drag_suite_run( & integer, parameter :: ims=1, kms=1, its=1, kts=1 real(kind=kind_phys), intent(in) :: fv, pi real(kind=kind_phys) :: rcl, cdmb - real(kind=kind_phys) :: g_inv + real(kind=kind_phys) :: g_inv, rd_inv real(kind=kind_phys), intent(inout) :: & & dudt(:,:),dvdt(:,:), & @@ -353,7 +349,7 @@ subroutine drag_suite_run( & real(kind=kind_phys), intent(in) :: var(:),oc1(:), & & oa4(:,:),ol4(:,:), & & dx(:) - real(kind=kind_phys), intent(in) :: varss(:),oc1ss(:), & + real(kind=kind_phys), intent(in) :: varss(:),oc1ss(:), & & oa4ss(:,:),ol4ss(:,:) real(kind=kind_phys), intent(in) :: THETA(:),SIGMA(:), & & GAMMA(:),ELVMAX(:) @@ -374,7 +370,7 @@ subroutine drag_suite_run( & !SPP real(kind=kind_phys), dimension(im) :: var_stoch, varss_stoch, & varmax_fd_stoch - real(kind=kind_phys), intent(in) :: spp_wts_gwd(:,:) + real(kind=kind_phys), intent(in), optional :: spp_wts_gwd(:,:) integer, intent(in) :: spp_gwd real(kind=kind_phys), dimension(im) :: rstoch @@ -383,12 +379,12 @@ subroutine drag_suite_run( & real(kind=kind_phys), intent(inout) :: & & dusfc(:), dvsfc(:) !Output (optional): - real(kind=kind_phys), intent(inout) :: & + real(kind=kind_phys), intent(inout), optional :: & & dusfc_ms(:),dvsfc_ms(:), & & dusfc_bl(:),dvsfc_bl(:), & & dusfc_ss(:),dvsfc_ss(:), & & dusfc_fd(:),dvsfc_fd(:) - real(kind=kind_phys), intent(inout) :: & + real(kind=kind_phys), intent(inout), optional :: & & dtaux2d_ms(:,:),dtauy2d_ms(:,:), & & dtaux2d_bl(:,:),dtauy2d_bl(:,:), & & dtaux2d_ss(:,:),dtauy2d_ss(:,:), & @@ -443,6 +439,7 @@ subroutine drag_suite_run( & real(kind=kind_phys), dimension(im,km) :: utendform,vtendform real(kind=kind_phys) :: a1,a2,wsp real(kind=kind_phys) :: H_efold + real(kind=kind_phys), parameter :: coeff_fd = 6.325e-3 ! critical richardson number for wave breaking : ! larger drag with larger value real(kind=kind_phys), parameter :: ric = 0.25 @@ -511,7 +508,6 @@ subroutine drag_suite_run( & real(kind=kind_phys),parameter :: olmin = 1.0e-5 real(kind=kind_phys),parameter :: odmin = 0.1 real(kind=kind_phys),parameter :: odmax = 10. - real(kind=kind_phys),parameter :: erad = 6371.315e+3 integer :: komax(im) integer :: kblk real(kind=kind_phys) :: cd @@ -707,11 +703,12 @@ subroutine drag_suite_run( & taufb(1:im,1:km+1) = 0.0 komax(1:im) = 0 ! + rd_inv = 1./rd do k = kts,km do i = its,im vtj(i,k) = t1(i,k) * (1.+fv*q1(i,k)) vtk(i,k) = vtj(i,k) / prslk(i,k) - ro(i,k) = 1./rd * prsl(i,k) / vtj(i,k) ! density kg/m**3 + ro(i,k) = rd_inv * prsl(i,k) / vtj(i,k) ! density kg/m**3 enddo enddo ! @@ -1362,9 +1359,10 @@ subroutine drag_suite_run( & H_efold = 1500. DO k=kts,km wsp=SQRT(uwnd1(i,k)**2 + vwnd1(i,k)**2) - ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 - ! Change alpha to 35 -- 0.0759 becomes 0.2214 - var_temp = 0.2214*EXP(-(zl(i,k)/H_efold)**1.5)*a2* & + ! Note: In Beljaars et al. (2004): + ! alpha_fd*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + ! lump beta*Cmd*Ccorr*2.109 into 1.*0.005*0.6*2.109 = coeff_fd ~ 6.325e-3_kind_phys + var_temp = alpha_fd*coeff_fd*EXP(-(zl(i,k)/H_efold)**1.5)*a2* & zl(i,k)**(-1.2)*ss_taper(i) ! this is greater than zero ! Note: This is a semi-implicit treatment of the time differencing ! per Beljaars et al. (2004, QJRMS) @@ -1414,6 +1412,1231 @@ subroutine drag_suite_run( & return end subroutine drag_suite_run !------------------------------------------------------------------- + + subroutine drag_suite_psl( & + & IM,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, & + & PRSI,DEL,PRSL,PRSLK,PHII,PHIL,DELTIM,KDT, & + & var,oc1,oa4,ol4, & + & varss,oc1ss,oa4ss,ol4ss, & + & THETA,SIGMA,GAMMA,ELVMAX, & + & dtaux2d_ls,dtauy2d_ls,dtaux2d_bl,dtauy2d_bl, & + & dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd, & + & dusfc,dvsfc, & + & dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & + & dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & + & slmsk,br1,hpbl,vtype, & + & g, cp, rd, rv, fv, pi, imx, cdmbgwd, alpha_fd, & + & me, master, lprnt, ipr, rdxzb, dx, gwd_opt, & + & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & + & psl_gwd_dx_factor, & + & dtend, dtidx, index_of_process_orographic_gwd, & + & index_of_temperature, index_of_x_wind, & + & index_of_y_wind, ldiag3d, ldiag_ugwp, ugwp_seq_update, & + & spp_wts_gwd, spp_gwd, errmsg, errflg) + +! ******************************************************************** +! -----> I M P L E M E N T A T I O N V E R S I O N <---------- +! +! ----- This code ----- +!begin WRF code + +! this code handles the time tendencies of u v due to the effect of mountain +! induced gravity wave drag from sub-grid scale orography. this routine +! not only treats the traditional upper-level wave breaking due to mountain +! variance (alpert 1988), but also the enhanced lower-tropospheric wave +! breaking due to mountain convexity and asymmetry (kim and arakawa 1995). +! thus, in addition to the terrain height data in a model grid box, +! additional 10-2d topographic statistics files are needed, including +! orographic standard deviation (var), convexity (oc1), asymmetry (oa4) +! and ol (ol4). these data sets are prepared based on the 30 sec usgs orography +! hong (1999). the current scheme was implmented as in hong et al.(2008) +! +! Originally coded by song-you hong and young-joon kim and implemented by song-you hong +! +! program history log: +! 2014-10-01 Hyun-Joo Choi (from KIAPS) flow-blocking drag of kim and doyle +! with blocked height by dividing streamline theory +! 2017-04-06 Joseph Olson (from Gert-Jan Steeneveld) added small-scale +! orographic grabity wave drag: +! 2017-09-15 Joseph Olson, with some bug fixes from Michael Toy: added the +! topographic form drag of Beljaars et al. (2004, QJRMS) +! Activation of each component is done by specifying the integer-parameters +! (defined below) to 0: inactive or 1: active +! gwd_opt_ls = 0 or 1: large-scale +! gwd_opt_bl = 0 or 1: blocking drag +! gwd_opt_ss = 0 or 1: small-scale gravity wave drag +! gwd_opt_fd = 0 or 1: topographic form drag +! 2017-09-25 Michael Toy (from NCEP GFS model) added dissipation heating +! gsd_diss_ht_opt = 0: dissipation heating off +! gsd_diss_ht_opt = 1: dissipation heating on +! 2020-08-25 Michael Toy changed logic control for drag component selection +! for CCPP. +! Namelist options: +! do_gsl_drag_ls_bl - logical flag for large-scale GWD + blocking +! do_gsl_drag_ss - logical flag for small-scale GWD +! do_gsl_drag_tofd - logical flag for turbulent form drag +! Compile-time options (same as before): +! gwd_opt_ls = 0 or 1: large-scale GWD +! gwd_opt_bl = 0 or 1: blocking drag +! +! References: +! Choi and Hong (2015) J. Geophys. Res. +! Hong et al. (2008), wea. and forecasting +! Kim and Doyle (2005), Q. J. R. Meteor. Soc. +! Kim and Arakawa (1995), j. atmos. sci. +! Alpert et al. (1988), NWP conference. +! Hong (1999), NCEP office note 424. +! Steeneveld et al (2008), JAMC +! Tsiringakis et al. (2017), Q. J. R. Meteor. Soc. +! Beljaars et al. (2004), Q. J. R. Meteor. Soc. +! +! notice : comparible or lower resolution orography files than model resolution +! are desirable in preprocess (wps) to prevent weakening of the drag +!------------------------------------------------------------------------------- +! +! input +! dudt (im,km) non-lin tendency for u wind component +! dvdt (im,km) non-lin tendency for v wind component +! u1(im,km) zonal wind / sqrt(rcl) m/sec at t0-dt +! v1(im,km) meridional wind / sqrt(rcl) m/sec at t0-dt +! t1(im,km) temperature deg k at t0-dt +! q1(im,km) specific humidity at t0-dt +! deltim time step secs +! del(km) positive increment of pressure across layer (pa) +! KPBL(IM) is the index of the top layer of the PBL +! ipr & lprnt for diagnostics +! +! output +! dudt, dvdt wind tendency due to gwdo +! dTdt +! +!------------------------------------------------------------------------------- + +!end wrf code +!----------------------------------------------------------------------C +! USE +! ROUTINE IS CALLED FROM CCPP (AFTER CALLING PBL SCHEMES) +! +! PURPOSE +! USING THE GWD PARAMETERIZATIONS OF PS-GLAS AND PH- +! GFDL TECHNIQUE. THE TIME TENDENCIES OF U V +! ARE ALTERED TO INCLUDE THE EFFECT OF MOUNTAIN INDUCED +! GRAVITY WAVE DRAG FROM SUB-GRID SCALE OROGRAPHY INCLUDING +! CONVECTIVE BREAKING, SHEAR BREAKING AND THE PRESENCE OF +! CRITICAL LEVELS +! +! +! ******************************************************************** + USE MACHINE , ONLY : kind_phys + implicit none + + ! Interface variables + integer, intent(in) :: im, km, imx, kdt, ipr, me, master + integer, intent(in) :: gwd_opt + logical, intent(in) :: lprnt + integer, intent(in) :: KPBL(:) + real(kind=kind_phys), intent(in) :: deltim, G, CP, RD, RV, & + & cdmbgwd(:), alpha_fd + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + logical, intent(in) :: ldiag3d + integer, intent(in) :: dtidx(:,:), index_of_temperature, & + & index_of_process_orographic_gwd, index_of_x_wind, index_of_y_wind + + integer :: kpblmax + integer, parameter :: ims=1, kms=1, its=1, kts=1 + real(kind=kind_phys), intent(in) :: fv, pi + real(kind=kind_phys) :: rcl, cdmb + real(kind=kind_phys) :: g_inv, g_cp, rd_inv + + real(kind=kind_phys), intent(inout) :: & + & dudt(:,:),dvdt(:,:), & + & dtdt(:,:) + real(kind=kind_phys), intent(out) :: rdxzb(:) + real(kind=kind_phys), intent(in) :: & + & u1(:,:),v1(:,:), & + & t1(:,:),q1(:,:), & + & PHII(:,:),prsl(:,:), & + & prslk(:,:),PHIL(:,:) + real(kind=kind_phys), intent(in) :: prsi(:,:), & + & del(:,:) + real(kind=kind_phys), intent(in) :: var(:),oc1(:), & + & oa4(:,:),ol4(:,:), & + & dx(:) + real(kind=kind_phys), intent(in) :: varss(:),oc1ss(:), & + & oa4ss(:,:),ol4ss(:,:) + real(kind=kind_phys), intent(in) :: THETA(:),SIGMA(:), & + & GAMMA(:),ELVMAX(:) + +! added for small-scale orographic wave drag + real(kind=kind_phys), dimension(im,km) :: utendwave,vtendwave,thx,thvx + integer, intent(in) :: vtype(:) + real(kind=kind_phys), intent(in) :: br1(:), & + & hpbl(:), & + & slmsk(:) + real(kind=kind_phys), dimension(im) :: govrth,xland + !real(kind=kind_phys), dimension(im,km) :: dz2 + real(kind=kind_phys) :: tauwavex0,tauwavey0, & + & XNBV,density,tvcon,hpbl2 + integer :: kpbl2,kvar + !real(kind=kind_phys), dimension(im,km+1) :: zq ! = PHII/g + real(kind=kind_phys), dimension(im,km) :: zl ! = PHIL/g + +!SPP + real(kind=kind_phys), dimension(im) :: var_stoch, varss_stoch, & + varmax_ss_stoch, varmax_fd_stoch + real(kind=kind_phys), intent(in), optional :: spp_wts_gwd(:,:) + integer, intent(in) :: spp_gwd + + real(kind=kind_phys), dimension(im) :: rstoch + +!Output: + real(kind=kind_phys), intent(out) :: & + & dusfc(:), dvsfc(:) +!Output (optional): + real(kind=kind_phys), intent(out), optional :: & + & dusfc_ls(:),dvsfc_ls(:), & + & dusfc_bl(:),dvsfc_bl(:), & + & dusfc_ss(:),dvsfc_ss(:), & + & dusfc_fd(:),dvsfc_fd(:) + real(kind=kind_phys), intent(out), optional :: & + & dtaux2d_ls(:,:),dtauy2d_ls(:,:), & + & dtaux2d_bl(:,:),dtauy2d_bl(:,:), & + & dtaux2d_ss(:,:),dtauy2d_ss(:,:), & + & dtaux2d_fd(:,:),dtauy2d_fd(:,:) + +!Misc arrays + real(kind=kind_phys), dimension(im,km) :: dtaux2d, dtauy2d + +!------------------------------------------------------------------------- +! Flags to regulate the activation of specific components of drag suite: +! Each component is tapered off automatically as a function of dx, so best to +! keep them activated (.true.). + logical, intent(in) :: & + do_gsl_drag_ls_bl, & ! large-scale gravity wave drag and blocking + do_gsl_drag_ss, & ! small-scale gravity wave drag (Steeneveld et al. 2008) + do_gsl_drag_tofd ! form drag (Beljaars et al. 2004, QJRMS) +! Flag for diagnostic outputs + logical, intent(in) :: ldiag_ugwp + +! Flag for sequential update of u and v between +! LSGWD + BLOCKING and SSGWD + TOFD calculations + logical, intent(in) :: ugwp_seq_update +! +! Additional flags + integer, parameter :: & + gwd_opt_ls = 1, & ! large-scale gravity wave drag + gwd_opt_bl = 1, & ! blocking drag + gsd_diss_ht_opt = 0 + +! Parameters for bounding the scale-adaptive variability: +! Small-scale GWD + turbulent form drag + real(kind=kind_phys), parameter :: dxmin_ss = 1000., & + & dxmax_ss = 12000. ! min,max range of tapering (m) +! Large-scale GWD + blocking + real(kind=kind_phys), parameter :: dxmin_ls = 3000., & + & dxmax_ls = 13000. ! min,max range of tapering (m) + real(kind=kind_phys), dimension(im) :: ss_taper, ls_taper ! small- and large-scale tapering factors (-) +! +! Variables for limiting topographic standard deviation (var) + real(kind=kind_phys), parameter :: varmax_ss = 50., & + varmax_fd = 150., & + beta_ss = 0.1, & + beta_fd = 0.2 + real(kind=kind_phys) :: var_temp, var_temp2 + +! added Beljaars orographic form drag + real(kind=kind_phys), dimension(im,km) :: utendform,vtendform + real(kind=kind_phys) :: a1,a2,wsp + real(kind=kind_phys) :: H_efold + real(kind=kind_phys), parameter :: coeff_fd = 6.325e-3 + +! multification factor of standard deviation : ! larger drag with larger value +!!! real(kind=kind_phys), parameter :: psl_gwd_dx_factor = 6.0 + real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor + +! critical richardson number for wave breaking : ! larger drag with larger value + real(kind=kind_phys), parameter :: ric = 0.25 + real(kind=kind_phys), parameter :: dw2min = 1. + real(kind=kind_phys), parameter :: rimin = -100. + real(kind=kind_phys), parameter :: bnv2min = 1.0e-5 + real(kind=kind_phys), parameter :: efmin = 0.0 + real(kind=kind_phys), parameter :: efmax = 10.0 + real(kind=kind_phys), parameter :: xl = 4.0e4 + real(kind=kind_phys), parameter :: critac = 1.0e-5 + real(kind=kind_phys), parameter :: gmax = 1. + real(kind=kind_phys), parameter :: veleps = 1.0 + real(kind=kind_phys), parameter :: factop = 0.5 + real(kind=kind_phys), parameter :: frc = 1.0 + real(kind=kind_phys), parameter :: ce = 0.8 + real(kind=kind_phys), parameter :: cg = 1.0 +! real(kind=kind_phys), parameter :: var_min = 100.0 + real(kind=kind_phys), parameter :: var_min = 10.0 + real(kind=kind_phys), parameter :: hmt_min = 50. + real(kind=kind_phys), parameter :: oc_min = 1.0 + real(kind=kind_phys), parameter :: oc_max = 10.0 +! 7.5 mb -- 33 km ... 0.01 kgm-3 reduce gwd drag above cutoff level + real(kind=kind_phys), parameter :: pcutoff = 7.5e2 +! 0.76 mb -- 50 km ...0.001 kgm-3 --- 0.1 mb 65 km 0.0001 kgm-3 + real(kind=kind_phys), parameter :: pcutoff_den = 0.01 ! + + integer,parameter :: kpblmin = 2 + +! +! local variables +! + integer :: i,j,k,lcap,lcapp1,nwd,idir, & + klcap,kp1 +! + real(kind=kind_phys) :: rcs,csg,fdir,cs, & + rcsks,wdir,ti,rdz,tem2,dw2,shr2, & + bvf2,rdelks,wtkbj,tem,gfobnv,hd,fro, & + rim,temc,tem1,efact,temv,dtaux,dtauy, & + dtauxb,dtauyb,eng0,eng1 + real(kind=kind_phys) :: denfac +! + logical :: ldrag(im),icrilv(im), & + flag(im) +! + real(kind=kind_phys) :: invgrcs +! + real(kind=kind_phys) :: taub(im),taup(im,km+1), & + xn(im),yn(im), & + ubar(im),vbar(im), & + fr(im),ulow(im), & + rulow(im),bnv(im), & + oa(im),ol(im),oc(im), & + oass(im),olss(im), & + roll(im),dtfac(im,km), & + brvf(im),xlinv(im), & + delks(im),delks1(im), & + bnv2(im,km),usqj(im,km), & + taud_ls(im,km),taud_bl(im,km), & + ro(im,km), & + vtk(im,km),vtj(im,km), & + zlowtop(im),velco(im,km-1), & + coefm(im),coefm_ss(im) + real(kind=kind_phys) :: cleff(im),cleff_ss(im) +! + integer :: kbl(im),klowtop(im) + integer,parameter :: mdir=8 + !integer :: nwdir(mdir) + !data nwdir/6,7,5,8,2,3,1,4/ + integer, parameter :: nwdir(8) = (/6,7,5,8,2,3,1,4/) +! +! variables for flow-blocking drag +! + real(kind=kind_phys),parameter :: frmax = 10. + real(kind=kind_phys),parameter :: olmin = 1.e-5 + real(kind=kind_phys),parameter :: odmin = 0.1 + real(kind=kind_phys),parameter :: odmax = 10. + real(kind=kind_phys),parameter :: cdmin = 0.0 + integer :: komax(im),kbmax(im),kblk(im) + real(kind=kind_phys) :: href(im),hmax(im) + real(kind=kind_phys) :: cd + real(kind=kind_phys) :: zblk,tautem + real(kind=kind_phys) :: pe,ke + real(kind=kind_phys) :: delx,dely + real(kind=kind_phys) :: dxy4(im,4),dxy4p(im,4) + real(kind=kind_phys) :: dxy(im),dxyp(im) + real(kind=kind_phys) :: ol4p(4),olp(im),od(im) + real(kind=kind_phys) :: taufb(im,km+1) + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: udtend, vdtend, Tdtend + + ! Calculate inverse of gravitational acceleration + g_inv = 1./G + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Initialize local variables + var_temp2 = 0. + udtend = -1 + vdtend = -1 + Tdtend = -1 + + if(ldiag3d) then + udtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) + vdtend = dtidx(index_of_y_wind,index_of_process_orographic_gwd) + Tdtend = dtidx(index_of_temperature,index_of_process_orographic_gwd) + endif +! +!---- constants +! + rcl = 1. + rcs = sqrt(rcl) + cs = 1. / sqrt(rcl) + csg = cs * g + lcap = km + lcapp1 = lcap + 1 + fdir = mdir / (2.0*pi) + invgrcs = 1._kind_phys/g*rcs + kpblmax = km / 2 ! maximum pbl height : # of vertical levels / 2 + denfac = 1.0 + + do i=1,im + if (slmsk(i)==1. .or. slmsk(i)==2.) then !sea/land/ice mask (=0/1/2) in FV3 + xland(i)=1.0 !but land/water = (1/2) in this module + else + xland(i)=2.0 + endif + RDXZB(i) = 0.0 + enddo + +!--- calculate scale-aware tapering factors + do i=1,im + if ( dx(i) .ge. dxmax_ls ) then + ls_taper(i) = 1. + else + if ( dx(i) .le. dxmin_ls) then + ls_taper(i) = 0. + else + ls_taper(i) = 0.5 * ( SIN(pi*(dx(i)-0.5*(dxmax_ls+dxmin_ls))/ & + (dxmax_ls-dxmin_ls)) + 1. ) + endif + endif + enddo + + ! Remove ss_tapering + ss_taper(:) = 1. + + ! SPP, if spp_gwd is 0, no perturbations are applied. + if ( spp_gwd==1 ) then + do i = its,im + var_stoch(i) = var(i) + var(i)*0.75*spp_wts_gwd(i,1) + varss_stoch(i) = varss(i) + varss(i)*0.75*spp_wts_gwd(i,1) + varmax_ss_stoch(i) = varmax_ss + varmax_ss*0.75*spp_wts_gwd(i,1) + varmax_fd_stoch(i) = varmax_fd + varmax_fd*0.75*spp_wts_gwd(i,1) + enddo + else + do i = its,im + var_stoch(i) = var(i) + varss_stoch(i) = varss(i) + varmax_ss_stoch(i) = varmax_ss + varmax_fd_stoch(i) = varmax_fd + enddo + endif + + !--- calculate length of grid for flow-blocking drag + ! + do i=1,im + delx = dx(i) + dely = dx(i) + dxy4(i,1) = delx + dxy4(i,2) = dely + dxy4(i,3) = sqrt(delx*delx + dely*dely) + dxy4(i,4) = dxy4(i,3) + dxy4p(i,1) = dxy4(i,2) + dxy4p(i,2) = dxy4(i,1) + dxy4p(i,3) = dxy4(i,4) + dxy4p(i,4) = dxy4(i,3) + cleff(i) = psl_gwd_dx_factor*(delx+dely)*0.5 + cleff_ss(i) = 0.1 * max(dxmax_ss,dxy4(i,3)) + ! cleff_ss(i) = cleff(i) ! consider ..... + enddo +! +!-----initialize arrays +! + dtaux = 0.0 + dtauy = 0.0 + do i = its,im + klowtop(i) = 0 + kbl(i) = 0 + enddo +! + do i = its,im + xn(i) = 0.0 + yn(i) = 0.0 + ubar (i) = 0.0 + vbar (i) = 0.0 + roll (i) = 0.0 + taub (i) = 0.0 + oa(i) = 0.0 + ol(i) = 0.0 + oc(i) = 0.0 + oass(i) = 0.0 + olss(i) = 0.0 + ulow (i) = 0.0 + rstoch(i) = 0.0 + ldrag(i) = .false. + icrilv(i) = .false. + enddo + + do k = kts,km + do i = its,im + usqj(i,k) = 0.0 + bnv2(i,k) = 0.0 + vtj(i,k) = 0.0 + vtk(i,k) = 0.0 + taup(i,k) = 0.0 + taud_ls(i,k) = 0.0 + taud_bl(i,k) = 0.0 + dtaux2d(i,k) = 0.0 + dtauy2d(i,k) = 0.0 + dtfac(i,k) = 1.0 + enddo + enddo +! + if ( ldiag_ugwp ) then + do i = its,im + dusfc_ls(i) = 0.0 + dvsfc_ls(i) = 0.0 + dusfc_bl(i) = 0.0 + dvsfc_bl(i) = 0.0 + dusfc_ss(i) = 0.0 + dvsfc_ss(i) = 0.0 + dusfc_fd(i) = 0.0 + dvsfc_fd(i) = 0.0 + enddo + do k = kts,km + do i = its,im + dtaux2d_ls(i,k)= 0.0 + dtauy2d_ls(i,k)= 0.0 + dtaux2d_bl(i,k)= 0.0 + dtauy2d_bl(i,k)= 0.0 + dtaux2d_ss(i,k)= 0.0 + dtauy2d_ss(i,k)= 0.0 + dtaux2d_fd(i,k)= 0.0 + dtauy2d_fd(i,k)= 0.0 + enddo + enddo + endif + + do i = its,im + taup(i,km+1) = 0.0 + xlinv(i) = 1.0/xl + dusfc(i) = 0.0 + dvsfc(i) = 0.0 + enddo +! +! initialize array for flow-blocking drag +! + taufb(1:im,1:km+1) = 0.0 + href(1:im) = 0.0 + hmax(1:im) = 0.0 + komax(1:im) = 0 + kbmax(1:im) = 0 + kblk(1:im) = 0 +! + rd_inv = 1./rd + do k = kts,km + do i = its,im + vtj(i,k) = t1(i,k) * (1.+fv*q1(i,k)) + vtk(i,k) = vtj(i,k) / prslk(i,k) + ro(i,k) = rd_inv * prsl(i,k) / vtj(i,k) ! density kg/m**3 + enddo + enddo +! +! calculate mid-layer height (zl), interface height (zq), and layer depth (dz2). +! + !zq=0. + do k = kts,km + do i = its,im + !zq(i,k+1) = PHII(i,k+1)*g_inv + !dz2(i,k) = (PHII(i,k+1)-PHII(i,k))*g_inv + zl(i,k) = PHIL(i,k)*g_inv + enddo + enddo +! +! determine reference level: maximum of 2*var and pbl heights +! + do i = its,im + if(vtype(i)==15) then + zlowtop(i) = 1.0 * var_stoch(i) !!! reduce drag over land ice + else + zlowtop(i) = 2.0 * var_stoch(i) + endif + enddo +! + do i = its,im + flag(i) = .true. + enddo +! + do k = kts+1,km + do i = its,im + if(flag(i).and.zl(i,k).ge.zlowtop(i)) then + klowtop(i) = k+1 + flag(i) = .false. + endif + enddo + enddo +! +! determine the maximum height level +! note taht elvmax and zl are the heights from the model surface whereas +! oro (mean orography) is the height from the sea level +! + do i = its,im + flag(i) = .true. + enddo +! + do k = kts+1,km + do i = its,im + if(flag(i).and.zl(i,k).ge.elvmax(i)) then + komax(i) = k+1 + flag(i) = .false. + endif + enddo + enddo +! +! determine the launching level in determining blocking layer +! + do i = its,im + flag(i) = .true. + enddo +! + do k = kts+1,km + do i = its,im + if(flag(i).and.zl(i,k).ge.elvmax(i)+zlowtop(i)) then + kbmax(i) = k+1 + flag(i) = .false. + endif + enddo + enddo +! +! determing the reference level for gwd and blockding... +! + do i = its,im + hmax(i) = max(elvmax(i),zlowtop(i)) + href(i) = max(hmax(i),hpbl(i)) + enddo +! + do i = its,im +!!! kbl(i) = max(kpbl(i), klowtop(i)) ! do not use pbl height for the time being... + kbl(i) = max(komax(i), klowtop(i)) + kbl(i) = max(kbl(i), kpbl(i)) + kbl(i) = max(min(kbl(i),kpblmax),kpblmin) + enddo +! +! compute low level averages below reference level +! + do i = its,im + delks(i) = 1.0 / (prsi(i,1) - prsi(i,kbl(i))) + delks1(i) = 1.0 / (prsl(i,1) - prsl(i,kbl(i))) + enddo + do k = kts,kpblmax + do i = its,im + if (k.lt.kbl(i)) then + rcsks = rcs * del(i,k) * delks(i) + rdelks = del(i,k) * delks(i) + ubar(i) = ubar(i) + rcsks * u1(i,k) ! pbl u mean + vbar(i) = vbar(i) + rcsks * v1(i,k) ! pbl v mean + roll(i) = roll(i) + rdelks * ro(i,k) ! ro mean + endif + enddo + enddo +! +! figure out low-level horizontal wind direction +! +! nwd 1 2 3 4 5 6 7 8 +! wd w s sw nw e n ne se +! + do i = its,im + wdir = atan2(ubar(i),vbar(i)) + pi + idir = mod(nint(fdir*wdir),mdir) + 1 + nwd = nwdir(idir) + oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(i,mod(nwd-1,4)+1) + ol(i) = max(ol4(i,mod(nwd-1,4)+1),olmin) + oc(i) = min(max(oc1(i),oc_min),oc_max) +! if (var(i).le.var_min) then +! oc(i) = max(oc(i)*var(i)/var_min,oc_min) +! endif + ! Repeat for small-scale gwd + oass(i) = (1-2*int( (nwd-1)/4 )) * oa4ss(i,mod(nwd-1,4)+1) + olss(i) = ol4ss(i,mod(nwd-1,4)+1) + +! +!----- compute orographic width along (ol) and perpendicular (olp) +!----- the direction of wind +! + ol4p(1) = ol4(i,2) + ol4p(2) = ol4(i,1) + ol4p(3) = ol4(i,4) + ol4p(4) = ol4(i,3) + olp(i) = max(ol4p(mod(nwd-1,4)+1),olmin) +! +!----- compute orographic direction (horizontal orographic aspect ratio) +! + od(i) = olp(i)/ol(i) + od(i) = min(od(i),odmax) + od(i) = max(od(i),odmin) +! +!----- compute length of grid in the along(dxy) and cross(dxyp) wind directions +! + dxy(i) = dxy4(i,MOD(nwd-1,4)+1) + dxyp(i) = dxy4p(i,MOD(nwd-1,4)+1) + enddo +! +! END INITIALIZATION; BEGIN GWD CALCULATIONS: +! +IF ( (do_gsl_drag_ls_bl).and. & + ((gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1)) ) then + + g_cp = g/cp + do i=its,im + + if ( ls_taper(i).GT.1.E-02 ) then + +! +!--- saving richardson number in usqj for migwdi +! + do k = kts,km-1 + ti = 2.0 / (t1(i,k)+t1(i,k+1)) + rdz = 1./(zl(i,k+1) - zl(i,k)) + tem1 = u1(i,k) - u1(i,k+1) + tem2 = v1(i,k) - v1(i,k+1) + dw2 = rcl*(tem1*tem1 + tem2*tem2) + shr2 = max(dw2,dw2min) * rdz * rdz + bvf2 = g*(g_cp+rdz*(vtj(i,k+1)-vtj(i,k))) * ti + usqj(i,k) = max(bvf2/shr2,rimin) + bnv2(i,k) = 2.0*g*rdz*(vtk(i,k+1)-vtk(i,k))/(vtk(i,k+1)+vtk(i,k)) + bnv2(i,k) = max( bnv2(i,k), bnv2min ) + enddo +! +!----compute the "low level" or 1/3 wind magnitude (m/s) +! + ulow(i) = max(sqrt(ubar(i)*ubar(i) + vbar(i)*vbar(i)), 1.0) + rulow(i) = 1./ulow(i) +! + do k = kts,km-1 + velco(i,k) = (0.5*rcs) * ((u1(i,k)+u1(i,k+1)) * ubar(i) & + + (v1(i,k)+v1(i,k+1)) * vbar(i)) + velco(i,k) = velco(i,k) * rulow(i) + if ((velco(i,k).lt.veleps) .and. (velco(i,k).gt.0.)) then + velco(i,k) = veleps + endif + enddo +! +! no drag when sub-oro is too small.. +! + ldrag(i) = href(i).le.hmt_min +! +! no drag when critical level in the base layer +! + ldrag(i) = ldrag(i).or. velco(i,1).le.0. +! +! no drag when velco.lt.0 +! + do k = kpblmin,kpblmax + if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. velco(i,k).le.0. + enddo +! +! no drag when bnv2.lt.0 +! + do k = kts,kpblmax + if (k .lt. kbl(i)) ldrag(i) = ldrag(i).or. bnv2(i,k).lt.0. + enddo +! +!-----the low level weighted average ri is stored in usqj(1,1; im) +!-----the low level weighted average n**2 is stored in bnv2(1,1; im) +!---- this is called bnvl2 in phys_gwd_alpert_sub not bnv2 +!---- rdelks (del(k)/delks) vert ave factor so we can * instead of / +! + wtkbj = (prsl(i,1)-prsl(i,2)) * delks1(i) + bnv2(i,1) = wtkbj * bnv2(i,1) + usqj(i,1) = wtkbj * usqj(i,1) +! + do k = kpblmin,kpblmax + if (k .lt. kbl(i)) then + rdelks = (prsl(i,k)-prsl(i,k+1)) * delks1(i) + bnv2(i,1) = bnv2(i,1) + bnv2(i,k) * rdelks + usqj(i,1) = usqj(i,1) + usqj(i,k) * rdelks + endif + enddo +! + ldrag(i) = ldrag(i) .or. bnv2(i,1).le.0.0 + ldrag(i) = ldrag(i) .or. ulow(i).eq.1.0 + ldrag(i) = ldrag(i) .or. var_stoch(i) .le. 0.0 + ldrag(i) = ldrag(i) .or. xland(i) .gt. 1.5 +! +! set all ri low level values to the low level value +! + do k = kpblmin,kpblmax + if (k .lt. kbl(i)) usqj(i,k) = usqj(i,1) + enddo +! + if (.not.ldrag(i)) then + bnv(i) = sqrt( bnv2(i,1) ) + fr(i) = bnv(i) * rulow(i) * 2. * var_stoch(i) * od(i) + fr(i) = min(fr(i),frmax) + xn(i) = ubar(i) * rulow(i) + yn(i) = vbar(i) * rulow(i) + endif +! +! compute the base level stress and store it in taub +! calculate enhancement factor, number of mountains & aspect +! ratio const. use simplified relationship between standard +! deviation & critical hgt + + if (.not. ldrag(i)) then + efact = (oa(i) + 2.) ** (ce*fr(i)/frc) + efact = min( max(efact,efmin), efmax ) + coefm(i) = (1. + ol(i)) ** (oa(i)+1.) + xlinv(i) = coefm(i) / cleff(i) + tem = fr(i) * fr(i) * oc(i) + gfobnv = gmax * tem / ((tem + cg)*bnv(i)) + if ( gwd_opt_ls .NE. 0 ) then + taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) & + * ulow(i) * gfobnv * efact + else ! We've gotten what we need for the blocking scheme + taub(i) = 0.0 + end if + else + taub(i) = 0.0 + xn(i) = 0.0 + yn(i) = 0.0 + endif + + endif ! (ls_taper(i).GT.1.E-02) + + enddo ! do i=its,im + +ENDIF ! (do_gsl_drag_ls_bl).and.((gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1)) + +!========================================================= +! add small-scale wavedrag for stable boundary layer +!========================================================= + XNBV=0. + tauwavex0=0. + tauwavey0=0. + density=1.2 + utendwave=0. + vtendwave=0. +! +IF ( do_gsl_drag_ss ) THEN + + do i=its,im + + if ( ss_taper(i).GT.1.E-02 ) then + ! + ! calculating potential temperature + ! + do k = kts,km + thx(i,k) = t1(i,k)/prslk(i,k) + enddo + ! + do k = kts,km + tvcon = (1.+fv*q1(i,k)) + thvx(i,k) = thx(i,k)*tvcon + enddo + + hpbl2 = hpbl(i)+10. + kpbl2 = kpbl(i) + !kvar = MIN(kpbl, k-level of var) + kvar = 1 + do k=kts+1,MAX(kpbl(i),kts+1) +! IF (zl(i,k)>2.*var(i) .or. zl(i,k)>2*varmax) then + IF (zl(i,k)>300.) then + kpbl2 = k + IF (k == kpbl(i)) then + hpbl2 = hpbl(i)+10. + ELSE + hpbl2 = zl(i,k)+10. + ENDIF + exit + ENDIF + enddo + if((xland(i)-1.5).le.0. .and. 2.*varss_stoch(i).le.hpbl(i))then + if(br1(i).gt.0. .and. thvx(i,kpbl2)-thvx(i,kts) > 0.)then + coefm_ss(i) = (1. + olss(i)) ** (oass(i)+1.) + xlinv(i) = coefm_ss(i) / cleff_ss(i) + !govrth(i)=g/(0.5*(thvx(i,kpbl(i))+thvx(i,kts))) + govrth(i)=g/(0.5*(thvx(i,kpbl2)+thvx(i,kts))) + !XNBV=sqrt(govrth(i)*(thvx(i,kpbl(i))-thvx(i,kts))/hpbl(i)) + XNBV=sqrt(govrth(i)*(thvx(i,kpbl2)-thvx(i,kts))/hpbl2) +! + !if(abs(XNBV/u1(i,kpbl(i))).gt.xlinv(i))then + if(abs(XNBV/u1(i,kpbl2)).gt.xlinv(i))then + !tauwavex0=0.5*XNBV*xlinv(i)*(2*MIN(varss(i),75.))**2*ro(i,kts)*u1(i,kpbl(i)) + !tauwavex0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*u1(i,kpbl2) + !tauwavex0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*u1(i,3) + ! Remove limit on varss_stoch + var_temp = varss_stoch(i) + ! Note: This is a semi-implicit treatment of the time differencing + var_temp2 = 0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar) ! this is greater than zero + tauwavex0=var_temp2*u1(i,kvar)/(1.+var_temp2*deltim) + tauwavex0=tauwavex0*ss_taper(i) + else + tauwavex0=0. + endif +! + !if(abs(XNBV/v1(i,kpbl(i))).gt.xlinv(i))then + if(abs(XNBV/v1(i,kpbl2)).gt.xlinv(i))then + !tauwavey0=0.5*XNBV*xlinv(i)*(2*MIN(varss(i),75.))**2*ro(i,kts)*v1(i,kpbl(i)) + !tauwavey0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*v1(i,kpbl2) + !tauwavey0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*v1(i,3) + ! Remove limit on varss_stoch + var_temp = varss_stoch(i) + ! Note: This is a semi-implicit treatment of the time differencing + var_temp2 = 0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar) ! this is greater than zero + tauwavey0=var_temp2*v1(i,kvar)/(1.+var_temp2*deltim) + tauwavey0=tauwavey0*ss_taper(i) + else + tauwavey0=0. + endif + + do k=kts,kpbl(i) !MIN(kpbl2+1,km-1) +!original + !utendwave(i,k)=-1.*tauwavex0*2.*max((1.-zl(i,k)/hpbl(i)),0.)/hpbl(i) + !vtendwave(i,k)=-1.*tauwavey0*2.*max((1.-zl(i,k)/hpbl(i)),0.)/hpbl(i) +!new + utendwave(i,k)=-1.*tauwavex0*2.*max((1.-zl(i,k)/hpbl2),0.)/hpbl2 + vtendwave(i,k)=-1.*tauwavey0*2.*max((1.-zl(i,k)/hpbl2),0.)/hpbl2 +!mod-to be used in HRRRv3/RAPv4 + !utendwave(i,k)=-1.*tauwavex0 * max((1.-zl(i,k)/hpbl2),0.)**2 + !vtendwave(i,k)=-1.*tauwavey0 * max((1.-zl(i,k)/hpbl2),0.)**2 + enddo + endif + endif + + do k = kts,km + dudt(i,k) = dudt(i,k) + utendwave(i,k) + dvdt(i,k) = dvdt(i,k) + vtendwave(i,k) + dusfc(i) = dusfc(i) + utendwave(i,k) * del(i,k) + dvsfc(i) = dvsfc(i) + vtendwave(i,k) * del(i,k) + enddo + if(udtend>0) then + dtend(i,kts:km,udtend) = dtend(i,kts:km,udtend) + utendwave(i,kts:km)*deltim + endif + if(vdtend>0) then + dtend(i,kts:km,vdtend) = dtend(i,kts:km,vdtend) + vtendwave(i,kts:km)*deltim + endif + if ( ldiag_ugwp ) then + do k = kts,km + dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) + dvsfc_ss(i) = dvsfc_ss(i) + vtendwave(i,k) * del(i,k) + dtaux2d_ss(i,k) = utendwave(i,k) + dtauy2d_ss(i,k) = vtendwave(i,k) + enddo + endif + + endif ! if (ss_taper(i).GT.1.E-02) + + enddo ! i=its,im + +ENDIF ! if (do_gsl_drag_ss) + +!================================================================ +! Topographic Form Drag from Beljaars et al. (2004, QJRMS, equ. 16): +!================================================================ +IF ( do_gsl_drag_tofd ) THEN + + do i=its,im + + if ( ss_taper(i).GT.1.E-02 ) then + + utendform=0. + vtendform=0. + + IF ((xland(i)-1.5) .le. 0.) then + !(IH*kflt**n1)**-1 = (0.00102*0.00035**-1.9)**-1 = 0.00026615161 + ! Remove limit on varss_stoch + var_temp = varss_stoch(i) + !var_temp = MIN(var_temp, 250.) + a1=0.00026615161*var_temp**2 +! a1=0.00026615161*MIN(varss(i),varmax)**2 +! a1=0.00026615161*(0.5*varss(i))**2 + ! k1**(n1-n2) = 0.003**(-1.9 - -2.8) = 0.003**0.9 = 0.005363 + a2=a1*0.005363 + ! Beljaars H_efold + H_efold = 1500. + DO k=kts,km + wsp=SQRT(u1(i,k)**2 + v1(i,k)**2) + ! Note: In Beljaars et al. (2004): + ! alpha_fd*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + ! lump beta*Cmd*Ccorr*2.109 into 1.*0.005*0.6*2.109 = coeff_fd ~ 6.325e-3_kind_phys + var_temp = alpha_fd*coeff_fd*EXP(-(zl(i,k)/H_efold)**1.5)*a2* & + zl(i,k)**(-1.2)*ss_taper(i) ! this is greater than zero + ! Note: This is a semi-implicit treatment of the time differencing + ! per Beljaars et al. (2004, QJRMS) + utendform(i,k) = - var_temp*wsp*u1(i,k)/(1. + var_temp*deltim*wsp) + vtendform(i,k) = - var_temp*wsp*v1(i,k)/(1. + var_temp*deltim*wsp) + !IF(zl(i,k) > 4000.) exit + ENDDO + ENDIF + + do k = kts,km + dudt(i,k) = dudt(i,k) + utendform(i,k) + dvdt(i,k) = dvdt(i,k) + vtendform(i,k) + dusfc(i) = dusfc(i) + utendform(i,k) * del(i,k) + dvsfc(i) = dvsfc(i) + vtendform(i,k) * del(i,k) + enddo + if(udtend>0) then + dtend(i,kts:km,udtend) = dtend(i,kts:km,udtend) + utendform(i,kts:km)*deltim + endif + if(vdtend>0) then + dtend(i,kts:km,vdtend) = dtend(i,kts:km,vdtend) + vtendform(i,kts:km)*deltim + endif + if ( ldiag_ugwp ) then + do k = kts,km + dtaux2d_fd(i,k) = utendform(i,k) + dtauy2d_fd(i,k) = vtendform(i,k) + dusfc_fd(i) = dusfc_fd(i) + utendform(i,k) * del(i,k) + dvsfc_fd(i) = dvsfc_fd(i) + vtendform(i,k) * del(i,k) + enddo + endif + + endif ! if (ss_taper(i).GT.1.E-02) + + enddo ! i=its,im + +ENDIF ! if (do_gsl_drag_tofd) +!======================================================= +! More for the large-scale gwd component +IF ( (do_gsl_drag_ls_bl).and.(gwd_opt_ls .EQ. 1) ) THEN + + do i=its,im + + if ( ls_taper(i).GT.1.E-02 ) then + +! +! now compute vertical structure of the stress. + do k = kts,kpblmax + if (k .le. kbl(i)) taup(i,k) = taub(i) + enddo +! + do k = kpblmin, km-1 ! vertical level k loop! + kp1 = k + 1 +! +! unstablelayer if ri < ric +! unstable layer if upper air vel comp along surf vel <=0 (crit lay) +! at (u-c)=0. crit layer exists and bit vector should be set (.le.) +! + if (k .ge. kbl(i)) then + icrilv(i) = icrilv(i) .or. ( usqj(i,k) .lt. ric) & + .or. (velco(i,k) .le. 0.0) + brvf(i) = max(bnv2(i,k),bnv2min) ! brunt-vaisala frequency squared + brvf(i) = sqrt(brvf(i)) ! brunt-vaisala frequency + endif +! + if (k .ge. kbl(i) .and. (.not. ldrag(i))) then + if (.not.icrilv(i) .and. taup(i,k) .gt. 0.0 ) then + temv = 1.0 / velco(i,k) + tem1 = coefm(i)/dxy(i)*(ro(i,kp1)+ro(i,k))*brvf(i)* & + velco(i,k)*0.5 + hd = sqrt(taup(i,k) / tem1) + fro = brvf(i) * hd * temv +! +! rim is the minimum-richardson number by shutts (1985) + tem2 = sqrt(usqj(i,k)) + tem = 1. + tem2 * fro + rim = usqj(i,k) * (1.-fro) / (tem * tem) +! +! check stability to employ the 'saturation hypothesis' +! of lindzen (1981) except at tropospheric downstream regions +! + if (rim .le. ric) then ! saturation hypothesis! + temc = 2.0 + 1.0 / tem2 + hd = velco(i,k) * (2.*sqrt(temc)-temc) / brvf(i) + taup(i,kp1) = tem1 * hd * hd + else ! no wavebreaking! + taup(i,kp1) = taup(i,k) + endif + endif + endif + enddo +! + if(lcap.lt.km) then + do klcap = lcapp1,km + taup(i,klcap) = prsi(i,klcap) / prsi(i,lcap) * taup(i,lcap) + enddo + endif + + endif ! if ( ls_taper(i).GT.1.E-02 ) + + enddo ! do i=its,im + +ENDIF ! (do_gsl_drag_ls_bl).and.(gwd_opt_ls .EQ. 1) +!=============================================================== +!COMPUTE BLOCKING COMPONENT +!=============================================================== +IF ( (do_gsl_drag_ls_bl) .and. (gwd_opt_bl .EQ. 1) ) THEN + do i = its,im + flag(i) = .true. + enddo + + do i=its,im + + if ( ls_taper(i).GT.1.E-02 ) then + + if (.not.ldrag(i)) then +! +!------- determine the height of flow-blocking layer +! + pe = 0.0 + ke = 0.0 + do k = km, kpblmin, -1 + if(flag(i).and. k.le.kbmax(i)) then + pe = pe + bnv2(i,k)*(zl(i,kbmax(i))-zl(i,k))* & + del(i,k)*g_inv/ro(i,k) + ke = 0.5*((rcs*u1(i,k))**2.+(rcs*v1(i,k))**2.) +! +!---------- apply flow-blocking drag when pe >= ke +! + if(pe.ge.ke.and.zl(i,k).le.hmax(i)) then + kblk(i)= k + zblk = zl(i,k) + RDXZB(i) = real(k,kind=kind_phys) + flag(i) = .false. + endif + endif + enddo + if(.not.flag(i)) then +! +!--------- compute flow-blocking stress +! + cd = max(2.0-1.0/od(i),cdmin) + taufb(i,kts) = 0.5 * roll(i) * coefm(i) / & + max(dxmax_ls,dxy(i))**2 * cd * dxyp(i) * & + olp(i) * zblk * ulow(i)**2 + tautem = taufb(i,kts)/float(kblk(i)-kts) + do k = kts+1, kpblmax + if (k .le. kblk(i)) taufb(i,k) = taufb(i,k-1) - tautem + enddo +! +! reset gwd stress below blocking layer +! + do k = kts,kpblmax + if (k .le. kblk(i)) taup(i,k) = taup(i,kblk(i)) + enddo +! if(kblk(i).gt.5) print *,' gwd kbl komax kbmax kblk ',kbl(i),komax(i),kbmax(i),kblk(i) +! if(kblk(i).gt.5) print *,' gwd elvmax zlowtop zblk ',elvmax(i),zlowtop(i),zl(i,kblk(i)) + endif + + endif ! if (.not.ldrag(i)) + + endif ! if ( ls_taper(i).GT.1.E-02 ) + + enddo ! do i=its,im + +ENDIF ! IF ( (do_gsl_drag_ls_bl) .and. (gwd_opt_bl .EQ. 1) ) +!=========================================================== +IF ( (do_gsl_drag_ls_bl) .and. & + (gwd_opt_ls .EQ. 1 .OR. gwd_opt_bl .EQ. 1) ) THEN + + do i=its,im + + if ( ls_taper(i) .GT. 1.E-02 ) then + +! +! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy +! + do k = kts,km + taud_ls(i,k) = 1. * (taup(i,k+1) - taup(i,k)) * csg / del(i,k) + taud_bl(i,k) = 1. * (taufb(i,k+1) - taufb(i,k)) * csg / del(i,k) + enddo +! +! limit de-acceleration (momentum deposition ) at top to 1/2 value +! the idea is some stuff must go out the 'top' + do klcap = lcap,km + taud_ls(i,klcap) = taud_ls(i,klcap) * factop + taud_bl(i,klcap) = taud_bl(i,klcap) * factop + enddo +! +! if the gravity wave drag would force a critical line +! in the lower ksmm1 layers during the next deltim timestep, +! then only apply drag until that critical line is reached. +! + do k = kts,kpblmax-1 + if ((taud_ls(i,k)+taud_bl(i,k)).ne.0.) then + dtfac(i,k) = min(dtfac(i,k),abs(velco(i,k) & + /(deltim*rcs*(taud_ls(i,k)+taud_bl(i,k))))) + endif + enddo +! apply limiter to mesosphere drag, reduce the drag by density factor 10-3 +! prevent wind reversal... +! + do k = kpblmax,km-1 + if ((taud_ls(i,k)+taud_bl(i,k)).ne.0..and.prsl(i,k).le.pcutoff) then + denfac = min(ro(i,k)/pcutoff_den,1.) + dtfac(i,k) = min(dtfac(i,k),denfac*abs(velco(i,k) & + /(deltim*rcs*(taud_ls(i,k)+taud_bl(i,k))))) + endif + enddo +! + do k = kts,km + taud_ls(i,k) = taud_ls(i,k)*dtfac(i,k)* ls_taper(i) *(1.-rstoch(i)) + taud_bl(i,k) = taud_bl(i,k)*dtfac(i,k)* ls_taper(i) *(1.-rstoch(i)) + dtaux = taud_ls(i,k) * xn(i) + dtauy = taud_ls(i,k) * yn(i) + dtauxb = taud_bl(i,k) * xn(i) + dtauyb = taud_bl(i,k) * yn(i) + + !add blocking and large-scale contributions to tendencies + dudt(i,k) = dtaux + dtauxb + dudt(i,k) + dvdt(i,k) = dtauy + dtauyb + dvdt(i,k) + + if ( gsd_diss_ht_opt .EQ. 1 ) then + ! Calculate dissipation heating + ! Initial kinetic energy (at t0-dt) + eng0 = 0.5*( (rcs*u1(i,k))**2. + (rcs*v1(i,k))**2. ) + ! Kinetic energy after wave-breaking/flow-blocking + eng1 = 0.5*( (rcs*(u1(i,k)+(dtaux+dtauxb)*deltim))**2 + & + (rcs*(v1(i,k)+(dtauy+dtauyb)*deltim))**2 ) + ! Modify theta tendency + dtdt(i,k) = dtdt(i,k) + max((eng0-eng1),0.0)/cp/deltim + if ( Tdtend>0 ) then + dtend(i,k,Tdtend) = dtend(i,k,Tdtend) + max((eng0-eng1),0.0)/cp + endif + endif + + dusfc(i) = dusfc(i) + taud_ls(i,k)*xn(i)*del(i,k) + & + taud_bl(i,k)*xn(i)*del(i,k) + dvsfc(i) = dvsfc(i) + taud_ls(i,k)*yn(i)*del(i,k) + & + taud_bl(i,k)*yn(i)*del(i,k) + if(udtend>0) then + dtend(i,k,udtend) = dtend(i,k,udtend) + (taud_ls(i,k) * & + xn(i) + taud_bl(i,k) * xn(i)) * deltim + endif + if(vdtend>0) then + dtend(i,k,vdtend) = dtend(i,k,vdtend) + (taud_ls(i,k) * & + yn(i) + taud_bl(i,k) * yn(i)) * deltim + endif + + enddo + + ! Finalize dusfc and dvsfc diagnostics + dusfc(i) = -(invgrcs) * dusfc(i) + dvsfc(i) = -(invgrcs) * dvsfc(i) + + if ( ldiag_ugwp ) then + do k = kts,km + dtaux2d_ls(i,k) = taud_ls(i,k) * xn(i) + dtauy2d_ls(i,k) = taud_ls(i,k) * yn(i) + dtaux2d_bl(i,k) = taud_bl(i,k) * xn(i) + dtauy2d_bl(i,k) = taud_bl(i,k) * yn(i) + dusfc_ls(i) = dusfc_ls(i) + dtaux2d_ls(i,k) * del(i,k) + dvsfc_ls(i) = dvsfc_ls(i) + dtauy2d_ls(i,k) * del(i,k) + dusfc_bl(i) = dusfc_bl(i) + dtaux2d_bl(i,k) * del(i,k) + dvsfc_bl(i) = dvsfc_bl(i) + dtauy2d_bl(i,k) * del(i,k) + enddo + endif + + endif ! if ( ls_taper(i) .GT. 1.E-02 ) + + enddo ! do i=its,im + +ENDIF ! (do_gsl_drag_ls_bl).and.(gwd_opt_ls.EQ.1 .OR. gwd_opt_bl.EQ.1) + +if ( ldiag_ugwp ) then + ! Finalize dusfc and dvsfc diagnostics + do i = its,im + dusfc_ls(i) = -(invgrcs) * dusfc_ls(i) + dvsfc_ls(i) = -(invgrcs) * dvsfc_ls(i) + dusfc_bl(i) = -(invgrcs) * dusfc_bl(i) + dvsfc_bl(i) = -(invgrcs) * dvsfc_bl(i) + dusfc_ss(i) = -(invgrcs) * dusfc_ss(i) + dvsfc_ss(i) = -(invgrcs) * dvsfc_ss(i) + dusfc_fd(i) = -(invgrcs) * dusfc_fd(i) + dvsfc_fd(i) = -(invgrcs) * dvsfc_fd(i) + enddo +endif +! + return + end subroutine drag_suite_psl ! !> @} diff --git a/physics/GWD/drag_suite.meta b/physics/GWD/drag_suite.meta index 94dddcc93..559ea1a63 100644 --- a/physics/GWD/drag_suite.meta +++ b/physics/GWD/drag_suite.meta @@ -278,6 +278,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_ms] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = y wind tendency from mesoscale gwd @@ -286,6 +287,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtaux2d_bl] standard_name = tendency_of_x_wind_due_to_blocking_drag long_name = x wind tendency from blocking drag @@ -294,6 +296,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_bl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -302,6 +305,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtaux2d_ss] standard_name = tendency_of_x_wind_due_to_small_scale_gravity_wave_drag long_name = x wind tendency from small scale gwd @@ -310,6 +314,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_ss] standard_name = tendency_of_y_wind_due_to_small_scale_gravity_wave_drag long_name = y wind tendency from small scale gwd @@ -318,6 +323,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtaux2d_fd] standard_name = tendency_of_x_wind_due_to_form_drag long_name = x wind tendency from form drag @@ -326,6 +332,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_fd] standard_name = tendency_of_y_wind_due_to_form_drag long_name = y wind tendency from form drag @@ -334,6 +341,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc] standard_name = instantaneous_x_stress_due_to_gravity_wave_drag long_name = zonal surface stress due to orographic gravity wave drag @@ -358,6 +366,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_ms] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from mesoscale gwd @@ -366,6 +375,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_bl] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -374,6 +384,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_bl] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -382,6 +393,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_ss] standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd @@ -390,6 +402,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_ss] standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd @@ -398,6 +411,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_fd] standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag @@ -406,6 +420,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_fd] standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag @@ -414,6 +429,7 @@ type = real kind = kind_phys intent = inout + optional = True [slmsk] standard_name = area_type long_name = landmask: sea/land/ice=0/1/2 @@ -501,6 +517,14 @@ type = real kind = kind_phys intent = in +[alpha_fd] + standard_name = alpha_coefficient_for_turbulent_orographic_form_drag + long_name = alpha coefficient for Beljaars et al turbulent orographic form drag + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in [me] standard_name = mpi_rank long_name = rank of the current MPI task @@ -580,8 +604,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - active = (flag_for_diagnostics_3D) intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -646,6 +670,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_gwd] standard_name = control_for_gravity_wave_drag_spp_perturbations long_name = control for gravity wave drag spp perturbations diff --git a/physics/GWD/ecmwf_ngw.F90 b/physics/GWD/ecmwf_ngw.F90 new file mode 100644 index 000000000..d506c60e9 --- /dev/null +++ b/physics/GWD/ecmwf_ngw.F90 @@ -0,0 +1,957 @@ +!>\file ecmwf_ngw.F90 +!! + +module ecmwf_ngw + + +contains +!------------------------------------------------------------------------------------------ +! April 2025 Adding ECMWF Non-stationary gravity wave scheme option by Bo Yang +!------------------------------------------------------------------------------------------ +! different orientation at vertical +! 1 is the highest level for ECMWF, 1 is the lowest level for GFS +! Vertical levels are reversed after entering the subroutine ecmwf_ngw_emc and reversed back before exiting +! This non-stationary GWD module was obtained by Fanglin Yang from ECMWF, with permission for operational use at NCEP. We would +! like to thank Andy Brown, Michael Sleigh, Peter Bechtold, and Nils Wedi at ECMWF for their support in porting this code to the +! UFS. +!! Original Fortran Code by J. SCINOCCIA +! Rewritten in IFS format by A. ORR E.C.M.W.F. August 2008 +! PURPOSE +! ------- + +! THIS ROUTINE COMPUTES NON-OROGRAPHIC GRAVITY WAVE DRAG +! AFTER SCINOCCA (2003) AND Mc LANDRESS AND SCINOCCIA (JAS 2005) +! HYDROSTATIC NON-ROTATIONAL SIMPLIFIED VERSION OF THE +! WARNER AND MCINTYRE (1996) NON-OROGRAPHIC GRAVITY WAVE PARAMETERIZATION +! CONSTANTS HAVE BEEN OPTIMIZED FOLLOWING M. ERN ET AL. (ATMOS. CHEM. PHYS. 2006) + +! REFERENCE: Orr, A., P. Bechtold, J. Scinoccia, M. Ern, M. Janiskova, 2010: +! Improved middle atmosphere climate and analysis in the ECMWF forecasting system +! through a non-orographic gravity wave parametrization. J. Climate., 23, 5905-5926. + +! LAUNCH SPECTRUM - GENERALIZED DESAUBIES +! INCLUDES A CRITICAL-LEVEL CORRECTION THAT PREVENTS THE +! MOMEMTUM DEPOSITION IN EACH AZIMUTH FROM DRIVING THE FLOW TO SPEEDS FASTER +! THAN THE PHASE SPEED OF THE WAVES, I.E. WHEN WAVES BREAK THEY DRAG THE MEAN +! FLOW TOWARDS THEIR PHASE SPEED - NOT PAST IT. +!!! different orientation for vertical +!!! 1 is the highest level for ECMWF, 1 is the lowest level for GFS +!--------------------------------------------------- +! subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & +! tau_ngw, tm , um, vm, qm, prsl, prsi, zmet, zmeti, prslk, & +! xlatd, sinlat, coslat, & +! pdudt, pdvdt, pdtdt, dked, zngw) + +! (C) Copyright 1989- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. + + subroutine ecmwf_ngw_emc(mpi_id, master, KLON, KLEV, kdt, PTSTEP, DX, & + tau_ngw, PTM11, PUM11, PVM11, qm1, PAPM11, PAPHM11, PGEO11, zmeti1, prslk1, & + xlatd, sinlat, coslat, & + PTENU, PTENV, pdtdt, dked, zngw) + + +! + use machine, only : kind_phys + + + use cires_ugwpv1_module,only : psrc => knob_ugwp_palaunch + + use cires_ugwpv1_module,only : maxdudt, maxdtdt, max_eps, dked_min, dked_max +!! maxdudt=250.e-5; maxdtdt=15.e-2; dked_min=0.01; dked_max=250.0 +!! max_eps=max_kdis*4.e-4=450*4.e-4 + + use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpdl, grav2cpd, & + omega2, rcpd, rcpd2, pi, pi2, fv, & + rad_to_deg, deg_to_rad, & + rdi, gor, grcp, gocp, & + bnv2min, bnv2max, dw2min, velmin, gr2, & + hpscale, rhp, rh4, grav2, rgrav2, mkzmin, mkz2min + +!!! grav=con_g; rgrav=1/grav; cpd=con_cp; rd=con_rd; rv=con_rv; rcpdl=cpd*rgrav=cpd/g +!!!grav2cpd= grav*grcp=grav*grav*rcpd= g**2/cpd omega=con_omega; omega2=2*omega1 +!! rcpd2=0.5*rcpd=1/(2*cpd) +!! pi=con_pi; pi2=2*pi +!! fv=con_fvirt; rad_to_deg=180.0/pi; deg_to_rad=pi2/180.0 +!! rdi= 1.0/rd; gor=grav/rd; grcp= grav*rcpd=g/Cpd; gocp=grcp=grav*rcpd= g/cpd +!! bnv2min=(pi2/1800.)*(pi2/1800.); bnv2max=(pi2/30.)*(pi2/30.) +!! dw2min=1.0, velmin=sqrt(dw2min) +!! gr2=grav*gor=grav*grav/rd=g**2/rd +!! hpscale=7000; rhp = 1./hpscale = 1/7000; rh4=rhp2*rhp2=(0.5*rhp)**2=1/4*1/7000=1/28000 +!! rgrav2=rgrav*rgrav=1/(g**2); grav2=grav+grav=2*g; mkzmin=pi2/80.0e-3=2*pi/80.0e3 +!! mkz2min= mkzmin*mkzmin=(2*pi/80.0E3)**2 + + + use ugwp_wmsdis_init, only : v_kxw, rv_kxw, v_kxw2, tamp_mpa, tau_min, ucrit, & + gw_eff, & +! zms, & + zci4, zci3, zci2, & + rimin, sc2, sc2u, ric +! v_kxw=kxw=pi2/lhmet=pi2/200e3; rv_kxw=200e3/pi2 +! v_kxw2=v_kxw*v_kxw=(pi2/200e3)**2; tamp_mpa=knob_ugwp_tauamp amplitude for GEOS-5/MERRA-2 +! tau_min=min of GW MF 0.25mPa +! ucrit=cdmin=2e-2/mkzmax=2e-2/((2pie)/500) = 10/(2pie) +! gw_eff=effac=1.0 +! zci4=(zms*zci(inc))**4; zci2=(zms*zci(inc))**2; zci3(inc)=(zms*zci(inc))**3 +! rimin=-10.0; sc2=lturb*lturb=30m*30m; sc2u=ulturb*ulturb=150*150 + + + implicit none + +!in +!work + + +! integer, intent(in) :: KLAUNCH ! index for launch level + integer, intent(in) :: KLEV ! vertical level + integer, intent(in) :: KLON ! horiz tiles + integer, intent(in) :: mpi_id, master, kdt + + real(kind=kind_phys) ,intent(in) :: PTSTEP ! model time step + real(kind=kind_phys) ,intent(in) :: DX(KLON) ! model grid size + + real(kind=kind_phys) ,intent(in) :: tau_ngw(KLON) + + real(kind=kind_phys) ,intent(in) :: PVM11(KLON,KLEV) ! meridional wind + real(kind=kind_phys) ,intent(in) :: PUM11(KLON,KLEV) ! zonal wind + real(kind=kind_phys) ,intent(in) :: qm1(KLON,KLEV) ! spec. humidity + real(kind=kind_phys) ,intent(in) :: PTM11(KLON,KLEV) ! kinetic temperature + real(kind=kind_phys) ,intent(in) :: PAPM11(KLON,KLEV) ! mid-layer pressure + real(kind=kind_phys) ,intent(in) :: PAPHM11(KLON,KLEV+1) ! interface pressure + real(kind=kind_phys) ,intent(in) :: PGEO11(KLON,KLEV) ! full model level geopotential in meters + + real(kind=kind_phys) :: PVM1(KLON,KLEV) ! meridional wind + real(kind=kind_phys) :: PUM1(KLON,KLEV) ! zonal wind + real(kind=kind_phys) :: qm(KLON,KLEV) ! spec. humidity + real(kind=kind_phys) :: PTM1(KLON,KLEV) ! kinetic temperature + real(kind=kind_phys) :: PAPM1(KLON,KLEV) ! mid-layer pressure + real(kind=kind_phys) :: PAPHM1(KLON,KLEV+1) ! interface pressure + real(kind=kind_phys) :: PGEO1(KLON,KLEV) ! full model level geopotential in meters + +! real(kind=kind_phys) :: PGAW(KLON) !normalised gaussian quadrature weight/nb of longitude pts + ! local sub-area == 4*RPI*RA**2 * PGAW +! real(kind=kind_phys) ,intent(in) :: PPRECIP(KLON) ! total surface precipitation + + + + + real(kind=kind_phys) ,intent(in) :: prslk1(KLON,KLEV) ! mid-layer exner function + real(kind=kind_phys) :: prslk(KLON,KLEV) ! mid-layer exner function +! real(kind=kind_phys) ,intent(in) :: zmet(KLON,KLEV) ! meters phil =philg/grav ! use PGEO1 instead + + real(kind=kind_phys) ,intent(in) :: zmeti1(KLON,KLEV+1) ! interface geopi/meters + real(kind=kind_phys) :: zmeti(KLON,KLEV+1) ! interface geopi/meters + real(kind=kind_phys) ,intent(in) :: xlatd(KLON) ! xlat_d in degrees + real(kind=kind_phys) ,intent(in) :: sinlat(KLON) + real(kind=kind_phys) ,intent(in) :: coslat(KLON) +! +! out-gw effects +! + real(kind=kind_phys) ,intent(out) :: PTENU(KLON,KLEV) ! zonal momentum tendency + real(kind=kind_phys) ,intent(out) :: PTENV(KLON,KLEV) ! meridional momentum tendency + real(kind=kind_phys) ,intent(out) :: pdtdt(KLON,KLEV) ! gw-heating (u*ax+v*ay)/cp and cooling + + + real(kind=kind_phys) :: PFLUXU(KLON,KLEV+1) ! zonal momentum tendency + real(kind=kind_phys) :: PFLUXV(KLON,KLEV+1) ! meridional momentum tendency + + real(kind=kind_phys) ,intent(out) :: dked(KLON,KLEV) ! gw-eddy diffusion + + real(kind=kind_phys) ,intent(out) :: zngw(KLON) ! launch height +! +!work + INTEGER, PARAMETER :: IAZIDIM=4 !number of azimuths + INTEGER, PARAMETER :: INCDIM=20 !number of discretized c spectral elements in launch spectrum + + REAL(kind=kind_phys), PARAMETER :: RA=6370.e3 !half-model level zonal velocity + REAL(kind=kind_phys), PARAMETER :: GPTWO=2.0 ! 2p in equation + + REAL(kind=kind_phys) :: ZUHM1(KLON,KLEV) !half-model level zonal velocity + REAL(kind=kind_phys) :: ZVHM1(KLON,KLEV) !half-model level meridional velocity + + REAL(kind=kind_phys) :: ZBVFHM1(KLON,KLEV) !half-model level Brunt-Vaisalla frequency + REAL(kind=kind_phys) :: ZRHOHM1(KLON,KLEV) !half-model level density + REAL(kind=kind_phys) :: ZX(INCDIM) !coordinate transformation + REAL(kind=kind_phys) :: ZCI(INCDIM) !phase speed element + REAL(kind=kind_phys) :: ZDCI(INCDIM) + REAL(kind=kind_phys) :: ZUI(KLON,KLEV,IAZIDIM) !intrinsic velocity + REAL(kind=kind_phys) :: ZUL(KLON,IAZIDIM) !velocity in azimuthal direction at launch level + REAL(kind=kind_phys) :: ZBVFL(KLON) !buoyancy at launch level + REAL(kind=kind_phys) :: ZCOSANG(IAZIDIM) !cos of azimuth angle + REAL(kind=kind_phys) :: ZSINANG(IAZIDIM) !sin of azimuth angle + REAL(kind=kind_phys) :: ZFCT(KLON,KLEV) + REAL(kind=kind_phys) :: ZFNORM(KLON) !normalisation factor (A) + REAL(kind=kind_phys) :: ZCI_MIN(KLON,IAZIDIM) + REAL(kind=kind_phys) :: ZTHM1(KLON,KLEV) !temperature on half-model levels + REAL(kind=kind_phys) :: ZFLUX(KLON,INCDIM,IAZIDIM) !momentum flux at each vertical level and azimuth + REAL(kind=kind_phys) :: ZPU(KLON,KLEV,IAZIDIM) !momentum flux + REAL(kind=kind_phys) :: ZDFL(KLON,KLEV,IAZIDIM) + REAL(kind=kind_phys) :: ZACT(KLON,INCDIM,IAZIDIM) !if =1 then critical level encountered + REAL(kind=kind_phys) :: ZACC(KLON,INCDIM,IAZIDIM) + REAL(kind=kind_phys) :: ZCRT(KLON,KLEV,IAZIDIM) + + INTEGER :: ILAUNCH !model level from which GW spectrum is launched + INTEGER :: INC, JK, JL, IAZI + + + REAL(KIND=kind_phys) :: ZRADTODEG, ZGELATDEG + REAL(KIND=kind_phys) :: ZCIMIN, ZCIMAX + REAL(KIND=kind_phys) :: ZGAM, ZPEXP, ZXMAX, ZXMIN, ZXRAN + REAL(KIND=kind_phys) :: ZDX + + REAL(KIND=kind_phys) :: ZX1, ZX2, ZDXA, ZDXB, ZDXS + REAL(KIND=kind_phys) :: ZANG, ZAZ_FCT, ZNORM, ZANG1, ZTX + REAL(KIND=kind_phys) :: ZU, ZCIN, ZCPEAK + REAL(KIND=kind_phys) :: ZCIN4, ZBVFL4, ZCIN2, ZBVFL2, ZCIN3, ZBVFL3, ZCINC + REAL(KIND=kind_phys) :: ZATMP, ZFLUXS, ZDEP, ZFLUXSQ, ZULM, ZDFT, ZE1, ZE2 + REAL(KIND=kind_phys) :: ZMS_L,ZMS, Z0P5, Z0P0, Z50S + REAL(KIND=kind_phys) :: ZGAUSS(KLON), ZFLUXLAUN(KLON), ZCNGL(KLON) + REAL(KIND=kind_phys) :: ZCONS1,ZCONS2,ZDELP,ZRGPTS + +!!! try to assign values for the following + + REAL(KIND=kind_phys) :: GSSEC + REAL(KIND=kind_phys) :: ZGAUSSB,ZFLUXGLOB + +! REAL(KIND=kind_phys) :: PGAW(KLON) don't need this value, set ZDX directly + + +! REAL(KIND=kind_phys) :: PGELAT(KLON) !!! use xlatd from gfs instead + REAL(KIND=kind_phys) :: GCOEFF, GGAUSSA !!! GCOEFF link to precip +! REAL(KIND=kind_phys) :: GGAUSSB !!! GGAUSSB->ZGAUSS + !!!! GGAUSSA + REAL(KIND=kind_phys) :: GCSTAR + + + LOGICAL :: LGACALC, LGSATL, LOZPR + + integer :: NGAUSS, NSLOPE + + + NSLOPE=1 + LGACALC=.false. + LGSATL=.false. + LOZPR=.true. +! NGAUSS=4 + NGAUSS=1 +! GGAUSSA=20._kind_phys +! GGAUSSA=10._kind_phys + GGAUSSA=5._kind_phys +! GGAUSSB=1.0_kind_phys +! ZGAUSSB=0.25_kind_phys +! ZGAUSSB=0.3_kind_phys +! ZGAUSSB=0.35_kind_phys +! ZGAUSSB=0.38_kind_phys +! ZGAUSSB=-0.25_kind_phys + ZGAUSSB=0.5_kind_phys +! ZGAUSSB=0.3_kind_phys + GCSTAR=1.0_kind_phys + + + +! GSSEC=(pi2/1800.)*(pi2/1800.) + GSSEC=1.e-24 + GCOEFF=1.0_kind_phys !!do not know the value, but never use it when NGAUSS is not equal 1 + + + +!! LOGIC :: LGINDL !!LGINDL=.true. using standard atm values to calculate!! comment out +!! REAL(KIND=kind_phys) :: STPHI(KM),STTEM(KM), STPREH(KM) +!! REAL(KIND=kind_phys) :: ZTHSTD,ZRHOSTD,ZBVFSTD + +! Set parameters which are a function of launch height +!!! need to set the parameter ILAUCH, ZFLUXGLOB,ZGAUSSB,ZMS_L directly +!ILAUNCH=NLAUNCHL(KLAUNCH) +!ZFLUXGLOB=GFLUXLAUNL(KLAUNCH) +!ZGAUSSB=GGAUSSB(KLAUNCH) +!ZMS_L=GMSTAR_L(KLAUNCH) + +!*INPUT PARAMETERS +!* ---------------- + ZRADTODEG=57.29577951_kind_phys + ZMS_L=2.e3_kind_phys +! ZFLUXGLOB=3.75e-3_kind_phys +! ZFLUXGLOB=3.7e-3_kind_phys +! ZFLUXGLOB=3.55e-3_kind_phys +! ZFLUXGLOB=3.65e-3_kind_phys !standard value +! ZFLUXGLOB=3.62e-3_kind_phys !standard value + ZFLUXGLOB=3.60e-3_kind_phys + +! ZFLUXGLOB=3.2e-3_kind_phys +! ZFLUXGLOB=3.0e-3_kind_phys +! ZFLUXGLOB=5.0e-3_kind_phys +! ZFLUXGLOB=4.0e-3_kind_phys +! ZFLUXGLOB=0.0_kind_phys + + ZMS=2*pi/ZMS_L + +!* INITIALIZE FIELDS TO ZERO +!* ------------------------- + + PTENU(:,:)=0.0_kind_phys + PTENV(:,:)=0.0_kind_phys + pdtdt(:,:)=0.0_kind_phys + dked(:,:)=0.0_kind_phys + + DO JK=1,KLEV+1 + DO JL=1,KLON + PFLUXU(JL,JK)=0.0_kind_phys + PFLUXV(JL,JK)=0.0_kind_phys + ENDDO + ENDDO + + + DO IAZI=1,IAZIDIM + DO JK=1,KLEV + DO JL=1,KLON + ZPU(JL,JK,IAZI)=0.0_kind_phys + ZCRT(JL,JK,IAZI)=0.0_kind_phys + ZDFL(JL,JK,IAZI)=0.0_kind_phys + ENDDO + ENDDO + ENDDO + +!!!!!!!!!!!!!!!!!!!!!!!! +! redefine ilaunch + + DO JK=1, KLEV + if (PAPM11(KLON,JK) .LT. psrc) exit + ENDDO + ILAUNCH = max(JK-1,3) + + DO JL=1,KLON + zngw(JL) = PGEO11(JL, ILAUNCH) + ENDDO + + ILAUNCH = KLEV + 1 - ILAUNCH + +!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +!* reverse vertical coordinate to ECMWF + DO JL=1,KLON + PTM1(JL,:)=transfer(PTM11(JL,KLEV:1:-1),PTM11(JL,:)) + PUM1(JL,:)=transfer(PUM11(JL,KLEV:1:-1),PUM11(JL,:)) + PVM1(JL,:)=transfer(PVM11(JL,KLEV:1:-1),PVM11(JL,:)) + qm(JL,:)=transfer(qm1(JL,KLEV:1:-1),qm1(JL,:)) + PAPM1(JL,:)=transfer(PAPM11(JL,KLEV:1:-1),PAPM11(JL,:)) + PGEO1(JL,:)=transfer(PGEO11(JL,KLEV:1:-1),PGEO11(JL,:)) + prslk(JL,:)=transfer(prslk1(JL,KLEV:1:-1),prslk1(JL,:)) + + dked(JL,:)=transfer(dked(JL,KLEV:1:-1),dked(JL,:)) + PTENU(JL,:)=transfer(PTENU(JL,KLEV:1:-1),PTENU(JL,:)) + PTENV(JL,:)=transfer(PTENV(JL,KLEV:1:-1),PTENV(JL,:)) + pdtdt(JL,:)=transfer(pdtdt(JL,KLEV:1:-1),pdtdt(JL,:)) + + + PAPHM1(JL,:)=transfer(PAPHM11(JL,KLEV+1:1:-1),PAPHM11(JL,:)) + zmeti(JL,:)=transfer(zmeti1(JL,KLEV+1:1:-1),zmeti1(JL,:)) + ENDDO +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + + +!* INITIALIZE PARAMETERS FOR COORDINATE TRANSFORM +!* ---------------------------------------------- + +! ZCIMIN,ZCIMAX - min,max intrinsic launch-level phase speed (c-U_o) (m/s) +! ZGAM - half=width of coordinate stretch + + ZCIMIN=0.50_kind_phys + ZCIMAX=100.0_kind_phys + ZGAM=0.25_kind_phys + + ZPEXP=GPTWO/2.0_kind_phys + +! set initial min ci in each column and azimuth (used for critical levels) + + DO IAZI=1,IAZIDIM + DO JL=1,KLON + ZCI_MIN(JL,IAZI)=ZCIMIN + ENDDO + ENDDO + + +!* DEFINE HALF MODEL LEVEL WINDS AND TEMPERATURE +!* ----------------------------------- + + DO JK=2,KLEV + DO JL=1,KLON + ZTHM1(JL,JK) =0.5_kind_phys*(PTM1(JL,JK-1)+PTM1(JL,JK)) + ZUHM1(JL,JK) =0.5_kind_phys*(PUM1(JL,JK-1)+PUM1(JL,JK)) + ZVHM1(JL,JK) =0.5_kind_phys*(PVM1(JL,JK-1)+PVM1(JL,JK)) + ENDDO + ENDDO + + JK=1 + DO JL=1,KLON + ZTHM1(JL,JK)=PTM1(JL,JK) + ZUHM1(JL,JK)=PUM1(JL,JK) + ZVHM1(JL,JK)=PVM1(JL,JK) + ENDDO + + +!* DEFINE STATIC STABILITY AND AIR DENSITY ON HALF MODEL LEVELS +!* ------------------------------------------------------------ + +! ZCONS1=1.0_kind_phys/RD +! ZCONS2=RG**2/RCPD + + ZCONS1=1.0_kind_phys/rd + ZCONS2=grav2cpd + + + DO JK=KLEV,2,-1 + DO JL=1,KLON +! ZDELP=PAPM1(JL,JK)-PAPM1(JL,JK-1) + ZDELP=(PGEO1(JL,JK)-PGEO1(JL,JK-1))*grav !! times grav since import from zmet + ZRHOHM1(JL,JK)=PAPHM1(JL,JK)*ZCONS1/ZTHM1(JL,JK) + ZBVFHM1(JL,JK)=ZCONS2/ZTHM1(JL,JK)*& + & (1.0_kind_phys+cpd*(PTM1(JL,JK)-PTM1(JL,JK-1))/ZDELP) +! & (1.0_kind_phys-RCPD*ZRHOHM1(JL,JK)*(PTM1(JL,JK)-PTM1(JL,JK-1))/ZDELP) + ZBVFHM1(JL,JK)=MAX(ZBVFHM1(JL,JK),GSSEC) + ZBVFHM1(JL,JK)=SQRT(ZBVFHM1(JL,JK)) + ENDDO + ENDDO + +!* SET UP AZIMUTH DIRECTIONS AND SOME TRIG FACTORS +!* ----------------------------------------------- + + ZANG=2*pi/IAZIDIM + ZAZ_FCT=1.0_kind_phys + + +! get normalization factor to ensure that the same amount of momentum +! flux is directed (n,s,e,w) no mater how many azimuths are selected. +! note, however, the code below assumes a symmetric distribution of +! of azimuthal directions (ie 4,8,16,32,...) + + ZNORM=0.0_kind_phys + DO IAZI=1,IAZIDIM + ZANG1=(IAZI-1)*ZANG + ZCOSANG(IAZI)=COS(ZANG1) + ZSINANG(IAZI)=SIN(ZANG1) + ZNORM=ZNORM+ABS(ZCOSANG(IAZI)) + ENDDO + ZAZ_FCT=2._kind_phys*ZAZ_FCT/ZNORM + + +!* DEFINE COORDINATE TRANSFORM +!* ----------------------------------------------- + +! note that this is expresed in terms of the intrinsic phase speed +! at launch ci=c-u_o so that the transformation is identical at every +! launch site. +! See Eq. 28-30 of Scinocca 2003. + + ZXMAX=1.0_kind_phys/ZCIMIN + ZXMIN=1.0_kind_phys/ZCIMAX + + ZXRAN=ZXMAX-ZXMIN + ZDX=ZXRAN/REAL(INCDIM-1) + IF(LGACALC) ZGAM=(ZXMAX-ZXMIN)/LOG(ZXMAX/ZXMIN) +!! LGACALC=.false. ZGAM =0.25 ZX1=0.0007 +!! LGACALC=.true. ZGAM =0.37559 ZX1=0.01 + + ZX1=ZXRAN/(EXP(ZXRAN/ZGAM)-1.0_kind_phys) + ZX2=ZXMIN-ZX1 + + + + + DO INC=1,INCDIM + ZTX=REAL(INC-1)*ZDX+ZXMIN + ZX(INC)=ZX1*EXP((ZTX-ZXMIN)/ZGAM)+ZX2 !Eq. 29 of Scinocca 2003 + ZCI(INC)=1.0_kind_phys/ZX(INC) !Eq. 28 of Scinocca 2003 + ZDCI(INC)=ZCI(INC)**2*(ZX1/ZGAM)*EXP((ZTX-ZXMIN)/ZGAM)*ZDX !Eq. 30 of Scinocca 2003 + ENDDO + + +!* DEFINE INTRINSIC VELOCITY (RELATIVE TO LAUNCH LEVEL VELOCITY) U(Z)-U(Zo), AND COEFFICINETS +!* ------------------------------------------------------------------------------------------ + + DO IAZI=1,IAZIDIM + DO JL=1,KLON + ZUL(JL,IAZI)=ZCOSANG(IAZI)*ZUHM1(JL,ILAUNCH)& + & +ZSINANG(IAZI)*ZVHM1(JL,ILAUNCH) + ENDDO + ENDDO + DO JL=1,KLON + ZBVFL(JL)=ZBVFHM1(JL,ILAUNCH) + ENDDO + + DO JK=2,ILAUNCH + DO IAZI=1,IAZIDIM + DO JL=1,KLON + ZU=ZCOSANG(IAZI)*ZUHM1(JL,JK)+ZSINANG(IAZI)*ZVHM1(JL,JK) + ZUI(JL,JK,IAZI)=ZU-ZUL(JL,IAZI) + ENDDO + ENDDO + ENDDO + +!* DEFINE RHO(Zo)/N(Zo) +!* ------------------- + DO JK=2,ILAUNCH + DO JL=1,KLON + ZFCT(JL,JK)=ZRHOHM1(JL,JK)/ZBVFHM1(JL,JK) + ENDDO + ENDDO + +! Optionally set ZFCT at launch level using standard atmos values, to ensure saturation is +! independent of location +! IF (LGINDL) THEN +! ZCONS1=1.0_kind_phys/rd +! ZCONS2=grav2cpd +! ZDELP=STPHI(ILAUNCH)-STPHI(ILAUNCH-1) !!probably need to time grav depending on input +! THSTD=0.5_kind_phys*(STTEM(ILAUNCH-1)+STTEM(ILAUNCH)) +! ZRHOSTD=STPREH(ILAUNCH-1)*ZCONS1/ZTHSTD +! ZBVFSTD=ZCONS2/ZTHSTD*(1.0_kind_phys+rcpd* +! & (STTEM(ILAUNCH)-STTEM(ILAUNCH-1))/ZDELP) +! +! ZBVFSTD=MAX(ZBVFSTD,GSSEC) +! ZBVFSTD=SQRT(ZBVFSTD) +! DO JL=1,KLON +! ZFCT(JL,ILAUNCH)=ZRHOSTD/ZBVFSTD +! ENDDO +! ENDIF + +!* SET LAUNCH MOMENTUM FLUX SPECTRAL DENSITY +!* ----------------------------------------- + +! Eq. (25) of Scinocca 2003 (not including the 'A' component), and with U-Uo=0 +! do this for only one azimuth since it is identical to all azimuths, and it will be renormalized +! Initial spectrum fully saturated if LGSATL + + IF(NSLOPE==1) THEN +! s=1 case + DO INC=1,INCDIM + ZCIN=ZCI(INC) + ZCIN4=(ZMS*ZCIN)**4 + DO JL=1,KLON + ZBVFL4=ZBVFL(JL)**4 + IF(LGSATL) THEN + ZFLUX(JL,INC,1)=ZFCT(JL,ILAUNCH)*ZBVFL4*MIN(ZCIN/ZCIN4,& + & ZCIN/ZBVFL4) + ELSE + ZFLUX(JL,INC,1)=ZFCT(JL,ILAUNCH)*ZBVFL4*ZCIN/(ZBVFL4+ZCIN4) + ENDIF + ZACT(JL,INC,1)=1.0_kind_phys + ENDDO + ENDDO + + ELSEIF(NSLOPE==2) THEN +! s=2 case + DO INC=1,INCDIM + ZCIN=ZCI(INC) + ZCIN4=(ZMS*ZCIN)**4 + DO JL=1,KLON + ZBVFL4=ZBVFL(JL)**4 + ZCPEAK=ZBVFL(JL)/ZMS + IF(LGSATL) THEN + ZFLUX(JL,INC,1)=ZFCT(JL,ILAUNCH)*ZBVFL4*MIN& + & (ZCPEAK/ZCIN4,ZCIN/ZBVFL4) + ELSE + ZFLUX(JL,INC,1)=ZFCT(JL,ILAUNCH)*ZBVFL4*ZCIN*ZCPEAK/(ZBVFL4& + & *ZCPEAK+ZCIN4*ZCIN) + ENDIF + ZACT(JL,INC,1)=1.0_kind_phys + ENDDO + ENDDO + + ELSEIF(NSLOPE==-1) THEN +! s=-1 case + DO INC=1,INCDIM + ZCIN=ZCI(INC) + ZCIN2=(ZMS*ZCIN)**2 + DO JL=1,KLON + ZBVFL2=ZBVFL(JL)**2 + ZFLUX(JL,INC,1)=ZFCT(JL,ILAUNCH)*ZBVFL2*ZCIN/(ZBVFL2+ZCIN2) + ZACT(JL,INC,1)=1.0_kind_phys + ENDDO + ENDDO + + ELSEIF(NSLOPE==0) THEN +! s=0 case + DO INC=1,INCDIM + ZCIN=ZCI(INC) + ZCIN3=(ZMS*ZCIN)**3 + DO JL=1,KLON + ZBVFL3=ZBVFL(JL)**3 + ZFLUX(JL,INC,1)=ZFCT(JL,ILAUNCH)*ZBVFL3*ZCIN/(ZBVFL3+ZCIN3) + ZACT(JL,INC,1)=1.0_kind_phys + ZACC(JL,INC,1)=1.0_kind_phys + ENDDO + ENDDO + + ENDIF + +!* NORMALIZE LAUNCH MOMENTUM FLUX +!* ------------------------------ + +! (rho x F^H = rho_o x F_p^total) + +! integrate (ZFLUX x dX) + DO INC=1,INCDIM + ZCINC=ZDCI(INC) + DO JL=1,KLON + ZPU(JL,ILAUNCH,1)=ZPU(JL,ILAUNCH,1)+ZFLUX(JL,INC,1)*ZCINC + ENDDO + ENDDO + + +!* NORMALIZE GFLUXLAUN TO INCLUDE SENSITIVITY TO PRECIPITATION +!* ----------------------------------------------------------- + +! Also other options to alter tropical values + +! A=ZFNORM in Scinocca 2003. A is independent of height. + ZDXA=1.0_kind_phys/29.E3_kind_phys + ZDXB=1.0_kind_phys/3.5E3_kind_phys + DO JL=1,KLON +!! ZDX=MAX(1.E2_kind_phys,2*RA*SQRT(pi*PGAW(JL))) !grid resolution (m) +!! ZDX=50.E3 ! c192 for c192 usage +!!! ZDX=25.E3 !C384 +!!! ZDX=13.E3 !C768 + + + !Scaling factor for launch flux depending on grid resolution + ! smooth reduction below 30 km + ZDXS=1.0_kind_phys-MIN(1.0_kind_phys,ATAN((MAX(1.0_kind_phys& + & /DX(JL),ZDXA)-ZDXA)/(ZDXB-ZDXA))) + ZFLUXLAUN(JL)=ZFLUXGLOB*ZDXS + ZFNORM(JL)=ZFLUXLAUN(JL)/ZPU(JL,ILAUNCH,1) + ENDDO + +! If LOZPR=TRUE then vary EPLAUNCH over tropics + IF (LOZPR) THEN + IF (NGAUSS==1) THEN + Z50S=-50.0_kind_phys + + DO JL=1,KLON + +! ZFLUXLAUN(JL)=ZFLUXLAUN(JL)*(1.0_kind_phys+MIN& +! & (0.5_kind_phys,GCOEFF*PPRECIP(JL))) !precip +! ZFNORM(JL)=ZFLUXLAUN(JL)/ZPU(JL,ILAUNCH,1) + + ZGELATDEG=xlatd(JL)-Z50S + ZGAUSS(JL)=ZGAUSSB*EXP((-ZGELATDEG*ZGELATDEG)& +! & /(2*GGAUSSA*GGAUSSA)) + & /(2*20.*20.)) + +! ZGELATDEG=xlatd(JL) +! ZGAUSS(JL)=-0.1_kind_phys*EXP((-ZGELATDEG*ZGELATDEG)& +! & /(2*GGAUSSA*GGAUSSA))+ZGAUSS(JL) + + +! ZGELATDEG=xlatd(JL) +! ZGAUSS(JL)=-0.05_kind_phys*EXP((-ZGELATDEG*ZGELATDEG)& +! & /(2*GGAUSSA*GGAUSSA))+ZGAUSS(JL) + + ZGELATDEG=xlatd(JL) + ZGAUSS(JL)=0.08_kind_phys*EXP((-ZGELATDEG*ZGELATDEG)& + & /(2*GGAUSSA*GGAUSSA))+ZGAUSS(JL) + + ZGELATDEG=xlatd(JL)-50.0_kind_phys + ZGAUSS(JL)= 0.1_kind_phys*EXP((-ZGELATDEG*ZGELATDEG)& + & /(2*10.*10.))+ZGAUSS(JL) + + + ZFLUXLAUN(JL)=(1.0_kind_phys+ZGAUSS(JL))*ZFLUXLAUN(JL) + + + + ZFNORM(JL)=ZFLUXLAUN(JL)/ZPU(JL,ILAUNCH,1) + + + ENDDO + ELSEIF (NGAUSS==2) THEN + + DO JL=1,KLON +! ZGELATDEG=PGELAT(JL)*ZRADTODEG + ZGELATDEG=xlatd(JL) + ZGAUSS(JL)=ZGAUSSB*EXP((-ZGELATDEG*ZGELATDEG)& + & /(2*GGAUSSA*GGAUSSA)) + ZFLUXLAUN(JL)=(1.0_kind_phys+ZGAUSS(JL))*ZFLUXLAUN(JL) + ZFNORM(JL)=ZFLUXLAUN(JL)/ZPU(JL,ILAUNCH,1) + ENDDO + + + + ELSEIF (NGAUSS==4) THEN + +! Set latitudinal dependence to optimize stratospheric winds for 36r1 + Z50S=-50.0_kind_phys + DO JL=1,KLON +! ZGELATDEG=PGELAT(JL)*ZRADTODEG-Z50S + ZGELATDEG=xlatd(JL)-Z50S + ZGAUSS(JL)=ZGAUSSB*EXP((-ZGELATDEG*ZGELATDEG)/(2*GGAUSSA*GGAUSSA)) + ZFLUXLAUN(JL)=(1.0_kind_phys+ZGAUSS(JL))*ZFLUXLAUN(JL) + ZFNORM(JL)=ZFLUXLAUN(JL)/ZPU(JL,ILAUNCH,1) + ENDDO + + ENDIF + ENDIF + + DO IAZI=1,IAZIDIM + DO JL=1,KLON + ZPU(JL,ILAUNCH,IAZI)=ZFLUXLAUN(JL) + ENDDO + ENDDO + +!* ADJUST CONSTANT ZFCT +!* -------------------- + DO JK=2,ILAUNCH + DO JL=1,KLON + ZFCT(JL,JK)=ZFNORM(JL)*ZFCT(JL,JK) + ENDDO + ENDDO + +!* RENORMALIZE EACH SPECTRAL ELEMENT IN FIRST AZIMUTH +!* -------------------------------------------------- + DO INC=1,INCDIM + DO JL=1,KLON + ZFLUX(JL,INC,1)=ZFNORM(JL)*ZFLUX(JL,INC,1) + ENDDO + ENDDO + + + +!* COPY ZFLUX INTO ALL OTHER AZIMUTHS +!* -------------------------------- + +! ZACT=1 then no critical level +! ZACT=0 then critical level + + DO IAZI=2,IAZIDIM + DO INC=1,INCDIM + DO JL=1,KLON + ZFLUX(JL,INC,IAZI)=ZFLUX(JL,INC,1) + ZACT(JL,INC,IAZI)=1.0_kind_phys + ZACC(JL,INC,IAZI)=1.0_kind_phys + ENDDO + ENDDO + ENDDO + +! ----------------------------------------------------------------------------- + +!* BEGIN MAIN LOOP OVER LEVELS +!* --------------------------- + +!* begin IAZIDIM do-loop +!* -------------------- + + DO IAZI=1,IAZIDIM + +!* begin JK do-loop +!* ---------------- + + DO JK=ILAUNCH-1,2,-1 + +!* first do critical levels +!* ------------------------ + + DO JL=1,KLON + ZCI_MIN(JL,IAZI)=MAX(ZCI_MIN(JL,IAZI),ZUI(JL,JK,IAZI)) + ENDDO + +!* set ZACT to zero if critical level encountered +!* ---------------------------------------------- + + Z0P5=0.5_kind_phys + DO INC=1,INCDIM + ZCIN=ZCI(INC) + DO JL=1,KLON + ZATMP=Z0P5+SIGN(Z0P5,ZCIN-ZCI_MIN(JL,IAZI)) + ZACC(JL,INC,IAZI)=ZACT(JL,INC,IAZI)-ZATMP + ZACT(JL,INC,IAZI)=ZATMP + ENDDO + ENDDO + +!* integrate to get critical-level contribution to mom deposition on this level, i.e. ZACC=1 +!* ---------------------------------------------------------------------------------------- + + DO INC=1,INCDIM + ZCINC=ZDCI(INC) + DO JL=1,KLON + ZDFL(JL,JK,IAZI)=ZDFL(JL,JK,IAZI)+& + & ZACC(JL,INC,IAZI)*ZFLUX(JL,INC,IAZI)*ZCINC + ENDDO + ENDDO + +!* get weighted average of phase speed in layer + + DO JL=1,KLON + IF(ZDFL(JL,JK,IAZI)>0.0_kind_phys) THEN + ZATMP=ZCRT(JL,JK,IAZI) + DO INC=1,INCDIM + ZATMP=ZATMP+ZCI(INC)*& + & ZACC(JL,INC,IAZI)*ZFLUX(JL,INC,IAZI)*ZDCI(INC) + ENDDO + ZCRT(JL,JK,IAZI)=ZATMP/ZDFL(JL,JK,IAZI) + ELSE + ZCRT(JL,JK,IAZI)=ZCRT(JL,JK+1,IAZI) + ENDIF + ENDDO + +!* do saturation (Eq. (26) and (27) of Scinocca 2003) +!* ------------------------------------------------- + + IF(GPTWO==3.0_kind_phys) THEN + DO INC=1,INCDIM + ZCIN=ZCI(INC) + ZCINC=1.0_kind_phys/ZCIN + DO JL=1,KLON + ZE1=ZCIN-ZUI(JL,JK,IAZI) + ZE2=GCSTAR*ZFCT(JL,JK)*ZE1 + ZFLUXSQ=ZE2*ZE2*ZE1*ZCINC + ! ZFLUXSQ=ZE2*ZE2*ZE1/ZCIN + ZDEP=ZACT(JL,INC,IAZI)*(ZFLUX(JL,INC,IAZI)**2-ZFLUXSQ) + IF(ZDEP>0.0_kind_phys) THEN + ZFLUX(JL,INC,IAZI)=SQRT(ZFLUXSQ) + ENDIF + ENDDO + ENDDO + ELSEIF(GPTWO==2.0_kind_phys) THEN + DO INC=1,INCDIM + ZCIN=ZCI(INC) + ZCINC=1.0_kind_phys/ZCIN + DO JL=1,KLON + ZFLUXS=GCSTAR*ZFCT(JL,JK)*& + & (ZCIN-ZUI(JL,JK,IAZI))**2*ZCINC + ! ZFLUXS=GCSTAR*ZFCT(JL,JK)*(ZCIN-ZUI(JL,JK,IAZI))**2/ZCIN + ZDEP=ZACT(JL,INC,IAZI)*(ZFLUX(JL,INC,IAZI)-ZFLUXS) + IF(ZDEP>0.0_kind_phys) THEN + ZFLUX(JL,INC,IAZI)=ZFLUXS + ENDIF + ENDDO + ENDDO + ENDIF + +!* integrate spectrum +!* ------------------ + + DO INC=1,INCDIM + ZCINC=ZDCI(INC) + DO JL=1,KLON + ZPU(JL,JK,IAZI)=ZPU(JL,JK,IAZI)+& + & ZACT(JL,INC,IAZI)*ZFLUX(JL,INC,IAZI)*ZCINC + ENDDO + ENDDO + +!* end JK do-loop +!* -------------- + + ENDDO +!* end IAZIDIM do-loop +!* --------------- + + ENDDO + +! ----------------------------------------------------------------------------- + +!* MAKE CORRECTION FOR CRITICAL-LEVEL MOMENTUM DEPOSITION +!* ------------------------------------------------------ + + Z0P0=0._kind_phys +! ZRGPTS=1.0_kind_phys/(RG*PTSTEP) + ZRGPTS=1.0_kind_phys/(grav*PTSTEP) + DO IAZI=1,IAZIDIM + DO JL=1,KLON + ZCNGL(JL)=0.0_kind_phys + ENDDO + DO JK=2,ILAUNCH + DO JL=1,KLON + ZULM=ZCOSANG(IAZI)*PUM1(JL,JK)+ZSINANG(IAZI)*& + & PVM1(JL,JK)-ZUL(JL,IAZI) + ZDFL(JL,JK-1,IAZI)=ZDFL(JL,JK-1,IAZI)+ZCNGL(JL) + ZDFT=MIN(ZDFL(JL,JK-1,IAZI),2.0_kind_phys*(PAPM1(JL,JK-1)-& + & PAPM1(JL,JK))*(ZCRT(JL,JK-1,IAZI)-ZULM)*ZRGPTS) + + ZDFT=MAX(ZDFT,Z0P0) + ZCNGL(JL)=(ZDFL(JL,JK-1,IAZI)-ZDFT) + ZPU(JL,JK,IAZI)=ZPU(JL,JK,IAZI)-ZCNGL(JL) + ENDDO + ENDDO + ENDDO + + +!* SUM CONTRIBUTION FOR TOTAL ZONAL AND MERIDIONAL FLUX +!* --------------------------------------------------- + + DO IAZI=1,IAZIDIM + DO JK=ILAUNCH,2,-1 + DO JL=1,KLON + PFLUXU(JL,JK)=PFLUXU(JL,JK)+ZPU(JL,JK,IAZI)*ZAZ_FCT*ZCOSANG(IAZI) + PFLUXV(JL,JK)=PFLUXV(JL,JK)+ZPU(JL,JK,IAZI)*ZAZ_FCT*ZSINANG(IAZI) + ENDDO + ENDDO + ENDDO + + +!* UPDATE U AND V TENDENCIES +!* ---------------------------- + +! ZCONS1=1.0_kind_phys/RCPD + ZCONS1=rcpd + DO JK=1,ILAUNCH + DO JL=1, KLON +! ZDELP= RG/(PAPHM1(JL,JK+1)-PAPHM1(JL,JK)) + ZDELP= grav/(PAPHM1(JL,JK+1)-PAPHM1(JL,JK)) + ZE1=(PFLUXU(JL,JK+1)-PFLUXU(JL,JK))*ZDELP + ZE2=(PFLUXV(JL,JK+1)-PFLUXV(JL,JK))*ZDELP + + if (abs(ZE1) >= maxdudt ) then + ZE1 = sign(maxdudt, ZE1) + endif + if (abs(ZE2) >= maxdudt ) then + ZE2 = sign(maxdudt, ZE2) + endif + + + PTENU(JL,JK)=ZE1 + PTENV(JL,JK)=ZE2 +! add the tendency of dT/dt + ZE2=-(PUM1(JL,JK)*PTENU(JL,JK)+PVM1(JL,JK)*PTENV(JL,JK))/cpd + if (abs(ZE2) >= max_eps) pdtdt(JL,JK) = sign(max_eps, ZE2) + +! end of the tendency of dT/dt + ENDDO + ENDDO + + +!* reverse vertical coordinate back to GFS for outbound variables only + DO JL=1,KLON + dked(JL,:)=transfer(dked(JL,KLEV:1:-1),dked(JL,:)) + PTENU(JL,:)=transfer(PTENU(JL,KLEV:1:-1),PTENU(JL,:)) + PTENV(JL,:)=transfer(PTENV(JL,KLEV:1:-1),PTENV(JL,:)) + pdtdt(JL,:)=transfer(pdtdt(JL,KLEV:1:-1),pdtdt(JL,:)) + ENDDO + + +! DO JL=1,KLON +! dked(JL,:)=0.0 +! PTENU(JL,:)=0.0 +! PTENV(JL,:)=0.0 +! pdtdt(JL,:)=0.0 +! ENDDO + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + + return + end subroutine ecmwf_ngw_emc + + +end module ecmwf_ngw + + + + diff --git a/physics/GWD/gwdc_post.f b/physics/GWD/gwdc_post.f index 62891ffd4..ab2043fec 100644 --- a/physics/GWD/gwdc_post.f +++ b/physics/GWD/gwdc_post.f @@ -79,4 +79,4 @@ subroutine gwdc_post_run( & end subroutine gwdc_post_run - end module gwdc_post \ No newline at end of file + end module gwdc_post diff --git a/physics/GWD/gwdc_post.meta b/physics/GWD/gwdc_post.meta index 97649d4cf..6b3a160d0 100644 --- a/physics/GWD/gwdc_post.meta +++ b/physics/GWD/gwdc_post.meta @@ -115,8 +115,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - active = (flag_for_diagnostics_3D) intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/GWD/gwdps.f b/physics/GWD/gwdps.f index 273c2d5dc..ca2efeef4 100644 --- a/physics/GWD/gwdps.f +++ b/physics/GWD/gwdps.f @@ -315,11 +315,11 @@ subroutine gwdps_run( & & THETA(:), SIGMA(:), GAMMA(:) real(kind=kind_phys), intent(inout) :: DUSFC(:), DVSFC(:), & & RDXZB(:) - real(kind=kind_phys), intent(inout) :: dtaux2d_ms(:,:), & + real(kind=kind_phys), intent(inout), optional :: dtaux2d_ms(:,:), & & dtauy2d_ms(:,:), dtaux2d_bl(:,:), & & dtauy2d_bl(:,:) - real(kind=kind_phys), intent(inout) :: dusfc_ms(:), dvsfc_ms(:), & - & dusfc_bl(:), dvsfc_bl(:) + real(kind=kind_phys), intent(inout), optional :: dusfc_ms(:), & + & dvsfc_ms(:), dusfc_bl(:), dvsfc_bl(:) integer, intent(in) :: nmtvr logical, intent(in) :: lprnt logical, intent(in) :: ldiag_ugwp diff --git a/physics/GWD/gwdps.meta b/physics/GWD/gwdps.meta index bbe7569d0..58c18d367 100644 --- a/physics/GWD/gwdps.meta +++ b/physics/GWD/gwdps.meta @@ -235,6 +235,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_ms] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in y wind due to orographic gw drag @@ -243,6 +244,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtaux2d_bl] standard_name = tendency_of_x_wind_due_to_blocking_drag long_name = x wind tendency from blocking drag @@ -251,6 +253,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtauy2d_bl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -259,6 +262,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_ms] standard_name = vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated x momentum flux from mesoscale gwd @@ -267,6 +271,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_ms] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from mesoscale gwd @@ -275,6 +280,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_bl] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -283,6 +289,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_bl] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -291,6 +298,7 @@ type = real kind = kind_phys intent = inout + optional = True [g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -373,7 +381,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout [ldiag_ugwp] standard_name = flag_for_unified_gravity_wave_physics_diagnostics long_name = flag for CIRES UGWP Diagnostics diff --git a/physics/GWD/rayleigh_damp.f b/physics/GWD/rayleigh_damp.f index abbac041c..f8b4ac6a6 100644 --- a/physics/GWD/rayleigh_damp.f +++ b/physics/GWD/rayleigh_damp.f @@ -70,7 +70,8 @@ subroutine rayleigh_damp_run ( & real(kind=kind_phys),intent(in) :: U1(:,:), V1(:,:) real(kind=kind_phys),intent(inout) :: A(:,:), B(:,:), C(:,:) real(kind=kind_phys),optional, intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), & + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: & & index_of_process_rayleigh_damping, index_of_temperature, & & index_of_x_wind, index_of_y_wind character(len=*), intent(out) :: errmsg diff --git a/physics/GWD/rayleigh_damp.meta b/physics/GWD/rayleigh_damp.meta index 525acbe8b..857c66e8b 100644 --- a/physics/GWD/rayleigh_damp.meta +++ b/physics/GWD/rayleigh_damp.meta @@ -137,8 +137,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - active = (flag_for_diagnostics_3D) intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/GWD/ugwp_driver_v0.F b/physics/GWD/ugwp_driver_v0.F index 0f4ad447e..845323e43 100644 --- a/physics/GWD/ugwp_driver_v0.F +++ b/physics/GWD/ugwp_driver_v0.F @@ -1,4 +1,6 @@ !>\file ugwp_driver_v0.F + +!> This module contains the UGWP v0 driver module module ugwp_driver_v0 use cires_orowam2017 contains @@ -8,8 +10,7 @@ module ugwp_driver_v0 !ugwp-v0 subroutines: GWDPS_V0 and fv3_ugwp_solv2_v0 ! !===================================================================== -!>\ingroup cires_ugwp_run_mod -!>\defgroup ugwp_driverv0_mod GFS UGWP V0 Driver Module +!>\defgroup ugwp_driverv0_mod UGWP V0 Driver Module !! This is the CIRES UGWP V0 driver module !! !! Note for the sub-grid scale orography scheme in UGWP-v0: Due to degraded forecast @@ -347,7 +348,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, BVF2 = grav2 * RDZ * (VTK(I,K+1)-VTK(I,K)) & / (VTK(I,K+1)+VTK(I,K)) bnv2(i,k+1) = max( BVF2, bnv2min ) - RI_N(I,K+1) = Bnv2(i,k)/SHR2 ! Richardson number consistent with BNV2 + ! https://github.com/NCAR/ccpp-physics/issues/1103 + !RI_N(I,K+1) = Bnv2(i,k)/SHR2 ! Richardson number consistent with BNV2 + RI_N(I,K+1) = Bnv2(i,max(k,2))/SHR2 ! Richardson number consistent with BNV2 ! ! add here computation for Ktur and OGW-dissipation fro VE-GFS ! @@ -813,7 +816,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, IF( do_tofd ) then axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 - + DO I = 1,npt J = ipt(i) zpbl =rgrav*phil( j, kpbl(j) ) @@ -920,8 +923,7 @@ end subroutine gwdps_v0 !=============================================================================== !23456============================================================================== -!>\ingroup cires_ugwp_run_mod -!! A modification of the Scinocca (2003) \cite scinocca_2003 algorithm for +!> A modification of the Scinocca (2003) \cite scinocca_2003 algorithm for !! NGWs with non-hydrostatic and rotational !!effects for GW propagations and background dissipation subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, diff --git a/physics/GWD/ugwpv1_gsldrag.F90 b/physics/GWD/ugwpv1_gsldrag.F90 index 9303e0221..863f72b9c 100644 --- a/physics/GWD/ugwpv1_gsldrag.F90 +++ b/physics/GWD/ugwpv1_gsldrag.F90 @@ -1,5 +1,7 @@ !> \file ugwpv1_gsldrag.F90 -!! This introduces two gravity wave drag schemes ugwpv1/CIRES and GSL/drag_suite.F90 under "ugwpv1_gsldrag" suite: + +!> This module introduces two gravity wave drag schemes: UGWPv1 and orographic drag scheme +!! !! 1) The "V1 CIRES UGWP" scheme as tested in the FV3GFSv16-127L atmosphere model and workflow, which includes: !! a) the orograhic gravity wave drag, flow blocking scheme and TOFD (Beljaars et al, 2004). !! b) the v1 CIRE ugwp non-stationary GW scheme, new revision that generate realistic climate of FV3GFS-127L @@ -33,7 +35,6 @@ !! do_ugwp_v1_w_gsldrag -- activates V1 CIRES UGWP scheme with orographic drag of GSL !! Note that only one "large-scale" scheme can be activated at a time. !! - module ugwpv1_gsldrag use machine, only: kind_phys @@ -42,9 +43,12 @@ module ugwpv1_gsldrag use cires_ugwpv1_module, only: cires_ugwpv1_init, ngwflux_update, calendar_ugwp use cires_ugwpv1_module, only: knob_ugwp_version, cires_ugwp_dealloc, tamp_mpa use cires_ugwpv1_solv2, only: cires_ugwpv1_ngw_solv2 +! use cires_ugwpv1_solv2, only: cires_ugwpv1_ngw_solv2, ecmwf_ngw + use ecmwf_ngw, only: ecmwf_ngw_emc + use cires_ugwpv1_oro, only: orogw_v1 - use drag_suite, only: drag_suite_run + use drag_suite, only: drag_suite_run, drag_suite_psl implicit none @@ -63,15 +67,14 @@ module ugwpv1_gsldrag !> \section arg_table_ugwpv1_gsldrag_init Argument Table !! \htmlinclude ugwpv1_gsldrag_init.html !! -! ----------------------------------------------------------------------- -! subroutine ugwpv1_gsldrag_init ( & me, master, nlunit, input_nml_file, logunit, & fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, & con_pi, con_rerth, con_p0, & con_g, con_omega, con_cp, con_rd, con_rv,con_fvirt, & do_ugwp,do_ugwp_v0, do_ugwp_v0_orog_only, do_gsl_drag_ls_bl, & - do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & + do_gsl_drag_ss, do_gsl_drag_tofd, do_ngw_ec, do_ugwp_v1, & +!! do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & do_ugwp_v1_orog_only, do_ugwp_v1_w_gsldrag, errmsg, errflg) use ugwp_common @@ -95,9 +98,10 @@ subroutine ugwpv1_gsldrag_init ( & real(kind=kind_phys), intent (in) :: con_g, con_cp, con_rd, con_rv, con_omega, con_fvirt logical, intent (in) :: do_ugwp - logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & - do_gsl_drag_ls_bl, do_gsl_drag_ss, & - do_gsl_drag_tofd, do_ugwp_v1, & + logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & + do_gsl_drag_ls_bl, do_gsl_drag_ss, & +!! do_gsl_drag_tofd, do_ugwp_v1, & + do_gsl_drag_tofd, do_ugwp_v1, do_ngw_ec, & do_ugwp_v1_orog_only,do_ugwp_v1_w_gsldrag character(len=*), intent (in) :: fn_nml2 @@ -291,25 +295,23 @@ end subroutine ugwpv1_gsldrag_finalize ! ----------------------------------------------------------------------- ! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re ! ----------------------------------------------------------------------- -!>@brief These subroutines and modules execute the CIRES UGWP Version 0 -!>\defgroup ugwpv1_gsldrag_run Unified Gravity Wave Physics General Algorithm -!> @{ -!! The physics of NGWs in the UGWP framework (Yudin et al. 2018 \cite yudin_et_al_2018) is represented by four GW-solvers, which is introduced in Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, Alexander and Dunkerton (1999) \cite alexander_and_dunkerton_1999, and Scinocca (2003) \cite scinocca_2003. The major modification of these GW solvers is represented by the addition of the background dissipation of temperature and winds to the saturation criteria for wave breaking. This feature is important in the mesosphere and thermosphere for WAM applications and it considers appropriate scale-dependent dissipation of waves near the model top lid providing the momentum and energy conservation in the vertical column physics (Shaw and Shepherd 2009 \cite shaw_and_shepherd_2009). In the UGWP-v0, the modification of Scinocca (2003) \cite scinocca_2003 scheme for NGWs with non-hydrostatic and rotational effects for GW propagations and background dissipation is represented by the subroutine \ref fv3_ugwp_solv2_v0. In the next release of UGWP, additional GW-solvers will be implemented along with physics-based triggering of waves and stochastic approaches for selection of GW modes characterized by horizontal phase velocities, azimuthal directions and magnitude of the vertical momentum flux (VMF). +!>\section gen_ugwpv1_gsldrag_run Unified Gravity Wave Physics General Algorithm +!! The physics of NGWs in the UGWP framework (Yudin et al. 2018 \cite yudin_et_al_2018) is represented by four GW-solvers, which is introduced in Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, Alexander and Dunkerton (1999) \cite alexander_and_dunkerton_1999, and Scinocca (2003) \cite scinocca_2003. The major modification of these GW solvers is represented by the addition of the background dissipation of temperature and winds to the saturation criteria for wave breaking. This feature is important in the mesosphere and thermosphere for WAM applications and it considers appropriate scale-dependent dissipation of waves near the model top lid providing the momentum and energy conservation in the vertical column physics (Shaw and Shepherd 2009 \cite shaw_and_shepherd_2009). In the UGWP-v0, the modification of Scinocca (2003) \cite scinocca_2003 scheme for NGWs with non-hydrostatic and rotational effects for GW propagations and background dissipation is represented by the subroutine fv3_ugwp_solv2_v0. In the next release of UGWP, additional GW-solvers will be implemented along with physics-based triggering of waves and stochastic approaches for selection of GW modes characterized by horizontal phase velocities, azimuthal directions and magnitude of the vertical momentum flux (VMF). !! !! In UGWP-v0, the specification for the VMF function is adopted from the GEOS-5 global atmosphere model of GMAO NASA/GSFC, as described in Molod et al. (2015) \cite molod_et_al_2015 and employed in the MERRRA-2 reanalysis (Gelaro et al., 2017 \cite gelaro_et_al_2017). The Fortran subroutine \ref slat_geos5_tamp describes the latitudinal shape of VMF-function as displayed in Figure 3 of Molod et al. (2015) \cite molod_et_al_2015. It shows that the enhanced values of VMF in the equatorial region gives opportunity to simulate the QBO-like oscillations in the equatorial zonal winds and lead to more realistic simulations of the equatorial dynamics in GEOS-5 operational and MERRA-2 reanalysis products. For the first vertically extended version of FV3GFS in the stratosphere and mesosphere, this simplified function of VMF allows us to tune the model climate and to evaluate multi-year simulations of FV3GFS with the MERRA-2 and ERA-5 reanalysis products, along with temperature, ozone, and water vapor observations of current satellite missions. After delivery of the UGWP-code, the EMC group developed and tested approach to modulate the zonal mean NGW forcing by 3D-distributions of the total precipitation as a proxy for the excitation of NGWs by convection and the vertically-integrated (surface - tropopause) Turbulent Kinetic Energy (TKE). The verification scores with updated NGW forcing, as reported elsewhere by EMC researchers, display noticeable improvements in the forecast scores produced by FV3GFS configuration extended into the mesosphere. !! !> \section arg_table_ugwpv1_gsldrag_run Argument Table !! \htmlinclude ugwpv1_gsldrag_run.html !! -!> \section gen_ugwpv1_gsldrag CIRES UGWP Scheme General Algorithm -!! @{ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, & - fhzero, kdt, ldiag3d, lssav, flag_for_gwd_generic_tend, do_gsl_drag_ls_bl, & - do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, do_ugwp_v1_orog_only, & + kdt, ldiag3d, lssav, flag_for_gwd_generic_tend, do_gsl_drag_ls_bl, & + do_gsl_drag_ss, do_gsl_drag_tofd, & + do_gwd_opt_psl, psl_gwd_dx_factor, & + do_ngw_ec, do_ugwp_v1, do_ugwp_v1_orog_only, & do_ugwp_v1_w_gsldrag, gwd_opt, do_tofd, ldiag_ugwp, ugwp_seq_update, & - cdmbgwd, jdat, nmtvr, hprime, oc, theta, sigma, gamma, & + cdmbgwd, alpha_fd, jdat, nmtvr, hprime, oc, theta, sigma, gamma, & elvmax, clx, oa4, varss,oc1ss,oa4ss,ol4ss, dx, xlat, xlat_d, sinlat, coslat, & - area, rain, br1, hpbl, kpbl, slmsk, & + area, rain, br1, hpbl,vtype, kpbl, slmsk, & ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, del, tau_amf, & dudt_ogw, dvdt_ogw, du_ogwcol, dv_ogwcol, & dudt_obl, dvdt_obl, du_oblcol, dv_oblcol, & @@ -359,26 +361,29 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! flags for choosing combination of GW drag schemes to run logical, intent (in) :: do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd - logical, intent (in) :: do_ugwp_v1, do_ugwp_v1_orog_only, do_tofd + logical, intent (in) :: do_ugwp_v1, do_ngw_ec, do_ugwp_v1_orog_only, do_tofd logical, intent (in) :: ldiag_ugwp, ugwp_seq_update logical, intent (in) :: do_ugwp_v1_w_gsldrag ! combination of ORO and NGW schemes integer, intent(in) :: me, master, im, levs, ntrac,lonr - real(kind=kind_phys), intent(in) :: dtp, fhzero + real(kind=kind_phys), intent(in) :: dtp real(kind=kind_phys), intent(in) :: ak(:), bk(:) integer, intent(in) :: kdt, jdat(:) - +! option for psl gwd + logical, intent(in) :: do_gwd_opt_psl ! option for psl gravity wave drag + real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor ! ! SSO parameters and variables integer, intent(in) :: gwd_opt !gwd_opt and nmtvr are "redundant" controls integer, intent(in) :: nmtvr - real(kind=kind_phys), intent(in) :: cdmbgwd(:) ! for gsl_drag + real(kind=kind_phys), intent(in) :: cdmbgwd(:), alpha_fd ! for gsl_drag real(kind=kind_phys), intent(in), dimension(:) :: hprime, oc, theta, sigma, gamma real(kind=kind_phys), intent(in), dimension(:) :: elvmax real(kind=kind_phys), intent(in), dimension(:,:) :: clx, oa4 - real(kind=kind_phys), intent(in), dimension(:) :: varss,oc1ss,dx + real(kind=kind_phys), intent(in), dimension(:) :: dx + real(kind=kind_phys), intent(in), dimension(:) :: varss,oc1ss real(kind=kind_phys), intent(in), dimension(:,:) :: oa4ss,ol4ss !===== @@ -396,6 +401,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, real(kind=kind_phys), intent(in), dimension(:,:) :: prsi, phii real(kind=kind_phys), intent(in), dimension(:,:) :: q1 integer, intent(in), dimension(:) :: kpbl + integer, intent(in), dimension(:) :: vtype real(kind=kind_phys), intent(in), dimension(:) :: rain real(kind=kind_phys), intent(in), dimension(:) :: br1, hpbl, slmsk @@ -407,7 +413,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, !Output (optional): - real(kind=kind_phys), intent(out), dimension(:) :: & + real(kind=kind_phys), intent(out), dimension(:) :: & du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & du_osscol, dv_osscol, du_ofdcol, dv_ofdcol ! @@ -421,24 +427,23 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd - real(kind=kind_phys), intent(out) , dimension(:,:) :: dudt_ngw, dvdt_ngw, kdis_ngw - real(kind=kind_phys), intent(out) , dimension(:,:) :: dudt_gw, dvdt_gw, kdis_gw - - real(kind=kind_phys), intent(out) , dimension(:,:) :: dtdt_ngw, dtdt_gw + real(kind=kind_phys), intent(out) , dimension(:,:) :: dudt_ngw, dvdt_ngw, kdis_ngw, dtdt_ngw + real(kind=kind_phys), intent(out) , dimension(:,:) :: dudt_gw, dvdt_gw, dtdt_gw, kdis_gw real(kind=kind_phys), intent(out) , dimension(:) :: zogw, zlwb, zobl, zngw ! ! real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), & + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: & index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_orographic_gwd, index_of_process_nonorographic_gwd real(kind=kind_phys), intent(out), dimension(:) :: rdxzb ! for stoch phys. mtb-level - real(kind=kind_phys), intent(in) :: spp_wts_gwd(:,:) + real(kind=kind_phys), intent(in), optional :: spp_wts_gwd(:,:) integer, intent(in) :: spp_gwd character(len=*), intent(out) :: errmsg @@ -544,6 +549,28 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, ! dusfcg, dvsfcg ! ! + if (do_gwd_opt_psl) then + call drag_suite_psl(im, levs, Pdvdt, Pdudt, Pdtdt, & + ugrs,vgrs,tgrs,q1, & + kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & + kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & + ol4ss,theta,sigma,gamma,elvmax, & + dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & + dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, & + dusfcg, dvsfcg, & + du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & + du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & + slmsk,br1,hpbl,vtype,con_g,con_cp,con_rd,con_rv, & + con_fv, con_pi, lonr, & + cdmbgwd(1:2),alpha_fd,me,master, & + lprnt,ipr,rdxzb,dx,gwd_opt, & + do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & + psl_gwd_dx_factor, & + dtend, dtidx, index_of_process_orographic_gwd, & + index_of_temperature, index_of_x_wind, & + index_of_y_wind, ldiag3d, ldiag_ugwp, & + ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg) + else call drag_suite_run(im, levs, Pdvdt, Pdudt, Pdtdt, & ugrs,vgrs,tgrs,q1, & kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & @@ -554,14 +581,18 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, dusfcg, dvsfcg, & du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & - slmsk,br1,hpbl, con_g,con_cp,con_rd,con_rv, & + slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & con_fv, con_pi, lonr, & - cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & + cdmbgwd(1:2),alpha_fd,me,master, & + lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & dtend, dtidx, index_of_process_orographic_gwd, & index_of_temperature, index_of_x_wind, & index_of_y_wind, ldiag3d, ldiag_ugwp, & ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg) + endif + if(errflg/=0) return + ! ! dusfcg = du_ogwcol + du_oblcol + du_osscol + du_ofdcol ! @@ -611,6 +642,8 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, dudt_obl, dvdt_obl,dudt_ofd, dvdt_ofd, & du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & du_ofdcol, dv_ofdcol, errmsg,errflg ) + if(errflg/=0) return + ! ! orogw_v1: dusfcg = du_ogwcol + du_oblcol + du_ofdcol only 3 terms ! @@ -674,10 +707,21 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, call ngwflux_update(me, master, im, levs, kdt, ddd_ugwp,curdate, & tau_amf, xlat_d, sinlat,coslat, rain, tau_ngw) - call cires_ugwpv1_ngw_solv2(me, master, im, levs, kdt, dtp, & + if (do_ngw_ec) then + + call ecmwf_ngw_emc(me, master, im, levs, kdt, dtp, dx, & tau_ngw, tgrs, ugrs, vgrs, q1, prsl, prsi, & zmet, zmeti,prslk, xlat_d, sinlat, coslat, & dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, zngw) + else + + call cires_ugwpv1_ngw_solv2(me, master, im, levs, kdt, dtp, & + tau_ngw, tgrs, ugrs, vgrs, q1, prsl, prsi, & + zmet, zmeti,prslk, xlat_d, sinlat, coslat, & + dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, zngw) + + endif + ! ! => con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt ! @@ -733,6 +777,4 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ak, bk, ntrac, lonr, dtp, dtdt = dtdt + dtdt_gw end subroutine ugwpv1_gsldrag_run -!! @} -!>@} end module ugwpv1_gsldrag diff --git a/physics/GWD/ugwpv1_gsldrag.meta b/physics/GWD/ugwpv1_gsldrag.meta index 73d7eee1c..934d5b138 100644 --- a/physics/GWD/ugwpv1_gsldrag.meta +++ b/physics/GWD/ugwpv1_gsldrag.meta @@ -2,7 +2,7 @@ name = ugwpv1_gsldrag type = scheme dependencies = ../hooks/machine.F,drag_suite.F90 - dependencies = cires_ugwpv1_module.F90,cires_ugwpv1_triggers.F90,cires_ugwpv1_initialize.F90,cires_ugwpv1_solv2.F90 + dependencies = cires_ugwpv1_module.F90,cires_ugwpv1_triggers.F90,cires_ugwpv1_initialize.F90,cires_ugwpv1_solv2.F90,ecmwf_ngw.F90 dependencies = cires_ugwpv1_sporo.F90,cires_ugwpv1_oro.F90 ######################################################################## [ccpp-arg-table] @@ -218,6 +218,13 @@ dimensions = () type = logical intent = in +[do_ngw_ec] + standard_name = flag_for_ngw_ec + long_name = flag to activate ecmwf ngwd + units = flag + dimensions = () + type = logical + intent = in [do_ugwp_v1] standard_name = flag_for_ugwp_version_1 long_name = flag to activate ver 1 CIRES UGWP @@ -345,14 +352,6 @@ type = real kind = kind_phys intent = in -[fhzero] - standard_name = period_of_diagnostics_reset - long_name = hours between clearing of diagnostic buckets - units = h - dimensions = () - type = real - kind = kind_phys - intent = in [kdt] standard_name = index_of_timestep long_name = current forecast iteration @@ -402,6 +401,28 @@ dimensions = () type = logical intent = in +[do_gwd_opt_psl] + standard_name = do_gsl_drag_suite_with_psl_gwd_option + long_name = flag to activate PSL drag suite - mesoscale GWD and blocking + units = flag + dimensions = () + type = logical + intent = in +[psl_gwd_dx_factor] + standard_name = effective_grid_spacing_of_psl_gwd_suite + long_name = multiplication of grid spacing + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in +[do_ngw_ec] + standard_name = flag_for_ngw_ec + long_name = flag to activate ecmwf ngwd + units = flag + dimensions = () + type = logical + intent = in [do_ugwp_v1] standard_name = flag_for_ugwp_version_1 long_name = flag to activate ver 1 CIRES UGWP @@ -459,6 +480,14 @@ type = real kind = kind_phys intent = in +[alpha_fd] + standard_name = alpha_coefficient_for_turbulent_orographic_form_drag + long_name = alpha coefficient for Beljaars et al turbulent orographic form drag + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in [jdat] standard_name = date_and_time_of_forecast_in_united_states_order long_name = current forecast date and time @@ -641,6 +670,13 @@ type = real kind = kind_phys intent = in +[vtype] + standard_name = vegetation_type_classification + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in [kpbl] standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = vertical index at top atmospheric boundary layer @@ -1049,6 +1085,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -1113,6 +1150,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_gwd] standard_name = control_for_gravity_wave_drag_spp_perturbations long_name = control for gravity wave drag spp perturbations diff --git a/physics/GWD/ugwpv1_gsldrag_post.F90 b/physics/GWD/ugwpv1_gsldrag_post.F90 index 8c6704dc5..c57ce55f5 100644 --- a/physics/GWD/ugwpv1_gsldrag_post.F90 +++ b/physics/GWD/ugwpv1_gsldrag_post.F90 @@ -1,11 +1,11 @@ !> \file ugwpv1_gsldrag_post.F90 -!! This file contains + +!> This module contains code to be executed after the UGWP v1 scheme module ugwpv1_gsldrag_post contains !>\defgroup ugwpv1_gsldrag_post ugwpv1_gsldrag Scheme Post -!! @{ !> \section arg_table_ugwpv1_gsldrag_post_run Argument Table !! \htmlinclude ugwpv1_gsldrag_post_run.html !! @@ -35,30 +35,31 @@ subroutine ugwpv1_gsldrag_post_run ( im, levs, ldiag_ugwp, & logical, intent(in) :: ldiag_ugwp !< flag for CIRES UGWP Diagnostics real(kind=kind_phys), intent(in), dimension(:) :: zobl, zlwb, zogw - real(kind=kind_phys), intent(in), dimension(:) :: du_ofdcol, tau_ogw, du_oblcol, tau_ngw + real(kind=kind_phys), intent(in), dimension(:) :: tau_ogw, tau_ngw + real(kind=kind_phys), intent(in), dimension(:),optional :: du_ofdcol, du_oblcol real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw real(kind=kind_phys), intent(in), dimension(:,:) :: dtdt_gw, dudt_gw, dvdt_gw - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_obl, dvdt_obl, dudt_ogw - real(kind=kind_phys), intent(in), dimension(:,:) :: dvdt_ogw, dudt_ofd, dvdt_ofd - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_oss, dvdt_oss - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_ngw, dv3dt_ngw - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_ngw, dvdt_ngw, dtdt_ngw - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw - real(kind=kind_phys), intent(inout), dimension(:,:) :: dws3dt_ogw, dws3dt_obl - real(kind=kind_phys), intent(inout), dimension(:,:) :: dws3dt_oss, dws3dt_ofd - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ogw, ldu3dt_obl - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_oss, ldu3dt_ofd - real(kind=kind_phys), intent(in), dimension(:) :: du_ogwcol, dv_ogwcol - real(kind=kind_phys), intent(in), dimension(:) :: dv_oblcol - real(kind=kind_phys), intent(in), dimension(:) :: du_osscol, dv_osscol - real(kind=kind_phys), intent(in), dimension(:) :: dv_ofdcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_ogwcol, dv3_ogwcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_oblcol, dv3_oblcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_osscol, dv3_osscol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_ofdcol, dv3_ofdcol + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_obl, dvdt_obl, dudt_ogw + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dvdt_ogw, dudt_ofd, dvdt_ofd + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_oss, dvdt_oss + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_ngw, dv3dt_ngw + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_ngw, dvdt_ngw, dtdt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: dws3dt_ogw, dws3dt_obl + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: dws3dt_oss, dws3dt_ofd + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: ldu3dt_ogw, ldu3dt_obl + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: ldu3dt_oss, ldu3dt_ofd + real(kind=kind_phys), intent(in), dimension(:), optional :: du_ogwcol, dv_ogwcol + real(kind=kind_phys), intent(in), dimension(:), optional :: dv_oblcol + real(kind=kind_phys), intent(in), dimension(:), optional :: du_osscol, dv_osscol + real(kind=kind_phys), intent(in), dimension(:), optional :: dv_ofdcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_ogwcol, dv3_ogwcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_oblcol, dv3_oblcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_osscol, dv3_osscol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_ofdcol, dv3_ofdcol real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt @@ -141,5 +142,4 @@ subroutine ugwpv1_gsldrag_post_run ( im, levs, ldiag_ugwp, & !===================================================================== end subroutine ugwpv1_gsldrag_post_run -!! @} end module ugwpv1_gsldrag_post diff --git a/physics/GWD/ugwpv1_gsldrag_post.meta b/physics/GWD/ugwpv1_gsldrag_post.meta index e1c63102d..b97db21c0 100644 --- a/physics/GWD/ugwpv1_gsldrag_post.meta +++ b/physics/GWD/ugwpv1_gsldrag_post.meta @@ -108,6 +108,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_obl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -116,6 +117,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_ofd] standard_name = tendency_of_x_wind_due_to_form_drag long_name = x wind tendency from form drag @@ -124,6 +126,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ofd] standard_name = tendency_of_y_wind_due_to_form_drag long_name = y wind tendency from form drag @@ -132,6 +135,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_ogw] standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = x wind tendency from meso scale ogw @@ -140,6 +144,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ogw] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = y wind tendency from meso scale ogw @@ -148,6 +153,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_oss] standard_name = tendency_of_x_wind_due_to_small_scale_gravity_wave_drag long_name = x wind tendency from small scale gwd @@ -156,6 +162,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_oss] standard_name = tendency_of_y_wind_due_to_small_scale_gravity_wave_drag long_name = y wind tendency from small scale gwd @@ -164,6 +171,7 @@ type = real kind = kind_phys intent = in + optional = True [tot_zmtb] standard_name = time_integral_of_height_of_mountain_blocking long_name = time integral of height of mountain blocking drag @@ -228,6 +236,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ogw] standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag @@ -236,6 +245,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_tms] standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD @@ -244,6 +254,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ngw] standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in x wind due to NGW @@ -252,6 +263,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3dt_ngw] standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in y wind due to NGW @@ -260,6 +272,7 @@ type = real kind = kind_phys intent = inout + optional = True [dudt_ngw] standard_name = tendency_of_x_wind_due_to_nonorographic_gravity_wave_drag long_name = zonal wind tendency due to non-stationary GWs @@ -268,6 +281,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ngw] standard_name = tendency_of_y_wind_due_to_nonorographic_gravity_wave_drag long_name = meridional wind tendency due to non-stationary GWs @@ -276,6 +290,7 @@ type = real kind = kind_phys intent = in + optional = True [dtdt_ngw] standard_name = tendency_of_air_temperature_due_to_nonorographic_gravity_wave_drag long_name = air temperature tendency due to non-stationary GWs @@ -284,6 +299,7 @@ type = real kind = kind_phys intent = in + optional = True [ldu3dt_ngw] standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in x wind due to convective gravity wave drag @@ -292,6 +308,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldv3dt_ngw] standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in y wind due to convective gravity wave drag @@ -300,6 +317,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldt3dt_ngw] standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag long_name = cumulative change in temperature due to convective gravity wave drag @@ -308,6 +326,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_ogw] standard_name = cumulative_change_in_wind_speed_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative change in wind speed due to mesoscale orographic gravity wave drag @@ -316,6 +335,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_obl] standard_name = cumulative_change_in_wind_speed_due_to_blocking_drag long_name = cumulative change in wind speed due to blocking drag @@ -324,6 +344,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_oss] standard_name = cumulative_change_in_wind_speed_due_to_small_scale_orographic_gravity_wave_drag long_name = cumulative change in wind speed due to small scale orographic gravity wave drag @@ -332,6 +353,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_ofd] standard_name = cumulative_change_in_wind_speed_due_to_turbulent_orographic_form_drag long_name = cumulative change in wind speed due to turbulent orographic form drag @@ -340,6 +362,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_ogw] standard_name = cumulative_change_in_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative change in x wind due to mesoscale orographic gravity wave drag @@ -348,6 +371,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_obl] standard_name = cumulative_change_in_x_wind_due_to_blocking_drag long_name = cumulative change in x wind due to blocking drag @@ -356,6 +380,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_oss] standard_name = cumulative_change_in_x_wind_due_to_small_scale_gravity_wave_drag long_name = cumulative change in x wind due to small scale gravity wave drag @@ -364,6 +389,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_ofd] standard_name = cumulative_change_in_x_wind_due_to_form_drag long_name = cumulative change in x wind due to form drag @@ -372,6 +398,7 @@ type = real kind = kind_phys intent = inout + optional = True [du_ogwcol] standard_name = vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated x momentum flux from meso scale ogw @@ -380,6 +407,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_ogwcol] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from meso scale ogw @@ -388,6 +416,7 @@ type = real kind = kind_phys intent = in + optional = True [du_oblcol] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -396,6 +425,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_oblcol] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -404,6 +434,7 @@ type = real kind = kind_phys intent = in + optional = True [du_osscol] standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd @@ -412,6 +443,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_osscol] standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd @@ -420,6 +452,7 @@ type = real kind = kind_phys intent = in + optional = True [du_ofdcol] standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag @@ -428,6 +461,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_ofdcol] standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag @@ -436,6 +470,7 @@ type = real kind = kind_phys intent = in + optional = True [du3_ogwcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative integrated x momentum flux from mesoscale orographic gravity wave drag @@ -444,6 +479,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_ogwcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative integrated y momentum flux from mesoscale orographic gravity wave drag @@ -452,6 +488,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_oblcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = cumulative integrated x momentum flux from blocking drag @@ -460,6 +497,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_oblcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = cumulative integrated y momentum flux from blocking drag @@ -468,6 +506,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_osscol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = cumulative integrated x momentum flux from small scale gravity wave drag @@ -476,6 +515,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_osscol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_small_scale_gravity_wave_drag long_name = cumulative integrated y momentum flux from small scale gravity wave drag @@ -484,6 +524,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_ofdcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_form_drag long_name = cumulative integrated x momentum flux from form drag @@ -492,6 +533,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_ofdcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_form_drag long_name = cumulative integrated y momentum flux from form drag @@ -500,6 +542,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtdt] standard_name = process_split_cumulative_tendency_of_air_temperature long_name = air temperature tendency due to model physics diff --git a/physics/GWD/unified_ugwp.F90 b/physics/GWD/unified_ugwp.F90 index 0bcbc4f62..aeaa54471 100644 --- a/physics/GWD/unified_ugwp.F90 +++ b/physics/GWD/unified_ugwp.F90 @@ -40,7 +40,7 @@ module unified_ugwp use gwdps, only: gwdps_run use cires_ugwp_triggers use ugwp_driver_v0 - use drag_suite, only: drag_suite_run + use drag_suite, only: drag_suite_run, drag_suite_psl implicit none @@ -244,16 +244,16 @@ end subroutine unified_ugwp_finalize !! \htmlinclude unified_ugwp_run.html !! ! \section det_unified_ugwp GFS Unified GWP Scheme Detailed Algorithm - subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt, & + subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, kdt, & lonr, oro, oro_uf, hprime, nmtvr, oc, theta, sigma, gamma, elvmax, clx, oa4, & varss,oc1ss,oa4ss,ol4ss,dx,dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl,dusfc_ss, & dvsfc_ss,dusfc_fd,dvsfc_fd,dtaux2d_ms,dtauy2d_ms,dtaux2d_bl,dtauy2d_bl, & dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dudt_ngw,dvdt_ngw,dtdt_ngw, & - br1,hpbl,slmsk, do_tofd, ldiag_ugwp, ugwp_seq_update, & - cdmbgwd, jdat, xlat, xlat_d, sinlat, coslat, area, & + br1,hpbl,vtype,slmsk, do_tofd, ldiag_ugwp, ugwp_seq_update, & + cdmbgwd, alpha_fd, jdat, xlat, xlat_d, sinlat, coslat, area, & ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, & del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & - tau_tofd, tau_mtb, tau_ogw, tau_ngw, zmtb, zlwb, zogw, & + tau_tofd, tau_mtb, tau_ogw, tau_ngw, & dudt_mtb, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & dudt, dvdt, dtdt, rdxzb, con_g, con_omega, con_pi, con_cp, con_rd, con_rv, & con_rerth, con_fvirt, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & @@ -262,6 +262,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt index_of_process_nonorographic_gwd, & lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, & do_ugwp_v0_nst_only, do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & + do_gwd_opt_psl, psl_gwd_dx_factor, & gwd_opt, spp_wts_gwd, spp_gwd, errmsg, errflg) implicit none @@ -270,9 +271,11 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt integer, intent(in) :: me, master, im, levs, ntrac, kdt, lonr, nmtvr integer, intent(in) :: gwd_opt integer, intent(in), dimension(:) :: kpbl + integer, intent(in), dimension(:) :: vtype real(kind=kind_phys), intent(in), dimension(:) :: ak, bk real(kind=kind_phys), intent(in), dimension(:) :: oro, oro_uf, hprime, oc, theta, sigma, gamma - real(kind=kind_phys), intent(in), dimension(:) :: varss,oc1ss, dx + real(kind=kind_phys), intent(in), dimension(:) :: varss,oc1ss + real(kind=kind_phys), intent(in), dimension(:) :: dx !vay-nov 2020 real(kind=kind_phys), intent(in), dimension(:,:) :: oa4ss,ol4ss @@ -287,41 +290,41 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt real(kind=kind_phys), intent(in), dimension(:,:) :: del, ugrs, vgrs, tgrs, prsl, prslk, phil real(kind=kind_phys), intent(in), dimension(:,:) :: prsi, phii real(kind=kind_phys), intent(in), dimension(:,:) :: q1 - real(kind=kind_phys), intent(in) :: dtp, fhzero, cdmbgwd(:) + real(kind=kind_phys), intent(in) :: dtp, cdmbgwd(:), alpha_fd integer, intent(in) :: jdat(:) logical, intent(in) :: do_tofd, ldiag_ugwp, ugwp_seq_update !Output (optional): - real(kind=kind_phys), intent(out) :: & + real(kind=kind_phys), intent(out), optional :: & & dusfc_ms(:),dvsfc_ms(:), & & dusfc_bl(:),dvsfc_bl(:), & & dusfc_ss(:),dvsfc_ss(:), & & dusfc_fd(:),dvsfc_fd(:) - real(kind=kind_phys), intent(out) :: & + real(kind=kind_phys), intent(out), optional :: & & dtaux2d_ms(:,:),dtauy2d_ms(:,:), & & dtaux2d_bl(:,:),dtauy2d_bl(:,:), & & dtaux2d_ss(:,:),dtauy2d_ss(:,:), & & dtaux2d_fd(:,:),dtauy2d_fd(:,:), & & dudt_ngw(:,:),dvdt_ngw(:,:),dtdt_ngw(:,:) - - real(kind=kind_phys), intent(in) :: br1(:), & - & hpbl(:), & + real(kind=kind_phys), intent(in) :: hpbl(:), & + & br1(:), & & slmsk(:) real(kind=kind_phys), intent(out), dimension(:) :: dusfcg, dvsfcg - real(kind=kind_phys), intent(out), dimension(:) :: zmtb, zlwb, zogw, rdxzb + real(kind=kind_phys), intent(out), dimension(:) :: rdxzb real(kind=kind_phys), intent(out), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw real(kind=kind_phys), intent(out), dimension(:,:) :: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis real(kind=kind_phys), intent(out), dimension(:,:) :: dudt_mtb, dudt_tms - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) - integer, intent(in) :: dtidx(:,:), index_of_temperature, index_of_x_wind, & + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + integer, intent(in) :: dtidx(:,:) + integer, intent(in) :: index_of_temperature, index_of_x_wind, & index_of_y_wind, index_of_process_nonorographic_gwd, & index_of_process_orographic_gwd logical, intent(in) :: ldiag3d, lssav ! These arrays only allocated if ldiag_ugwp = .true. - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt @@ -342,9 +345,13 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt do_gsl_drag_ls_bl, do_gsl_drag_ss, & do_gsl_drag_tofd - real(kind=kind_phys), intent(in) :: spp_wts_gwd(:,:) + real(kind=kind_phys), intent(in), optional :: spp_wts_gwd(:,:) integer, intent(in) :: spp_gwd + ! option for psl gwd + logical, intent(in) :: do_gwd_opt_psl ! option for psl gravity wave drag + real(kind=kind_phys), intent(in) :: psl_gwd_dx_factor ! + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -378,6 +385,18 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt errflg = 0 + ! Initialize intent(out) variables in case they are not set below + dusfcg(:) = 0.0 + dvsfcg(:) = 0.0 + rdxzb(:) = 0.0 + tau_ngw(:) = 0.0 + gw_dudt(:,:) = 0.0 + gw_dvdt(:,:) = 0.0 + gw_dtdt(:,:) = 0.0 + gw_kdis(:,:) = 0.0 + dudt_mtb(:,:) = 0.0 + dudt_tms(:,:) = 0.0 + ! 1) ORO stationary GWs ! ------------------ @@ -487,7 +506,27 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt ! Note: In case of GSL drag_suite, this includes ss and tofd if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd ) then - +! + if (do_gwd_opt_psl) then + call drag_suite_psl(im,levs,dvdt,dudt,dtdt,uwnd1,vwnd1, & + tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & + kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & + ol4ss,theta,sigma,gamma,elvmax,dtaux2d_ms, & + dtauy2d_ms,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss, & + dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dusfcg, & + dvsfcg,dusfc_ms,dvsfc_ms,dusfc_bl,dvsfc_bl, & + dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & + slmsk,br1,hpbl,vtype,con_g,con_cp,con_rd,con_rv, & + con_fvirt,con_pi,lonr, & + cdmbgwd,alpha_fd,me,master, & + lprnt,ipr,rdxzb,dx,gwd_opt, & + do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & + psl_gwd_dx_factor, & + dtend, dtidx, index_of_process_orographic_gwd, & + index_of_temperature, index_of_x_wind, & + index_of_y_wind, ldiag3d, ldiag_ugwp, & + ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg) + else call drag_suite_run(im,levs,dvdt,dudt,dtdt,uwnd1,vwnd1, & tgrs,q1,kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & @@ -498,12 +537,14 @@ subroutine unified_ugwp_run(me, master, im, levs, ak,bk, ntrac, dtp, fhzero, kdt dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & con_fvirt,con_pi,lonr, & - cdmbgwd,me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & + cdmbgwd,alpha_fd,me,master, & + lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & dtend, dtidx, index_of_process_orographic_gwd, & index_of_temperature, index_of_x_wind, & index_of_y_wind, ldiag3d, ldiag_ugwp, & ugwp_seq_update, spp_wts_gwd, spp_gwd, errmsg, errflg) + endif ! ! put zeros due to xy GSL-drag style: dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ms,dvsfc_ms ! diff --git a/physics/GWD/unified_ugwp.meta b/physics/GWD/unified_ugwp.meta index a08ee3960..62db52127 100644 --- a/physics/GWD/unified_ugwp.meta +++ b/physics/GWD/unified_ugwp.meta @@ -331,14 +331,6 @@ type = real kind = kind_phys intent = in -[fhzero] - standard_name = period_of_diagnostics_reset - long_name = hours between clearing of diagnostic buckets - units = h - dimensions = () - type = real - kind = kind_phys - intent = in [kdt] standard_name = index_of_timestep long_name = current forecast iteration @@ -488,6 +480,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_ms] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from mesoscale gwd @@ -496,6 +489,7 @@ type = real kind = kind_phys intent = out + optional = True [dusfc_bl] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -504,6 +498,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_bl] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -512,6 +507,7 @@ type = real kind = kind_phys intent = out + optional = True [dusfc_ss] standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd @@ -520,6 +516,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_ss] standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd @@ -528,6 +525,7 @@ type = real kind = kind_phys intent = out + optional = True [dusfc_fd] standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag @@ -536,6 +534,7 @@ type = real kind = kind_phys intent = out + optional = True [dvsfc_fd] standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag @@ -544,6 +543,7 @@ type = real kind = kind_phys intent = out + optional = True [dtaux2d_ms] standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in x wind due to orographic gw drag @@ -552,6 +552,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_ms] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in y wind due to orographic gw drag @@ -560,6 +561,7 @@ type = real kind = kind_phys intent = out + optional = True [dtaux2d_bl] standard_name = tendency_of_x_wind_due_to_blocking_drag long_name = x wind tendency from blocking drag @@ -568,6 +570,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_bl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -576,6 +579,7 @@ type = real kind = kind_phys intent = out + optional = True [dtaux2d_ss] standard_name = tendency_of_x_wind_due_to_small_scale_gravity_wave_drag long_name = x wind tendency from small scale gwd @@ -584,6 +588,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_ss] standard_name = tendency_of_y_wind_due_to_small_scale_gravity_wave_drag long_name = y wind tendency from small scale gwd @@ -592,6 +597,7 @@ type = real kind = kind_phys intent = out + optional = True [dtaux2d_fd] standard_name = tendency_of_x_wind_due_to_form_drag long_name = x wind tendency from form drag @@ -600,6 +606,7 @@ type = real kind = kind_phys intent = out + optional = True [dtauy2d_fd] standard_name = tendency_of_y_wind_due_to_form_drag long_name = y wind tendency from form drag @@ -608,6 +615,7 @@ type = real kind = kind_phys intent = out + optional = True [dudt_ngw] standard_name = tendency_of_x_wind_due_to_nonorographic_gravity_wave_drag long_name = zonal wind tendency due to non-stationary GWs @@ -616,6 +624,7 @@ type = real kind = kind_phys intent = out + optional = True [dvdt_ngw] standard_name = tendency_of_y_wind_due_to_nonorographic_gravity_wave_drag long_name = meridional wind tendency due to non-stationary GWs @@ -624,6 +633,7 @@ type = real kind = kind_phys intent = out + optional = True [dtdt_ngw] standard_name = tendency_of_air_temperature_due_to_nonorographic_gravity_wave_drag long_name = air temperature tendency due to non-stationary GWs @@ -632,6 +642,7 @@ type = real kind = kind_phys intent = out + optional = True [br1] standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface @@ -648,6 +659,13 @@ type = real kind = kind_phys intent = in +[vtype] + standard_name = vegetation_type_classification + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in [slmsk] standard_name = area_type long_name = landmask: sea/land/ice=0/1/2 @@ -685,6 +703,14 @@ type = real kind = kind_phys intent = in +[alpha_fd] + standard_name = alpha_coefficient_for_turbulent_orographic_form_drag + long_name = alpha coefficient for Beljaars et al turbulent orographic form drag + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in [jdat] standard_name = date_and_time_of_forecast_in_united_states_order long_name = current forecast date and time @@ -900,30 +926,6 @@ type = real kind = kind_phys intent = out -[zmtb] - standard_name = height_of_mountain_blocking - long_name = height of mountain blocking drag - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[zlwb] - standard_name = height_of_low_level_wave_breaking - long_name = height of low level wave breaking - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[zogw] - standard_name = height_of_launch_level_of_orographic_gravity_wave - long_name = height of launch level of orographic gravity wave - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out [dudt_mtb] standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag long_name = instantaneous change in x wind due to mountain blocking drag @@ -948,6 +950,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ogw] standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag @@ -956,6 +959,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_tms] standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD @@ -964,6 +968,7 @@ type = real kind = kind_phys intent = inout + optional = True [dudt] standard_name = process_split_cumulative_tendency_of_x_wind long_name = zonal wind tendency due to model physics @@ -1120,6 +1125,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -1218,6 +1224,21 @@ dimensions = () type = logical intent = in +[do_gwd_opt_psl] + standard_name = do_gsl_drag_suite_with_psl_gwd_option + long_name = flag to activate PSL drag suite - mesoscale GWD and blocking + units = flag + dimensions = () + type = logical + intent = in +[psl_gwd_dx_factor] + standard_name = effective_grid_spacing_of_psl_gwd_suite + long_name = multiplication of grid spacing + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in [gwd_opt] standard_name = control_for_drag_suite_gravity_wave_drag long_name = flag to choose gwd scheme @@ -1233,6 +1254,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_gwd] standard_name = control_for_gravity_wave_drag_spp_perturbations long_name = control for gravity wave drag spp perturbations diff --git a/physics/GWD/unified_ugwp_post.F90 b/physics/GWD/unified_ugwp_post.F90 index 9c3717546..47ad40ba9 100644 --- a/physics/GWD/unified_ugwp_post.F90 +++ b/physics/GWD/unified_ugwp_post.F90 @@ -42,23 +42,24 @@ subroutine unified_ugwp_post_run (ldiag3d, ldiag_ugwp, & real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_ogw, dvdt_ogw, dudt_tms - real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ogw, ldu3dt_obl, ldu3dt_oss, ldu3dt_ofd - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_ngw, dvdt_ngw, dtdt_ngw - real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_obl, dvdt_obl - real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd - real(kind=kind_phys), intent(inout), dimension(:,:) :: dws3dt_obl, dws3dt_ogw - real(kind=kind_phys), intent(inout), dimension(:,:) :: dws3dt_oss, dws3dt_ofd - real(kind=kind_phys), intent(in), dimension(:) :: du_ogwcol, dv_ogwcol - real(kind=kind_phys), intent(in), dimension(:) :: du_oblcol, dv_oblcol - real(kind=kind_phys), intent(in), dimension(:) :: du_osscol, dv_osscol - real(kind=kind_phys), intent(in), dimension(:) :: du_ofdcol, dv_ofdcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_ogwcol, dv3_ogwcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_oblcol, dv3_oblcol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_osscol, dv3_osscol - real(kind=kind_phys), intent(inout), dimension(:) :: du3_ofdcol, dv3_ofdcol + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_ogw, dvdt_ogw + real(kind=kind_phys), intent(in), dimension(:,:) :: dudt_tms + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: ldu3dt_ogw, ldu3dt_obl, ldu3dt_oss, ldu3dt_ofd + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_ngw, dvdt_ngw, dtdt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_obl, dvdt_obl + real(kind=kind_phys), intent(in), dimension(:,:), optional :: dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: dws3dt_obl, dws3dt_ogw + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: dws3dt_oss, dws3dt_ofd + real(kind=kind_phys), intent(in), dimension(:), optional :: du_ogwcol, dv_ogwcol + real(kind=kind_phys), intent(in), dimension(:), optional :: du_oblcol, dv_oblcol + real(kind=kind_phys), intent(in), dimension(:), optional :: du_osscol, dv_osscol + real(kind=kind_phys), intent(in), dimension(:), optional :: du_ofdcol, dv_ofdcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_ogwcol, dv3_ogwcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_oblcol, dv3_oblcol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_osscol, dv3_osscol + real(kind=kind_phys), intent(inout), dimension(:), optional :: du3_ofdcol, dv3_ofdcol real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt character(len=*), intent(out) :: errmsg diff --git a/physics/GWD/unified_ugwp_post.meta b/physics/GWD/unified_ugwp_post.meta index 7784c28ec..d129b046f 100644 --- a/physics/GWD/unified_ugwp_post.meta +++ b/physics/GWD/unified_ugwp_post.meta @@ -139,6 +139,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ogw] standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = y momentum tendency from meso scale ogw @@ -147,6 +148,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_tms] standard_name = tendency_of_x_wind_due_to_turbulent_orographic_form_drag long_name = instantaneous change in x wind due to TOFD @@ -219,6 +221,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ogw] standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag @@ -227,6 +230,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_tms] standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD @@ -235,6 +239,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3dt_ngw] standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in x wind due to NGW @@ -243,6 +248,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3dt_ngw] standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in y wind due to NGW @@ -251,6 +257,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_ogw] standard_name = cumulative_change_in_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative change in x wind due to mesoscale orographic gravity wave drag @@ -259,6 +266,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_obl] standard_name = cumulative_change_in_x_wind_due_to_blocking_drag long_name = cumulative change in x wind due to blocking drag @@ -267,6 +275,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_oss] standard_name = cumulative_change_in_x_wind_due_to_small_scale_gravity_wave_drag long_name = cumulative change in x wind due to small scale gravity wave drag @@ -275,6 +284,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldu3dt_ofd] standard_name = cumulative_change_in_x_wind_due_to_form_drag long_name = cumulative change in x wind due to form drag @@ -283,6 +293,7 @@ type = real kind = kind_phys intent = inout + optional = True [dudt_ngw] standard_name = tendency_of_x_wind_due_to_nonorographic_gravity_wave_drag long_name = zonal wind tendency due to non-stationary GWs @@ -291,6 +302,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ngw] standard_name = tendency_of_y_wind_due_to_nonorographic_gravity_wave_drag long_name = meridional wind tendency due to non-stationary GWs @@ -299,6 +311,7 @@ type = real kind = kind_phys intent = in + optional = True [dtdt_ngw] standard_name = tendency_of_air_temperature_due_to_nonorographic_gravity_wave_drag long_name = air temperature tendency due to non-stationary GWs @@ -307,6 +320,7 @@ type = real kind = kind_phys intent = in + optional = True [ldu3dt_ngw] standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in x wind due to convective gravity wave drag @@ -315,6 +329,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldv3dt_ngw] standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in y wind due to convective gravity wave drag @@ -323,6 +338,7 @@ type = real kind = kind_phys intent = inout + optional = True [ldt3dt_ngw] standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag long_name = cumulative change in temperature due to convective gravity wave drag @@ -331,6 +347,7 @@ type = real kind = kind_phys intent = inout + optional = True [dudt_obl] standard_name = tendency_of_x_wind_due_to_blocking_drag long_name = x wind tendency from blocking drag @@ -339,6 +356,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_obl] standard_name = tendency_of_y_wind_due_to_blocking_drag long_name = y wind tendency from blocking drag @@ -347,6 +365,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_oss] standard_name = tendency_of_x_wind_due_to_small_scale_gravity_wave_drag long_name = x wind tendency from small scale gwd @@ -355,6 +374,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_oss] standard_name = tendency_of_y_wind_due_to_small_scale_gravity_wave_drag long_name = y wind tendency from small scale gwd @@ -363,6 +383,7 @@ type = real kind = kind_phys intent = in + optional = True [dudt_ofd] standard_name = tendency_of_x_wind_due_to_form_drag long_name = x wind tendency from form drag @@ -371,6 +392,7 @@ type = real kind = kind_phys intent = in + optional = True [dvdt_ofd] standard_name = tendency_of_y_wind_due_to_form_drag long_name = y wind tendency from form drag @@ -379,6 +401,7 @@ type = real kind = kind_phys intent = in + optional = True [dws3dt_ogw] standard_name = cumulative_change_in_wind_speed_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative change in wind speed due to mesoscale orographic gravity wave drag @@ -387,6 +410,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_obl] standard_name = cumulative_change_in_wind_speed_due_to_blocking_drag long_name = cumulative change in wind speed due to blocking drag @@ -395,6 +419,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_oss] standard_name = cumulative_change_in_wind_speed_due_to_small_scale_orographic_gravity_wave_drag long_name = cumulative change in wind speed due to small scale orographic gravity wave drag @@ -403,6 +428,7 @@ type = real kind = kind_phys intent = inout + optional = True [dws3dt_ofd] standard_name = cumulative_change_in_wind_speed_due_to_turbulent_orographic_form_drag long_name = cumulative change in wind speed due to turbulent orographic form drag @@ -411,6 +437,7 @@ type = real kind = kind_phys intent = inout + optional = True [du_ogwcol] standard_name = vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated x momentum flux from meso scale ogw @@ -419,6 +446,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_ogwcol] standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from meso scale ogw @@ -427,6 +455,7 @@ type = real kind = kind_phys intent = in + optional = True [du_oblcol] standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag @@ -435,6 +464,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_oblcol] standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag @@ -443,6 +473,7 @@ type = real kind = kind_phys intent = in + optional = True [du_osscol] standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd @@ -451,6 +482,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_osscol] standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd @@ -459,6 +491,7 @@ type = real kind = kind_phys intent = in + optional = True [du_ofdcol] standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag @@ -467,6 +500,7 @@ type = real kind = kind_phys intent = in + optional = True [dv_ofdcol] standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag @@ -475,6 +509,7 @@ type = real kind = kind_phys intent = in + optional = True [du3_ogwcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative integrated x momentum flux from mesoscale orographic gravity wave drag @@ -483,6 +518,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_ogwcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = cumulative integrated y momentum flux from mesoscale orographic gravity wave drag @@ -491,6 +527,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_oblcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = cumulative integrated x momentum flux from blocking drag @@ -499,6 +536,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_oblcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = cumulative integrated y momentum flux from blocking drag @@ -507,6 +545,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_osscol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = cumulative integrated x momentum flux from small scale gravity wave drag @@ -515,6 +554,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_osscol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_small_scale_gravity_wave_drag long_name = cumulative integrated y momentum flux from small scale gravity wave drag @@ -523,6 +563,7 @@ type = real kind = kind_phys intent = inout + optional = True [du3_ofdcol] standard_name = cumulative_vertically_integrated_x_momentum_flux_due_to_form_drag long_name = cumulative integrated x momentum flux from form drag @@ -531,6 +572,7 @@ type = real kind = kind_phys intent = inout + optional = True [dv3_ofdcol] standard_name = cumulative_vertically_integrated_y_momentum_flux_due_to_form_drag long_name = cumulative integrated y momentum flux from form drag @@ -539,6 +581,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtdt] standard_name = process_split_cumulative_tendency_of_air_temperature long_name = air temperature tendency due to model physics diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 index 3b69849a7..62e5f4862 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.F90 @@ -15,8 +15,8 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & index_of_temperature, index_of_x_wind, index_of_y_wind, ntqv, gq0, save_q, & cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, & ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & - ntgnc, nthl, nthnc, nthv, ntgv, ntrz, ntgz, nthz, ntsigma, ntrac,clw, & - satmedmf, trans_trac, errmsg, errflg) + ntgnc, nthl, nthnc, nthv, ntgv, ntrz, ntgz, nthz, ntsigma, ntomega, & + ntrac,clw,satmedmf, trans_trac, errmsg, errflg) use machine, only: kind_phys @@ -32,25 +32,26 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & real(kind=kind_phys), dimension(:,:), intent(in) :: save_u, save_v, save_t real(kind=kind_phys), dimension(:,:), intent(in) :: gu0, gv0, gt0 real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q - real(kind=kind_phys), dimension(:,:), intent(in) :: ud_mf, dd_mf, dt_mf + real(kind=kind_phys), dimension(:,:), intent(in) :: dd_mf, dt_mf + real(kind=kind_phys), dimension(:,:), intent(in), optional :: ud_mf real(kind=kind_phys), intent(in) :: con_g integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d logical, intent(in) :: satmedmf, trans_trac real(kind=kind_phys), dimension(:), intent(inout) :: rainc, cldwrk - real(kind=kind_phys), dimension(:,:), intent(inout) :: upd_mf, dwn_mf, det_mf + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: upd_mf, dwn_mf, det_mf real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw, cnvc - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + real(kind=kind_phys), dimension(:,:,:), intent(inout), optional :: dtend integer, intent(in) :: dtidx(:,:), index_of_process_dcnv, index_of_temperature, & index_of_x_wind, index_of_y_wind, ntqv integer, intent(in) :: ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & ntgnc, nthl, nthnc, nthv, ntgv, ntrz, ntgz, nthz, & - ntsigma, ntrac + ntsigma, ntomega, ntrac real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw - real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: cnvw_phy_f3d, cnvc_phy_f3d character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -114,7 +115,7 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, & n /= ntsnc .and. n /= ntgl .and. n /= ntgnc .and. & n /= nthl .and. n /= nthnc .and. n /= nthv .and. & n /= ntrz .and. n /= ntgz .and. n /= nthz .and. & - n /= ntgv .and. n /= ntsigma) then + n /= ntgv .and. n /= ntsigma .and. n /= ntomega) then tracers = tracers + 1 idtend = dtidx(100+n,index_of_process_dcnv) if(idtend>0) then diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta index ab8982e11..1498afa53 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_post.meta @@ -138,6 +138,7 @@ type = real kind = kind_phys intent = in + optional = True [dd_mf] standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt @@ -162,6 +163,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -280,6 +282,7 @@ type = real kind = kind_phys intent = inout + optional = True [dwn_mf] standard_name = cumulative_atmosphere_downdraft_convective_mass_flux long_name = cumulative downdraft mass flux @@ -288,6 +291,7 @@ type = real kind = kind_phys intent = inout + optional = True [det_mf] standard_name = cumulative_atmosphere_detrainment_convective_mass_flux long_name = cumulative detrainment mass flux @@ -296,6 +300,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnvw] standard_name = convective_cloud_water_mixing_ratio long_name = moist convective cloud water mixing ratio @@ -320,6 +325,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnvc_phy_f3d] standard_name = convective_cloud_area_fraction long_name = convective cloud cover in the phy_f3d array @@ -328,6 +334,7 @@ type = real kind = kind_phys intent = inout + optional = True [flag_for_dcnv_generic_tend] standard_name = flag_for_generic_tendency_due_to_deep_convection long_name = true if GFS_DCNV_generic should calculate tendencies @@ -363,6 +370,13 @@ dimensions = () type = integer intent = in +[ntomega] + standard_name = index_of_updraft_velocity_in_tracer_concentration_array + long_name = tracer index of updraft_velocity + units = index + dimensions = () + type = integer + intent = in [ntcw] standard_name = index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array long_name = tracer index for cloud condensate (or liquid water) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 index 1dd3aafc7..7bb47ac9b 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.F90 @@ -14,7 +14,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc save_u, save_v, save_t, save_q, clw, & ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl, & ntgnc, nthl, nthnc, nthv, ntgv, & - ntrz, ntgz, nthz, ntsigma, & + ntrz, ntgz, nthz, ntsigma, ntomega, & cscnv, satmedmf, trans_trac, ras, ntrac, & dtidx, index_of_process_dcnv, errmsg, errflg) @@ -24,7 +24,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc integer, intent(in) :: im, levs, nsamftrac, ntqv, index_of_process_dcnv, dtidx(:,:), & ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntrac,ntgnc,nthl,nthnc,nthv,ntgv, & - ntrz, ntgz, nthz, ntsigma + ntrz, ntgz, nthz, ntsigma, ntomega logical, intent(in) :: ldiag3d, qdiag3d, do_cnvgwd, cplchm real(kind=kind_phys), dimension(:,:), intent(in) :: gu0 real(kind=kind_phys), dimension(:,:), intent(in) :: gv0 @@ -71,7 +71,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplc n /= ntsnc .and. n /= ntgl .and. n /= ntgnc .and. & n /= nthl .and. n /= nthnc .and. n /= nthv .and. & n /= ntrz .and. n /= ntgz .and. n /= nthz .and. & - n /= ntgv .and. n/= ntsigma) then + n /= ntgv .and. n/= ntsigma .and. n /= ntomega) then tracers = tracers + 1 if(dtidx(100+n,index_of_process_dcnv)>0) then save_q(:,:,n) = clw(:,:,tracers) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta index ec1c59810..15fb106e7 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_DCNV_generic_pre.meta @@ -126,7 +126,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = in + intent = inout [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -176,6 +176,13 @@ dimensions = () type = integer intent = in +[ntomega] + standard_name = index_of_updraft_velocity_in_tracer_concentration_array + long_name = tracer index of updraft_velocity + units = index + dimensions = () + type = integer + intent = in [ntcw] standard_name = index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array long_name = tracer index for cloud condensate (or liquid water) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 index 58f18567d..579d32fac 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.F90 @@ -27,7 +27,7 @@ subroutine GFS_GWD_generic_post_run(lssav, ldiag3d, dtf, dusfcg, dvsfcg, dudt, d real(kind=kind_phys), intent(inout) :: dugwd(:), dvgwd(:) ! dtend only allocated only if ldiag3d is .true. - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), index_of_temperature, & & index_of_x_wind, index_of_y_wind, index_of_process_orographic_gwd diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta index beca39282..a11b8641d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_post.meta @@ -94,6 +94,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 index 51a76c989..f0d708d5b 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.F90 @@ -9,7 +9,6 @@ module GFS_GWD_generic_pre !> \section arg_table_GFS_GWD_generic_pre_run Argument Table !! \htmlinclude GFS_GWD_generic_pre_run.html !! -!! \section gfs_gwd_ge_pre_ga General Algorithm subroutine GFS_GWD_generic_pre_run( & & im, levs, nmtvr, mntvar, & & oc, oa4, clx, theta, & @@ -28,13 +27,13 @@ subroutine GFS_GWD_generic_pre_run( & real(kind=kind_phys), intent(out) :: & & oc(:), oa4(:,:), clx(:,:), & - & varss(:), ocss(:), oa4ss(:,:), clxss(:,:), & & theta(:), sigma(:), gamma(:), elvmax(:) - + real(kind=kind_phys), intent(out), optional :: & + & varss(:), ocss(:), oa4ss(:,:), clxss(:,:) logical, intent(in) :: lssav, ldiag3d, flag_for_gwd_generic_tend real(kind=kind_phys), intent(in) :: dtdt(:,:), dudt(:,:), dvdt(:,:) ! dtend only allocated only if ldiag3d is .true. - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), index_of_temperature, & & index_of_x_wind, index_of_y_wind, index_of_process_orographic_gwd real(kind=kind_phys), intent(in) :: dtf diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta index dbbfc261d..8321c7d32 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_GWD_generic_pre.meta @@ -76,6 +76,7 @@ type = real kind = kind_phys intent = out + optional = True [ocss] standard_name = convexity_of_subgrid_orography_small_scale long_name = convexity of subgrid height_above_mean_sea_level small scale @@ -84,6 +85,7 @@ type = real kind = kind_phys intent = out + optional = True [oa4ss] standard_name = asymmetry_of_subgrid_orography_small_scale long_name = asymmetry of subgrid height_above_mean_sea_level small scale @@ -92,6 +94,7 @@ type = real kind = kind_phys intent = out + optional = True [clxss] standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale long_name = horizontal fraction of grid box covered by subgrid height_above_mean_sea_level higher than critical height small scale @@ -100,6 +103,7 @@ type = real kind = kind_phys intent = out + optional = True [sigma] standard_name = slope_of_subgrid_orography long_name = slope of subgrid height_above_mean_sea_level @@ -170,6 +174,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 index d9d30fb90..ce2a2a9e2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.F90 @@ -8,26 +8,23 @@ module GFS_MP_generic_post contains -!>\defgroup gfs_calpreciptype GFS Precipitation Type Diagnostics Module -!! \brief If dominant precip type is requested (i.e., Zhao-Carr MP scheme), 4 more algorithms in calpreciptype() +!> If dominant precip type is requested (i.e., Zhao-Carr MP scheme), 4 more algorithms in calpreciptype() !! will be called. the tallies are then summed in calwxt_dominant(). For GFDL cloud MP scheme, determine convective !! rain/snow by surface temperature; and determine explicit rain/snow by rain/snow coming out directly from MP. !! !> \section arg_table_GFS_MP_generic_post_run Argument Table !! \htmlinclude GFS_MP_generic_post_run.html !! -!> \section gfs_mp_gen GFS MP Generic Post General Algorithm -!> @{ subroutine GFS_MP_generic_post_run( & - im, levs, kdt, nrcm, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_nssl, & - imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, cpllnd, progsigma, con_g, rhowater, rainmin, dtf, & - frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, phil, htop, refl_10cm, & - imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf, con_t0c, snow, graupel, save_t, save_q, & - rain0, ice0, snow0, graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp,& - totprcp, totice, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, snow_cpl, & - pwat, frzr, frzrb, frozr, frozrb, tsnowp, tsnowpb, rhonewsn1, exticeden, & + im, levs, kdt, nrcm, nncl, ntcw, ntrac, imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_tempo, & + imp_physics_nssl, imp_physics_mg, imp_physics_fer_hires, cal_pre, cplflx, cplchm, cpllnd, progsigma, con_g, & + rhowater, rainmin, dtf, frain, rainc, rain1, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, phil, htop, & + refl_10cm, imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf, con_t0c, snow, graupel, save_t, & + save_q, rain0, ice0, snow0, graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, & + cnvprcp, totprcp, totice, totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, rain_cpl, rainc_cpl, & + snow_cpl, pwat, frzr, frzrb, frozr, frozrb, tsnowp, tsnowpb, rhonewsn1, exticeden, & drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & - graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, dfi_radar_max_intervals, & + graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, num_diag_buckets, & dtend, dtidx, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d,dqdt_qmicro, lssav, num_dfi_radar, & fh_dfi_radar,index_of_process_dfi_radar, ix_dfi_radar, dfi_radar_tten, radar_tten_limits, fhour, prevsq, & iopt_lake, iopt_lake_clm, lkm, use_lake_model, errmsg, errflg) @@ -38,52 +35,53 @@ subroutine GFS_MP_generic_post_run( integer, intent(in) :: im, levs, kdt, nrcm, nncl, ntcw, ntrac, num_dfi_radar, index_of_process_dfi_radar integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires - integer, intent(in) :: imp_physics_nssl, iopt_lake_clm, iopt_lake, lkm + integer, intent(in) :: imp_physics_nssl, iopt_lake_clm, iopt_lake, lkm, imp_physics_tempo logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm, cpllnd, progsigma, exticeden integer, intent(in) :: index_of_temperature,index_of_process_mp,use_lake_model(:) integer, intent(in) :: imfshalcnv,imfshalcnv_gf,imfdeepcnv,imfdeepcnv_gf,imfdeepcnv_samf + integer, intent(in) :: num_diag_buckets integer, dimension (:), intent(in) :: htop - integer :: dfi_radar_max_intervals real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour, con_t0c real(kind=kind_phys), intent(in) :: radar_tten_limits(:) - integer :: ix_dfi_radar(:) + integer, intent(in) :: ix_dfi_radar(:) real(kind=kind_phys), dimension(:,:), intent(inout) :: gt0,refl_10cm real(kind=kind_phys), intent(in) :: dtf, frain, con_g, rainmin, rhowater real(kind=kind_phys), dimension(:), intent(in) :: rain1, xlat, xlon, tsfc real(kind=kind_phys), dimension(:), intent(inout) :: ice, snow, graupel, rainc - real(kind=kind_phys), dimension(:), intent(in) :: rain0, ice0, snow0, graupel0 + real(kind=kind_phys), dimension(:), intent(in), optional :: rain0, ice0, snow0, graupel0 real(kind=kind_phys), dimension(:,:), intent(in) :: rann real(kind=kind_phys), dimension(:,:), intent(in) :: prsl, save_t, del real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, phii,phil real(kind=kind_phys), dimension(:,:,:), intent(in) :: gq0, save_q - real(kind=kind_phys), dimension(:,:,:), intent(in) :: dfi_radar_tten + real(kind=kind_phys), dimension(:,:,:), intent(in), optional :: dfi_radar_tten real(kind=kind_phys), dimension(:), intent(in ) :: sr real(kind=kind_phys), dimension(:), intent(inout) :: rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, & - srflag, cnvprcp, totprcp, totice, totsnw, totgrp, cnvprcpb, & - totprcpb, toticeb, totsnwb, totgrpb, pwat - real(kind=kind_phys), dimension(:), intent(inout) :: rain_cpl, rainc_cpl, snow_cpl + srflag, cnvprcp, totprcp, totice, totsnw, totgrp, & + toticeb, totsnwb, totgrpb, pwat + real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvprcpb, totprcpb + real(kind=kind_phys), dimension(:), intent(inout), optional :: rain_cpl, rainc_cpl, snow_cpl - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + real(kind=kind_phys), dimension(:,:,:), intent(inout), optional :: dtend integer, dimension(:,:), intent(in) :: dtidx ! Stochastic physics / surface perturbations - real(kind=kind_phys), dimension(:), intent(inout) :: drain_cpl, dsnow_cpl + real(kind=kind_phys), dimension(:), intent(inout), optional :: drain_cpl, dsnow_cpl ! Rainfall variables previous time step integer, intent(in) :: lsm, lsm_ruc, lsm_noahmp - real(kind=kind_phys), dimension(:), intent(inout) :: raincprv - real(kind=kind_phys), dimension(:), intent(inout) :: rainncprv - real(kind=kind_phys), dimension(:), intent(inout) :: iceprv - real(kind=kind_phys), dimension(:), intent(inout) :: snowprv - real(kind=kind_phys), dimension(:), intent(inout) :: graupelprv - real(kind=kind_phys), dimension(:), intent(inout) :: draincprv - real(kind=kind_phys), dimension(:), intent(inout) :: drainncprv - real(kind=kind_phys), dimension(:), intent(inout) :: diceprv - real(kind=kind_phys), dimension(:), intent(inout) :: dsnowprv - real(kind=kind_phys), dimension(:), intent(inout) :: dgraupelprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: raincprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: rainncprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: iceprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: snowprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: graupelprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: draincprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: drainncprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: diceprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: dsnowprv + real(kind=kind_phys), dimension(:), intent(inout), optional :: dgraupelprv real(kind=kind_phys), dimension(:), intent(inout) :: frzr real(kind=kind_phys), dimension(:), intent(inout) :: frzrb real(kind=kind_phys), dimension(:), intent(inout) :: frozr @@ -91,8 +89,8 @@ subroutine GFS_MP_generic_post_run( real(kind=kind_phys), dimension(:), intent(inout) :: tsnowp real(kind=kind_phys), dimension(:), intent(inout) :: tsnowpb real(kind=kind_phys), dimension(:), intent(inout) :: rhonewsn1 - real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdt_qmicro - real(kind=kind_phys), dimension(:,:), intent(inout) :: prevsq + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: dqdt_qmicro + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: prevsq real(kind=kind_phys), intent(in) :: dtp ! CCPP error handling @@ -105,7 +103,7 @@ subroutine GFS_MP_generic_post_run( real(kind=kind_phys), parameter :: p850 = 85000.0_kind_phys ! *DH - integer :: i, k, ic, itrac, idtend, itime, idtend_radar, idtend_mp + integer :: i, k, ic, itrac, idtend, itime, idtend_radar, idtend_mp, ib real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys real(kind=kind_phys) :: crain, csnow, onebg, tem, total_precip, tem1, tem2, ttend @@ -137,7 +135,7 @@ subroutine GFS_MP_generic_post_run( ! ! Combine convective reflectivity with MP reflectivity for selected ! parameterizations. - if ( (imp_physics==imp_physics_thompson .or. imp_physics==imp_physics_nssl) .and. & + if ( (imp_physics==imp_physics_thompson .or. imp_physics==imp_physics_tempo .or. imp_physics==imp_physics_nssl) .and. & (imfdeepcnv==imfdeepcnv_samf .or. imfdeepcnv==imfdeepcnv_gf .or. imfshalcnv==imfshalcnv_gf) ) then do i=1,im factor(i) = 0.0 @@ -182,7 +180,8 @@ subroutine GFS_MP_generic_post_run( endif ! compute surface snowfall, graupel/sleet, freezing rain and precip ice density - if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_nssl ) then + if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson .or. & + imp_physics == imp_physics_tempo .or. imp_physics == imp_physics_nssl ) then do i = 1, im if (gt0(i,1) .le. 273) then frzr(i) = frzr(i) + rain0(i) @@ -260,7 +259,7 @@ subroutine GFS_MP_generic_post_run( ice = ice0 snow = snow0 ! Do it right from the beginning for Thompson - else if (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_nssl ) then + else if (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo .or. imp_physics == imp_physics_nssl ) then tprcp = max (zero, rainc + frain * rain1) ! time-step convective and explicit precip graupel = frain*graupel0 ! time-step graupel ice = frain*ice0 ! time-step ice @@ -306,7 +305,8 @@ subroutine GFS_MP_generic_post_run( ! ! HCHUANG: use new precipitation type to decide snow flag for LSM snow accumulation - if (imp_physics /= imp_physics_gfdl .and. imp_physics /= imp_physics_thompson .and. imp_physics /= imp_physics_nssl) then + if (imp_physics /= imp_physics_gfdl .and. imp_physics /= imp_physics_thompson .and. & + imp_physics /= imp_physics_tempo .and. imp_physics /= imp_physics_nssl) then do i=1,im tprcp(i) = max(zero, rain(i) ) if(doms(i) > zero .or. domip(i) > zero) then @@ -394,7 +394,7 @@ subroutine GFS_MP_generic_post_run( !! \f$0^oC\f$. if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson .or. & - imp_physics == imp_physics_nssl ) then + imp_physics == imp_physics_tempo .or. imp_physics == imp_physics_nssl ) then ! determine convective rain/snow by surface temperature ! determine large-scale rain/snow by rain/snow coming out directly from MP @@ -453,7 +453,7 @@ subroutine GFS_MP_generic_post_run( if_save_fields: if (lssav) then ! if (Model%me == 0) print *,'in phys drive, kdt=',Model%kdt, & -! 'totprcpb=', Diag%totprcpb(1),'totprcp=',Diag%totprcp(1), & +! 'totprcpb=', Diag%totprcpb(1,1),'totprcp=',Diag%totprcp(1), & ! 'rain=',Diag%rain(1) do i=1,im cnvprcp (i) = cnvprcp (i) + rainc(i) @@ -462,12 +462,16 @@ subroutine GFS_MP_generic_post_run( totsnw (i) = totsnw (i) + snow(i) totgrp (i) = totgrp (i) + graupel(i) - cnvprcpb(i) = cnvprcpb(i) + rainc(i) - totprcpb(i) = totprcpb(i) + rain(i) toticeb (i) = toticeb (i) + ice(i) totsnwb (i) = totsnwb (i) + snow(i) totgrpb (i) = totgrpb (i) + graupel(i) enddo + do ib=1,num_diag_buckets + do i=1,im + cnvprcpb(i,ib) = cnvprcpb(i,ib) + rainc(i) + totprcpb(i,ib) = totprcpb(i,ib) + rain(i) + enddo + enddo if_tendency_diagnostics: if (ldiag3d) then idtend = dtidx(index_of_temperature,index_of_process_mp) @@ -546,6 +550,5 @@ subroutine GFS_MP_generic_post_run( endif end subroutine GFS_MP_generic_post_run -!> @} end module GFS_MP_generic_post diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta index 7f67aa925..ea1b456e3 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_MP_generic_post.meta @@ -86,6 +86,13 @@ dimensions = () type = integer intent = in +[imp_physics_tempo] + standard_name = identifier_for_tempo_microphysics_scheme + long_name = choice of TEMPO microphysics scheme + units = flag + dimensions = () + type = integer + intent = in [imp_physics_mg] standard_name = identifier_for_morrison_gettelman_microphysics_scheme long_name = choice of Morrison-Gettelman microphysics scheme @@ -430,7 +437,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) type = real kind = kind_phys - intent = inout + intent = in [rain0] standard_name = lwe_thickness_of_explicit_rain_amount long_name = explicit rain on physics timestep @@ -439,6 +446,7 @@ type = real kind = kind_phys intent = in + optional = True [ice0] standard_name = lwe_thickness_of_ice_amount long_name = ice fall on physics timestep @@ -447,6 +455,7 @@ type = real kind = kind_phys intent = in + optional = True [snow0] standard_name = lwe_thickness_of_snow_amount long_name = snow fall on physics timestep @@ -455,6 +464,7 @@ type = real kind = kind_phys intent = in + optional = True [graupel0] standard_name = lwe_thickness_of_graupel_amount long_name = graupel fall on physics timestep @@ -463,6 +473,7 @@ type = real kind = kind_phys intent = in + optional = True [del] standard_name = air_pressure_difference_between_midlayers long_name = air pressure difference between midlayers @@ -579,7 +590,7 @@ standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket long_name = cumulative convective precipitation in bucket units = m - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,number_of_diagnostic_buckets) type = real kind = kind_phys intent = inout @@ -587,7 +598,7 @@ standard_name = accumulated_lwe_thickness_of_precipitation_amount_in_bucket long_name = accumulated total precipitation in bucket units = m - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,number_of_diagnostic_buckets) type = real kind = kind_phys intent = inout @@ -623,6 +634,7 @@ type = real kind = kind_phys intent = inout + optional = True [rainc_cpl] standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_for_coupling long_name = total convective precipitation @@ -631,6 +643,7 @@ type = real kind = kind_phys intent = inout + optional = True [snow_cpl] standard_name = cumulative_lwe_thickness_of_snow_amount_for_coupling long_name = total snow precipitation @@ -639,6 +652,7 @@ type = real kind = kind_phys intent = inout + optional = True [pwat] standard_name = column_precipitable_water long_name = precipitable water @@ -655,6 +669,7 @@ type = real kind = kind_phys intent = inout + optional = True [dsnow_cpl] standard_name = tendency_of_lwe_thickness_of_snowfall_amount_on_dynamics_timestep_for_coupling long_name = change in show_cpl (coupling_type) @@ -663,6 +678,7 @@ type = real kind = kind_phys intent = inout + optional = True [lsm] standard_name = control_for_land_surface_scheme long_name = flag for land surface model @@ -692,6 +708,7 @@ type = real kind = kind_phys intent = inout + optional = True [rainncprv] standard_name = lwe_thickness_of_explicit_precipitation_amount_on_previous_timestep long_name = explicit rainfall from previous timestep @@ -700,6 +717,7 @@ type = real kind = kind_phys intent = inout + optional = True [iceprv] standard_name = lwe_thickness_of_ice_precipitation_amount_on_previous_timestep long_name = ice amount from previous timestep @@ -708,6 +726,7 @@ type = real kind = kind_phys intent = inout + optional = True [snowprv] standard_name = snow_mass_on_previous_timestep long_name = snow amount from previous timestep @@ -716,6 +735,7 @@ type = real kind = kind_phys intent = inout + optional = True [graupelprv] standard_name = lwe_thickness_of_graupel_amount_on_previous_timestep long_name = graupel amount from previous timestep @@ -724,6 +744,7 @@ type = real kind = kind_phys intent = inout + optional = True [draincprv] standard_name = convective_precipitation_rate_on_previous_timestep long_name = convective precipitation rate from previous timestep @@ -732,6 +753,7 @@ type = real kind = kind_phys intent = inout + optional = True [drainncprv] standard_name = explicit_precipitation_rate_on_previous_timestep long_name = explicit rainfall rate previous timestep @@ -740,6 +762,7 @@ type = real kind = kind_phys intent = inout + optional = True [diceprv] standard_name = ice_precipitation_rate_on_previous_timestep long_name = ice precipitation rate from previous timestep @@ -748,6 +771,7 @@ type = real kind = kind_phys intent = inout + optional = True [dsnowprv] standard_name = snowfall_rate_on_previous_timestep long_name = snow precipitation rate from previous timestep @@ -756,6 +780,7 @@ type = real kind = kind_phys intent = inout + optional = True [dgraupelprv] standard_name = graupel_precipitation_rate_on_previous_timestep long_name = graupel precipitation rate from previous timestep @@ -764,6 +789,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtp] standard_name = timestep_for_physics long_name = physics timestep @@ -772,9 +798,9 @@ type = real kind = kind_phys intent = in -[dfi_radar_max_intervals] - standard_name = maximum_number_of_radar_derived_temperature_or_convection_suppression_intervals - long_name = maximum allowed number of time ranges with radar-derived microphysics temperature tendencies or radar-derived convection suppression +[num_diag_buckets] + standard_name = number_of_diagnostic_buckets + long_name = number of diagnostic bucket reset periods units = count dimensions = () type = integer @@ -809,6 +835,7 @@ type = real kind = kind_phys intent = in + optional = True [fhour] standard_name = forecast_time long_name = current forecast time @@ -840,6 +867,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -883,6 +911,7 @@ type = real kind = kind_phys intent = inout + optional = True [prevsq] standard_name = specific_humidity_on_previous_timestep long_name = specific_humidity_on_previous_timestep @@ -891,6 +920,7 @@ type = real kind = kind_phys intent = inout + optional = True [lssav] standard_name = flag_for_diagnostics long_name = logical flag for storing diagnostics diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 index 5f09f5347..1ae654edf 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_common.F90 @@ -15,7 +15,7 @@ subroutine set_aerosol_tracer_index(imp_physics, imp_physics_wsm6, & imp_physics_thompson, ltaerosol,mraerosol, & imp_physics_mg, ntgl, imp_physics_gfdl, & imp_physics_zhao_carr, imp_physics_nssl,& - nssl_hail_on, nssl_ccn_on, kk, & + nssl_hail_on, nssl_ccn_on, nssl_3moment, kk, & errmsg, errflg) implicit none ! @@ -23,7 +23,7 @@ subroutine set_aerosol_tracer_index(imp_physics, imp_physics_wsm6, & imp_physics_thompson, & imp_physics_mg, ntgl, imp_physics_gfdl, & imp_physics_zhao_carr,imp_physics_nssl - logical, intent(in ) :: ltaerosol, mraerosol, nssl_hail_on, nssl_ccn_on + logical, intent(in ) :: ltaerosol, mraerosol, nssl_hail_on, nssl_ccn_on, nssl_3moment integer, intent(out) :: kk character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -59,8 +59,10 @@ subroutine set_aerosol_tracer_index(imp_physics, imp_physics_wsm6, & elseif (imp_physics == imp_physics_nssl) then IF ( nssl_hail_on ) THEN kk = 16 + IF ( nssl_3moment ) kk = kk + 3 ELSE kk = 13 + IF ( nssl_3moment ) kk = kk + 2 ENDIF IF ( nssl_ccn_on ) kk = kk + 1 else diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 index a4e5f172a..01033f4d6 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.F90 @@ -47,8 +47,9 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), intent(in) :: rd, cp, fvirt, hvap, huge real(kind=kind_phys), dimension(:), intent(in) :: t1, q1, hflx, oceanfrac real(kind=kind_phys), dimension(:,:), intent(in) :: prsl - real(kind=kind_phys), dimension(:), intent(in) :: dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice, & - dtsfc_med, dqsfc_med, dusfc_med, dvsfc_med, wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1 + real(kind=kind_phys), dimension(:), intent(in), optional :: dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice, & + dtsfc_med, dqsfc_med, dusfc_med, dvsfc_med + real(kind=kind_phys), dimension(:), intent(in) :: wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1 real(kind=kind_phys), dimension(:,:, :), intent(in) :: qgrs real(kind=kind_phys), dimension(:,:), intent(in) :: ugrs, vgrs, tgrs @@ -63,14 +64,16 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays ! as long as these do not get used when not allocated. - real(kind=kind_phys), dimension(:), intent(inout) :: dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, & - dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag + real(kind=kind_phys), dimension(:), intent(inout), optional :: dusfc_cpl, dvsfc_cpl, & + dtsfc_cpl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl + real(kind=kind_phys), dimension(:), intent(inout) :: dusfc_diag, dvsfc_diag, & + dtsfc_diag, dqsfc_diag, dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: index_of_temperature, index_of_x_wind, index_of_y_wind, index_of_process_pbl logical, dimension(:),intent(in) :: wet, dry, icy - real(kind=kind_phys), dimension(:), intent(out) :: ushfsfci + real(kind=kind_phys), dimension(:), intent(out), optional :: ushfsfci ! From canopy heat storage - reduction factors in latent/sensible heat flux due to surface roughness real(kind=kind_phys), dimension(:), intent(in) :: hffac @@ -107,7 +110,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, imp_physics_thompson, ltaerosol,mraerosol, & imp_physics_mg, ntgl, imp_physics_gfdl, & imp_physics_zhao_carr, imp_physics_nssl,& - nssl_hail_on, nssl_ccn_on, kk, & + nssl_hail_on, nssl_ccn_on, nssl_3moment, kk, & errmsg, errflg) if (errflg /= 0) return ! diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta index d49a885c5..057d061a4 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_post.meta @@ -447,6 +447,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -562,6 +563,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_cpl] standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc v momentum flux multiplied by timestep @@ -570,6 +572,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtsfc_cpl] standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc sensible heat flux multiplied by timestep @@ -578,6 +581,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqsfc_cpl] standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc latent heat flux multiplied by timestep @@ -586,6 +590,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfci_cpl] standard_name = surface_x_momentum_flux_for_coupling long_name = instantaneous sfc u momentum flux @@ -594,6 +599,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfci_cpl] standard_name = surface_y_momentum_flux_for_coupling long_name = instantaneous sfc v momentum flux @@ -602,6 +608,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtsfci_cpl] standard_name = surface_upward_sensible_heat_flux_for_coupling long_name = instantaneous sfc sensible heat flux @@ -610,6 +617,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqsfci_cpl] standard_name = surface_upward_latent_heat_flux_for_coupling long_name = instantaneous sfc latent heat flux @@ -618,6 +626,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_diag] standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc x momentum flux multiplied by timestep @@ -754,6 +763,7 @@ type = real kind = kind_phys intent = out + optional = True [oceanfrac] standard_name = sea_area_fraction long_name = fraction of horizontal grid area occupied by ocean @@ -777,6 +787,7 @@ type = real kind = kind_phys intent = in + optional = True [dvsfc_cice] standard_name = surface_y_momentum_flux_from_coupled_process long_name = sfc y momentum flux for coupling @@ -785,6 +796,7 @@ type = real kind = kind_phys intent = in + optional = True [dtsfc_cice] standard_name = surface_upward_sensible_heat_flux_from_coupled_process long_name = sfc sensible heat flux for coupling @@ -793,6 +805,7 @@ type = real kind = kind_phys intent = in + optional = True [dqsfc_cice] standard_name = surface_upward_latent_heat_flux_from_coupled_process long_name = sfc latent heat flux for coupling @@ -801,6 +814,7 @@ type = real kind = kind_phys intent = in + optional = True [use_med_flux] standard_name = do_mediator_atmosphere_ocean_fluxes long_name = flag for using atmosphere-ocean fluxes from mediator @@ -816,6 +830,7 @@ type = real kind = kind_phys intent = in + optional = True [dtsfc_med] standard_name = surface_upward_sensible_heat_flux_over_ocean_from_mediator long_name = sfc sensible heat flux input over ocean for coupling @@ -824,6 +839,7 @@ type = real kind = kind_phys intent = in + optional = True [dusfc_med] standard_name = surface_x_momentum_flux_over_ocean_from_mediator long_name = sfc x momentum flux over ocean for coupling @@ -832,6 +848,7 @@ type = real kind = kind_phys intent = in + optional = True [dvsfc_med] standard_name = surface_y_momentum_flux_over_ocean_from_mediator long_name = sfc y momentum flux over ocean for coupling @@ -840,6 +857,7 @@ type = real kind = kind_phys intent = in + optional = True [wet] standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 index d8ed0f8fc..eab767147 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_PBL_generic_pre.F90 @@ -276,7 +276,7 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, rtg_ozone_index, imp_physics_thompson, ltaerosol,mraerosol, & imp_physics_mg, ntgl, imp_physics_gfdl, & imp_physics_zhao_carr, imp_physics_nssl,& - nssl_hail_on, nssl_ccn_on, kk, & + nssl_hail_on, nssl_ccn_on, nssl_3moment, kk, & errmsg, errflg) if (errflg /= 0) return ! diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 index 0b38ff081..21de71ecb 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.F90 @@ -11,7 +11,7 @@ module GFS_SCNV_generic_post subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & frain, gu0, gv0, gt0, gq0, save_u, save_v, save_t, save_q, & clw, shcnvcw, rain1, npdf3d, num_p3d, ncnvcld3d, cnvc, cnvw, nsamftrac, & - rainc, cnvprcp, cnvprcpb, cnvw_phy_f3d, cnvc_phy_f3d, & + rainc, cnvprcp, cnvw_phy_f3d, cnvc_phy_f3d, & dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, & index_of_process_scnv, ntqv, flag_for_scnv_generic_tend, & ntcw,ntiw,ntclamt,ntrw,ntsw,ntrnc,ntsnc,ntgl,ntgnc,ntsigma, & @@ -31,7 +31,7 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & real(kind=kind_phys), dimension(:,:,:), intent(in) :: save_q, gq0 ! dtend only allocated if ldiag3d == .true. - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: index_of_temperature, index_of_x_wind, index_of_y_wind, index_of_process_scnv real(kind=kind_phys), dimension(:,:,:), intent(in) :: clw @@ -41,12 +41,12 @@ subroutine GFS_SCNV_generic_post_run (im, levs, nn, lssav, ldiag3d, qdiag3d, & logical, intent(in) :: shcnvcw real(kind=kind_phys), dimension(:), intent(in) :: rain1 real(kind=kind_phys), dimension(:, :), intent(in) :: cnvw, cnvc - real(kind=kind_phys), dimension(:), intent(inout) :: rainc, cnvprcp, cnvprcpb + real(kind=kind_phys), dimension(:), intent(inout) :: rainc, cnvprcp ! The following arrays may not be allocated, depending on certain flags and microphysics schemes. ! Since Intel 15 crashes when passing unallocated arrays to arrays defined with explicit shape, ! use assumed-shape arrays. Note that Intel 18 and GNU 6.2.0-8.1.0 tolerate explicit-shape arrays ! as long as these do not get used when not allocated. - real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: cnvw_phy_f3d, cnvc_phy_f3d integer, intent(in) :: imfshalcnv, imfshalcnv_sas, imfshalcnv_samf logical, intent(in) :: cscnv, satmedmf, trans_trac, ras diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta index 963ad4a81..02b6bbe54 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_SCNV_generic_post.meta @@ -130,6 +130,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -255,14 +256,6 @@ type = real kind = kind_phys intent = inout -[cnvprcpb] - standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket - long_name = cumulative convective precipitation in bucket - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout [cnvw_phy_f3d] standard_name = convective_cloud_condensate_mixing_ratio long_name = convective cloud water mixing ratio in the phy_f3d array @@ -271,6 +264,7 @@ type = real kind = kind_phys intent = inout + optional = True [cnvc_phy_f3d] standard_name = convective_cloud_area_fraction long_name = convective cloud cover in the phy_f3d array @@ -279,6 +273,7 @@ type = real kind = kind_phys intent = inout + optional = True [flag_for_scnv_generic_tend] standard_name = flag_for_generic_tendency_due_to_shallow_convection long_name = true if GFS_SCNV_generic should calculate tendencies diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 new file mode 100644 index 000000000..9a5ce6112 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.F90 @@ -0,0 +1,441 @@ +!>\file GFS_ccpp_suite_sim_pre.F90 +!! Interstitial CCPP suite to couple UFS physics to CCPP suite simulator. + +! ######################################################################################## +! +! Description: Interstitial CCPP suite to couple UFS physics to ccpp_suite_simulator. +! +! Contains: +! - load_ccpp_suite_sim(): read and load data into type used by ccpp_suite_simulator. +! called once during model initialization +! - GFS_ccpp_suite_sim_pre_run(): prepare GFS diagnostic physics tendencies for +! ccpp_suite_simulator. +! +! ######################################################################################## +module GFS_ccpp_suite_sim_pre + use machine, only: kind_phys + use module_ccpp_suite_simulator, only: base_physics_process + use netcdf + implicit none + public GFS_ccpp_suite_sim_pre_run, load_ccpp_suite_sim +contains + +!> \section arg_table_GFS_ccpp_suite_sim_pre_run Argument Table +!! \htmlinclude GFS_ccpp_suite_sim_pre_run.html +!! + subroutine GFS_ccpp_suite_sim_pre_run(do_ccpp_suite_sim, dtend, ntqv, dtidx, dtp, & + index_of_process_dcnv, index_of_process_longwave, index_of_process_shortwave, & + index_of_process_scnv, index_of_process_orographic_gwd, index_of_process_pbl, & + index_of_process_mp, index_of_temperature, index_of_x_wind, index_of_y_wind, & + physics_process, iactive_T, iactive_u, iactive_v, iactive_q, active_phys_tend, & + errmsg, errflg) + + ! Inputs + logical, intent(in) :: do_ccpp_suite_sim + integer, intent(in) :: ntqv, index_of_process_dcnv, index_of_process_longwave, & + index_of_process_shortwave, index_of_process_scnv, & + index_of_process_orographic_gwd, index_of_process_pbl, index_of_process_mp, & + index_of_temperature, index_of_x_wind, index_of_y_wind + integer, intent(in), dimension(:,:) :: dtidx + real(kind_phys), intent(in) :: dtp + real(kind_phys), intent(in), dimension(:,:,:), optional :: dtend + type(base_physics_process),intent(in) :: physics_process(:) + integer, intent(in) :: iactive_T, iactive_u, iactive_v, iactive_q + + ! Outputs + real(kind_phys), intent(out) :: active_phys_tend(:,:,:) + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Locals + integer :: idtend, iactive + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. do_ccpp_suite_sim) return + + ! Get tendency for "active" process. + + ! ###################################################################################### + ! DJS2023: For the UFS and SCM, the physics tendencies are stored in a multi-dimensional + ! array, CCPP standard_name = cumulative_change_of_state_variables. + ! These are not the instantaneous physics tendencies that are applied to the state by + ! the physics suites. Not all suites output physics tendencies... + ! Rather these are intended for diagnostic puposes and are accumulated over some + ! interval. + ! In the UFS/SCM this is controlled by the diagnostic bucket interval, namelist option + ! "fhzero". For this to work, you need to clear the diagnostic buckets after each + ! physics timestep when running in the UFS/SCM. + ! + ! In the SCM this is done by adding the following runtime options: + ! --n_itt_out 1 --n_itt_diag 1 + ! + ! ###################################################################################### + if (physics_process(1)%active_name == "LWRAD") iactive = index_of_process_longwave + if (physics_process(1)%active_name == "SWRAD") iactive = index_of_process_shortwave + if (physics_process(1)%active_name == "PBL") iactive = index_of_process_pbl + if (physics_process(1)%active_name == "GWD") iactive = index_of_process_orographic_gwd + if (physics_process(1)%active_name == "SCNV") iactive = index_of_process_scnv + if (physics_process(1)%active_name == "DCNV") iactive = index_of_process_dcnv + if (physics_process(1)%active_name == "cldMP") iactive = index_of_process_mp + + ! Heat + idtend = dtidx(index_of_temperature,iactive) + if (idtend >= 1) then + active_phys_tend(:,:,iactive_T) = dtend(:,:,idtend)/dtp + endif + + ! u-wind + idtend = dtidx(index_of_x_wind,iactive) + if (idtend >= 1) then + active_phys_tend(:,:,iactive_u) = dtend(:,:,idtend)/dtp + endif + + ! v-wind + idtend = dtidx(index_of_y_wind,iactive) + if (idtend >= 1) then + active_phys_tend(:,:,iactive_v) = dtend(:,:,idtend)/dtp + endif + + ! Moisture + idtend = dtidx(100+ntqv,iactive) + if (idtend >= 1) then + active_phys_tend(:,:,iactive_q) = dtend(:,:,idtend)/dtp + endif + + end subroutine GFS_ccpp_suite_sim_pre_run + + ! ###################################################################################### +!> + subroutine load_ccpp_suite_sim(nlunit, nml_file, physics_process, iactive_T, & + iactive_u, iactive_v, iactive_q, errmsg, errflg) + + ! Inputs + integer, intent (in) :: nlunit + character(len=*), intent (in) :: nml_file + + ! Outputs + type(base_physics_process),intent(inout),allocatable :: physics_process(:) + integer, intent(inout) :: iactive_T, iactive_u, iactive_v, iactive_q + integer, intent(out) :: errflg + character(len=256), intent(out) :: errmsg + + ! Local variables + integer :: ncid, dimID, varID, status, ios, iprc, nlev_data, ntime_data + character(len=256) :: suite_sim_file + logical :: exists, do_ccpp_suite_sim + integer :: nprc_sim + + ! For each process there is a corresponding namelist entry, which is constructed as + ! follows: + ! {use_suite_sim[0(no)/1(yes)], time_split[0(no)/1(yes)], order[1:nPhysProcess]} + integer, dimension(3) :: & + prc_LWRAD_cfg = (/0,0,0/), & + prc_SWRAD_cfg = (/0,0,0/), & + prc_PBL_cfg = (/0,0,0/), & + prc_GWD_cfg = (/0,0,0/), & + prc_SCNV_cfg = (/0,0,0/), & + prc_DCNV_cfg = (/0,0,0/), & + prc_cldMP_cfg = (/0,0,0/) + + ! Namelist + namelist / ccpp_suite_sim_nml / do_ccpp_suite_sim, suite_sim_file, nprc_sim, & + prc_LWRAD_cfg, prc_SWRAD_cfg, prc_PBL_cfg, prc_GWD_cfg, prc_SCNV_cfg, & + prc_DCNV_cfg, prc_cldMP_cfg + + errmsg = '' + errflg = 0 + + ! Read in namelist + inquire (file = trim (nml_file), exist = exists) + if (.not. exists) then + errmsg = 'CCPP suite simulator namelist file: '//trim(nml_file)//' does not exist.' + errflg = 1 + return + else + open (unit = nlunit, file = nml_file, action = 'read', status = 'old', iostat = ios) + endif + rewind (nlunit) + read (nlunit, nml = ccpp_suite_sim_nml, iostat=status) + close (nlunit) + + ! Only proceed if suite simulator requested. + if (prc_SWRAD_cfg(1) == 1 .or. prc_LWRAD_cfg(1) == 1 .or. prc_PBL_cfg(1) == 1 .or. & + prc_GWD_cfg(1) == 1 .or. prc_SCNV_cfg(1) == 1 .or. prc_DCNV_cfg(1) == 1 .or. & + prc_cldMP_cfg(1) == 1 ) then + else + return + endif + + ! Check that input data file exists. + inquire (file = trim (suite_sim_file), exist = exists) + if (.not. exists) then + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not exist' + errflg = 1 + return + endif + + ! + ! Read data file... + ! + + ! Open file + status = nf90_open(trim(suite_sim_file), NF90_NOWRITE, ncid) + if (status /= nf90_noerr) then + errmsg = 'Error reading in CCPP suite simulator file: '//trim(suite_sim_file) + errflg = 1 + return + endif + + ! Metadata (dimensions) + status = nf90_inq_dimid(ncid, 'time', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = ntime_data) + else + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [time] dimension' + errflg = 1 + return + endif + + status = nf90_inq_dimid(ncid, 'lev', dimid) + if (status == nf90_noerr) then + status = nf90_inquire_dimension(ncid, dimid, len = nlev_data) + else + errmsg = 'CCPP suite simulator file: '//trim(suite_sim_file)//' does not contain [lev] dimension' + errflg = 1 + return + endif + + ! Allocate space and read in data + allocate(physics_process(nprc_sim)) + physics_process(1)%active_name = '' + physics_process(1)%iactive_scheme = 0 + physics_process(1)%active_tsp = .false. + do iprc = 1,nprc_sim + allocate(physics_process(iprc)%tend1d%T( nlev_data )) + allocate(physics_process(iprc)%tend1d%u( nlev_data )) + allocate(physics_process(iprc)%tend1d%v( nlev_data )) + allocate(physics_process(iprc)%tend1d%q( nlev_data )) + allocate(physics_process(iprc)%tend2d%time( ntime_data)) + allocate(physics_process(iprc)%tend2d%T( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%u( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%v( nlev_data, ntime_data)) + allocate(physics_process(iprc)%tend2d%q( nlev_data, ntime_data)) + + ! Temporal info + status = nf90_inq_varid(ncid, 'times', varID) + if (status == nf90_noerr) then + status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%time) + else + errmsg = 'SCM data tendency file: '//trim(suite_sim_file)//' does not contain times variable' + errflg = 1 + return + endif + + if (iprc == prc_SWRAD_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SWRAD" + if (prc_SWRAD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 1 + iactive_T = 1 + endif + if (prc_SWRAD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_swrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + endif + + if (iprc == prc_LWRAD_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "LWRAD" + if (prc_LWRAD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 1 + iactive_T = 1 + endif + if (prc_LWRAD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_lwrad', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + endif + + if (iprc == prc_GWD_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "GWD" + if (prc_GWD_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 3 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + endif + if (prc_GWD_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_cgwd', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + endif + + if (iprc == prc_PBL_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "PBL" + if (prc_PBL_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 + endif + if (prc_PBL_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'dq_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + status = nf90_inq_varid(ncid, 'du_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_pbl', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + endif + + if (iprc == prc_SCNV_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "SCNV" + if (prc_SCNV_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 + endif + if (prc_SCNV_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + status = nf90_inq_varid(ncid, 'dq_dt_shalconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + endif + + if (iprc == prc_DCNV_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "DCNV" + if (prc_DCNV_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 4 + iactive_T = 1 + iactive_u = 2 + iactive_v = 3 + iactive_q = 4 + endif + if (prc_DCNV_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'du_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%u) + status = nf90_inq_varid(ncid, 'dv_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%v) + status = nf90_inq_varid(ncid, 'dq_dt_deepconv', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + endif + + if (iprc == prc_cldMP_cfg(3)) then + ! Metadata + physics_process(iprc)%order = iprc + physics_process(iprc)%name = "cldMP" + if (prc_cldMP_cfg(1) == 1) then + physics_process(iprc)%use_sim = .true. + else + physics_process(1)%nprg_active = 2 + iactive_T = 1 + iactive_q = 2 + endif + if (prc_cldMP_cfg(2) == 1) then + physics_process(iprc)%time_split = .true. + endif + + ! Data + status = nf90_inq_varid(ncid, 'dT_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%T) + status = nf90_inq_varid(ncid, 'dq_dt_micro', varID) + if (status == nf90_noerr) status = nf90_get_var( ncid, varID, physics_process(iprc)%tend2d%q) + endif + + ! Which process-suite is "active"? Is process time-split? + if (.not. physics_process(iprc)%use_sim) then + physics_process(1)%iactive_scheme = iprc + physics_process(1)%active_name = physics_process(iprc)%name + if (physics_process(iprc)%time_split) then + physics_process(1)%active_tsp = .true. + endif + endif + + enddo + + if (physics_process(1)%iactive_scheme == 0) then + errflg = 1 + errmsg = "ERROR: No active suite set for CCPP suite simulator" + return + endif + + print*, "-----------------------------------" + print*, "--- Using CCPP suite simulator ---" + print*, "-----------------------------------" + do iprc = 1,nprc_sim + if (physics_process(iprc)%use_sim) then + print*," simulate_suite: ", trim(physics_process(iprc)%name) + print*," order: ", physics_process(iprc)%order + print*," time_split: ", physics_process(iprc)%time_split + else + print*, " active_suite: ", trim(physics_process(1)%active_name) + print*, " order: ", physics_process(physics_process(1)%iactive_scheme)%order + print*, " time_split : ", physics_process(1)%active_tsp + endif + enddo + print*, "-----------------------------------" + print*, "-----------------------------------" + + end subroutine load_ccpp_suite_sim + +end module GFS_ccpp_suite_sim_pre diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.meta new file mode 100644 index 000000000..c25a3dd05 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_ccpp_suite_sim_pre.meta @@ -0,0 +1,175 @@ +[ccpp-table-properties] + name = GFS_ccpp_suite_sim_pre + type = scheme + dependencies = ../../hooks/machine.F,module_ccpp_suite_simulator.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_ccpp_suite_sim_pre_run + type = scheme +[do_ccpp_suite_sim] + standard_name = flag_for_ccpp_suite_simulator + long_name = flag for ccpp suite simulator + units = flag + dimensions = () + type = logical + intent = in +[physics_process] + standard_name = physics_process_type_for_CCPP_suite_simulator + long_name = physics process type for CCPP suite simulator + units = mixed + dimensions = (number_of_physics_process_in_CCPP_suite_simulator) + type = base_physics_process + intent = in +[dtend] + standard_name = cumulative_change_of_state_variables + long_name = diagnostic tendencies for state variables + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) + type = real + kind = kind_phys + intent = in + optional = True +[dtidx] + standard_name = cumulative_change_of_state_variables_outer_index + long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index + units = index + dimensions = (number_of_tracers_plus_one_hundred,number_of_cumulative_change_processes) + type = integer + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[index_of_process_dcnv] + standard_name = index_of_deep_convection_process_process_in_cumulative_change_index + long_name = index of deep convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_longwave] + standard_name = index_of_longwave_heating_process_in_cumulative_change_index + long_name = index of longwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_shortwave] + standard_name = index_of_shortwave_heating_process_in_cumulative_change_index + long_name = index of shortwave heating process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_orographic_gwd] + standard_name = index_of_orographic_gravity_wave_drag_process_in_cumulative_change_index + long_name = index of orographic gravity wave drag process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_scnv] + standard_name = index_of_shallow_convection_process_process_in_cumulative_change_index + long_name = index of shallow convection process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_pbl] + standard_name = index_of_subgrid_scale_vertical_mixing_process_in_cumulative_change_index + long_name = index of subgrid scale vertical mixing process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_process_mp] + standard_name = index_of_microphysics_process_process_in_cumulative_change_index + long_name = index of microphysics transport process in second dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_temperature] + standard_name = index_of_temperature_in_cumulative_change_index + long_name = index of temperature in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_x_wind] + standard_name = index_of_x_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[index_of_y_wind] + standard_name = index_of_y_wind_in_cumulative_change_index + long_name = index of x-wind in first dimension of array cumulative change index + units = index + dimensions = () + type = integer + intent = in +[ntqv] + standard_name = index_of_specific_humidity_in_tracer_concentration_array + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in +[active_phys_tend] + standard_name = tendencies_for_active_process_in_ccpp_suite_simulator + long_name = tendencies for active physics process in ccpp suite simulator + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) + type = real + kind = kind_phys + intent = out +[iactive_T] + standard_name = index_for_active_T_in_CCPP_suite_simulator + long_name = index into active process tracer array for temperature in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_u] + standard_name = index_for_active_u_in_CCPP_suite_simulator + long_name = index into active process tracer array for zonal wind in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_v] + standard_name = index_for_active_v_in_CCPP_suite_simulator + long_name = index into active process tracer array for meridional wind in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_q] + standard_name = index_for_active_q_in_CCPP_suite_simulator + long_name = index into active process tracer array for moisture in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90 index 86dc2b518..f46b19f5a 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.F90 @@ -28,7 +28,7 @@ module GFS_cloud_diagnostics !! This was bundled together with the prognostic cloud modules within the RRTMG implementation. !! For the RRTMGP implementation we propose to keep these diagnostics independent. !> @{ -!> \section arg_table_GFS_cloud_diagnostics_run +!> \section arg_table_GFS_cloud_diagnostics_run Argument Table !! \htmlinclude GFS_cloud_diagnostics_run.html !! subroutine GFS_cloud_diagnostics_run(nCol, nLev, iovr, iovr_rand, iovr_maxrand, & @@ -59,12 +59,13 @@ subroutine GFS_cloud_diagnostics_run(nCol, nLev, iovr, iovr_rand, iovr_maxrand, lat, & ! Latitude de_lgth, & ! Decorrelation length si ! Vertical sigma coordinate + real(kind_phys), dimension(:,:), intent(in), optional :: & + p_lay ! Pressure at model-layer real(kind_phys), dimension(:,:), intent(in) :: & - p_lay, & ! Pressure at model-layer cld_frac ! Total cloud fraction - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & p_lev ! Pressure at model interfaces - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & deltaZ, & ! Layer thickness (m) cloud_overlap_param, & ! Cloud-overlap parameter precip_overlap_param ! Precipitation overlap parameter diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.meta index 576c66463..224ee3297 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_cloud_diagnostics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_cloud_diagnostics type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F,Radiation/radiation_clouds.f ######################################################################## @@ -109,6 +109,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -125,6 +126,7 @@ type = real kind = kind_phys intent = in + optional = True [deltaZ] standard_name = layer_thickness long_name = layer_thickness @@ -133,6 +135,7 @@ type = real kind = kind_phys intent = in + optional = True [cloud_overlap_param] standard_name = cloud_overlap_param long_name = cloud overlap parameter @@ -141,6 +144,7 @@ type = real kind = kind_phys intent = in + optional = True [precip_overlap_param] standard_name = precip_overlap_param long_name = precipitation overlap parameter @@ -149,6 +153,7 @@ type = real kind = kind_phys intent = in + optional = True [con_pi] standard_name = pi long_name = ratio of a circle's circumference to its diameter diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 index 7f85da7f6..ae92a4789 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.F90 @@ -303,6 +303,16 @@ module GFS_diagtoscreen use print_var_chksum, only: print_var + use machine, only: kind_phys + + use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & + GFS_stateout_type, GFS_sfcprop_type, & + GFS_coupling_type, GFS_grid_type, & + GFS_tbd_type, GFS_cldprop_type, & + GFS_radtend_type, GFS_diag_type + + use CCPP_typedefs, only: GFS_interstitial_type + implicit none private @@ -314,66 +324,70 @@ module GFS_diagtoscreen !> \section arg_table_GFS_diagtoscreen_init Argument Table !! \htmlinclude GFS_diagtoscreen_init.html !! - subroutine GFS_diagtoscreen_init (Model, Data, Interstitial, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type + subroutine GFS_diagtoscreen_init (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & + errmsg, errflg) implicit none !--- interface variables type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_statein_type), intent(in) :: Statein + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_coupling_type), intent(in) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(in) :: Diag type(GFS_interstitial_type), intent(in) :: Interstitial(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - !--- local variables - integer :: i - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - do i=1,size(Data) - call GFS_diagtoscreen_run (Model, Data(i)%Statein, Data(i)%Stateout, Data(i)%Sfcprop, & - Data(i)%Coupling, Data(i)%Grid, Data(i)%Tbd, Data(i)%Cldprop, & - Data(i)%Radtend, Data(i)%Intdiag, Interstitial(1), & - size(Interstitial), i, errmsg, errflg) - end do + call GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, & + Coupling, Grid, Tbd, Cldprop, & + Radtend, Diag, Interstitial(1), & + size(Interstitial), -999, errmsg, errflg) end subroutine GFS_diagtoscreen_init !> \section arg_table_GFS_diagtoscreen_timestep_init Argument Table !! \htmlinclude GFS_diagtoscreen_timestep_init.html !! - subroutine GFS_diagtoscreen_timestep_init (Model, Data, Interstitial, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type + subroutine GFS_diagtoscreen_timestep_init (Model, Statein, Stateout, Sfcprop, Coupling, & + Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & + errmsg, errflg) implicit none !--- interface variables type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) + type(GFS_statein_type), intent(in) :: Statein + type(GFS_stateout_type), intent(in) :: Stateout + type(GFS_sfcprop_type), intent(in) :: Sfcprop + type(GFS_coupling_type), intent(in) :: Coupling + type(GFS_grid_type), intent(in) :: Grid + type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_cldprop_type), intent(in) :: Cldprop + type(GFS_radtend_type), intent(in) :: Radtend + type(GFS_diag_type), intent(in) :: Diag type(GFS_interstitial_type), intent(in) :: Interstitial(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - !--- local variables - integer :: i - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - do i=1,size(Data) - call GFS_diagtoscreen_run (Model, Data(i)%Statein, Data(i)%Stateout, Data(i)%Sfcprop, & - Data(i)%Coupling, Data(i)%Grid, Data(i)%Tbd, Data(i)%Cldprop, & - Data(i)%Radtend, Data(i)%Intdiag, Interstitial(1), & - size(Interstitial), i, errmsg, errflg) - end do + call GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, & + Coupling, Grid, Tbd, Cldprop, & + Radtend, Diag, Interstitial(1), & + size(Interstitial), -999, errmsg, errflg) end subroutine GFS_diagtoscreen_timestep_init @@ -384,18 +398,10 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & nthreads, blkno, errmsg, errflg) -#ifdef MPI - use mpi -#endif + use mpi_f08 #ifdef _OPENMP use omp_lib #endif - use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & - GFS_stateout_type, GFS_sfcprop_type, & - GFS_coupling_type, GFS_grid_type, & - GFS_tbd_type, GFS_cldprop_type, & - GFS_radtend_type, GFS_diag_type - use CCPP_typedefs, only: GFS_interstitial_type implicit none @@ -418,22 +424,15 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, !--- local variables integer :: impi, iomp, ierr, n, idtend, iprocess, itracer - integer :: mpirank, mpisize, mpicomm + integer :: mpirank, mpisize integer :: omprank, ompsize ! Initialize CCPP error handling variables errmsg = '' errflg = 0 -#ifdef MPI - mpicomm = Model%communicator mpirank = Model%me mpisize = Model%ntasks -#else - mpirank = 0 - mpisize = 1 - mpicomm = 0 -#endif #ifdef _OPENMP omprank = OMP_GET_THREAD_NUM() ompsize = nthreads @@ -445,9 +444,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, #ifdef _OPENMP !$OMP BARRIER #endif -#ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) -#endif +! call MPI_BARRIER(Model%communicator,ierr) do impi=0,mpisize-1 do iomp=0,ompsize-1 @@ -619,7 +616,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%in_nm' , Tbd%in_nm) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%ccn_nm' , Tbd%ccn_nm) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%aer_nm' , Tbd%aer_nm) - if (Model%imfdeepcnv == Model%imfdeepcnv_gf .or. Model%imfdeepcnv == Model%imfdeepcnv_unified) then + if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%cactiv' , Tbd%cactiv) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%cactiv_m' , Tbd%cactiv_m) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%aod_gf' , Tbd%aod_gf) @@ -878,13 +875,6 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%v10mi_cpl ', Coupling%v10mi_cpl ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%tsfci_cpl ', Coupling%tsfci_cpl ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%psurfi_cpl ', Coupling%psurfi_cpl ) - if (Model%use_med_flux) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dusfcino_cpl ', Coupling%dusfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dvsfcino_cpl ', Coupling%dvsfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dtsfcino_cpl ', Coupling%dtsfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%dqsfcino_cpl ', Coupling%dqsfcino_cpl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ulwsfcino_cpl', Coupling%ulwsfcino_cpl ) - end if end if if (Model%cplchm) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%rainc_cpl', Coupling%rainc_cpl) @@ -951,17 +941,13 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, !$OMP BARRIER #endif end do -#ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) -#endif +! call MPI_BARRIER(Model%communicator,ierr) end do #ifdef _OPENMP !$OMP BARRIER #endif -#ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) -#endif +! call MPI_BARRIER(Model%communicator,ierr) end subroutine GFS_diagtoscreen_run @@ -972,81 +958,24 @@ module GFS_interstitialtoscreen use print_var_chksum, only: print_var - implicit none - - private - - public GFS_interstitialtoscreen_init, GFS_interstitialtoscreen_timestep_init, GFS_interstitialtoscreen_run - - contains - -!> \section arg_table_GFS_interstitialtoscreen_init Argument Table -!! \htmlinclude GFS_interstitialtoscreen_init.html -!! - subroutine GFS_interstitialtoscreen_init (Model, Data, Interstitial, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type - - implicit none - - !--- interface variables - type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) - type(GFS_interstitial_type), intent(in) :: Interstitial(:) - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - !--- local variables - integer :: i - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - - do i=1,size(Interstitial) - call GFS_interstitialtoscreen_run (Model, Data(1)%Statein, Data(1)%Stateout, Data(1)%Sfcprop, & - Data(1)%Coupling, Data(1)%Grid, Data(1)%Tbd, Data(1)%Cldprop, & - Data(1)%Radtend, Data(1)%Intdiag, Interstitial(i), & - size(Interstitial), -999, errmsg, errflg) - end do - - end subroutine GFS_interstitialtoscreen_init + use machine, only: kind_phys -!> \section arg_table_GFS_interstitialtoscreen_timestep_init Argument Table -!! \htmlinclude GFS_interstitialtoscreen_timestep_init.html -!! - subroutine GFS_interstitialtoscreen_timestep_init (Model, Data, Interstitial, errmsg, errflg) + use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & + GFS_stateout_type, GFS_sfcprop_type, & + GFS_coupling_type, GFS_grid_type, & + GFS_tbd_type, GFS_cldprop_type, & + GFS_radtend_type, GFS_diag_type - use GFS_typedefs, only: GFS_control_type, GFS_data_type - use CCPP_typedefs, only: GFS_interstitial_type + use CCPP_typedefs, only: GFS_interstitial_type - implicit none - - !--- interface variables - type(GFS_control_type), intent(in) :: Model - type(GFS_data_type), intent(in) :: Data(:) - type(GFS_interstitial_type), intent(in) :: Interstitial(:) - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - !--- local variables - integer :: i - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 + implicit none + private - do i=1,size(Interstitial) - call GFS_interstitialtoscreen_run (Model, Data(1)%Statein, Data(1)%Stateout, Data(1)%Sfcprop, & - Data(1)%Coupling, Data(1)%Grid, Data(1)%Tbd, Data(1)%Cldprop, & - Data(1)%Radtend, Data(1)%Intdiag, Interstitial(i), & - size(Interstitial), -999, errmsg, errflg) - end do + public GFS_interstitialtoscreen_run - end subroutine GFS_interstitialtoscreen_timestep_init + contains !> \section arg_table_GFS_interstitialtoscreen_run Argument Table !! \htmlinclude GFS_interstitialtoscreen_run.html @@ -1055,20 +984,10 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup Grid, Tbd, Cldprop, Radtend, Diag, Interstitial, & nthreads, blkno, errmsg, errflg) -#ifdef MPI - use mpi -#endif + use mpi_f08 #ifdef _OPENMP use omp_lib #endif - use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_statein_type, & - GFS_stateout_type, GFS_sfcprop_type, & - GFS_coupling_type, GFS_grid_type, & - GFS_tbd_type, GFS_cldprop_type, & - GFS_radtend_type, GFS_diag_type - use CCPP_typedefs, only: GFS_interstitial_type - implicit none !--- interface variables @@ -1090,7 +1009,7 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup !--- local variables integer :: impi, iomp, ierr - integer :: mpirank, mpisize, mpicomm + integer :: mpirank, mpisize integer :: omprank, ompsize integer :: istart, iend, kstart, kend @@ -1098,15 +1017,8 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup errmsg = '' errflg = 0 -#ifdef MPI - mpicomm = Model%communicator mpirank = Model%me - call MPI_COMM_SIZE(mpicomm, mpisize, ierr) -#else - mpirank = 0 - mpisize = 1 - mpicomm = 0 -#endif + call MPI_COMM_SIZE(Model%communicator, mpisize, ierr) #ifdef _OPENMP omprank = OMP_GET_THREAD_NUM() ompsize = nthreads @@ -1118,31 +1030,17 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup #ifdef _OPENMP !$OMP BARRIER #endif -#ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) -#endif +! call MPI_BARRIER(Model%communicator,ierr) do impi=0,mpisize-1 do iomp=0,ompsize-1 if (mpirank==impi .and. omprank==iomp) then ! Print static variables - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ipr ', Interstitial%ipr ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%itc ', Interstitial%itc ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%latidxprnt ', Interstitial%latidxprnt ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%levi ', Interstitial%levi ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%lmk ', Interstitial%lmk ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%lmp ', Interstitial%lmp ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nbdlw ', Interstitial%nbdlw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nbdsw ', Interstitial%nbdsw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nf_aelw ', Interstitial%nf_aelw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nf_aesw ', Interstitial%nf_aesw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nsamftrac ', Interstitial%nsamftrac ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nscav ', Interstitial%nscav ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nspc1 ', Interstitial%nspc1 ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ntiwx ', Interstitial%ntiwx ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nvdiff ', Interstitial%nvdiff ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%phys_hydrostatic ', Interstitial%phys_hydrostatic ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%skip_macro ', Interstitial%skip_macro ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%trans_aero ', Interstitial%trans_aero ) ! Print all other variables call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%adjsfculw_land ', Interstitial%adjsfculw_land ) @@ -1182,7 +1080,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cmm_land ', Interstitial%cmm_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cmm_water ', Interstitial%cmm_water ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cnvc ', Interstitial%cnvc ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cnvw ', Interstitial%cnvw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ctei_r ', Interstitial%ctei_r ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ctei_rml ', Interstitial%ctei_rml ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cumabs ', Interstitial%cumabs ) @@ -1235,7 +1132,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fm10_ice ', Interstitial%fm10_ice ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fm10_land ', Interstitial%fm10_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fm10_water ', Interstitial%fm10_water ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%frain ', Interstitial%frain ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%frland ', Interstitial%frland ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fscav ', Interstitial%fscav ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fswtr ', Interstitial%fswtr ) @@ -1294,7 +1190,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_ice ', Interstitial%qss_ice ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_land ', Interstitial%qss_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qss_water ', Interstitial%qss_water ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%radar_reset ', Interstitial%radar_reset ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raddt ', Interstitial%raddt ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raincd ', Interstitial%raincd ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%raincs ', Interstitial%raincs ) @@ -1323,8 +1218,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigmafrac ', Interstitial%sigmafrac ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%sigmatot ', Interstitial%sigmatot ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowc ', Interstitial%snowc ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowd_ice ', Interstitial%snowd_ice ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowd_land ', Interstitial%snowd_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snohf ', Interstitial%snohf ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%snowmt ', Interstitial%snowmt ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%stress ', Interstitial%stress ) @@ -1423,8 +1316,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qrn ', Interstitial%qrn ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qsnw ', Interstitial%qsnw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%qgl ', Interstitial%qgl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ncpi ', Interstitial%ncpi ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ncpl ', Interstitial%ncpl ) end if ! Noah MP if (Model%lsm == Model%lsm_noahmp) then @@ -1435,15 +1326,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup if (Model%do_RRTMGP) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%aerosolslw ', Interstitial%aerosolslw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%aerosolssw ', Interstitial%aerosolssw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_frac ', Interstitial%cld_frac ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_lwp ', Interstitial%cld_lwp ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_reliq ', Interstitial%cld_reliq ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_iwp ', Interstitial%cld_iwp ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_reice ', Interstitial%cld_reice ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_swp ', Interstitial%cld_swp ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_resnow ', Interstitial%cld_resnow ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_rwp ', Interstitial%cld_rwp ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%cld_rerain ', Interstitial%cld_rerain ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%precip_frac ', Interstitial%precip_frac ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwUP_allsky ', Interstitial%fluxlwUP_allsky ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwDOWN_allsky ', Interstitial%fluxlwDOWN_allsky ) @@ -1470,17 +1352,13 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup !$OMP BARRIER #endif end do -#ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) -#endif +! call MPI_BARRIER(Model%communicator,ierr) end do #ifdef _OPENMP !$OMP BARRIER #endif -#ifdef MPI -! call MPI_BARRIER(mpicomm,ierr) -#endif +! call MPI_BARRIER(Model%communicator,ierr) end subroutine GFS_interstitialtoscreen_run @@ -1536,7 +1414,7 @@ module GFS_checkland !! \htmlinclude GFS_checkland_run.html !! subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_guess, & - flag_init, flag_restart, frac_grid, isot, ivegsrc, stype,scolor, vtype, slope, & + flag_init, flag_restart, frac_grid, isot, ivegsrc, stype,scolor, vtype, slope, & dry, icy, wet, lake, ocean, oceanfrac, landfrac, lakefrac, slmsk, islmsk, & zorl, zorlw, zorll, zorli, fice, errmsg, errflg ) @@ -1604,11 +1482,11 @@ subroutine GFS_checkland_run (me, master, blkno, im, kdt, iter, flag_iter, flag_ !if (vegtype(i)==15) then write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_iter(i) :', i, blkno, flag_iter(i) write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, flag_guess(i) :', i, blkno, flag_guess(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, stype(i) :', i, blkno, stype(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, stype(i) :', i, blkno, stype(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, scolor(i) :', i, blkno, scolor(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, vtype(i) :', i, blkno, vtype(i) - write(0,'(a,2i5,1x,e16.7)')'YYY: i, blk, slope(i) :', i, blkno, slope(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, scolor(i) :', i, blkno, scolor(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, vtype(i) :', i, blkno, vtype(i) + write(0,'(a,2i5,1x,i5)') 'YYY: i, blk, slope(i) :', i, blkno, slope(i) write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, dry(i) :', i, blkno, dry(i) write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, icy(i) :', i, blkno, icy(i) write(0,'(a,2i5,1x,1x,l)') 'YYY: i, blk, wet(i) :', i, blkno, wet(i) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta index 10eb43671..3fb25af27 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_debug.meta @@ -9,17 +9,73 @@ type = scheme [Model] standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type in FV3 + long_name = instance of derived type GFS_control_type units = DDT dimensions = () type = GFS_control_type intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type +[Statein] + standard_name = GFS_statein_type_instance + long_name = prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = prognostic state or tendencies return to dycore + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of derived type GFS_cldprop_type units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type + dimensions = () + type = GFS_cldprop_type + intent = in +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = in +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type intent = in [Interstitial] standard_name = GFS_interstitial_type_instance_all_threads @@ -55,12 +111,68 @@ dimensions = () type = GFS_control_type intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type +[Statein] + standard_name = GFS_statein_type_instance + long_name = prognostic state data in from dycore + units = DDT + dimensions = () + type = GFS_statein_type + intent = in +[Stateout] + standard_name = GFS_stateout_type_instance + long_name = prognostic state or tendencies return to dycore + units = DDT + dimensions = () + type = GFS_stateout_type + intent = in +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = instance of derived type GFS_cldprop_type + units = DDT + dimensions = () + type = GFS_cldprop_type + intent = in +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = in +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type + dimensions = () + type = GFS_diag_type intent = in [Interstitial] standard_name = GFS_interstitial_type_instance_all_threads @@ -202,88 +314,6 @@ type = scheme dependencies = ../../hooks/machine.F -######################################################################## -[ccpp-arg-table] - name = GFS_interstitialtoscreen_init - type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type in FV3 - units = DDT - dimensions = () - type = GFS_control_type - intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type - units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type - intent = in -[Interstitial] - standard_name = GFS_interstitial_type_instance_all_threads - long_name = instance of derived type GFS_interstitial_type - units = DDT - dimensions = (number_of_openmp_threads) - type = GFS_interstitial_type - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = GFS_interstitialtoscreen_timestep_init - type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = instance of derived type GFS_control_type in FV3 - units = DDT - dimensions = () - type = GFS_control_type - intent = in -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = instance of derived type GFS_data_type - units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type - intent = in -[Interstitial] - standard_name = GFS_interstitial_type_instance_all_threads - long_name = instance of derived type GFS_interstitial_type - units = DDT - dimensions = (number_of_openmp_threads) - type = GFS_interstitial_type - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - ######################################################################## [ccpp-arg-table] name = GFS_interstitialtoscreen_run diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 new file mode 100644 index 000000000..632a86597 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.F90 @@ -0,0 +1,107 @@ +!> \file GFS_photochemistry.F90 +!! + +module GFS_photochemistry + use machine, only: kind_phys + use module_ozphys, only: ty_ozphys + use module_h2ophys, only: ty_h2ophys + implicit none +contains + +!> \section arg_table_GFS_photochemistry_init Argument Table +!! \htmlinclude GFS_photochemistry_init.html +!! + subroutine GFS_photochemistry_init(oz_phys_2006, oz_phys_2015, h2o_phys, errmsg, errflg) + logical, intent(in) :: & + oz_phys_2015, & !< Do ozone photochemistry? (2015) + oz_phys_2006, & !< Do ozone photochemistry? (2006) + h2o_phys !< Do stratospheric h2o photochemistry? + character(len=*), intent(out) :: & + errmsg !< CCPP Error message. + integer, intent(out) :: & + errflg !< CCPP Error flag. + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! If no photchemical scheme is on, but SDF has this module, report an error? + if ((.not. oz_phys_2006) .and. (.not. oz_phys_2015) .and. (.not. h2o_phys)) then + write (errmsg,'(*(a))') 'Logic error: One of [oz_phys_2006, oz_phys_2015, or h2o_phys] must == .true. ' + errflg = 1 + return + endif + + ! Only one ozone scheme can be on. Otherwise, return and report error. + if (oz_phys_2006 .and. oz_phys_2015) then + write (errmsg,'(*(a))') 'Logic error: Only one ozone scheme can be enabled at a time' + errflg = 1 + return + endif + + end subroutine GFS_photochemistry_init + +!> \section arg_table_GFS_photochemistry_run Argument Table +!! \htmlinclude GFS_photochemistry_run.html +!! + subroutine GFS_photochemistry_run (dtp, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, & + prsl, dp, ozpl, h2o_phys, h2ophys, h2opl, h2o0, oz0, gt0, do3_dt_prd, do3_dt_ozmx, & + do3_dt_temp, do3_dt_ohoz, dqv_dt_prd, dqv_dt_qvmx, errmsg, errflg) + + ! Inputs + real(kind=kind_phys), intent(in) :: & + dtp, & ! Model timestep + con_1ovg ! Physical constant (1./gravity) + real(kind=kind_phys), intent(in), dimension(:,:) :: & + prsl, & ! Air pressure (Pa) + dp, & ! Pressure thickness (Pa) + gt0 ! Air temperature (K) + real(kind=kind_phys), intent(in), dimension(:,:,:) :: & + ozpl, & ! Ozone data for current model timestep. + h2opl ! h2o data for curent model timestep. + logical, intent(in) :: & + oz_phys_2015, & ! Do ozone photochemistry? (2015) + oz_phys_2006, & ! Do ozone photochemistry? (2006) + h2o_phys ! Do stratospheric h2o photochemistry? + type(ty_ozphys), intent(in) :: & + ozphys ! DDT with ozone photochemistry scheme/data. + type(ty_h2ophys), intent(in) :: & + h2ophys ! DDT with h2o photochemistry scheme/data. + + ! Outputs (optional) + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: & + do3_dt_prd, & ! Physics tendency: production and loss effect + do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect + do3_dt_temp, & ! Physics tendency: temperature effect + do3_dt_ohoz, & ! Physics tendency: overhead ozone effect + dqv_dt_prd, & ! Physics tendency: Climatological net production effect + dqv_dt_qvmx ! Physics tendency: specific humidity effect + + ! Outputs + real(kind=kind_phys), intent(inout), dimension(:,:) :: & + oz0, & ! Update ozone concentration. + h2o0 ! Updated h2o concentration. + character(len=*), intent(out) :: & + errmsg ! CCPP Error message. + integer, intent(out) :: & + errflg ! CCPP Error flag. + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (oz_phys_2015) then + call ozphys%run_o3prog_2015(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & + do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + endif + if (oz_phys_2006) then + call ozphys%run_o3prog_2006(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, do3_dt_prd, & + do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) + endif + if (h2o_phys) then + call h2ophys%run(dtp, prsl, h2opl, h2o0, dqv_dt_prd, dqv_dt_qvmx) + endif + + end subroutine GFS_photochemistry_run + +end module GFS_photochemistry diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta new file mode 100644 index 000000000..a89773b12 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_photochemistry.meta @@ -0,0 +1,229 @@ +######################################################################## +[ccpp-table-properties] + name = GFS_photochemistry + type = scheme + dependencies = ../../hooks/machine.F,../../photochem/module_ozphys.F90 + dependencies = ../../photochem/module_h2ophys.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_photochemistry_init + type = scheme +[oz_phys_2006] + standard_name = flag_for_nrl_2006_ozone_scheme + long_name = flag for new (2006) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[oz_phys_2015] + standard_name = flag_for_nrl_2015_ozone_scheme + long_name = flag for new (2015) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = GFS_photochemistry_run + type = scheme +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in +[oz_phys_2015] + standard_name = flag_for_nrl_2015_ozone_scheme + long_name = flag for new (2015) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[oz_phys_2006] + standard_name = flag_for_nrl_2006_ozone_scheme + long_name = flag for new (2006) ozone physics + units = flag + dimensions = () + type = logical + intent = in +[con_1ovg] + standard_name = one_divided_by_the_gravitational_acceleration + long_name = inverse of gravitational acceleration + units = s2 m-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[prsl] + standard_name = air_pressure + long_name = mid-layer pressure + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[dp] + standard_name = air_pressure_difference_between_midlayers + long_name = difference between mid-layer pressures + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = mixed + dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) + type = real + kind = kind_phys + intent = in +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in +[h2ophys] + standard_name = dataset_for_h2o_photochemistry_physics + long_name = dataset for NRL h2o photochemistry physics + units = mixed + dimensions = () + type = ty_h2ophys + intent = in +[h2opl] + standard_name = stratospheric_water_vapor_forcing + long_name = water forcing data + units = mixed + dimensions = (horizontal_loop_extent,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = in +[h2o0] + standard_name = specific_humidity_of_new_state + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[oz0] + standard_name = ozone_concentration_of_new_state + long_name = ozone concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gt0] + standard_name = air_temperature_of_new_state + long_name = temperature updated by physics + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[do3_dt_prd] + standard_name = ozone_tendency_due_to_production_and_loss_rate + long_name = ozone tendency due to production and loss rate + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[do3_dt_ozmx] + standard_name = ozone_tendency_due_to_ozone_mixing_ratio + long_name = ozone tendency due to ozone mixing ratio + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[do3_dt_temp] + standard_name = ozone_tendency_due_to_temperature + long_name = ozone tendency due to temperature + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[do3_dt_ohoz] + standard_name = ozone_tendency_due_to_overhead_ozone_column + long_name = ozone tendency due to overhead ozone column + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[dqv_dt_prd] + standard_name = water_vapor_tendency_due_to_production_and_loss_rate + long_name = water_vapor tendency due to production and loss rate + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[dqv_dt_qvmx] + standard_name = water_vapor_tendency_due_to_water_vapor_mixing_ratio + long_name = water_vapor tendency due to water_vapor mixing ratio + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 index f53ab3928..378b9a8d2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.F90 @@ -15,12 +15,11 @@ module GFS_phys_time_vary use mersenne_twister, only: random_setseed, random_number use module_ozphys, only: ty_ozphys - - use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin - use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol + use module_h2ophys, only: ty_h2ophys use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm, iamin, iamax, jamin, jamax - use aerinterp, only : read_aerdata, setindxaer, aerinterpol, read_aerdataf + use aerinterp, only : read_aerdata, setindxaer, aerinterpol, read_aerdataf, & + read_aerdata_dl, aerinterpol_dl, read_aerdataf_dl use iccn_def, only : ciplin, ccnin, ci_pres use iccninterp, only : read_cidata, setindxci, ciinterpol @@ -46,9 +45,7 @@ module GFS_phys_time_vary private - public GFS_phys_time_vary_init, GFS_phys_time_vary_timestep_init, GFS_phys_time_vary_timestep_finalize, GFS_phys_time_vary_finalize - - logical :: is_initialized = .false. + public GFS_phys_time_vary_init, GFS_phys_time_vary_timestep_init, GFS_phys_time_vary_finalize real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys @@ -82,7 +79,7 @@ end subroutine copy_error !>\section gen_GFS_phys_time_vary_init GFS_phys_time_vary_init General Algorithm !> @{ subroutine GFS_phys_time_vary_init ( & - me, master, ntoz, h2o_phys, iaerclm, iccn, iaermdl, iflip, im, levs, & + me, master, ntoz, h2o_phys, iaerclm, iaermdl, iccn, iflip, im, levs, & nx, ny, idate, xlat_d, xlon_d, & jindx1_o3, jindx2_o3, ddy_o3, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & @@ -97,7 +94,8 @@ subroutine GFS_phys_time_vary_init ( smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, & lkm, use_lake_model, lakefrac, lakedepth, iopt_lake, iopt_lake_clm, iopt_lake_flake, & - lakefrac_threshold, lakedepth_threshold, ozphys, errmsg, errflg) + lakefrac_threshold, lakedepth_threshold, ozphys, h2ophys, is_initialized, errmsg, & + errflg) implicit none @@ -112,19 +110,19 @@ subroutine GFS_phys_time_vary_init ( integer, intent(inout) :: use_lake_model(:) real(kind=kind_phys), intent(in ) :: lakefrac(:), lakedepth(:) - integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) + integer, intent(inout), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(inout), optional :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(in) :: h2opl(:,:,:) - integer, intent(inout) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) - real(kind_phys), intent(inout) :: ddy_aer(:), ddx_aer(:) + integer, intent(inout), optional :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(inout), optional :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(out) :: aer_nm(:,:,:) - integer, intent(inout) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) - real(kind_phys), intent(inout) :: ddy_ci(:), ddx_ci(:) + integer, intent(inout), optional :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(inout), optional :: ddy_ci(:), ddx_ci(:) integer, intent(inout) :: imap(:), jmap(:) logical, intent(in) :: do_ugwp_v1 - real(kind_phys), intent(inout) :: ddy_j1tau(:), ddy_j2tau(:) - integer, intent(inout) :: jindx1_tau(:), jindx2_tau(:) + real(kind_phys), intent(inout), optional :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(inout), optional :: jindx1_tau(:), jindx2_tau(:) integer, intent(in) :: isot, ivegsrc, nlunit real(kind_phys), intent(inout) :: sncovr(:), sncovr_ice(:) @@ -133,55 +131,56 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: landfrac(:) real(kind_phys), intent(inout) :: weasd(:) type(ty_ozphys), intent(in) :: ozphys + type(ty_h2ophys), intent(in) :: h2ophys ! NoahMP - only allocated when NoahMP is used integer, intent(in) :: lsoil, lsnow_lsm_lbound, lsnow_lsm_ubound real(kind_phys), intent(in) :: zs(:) real(kind_phys), intent(in) :: dzs(:) - real(kind_phys), intent(inout) :: tvxy(:) - real(kind_phys), intent(inout) :: tgxy(:) - real(kind_phys), intent(inout) :: tahxy(:) - real(kind_phys), intent(inout) :: canicexy(:) - real(kind_phys), intent(inout) :: canliqxy(:) - real(kind_phys), intent(inout) :: eahxy(:) - real(kind_phys), intent(inout) :: cmxy(:) - real(kind_phys), intent(inout) :: chxy(:) - real(kind_phys), intent(inout) :: fwetxy(:) - real(kind_phys), intent(inout) :: sneqvoxy(:) - real(kind_phys), intent(inout) :: alboldxy(:) - real(kind_phys), intent(inout) :: qsnowxy(:) - real(kind_phys), intent(inout) :: wslakexy(:) + real(kind_phys), intent(inout), optional :: tvxy(:) + real(kind_phys), intent(inout), optional :: tgxy(:) + real(kind_phys), intent(inout), optional :: tahxy(:) + real(kind_phys), intent(inout), optional :: canicexy(:) + real(kind_phys), intent(inout), optional :: canliqxy(:) + real(kind_phys), intent(inout), optional :: eahxy(:) + real(kind_phys), intent(inout), optional :: cmxy(:) + real(kind_phys), intent(inout), optional :: chxy(:) + real(kind_phys), intent(inout), optional :: fwetxy(:) + real(kind_phys), intent(inout), optional :: sneqvoxy(:) + real(kind_phys), intent(inout), optional :: alboldxy(:) + real(kind_phys), intent(inout), optional :: qsnowxy(:) + real(kind_phys), intent(inout), optional :: wslakexy(:) real(kind_phys), intent(inout) :: albdvis_lnd(:) real(kind_phys), intent(inout) :: albdnir_lnd(:) real(kind_phys), intent(inout) :: albivis_lnd(:) real(kind_phys), intent(inout) :: albinir_lnd(:) - real(kind_phys), intent(inout) :: albdvis_ice(:) - real(kind_phys), intent(inout) :: albdnir_ice(:) - real(kind_phys), intent(inout) :: albivis_ice(:) - real(kind_phys), intent(inout) :: albinir_ice(:) + real(kind_phys), intent(inout), optional :: albdvis_ice(:) + real(kind_phys), intent(inout), optional :: albdnir_ice(:) + real(kind_phys), intent(inout), optional :: albivis_ice(:) + real(kind_phys), intent(inout), optional :: albinir_ice(:) real(kind_phys), intent(inout) :: emiss_lnd(:) real(kind_phys), intent(inout) :: emiss_ice(:) - real(kind_phys), intent(inout) :: taussxy(:) - real(kind_phys), intent(inout) :: waxy(:) - real(kind_phys), intent(inout) :: wtxy(:) - real(kind_phys), intent(inout) :: zwtxy(:) - real(kind_phys), intent(inout) :: xlaixy(:) - real(kind_phys), intent(inout) :: xsaixy(:) - real(kind_phys), intent(inout) :: lfmassxy(:) - real(kind_phys), intent(inout) :: stmassxy(:) - real(kind_phys), intent(inout) :: rtmassxy(:) - real(kind_phys), intent(inout) :: woodxy(:) - real(kind_phys), intent(inout) :: stblcpxy(:) - real(kind_phys), intent(inout) :: fastcpxy(:) - real(kind_phys), intent(inout) :: smcwtdxy(:) - real(kind_phys), intent(inout) :: deeprechxy(:) - real(kind_phys), intent(inout) :: rechxy(:) - real(kind_phys), intent(inout) :: snowxy(:) - real(kind_phys), intent(inout) :: snicexy(:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: snliqxy(:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: tsnoxy (:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: smoiseq(:,:) - real(kind_phys), intent(inout) :: zsnsoxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: taussxy(:) + real(kind_phys), intent(inout), optional :: waxy(:) + real(kind_phys), intent(inout), optional :: wtxy(:) + real(kind_phys), intent(inout), optional :: zwtxy(:) + real(kind_phys), intent(inout), optional :: xlaixy(:) + real(kind_phys), intent(inout), optional :: xsaixy(:) + real(kind_phys), intent(inout), optional :: lfmassxy(:) + real(kind_phys), intent(inout), optional :: stmassxy(:) + real(kind_phys), intent(inout), optional :: rtmassxy(:) + real(kind_phys), intent(inout), optional :: woodxy(:) + real(kind_phys), intent(inout), optional :: stblcpxy(:) + real(kind_phys), intent(inout), optional :: fastcpxy(:) + real(kind_phys), intent(inout), optional :: smcwtdxy(:) + real(kind_phys), intent(inout), optional :: deeprechxy(:) + real(kind_phys), intent(inout), optional :: rechxy(:) + real(kind_phys), intent(inout), optional :: snowxy(:) + real(kind_phys), intent(inout), optional :: snicexy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: snliqxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: tsnoxy (:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: smoiseq(:,:) + real(kind_phys), intent(inout), optional :: zsnsoxy(:,lsnow_lsm_lbound:) real(kind_phys), intent(inout) :: slc(:,:) real(kind_phys), intent(inout) :: smc(:,:) real(kind_phys), intent(inout) :: stc(:,:) @@ -194,6 +193,7 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: con_t0c integer, intent(in) :: nthrds + logical, intent(inout) :: is_initialized character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -215,6 +215,9 @@ subroutine GFS_phys_time_vary_init ( ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + ! Initialize copy_error variables + myerrflg = 0 + myerrmsg = 'Error in GFS_phys_time_vary' if (is_initialized) return iamin=999 @@ -222,37 +225,17 @@ subroutine GFS_phys_time_vary_init ( jamin=999 jamax=-999 -!> - Call read_h2odata() to read stratospheric water vapor data - need_h2odata: if(h2o_phys) then - call read_h2odata (h2o_phys, me, master) - - ! Consistency check that the hardcoded values for levh2o and - ! h2o_coeff in GFS_typedefs.F90 match what is set by read_h2odata - ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) - if (size(h2opl, dim=2).ne.levh2o) then - write(myerrmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", & - levh2o, " /= ", size(h2opl, dim=2) - myerrflg = 1 - call copy_error(myerrmsg, myerrflg, errmsg, errflg) - end if - if (size(h2opl, dim=3).ne.h2o_coeff) then - write(myerrmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", & - h2o_coeff, " /= ", size(h2opl, dim=3) - myerrflg = 1 - call copy_error(myerrmsg, myerrflg, errmsg, errflg) - end if - endif need_h2odata - !> - Call read_aerdata() to read aerosol climatology, Anning added coupled !> added coupled gocart and radiation option to initializing aer_nm if (iaerclm) then ntrcaer = ntrcaerm - myerrflg = 0 - myerrmsg = 'read_aerdata failed without a message' - call read_aerdata (me,master,iflip,idate,myerrmsg,myerrflg) - call copy_error(myerrmsg, myerrflg, errmsg, errflg) + if(iaermdl == 1) then + call read_aerdata (me,master,iflip,idate,errmsg,errflg) + elseif (iaermdl == 6) then + call read_aerdata_dl(me,master,iflip, & + idate,fhour, errmsg,errflg) + end if + if(errflg/=0) return else if(iaermdl ==2 ) then do ix=1,ntrcaerm do j=1,levs @@ -275,24 +258,18 @@ subroutine GFS_phys_time_vary_init ( !> - Call tau_amf dats for ugwp_v1 if (do_ugwp_v1) then - myerrflg = 0 - myerrmsg = 'read_tau_amf failed without a message' - call read_tau_amf(me, master, myerrmsg, myerrflg) - call copy_error(myerrmsg, myerrflg, errmsg, errflg) + call read_tau_amf(me, master, errmsg, errflg) + if(errflg/=0) return endif !> - Initialize soil vegetation (needed for sncovr calculation further down) - myerrflg = 0 - myerrmsg = 'set_soilveg failed without a message' - call set_soilveg(me, isot, ivegsrc, nlunit, myerrmsg, myerrflg) - call copy_error(myerrmsg, myerrflg, errmsg, errflg) + call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) + if(errflg/=0) return !> - read in NoahMP table (needed for NoahMP init) if(lsm == lsm_noahmp) then - myerrflg = 0 - myerrmsg = 'read_mp_table_parameters failed without a message' - call read_mp_table_parameters(myerrmsg, myerrflg) - call copy_error(myerrmsg, myerrflg, errmsg, errflg) + call read_mp_table_parameters(errmsg, errflg) + if(errflg/=0) return endif @@ -305,7 +282,7 @@ subroutine GFS_phys_time_vary_init ( !> - Call setindxh2o() to initialize stratospheric water vapor data if (h2o_phys) then - call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) + call h2ophys%setup(xlat_d, jindx1_h, jindx2_h, ddy_h) endif !> - Call setindxaer() to initialize aerosols data @@ -375,7 +352,11 @@ subroutine GFS_phys_time_vary_init ( if (iaerclm) then ! This call is outside the OpenMP section, so it should access errmsg & errflg directly. - call read_aerdataf (me, master, iflip, idate, fhour, errmsg, errflg) + if(iaermdl==1) then + call read_aerdataf (me, master, iflip, idate, fhour, errmsg, errflg) + elseif (iaermdl==6) then + call read_aerdataf_dl (me, master, iflip, idate, fhour, errmsg, errflg) + end if ! If it is moved to an OpenMP section, it must use myerrmsg, myerrflg, and copy_error. if (errflg/=0) return end if @@ -547,10 +528,8 @@ subroutine GFS_phys_time_vary_init ( endif if (vegtyp == 15) then ! land ice in MODIS/IGBP - if (weasd(ix) < 0.1_kind_phys) then - weasd(ix) = 0.1_kind_phys - snd = 0.01_kind_phys - endif + weasd(ix) = 600.0_kind_phys ! 600mm SWE for glacier + snd = 2.0_kind_phys ! 2m snow depth for glacier endif if (snd < 0.025_kind_phys ) then @@ -593,8 +572,10 @@ subroutine GFS_phys_time_vary_init ( isnow = nint(snowxy(ix))+1 ! snowxy <=0.0, dzsno >= 0.0 +! using stc and tgxy to linearly interpolate the snow temp for each layer + do is = isnow,0 - tsnoxy(ix,is) = tgxy(ix) + tsnoxy(ix,is) = tgxy(ix) + (( sum(dzsno(isnow:is)) -0.5*dzsno(is) )/snd)*(stc(ix,1)-tgxy(ix)) snliqxy(ix,is) = zero snicexy(ix,is) = one * dzsno(is) * weasd(ix)/snd enddo @@ -724,36 +705,39 @@ end subroutine GFS_phys_time_vary_init !>\section gen_GFS_phys_time_vary_timestep_init GFS_phys_time_vary_timestep_init General Algorithm !> @{ subroutine GFS_phys_time_vary_timestep_init ( & - me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & - imfdeepcnv, cal_pre, random_clds, nscyc, ntoz, h2o_phys, iaerclm, iccn, clstp, & + me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, cplflx, & + nsswr, fhswr, lsswr, fhour, & + imfdeepcnv, cal_pre, random_clds, nscyc, ntoz, h2o_phys, iaerclm, iaermdl, iccn, clstp, & jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, fn_nml, & imap, jmap, prsl, seed0, rann, nthrds, nx, ny, nsst, tile_num, nlunit, lsoil, lsoil_lsm,& kice, ialb, isot, ivegsrc, input_nml_file, use_ufo, nst_anl, frac_grid, fhcyc, phour, & - lakefrac, min_seaice, min_lakeice, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, & + oceanfrac, lakefrac, min_seaice, min_lakeice, smc, slc, stc, smois, sh2o, tslb, tiice, & + tg3, tref, & tsfc, tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, & zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, stype,scolor, shdmin, shdmax, snowd, & - cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, ozphys, & - do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, errmsg, errflg) + cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, landfrac, ozphys, h2ophys, & + do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, is_initialized, & + errmsg, errflg) implicit none ! Interface variables integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & - nsswr, imfdeepcnv, iccn, nscyc, ntoz, iflip + nsswr, imfdeepcnv, iccn, nscyc, ntoz, iflip, iaermdl integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhswr, fhour - logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm + logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm, cplflx real(kind_phys), intent(out) :: clstp - integer, intent(in) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(in) :: ddy_o3(:), ddy_h(:) + integer, intent(in), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in), optional :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) - integer, intent(in) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) - real(kind_phys), intent(in) :: ddy_aer(:), ddx_aer(:) + integer, intent(in), optional :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(in), optional :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(inout) :: aer_nm(:,:,:) - integer, intent(in) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) - real(kind_phys), intent(in) :: ddy_ci(:), ddx_ci(:) + integer, intent(in), optional :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(in), optional :: ddy_ci(:), ddx_ci(:) real(kind_phys), intent(inout) :: in_nm(:,:), ccn_nm(:,:) integer, intent(in) :: imap(:), jmap(:) real(kind_phys), intent(in) :: prsl(:,:) @@ -761,10 +745,11 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(inout) :: rann(:,:) logical, intent(in) :: do_ugwp_v1 - integer, intent(in) :: jindx1_tau(:), jindx2_tau(:) - real(kind_phys), intent(in) :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(in), optional :: jindx1_tau(:), jindx2_tau(:) + real(kind_phys), intent(in), optional :: ddy_j1tau(:), ddy_j2tau(:) real(kind_phys), intent(inout) :: tau_amf(:) type(ty_ozphys), intent(in) :: ozphys + type(ty_h2ophys), intent(in) :: h2ophys ! For gcycle only integer, intent(in) :: nthrds, nx, ny, nsst, tile_num, nlunit, lsoil @@ -773,16 +758,17 @@ subroutine GFS_phys_time_vary_timestep_init ( character(len=*), intent(in) :: fn_nml logical, intent(in) :: use_ufo, nst_anl, frac_grid real(kind_phys), intent(in) :: fhcyc, phour, lakefrac(:), min_seaice, min_lakeice, & - xlat_d(:), xlon_d(:), landfrac(:) - real(kind_phys), intent(inout) :: smc(:,:), slc(:,:), stc(:,:), smois(:,:), sh2o(:,:), & - tslb(:,:), tiice(:,:), tg3(:), tref(:), & + xlat_d(:), xlon_d(:), landfrac(:),oceanfrac(:) + real(kind_phys), intent(inout) :: smc(:,:), slc(:,:), stc(:,:), tiice(:,:), tg3(:), & tsfc(:), tsfco(:), tisfc(:), hice(:), fice(:), & facsf(:), facwf(:), alvsf(:), alvwf(:), alnsf(:), alnwf(:), & zorli(:), zorll(:), zorlo(:), weasd(:), snoalb(:), & canopy(:), vfrac(:), shdmin(:), shdmax(:), & snowd(:), cv(:), cvb(:), cvt(:), oro(:), oro_uf(:), slmsk(:) + real(kind_phys), intent(inout), optional :: smois(:,:), sh2o(:,:), tslb(:,:), tref(:) integer, intent(inout) :: vtype(:), stype(:),scolor(:), slope(:) + logical, intent(in) :: is_initialized character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -793,7 +779,6 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys) :: rannie(cny) real(kind_phys) :: rndval(cnx*cny*nrcm) real(kind_dbl_prec) :: rinc(5) - real(kind_sngl_prec) :: rinc4(5) ! Initialize CCPP error handling variables errmsg = '' @@ -808,12 +793,12 @@ subroutine GFS_phys_time_vary_timestep_init ( !$OMP parallel num_threads(nthrds) default(none) & !$OMP shared(kdt,nsswr,lsswr,clstp,imfdeepcnv,cal_pre,random_clds) & -!$OMP shared(fhswr,fhour,seed0,cnx,cny,nrcm,wrk,rannie,rndval) & +!$OMP shared(fhswr,fhour,seed0,cnx,cny,nrcm,wrk,rannie,rndval, iaermdl) & !$OMP shared(rann,im,isc,jsc,imap,jmap,ntoz,me,idate,jindx1_o3,jindx2_o3) & !$OMP shared(ozpl,ddy_o3,h2o_phys,jindx1_h,jindx2_h,h2opl,ddy_h,iaerclm,master) & !$OMP shared(levs,prsl,iccn,jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci) & !$OMP shared(ddx_ci,in_nm,ccn_nm,do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau) & -!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys,rjday,n1,n2,idat,jdat,rinc,rinc4) & +!$OMP shared(ddy_j2tau,tau_amf,iflip,ozphys,h2ophys,rjday,n1,n2,idat,jdat,rinc) & !$OMP shared(w3kindreal,w3kindint,jdow,jdoy,jday) & !$OMP private(iseed,iskip,i,j,k) @@ -873,13 +858,7 @@ subroutine GFS_phys_time_vary_timestep_init ( idat(5)=idate(1) rinc=0. rinc(2)=fhour - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL w3movdat(rinc4,idat,jdat) - else - CALL w3movdat(rinc,idat,jdat) - endif + CALL w3movdat(rinc,idat,jdat) jdow = 0 jdoy = 0 jday = 0 @@ -887,27 +866,18 @@ subroutine GFS_phys_time_vary_timestep_init ( rjday = jdoy + jdat(5) / 24. if (rjday < ozphys%time(1)) rjday = rjday + 365. - n2 = ozphys%ntime + 1 - do j=2,ozphys%ntime - if (rjday < ozphys%time(j)) then - n2 = j - exit - endif - enddo - n1 = n2 - 1 - if (n2 > ozphys%ntime) n2 = n2 - ozphys%ntime - !> - Update ozone concentration. if (ntoz > 0) then + call find_photochem_time_index(ozphys%ntime, ozphys%time, rjday, n1, n2) + call ozphys%update_o3prog(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) endif -!$OMP section -!> - Call h2ointerpol() to make stratospheric water vapor data interpolation +!> - Update stratospheric h2o concentration. if (h2o_phys) then - call h2ointerpol (me, im, idate, fhour, & - jindx1_h, jindx2_h, & - h2opl, ddy_h) + call find_photochem_time_index(h2ophys%ntime, h2ophys%time, rjday, n1, n2) + + call h2ophys%update(jindx1_h, jindx2_h, ddy_h, rjday, n1, n2, h2opl) endif !$OMP section @@ -935,14 +905,20 @@ subroutine GFS_phys_time_vary_timestep_init ( if (iaerclm) then ! aerinterpol is using threading inside, don't ! move into OpenMP parallel section above - call aerinterpol (me, master, nthrds, im, idate, & - fhour, iflip, jindx1_aer, jindx2_aer, & - ddy_aer, iindx1_aer, & - iindx2_aer, ddx_aer, & - levs, prsl, aer_nm, errmsg, errflg) - if(errflg /= 0) then - return + if (iaermdl==1) then + call aerinterpol (me, master, nthrds, im, idate, & + fhour, iflip, jindx1_aer, jindx2_aer, & + ddy_aer, iindx1_aer, & + iindx2_aer, ddx_aer, & + levs, prsl, aer_nm, errmsg, errflg) + else if (iaermdl==6) then + call aerinterpol_dl (me, master, nthrds, im, idate, & + fhour, iflip, jindx1_aer, jindx2_aer, & + ddy_aer, iindx1_aer, & + iindx2_aer, ddx_aer, & + levs, prsl, aer_nm, errmsg, errflg) endif + if(errflg /= 0) return endif !> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs @@ -955,43 +931,48 @@ subroutine GFS_phys_time_vary_timestep_init ( tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, & zorli, zorll, zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, & stype, scolor, shdmin, shdmax, snowd, cv, cvb, cvt, oro, oro_uf, & + cplflx, oceanfrac, & xlat_d, xlon_d, slmsk, imap, jmap, errmsg, errflg) endif endif + contains + !> Find the time indexes on either side of current time + subroutine find_photochem_time_index(ntime, time, rjday, n1, n2) + implicit none + !> The number of times provided in the parameter file + integer, intent(in) :: ntime + !> The indexes of the parameters just before and after the + !! current time + integer, intent(out) :: n1, n2 + !> The times provided in the parameter file + real, intent(in), dimension(ntime+1) :: time + !> The current time of year + real, intent(in) :: rjday + n2 = ntime + 1 + do j=2,ntime + if (rjday < time(j)) then + n2 = j + exit + endif + enddo + n1 = n2 - 1 + if (n2 > ntime) n2 = n2 - ntime + end subroutine find_photochem_time_index end subroutine GFS_phys_time_vary_timestep_init !> @} -!> \section arg_table_GFS_phys_time_vary_timestep_finalize Argument Table -!! \htmlinclude GFS_phys_time_vary_timestep_finalize.html -!! -!>\section gen_GFS_phys_time_vary_timestep_finalize GFS_phys_time_vary_timestep_finalize General Algorithm -!> @{ - subroutine GFS_phys_time_vary_timestep_finalize (errmsg, errflg) - - implicit none - - ! Interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - end subroutine GFS_phys_time_vary_timestep_finalize -!> @} - !> \section arg_table_GFS_phys_time_vary_finalize Argument Table !! \htmlinclude GFS_phys_time_vary_finalize.html !! - subroutine GFS_phys_time_vary_finalize(errmsg, errflg) + subroutine GFS_phys_time_vary_finalize(is_initialized, errmsg, errflg) implicit none ! Interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + logical, intent(inout) :: is_initialized + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! Initialize CCPP error handling variables errmsg = '' @@ -999,12 +980,6 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (.not.is_initialized) return - ! Deallocate h2o arrays - if (allocated(h2o_lat) ) deallocate(h2o_lat) - if (allocated(h2o_pres)) deallocate(h2o_pres) - if (allocated(h2o_time)) deallocate(h2o_time) - if (allocated(h2oplin) ) deallocate(h2oplin) - ! Deallocate aerosol arrays if (allocated(aerin) ) deallocate(aerin) if (allocated(aer_pres)) deallocate(aer_pres) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta index a1990ed43..be7960bae 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.fv3.meta @@ -1,15 +1,14 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F dependencies = Interstitials/UFS_SCM_NEPTUNE/gcycle.F90,Interstitials/UFS_SCM_NEPTUNE/iccn_def.F dependencies = Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90,Interstitials/UFS_SCM_NEPTUNE/sfcsub.F dependencies = Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/Noah/namelist_soilveg.f,SFC_Models/Land/Noah/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 - dependencies = photochem/module_ozphys.F90 - dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 + dependencies = photochem/module_ozphys.F90,photochem/module_h2ophys.F90 dependencies = GWD/cires_tauamf_data.F90 ######################################################################## @@ -131,6 +130,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_o3] standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation long_name = interpolation high index for ozone @@ -138,6 +138,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_o3] standard_name = latitude_interpolation_weight_for_ozone_forcing long_name = interpolation high index for ozone @@ -146,6 +147,7 @@ type = real kind = kind_phys intent = inout + optional = True [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor @@ -153,6 +155,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_h] standard_name = upper_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation high index for stratospheric water vapor @@ -160,6 +163,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_h] standard_name = latitude_interpolation_weight_for_stratospheric_water_vapor_forcing long_name = interpolation high index for stratospheric water vapor @@ -168,6 +172,7 @@ type = real kind = kind_phys intent = inout + optional = True [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data @@ -191,6 +196,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_aer] standard_name = upper_latitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the y direction @@ -198,6 +204,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_aer] standard_name = latitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the y direction @@ -206,6 +213,7 @@ type = real kind = kind_phys intent = inout + optional = True [iindx1_aer] standard_name = lower_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation low index for prescribed aerosols in the x direction @@ -213,6 +221,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [iindx2_aer] standard_name = upper_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the x direction @@ -220,6 +229,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddx_aer] standard_name = longitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the x direction @@ -228,6 +238,7 @@ type = real kind = kind_phys intent = inout + optional = True [aer_nm] standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 long_name = mass mixing ratio of aerosol from gocart or merra2 @@ -243,6 +254,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_ci] standard_name = upper_latitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -250,6 +262,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_ci] standard_name = latitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -258,6 +271,7 @@ type = real kind = kind_phys intent = inout + optional = True [iindx1_ci] standard_name = lower_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation low index for ice and cloud condensation nuclei in the x direction @@ -265,6 +279,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [iindx2_ci] standard_name = upper_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -272,6 +287,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddx_ci] standard_name = longitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -280,6 +296,7 @@ type = real kind = kind_phys intent = inout + optional = True [imap] standard_name = map_of_block_column_number_to_global_i_index long_name = map of local index ix to global index i for this block @@ -308,6 +325,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_tau] standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs @@ -315,6 +333,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_j1tau] standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs @@ -323,6 +342,7 @@ type = real intent = inout kind = kind_phys + optional = True [ddy_j2tau] standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs @@ -331,6 +351,7 @@ type = real intent = inout kind = kind_phys + optional = True [isot] standard_name = control_for_soil_type_dataset long_name = soil type dataset choice @@ -473,6 +494,7 @@ type = real kind = kind_phys intent = inout + optional = True [tgxy] standard_name = ground_temperature long_name = ground temperature for noahmp @@ -481,6 +503,7 @@ type = real kind = kind_phys intent = inout + optional = True [tahxy] standard_name = air_temperature_in_canopy long_name = canopy air temperature @@ -489,6 +512,7 @@ type = real kind = kind_phys intent = inout + optional = True [canicexy] standard_name = canopy_intercepted_ice_mass long_name = canopy intercepted ice mass @@ -497,6 +521,7 @@ type = real kind = kind_phys intent = inout + optional = True [canliqxy] standard_name = canopy_intercepted_liquid_water long_name = canopy intercepted liquid water @@ -505,6 +530,7 @@ type = real kind = kind_phys intent = inout + optional = True [eahxy] standard_name = air_vapor_pressure_in_canopy long_name = canopy air vapor pressure @@ -513,6 +539,7 @@ type = real kind = kind_phys intent = inout + optional = True [cmxy] standard_name = surface_drag_coefficient_for_momentum_for_noahmp long_name = surface drag coefficient for momentum for noahmp @@ -521,6 +548,7 @@ type = real kind = kind_phys intent = inout + optional = True [chxy] standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp long_name = surface exchange coeff heat & moisture for noahmp @@ -529,6 +557,7 @@ type = real kind = kind_phys intent = inout + optional = True [fwetxy] standard_name = wet_canopy_area_fraction long_name = area fraction of canopy that is wetted/snowed @@ -537,6 +566,7 @@ type = real kind = kind_phys intent = inout + optional = True [sneqvoxy] standard_name = lwe_thickness_of_snowfall_amount_on_previous_timestep long_name = snow mass at previous time step @@ -545,6 +575,7 @@ type = real kind = kind_phys intent = inout + optional = True [alboldxy] standard_name = surface_albedo_assuming_deep_snow_on_previous_timestep long_name = snow albedo at previous time step @@ -553,6 +584,7 @@ type = real kind = kind_phys intent = inout + optional = True [qsnowxy] standard_name = lwe_snowfall_rate long_name = snow precipitation rate at surface @@ -561,6 +593,7 @@ type = real kind = kind_phys intent = inout + optional = True [wslakexy] standard_name = water_storage_in_lake long_name = lake water storage @@ -569,6 +602,7 @@ type = real kind = kind_phys intent = inout + optional = True [taussxy] standard_name = dimensionless_age_of_surface_snow long_name = non-dimensional snow age @@ -577,6 +611,7 @@ type = real kind = kind_phys intent = inout + optional = True [waxy] standard_name = water_storage_in_aquifer long_name = water storage in aquifer @@ -585,6 +620,7 @@ type = real kind = kind_phys intent = inout + optional = True [wtxy] standard_name = water_storage_in_aquifer_and_saturated_soil long_name = water storage in aquifer and saturated soil @@ -593,6 +629,7 @@ type = real kind = kind_phys intent = inout + optional = True [zwtxy] standard_name = water_table_depth long_name = water table depth @@ -601,6 +638,7 @@ type = real kind = kind_phys intent = inout + optional = True [xlaixy] standard_name = leaf_area_index long_name = leaf area index @@ -609,6 +647,7 @@ type = real kind = kind_phys intent = inout + optional = True [xsaixy] standard_name = stem_area_index long_name = stem area index @@ -617,6 +656,7 @@ type = real kind = kind_phys intent = inout + optional = True [lfmassxy] standard_name = leaf_mass_content long_name = leaf mass @@ -625,6 +665,7 @@ type = real kind = kind_phys intent = inout + optional = True [stmassxy] standard_name = stem_mass_content long_name = stem mass @@ -633,6 +674,7 @@ type = real kind = kind_phys intent = inout + optional = True [rtmassxy] standard_name = fine_root_mass_content long_name = fine root mass @@ -641,6 +683,7 @@ type = real kind = kind_phys intent = inout + optional = True [woodxy] standard_name = wood_mass_content long_name = wood mass including woody roots @@ -649,6 +692,7 @@ type = real kind = kind_phys intent = inout + optional = True [stblcpxy] standard_name = slow_soil_pool_mass_content_of_carbon long_name = stable carbon in deep soil @@ -657,6 +701,7 @@ type = real kind = kind_phys intent = inout + optional = True [fastcpxy] standard_name = fast_soil_pool_mass_content_of_carbon long_name = short-lived carbon in shallow soil @@ -665,6 +710,7 @@ type = real kind = kind_phys intent = inout + optional = True [smcwtdxy] standard_name = volumetric_soil_moisture_between_soil_bottom_and_water_table long_name = soil water content between the bottom of the soil and the water table @@ -673,6 +719,7 @@ type = real kind = kind_phys intent = inout + optional = True [deeprechxy] standard_name = water_table_recharge_assuming_deep long_name = recharge to or from the water table when deep @@ -681,6 +728,7 @@ type = real kind = kind_phys intent = inout + optional = True [rechxy] standard_name = water_table_recharge_assuming_shallow long_name = recharge to or from the water table when shallow @@ -689,6 +737,7 @@ type = real kind = kind_phys intent = inout + optional = True [albdvis_lnd] standard_name = surface_albedo_direct_visible_over_land long_name = direct surface albedo visible band over land @@ -729,6 +778,7 @@ type = real kind = kind_phys intent = inout + optional = True [albdnir_ice] standard_name = surface_albedo_direct_NIR_over_ice long_name = direct surface albedo NIR band over ice @@ -737,6 +787,7 @@ type = real kind = kind_phys intent = inout + optional = True [albivis_ice] standard_name = surface_albedo_diffuse_visible_over_ice long_name = diffuse surface albedo visible band over ice @@ -745,6 +796,7 @@ type = real kind = kind_phys intent = inout + optional = True [albinir_ice] standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice @@ -753,6 +805,7 @@ type = real kind = kind_phys intent = inout + optional = True [emiss_lnd] standard_name = surface_longwave_emissivity_over_land long_name = surface lw emissivity in fraction over land @@ -777,6 +830,7 @@ type = real kind = kind_phys intent = inout + optional = True [snicexy] standard_name = lwe_thickness_of_ice_in_surface_snow long_name = snow layer ice @@ -785,6 +839,7 @@ type = real kind = kind_phys intent = inout + optional = True [snliqxy] standard_name = lwe_thickness_of_liquid_water_in_surface_snow long_name = snow layer liquid water @@ -793,6 +848,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsnoxy] standard_name = temperature_in_surface_snow long_name = temperature_in_surface_snow @@ -801,6 +857,7 @@ type = real kind = kind_phys intent = inout + optional = True [smoiseq] standard_name = volumetric_equilibrium_soil_moisture long_name = equilibrium soil water content @@ -809,6 +866,7 @@ type = real kind = kind_phys intent = inout + optional = True [zsnsoxy] standard_name = depth_from_snow_surface_at_bottom_interface long_name = depth from the top of the snow surface at the bottom of the layer @@ -817,6 +875,7 @@ type = real kind = kind_phys intent = inout + optional = True [slc] standard_name = volume_fraction_of_unfrozen_water_in_soil long_name = liquid soil moisture @@ -976,6 +1035,20 @@ dimensions = () type = ty_ozphys intent = in +[h2ophys] + standard_name = dataset_for_h2o_photochemistry_physics + long_name = dataset for NRL h2o photochemistry physics + units = mixed + dimensions = () + type = ty_h2ophys + intent = in +[is_initialized] + standard_name = flag_for_gfs_phys_time_vary_interstitial_initialization + long_name = flag carrying interstitial initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -996,6 +1069,13 @@ [ccpp-arg-table] name = GFS_phys_time_vary_finalize type = scheme +[is_initialized] + standard_name = flag_for_gfs_phys_time_vary_interstitial_initialization + long_name = flag carrying interstitial initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1093,6 +1173,13 @@ dimensions = (4) type = integer intent = in +[cplflx] + standard_name = flag_for_surface_flux_coupling + long_name = flag controlling cplflx collection (default off) + units = flag + dimensions = () + type = logical + intent = in [nsswr] standard_name = number_of_timesteps_between_shortwave_radiation_calls long_name = number of timesteps between shortwave radiation calls @@ -1172,6 +1259,13 @@ dimensions = () type = logical intent = in +[iaermdl] + standard_name = control_for_aerosol_radiation_scheme + long_name = control of aerosol scheme in radiation + units = 1 + dimensions = () + type = integer + intent = in [iccn] standard_name = control_for_ice_cloud_condensation_nuclei_forcing long_name = flag for IN and CCN forcing for morrison gettelman microphysics @@ -1194,6 +1288,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_o3] standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation long_name = interpolation high index for ozone @@ -1201,6 +1296,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_o3] standard_name = latitude_interpolation_weight_for_ozone_forcing long_name = interpolation high index for ozone @@ -1209,6 +1305,7 @@ type = real kind = kind_phys intent = in + optional = True [ozpl] standard_name = ozone_forcing long_name = ozone forcing data @@ -1224,6 +1321,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_h] standard_name = upper_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation high index for stratospheric water vapor @@ -1231,6 +1329,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_h] standard_name = latitude_interpolation_weight_for_stratospheric_water_vapor_forcing long_name = interpolation high index for stratospheric water vapor @@ -1239,6 +1338,7 @@ type = real kind = kind_phys intent = in + optional = True [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data @@ -1261,6 +1361,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_aer] standard_name = upper_latitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the y direction @@ -1268,6 +1369,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_aer] standard_name = latitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the y direction @@ -1276,6 +1378,7 @@ type = real kind = kind_phys intent = in + optional = True [iindx1_aer] standard_name = lower_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation low index for prescribed aerosols in the x direction @@ -1283,6 +1386,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [iindx2_aer] standard_name = upper_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the x direction @@ -1290,6 +1394,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddx_aer] standard_name = longitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the x direction @@ -1298,6 +1403,7 @@ type = real kind = kind_phys intent = in + optional = True [aer_nm] standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 long_name = mass mixing ratio of aerosol from gocart or merra2 @@ -1313,6 +1419,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_ci] standard_name = upper_latitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -1320,6 +1427,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_ci] standard_name = latitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -1328,6 +1436,7 @@ type = real kind = kind_phys intent = in + optional = True [iindx1_ci] standard_name = lower_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation low index for ice and cloud condensation nuclei in the x direction @@ -1335,6 +1444,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [iindx2_ci] standard_name = upper_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -1342,6 +1452,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddx_ci] standard_name = longitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -1350,6 +1461,7 @@ type = real kind = kind_phys intent = in + optional = True [in_nm] standard_name = ice_nucleation_number_from_climatology long_name = ice nucleation number in MG MP @@ -1540,6 +1652,14 @@ type = real kind = kind_phys intent = in +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in [lakefrac] standard_name = lake_area_fraction long_name = fraction of horizontal grid area occupied by lake @@ -1596,6 +1716,7 @@ type = real kind = kind_phys intent = inout + optional = True [sh2o] standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model long_name = volume fraction of unfrozen soil moisture for lsm @@ -1604,6 +1725,7 @@ type = real kind = kind_phys intent = inout + optional = True [tslb] standard_name = soil_temperature_for_land_surface_model long_name = soil temperature for land surface model @@ -1612,6 +1734,7 @@ type = real kind = kind_phys intent = inout + optional = True [tiice] standard_name = temperature_in_ice_layer long_name = sea ice internal temperature @@ -1636,6 +1759,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -1918,6 +2042,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_tau] standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs @@ -1925,6 +2050,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_j1tau] standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs @@ -1933,6 +2059,7 @@ type = real intent = in kind = kind_phys + optional = True [ddy_j2tau] standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs @@ -1941,6 +2068,7 @@ type = real intent = in kind = kind_phys + optional = True [tau_amf] standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux @@ -1956,26 +2084,20 @@ dimensions = () type = ty_ozphys intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none +[h2ophys] + standard_name = dataset_for_h2o_photochemistry_physics + long_name = dataset for NRL h2o photochemistry physics + units = mixed dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 + type = ty_h2ophys + intent = in +[is_initialized] + standard_name = flag_for_gfs_phys_time_vary_interstitial_initialization + long_name = flag carrying interstitial initialization status + units = flag dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = GFS_phys_time_vary_timestep_finalize - type = scheme + type = logical + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 index 075bfc039..2af01115c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.F90 @@ -4,7 +4,6 @@ !>\defgroup mod_GFS_phys_time_vary GFS Physics Time Update !! This module contains GFS physics time vary subroutines including stratospheric water vapor, !! aerosol, IN&CCN and surface properties updates. -!> @{ module GFS_phys_time_vary use machine, only : kind_phys, kind_dbl_prec, kind_sngl_prec @@ -12,12 +11,11 @@ module GFS_phys_time_vary use mersenne_twister, only: random_setseed, random_number use module_ozphys, only: ty_ozphys - - use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin - use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol + use module_h2ophys, only: ty_h2ophys use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm, iamin, iamax, jamin, jamax - use aerinterp, only : read_aerdata, setindxaer, aerinterpol, read_aerdataf + use aerinterp, only : read_aerdata, setindxaer, aerinterpol, read_aerdataf, & + read_aerdata_dl, aerinterpol_dl, read_aerdataf_dl use iccn_def, only : ciplin, ccnin, ci_pres use iccninterp, only : read_cidata, setindxci, ciinterpol @@ -30,7 +28,8 @@ module GFS_phys_time_vary use set_soilveg_mod, only: set_soilveg ! --- needed for Noah MP init - use noahmp_tables, only: laim_table,saim_table,sla_table, & + use noahmp_tables, only: read_mp_table_parameters, & + laim_table,saim_table,sla_table, & bexp_table,smcmax_table,smcwlt_table, & dwsat_table,dksat_table,psisat_table, & isurban_table,isbarren_table, & @@ -40,9 +39,7 @@ module GFS_phys_time_vary private - public GFS_phys_time_vary_init, GFS_phys_time_vary_timestep_init, GFS_phys_time_vary_timestep_finalize, GFS_phys_time_vary_finalize - - logical :: is_initialized = .false. + public GFS_phys_time_vary_init, GFS_phys_time_vary_timestep_init, GFS_phys_time_vary_finalize real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys @@ -58,10 +55,11 @@ module GFS_phys_time_vary !! \htmlinclude GFS_phys_time_vary_init.html !! !>\section gen_GFS_phys_time_vary_init GFS_phys_time_vary_init General Algorithm -!! @{ +!> @{ subroutine GFS_phys_time_vary_init ( & - me, master, ntoz, h2o_phys, iaerclm, iccn, iflip, im, nx, ny, idate, xlat_d, xlon_d, & - jindx1_o3, jindx2_o3, ddy_o3, ozphys, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & + me, master, ntoz, h2o_phys, iaerclm, iaermdl, iccn, iflip, im, levs, & + nx, ny, idate, xlat_d, xlon_d, & + jindx1_o3, jindx2_o3, ddy_o3, jindx1_h, jindx2_h, ddy_h, h2opl,fhour, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & @@ -73,29 +71,36 @@ subroutine GFS_phys_time_vary_init ( zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, & - errmsg, errflg) + lkm, use_lake_model, lakefrac, lakedepth, iopt_lake, iopt_lake_clm, iopt_lake_flake, & + lakefrac_threshold, lakedepth_threshold, ozphys, h2ophys, is_initialized, errmsg, & + errflg) implicit none ! Interface variables - integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny + integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny, levs, iaermdl logical, intent(in) :: h2o_phys, iaerclm, lsm_cold_start - integer, intent(in) :: idate(:) - real(kind_phys), intent(in) :: fhour + integer, intent(in) :: idate(:), iopt_lake, iopt_lake_clm, iopt_lake_flake + real(kind_phys), intent(in) :: fhour, lakefrac_threshold, lakedepth_threshold real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) - integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) + integer, intent(in) :: lkm + integer, intent(inout) :: use_lake_model(:) + real(kind=kind_phys), intent(in ) :: lakefrac(:), lakedepth(:) + + integer, intent(inout), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(inout), optional :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(in) :: h2opl(:,:,:) - integer, intent(inout) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) - real(kind_phys), intent(inout) :: ddy_aer(:), ddx_aer(:) - real(kind_phys), intent(in) :: aer_nm(:,:,:) - integer, intent(inout) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) - real(kind_phys), intent(inout) :: ddy_ci(:), ddx_ci(:) + + integer, intent(inout), optional :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(inout), optional :: ddy_aer(:), ddx_aer(:) + real(kind_phys), intent(out) :: aer_nm(:,:,:) + integer, intent(inout), optional :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(inout), optional :: ddy_ci(:), ddx_ci(:) integer, intent(inout) :: imap(:), jmap(:) logical, intent(in) :: do_ugwp_v1 - real(kind_phys), intent(inout) :: ddy_j1tau(:), ddy_j2tau(:) - integer, intent(inout) :: jindx1_tau(:), jindx2_tau(:) + real(kind_phys), intent(inout), optional :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(inout), optional :: jindx1_tau(:), jindx2_tau(:) integer, intent(in) :: isot, ivegsrc, nlunit real(kind_phys), intent(inout) :: sncovr(:), sncovr_ice(:) @@ -104,55 +109,56 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: landfrac(:) real(kind_phys), intent(inout) :: weasd(:) type(ty_ozphys), intent(in) :: ozphys + type(ty_h2ophys), intent(in) :: h2ophys ! NoahMP - only allocated when NoahMP is used integer, intent(in) :: lsoil, lsnow_lsm_lbound, lsnow_lsm_ubound real(kind_phys), intent(in) :: zs(:) real(kind_phys), intent(in) :: dzs(:) - real(kind_phys), intent(inout) :: tvxy(:) - real(kind_phys), intent(inout) :: tgxy(:) - real(kind_phys), intent(inout) :: tahxy(:) - real(kind_phys), intent(inout) :: canicexy(:) - real(kind_phys), intent(inout) :: canliqxy(:) - real(kind_phys), intent(inout) :: eahxy(:) - real(kind_phys), intent(inout) :: cmxy(:) - real(kind_phys), intent(inout) :: chxy(:) - real(kind_phys), intent(inout) :: fwetxy(:) - real(kind_phys), intent(inout) :: sneqvoxy(:) - real(kind_phys), intent(inout) :: alboldxy(:) - real(kind_phys), intent(inout) :: qsnowxy(:) - real(kind_phys), intent(inout) :: wslakexy(:) + real(kind_phys), intent(inout), optional :: tvxy(:) + real(kind_phys), intent(inout), optional :: tgxy(:) + real(kind_phys), intent(inout), optional :: tahxy(:) + real(kind_phys), intent(inout), optional :: canicexy(:) + real(kind_phys), intent(inout), optional :: canliqxy(:) + real(kind_phys), intent(inout), optional :: eahxy(:) + real(kind_phys), intent(inout), optional :: cmxy(:) + real(kind_phys), intent(inout), optional :: chxy(:) + real(kind_phys), intent(inout), optional :: fwetxy(:) + real(kind_phys), intent(inout), optional :: sneqvoxy(:) + real(kind_phys), intent(inout), optional :: alboldxy(:) + real(kind_phys), intent(inout), optional :: qsnowxy(:) + real(kind_phys), intent(inout), optional :: wslakexy(:) real(kind_phys), intent(inout) :: albdvis_lnd(:) real(kind_phys), intent(inout) :: albdnir_lnd(:) real(kind_phys), intent(inout) :: albivis_lnd(:) real(kind_phys), intent(inout) :: albinir_lnd(:) - real(kind_phys), intent(inout) :: albdvis_ice(:) - real(kind_phys), intent(inout) :: albdnir_ice(:) - real(kind_phys), intent(inout) :: albivis_ice(:) - real(kind_phys), intent(inout) :: albinir_ice(:) + real(kind_phys), intent(inout), optional :: albdvis_ice(:) + real(kind_phys), intent(inout), optional :: albdnir_ice(:) + real(kind_phys), intent(inout), optional :: albivis_ice(:) + real(kind_phys), intent(inout), optional :: albinir_ice(:) real(kind_phys), intent(inout) :: emiss_lnd(:) real(kind_phys), intent(inout) :: emiss_ice(:) - real(kind_phys), intent(inout) :: taussxy(:) - real(kind_phys), intent(inout) :: waxy(:) - real(kind_phys), intent(inout) :: wtxy(:) - real(kind_phys), intent(inout) :: zwtxy(:) - real(kind_phys), intent(inout) :: xlaixy(:) - real(kind_phys), intent(inout) :: xsaixy(:) - real(kind_phys), intent(inout) :: lfmassxy(:) - real(kind_phys), intent(inout) :: stmassxy(:) - real(kind_phys), intent(inout) :: rtmassxy(:) - real(kind_phys), intent(inout) :: woodxy(:) - real(kind_phys), intent(inout) :: stblcpxy(:) - real(kind_phys), intent(inout) :: fastcpxy(:) - real(kind_phys), intent(inout) :: smcwtdxy(:) - real(kind_phys), intent(inout) :: deeprechxy(:) - real(kind_phys), intent(inout) :: rechxy(:) - real(kind_phys), intent(inout) :: snowxy(:) - real(kind_phys), intent(inout) :: snicexy(:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: snliqxy(:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: tsnoxy (:,lsnow_lsm_lbound:) - real(kind_phys), intent(inout) :: smoiseq(:,:) - real(kind_phys), intent(inout) :: zsnsoxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: taussxy(:) + real(kind_phys), intent(inout), optional :: waxy(:) + real(kind_phys), intent(inout), optional :: wtxy(:) + real(kind_phys), intent(inout), optional :: zwtxy(:) + real(kind_phys), intent(inout), optional :: xlaixy(:) + real(kind_phys), intent(inout), optional :: xsaixy(:) + real(kind_phys), intent(inout), optional :: lfmassxy(:) + real(kind_phys), intent(inout), optional :: stmassxy(:) + real(kind_phys), intent(inout), optional :: rtmassxy(:) + real(kind_phys), intent(inout), optional :: woodxy(:) + real(kind_phys), intent(inout), optional :: stblcpxy(:) + real(kind_phys), intent(inout), optional :: fastcpxy(:) + real(kind_phys), intent(inout), optional :: smcwtdxy(:) + real(kind_phys), intent(inout), optional :: deeprechxy(:) + real(kind_phys), intent(inout), optional :: rechxy(:) + real(kind_phys), intent(inout), optional :: snowxy(:) + real(kind_phys), intent(inout), optional :: snicexy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: snliqxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: tsnoxy (:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout), optional :: smoiseq(:,:) + real(kind_phys), intent(inout), optional :: zsnsoxy(:,lsnow_lsm_lbound:) real(kind_phys), intent(inout) :: slc(:,:) real(kind_phys), intent(inout) :: smc(:,:) real(kind_phys), intent(inout) :: stc(:,:) @@ -161,9 +167,11 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: canopy(:) real(kind_phys), intent(in) :: tg3(:) integer, intent(in) :: stype(:) + real(kind_phys), intent(in) :: con_t0c integer, intent(in) :: nthrds + logical, intent(inout) :: is_initialized character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -189,47 +197,27 @@ subroutine GFS_phys_time_vary_init ( jamin=999 jamax=-999 -!> - Call read_h2odata() to read stratospheric water vapor data - call read_h2odata (h2o_phys, me, master) - - ! Consistency check that the hardcoded values for levh2o and - ! h2o_coeff in GFS_typedefs.F90 match what is set by read_h2odata - ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) - if (size(h2opl, dim=2).ne.levh2o) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", & - levh2o, " /= ", size(h2opl, dim=2) - errflg = 1 - end if - if (size(h2opl, dim=3).ne.h2o_coeff) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", & - h2o_coeff, " /= ", size(h2opl, dim=3) - errflg = 1 - end if - !> - Call read_aerdata() to read aerosol climatology if (iaerclm) then - ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 - ! and used to allocate aer_nm matches the value defined in aerclm_def - if (size(aer_nm, dim=3).ne.ntrcaerm) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", & - ntrcaerm, " /= ", size(aer_nm, dim=3) - errflg = 1 - else - ! Update the value of ntrcaer in aerclm_def with the value defined - ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If iaerclm is .true., then ntrcaer == ntrcaerm - ntrcaer = size(aer_nm, dim=3) - ! Read aerosol climatology - call read_aerdata (me,master,iflip,idate,errmsg,errflg) - endif + ntrcaer = ntrcaerm + if(iaermdl == 1) then + call read_aerdata (me,master,iflip,idate,errmsg,errflg) + elseif (iaermdl == 6) then + call read_aerdata_dl(me,master,iflip, & + idate,fhour, errmsg,errflg) + end if + if(errflg/=0) return + else if(iaermdl ==2 ) then + do ix=1,ntrcaerm + do j=1,levs + do i=1,im + aer_nm(i,j,ix) = 1.e-20_kind_phys + end do + end do + end do + ntrcaer = ntrcaerm else - ! Update the value of ntrcaer in aerclm_def with the value defined - ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If iaerclm is .false., then ntrcaer == 1 - ntrcaer = size(aer_nm, dim=3) + ntrcaer = 1 endif !> - Call read_cidata() to read IN and CCN data @@ -242,19 +230,27 @@ subroutine GFS_phys_time_vary_init ( !> - Call tau_amf dats for ugwp_v1 if (do_ugwp_v1) then call read_tau_amf(me, master, errmsg, errflg) + if(errflg/=0) return endif !> - Initialize soil vegetation (needed for sncovr calculation further down) call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) + if(errflg/=0) return + +!> - read in NoahMP table (needed for NoahMP init) + if(lsm == lsm_noahmp) then + call read_mp_table_parameters(errmsg, errflg) + if(errflg/=0) return + endif !> - Setup spatial interpolation indices for ozone physics. if (ntoz > 0) then - call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) + call ozphys%setup_o3prog(xlat_d, jindx1_o3, jindx2_o3, ddy_o3) endif !> - Call setindxh2o() to initialize stratospheric water vapor data if (h2o_phys) then - call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) + call h2ophys%setup(xlat_d, jindx1_h, jindx2_h, ddy_h) endif !> - Call setindxaer() to initialize aerosols data @@ -319,11 +315,15 @@ subroutine GFS_phys_time_vary_init ( sncovr_ice(:) = sncovr(:) endif endif - + if (errflg/=0) return if (iaerclm) then - call read_aerdataf (me, master, iflip, idate, fhour, errmsg, errflg) + if (iaermdl==1) then + call read_aerdataf (me, master, iflip, idate, fhour, errmsg, errflg) + elseif (iaermdl==6) then + call read_aerdataf_dl (me, master, iflip, idate, fhour, errmsg, errflg) + end if if (errflg/=0) return end if @@ -478,10 +478,8 @@ subroutine GFS_phys_time_vary_init ( endif if (vegtyp == 15) then ! land ice in MODIS/IGBP - if (weasd(ix) < 0.1_kind_phys) then - weasd(ix) = 0.1_kind_phys - snd = 0.01_kind_phys - endif + weasd(ix) = 600.0_kind_phys ! 600mm SWE for glacier + snd = 2.0_kind_phys ! 2m snow depth for glacier endif if (snd < 0.025_kind_phys ) then @@ -523,8 +521,10 @@ subroutine GFS_phys_time_vary_init ( isnow = nint(snowxy(ix))+1 ! snowxy <=0.0, dzsno >= 0.0 +! using stc and tgxy to linearly interpolate the snow temp for each layer + do is = isnow,0 - tsnoxy(ix,is) = tgxy(ix) + tsnoxy(ix,is) = tgxy(ix) + (( sum(dzsno(isnow:is)) -0.5*dzsno(is) )/snd)*(stc(ix,1)-tgxy(ix)) snliqxy(ix,is) = zero snicexy(ix,is) = one * dzsno(is) * weasd(ix)/snd enddo @@ -595,6 +595,27 @@ subroutine GFS_phys_time_vary_init ( endif noahmp_init endif lsm_init +!Lake model + if(lkm>0 .and. iopt_lake>0) then + ! A lake model is enabled. + do i = 1, im + !if (lakefrac(i) > 0.0 .and. lakedepth(i) > 1.0 ) then + + ! The lake data must say there's a lake here (lakefrac) with a depth (lakedepth) + if (lakefrac(i) > lakefrac_threshold .and. lakedepth(i) > lakedepth_threshold ) then + ! This is a lake point. Inform the other schemes to use a lake model, and possibly nsst (lkm) + use_lake_model(i) = lkm + cycle + else + ! Not a valid lake point. + use_lake_model(i) = 0 + endif + enddo + else + ! Lake model is disabled or settings are invalid. + use_lake_model = 0 + endif + is_initialized = .true. contains @@ -624,39 +645,39 @@ function find_eq_smc(bexp, dwsat, dksat, ddz, smcmax) result(smc) end function find_eq_smc end subroutine GFS_phys_time_vary_init -!! @} +!> @} !> \section arg_table_GFS_phys_time_vary_timestep_init Argument Table !! \htmlinclude GFS_phys_time_vary_timestep_init.html !! !>\section gen_GFS_phys_time_vary_timestep_init GFS_phys_time_vary_timestep_init General Algorithm -!! @{ +!> @{ subroutine GFS_phys_time_vary_timestep_init ( & me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & - imfdeepcnv, cal_pre, random_clds, ozphys, ntoz, h2o_phys, iaerclm, iccn, clstp, & + imfdeepcnv, cal_pre, random_clds, ntoz, h2o_phys, iaerclm, iaermdl, iccn, clstp, & jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, iflip, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, & - imap, jmap, prsl, seed0, rann, do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau,& - tau_amf, nthrds, errmsg, errflg) + imap, jmap, prsl, seed0, rann, nthrds, ozphys, h2ophys, do_ugwp_v1, jindx1_tau, & + jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, is_initialized, errmsg, errflg) implicit none ! Interface variables integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & - nsswr, imfdeepcnv, iccn, ntoz, iflip + nsswr, imfdeepcnv, iccn, ntoz, iflip, iaermdl integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: fhswr, fhour logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm real(kind_phys), intent(out) :: clstp - integer, intent(in) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) - real(kind_phys), intent(in) :: ddy_o3(:), ddy_h(:) + integer, intent(in), optional :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in), optional :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) - integer, intent(in) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) - real(kind_phys), intent(in) :: ddy_aer(:), ddx_aer(:) + integer, intent(in), optional :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(in), optional :: ddy_aer(:), ddx_aer(:) real(kind_phys), intent(inout) :: aer_nm(:,:,:) - integer, intent(in) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) - real(kind_phys), intent(in) :: ddy_ci(:), ddx_ci(:) + integer, intent(in), optional :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(in), optional :: ddy_ci(:), ddx_ci(:) real(kind_phys), intent(inout) :: in_nm(:,:), ccn_nm(:,:) integer, intent(in) :: imap(:), jmap(:) real(kind_phys), intent(in) :: prsl(:,:) @@ -664,11 +685,13 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(inout) :: rann(:,:) logical, intent(in) :: do_ugwp_v1 - integer, intent(in) :: jindx1_tau(:), jindx2_tau(:) - real(kind_phys), intent(in) :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(in), optional :: jindx1_tau(:), jindx2_tau(:) + real(kind_phys), intent(in), optional :: ddy_j1tau(:), ddy_j2tau(:) real(kind_phys), intent(inout) :: tau_amf(:) type(ty_ozphys), intent(in) :: ozphys + type(ty_h2ophys), intent(in) :: h2ophys integer, intent(in) :: nthrds + logical, intent(in) :: is_initialized character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -679,7 +702,6 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys) :: rannie(cny) real(kind_phys) :: rndval(cnx*cny*nrcm) real(kind_dbl_prec) :: rinc(5) - real(kind_sngl_prec) :: rinc4(5) ! Initialize CCPP error handling variables errmsg = '' @@ -741,13 +763,7 @@ subroutine GFS_phys_time_vary_timestep_init ( idat(5)=idate(1) rinc=0. rinc(2)=fhour - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL w3movdat(rinc4,idat,jdat) - else - CALL w3movdat(rinc,idat,jdat) - endif + CALL w3movdat(rinc,idat,jdat) jdow = 0 jdoy = 0 jday = 0 @@ -755,26 +771,18 @@ subroutine GFS_phys_time_vary_timestep_init ( rjday = jdoy + jdat(5) / 24. if (rjday < ozphys%time(1)) rjday = rjday + 365. - n2 = ozphys%ntime + 1 - do j=2,ozphys%ntime - if (rjday < ozphys%time(j)) then - n2 = j - exit - endif - enddo - n1 = n2 - 1 - if (n2 > ozphys%ntime) n2 = n2 - ozphys%ntime - !> - Update ozone concentration. if (ntoz > 0) then + call find_photochem_time_index(ozphys%ntime, ozphys%time, rjday, n1, n2) + call ozphys%update_o3prog(jindx1_o3, jindx2_o3, ddy_o3, rjday, n1, n2, ozpl) endif -!> - Call h2ointerpol() to make stratospheric water vapor data interpolation +!> - Update stratospheric h2o concentration. if (h2o_phys) then - call h2ointerpol (me, im, idate, fhour, & - jindx1_h, jindx2_h, & - h2opl, ddy_h) + call find_photochem_time_index(h2ophys%ntime, h2ophys%time, rjday, n1, n2) + + call h2ophys%update(jindx1_h, jindx2_h, ddy_h, rjday, n1, n2, h2opl) endif !> - Call ciinterpol() to make IN and CCN data interpolation @@ -797,61 +805,59 @@ subroutine GFS_phys_time_vary_timestep_init ( if (iaerclm) then ! aerinterpol is using threading inside, don't ! move into OpenMP parallel section above - call aerinterpol (me, master, nthrds, im, idate, & - fhour, iflip, jindx1_aer, jindx2_aer, & - ddy_aer, iindx1_aer, & - iindx2_aer, ddx_aer, & - levs, prsl, aer_nm) + if (iaermdl==1) then + call aerinterpol (me, master, nthrds, im, idate, & + fhour, iflip, jindx1_aer, jindx2_aer, & + ddy_aer, iindx1_aer, & + iindx2_aer, ddx_aer, & + levs, prsl, aer_nm, errmsg, errflg) + else if (iaermdl==6) then + call aerinterpol_dl (me, master, nthrds, im, idate, & + fhour, iflip, jindx1_aer, jindx2_aer, & + ddy_aer, iindx1_aer, & + iindx2_aer, ddx_aer, & + levs, prsl, aer_nm, errmsg, errflg) + endif + if(errflg /= 0) return endif - -! Not needed for SCM: -!> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs - ! if (nscyc > 0) then - ! if (mod(kdt,nscyc) == 1) THEN - ! call gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, & - ! input_nml_file, lsoil, lsoil_lsm, kice, idate, ialb, isot, ivegsrc, & - ! use_ufo, nst_anl, fhcyc, phour, landfrac, lakefrac, min_seaice, min_lakeice,& - ! frac_grid, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, tsfc, & - ! tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, & - ! zorli, zorll, zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, & - ! stype, shdmin, shdmax, snowd, cv, cvb, cvt, oro, oro_uf, & - ! xlat_d, xlon_d, slmsk, imap, jmap) - ! endif - ! endif + contains + !> Find the time indexes on either side of current time + subroutine find_photochem_time_index(ntime, time, rjday, n1, n2) + implicit none + !> The number of times provided in the parameter file + integer, intent(in) :: ntime + !> The indexes of the parameters just before and after the + !! current time + integer, intent(out) :: n1, n2 + !> The times provided in the parameter file + real, intent(in), dimension(ntime+1) :: time + !> The current time of year + real, intent(in) :: rjday + n2 = ntime + 1 + do j=2,ntime + if (rjday < time(j)) then + n2 = j + exit + endif + enddo + n1 = n2 - 1 + if (n2 > ntime) n2 = n2 - ntime + end subroutine find_photochem_time_index end subroutine GFS_phys_time_vary_timestep_init -!! @} - -!> \section arg_table_GFS_phys_time_vary_timestep_finalize Argument Table -!! \htmlinclude GFS_phys_time_vary_timestep_finalize.html -!! -!>\section gen_GFS_phys_time_vary_timestep_finalize GFS_phys_time_vary_timestep_finalize General Algorithm -!! @{ - subroutine GFS_phys_time_vary_timestep_finalize (errmsg, errflg) - - implicit none - - ! Interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - end subroutine GFS_phys_time_vary_timestep_finalize -!! @} +!> @} !> \section arg_table_GFS_phys_time_vary_finalize Argument Table !! \htmlinclude GFS_phys_time_vary_finalize.html !! - subroutine GFS_phys_time_vary_finalize(errmsg, errflg) + subroutine GFS_phys_time_vary_finalize(is_initialized, errmsg, errflg) implicit none ! Interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + logical, intent(inout) :: is_initialized + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! Initialize CCPP error handling variables errmsg = '' @@ -859,12 +865,6 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (.not.is_initialized) return - ! Deallocate h2o arrays - if (allocated(h2o_lat) ) deallocate(h2o_lat) - if (allocated(h2o_pres)) deallocate(h2o_pres) - if (allocated(h2o_time)) deallocate(h2o_time) - if (allocated(h2oplin) ) deallocate(h2oplin) - ! Deallocate aerosol arrays if (allocated(aerin) ) deallocate(aerin) if (allocated(aer_pres)) deallocate(aer_pres) @@ -884,4 +884,3 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) end subroutine GFS_phys_time_vary_finalize end module GFS_phys_time_vary -!> @} diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta index a9094a075..e86858a3f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_phys_time_vary.scm.meta @@ -1,14 +1,13 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F dependencies = Interstitials/UFS_SCM_NEPTUNE/iccn_def.F,Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 dependencies = Interstitials/UFS_SCM_NEPTUNE/sfcsub.F,Radiation/mersenne_twister.f dependencies = MP/Morrison_Gettelman/aerclm_def.F,MP/Morrison_Gettelman/aerinterp.F90 dependencies = SFC_Models/Land/Noah/namelist_soilveg.f,SFC_Models/Land/Noah/set_soilveg.f,SFC_Models/Land/Noahmp/noahmp_tables.f90 - dependencies = photochem/module_ozphys.F90 - dependencies = photochem/h2o_def.f,photochem/h2ointerp.f90 + dependencies = photochem/module_ozphys.F90,photochem/module_h2ophys.F90 dependencies = GWD/cires_tauamf_data.F90 ######################################################################## @@ -51,6 +50,13 @@ dimensions = () type = logical intent = in +[iaermdl] + standard_name = control_for_aerosol_radiation_scheme + long_name = control of aerosol scheme in radiation + units = 1 + dimensions = () + type = integer + intent = in [iccn] standard_name = control_for_ice_cloud_condensation_nuclei_forcing long_name = flag for IN and CCN forcing for morrison gettelman microphysics @@ -72,6 +78,13 @@ dimensions = () type = integer intent = in +[levs] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in [nx] standard_name = number_of_points_in_x_direction_for_this_MPI_rank long_name = number of points in x direction for this MPI rank @@ -116,6 +129,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_o3] standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation long_name = interpolation high index for ozone @@ -123,6 +137,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_o3] standard_name = latitude_interpolation_weight_for_ozone_forcing long_name = interpolation high index for ozone @@ -131,6 +146,7 @@ type = real kind = kind_phys intent = inout + optional = True [jindx1_h] standard_name = lower_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation low index for stratospheric water vapor @@ -138,6 +154,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_h] standard_name = upper_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation high index for stratospheric water vapor @@ -145,6 +162,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_h] standard_name = latitude_interpolation_weight_for_stratospheric_water_vapor_forcing long_name = interpolation high index for stratospheric water vapor @@ -153,6 +171,7 @@ type = real kind = kind_phys intent = inout + optional = True [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data @@ -176,6 +195,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_aer] standard_name = upper_latitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the y direction @@ -183,6 +203,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_aer] standard_name = latitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the y direction @@ -191,6 +212,7 @@ type = real kind = kind_phys intent = inout + optional = True [iindx1_aer] standard_name = lower_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation low index for prescribed aerosols in the x direction @@ -198,6 +220,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [iindx2_aer] standard_name = upper_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the x direction @@ -205,6 +228,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddx_aer] standard_name = longitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the x direction @@ -213,6 +237,7 @@ type = real kind = kind_phys intent = inout + optional = True [aer_nm] standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 long_name = mass mixing ratio of aerosol from gocart or merra2 @@ -220,7 +245,7 @@ dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_aerosol_tracers_MG) type = real kind = kind_phys - intent = in + intent = out [jindx1_ci] standard_name = lower_latitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation low index for ice and cloud condensation nuclei in the y direction @@ -228,6 +253,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_ci] standard_name = upper_latitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -235,6 +261,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_ci] standard_name = latitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -243,6 +270,7 @@ type = real kind = kind_phys intent = inout + optional = True [iindx1_ci] standard_name = lower_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation low index for ice and cloud condensation nuclei in the x direction @@ -250,6 +278,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [iindx2_ci] standard_name = upper_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -257,6 +286,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddx_ci] standard_name = longitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -265,6 +295,7 @@ type = real kind = kind_phys intent = inout + optional = True [imap] standard_name = map_of_block_column_number_to_global_i_index long_name = map of local index ix to global index i for this block @@ -293,6 +324,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [jindx2_tau] standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs @@ -300,6 +332,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [ddy_j1tau] standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs @@ -308,6 +341,7 @@ type = real intent = inout kind = kind_phys + optional = True [ddy_j2tau] standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs @@ -316,6 +350,7 @@ type = real intent = inout kind = kind_phys + optional = True [isot] standard_name = control_for_soil_type_dataset long_name = soil type dataset choice @@ -458,6 +493,7 @@ type = real kind = kind_phys intent = inout + optional = True [tgxy] standard_name = ground_temperature long_name = ground temperature for noahmp @@ -466,6 +502,7 @@ type = real kind = kind_phys intent = inout + optional = True [tahxy] standard_name = air_temperature_in_canopy long_name = canopy air temperature @@ -474,6 +511,7 @@ type = real kind = kind_phys intent = inout + optional = True [canicexy] standard_name = canopy_intercepted_ice_mass long_name = canopy intercepted ice mass @@ -482,6 +520,7 @@ type = real kind = kind_phys intent = inout + optional = True [canliqxy] standard_name = canopy_intercepted_liquid_water long_name = canopy intercepted liquid water @@ -490,6 +529,7 @@ type = real kind = kind_phys intent = inout + optional = True [eahxy] standard_name = air_vapor_pressure_in_canopy long_name = canopy air vapor pressure @@ -498,6 +538,7 @@ type = real kind = kind_phys intent = inout + optional = True [cmxy] standard_name = surface_drag_coefficient_for_momentum_for_noahmp long_name = surface drag coefficient for momentum for noahmp @@ -506,6 +547,7 @@ type = real kind = kind_phys intent = inout + optional = True [chxy] standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp long_name = surface exchange coeff heat & moisture for noahmp @@ -514,6 +556,7 @@ type = real kind = kind_phys intent = inout + optional = True [fwetxy] standard_name = wet_canopy_area_fraction long_name = area fraction of canopy that is wetted/snowed @@ -522,6 +565,7 @@ type = real kind = kind_phys intent = inout + optional = True [sneqvoxy] standard_name = lwe_thickness_of_snowfall_amount_on_previous_timestep long_name = snow mass at previous time step @@ -530,6 +574,7 @@ type = real kind = kind_phys intent = inout + optional = True [alboldxy] standard_name = surface_albedo_assuming_deep_snow_on_previous_timestep long_name = snow albedo at previous time step @@ -538,6 +583,7 @@ type = real kind = kind_phys intent = inout + optional = True [qsnowxy] standard_name = lwe_snowfall_rate long_name = snow precipitation rate at surface @@ -546,6 +592,7 @@ type = real kind = kind_phys intent = inout + optional = True [wslakexy] standard_name = water_storage_in_lake long_name = lake water storage @@ -554,6 +601,7 @@ type = real kind = kind_phys intent = inout + optional = True [taussxy] standard_name = dimensionless_age_of_surface_snow long_name = non-dimensional snow age @@ -562,6 +610,7 @@ type = real kind = kind_phys intent = inout + optional = True [waxy] standard_name = water_storage_in_aquifer long_name = water storage in aquifer @@ -570,6 +619,7 @@ type = real kind = kind_phys intent = inout + optional = True [wtxy] standard_name = water_storage_in_aquifer_and_saturated_soil long_name = water storage in aquifer and saturated soil @@ -578,6 +628,7 @@ type = real kind = kind_phys intent = inout + optional = True [zwtxy] standard_name = water_table_depth long_name = water table depth @@ -586,6 +637,7 @@ type = real kind = kind_phys intent = inout + optional = True [xlaixy] standard_name = leaf_area_index long_name = leaf area index @@ -594,6 +646,7 @@ type = real kind = kind_phys intent = inout + optional = True [xsaixy] standard_name = stem_area_index long_name = stem area index @@ -602,6 +655,7 @@ type = real kind = kind_phys intent = inout + optional = True [lfmassxy] standard_name = leaf_mass_content long_name = leaf mass @@ -610,6 +664,7 @@ type = real kind = kind_phys intent = inout + optional = True [stmassxy] standard_name = stem_mass_content long_name = stem mass @@ -618,6 +673,7 @@ type = real kind = kind_phys intent = inout + optional = True [rtmassxy] standard_name = fine_root_mass_content long_name = fine root mass @@ -626,6 +682,7 @@ type = real kind = kind_phys intent = inout + optional = True [woodxy] standard_name = wood_mass_content long_name = wood mass including woody roots @@ -634,6 +691,7 @@ type = real kind = kind_phys intent = inout + optional = True [stblcpxy] standard_name = slow_soil_pool_mass_content_of_carbon long_name = stable carbon in deep soil @@ -642,6 +700,7 @@ type = real kind = kind_phys intent = inout + optional = True [fastcpxy] standard_name = fast_soil_pool_mass_content_of_carbon long_name = short-lived carbon in shallow soil @@ -650,6 +709,7 @@ type = real kind = kind_phys intent = inout + optional = True [smcwtdxy] standard_name = volumetric_soil_moisture_between_soil_bottom_and_water_table long_name = soil water content between the bottom of the soil and the water table @@ -658,6 +718,7 @@ type = real kind = kind_phys intent = inout + optional = True [deeprechxy] standard_name = water_table_recharge_assuming_deep long_name = recharge to or from the water table when deep @@ -666,6 +727,7 @@ type = real kind = kind_phys intent = inout + optional = True [rechxy] standard_name = water_table_recharge_assuming_shallow long_name = recharge to or from the water table when shallow @@ -674,6 +736,7 @@ type = real kind = kind_phys intent = inout + optional = True [albdvis_lnd] standard_name = surface_albedo_direct_visible_over_land long_name = direct surface albedo visible band over land @@ -714,6 +777,7 @@ type = real kind = kind_phys intent = inout + optional = True [albdnir_ice] standard_name = surface_albedo_direct_NIR_over_ice long_name = direct surface albedo NIR band over ice @@ -722,6 +786,7 @@ type = real kind = kind_phys intent = inout + optional = True [albivis_ice] standard_name = surface_albedo_diffuse_visible_over_ice long_name = diffuse surface albedo visible band over ice @@ -730,6 +795,7 @@ type = real kind = kind_phys intent = inout + optional = True [albinir_ice] standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice @@ -738,6 +804,7 @@ type = real kind = kind_phys intent = inout + optional = True [emiss_lnd] standard_name = surface_longwave_emissivity_over_land long_name = surface lw emissivity in fraction over land @@ -762,6 +829,7 @@ type = real kind = kind_phys intent = inout + optional = True [snicexy] standard_name = lwe_thickness_of_ice_in_surface_snow long_name = snow layer ice @@ -770,6 +838,7 @@ type = real kind = kind_phys intent = inout + optional = True [snliqxy] standard_name = lwe_thickness_of_liquid_water_in_surface_snow long_name = snow layer liquid water @@ -778,6 +847,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsnoxy] standard_name = temperature_in_surface_snow long_name = temperature_in_surface_snow @@ -786,6 +856,7 @@ type = real kind = kind_phys intent = inout + optional = True [smoiseq] standard_name = volumetric_equilibrium_soil_moisture long_name = equilibrium soil water content @@ -794,6 +865,7 @@ type = real kind = kind_phys intent = inout + optional = True [zsnsoxy] standard_name = depth_from_snow_surface_at_bottom_interface long_name = depth from the top of the snow surface at the bottom of the layer @@ -802,6 +874,7 @@ type = real kind = kind_phys intent = inout + optional = True [slc] standard_name = volume_fraction_of_unfrozen_water_in_soil long_name = liquid soil moisture @@ -887,6 +960,94 @@ dimensions = () type = integer intent = in +[lkm] + standard_name = control_for_lake_model_execution_method + long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst + units = flag + dimensions = () + type = integer + intent = in +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[lakedepth] + standard_name = lake_depth + long_name = lake depth + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_flake] + standard_name = flake_model_control_selection_value + long_name = value that indicates flake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[lakefrac_threshold] + standard_name = lakefrac_threshold_for_enabling_lake_model + long_name = fraction of horizontal grid area occupied by lake must be greater than this value to enable a lake model + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in +[lakedepth_threshold] + standard_name = lake_depth_threshold_for_enabling_lake_model + long_name = lake depth must be greater than this value to enable a lake model + units = m + dimensions = () + type = real + kind = kind_phys + intent = in +[ozphys] + standard_name = dataset_for_ozone_physics + long_name = dataset for NRL ozone physics + units = mixed + dimensions = () + type = ty_ozphys + intent = in +[h2ophys] + standard_name = dataset_for_h2o_photochemistry_physics + long_name = dataset for NRL h2o photochemistry physics + units = mixed + dimensions = () + type = ty_h2ophys + intent = in +[is_initialized] + standard_name = flag_for_gfs_phys_time_vary_interstitial_initialization + long_name = flag carrying interstitial initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -907,6 +1068,13 @@ [ccpp-arg-table] name = GFS_phys_time_vary_finalize type = scheme +[is_initialized] + standard_name = flag_for_gfs_phys_time_vary_interstitial_initialization + long_name = flag carrying interstitial initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1076,6 +1244,13 @@ dimensions = () type = logical intent = in +[iaermdl] + standard_name = control_for_aerosol_radiation_scheme + long_name = control of aerosol scheme in radiation + units = 1 + dimensions = () + type = integer + intent = in [iccn] standard_name = control_for_ice_cloud_condensation_nuclei_forcing long_name = flag for IN and CCN forcing for morrison gettelman microphysics @@ -1098,6 +1273,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_o3] standard_name = upper_latitude_index_of_ozone_forcing_for_interpolation long_name = interpolation high index for ozone @@ -1105,6 +1281,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_o3] standard_name = latitude_interpolation_weight_for_ozone_forcing long_name = interpolation high index for ozone @@ -1113,6 +1290,7 @@ type = real kind = kind_phys intent = in + optional = True [ozpl] standard_name = ozone_forcing long_name = ozone forcing data @@ -1128,6 +1306,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_h] standard_name = upper_latitude_index_of_stratospheric_water_vapor_forcing_for_interpolation long_name = interpolation high index for stratospheric water vapor @@ -1135,6 +1314,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_h] standard_name = latitude_interpolation_weight_for_stratospheric_water_vapor_forcing long_name = interpolation high index for stratospheric water vapor @@ -1143,6 +1323,7 @@ type = real kind = kind_phys intent = in + optional = True [h2opl] standard_name = stratospheric_water_vapor_forcing long_name = water forcing data @@ -1165,6 +1346,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_aer] standard_name = upper_latitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the y direction @@ -1172,6 +1354,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_aer] standard_name = latitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the y direction @@ -1180,6 +1363,7 @@ type = real kind = kind_phys intent = in + optional = True [iindx1_aer] standard_name = lower_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation low index for prescribed aerosols in the x direction @@ -1187,6 +1371,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [iindx2_aer] standard_name = upper_longitude_index_of_aerosol_forcing_for_interpolation long_name = interpolation high index for prescribed aerosols in the x direction @@ -1194,6 +1379,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddx_aer] standard_name = longitude_interpolation_weight_for_aerosol_forcing long_name = interpolation high index for prescribed aerosols in the x direction @@ -1202,6 +1388,7 @@ type = real kind = kind_phys intent = in + optional = True [aer_nm] standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 long_name = mass mixing ratio of aerosol from gocart or merra2 @@ -1217,6 +1404,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_ci] standard_name = upper_latitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -1224,6 +1412,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_ci] standard_name = latitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the y direction @@ -1232,6 +1421,7 @@ type = real kind = kind_phys intent = in + optional = True [iindx1_ci] standard_name = lower_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation low index for ice and cloud condensation nuclei in the x direction @@ -1239,6 +1429,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [iindx2_ci] standard_name = upper_longitude_index_of_cloud_nuclei_forcing_for_interpolation long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -1246,6 +1437,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddx_ci] standard_name = longitude_interpolation_weight_for_cloud_nuclei_forcing long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -1254,6 +1446,7 @@ type = real kind = kind_phys intent = in + optional = True [in_nm] standard_name = ice_nucleation_number_from_climatology long_name = ice nucleation number in MG MP @@ -1307,6 +1500,13 @@ type = real kind = kind_phys intent = inout +[nthrds] + standard_name = number_of_openmp_threads + long_name = number of OpenMP threads available for physics schemes + units = count + dimensions = () + type = integer + intent = in [do_ugwp_v1] standard_name = flag_for_ugwp_version_1 long_name = flag to activate ver 1 CIRES UGWP @@ -1321,6 +1521,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [jindx2_tau] standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs @@ -1328,6 +1529,7 @@ dimensions = (horizontal_dimension) type = integer intent = in + optional = True [ddy_j1tau] standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs @@ -1336,6 +1538,7 @@ type = real intent = in kind = kind_phys + optional = True [ddy_j2tau] standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs @@ -1344,6 +1547,7 @@ type = real intent = in kind = kind_phys + optional = True [tau_amf] standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux @@ -1359,33 +1563,20 @@ dimensions = () type = ty_ozphys intent = in -[nthrds] - standard_name = number_of_openmp_threads - long_name = number of OpenMP threads available for physics schemes - units = count +[h2ophys] + standard_name = dataset_for_h2o_photochemistry_physics + long_name = dataset for NRL h2o photochemistry physics + units = mixed dimensions = () - type = integer + type = ty_h2ophys intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 +[is_initialized] + standard_name = flag_for_gfs_phys_time_vary_interstitial_initialization + long_name = flag carrying interstitial initialization status + units = flag dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = GFS_phys_time_vary_timestep_finalize - type = scheme + type = logical + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.F90 index fe5409353..7bb3c7e6d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.F90 @@ -1,4 +1,3 @@ -! ########################################################################################### !> \file GFS_physics_post.F90 !! !! This module contains GFS specific calculations (e.g. diagnostics) and suite specific @@ -13,52 +12,53 @@ module GFS_physics_post public GFS_physics_post_run contains -! ########################################################################################### -! SUBROUTINE GFS_physics_post_run -! ########################################################################################### -!! \section arg_table_GFS_physics_post_run Argument Table +!> \section arg_table_GFS_physics_post_run Argument Table !! \htmlinclude GFS_physics_post_run.html !! subroutine GFS_physics_post_run(nCol, nLev, ntoz, ntracp100, nprocess, nprocess_summed, & dtidx, is_photochem, ldiag3d, ip_physics, ip_photochem, ip_prod_loss, ip_ozmix, & ip_temp, ip_overhead_ozone, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, & + ntqv, dqv_dt_prd, dqv_dt_qvmx, & dtend, errmsg, errflg) ! Inputs integer, intent(in) :: & - nCol, & ! Horizontal dimension - nLev, & ! Number of vertical layers - ntoz, & ! Index for ozone mixing ratio - ntracp100, & ! Number of tracers plus 100 - nprocess, & ! Number of processes that cause changes in state variables - nprocess_summed,& ! Number of causes in dtidx per tracer summed for total physics tendency - ip_physics, & ! Index for process in diagnostic tendency output - ip_photochem, & ! Index for process in diagnostic tendency output - ip_prod_loss, & ! Index for process in diagnostic tendency output - ip_ozmix, & ! Index for process in diagnostic tendency output - ip_temp, & ! Index for process in diagnostic tendency output - ip_overhead_ozone ! Index for process in diagnostic tendency output + nCol, & !< Horizontal dimension + nLev, & !< Number of vertical layers + ntoz, & !< Index for ozone mixing ratio + ntqv, & !< Index for water vapor mixing ratio + ntracp100, & !< Number of tracers plus 100 + nprocess, & !< Number of processes that cause changes in state variables + nprocess_summed,& !< Number of causes in dtidx per tracer summed for total physics tendency + ip_physics, & !< Index for process in diagnostic tendency output + ip_photochem, & !< Index for process in diagnostic tendency output + ip_prod_loss, & !< Index for process in diagnostic tendency output + ip_ozmix, & !< Index for process in diagnostic tendency output + ip_temp, & !< Index for process in diagnostic tendency output + ip_overhead_ozone !< Index for process in diagnostic tendency output integer, intent(in), dimension(:,:) :: & - dtidx ! Bookkeeping indices for GFS diagnostic tendencies + dtidx !< Bookkeeping indices for GFS diagnostic tendencies logical, intent(in) :: & - ldiag3d ! Flag for 3d diagnostic fields + ldiag3d !< Flag for 3d diagnostic fields logical, intent(in), dimension(:) :: & - is_photochem ! Flags for photochemistry processes to sum + is_photochem !< Flags for photochemistry processes to sum ! Inputs (optional) real(kind=kind_phys), intent(in), dimension(:,:), pointer, optional :: & - do3_dt_prd, & ! Physics tendency: production and loss effect - do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect - do3_dt_temp, & ! Physics tendency: temperature effect - do3_dt_ohoz ! Physics tendency: overhead ozone effect + do3_dt_prd, & !< Physics tendency: production and loss effect + do3_dt_ozmx, & !< Physics tendency: ozone mixing ratio effect + do3_dt_temp, & !< Physics tendency: temperature effect + do3_dt_ohoz, & !< Physics tendency: overhead ozone effect + dqv_dt_prd, & !< Physics tendency: climatological net production effect + dqv_dt_qvmx !< Physics tendency: water vapor mixing ratio effect ! Outputs - real(kind=kind_phys), intent(inout), dimension(:,:,:) :: & - dtend ! Diagnostic tendencies for state variables + real(kind=kind_phys), intent(inout), dimension(:,:,:), optional :: & + dtend !< Diagnostic tendencies for state variables character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg !< CCPP error message integer, intent(out) :: & - errflg ! CCPP error flag + errflg !< CCPP error flag ! Locals integer :: idtend, ichem, iphys, itrac @@ -108,6 +108,32 @@ subroutine GFS_physics_post_run(nCol, nLev, ntoz, ntracp100, nprocess, nprocess_ call sum_it(ichem, itrac, is_photochem) endif + ! ####################################################################################### + ! + ! Water vapor photochemistry diagnostics + ! + ! ####################################################################################### + idtend = dtidx(100+ntqv, ip_prod_loss) + if (idtend >= 1 .and. associated(dqv_dt_prd)) then + dtend(:, :, idtend) = dtend(:, :, idtend) + dqv_dt_prd + endif + ! + idtend = dtidx(100+ntqv,ip_ozmix) + if (idtend >= 1 .and. associated(dqv_dt_qvmx)) then + dtend(:, :, idtend) = dtend(:, :, idtend) + dqv_dt_qvmx + endif + + ! ####################################################################################### + ! + ! Total photochemical tendencies + ! + ! ####################################################################################### + itrac = ntqv + 100 + ichem = dtidx(itrac, ip_photochem) + if (ichem >= 1) then + call sum_it(ichem, itrac, is_photochem) + endif + ! ####################################################################################### ! ! Total (physics) tendencies @@ -123,6 +149,7 @@ subroutine GFS_physics_post_run(nCol, nLev, ntoz, ntracp100, nprocess, nprocess_ contains +!> subroutine sum_it(isum,itrac,sum_me) integer, intent(in) :: isum ! third index of dtend of summary process integer, intent(in) :: itrac ! tracer or state variable being summed diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta index 758b9d8b8..823870a0e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_physics_post.meta @@ -29,6 +29,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -128,6 +129,7 @@ type = real kind = kind_phys intent = in + optional = True [do3_dt_ozmx] standard_name = ozone_tendency_due_to_ozone_mixing_ratio long_name = ozone tendency due to ozone mixing ratio @@ -136,6 +138,7 @@ type = real kind = kind_phys intent = in + optional = True [do3_dt_temp] standard_name = ozone_tendency_due_to_temperature long_name = ozone tendency due to temperature @@ -144,6 +147,7 @@ type = real kind = kind_phys intent = in + optional = True [do3_dt_ohoz] standard_name = ozone_tendency_due_to_overhead_ozone_column long_name = ozone tendency due to overhead ozone column @@ -152,6 +156,32 @@ type = real kind = kind_phys intent = in + optional = True +[ntqv] + standard_name = index_of_specific_humidity_in_tracer_concentration_array + long_name = tracer index for water_vapor mixing ratio + units = index + dimensions = () + type = integer + intent = in +[dqv_dt_prd] + standard_name = water_vapor_tendency_due_to_production_and_loss_rate + long_name = water_vapor tendency due to production and loss rate + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[dqv_dt_qvmx] + standard_name = water_vapor_tendency_due_to_water_vapor_mixing_ratio + long_name = water_vapor tendency due to water_vapor mixing ratio + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90 index 978dc177f..cbd660414 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.F90 @@ -10,9 +10,8 @@ module GFS_rad_time_vary contains -!>\defgroup mod_GFS_rad_time_vary GFS Radiation Time Update -!! This module contains code related to GFS radiation setup. -!> @{ +!> This module contains code related to GFS radiation setup. + !> \section arg_table_GFS_rad_time_vary_timestep_init Argument Table !! \htmlinclude GFS_rad_time_vary_timestep_init.html !! @@ -30,19 +29,19 @@ subroutine GFS_rad_time_vary_timestep_init (lrseeds, rseeds, ! Interface variables logical, intent(in) :: lrseeds - integer, intent(in) :: rseeds(:,:) + integer, intent(in), optional :: rseeds(:,:) integer, intent(in) :: isubc_lw, isubc_sw, cnx, cny, isc, jsc, kdt integer, intent(in) :: imp_physics, imp_physics_zhao_carr, ipsd0, ipsdlim logical, intent(in) :: lslwr, lsswr - integer, intent(inout) :: icsdsw(:), icsdlw(:) + integer, intent(inout), optional :: icsdsw(:), icsdlw(:) integer, intent(in) :: imap(:), jmap(:) real(kind_phys), intent(in) :: sec - real(kind_phys), intent(inout) :: ps_2delt(:) - real(kind_phys), intent(inout) :: ps_1delt(:) - real(kind_phys), intent(inout) :: t_2delt(:,:) - real(kind_phys), intent(inout) :: t_1delt(:,:) - real(kind_phys), intent(inout) :: qv_2delt(:,:) - real(kind_phys), intent(inout) :: qv_1delt(:,:) + real(kind_phys), intent(inout), optional :: ps_2delt(:) + real(kind_phys), intent(inout), optional :: ps_1delt(:) + real(kind_phys), intent(inout), optional :: t_2delt(:,:) + real(kind_phys), intent(inout), optional :: t_1delt(:,:) + real(kind_phys), intent(inout), optional :: qv_2delt(:,:) + real(kind_phys), intent(inout), optional:: qv_1delt(:,:) real(kind_phys), intent(in) :: t(:,:), qv(:,:), ps(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -97,6 +96,5 @@ subroutine GFS_rad_time_vary_timestep_init (lrseeds, rseeds, endif end subroutine GFS_rad_time_vary_timestep_init -!> @} end module GFS_rad_time_vary diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta index 0759b7e2a..a7ac1381c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.fv3.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rad_time_vary type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F,Radiation/mersenne_twister.f,Radiation/RRTMG/radcons.f90 ######################################################################## @@ -22,6 +22,7 @@ dimensions = (horizontal_dimension, number_of_host_provided_random_number_streams) type = integer intent = in + optional = True [lslwr] standard_name = flag_for_calling_longwave_radiation long_name = logical flags for lw radiation calls @@ -57,6 +58,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [icsdlw] standard_name = random_number_seed_for_mcica_longwave long_name = random seeds for sub-column cloud generators lw @@ -64,6 +66,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [cnx] standard_name = number_of_x_points_for_current_cubed_sphere_tile long_name = number of points in x direction for this cubed sphere face @@ -137,14 +140,14 @@ intent = in [ipsd0] standard_name = initial_seed_for_mcica - long_name = initial permutaion seed for mcica radiation + long_name = initial permutation seed for mcica radiation units = 1 dimensions = () type = integer intent = in [ipsdlim] standard_name = limit_for_initial_seed_for_mcica - long_name = limit for initial permutaion seed for mcica radiation + long_name = limit for initial permutation seed for mcica radiation units = 1 dimensions = () type = integer @@ -157,6 +160,7 @@ type = real kind = kind_phys intent = inout + optional = True [ps_1delt] standard_name = surface_air_pressure_on_previous_timestep long_name = surface air pressure at previous timestep @@ -165,6 +169,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_2delt] standard_name = air_temperature_two_timesteps_back long_name = air temperature two timesteps back @@ -173,6 +178,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_1delt] standard_name = air_temperature_on_previous_timestep_in_xyz_dimensioned_restart_array long_name = air temperature at previous timestep @@ -181,6 +187,7 @@ type = real kind = kind_phys intent = inout + optional = True [qv_2delt] standard_name = specific_humidity_two_timesteps_back long_name = water vapor specific humidity two timesteps back @@ -189,6 +196,7 @@ type = real kind = kind_phys intent = inout + optional = True [qv_1delt] standard_name = specific_humidity_on_previous_timestep_in_xyz_dimensioned_restart_array long_name = water vapor specific humidity at previous timestep @@ -197,6 +205,7 @@ type = real kind = kind_phys intent = inout + optional = True [t] standard_name = air_temperature long_name = model layer mean temperature diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.mpas.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.mpas.F90 new file mode 100644 index 000000000..815d629b5 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.mpas.F90 @@ -0,0 +1,72 @@ +!>\file GFS_rad_time_vary.mpas.F90 +!! Contains code related to GFS radiation suite setup (radiation part of time_vary_step) +module GFS_rad_time_vary + implicit none + + private + + public GFS_rad_time_vary_timestep_init + +contains + +!> This module contains code related to GFS radiation setup. + +!> \section arg_table_GFS_rad_time_vary_timestep_init Argument Table +!! \htmlinclude GFS_rad_time_vary_timestep_init.html +!! + subroutine GFS_rad_time_vary_timestep_init (lrseeds, rseeds, lslwr, lsswr, isubc_lw, & + isubc_sw, icsdsw, icsdlw, sec, kdt, ipsd0, ipsdlim, errmsg, errflg) + use mersenne_twister, only: random_setseed, random_index, random_stat + use machine, only: kind_phys + use radcons, only: con_100 + implicit none + + ! Interface variables + logical, intent(in) :: lrseeds + integer, intent(in), optional :: rseeds(:,:) + integer, intent(in) :: isubc_lw, isubc_sw, kdt + integer, intent(in) :: ipsd0, ipsdlim + logical, intent(in) :: lslwr, lsswr + integer, intent(inout), optional :: icsdsw(:), icsdlw(:) + real(kind_phys), intent(in) :: sec + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + type (random_stat) :: stat + integer :: ix, j, i, ipseed, ixx + integer, allocatable, dimension(:) :: numrdm + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (lsswr .or. lslwr) then + !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) + if ((isubc_lw==2) .or. (isubc_sw==2)) then + !NRL If random seeds supplied by NEPTUNE + if(lrseeds) then + do ix=1,size(icsdsw) + icsdsw(ix) = rseeds(ix,1) + icsdlw(ix) = rseeds(ix,2) + enddo + else + allocate(numrdm(size(icsdlw)*2)) + ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 + call random_setseed (ipseed, stat) + call random_index (ipsdlim, numrdm, stat) + + ixx = 1 + do ix=1,size(icsdsw)*2,2 + icsdsw(ixx) = numrdm(ix) + icsdlw(ixx) = numrdm(ix+1) + ixx = ixx + 1 + enddo + deallocate(numrdm) + end if ! lrseeds + endif ! isubc_lw and isubc_sw + endif ! lsswr or lslwr + + end subroutine GFS_rad_time_vary_timestep_init + +end module GFS_rad_time_vary diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.mpas.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.mpas.meta new file mode 100644 index 000000000..1166af29d --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.mpas.meta @@ -0,0 +1,114 @@ +[ccpp-table-properties] + name = GFS_rad_time_vary + type = scheme + dependencies_path = ../../ + dependencies = hooks/machine.F,Radiation/mersenne_twister.f,Radiation/RRTMG/radcons.f90 + +######################################################################## +[ccpp-arg-table] + name = GFS_rad_time_vary_timestep_init + type = scheme +[lrseeds] + standard_name = do_host_provided_random_seeds + long_name = flag to use host-provided random seeds + units = flag + dimensions = () + type = logical + intent = in +[rseeds] + standard_name = random_number_seeds_from_host + long_name = random number seeds from host + units = none + dimensions = (horizontal_dimension, number_of_host_provided_random_number_streams) + type = integer + intent = in + optional = True +[lslwr] + standard_name = flag_for_calling_longwave_radiation + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in +[lsswr] + standard_name = flag_for_calling_shortwave_radiation + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in +[isubc_lw] + standard_name = flag_for_lw_clouds_sub_grid_approximation + long_name = flag for lw clouds sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in +[isubc_sw] + standard_name = flag_for_sw_clouds_grid_approximation + long_name = flag for sw clouds sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in +[icsdsw] + standard_name = random_number_seed_for_mcica_shortwave + long_name = random seeds for sub-column cloud generators sw + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[icsdlw] + standard_name = random_number_seed_for_mcica_longwave + long_name = random seeds for sub-column cloud generators lw + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = True +[sec] + standard_name = forecast_time_in_seconds + long_name = seconds elapsed since model initialization + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[ipsd0] + standard_name = initial_seed_for_mcica + long_name = initial permutaion seed for mcica radiation + units = 1 + dimensions = () + type = integer + intent = in +[ipsdlim] + standard_name = limit_for_initial_seed_for_mcica + long_name = limit for initial permutaion seed for mcica radiation + units = 1 + dimensions = () + type = integer + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.F90 index 3f730eaf5..46585c9da 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.F90 @@ -10,9 +10,8 @@ module GFS_rad_time_vary contains -!>\defgroup mod_GFS_rad_time_vary GFS Radiation Time Update -!! This module contains code related to GFS radiation setup. -!> @{ +!> This module contains code related to GFS radiation setup. + !> \section arg_table_GFS_rad_time_vary_timestep_init Argument Table !! \htmlinclude GFS_rad_time_vary_timestep_init.html !! @@ -97,6 +96,5 @@ subroutine GFS_rad_time_vary_timestep_init (lrseeds, rseeds, endif end subroutine GFS_rad_time_vary_timestep_init -!> @} end module GFS_rad_time_vary diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta index 0759b7e2a..a7ac1381c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rad_time_vary.scm.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rad_time_vary type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F,Radiation/mersenne_twister.f,Radiation/RRTMG/radcons.f90 ######################################################################## @@ -22,6 +22,7 @@ dimensions = (horizontal_dimension, number_of_host_provided_random_number_streams) type = integer intent = in + optional = True [lslwr] standard_name = flag_for_calling_longwave_radiation long_name = logical flags for lw radiation calls @@ -57,6 +58,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [icsdlw] standard_name = random_number_seed_for_mcica_longwave long_name = random seeds for sub-column cloud generators lw @@ -64,6 +66,7 @@ dimensions = (horizontal_dimension) type = integer intent = inout + optional = True [cnx] standard_name = number_of_x_points_for_current_cubed_sphere_tile long_name = number of points in x direction for this cubed sphere face @@ -137,14 +140,14 @@ intent = in [ipsd0] standard_name = initial_seed_for_mcica - long_name = initial permutaion seed for mcica radiation + long_name = initial permutation seed for mcica radiation units = 1 dimensions = () type = integer intent = in [ipsdlim] standard_name = limit_for_initial_seed_for_mcica - long_name = limit for initial permutaion seed for mcica radiation + long_name = limit for initial permutation seed for mcica radiation units = 1 dimensions = () type = integer @@ -157,6 +160,7 @@ type = real kind = kind_phys intent = inout + optional = True [ps_1delt] standard_name = surface_air_pressure_on_previous_timestep long_name = surface air pressure at previous timestep @@ -165,6 +169,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_2delt] standard_name = air_temperature_two_timesteps_back long_name = air temperature two timesteps back @@ -173,6 +178,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_1delt] standard_name = air_temperature_on_previous_timestep_in_xyz_dimensioned_restart_array long_name = air temperature at previous timestep @@ -181,6 +187,7 @@ type = real kind = kind_phys intent = inout + optional = True [qv_2delt] standard_name = specific_humidity_two_timesteps_back long_name = water vapor specific humidity two timesteps back @@ -189,6 +196,7 @@ type = real kind = kind_phys intent = inout + optional = True [qv_1delt] standard_name = specific_humidity_on_previous_timestep_in_xyz_dimensioned_restart_array long_name = water vapor specific humidity at previous timestep @@ -197,6 +205,7 @@ type = real kind = kind_phys intent = inout + optional = True [t] standard_name = air_temperature long_name = model layer mean temperature diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.F90 new file mode 100644 index 000000000..1d6349571 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.F90 @@ -0,0 +1,477 @@ +! ############################################################################################# +!> \file GFS_radiation_post.F90 +!! +!! Radiation post-processing routine. +!! +!! This module has two purposes: +!! 1*) Perform coupling from the radiation scheme(s) to other physical parameterizations. +!! 2) Compute diagnostics +!! +!! *For RRTMG, this coupling is handled in the SCHEME. +!! *For RRTMGP, this coupling is handled HERE (more on this below). +!! +! ############################################################################################# +module GFS_radiation_post + use machine, only: kind_phys + use module_radlw_parameters, only: topflw_type, sfcflw_type + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, cmpfsw_type + use mo_heating_rates, only: compute_heating_rate + use radiation_tools, only: check_error_msg + use mo_rte_kind, only: rte_wp => wp + implicit none + + public GFS_radiation_post_run + +contains +! ############################################################################################# +!> \section arg_table_GFS_radiation_post_run Argument Table +!! \htmlinclude GFS_radiation_post_run.html +!! +!! This routine needs to be called AFTER the RRTMG (radlw_main.F90 and radsw_main.F90) +!! or the RRTMGP (rrtmgp_lw_main.F90 and rrtmgp_sw_main.F90) radiation schemes in the +!! CCPP enabled UFS. +!! +!! For RRTMG, not much is done here, since the scheme outputs the fields needed by the +!! UFS. For example, RRTMG provides the heating-rate profiles and has been modified to use +!! UFS native DDTs for storing the fluxes. +!! +!! For RRTMGP*: +!! - The all-sky radiation tendency is computed. The clear-sky tendency is computed, if +!! requested. +!! - Surface and TOA fluxes are copied to UFS native DDTs that persist between radiation/physics +!! calls. +!! +!! *Note on RTE-RRTMGP implementation in CCPP +!! This is done in an attempt to make the CCPP enabled RRTMGP LW/SW drivers more host agnostic. +!! The drivers are outputting the same fields as RTE, flux profiles, maintaining the same scheme +!! interface at the lowest CCPP entrypoint, the "Scheme-level" interstitial. Any host specific +!! coupling to the scheme happens here, a layer above, within the "Suite-level" interstitial. +!! +!! For ALL Radiaiton Schemes: +!! - Compute SW total cloud albedo +!! - Compute diagnostics +!! +! ############################################################################################# + + ! ########################################################################################### + ! GFS_radiation_post_run + ! ########################################################################################### + subroutine GFS_radiation_post_run(doLWrad, doSWrad, lssav, total_albedo, topfsw, fhlwr, fhswr,& + coszen, coszdg, raddt, aerodp, cldsa, mtopa, mbota, cldtausw, cldtaulw, p_lev, tgrs, kb, & + kd, kt, sfcflw, sfcfsw, topflw, scmpsw, nCol, nLev, lmk, nDay, nfxr, nspc1, fluxr, & + do_RRTMGP, do_lw_clrsky_hr, fluxlwUP_clrsky, fluxlwDOWN_clrsky, htrlwc, fluxlwUP_allsky, & + fluxlwDOWN_allsky, htrlw, do_sw_clrsky_hr, htrswc, fluxswUP_clrsky, idxday, & + fluxswDOWN_clrsky, htrsw, fluxswUP_allsky, fluxswDOWN_allsky, iSFC, iTOA, tsflw, tsfa, & + sfcdlw, sfculw, htrlwu, nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, & + visdfui, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfcnsw, & + sfcdsw, errmsg, errflg) + + ! Inputs + integer, intent(in) :: & + nCol, & !< Horizontal loop extent + nLev, & !< Number of vertical layers + lmk, & !< Number of vertical layers for radiation (adjusted) + nDay, & !< Number of daylit columns + nfxr, & !< Number of variables stored in the fluxr array + nspc1, & !< Number of species for output aerosol optical depth + kb, & !< Vertical index difference between layer and lower bound (H/M/L diag) + kd, & !< Vertical index difference between in/out and local (H/M/L diag) + kt, & !< Vertical index difference between layer and upper bound (H/M/L diag) + iSFC, & !< Vertical index for surface level + iTOA !< Vertical index for TOA level + integer, intent(in), dimension(:) :: & + idxday !< Index array for daytime points + logical, intent(in) :: & + doLWrad, & !< Logical flags for lw radiation calls + doSWrad, & !< Logical flags for sw radiation calls + lssav, & !< Flag for radiation diagnostics + do_RRTMGP, & !< Flag for using RRTMGP scheme + do_lw_clrsky_hr, & !< Output clear-sky LW heating-rate? + do_sw_clrsky_hr !< Output clear-sky SW heating-rate? + real(kind_phys), intent(in) :: & + fhlwr, & !< Frequency for longwave radiation (sec) + fhswr, & !< Frequency for shortwave radiation (sec) + raddt !< Radiation time step (sec) + real(kind_phys), dimension(:), intent(in) :: & + coszen, & !< Mean cos of zenith angle over rad call period + coszdg !< Daytime mean cosz over rad call period + real(kind_phys), dimension(:), intent(in) :: & + tsfa, & !< Lowest model layer air temperature for radiation (K) + sfc_alb_nir_dir, & !< Surface albedo (direct) + sfc_alb_nir_dif, & !< Surface albedo (diffuse) + sfc_alb_uvvis_dir, & !< Surface albedo (direct) + sfc_alb_uvvis_dif !< Surface albedo (diffuse) + real(kind_phys), dimension(:,:), intent(in) :: & + p_lev !< Pressure @ model layer-interfaces (Pa) + real(kind_phys), dimension(:,:), intent(in) :: & + tgrs !< Temperature @ model layer-centers (K) + real(kind_phys), dimension(:,:), intent(in), optional :: & + fluxlwUP_clrsky, & !< RRTMGP longwave clear-sky flux (W/m2) + fluxlwDOWN_clrsky, & !< RRTMGP longwave clear-sky flux (W/m2) + fluxlwUP_allsky, & !< RRTMGP longwave all-sky flux (W/m2) + fluxlwDOWN_allsky, & !< RRTMGP longwave all-sky flux (W/m2) + fluxswUP_clrsky, & !< RRTMGP shortwave clear-sky flux (W/m2) + fluxswDOWN_clrsky, & !< RRTMGP shortwave clear-sky flux (W/m2) + fluxswUP_allsky, & !< RRTMGP shortwave all-sky flux (W/m2) + fluxswDOWN_allsky !< RRTMGP shortwave all-sky flux (W/m2) + real(kind_phys), dimension(:,:), intent(in) :: & + aerodp !< Vertical integrated optical depth for aerosol species + real(kind_phys), dimension(:,:), intent(in) :: & + cldtausw, & !< .55mu band layer cloud optical depth (SW) + cldtaulw !< 10mu band layer cloud optical depth (LW) + real(kind_phys), dimension(:,:), intent(in) :: & + cldsa !< Fraction of clouds for High/Mid/Low diagnostics: + !< low(1), middle(2), high(3), total(4) and BL(5) + integer, intent(in), dimension(:,:) :: & + mtopa, & !< Vertical indices for low, middle and high cloud tops (H/M/L diag) + mbota !< Vertical indices for low, middle and high cloud bases (H/M/L diag) + type(cmpfsw_type), dimension(:), intent(in) :: & + scmpsw !< 2D surface fluxes, components: + !!\n uvbfc - total sky downward uv-b flux at (W/m2) + !!\n uvbf0 - clear sky downward uv-b flux at (W/m2) + !!\n nirbm - downward nir direct beam flux (W/m2) + !!\n nirdf - downward nir diffused flux (W/m2) + !!\n visbm - downward uv+vis direct beam flux (W/m2) + !!\n visdf - downward uv+vis diffused flux (W/m2) + ! Outputs (mandatory) + real(kind_phys), dimension(:), intent(inout) :: & + tsflw, & !< LW sfc air temp during calculation (K) + sfcdlw, & !< LW sfc all-sky downward flux (W/m2) + sfculw, & !< LW sfc all-sky upward flux (W/m2) + nirbmdi, & !< SW sfc nir beam downward flux (W/m2) + nirdfdi, & !< SW sfc nir diff downward flux (W/m2) + visbmdi, & !< SW sfc uv+vis beam downward flux (W/m2) + visdfdi, & !< SW sfc uv+vis diff downward flux (W/m2) + nirbmui, & !< SW sfc nir beam upward flux (W/m2) + nirdfui, & !< SW sfc nir diff upward flux (W/m2) + visbmui, & !< SW sfc uv+vis beam upward flux (W/m2) + visdfui, & !< SW sfc uv+vis diff upward flux (W/m2) + sfcnsw, & !< SW sfc all-sky net flux (W/m2) flux into ground + sfcdsw !< SW sfc all-sky downward flux (W/m2) + real(kind_phys), dimension(:,:), intent(inout) :: & + htrlw, & !< LW all-sky heating rate (K/s) + htrsw !< SW all-sky heating rate (K/s) + real(kind_phys), dimension(:), intent(inout) :: & + total_albedo !< Total sky albedo at TOA (W/m2) + real(kind_phys), dimension(:,:), intent(inout), optional :: & + htrlwu !< LW all-sky heating-rate updated in-between radiation calls. + type(sfcflw_type), dimension(:), intent(inout) :: & + sfcflw !< LW radiation fluxes at sfc + type(sfcfsw_type), dimension(:), intent(inout) :: & + sfcfsw !< SW radiation fluxes at sfc + type(topfsw_type), dimension(:), intent(inout) :: & + topfsw !< SW fluxes at top atmosphere + type(topflw_type), dimension(:), intent(inout) :: & + topflw !< LW fluxes at top atmosphere + real(kind_phys), dimension(:,:), intent(inout) :: & + fluxr !< LW/SW diagnostics + character(len=*), intent(out) :: & + errmsg !< CCPP error message + integer, intent(out) :: & + errflg !< CCPP error code + ! Outputs (optional) + real(kind_phys),dimension(:,:),intent(inout),optional :: & + htrlwc, & !< LW clear-sky heating-rate (K/s) + htrswc !< SW clear-sky heating rate (K/s) + + ! Local variables + integer :: i + real(rte_wp), dimension(nDay, nLev) :: thetaTendClrSkySW, thetaTendAllSkySW + real(rte_wp), dimension(nCol, nLev) :: thetaTendClrSkyLW, thetaTendAllSkyLW + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Only proceed if radiation is being called. + if (.not. (doLWrad .or. doSWrad)) return + + ! ####################################################################################### + ! Longwave Radiation + ! ####################################################################################### + if (doLWRad) then + if (do_RRTMGP) then + ! Clear-sky heating-rate (optional) + if (do_lw_clrsky_hr) then + call check_error_msg('GFS_radiation_post',compute_heating_rate( & + real(fluxlwUP_clrsky, kind=rte_wp), & ! IN - RRTMGP upward longwave clear-sky flux profiles (W/m2) + real(fluxlwDOWN_clrsky, kind=rte_wp), & ! IN - RRTMGP downward longwave clear-sky flux profiles (W/m2) + real(p_lev, kind=rte_wp), & ! IN - Pressure @ layer-interfaces (Pa) + thetaTendClrSkyLW)) ! OUT - Longwave clear-sky heating rate (K/sec) + htrlwc = thetaTendClrSkyLW + endif + + ! All-sky heating-rate (mandatory) + call check_error_msg('GFS_radiation_post',compute_heating_rate( & + real(fluxlwUP_allsky, kind=rte_wp), & ! IN - RRTMGP upward longwave all-sky flux profiles (W/m2) + real(fluxlwDOWN_allsky, kind=rte_wp), & ! IN - RRTMGP downward longwave all-sky flux profiles (W/m2) + real(p_lev, kind=rte_wp), & ! IN - Pressure @ layer-interfaces (Pa) + thetaTendAllSkyLW)) ! OUT - Longwave all-sky heating rate (K/sec) + htrlw = thetaTendAllSkyLW + + ! (Copy fluxes from RRTMGP types into model radiation types.) + ! TOA fluxes + topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) + topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA) + + ! Surface fluxes + sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC) + sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC) + sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC) + sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC) + + ! Save surface air temp for diurnal adjustment at model t-steps + tsflw(:) = tsfa(:) + + ! Radiation fluxes for other physics processes + sfcdlw(:) = sfcflw(:)%dnfxc + sfculw(:) = sfcflw(:)%upfxc + + ! Heating-rate at radiation timestep, used for adjustment between radiation calls. + htrlwu = htrlw + endif ! RRTMGP Longwave Radiaiton + endif ! ALL Longwave Radiation + + ! ####################################################################################### + ! Shortwave Radiation + ! ####################################################################################### + if (doSWRad) then + if (do_RRTMGP) then + if (nDay .gt. 0) then + ! Clear-sky heating-rate (optional) + if (do_sw_clrsky_hr) then + htrswc(:,:) = 0._kind_phys + call check_error_msg('GFS_radiation_post',compute_heating_rate( & + real(fluxswUP_clrsky(idxday(1:nDay),:), kind=rte_wp), & ! IN - Shortwave upward clear-sky flux profiles (W/m2) + real(fluxswDOWN_clrsky(idxday(1:nDay),:), kind=rte_wp), & ! IN - Shortwave downward clear-sky flux profiles (W/m2) + real(p_lev(idxday(1:nDay),:), kind=rte_wp), & ! IN - Pressure at model-interface (Pa) + thetaTendClrSkySW)) ! OUT - Clear-sky heating-rate (K/sec) + htrswc(idxday(1:nDay),:)=thetaTendClrSkySW !**NOTE** GP doesn't use radiation levels, it uses the model fields. Not sure if this is necessary + endif + + ! All-sky heating-rate (mandatory) + htrsw(:,:) = 0._kind_phys + call check_error_msg('GFS_radiation_post',compute_heating_rate( & + real(fluxswUP_allsky(idxday(1:nDay),:), kind=rte_wp), & ! IN - Shortwave upward all-sky flux profiles (W/m2) + real(fluxswDOWN_allsky(idxday(1:nDay),:), kind=rte_wp), & ! IN - Shortwave downward all-sky flux profiles (W/m2) + real(p_lev(idxday(1:nDay),:), kind=rte_wp), & ! IN - Pressure at model-interface (Pa) + thetaTendAllSkySW)) ! OUT - All-sky heating-rate (K/sec) + htrsw(idxday(1:nDay),:) = thetaTendAllSkySW + + ! (Copy fluxes from RRTMGP types into model radiation types.) + + ! TOA fluxes + topfsw(:)%upfxc = fluxswUP_allsky(:,iTOA) + topfsw(:)%upfx0 = fluxswUP_clrsky(:,iTOA) + topfsw(:)%dnfxc = fluxswDOWN_allsky(:,iTOA) + + ! Surface fluxes + sfcfsw(:)%upfxc = fluxswUP_allsky(:,iSFC) + sfcfsw(:)%upfx0 = fluxswUP_clrsky(:,iSFC) + sfcfsw(:)%dnfxc = fluxswDOWN_allsky(:,iSFC) + sfcfsw(:)%dnfx0 = fluxswDOWN_clrsky(:,iSFC) + + ! Surface down and up spectral component fluxes + ! - Save two spectral bands' surface downward and upward fluxes for output. + do i=1,nCol + nirbmdi(i) = scmpsw(i)%nirbm + nirdfdi(i) = scmpsw(i)%nirdf + visbmdi(i) = scmpsw(i)%visbm + visdfdi(i) = scmpsw(i)%visdf + nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(i) + nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(i) + visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(i) + visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(i) + enddo + else ! if_nday_block + ! Dark everywhere + htrsw(:,:) = 0.0 + sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) + topfsw = topfsw_type( 0.0, 0.0, 0.0 ) + do i=1,nCol + nirbmdi(i) = 0.0 + nirdfdi(i) = 0.0 + visbmdi(i) = 0.0 + visdfdi(i) = 0.0 + nirbmui(i) = 0.0 + nirdfui(i) = 0.0 + visbmui(i) = 0.0 + visdfui(i) = 0.0 + enddo + + if (do_sw_clrsky_hr) then + htrswc(:,:) = 0 + endif + endif ! end_if_nday + + ! Radiation fluxes for other physics processes + ! *NOTE* For RRTMG, sfcnsw and sfcdsw are provided. + ! For RRTMGP, we compute them here. + do i=1,nCol + sfcnsw(i) = sfcfsw(i)%dnfxc - sfcfsw(i)%upfxc + sfcdsw(i) = sfcfsw(i)%dnfxc + enddo + endif ! RRTMGP Shortwave Radiaiton + endif ! ALL Shortwave Radiation + + ! The total sky (with clouds) shortwave albedo + total_albedo = 0.0 + where(topfsw(:)%dnfxc>0) total_albedo(:) = topfsw(:)%upfxc/topfsw(:)%dnfxc + + ! ######################################################################################### + ! Compute radiation diagnostics + ! ######################################################################################### + if (lssav) then + call GFS_radiation_diagnostics(doLWrad, doSWrad, fhlwr, fhswr, coszen, coszdg, raddt, & + aerodp, cldsa, mtopa, mbota, cldtausw, cldtaulw, p_lev, tgrs, kb, kd, kt, sfcflw, & + sfcfsw, topfsw, topflw, scmpsw, nCol, nDay, nLev, lmk, nfxr, nspc1, fluxr) + endif + + end subroutine GFS_radiation_post_run + + ! ########################################################################################### + ! GFS_radiation_diagnostics + ! + ! For time averaged output quantities (including total-sky and clear-sky SW and LW fluxes at + ! TOA and surface; conventional 3-domain cloud amount, cloud top and base pressure, and cloud + ! top temperature; aerosols AOD, etc.), store computed results in corresponding slots of + ! array with appropriate time weights. + ! + ! ########################################################################################### + subroutine GFS_radiation_diagnostics(doLWrad, doSWrad, fhlwr, fhswr, coszen, coszdg, raddt, & + aerodp, cldsa, mtopa, mbota, cldtausw, cldtaulw, p_lev, tgrs, kb, kd, kt, sfcflw, & + sfcfsw, topfsw, topflw, scmpsw, nCol, nDay, nLev, lmk, nfxr, nspc1, fluxr) + ! Inputs + logical, intent(in) :: doLWrad, doSWrad + integer, intent(in) :: nCol, nLev, lmk, nfxr, nspc1, nDay + real(kind_phys), intent(in) :: fhlwr, fhswr, coszen(nCol), coszdg(nCol), raddt + real(kind_phys), intent(in) :: aerodp(nCol,nspc1) + real(kind_phys), intent(in) :: cldtausw(nCol,lmk), cldtaulw(nCol,lmk) + real(kind_phys), intent(in) :: p_lev(nCol,nLev+1), tgrs(nCol,nLev) + type(cmpfsw_type), intent(in) :: scmpsw(nCol) + type(sfcflw_type), intent(in) :: sfcflw(nCol) + type(sfcfsw_type), intent(in) :: sfcfsw(nCol) + type(topfsw_type), intent(in) :: topfsw(nCol) + type(topflw_type), intent(in) :: topflw(nCol) + ! For High/Mid/Low cloud flux diagnsotics + integer, intent(in) :: kb, kd, kt + integer, intent(in) :: mtopa(nCol,3), mbota(nCol,3) + real(kind_phys), intent(in) :: cldsa(nCol,5) + + ! Outputs + real(kind_phys), intent(inout) :: fluxr(nCol,nfxr) + ! Locals + integer :: i, j, k, itop, ibtc + real(kind_phys) :: tem0d, tem1, tem2 + + ! Save LW toa and sfc fluxes + if (doLWrad) then + do i=1,nCol + ! LW total-sky fluxes + fluxr(i,1 ) = fluxr(i,1 ) + fhlwr * topflw(i)%upfxc ! total sky TOA LW up + fluxr(i,19) = fluxr(i,19) + fhlwr * sfcflw(i)%dnfxc ! total sky SFC LW down + fluxr(i,20) = fluxr(i,20) + fhlwr * sfcflw(i)%upfxc ! total sky SFC LW up + ! LW clear-sky fluxes + fluxr(i,28) = fluxr(i,28) + fhlwr * topflw(i)%upfx0 ! clear sky TOA LW up + fluxr(i,30) = fluxr(i,30) + fhlwr * sfcflw(i)%dnfx0 ! clear sky SFC LW down + fluxr(i,33) = fluxr(i,33) + fhlwr * sfcflw(i)%upfx0 ! clear sky SFC LW up + enddo + endif ! END DOLWRAD + + ! Save SW toa and sfc fluxes with proper diurnal sw wgt. coszen=mean cosz over daylight + ! part of sw calling interval, while coszdg= mean cosz over entire interval + if (doSWrad) then + do i=1,nCol + ! Aerosol optical-depths + fluxr(i,34) = aerodp(i,1) ! Total aod at 550nm + fluxr(i,35) = aerodp(i,2) ! Dust aod at 550nm + fluxr(i,36) = aerodp(i,3) ! Soot aod at 550nm + fluxr(i,37) = aerodp(i,4) ! Waso aod at 550nm + fluxr(i,38) = aerodp(i,5) ! Suso aod at 550nm + fluxr(i,39) = aerodp(i,6) ! Salt aod at 550nm + + if (coszen(i) > 0.) then + ! SW total-sky fluxes + tem0d = fhswr * coszdg(i) / coszen(i) + fluxr(i,2 ) = fluxr(i,2) + topfsw(i)%upfxc * tem0d ! total sky TOA SW up + fluxr(i,3 ) = fluxr(i,3) + sfcfsw(i)%upfxc * tem0d ! total sky SFC SW up + fluxr(i,4 ) = fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky SFC SW down + ! SW uv-b fluxes + fluxr(i,21) = fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b SW down + fluxr(i,22) = fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b SW down + ! SW toa incoming fluxes + fluxr(i,23) = fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! TOA SW down + ! SW sfc flux components + fluxr(i,24) = fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam SW down + fluxr(i,25) = fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff SW down + fluxr(i,26) = fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam SW down + fluxr(i,27) = fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff SW down + ! SW clear-sky fluxes + fluxr(i,29) = fluxr(i,29) + topfsw(i)%upfx0 * tem0d ! clear sky TOA SW up + fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d ! clear sky SFC SW up + fluxr(i,32) = fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d ! clear sky SFC SW down + endif + enddo + endif ! END DOSWRAD + + ! + ! High/Mid/Low diagnostics + ! + if (doLWrad .or. doSWrad) then + ! Save total and boundary layer clouds + do i=1,nCol + fluxr(i,17) = fluxr(i,17) + raddt * cldsa(i,4) + fluxr(i,18) = fluxr(i,18) + raddt * cldsa(i,5) + enddo + + ! Save cld frac,toplyr,botlyr and top temp, note that the order + ! of h,m,l cloud is reversed for the fluxr output. + ! save interface pressure (pa) of top/bot + do j = 1, 3 + do i = 1, nCol + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + fluxr(i, 8-j) = fluxr(i, 8-j) + tem0d + fluxr(i,11-j) = fluxr(i,11-j) + tem0d * p_lev(i,itop+kt) + fluxr(i,14-j) = fluxr(i,14-j) + tem0d * p_lev(i,ibtc+kb) + fluxr(i,17-j) = fluxr(i,17-j) + tem0d * tgrs(i,itop) + enddo + enddo + + ! In-cloud (shortwave) optical depth at approx .55 um channel + if (doSWrad .and. (nDay > 0)) then + do j = 1, 3 + do i = 1, nCol + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + tem1 = 0. + do k=ibtc,itop + tem1 = tem1 + cldtausw(i,k) + enddo + fluxr(i,43-j) = fluxr(i,43-j) + tem0d * tem1 + enddo + enddo + endif ! END DOSWRAD + + ! In-cloud (longwave) optical depth at approx 10. um channel + if (doLWrad) then + do j = 1, 3 + do i = 1, nCol + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) - kd + ibtc = mbota(i,j) - kd + tem2 = 0. + do k=ibtc,itop + tem2 = tem2 + cldtaulw(i,k) + enddo + fluxr(i,46-j) = fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) + enddo + enddo + endif ! END DOLWRAD + endif ! END DOSWRAD OR DOLWRAD + + end subroutine GFS_radiation_diagnostics + +end module GFS_radiation_post diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.meta similarity index 86% rename from physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta rename to physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.meta index 5b355849a..b8a05e258 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_post.meta @@ -1,70 +1,15 @@ [ccpp-table-properties] - name = GFS_rrtmgp_post + name = GFS_radiation_post type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F,Radiation/radiation_aerosols.f dependencies = Radiation/RRTMG/radlw_param.f,Radiation/radiation_tools.F90,Radiation/RRTMGP/rte-rrtmgp/extensions/mo_heating_rates.F90 + dependencies = Radiation/RRTMGP/rte-rrtmgp/rte-frontend/mo_rte_kind.F90 ######################################################################## [ccpp-arg-table] - name = GFS_rrtmgp_post_run + name = GFS_radiation_post_run type = scheme -[nCol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[iSFC] - standard_name = vertical_index_for_surface_in_RRTMGP - long_name = index for surface layer in RRTMGP - units = flag - dimensions = () - type = integer - intent = in -[iTOA] - standard_name = vertical_index_for_TOA_in_RRTMGP - long_name = index for TOA layer in RRTMGP - units = flag - dimensions = () - type = integer - intent = in -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = in -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent = in -[doSWrad] - standard_name = flag_for_calling_shortwave_radiation - long_name = logical flags for sw radiation calls - units = flag - dimensions = () - type = logical - intent = in -[do_sw_clrsky_hr] - standard_name = flag_for_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_clear_sky - long_name = flag to output sw heating rate - units = flag - dimensions = () - type = logical - intent = in [doLWrad] standard_name = flag_for_calling_longwave_radiation long_name = logical flags for lw radiation calls @@ -72,20 +17,35 @@ dimensions = () type = logical intent = in -[do_lw_clrsky_hr] - standard_name = flag_for_output_of_tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep_assuming_clear_sky - long_name = flag to output lw heating rate +[doSWrad] + standard_name = flag_for_calling_shortwave_radiation + long_name = logical flags for sw radiation calls units = flag dimensions = () type = logical intent = in -[save_diag] +[lssav] standard_name = flag_for_diagnostics long_name = logical flag for storing diagnostics units = flag dimensions = () type = logical intent = in +[total_albedo] + standard_name = total_sky_albedo + long_name = total sky albedo at toa + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[topfsw] + standard_name = sw_fluxes_top_atmosphere + long_name = sw radiation fluxes at toa + units = W m-2 + dimensions = (horizontal_loop_extent) + type = topfsw_type + intent = inout [fhlwr] standard_name = period_of_longwave_radiation_calls long_name = frequency for longwave radiation @@ -118,69 +78,188 @@ type = real kind = kind_phys intent = in -[sfc_alb_nir_dir] - standard_name = surface_albedo_due_to_near_IR_direct - long_name = surface albedo due to near IR direct beam - units = frac - dimensions = (horizontal_loop_extent) +[raddt] + standard_name = time_step_for_radiation + long_name = radiation time step + units = s + dimensions = () type = real kind = kind_phys intent = in -[sfc_alb_nir_dif] - standard_name = surface_albedo_due_to_near_IR_diffused - long_name = surface albedo due to near IR diffused beam - units = frac - dimensions = (horizontal_loop_extent) +[aerodp] + standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles + long_name = vertical integrated optical depth for various aerosol species + units = none + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys intent = in -[sfc_alb_uvvis_dir] - standard_name = surface_albedo_due_to_UV_and_VIS_direct - long_name = surface albedo due to UV+VIS direct beam +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle, high, total and BL units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,5) type = real kind = kind_phys intent = in -[sfc_alb_uvvis_dif] - standard_name = surface_albedo_due_to_UV_and_VIS_diffused - long_name = surface albedo due to UV+VIS diffused beam - units = frac - dimensions = (horizontal_loop_extent) +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_loop_extent,3) + type = integer + intent = in +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_loop_extent,3) + type = integer + intent = in +[cldtausw] + standard_name = cloud_optical_depth_layers_at_0p55mu_band + long_name = approx .55mu band layer cloud optical depth + units = none + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) +[cldtaulw] + standard_name = cloud_optical_depth_layers_at_10mu_band + long_name = approx 10mu band layer cloud optical depth + units = none + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP + standard_name = air_pressure_at_interface long_name = air pressure level units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in -[fluxlwUP_allsky] - standard_name = RRTMGP_lw_flux_profile_upward_allsky - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[fluxlwDOWN_allsky] - standard_name = RRTMGP_lw_flux_profile_downward_allsky - long_name = RRTMGP downward longwave all-sky flux profile +[kb] + standard_name = vertical_index_difference_between_layer_and_lower_bound + long_name = vertical index difference between layer and lower bound + units = index + dimensions = () + type = integer + intent = in +[kd] + standard_name = vertical_index_difference_between_inout_and_local + long_name = vertical index difference between in/out and local + units = index + dimensions = () + type = integer + intent = in +[kt] + standard_name = vertical_index_difference_between_layer_and_upper_bound + long_name = vertical index difference between layer and upper bound + units = index + dimensions = () + type = integer + intent = in +[sfcflw] + standard_name = surface_lw_fluxes_assuming_total_and_clear_sky_on_radiation_timestep + long_name = lw radiation fluxes at sfc units = W m-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) + dimensions = (horizontal_loop_extent) + type = sfcflw_type + intent = inout +[sfcfsw] + standard_name = surface_sw_fluxes_assuming_total_and_clear_sky_on_radiation_timestep + long_name = sw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_loop_extent) + type = sfcfsw_type + intent = inout +[topflw] + standard_name = lw_fluxes_top_atmosphere + long_name = lw radiation fluxes at top + units = W m-2 + dimensions = (horizontal_loop_extent) + type = topflw_type + intent = inout +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_loop_extent) + type = cmpfsw_type + intent = in +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[nLev] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[lmk] + standard_name = adjusted_vertical_layer_dimension_for_radiation + long_name = adjusted number of vertical layers for radiation + units = count + dimensions = () + type = integer + intent = in +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in +[nfxr] + standard_name = number_of_diagnostics_variables_for_radiation + long_name = number of variables stored in the fluxr array + units = count + dimensions = () + type = integer + intent = in +[nspc1] + standard_name = number_of_species_for_aerosol_optical_depth + long_name = number of species for output aerosol optical depth plus total + units = count + dimensions = () + type = integer + intent = in +[fluxr] + standard_name = cumulative_radiation_diagnostic + long_name = time-accumulated 2D radiation-related diagnostic fields + units = mixed + dimensions = (horizontal_loop_extent,number_of_diagnostics_variables_for_radiation) type = real kind = kind_phys + intent = inout +[do_RRTMGP] + standard_name = flag_for_rrtmgp_radiation_scheme + long_name = flag for RRTMGP scheme + units = flag + dimensions = () + type = logical + intent = in +[do_lw_clrsky_hr] + standard_name = flag_for_output_of_tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep_assuming_clear_sky + long_name = flag to output lw heating rate + units = flag + dimensions = () + type = logical intent = in [fluxlwUP_clrsky] standard_name = RRTMGP_lw_flux_profile_upward_clrsky @@ -190,6 +269,7 @@ type = real kind = kind_phys intent = in + optional = True [fluxlwDOWN_clrsky] standard_name = RRTMGP_lw_flux_profile_downward_clrsky long_name = RRTMGP downward longwave clr-sky flux profile @@ -198,22 +278,58 @@ type = real kind = kind_phys intent = in -[fluxswUP_allsky] - standard_name = RRTMGP_sw_flux_profile_upward_allsky - long_name = RRTMGP upward shortwave all-sky flux profile + optional = True +[htrlwc] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_timestep + long_name = longwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = inout + optional = True +[fluxlwUP_allsky] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile units = W m-2 dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in -[fluxswDOWN_allsky] - standard_name = RRTMGP_sw_flux_profile_downward_allsky - long_name = RRTMGP downward shortwave all-sky flux profile + optional = True +[fluxlwDOWN_allsky] + standard_name = RRTMGP_lw_flux_profile_downward_allsky + long_name = RRTMGP downward longwave all-sky flux profile units = W m-2 dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in + optional = True +[htrlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky lw heating rate + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[do_sw_clrsky_hr] + standard_name = flag_for_output_of_tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep_assuming_clear_sky + long_name = flag to output sw heating rate + units = flag + dimensions = () + type = logical + intent = in +[htrswc] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep + long_name = clear sky sw heating rates + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True [fluxswUP_clrsky] standard_name = RRTMGP_sw_flux_profile_upward_clrsky long_name = RRTMGP upward shortwave clr-sky flux profile @@ -222,6 +338,14 @@ type = real kind = kind_phys intent = in + optional = True +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in [fluxswDOWN_clrsky] standard_name = RRTMGP_sw_flux_profile_downward_clrsky long_name = RRTMGP downward shortwave clr-sky flux profile @@ -230,83 +354,63 @@ type = real kind = kind_phys intent = in -[raddt] - standard_name = time_step_for_radiation - long_name = radiation time step - units = s - dimensions = () + optional = True +[htrsw] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky sw heating rate + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in -[aerodp] - standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles - long_name = vertical integrated optical depth for various aerosol species - units = none - dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) + intent = inout +[fluxswUP_allsky] + standard_name = RRTMGP_sw_flux_profile_upward_allsky + long_name = RRTMGP upward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in -[cldsa] - standard_name = cloud_area_fraction_for_radiation - long_name = fraction of clouds for low, middle, high, total and BL - units = frac - dimensions = (horizontal_loop_extent,5) + optional = True +[fluxswDOWN_allsky] + standard_name = RRTMGP_sw_flux_profile_downward_allsky + long_name = RRTMGP downward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in -[mtopa] - standard_name = model_layer_number_at_cloud_top - long_name = vertical indices for low, middle and high cloud tops - units = index - dimensions = (horizontal_loop_extent,3) + optional = True +[iSFC] + standard_name = vertical_index_for_surface_in_RRTMGP + long_name = index for surface layer in RRTMGP + units = flag + dimensions = () type = integer intent = in -[mbota] - standard_name = model_layer_number_at_cloud_base - long_name = vertical indices for low, middle and high cloud bases - units = index - dimensions = (horizontal_loop_extent,3) +[iTOA] + standard_name = vertical_index_for_TOA_in_RRTMGP + long_name = index for TOA layer in RRTMGP + units = flag + dimensions = () type = integer intent = in -[cld_frac] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cldtaulw] - standard_name = cloud_optical_depth_layers_at_10mu_band - long_name = approx 10mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[cldtausw] - standard_name = cloud_optical_depth_layers_at_0p55mu_band - long_name = approx .55mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,vertical_layer_dimension) +[tsflw] + standard_name = air_temperature_at_surface_adjacent_layer_on_radiation_timestep + long_name = surface air temp during lw calculation + units = K + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in -[scmpsw] - standard_name = components_of_surface_downward_shortwave_fluxes - long_name = derived type for special components of surface downward shortwave fluxes - units = W m-2 + intent = inout +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K dimensions = (horizontal_loop_extent) - type = cmpfsw_type - intent = in -[fluxr] - standard_name = cumulative_radiation_diagnostic - long_name = time-accumulated 2D radiation-related diagnostic fields - units = mixed - dimensions = (horizontal_loop_extent,number_of_diagnostics_variables_for_radiation) type = real kind = kind_phys - intent = inout + intent = in [sfcdlw] standard_name = surface_downwelling_longwave_flux_on_radiation_timestep long_name = total sky sfc downward lw flux @@ -314,7 +418,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = inout [sfculw] standard_name = surface_upwelling_longwave_flux_on_radiation_timestep long_name = total sky sfc upward lw flux @@ -323,29 +427,6 @@ type = real kind = kind_phys intent = inout -[sfcflw] - standard_name = surface_lw_fluxes_assuming_total_and_clear_sky_on_radiation_timestep - long_name = lw radiation fluxes at sfc - units = W m-2 - dimensions = (horizontal_loop_extent) - type = sfcflw_type - intent = inout -[tsflw] - standard_name = air_temperature_at_surface_adjacent_layer_on_radiation_timestep - long_name = surface air temp during lw calculation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep - long_name = total sky lw heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [htrlwu] standard_name = updated_tendency_of_air_temperature_due_to_longwave_heating_on_physics_timestep long_name = total sky longwave heating rate on physics time step @@ -354,13 +435,7 @@ type = real kind = kind_phys intent = inout -[topflw] - standard_name = lw_fluxes_top_atmosphere - long_name = lw radiation fluxes at top - units = W m-2 - dimensions = (horizontal_loop_extent) - type = topflw_type - intent = inout + optional = True [nirbmdi] standard_name = surface_downwelling_direct_nir_shortwave_flux_on_radiation_timestep long_name = sfc nir beam sw downward flux @@ -425,57 +500,51 @@ type = real kind = kind_phys intent = inout -[sfcnsw] - standard_name = surface_net_downwelling_shortwave_flux_on_radiation_timestep - long_name = total sky sfc netsw flx into ground - units = W m-2 +[sfc_alb_nir_dir] + standard_name = surface_albedo_due_to_near_IR_direct + long_name = surface albedo due to near IR direct beam + units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout -[sfcdsw] - standard_name = surface_downwelling_shortwave_flux_on_radiation_timestep - long_name = total sky sfc downward sw flux - units = W m-2 + intent = in +[sfc_alb_nir_dif] + standard_name = surface_albedo_due_to_near_IR_diffused + long_name = surface albedo due to near IR diffused beam + units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout -[htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep - long_name = total sky sw heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[sfc_alb_uvvis_dir] + standard_name = surface_albedo_due_to_UV_and_VIS_direct + long_name = surface albedo due to UV+VIS direct beam + units = frac + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout -[sfcfsw] - standard_name = surface_sw_fluxes_assuming_total_and_clear_sky_on_radiation_timestep - long_name = sw radiation fluxes at sfc - units = W m-2 + intent = in +[sfc_alb_uvvis_dif] + standard_name = surface_albedo_due_to_UV_and_VIS_diffused + long_name = surface albedo due to UV+VIS diffused beam + units = frac dimensions = (horizontal_loop_extent) - type = sfcfsw_type - intent = inout -[topfsw] - standard_name = sw_fluxes_top_atmosphere - long_name = sw radiation fluxes at toa + type = real + kind = kind_phys + intent = in +[sfcnsw] + standard_name = surface_net_downwelling_shortwave_flux_on_radiation_timestep + long_name = total sky sfc netsw flx into ground units = W m-2 dimensions = (horizontal_loop_extent) - type = topfsw_type - intent = inout -[htrswc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep - long_name = clear sky sw heating rates - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = inout -[htrlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_timestep - long_name = longwave clear sky heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) +[sfcdsw] + standard_name = surface_downwelling_shortwave_flux_on_radiation_timestep + long_name = total sky sfc downward sw flux + units = W m-2 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -493,4 +562,4 @@ units = 1 dimensions = () type = integer - intent = out + intent = out \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 index f6067a86c..9c0caa104 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.F90 @@ -9,11 +9,10 @@ module GFS_radiation_surface contains -!>\defgroup GFS_radiation_surface_mod GFS Radiation Surface Module -!! This module contains calls to module_radiation_surface::setemis() to set up +!> This module contains calls to module_radiation_surface::setemis() to set up !! surface emissivity for LW radiation and to module_radiation_surface::setalb() !! to set up surface albedo for SW radiation. -!> @{ + !> \section arg_table_GFS_radiation_surface_init Argument Table !! \htmlinclude GFS_radiation_surface_init.html !! @@ -48,7 +47,7 @@ end subroutine GFS_radiation_surface_init !! \htmlinclude GFS_radiation_surface_run.html !! subroutine GFS_radiation_surface_run ( & - ialb, im, nf_albd, frac_grid, lslwr, lsswr, lsm, lsm_noahmp, & + ialb, im, frac_grid, lslwr, lsswr, lsm, lsm_noahmp, & lsm_ruc, xlat, xlon, slmsk, lndp_type, n_var_lndp, sfc_alb_pert,& lndp_var_list, lndp_prt_list, landfrac, snodl, snodi, sncovr, & sncovr_ice, fice, zorl, hprime, tsfg, tsfa, tisfc, coszen, & @@ -60,28 +59,28 @@ subroutine GFS_radiation_surface_run ( & semisbase, semis, sfcalb, sfc_alb_dif, errmsg, errflg) use module_radiation_surface, only: f_zero, f_one, & - epsln, & setemis, setalb implicit none - integer, intent(in) :: im, nf_albd, ialb + integer, intent(in) :: im, ialb logical, intent(in) :: frac_grid, lslwr, lsswr, use_cice_alb, cplice integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp real(kind=kind_phys), intent(in) :: min_seaice, min_lakeice, con_ttp integer, dimension(:), intent(in) :: use_lake_model real(kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, slmsk, & - sfc_alb_pert, lndp_prt_list, & + sfc_alb_pert, & landfrac, lakefrac, & snodl, snodi, sncovr, & sncovr_ice, fice, zorl, & hprime, tsfg, tsfa, tisfc, & coszen, alvsf, alnsf, alvwf, & alnwf, facsf, facwf, snoalb - character(len=3) , dimension(:), intent(in) :: lndp_var_list - real(kind=kind_phys), dimension(:), intent(in) :: albdvis_ice, albdnir_ice, & - albivis_ice, albinir_ice + real(kind=kind_phys), dimension(:), intent(in), optional :: lndp_prt_list + character(len=3) , dimension(:), intent(in), optional :: lndp_var_list + real(kind=kind_phys), dimension(:), intent(in), optional :: albdvis_ice, albdnir_ice, & + albivis_ice, albinir_ice real(kind=kind_phys), dimension(:), intent(inout) :: albdvis_lnd, albdnir_lnd, & albivis_lnd, albinir_lnd, & @@ -178,12 +177,10 @@ subroutine GFS_radiation_surface_run ( & call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, use_cice_alb, snodi, sncovr, sncovr_ice, & snoalb, zorl, coszen, tsfg, tsfa, hprime, frac_grid, lakefrac, & -! snoalb, zorl, coszen, tsfg, tsfa, hprime, frac_grid, min_seaice, & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & - im, nf_albd, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, ialb, & - con_ttp, & ! --- inputs + im, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, ialb, con_ttp, & ! --- inputs sfcalb ) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. @@ -192,5 +189,4 @@ subroutine GFS_radiation_surface_run ( & end subroutine GFS_radiation_surface_run -!> @} end module GFS_radiation_surface diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta index 686bd3c6c..7e04bc8d2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_radiation_surface.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_radiation_surface type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = Radiation/radiation_surface.f dependencies = SFC_Models/Land/RUC/set_soilveg_ruc.F90,SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 dependencies = hooks/machine.F @@ -81,13 +81,6 @@ dimensions = () type = integer intent = in -[nf_albd] - standard_name = number_of_components_for_surface_albedo - long_name = number of IR/VIS/UV compinents for surface albedo - units = count - dimensions = () - type = integer - intent = in [frac_grid] standard_name = flag_for_fractional_landmask long_name = flag for fractional grid @@ -184,6 +177,7 @@ type = character kind = len=3 intent = in + optional = True [lndp_prt_list] standard_name = land_surface_perturbation_magnitudes long_name = magnitude of perturbations for landperts @@ -192,6 +186,7 @@ type = real kind = kind_phys intent = in + optional = True [landfrac] standard_name = land_area_fraction long_name = fraction of horizontal grid area occupied by land @@ -461,6 +456,7 @@ type = real kind = kind_phys intent = in + optional = True [albdnir_ice] standard_name = surface_albedo_direct_NIR_over_ice long_name = direct surface albedo NIR band over ice @@ -469,6 +465,7 @@ type = real kind = kind_phys intent = in + optional = True [albivis_ice] standard_name = surface_albedo_diffuse_visible_over_ice long_name = diffuse surface albedo visible band over ice @@ -477,6 +474,7 @@ type = real kind = kind_phys intent = in + optional = True [albinir_ice] standard_name = surface_albedo_diffuse_NIR_over_ice long_name = diffuse surface albedo NIR band over ice @@ -485,6 +483,7 @@ type = real kind = kind_phys intent = in + optional = True [semisbase] standard_name = baseline_surface_longwave_emissivity long_name = baseline surface lw emissivity in fraction diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.F90 deleted file mode 100644 index 76ee18ec2..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.F90 +++ /dev/null @@ -1,214 +0,0 @@ -!>\file GFS_rrtmg_post.F90 -!! This file contains the calculation of time averaged output quantities (including total-sky and -!! clear-sky SW and LW fluxes at TOA and surface; conventional -!! 3-domain cloud amount, cloud top and base pressure, and cloud top -!! temperature; aerosols AOD, etc.), store computed results in -!! corresponding slots of array fluxr with appropriate time weights. - - module GFS_rrtmg_post - contains - -!>\defgroup GFS_rrtmg_post_mod GFS RRTMG Scheme Post -!! This module calculate time averaged output quantities (including total-sky and -!! clear-sky SW and LW fluxes at TOA and surface; conventional -!! 3-domain cloud amount, cloud top and base pressure, and cloud top -!! temperature; aerosols AOD, etc.), store computed results in -!! corresponding slots of array fluxr with appropriate time weights. -!> @{ -!> \section arg_table_GFS_rrtmg_post_run Argument Table -!! \htmlinclude GFS_rrtmg_post_run.html -!! - subroutine GFS_rrtmg_post_run (im, km, kmp1, lm, ltp, kt, kb, kd, nspc1, & - nfxr, nday, lsswr, lslwr, lssav, fhlwr, fhswr, raddt, coszen, & - coszdg, prsi, tgrs, aerodp, cldsa, mtopa, mbota, clouds1, & - cldtaulw, cldtausw, sfcflw, sfcfsw, topflw, topfsw, scmpsw, & - fluxr, total_albedo, errmsg, errflg) - - use machine, only: kind_phys - use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & - cmpfsw_type - use module_radlw_parameters, only: topflw_type, sfcflw_type - - implicit none - - ! Interface variables - integer, intent(in) :: im, km, kmp1, lm, ltp, kt, kb, kd, & - nspc1, nfxr, nday - logical, intent(in) :: lsswr, lslwr, lssav - real(kind=kind_phys), intent(in) :: raddt, fhlwr, fhswr - - real(kind=kind_phys), dimension(im), intent(in) :: coszen, coszdg - - real(kind=kind_phys), dimension(im,kmp1), intent(in) :: prsi - real(kind=kind_phys), dimension(im,km), intent(in) :: tgrs - - real(kind=kind_phys), dimension(im,NSPC1), intent(in) :: aerodp - real(kind=kind_phys), dimension(im,5), intent(in) :: cldsa - integer, dimension(im,3), intent(in) :: mbota, mtopa - real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: clouds1 - real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: cldtausw - real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: cldtaulw - real(kind=kind_phys), dimension(im), intent(inout) :: total_albedo - - type(sfcflw_type), dimension(im), intent(in) :: sfcflw - type(sfcfsw_type), dimension(im), intent(in) :: sfcfsw - type(cmpfsw_type), dimension(im), intent(in) :: scmpsw - type(topflw_type), dimension(im), intent(in) :: topflw - type(topfsw_type), dimension(im), intent(in) :: topfsw - - real(kind=kind_phys), dimension(im,nfxr), intent(inout) :: fluxr - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - integer :: i, j, k, k1, itop, ibtc - real(kind=kind_phys) :: tem0d, tem1, tem2 - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. (lsswr .or. lslwr)) return - -! - For time averaged output quantities (including total-sky and -! clear-sky SW and LW fluxes at TOA and surface; conventional -! 3-domain cloud amount, cloud top and base pressure, and cloud top -! temperature; aerosols AOD, etc.), store computed results in -! corresponding slots of array fluxr with appropriate time weights. - -! --- ... collect the fluxr data for wrtsfc - - if (lssav) then - if (lsswr) then - do i=1,im -! fluxr(i,34) = fluxr(i,34) + fhswr*aerodp(i,1) ! total aod at 550nm -! fluxr(i,35) = fluxr(i,35) + fhswr*aerodp(i,2) ! DU aod at 550nm -! fluxr(i,36) = fluxr(i,36) + fhswr*aerodp(i,3) ! BC aod at 550nm -! fluxr(i,37) = fluxr(i,37) + fhswr*aerodp(i,4) ! OC aod at 550nm -! fluxr(i,38) = fluxr(i,38) + fhswr*aerodp(i,5) ! SU aod at 550nm -! fluxr(i,39) = fluxr(i,39) + fhswr*aerodp(i,6) ! SS aod at 550nm - fluxr(i,34) = aerodp(i,1) ! total aod at 550nm - fluxr(i,35) = aerodp(i,2) ! DU aod at 550nm - fluxr(i,36) = aerodp(i,3) ! BC aod at 550nm - fluxr(i,37) = aerodp(i,4) ! OC aod at 550nm - fluxr(i,38) = aerodp(i,5) ! SU aod at 550nm - fluxr(i,39) = aerodp(i,6) ! SS aod at 550nm - enddo - endif - -! --- save lw toa and sfc fluxes - if (lslwr) then - do i=1,im -! --- lw total-sky fluxes - fluxr(i,1 ) = fluxr(i,1 ) + fhlwr * topflw(i)%upfxc ! total sky top lw up - fluxr(i,19) = fluxr(i,19) + fhlwr * sfcflw(i)%dnfxc ! total sky sfc lw dn - fluxr(i,20) = fluxr(i,20) + fhlwr * sfcflw(i)%upfxc ! total sky sfc lw up -! --- lw clear-sky fluxes - fluxr(i,28) = fluxr(i,28) + fhlwr * topflw(i)%upfx0 ! clear sky top lw up - fluxr(i,30) = fluxr(i,30) + fhlwr * sfcflw(i)%dnfx0 ! clear sky sfc lw dn - fluxr(i,33) = fluxr(i,33) + fhlwr * sfcflw(i)%upfx0 ! clear sky sfc lw up - enddo - endif - -! --- save sw toa and sfc fluxes with proper diurnal sw wgt. coszen=mean cosz over daylight -! part of sw calling interval, while coszdg= mean cosz over entire interval - if (lsswr) then - do i = 1, IM - if (coszen(i) > 0.) then -! --- sw total-sky fluxes -! ------------------- - tem0d = fhswr * coszdg(i) / coszen(i) - fluxr(i,2 ) = fluxr(i,2) + topfsw(i)%upfxc * tem0d ! total sky top sw up - fluxr(i,3 ) = fluxr(i,3) + sfcfsw(i)%upfxc * tem0d ! total sky sfc sw up - fluxr(i,4 ) = fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn -! --- sw uv-b fluxes -! -------------- - fluxr(i,21) = fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn - fluxr(i,22) = fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn -! --- sw toa incoming fluxes -! ---------------------- - fluxr(i,23) = fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn -! --- sw sfc flux components -! ---------------------- - fluxr(i,24) = fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam sw dn - fluxr(i,25) = fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff sw dn - fluxr(i,26) = fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam sw dn - fluxr(i,27) = fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff sw dn -! --- sw clear-sky fluxes -! ------------------- - fluxr(i,29) = fluxr(i,29) + topfsw(i)%upfx0 * tem0d ! clear sky top sw up - fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d ! clear sky sfc sw up - fluxr(i,32) = fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d ! clear sky sfc sw dn - endif - enddo - endif - -! --- save total and boundary layer clouds - - if (lsswr .or. lslwr) then - do i=1,im - fluxr(i,17) = fluxr(i,17) + raddt * cldsa(i,4) - fluxr(i,18) = fluxr(i,18) + raddt * cldsa(i,5) - enddo - -! --- save cld frac,toplyr,botlyr and top temp, note that the order -! of h,m,l cloud is reversed for the fluxr output. -! --- save interface pressure (pa) of top/bot - - do j = 1, 3 - do i = 1, IM - tem0d = raddt * cldsa(i,j) - itop = mtopa(i,j) - kd - ibtc = mbota(i,j) - kd - fluxr(i, 8-j) = fluxr(i, 8-j) + tem0d - fluxr(i,11-j) = fluxr(i,11-j) + tem0d * prsi(i,itop+kt) - fluxr(i,14-j) = fluxr(i,14-j) + tem0d * prsi(i,ibtc+kb) - fluxr(i,17-j) = fluxr(i,17-j) + tem0d * tgrs(i,itop) - enddo - enddo - -! Anning adds optical depth and emissivity output - if (lsswr .and. (nday > 0)) then - do j = 1, 3 - do i = 1, IM - tem0d = raddt * cldsa(i,j) - itop = mtopa(i,j) - kd - ibtc = mbota(i,j) - kd - tem1 = 0. - do k=ibtc,itop - tem1 = tem1 + cldtausw(i,k) ! approx .55 um channel - enddo - fluxr(i,43-j) = fluxr(i,43-j) + tem0d * tem1 - enddo - enddo - endif - - if (lslwr) then - do j = 1, 3 - do i = 1, IM - tem0d = raddt * cldsa(i,j) - itop = mtopa(i,j) - kd - ibtc = mbota(i,j) - kd - tem2 = 0. - do k=ibtc,itop - tem2 = tem2 + cldtaulw(i,k) ! approx 10. um channel - enddo - fluxr(i,46-j) = fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) - enddo - enddo - endif - - endif - - endif ! end_if_lssav - -! --- The total sky (with clouds) shortwave albedo - total_albedo = 0.0 - if (lsswr) then - where(topfsw(:)%dnfxc>0) total_albedo(:) = topfsw(:)%upfxc/topfsw(:)%dnfxc - endif -! - end subroutine GFS_rrtmg_post_run -!> @} - end module GFS_rrtmg_post diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta deleted file mode 100644 index b387c3e33..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_post.meta +++ /dev/null @@ -1,285 +0,0 @@ -[ccpp-table-properties] - name = GFS_rrtmg_post - type = scheme - relative_path = ../../ - dependencies = hooks/machine.F - dependencies = Radiation/radiation_aerosols.f,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f - -######################################################################## -[ccpp-arg-table] - name = GFS_rrtmg_post_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[km] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[kmp1] - standard_name = vertical_interface_dimension - long_name = number of vertical levels plus one - units = count - dimensions = () - type = integer - intent = in -[lm] - standard_name = vertical_dimension_for_radiation - long_name = number of vertical layers for radiation calculation - units = count - dimensions = () - type = integer - intent = in -[ltp] - standard_name = extra_top_layer - long_name = extra top layers - units = count - dimensions = () - type = integer - intent = in -[kt] - standard_name = vertical_index_difference_between_layer_and_upper_bound - long_name = vertical index difference between layer and upper bound - units = index - dimensions = () - type = integer - intent = in -[kb] - standard_name = vertical_index_difference_between_layer_and_lower_bound - long_name = vertical index difference between layer and lower bound - units = index - dimensions = () - type = integer - intent = in -[kd] - standard_name = vertical_index_difference_between_inout_and_local - long_name = vertical index difference between in/out and local - units = index - dimensions = () - type = integer - intent = in -[nspc1] - standard_name = number_of_species_for_aerosol_optical_depth - long_name = number of species for output aerosol optical depth plus total - units = count - dimensions = () - type = integer - intent = in -[nfxr] - standard_name = number_of_diagnostics_variables_for_radiation - long_name = number of variables stored in the fluxr array - units = count - dimensions = () - type = integer - intent = in -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer - intent = in -[lsswr] - standard_name = flag_for_calling_shortwave_radiation - long_name = logical flags for sw radiation calls - units = flag - dimensions = () - type = logical - intent = in -[lslwr] - standard_name = flag_for_calling_longwave_radiation - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in -[lssav] - standard_name = flag_for_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - type = logical - intent = in -[fhlwr] - standard_name = period_of_longwave_radiation_calls - long_name = frequency for longwave radiation - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[fhswr] - standard_name = period_of_shortwave_radiation_calls - long_name = frequency for shortwave radiation - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[raddt] - standard_name = time_step_for_radiation - long_name = radiation time step - units = s - dimensions = () - type = real - kind = kind_phys - intent = in -[coszen] - standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep - long_name = mean cos of zenith angle over rad call period - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[coszdg] - standard_name = cosine_of_solar_zenith_angle_on_radiation_timestep - long_name = daytime mean cosz over rad call period - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[prsi] - standard_name = air_pressure_at_interface - long_name = air pressure at model layer interfaces - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[tgrs] - standard_name = air_temperature - long_name = model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[aerodp] - standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles - long_name = vertical integrated optical depth for various aerosol species - units = none - dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) - type = real - kind = kind_phys - intent = in -[cldsa] - standard_name = cloud_area_fraction_for_radiation - long_name = fraction of clouds for low, middle, high, total and BL - units = frac - dimensions = (horizontal_loop_extent,5) - type = real - kind = kind_phys - intent = in -[mtopa] - standard_name = model_layer_number_at_cloud_top - long_name = vertical indices for low, middle and high cloud tops - units = index - dimensions = (horizontal_loop_extent,3) - type = integer - intent = in -[mbota] - standard_name = model_layer_number_at_cloud_base - long_name = vertical indices for low, middle and high cloud bases - units = index - dimensions = (horizontal_loop_extent,3) - type = integer - intent = in -[clouds1] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys - intent = in -[cldtaulw] - standard_name = cloud_optical_depth_layers_at_10mu_band - long_name = approx 10mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys - intent = in -[cldtausw] - standard_name = cloud_optical_depth_layers_at_0p55mu_band - long_name = approx .55mu band layer cloud optical depth - units = none - dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys - intent = in -[sfcflw] - standard_name = surface_lw_fluxes_assuming_total_and_clear_sky_on_radiation_timestep - long_name = lw radiation fluxes at sfc - units = W m-2 - dimensions = (horizontal_loop_extent) - type = sfcflw_type - intent = in -[sfcfsw] - standard_name = surface_sw_fluxes_assuming_total_and_clear_sky_on_radiation_timestep - long_name = sw radiation fluxes at sfc - units = W m-2 - dimensions = (horizontal_loop_extent) - type = sfcfsw_type - intent = in -[topflw] - standard_name = lw_fluxes_top_atmosphere - long_name = lw radiation fluxes at top - units = W m-2 - dimensions = (horizontal_loop_extent) - type = topflw_type - intent = in -[topfsw] - standard_name = sw_fluxes_top_atmosphere - long_name = sw radiation fluxes at toa - units = W m-2 - dimensions = (horizontal_loop_extent) - type = topfsw_type - intent = in -[scmpsw] - standard_name = components_of_surface_downward_shortwave_fluxes - long_name = derived type for special components of surface downward shortwave fluxes - units = W m-2 - dimensions = (horizontal_loop_extent) - type = cmpfsw_type - intent = in -[fluxr] - standard_name = cumulative_radiation_diagnostic - long_name = time-accumulated 2D radiation-related diagnostic fields - units = mixed - dimensions = (horizontal_loop_extent,number_of_diagnostics_variables_for_radiation) - type = real - kind = kind_phys - intent = inout -[total_albedo] - standard_name = total_sky_albedo - long_name = total sky albedo at toa - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 index 5da5c86fb..754fe12bb 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 @@ -19,20 +19,22 @@ module GFS_rrtmg_pre !>\section rrtmg_pre_gen General Algorithm subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& ltp, imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, me, ncnd, ntrac, & - num_p3d, npdf3d, & + num_p3d, npdf3d, xr_cnvcld, & ncnvcld3d,ntqv, ntcw,ntiw, ntlnc, ntinc, ntrnc, ntsnc, ntccn, top_at_1,& ntrw, ntsw, ntgl, nthl, ntwa, ntoz, ntsmoke, ntdust, ntcoarsepm, & ntclamt, nleffr, nieffr, nseffr, lndp_type, kdt, & ntdu1, ntdu2, ntdu3, ntdu4, ntdu5, ntss1, ntss2, & ntss3, ntss4, ntss5, ntsu, ntbcb, ntbcl, ntocb, ntocl, ntchm, & imp_physics,imp_physics_nssl, nssl_ccn_on, nssl_invertccn, & - imp_physics_thompson, imp_physics_gfdl, imp_physics_zhao_carr, & + imp_physics_thompson, imp_physics_tempo, imp_physics_gfdl, & + imp_physics_zhao_carr, & imp_physics_zhao_carr_pdf, imp_physics_mg, imp_physics_wsm6, & imp_physics_fer_hires, iovr, iovr_rand, iovr_maxrand, iovr_max, & iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, idcor_hogan, & idcor_oreopoulos, dcorr_con, julian, yearlen, lndp_var_list, lsswr, & lslwr, ltaerosol, mraerosol, lgfdlmprad, uni_cld, effr_in, do_mynnedmf,& - lmfshal, lcnorm, lmfdeep2, lcrick, fhswr, fhlwr, solhr, sup, con_eps, & + lmfshal, lcnorm, lmfdeep2, lcrick, fhswr, fhlwr, solhr, sup, xr_con, & + xr_exp, con_eps, & epsm1, fvirt, rog, rocp, con_rd, xlat_d, xlat, xlon, coslat, sinlat, & tsfc, slmsk, prsi, prsl, prslk, tgrs, sfc_wts, mg_cld, effrr_in, & pert_clds, sppt_wts, sppt_amp, cnvw_in, cnvc_in, qgrs, aer_nm, dx, & @@ -45,7 +47,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& gasvmr_ccl4, gasvmr_cfc113, aerodp,ext550, clouds6, clouds7, clouds8, & clouds9, cldsa, cldfra, cldfra2d, lwp_ex,iwp_ex, lwp_fc,iwp_fc, & faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, rrfs_sd, & - aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, ozphys, & + aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, ozphys, tempo_cfg, & errmsg, errflg) use machine, only: kind_phys @@ -72,15 +74,37 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& use surface_perturbation, only: cdfnor,ppfbet ! For Thompson MP - use module_mp_thompson, only: calc_effectRad, & - Nt_c_l, Nt_c_o, & - re_qc_min, re_qc_max, & - re_qi_min, re_qi_max, & - re_qs_min, re_qs_max + use module_mp_thompson, only: calc_effectRad_thompson => calc_effectRad, & + Nt_c_l_thompson => Nt_c_l, & + Nt_c_o_thompson => Nt_c_o, & + re_qc_min_thompson => re_qc_min, & + re_qc_max_thompson => re_qc_max, & + re_qi_min_thompson => re_qi_min, & + re_qi_max_thompson => re_qi_max, & + re_qs_min_thompson => re_qs_min, & + re_qs_max_thompson => re_qs_max use module_mp_thompson_make_number_concentrations, only: & - make_IceNumber, & - make_DropletNumber, & - make_RainNumber + make_IceNumber_thompson => make_IceNumber, & + make_DropletNumber_thompson => make_DropletNumber, & + make_RainNumber_thompson => make_RainNumber + + use module_mp_tempo_params, only: & + ty_tempo_cfg, & + Nt_c_l_tempo => Nt_c_l, & + Nt_c_o_tempo => Nt_c_o, & + re_qc_min_tempo => re_qc_min, & + re_qc_max_tempo => re_qc_max, & + re_qi_min_tempo => re_qi_min, & + re_qi_max_tempo => re_qi_max, & + re_qs_min_tempo => re_qs_min, & + re_qs_max_tempo => re_qs_max + + use module_mp_tempo_utils, only: & + calc_effectRad_tempo => calc_effectRad, & + make_IceNumber_tempo => make_IceNumber, & + make_DropletNumber_tempo => make_DropletNumber, & + make_RainNumber_tempo => make_RainNumber + ! For NRL Ozone use module_ozphys, only: ty_ozphys implicit none @@ -98,6 +122,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& lndp_type, & kdt, imp_physics, & imp_physics_thompson, & + imp_physics_tempo, & imp_physics_gfdl, & imp_physics_zhao_carr, & imp_physics_zhao_carr_pdf, & @@ -123,19 +148,19 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& integer, intent(in) :: ntdu1, ntdu2, ntdu3, ntdu4, ntdu5, ntss1, ntss2, ntss3, & ntss4, ntss5, ntsu, ntbcb, ntbcl, ntocb, ntocl, ntchm - character(len=3), dimension(:), intent(in) :: lndp_var_list + character(len=3), dimension(:), intent(in), optional :: lndp_var_list logical, intent(in) :: lsswr, lslwr, ltaerosol, lgfdlmprad, & uni_cld, effr_in, do_mynnedmf, & lmfshal, lmfdeep2, pert_clds, lcrick,& lcnorm, top_at_1, lextop, mraerosol - logical, intent(in) :: rrfs_sd, aero_dir_fdb + logical, intent(in) :: rrfs_sd, aero_dir_fdb, xr_cnvcld logical, intent(in) :: nssl_ccn_on, nssl_invertccn integer, intent(in) :: spp_rad - real(kind_phys), intent(in) :: spp_wts_rad(:,:) + real(kind_phys), intent(in), optional :: spp_wts_rad(:,:) - real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian, sppt_amp, dcorr_con + real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian, sppt_amp, dcorr_con, xr_con, xr_exp real(kind=kind_phys), intent(in) :: con_eps, epsm1, fvirt, rog, rocp, con_rd, con_pi, con_g, con_ttp, con_thgni real(kind=kind_phys), dimension(:), intent(in) :: xlat_d, xlat, xlon, & @@ -143,23 +168,24 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& slmsk, dx, si real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, prsl, prslk, & - tgrs, sfc_wts, & + tgrs + real(kind=kind_phys), dimension(:,:), intent(in), optional :: & mg_cld, effrr_in, & cnvw_in, cnvc_in, & - sppt_wts + sppt_wts, sfc_wts real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs real(kind=kind_phys), dimension(:,:,:), intent(inout) :: aer_nm real(kind=kind_phys), dimension(:), intent(inout) :: coszen, coszdg - real(kind=kind_phys), dimension(:,:), intent(inout) :: effrl_inout, & + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: effrl_inout, & effri_inout, & effrs_inout real(kind=kind_phys), dimension(:,:), intent(inout) :: clouds1, & clouds2, clouds3, & clouds4, clouds5 - real(kind=kind_phys), dimension(:,:), intent(in) :: qci_conv + real(kind=kind_phys), dimension(:,:), intent(in), optional :: qci_conv real(kind=kind_phys), dimension(:), intent(in) :: fdb_coef real(kind=kind_phys), dimension(:), intent(out) :: lwp_ex,iwp_ex, & lwp_fc,iwp_fc @@ -207,7 +233,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& real(kind=kind_phys), dimension(:,:,:), intent(out) :: faerlw1,& faerlw2,& faerlw3 - real(kind=kind_phys), dimension(:,:), intent(out) :: alpha + real(kind=kind_phys), dimension(:,:), intent(out), optional :: alpha character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -234,6 +260,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& real (kind=kind_phys), dimension(lm) :: cldfra1d, qv1d, & & qc1d, qi1d, qs1d, dz1d, p1d, t1d + ! For TEMPO MP + type(ty_tempo_cfg), intent(in) :: tempo_cfg + ! for F-A MP real(kind=kind_phys), dimension(im,lm+LTP+1) :: tem2db, hz @@ -275,7 +304,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& LP1 = LM + 1 ! num of in/out levels - if (imp_physics == imp_physics_thompson) then + if (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) then max_relh = 1.5 else max_relh = 1.1 @@ -736,7 +765,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& enddo enddo ! for Thompson MP - prepare variables for calc_effr - if_thompson: if (imp_physics == imp_physics_thompson .and. (ltaerosol .or. mraerosol)) then + if_thompson: if ((imp_physics == imp_physics_thompson .or. & + imp_physics == imp_physics_tempo) .and. (ltaerosol .or. mraerosol)) then do k=1,LMK do i=1,IM qvs = qlyr(i,k) @@ -751,7 +781,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& nwfa (i,k) = tracer1(i,k,ntwa) enddo enddo - elseif (imp_physics == imp_physics_thompson) then + elseif (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) then do k=1,LMK do i=1,IM qvs = qlyr(i,k) @@ -762,9 +792,17 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) qs_mp (i,k) = tracer1(i,k,ntsw)/(1.-qvs) if(nint(slmsk(i)) == 1) then - nc_mp (i,k) = Nt_c_l*orho(i,k) + if (imp_physics == imp_physics_thompson) then + nc_mp (i,k) = Nt_c_l_thompson*orho(i,k) + else + nc_mp (i,k) = Nt_c_l_tempo*orho(i,k) + endif else - nc_mp (i,k) = Nt_c_o*orho(i,k) + if (imp_physics == imp_physics_thompson) then + nc_mp (i,k) = Nt_c_o_thompson*orho(i,k) + else + nc_mp (i,k) = Nt_c_o_tempo*orho(i,k) + endif endif ni_mp (i,k) = tracer1(i,k,ntinc)/(1.-qvs) enddo @@ -877,18 +915,26 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& ! not used yet -- effr_in should always be true for now endif - elseif (imp_physics == imp_physics_thompson) then ! Thompson MP + elseif (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) then ! Thompson MP ! ! Compute effective radii for QC, QI, QS with (GF, MYNN) or without (all others) sub-grid clouds ! ! Update number concentration, consistent with sub-grid clouds (GF, MYNN) or without (all others) do k=1,lm do i=1,im - if ((ltaerosol .or. mraerosol) .and. qc_mp(i,k)>1.e-12 .and. nc_mp(i,k)<100.) then - nc_mp(i,k) = make_DropletNumber(qc_mp(i,k)*rho(i,k), nwfa(i,k)*rho(i,k)) * orho(i,k) + if ((ltaerosol .or. mraerosol) .and. qc_mp(i,k)>1.e-12 .and. nc_mp(i,k)<100.) then + if (imp_physics == imp_physics_thompson) then + nc_mp(i,k) = make_DropletNumber_thompson(qc_mp(i,k)*rho(i,k), nwfa(i,k)*rho(i,k)) * orho(i,k) + else + nc_mp(i,k) = make_DropletNumber_tempo(qc_mp(i,k)*rho(i,k), nwfa(i,k)*rho(i,k)) * orho(i,k) + endif endif if (qi_mp(i,k)>1.e-12 .and. ni_mp(i,k)<100.) then - ni_mp(i,k) = make_IceNumber(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k) + if (imp_physics == imp_physics_thompson) then + ni_mp(i,k) = make_IceNumber_thompson(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k) + else + ni_mp(i,k) = make_IceNumber_tempo(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k) + endif endif end do end do @@ -899,18 +945,36 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& !tgs: progclduni has different limits for ice radii (10.0-150.0) than ! calc_effectRad (4.99-125.0 for WRFv3.8.1; 2.49-125.0 for WRFv4+) ! it will raise the low limit from 5 to 10, but the high limit will remain 125. - call calc_effectRad (tlyr(i,:), plyr(i,:)*100., qv_mp(i,:), qc_mp(i,:), & - nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & - effrl(i,:), effri(i,:), effrs(i,:), islmsk, 1, lm ) - ! Scale Thompson's effective radii from meter to micron - do k=1,lm - effrl(i,k) = MAX(re_qc_min, MIN(effrl(i,k), re_qc_max))*1.e6 - effri(i,k) = MAX(re_qi_min, MIN(effri(i,k), re_qi_max))*1.e6 - effrs(i,k) = MAX(re_qs_min, MIN(effrs(i,k), re_qs_max))*1.e6 - end do - effrl(i,lmk) = re_qc_min*1.e6 - effri(i,lmk) = re_qi_min*1.e6 - effrs(i,lmk) = re_qs_min*1.e6 + + if (imp_physics == imp_physics_thompson) then + call calc_effectRad_thompson(tlyr(i,:), plyr(i,:)*100., qv_mp(i,:), qc_mp(i,:), & + nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & + effrl(i,:), effri(i,:), effrs(i,:), islmsk, 1, lm ) + ! Scale Thompson's effective radii from meter to micron + do k=1,lm + effrl(i,k) = MAX(re_qc_min_thompson, MIN(effrl(i,k), re_qc_max_thompson))*1.e6 + effri(i,k) = MAX(re_qi_min_thompson, MIN(effri(i,k), re_qi_max_thompson))*1.e6 + effrs(i,k) = MAX(re_qs_min_thompson, MIN(effrs(i,k), re_qs_max_thompson))*1.e6 + end do + effrl(i,lmk) = re_qc_min_thompson*1.e6 + effri(i,lmk) = re_qi_min_thompson*1.e6 + effrs(i,lmk) = re_qs_min_thompson*1.e6 + else + call calc_effectRad_tempo(t1d=tlyr(i,:), p1d=plyr(i,:)*100., qv1d=qv_mp(i,:), qc1d=qc_mp(i,:), & + nc1d=nc_mp(i,:), qi1d=qi_mp(i,:), ni1d=ni_mp(i,:), qs1d=qs_mp(i,:), & + re_qc1d=effrl(i,:), re_qi1d=effri(i,:), re_qs1d=effrs(i,:), kts=1, kte=lm, & + lsml=islmsk, configs=tempo_cfg) + ! Scale Thompson's effective radii from meter to micron + do k=1,lm + effrl(i,k) = MAX(re_qc_min_tempo, MIN(effrl(i,k), re_qc_max_tempo))*1.e6 + effri(i,k) = MAX(re_qi_min_tempo, MIN(effri(i,k), re_qi_max_tempo))*1.e6 + effrs(i,k) = MAX(re_qs_min_tempo, MIN(effrs(i,k), re_qs_max_tempo))*1.e6 + end do + effrl(i,lmk) = re_qc_min_tempo*1.e6 + effri(i,lmk) = re_qi_min_tempo*1.e6 + effrs(i,lmk) = re_qs_min_tempo*1.e6 + endif + end do effrr(:,:) = 1000. ! rrain_def=1000. ! Update global arrays @@ -975,19 +1039,20 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& & deltaq, sup, dcorr_con, me, icloud, kdt, & & ntrac, ntcw, ntiw, ntrw, ntsw, ntgl, ntclamt, & & imp_physics, imp_physics_nssl, imp_physics_fer_hires, & - & imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & + & imp_physics_gfdl, imp_physics_thompson, & + & imp_physics_wsm6, imp_physics_tempo, & & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & & imp_physics_mg, iovr, iovr_rand, iovr_maxrand, iovr_max, & & iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, & & idcor_hogan, idcor_oreopoulos, lcrick, lcnorm, & & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, do_mynnedmf, & - & lgfdlmprad, & + & lgfdlmprad, xr_cnvcld, & & uni_cld, lmfshal, lmfdeep2, cldcov, clouds1, & & effrl, effri, effrr, effrs, effr_in, & & effrl_inout, effri_inout, effrs_inout, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzb, xlat_d, julian, yearlen, gridkm, top_at_1, si, & - & con_ttp, con_pi, con_g, con_rd, con_thgni, & + & xr_con, xr_exp, con_ttp, con_pi, con_g, con_rd, con_thgni, & & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & ! --- outputs: & cld_rwp, cld_rerain, cld_swp, cld_resnow, & ! --- outputs: & cldsa, mtopa, mbota, de_lgth, alpha & ! --- outputs: diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index 43802298b..697aadfb5 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -1,8 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmg_pre type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = tools/funcphys.f90,hooks/machine.F + dependencies = MP/TEMPO/TEMPO/module_mp_tempo_params.F90,MP/TEMPO/TEMPO/module_mp_tempo_utils.F90 dependencies = MP/Thompson/module_mp_thompson.F90,MP/Thompson/module_mp_thompson_make_number_concentrations.F90 dependencies = Radiation/RRTMG/radcons.f90,Radiation/radiation_aerosols.f dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f @@ -56,6 +57,13 @@ dimensions = () type = logical intent = in +[xr_cnvcld] + standard_name = flag_for_suspended_convective_clouds_in_Xu_Randall + long_name = flag for using suspended convective clouds in Xu Randall + units = flag + dimensions = () + type = logical + intent = in [ltp] standard_name = extra_top_layer long_name = extra top layer for radiation @@ -259,6 +267,13 @@ dimensions = () type = ty_ozphys intent = in +[tempo_cfg] + standard_name = configuration_for_TEMPO_microphysics + long_name = configuration information for TEMPO microphysics + units = mixed + dimensions = () + type = ty_tempo_cfg + intent = in [iaermdl] standard_name = control_for_aerosol_radiation_scheme long_name = control of aerosol scheme in radiation @@ -462,6 +477,13 @@ dimensions = () type = integer intent = in +[imp_physics_tempo] + standard_name = identifier_for_tempo_microphysics_scheme + long_name = choice of TEMPO microphysics scheme + units = flag + dimensions = () + type = integer + intent = in [imp_physics_gfdl] standard_name = identifier_for_gfdl_microphysics_scheme long_name = choice of GFDL microphysics scheme @@ -611,6 +633,7 @@ type = character kind = len=3 intent = in + optional = True [lsswr] standard_name = flag_for_calling_shortwave_radiation long_name = logical flags for sw radiation calls @@ -727,6 +750,22 @@ type = real kind = kind_phys intent = in +[xr_con] + standard_name = multiplicative_tuning_parameter_for_Xu_Randall_cloud_fraction + long_name = multiplicative tuning parameter for Xu Randall cloud fraction + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in +[xr_exp] + standard_name = exponent_tuning_parameter_for_Xu_Randall_cloud_fraction + long_name = exponent tuning parameter for Xu Randall cloud fraction + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in [con_eps] standard_name = ratio_of_dry_air_to_water_vapor_gas_constants long_name = rd/rv @@ -903,6 +942,7 @@ type = real kind = kind_phys intent = in + optional = True [mg_cld] standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP @@ -911,6 +951,7 @@ type = real kind = kind_phys intent = in + optional = True [effrr_in] standard_name = effective_radius_of_stratiform_cloud_rain_particle long_name = effective radius of cloud rain particle in micrometers @@ -919,6 +960,7 @@ type = real kind = kind_phys intent = in + optional = True [pert_clds] standard_name = flag_for_stochastic_cloud_fraction_perturbations long_name = flag for stochastic cloud fraction physics perturbations @@ -934,6 +976,7 @@ type = real kind = kind_phys intent = in + optional = True [sppt_amp] standard_name = total_amplitude_of_sppt_perturbation long_name = total ampltidue of stochastic sppt perturbation @@ -950,6 +993,7 @@ type = real kind = kind_phys intent = in + optional = True [cnvc_in] standard_name = convective_cloud_area_fraction long_name = convective cloud cover in the phy_f3d array @@ -958,6 +1002,7 @@ type = real kind = kind_phys intent = in + optional = True [qgrs] standard_name = tracer_concentration long_name = model layer mean tracer concentration @@ -1013,6 +1058,7 @@ type = real kind = kind_phys intent = inout + optional = True [effri_inout] standard_name = effective_radius_of_stratiform_cloud_ice_particle long_name = eff. radius of cloud ice water particle in micrometer @@ -1021,6 +1067,7 @@ type = real kind = kind_phys intent = inout + optional = True [effrs_inout] standard_name = effective_radius_of_stratiform_cloud_snow_particle long_name = effective radius of cloud snow particle in micrometers @@ -1029,6 +1076,7 @@ type = real kind = kind_phys intent = inout + optional = True [clouds1] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -1077,6 +1125,7 @@ type = real kind = kind_phys intent = in + optional = True [kd] standard_name = vertical_index_difference_between_inout_and_local long_name = vertical index difference between in/out and local @@ -1456,6 +1505,7 @@ type = real kind = kind_phys intent = out + optional = True [top_at_1] standard_name = flag_for_vertical_ordering_in_radiation long_name = flag for vertical ordering in radiation @@ -1508,6 +1558,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_rad] standard_name = control_for_radiation_spp_perturbations long_name = control for radiation spp perturbations diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 index e48a60ac8..4d1391e20 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.F90 @@ -171,8 +171,6 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 - - if (is_initialized) return if (do_RRTMGP) then write(errmsg,'(*(a))') "Logic error: do_RRTMGP must be set to .false." @@ -186,12 +184,6 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & iaerflg = mod(iaer, 1000) endif iaermdl = iaer/1000 ! control flag for aerosol scheme selection - if ( iaermdl < 0 .or. (iaermdl>2 .and. iaermdl/=5) ) then - print *, ' Error -- IAER flag is incorrect, Abort' - errflg = 1 - errmsg = 'ERROR(GFS_rrtmg_setup): IAER flag is incorrect' - return - endif ! --- assign initial permutation seed for mcica cloud-radiation if ( isubcsw>0 .or. isubclw>0 ) then @@ -213,19 +205,30 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & print *, 'lextop=',lextop, ' ltp=',ltp endif + if (is_initialized) return + ! Call initialization routines call sol_init ( me, isol, solar_file, con_solr_2008,con_solr_2002,& con_pi ) call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file, & con_pi, con_t0c, con_c, con_boltz, con_plnk, errflg, errmsg) + if(errflg/=0) return + call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg ) + if(errflg/=0) return + call cld_init ( si, levr, imp_physics, me, con_g, con_rd, errflg, errmsg) + if(errflg/=0) return + call rlwinit ( me, rad_hr_units, inc_minor_gas, icliq_lw, isubcsw, & iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, & iovr_exp, iovr_exprand, errflg, errmsg ) + if(errflg/=0) return + call rswinit ( me, rad_hr_units, inc_minor_gas, icliq_sw, isubclw, & iovr, iovr_rand, iovr_maxrand, iovr_max, iovr_dcorr, & iovr_exp, iovr_exprand,iswmode, errflg, errmsg ) + if(errflg/=0) return if ( me == 0 ) then print *,' Radiation sub-cloud initial seed =',ipsd0, & @@ -235,8 +238,6 @@ subroutine GFS_rrtmg_setup_init ( si, levr, ictm, isol, solar_file, ico2, & ! is_initialized = .true. ! - return - end subroutine GFS_rrtmg_setup_init !> \section arg_table_GFS_rrtmg_setup_timestep_init Argument Table @@ -446,6 +447,7 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& ! --- outputs: & slag,sdec,cdec,solcon,con_pi,errmsg,errflg & & ) + if(errflg/=0) return endif ! end_if_lsswr_block @@ -453,6 +455,7 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& !! time interpolation if ( lmon_chg ) then call aer_update ( iyear, imon, me, iaermdl, aeros_file, errflg, errmsg ) + if(errflg/=0) return endif !> -# Call co2 and other gases update routine: @@ -466,6 +469,8 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& call gas_update ( kyear,kmon,kday,khour,lco2_chg, me, co2dat_file, & co2gbl_file, ictm, ico2, errflg, errmsg ) + if(errflg/=0) return + if (ntoz == 0) then call ozphys%update_o3clim(kmon, kday, khour, loz1st) endif @@ -478,7 +483,6 @@ subroutine radupdate( idate,jdate,deltsw,deltim,lsswr,me, iaermdl,& !> -# Call clouds update routine (currently not needed) ! call cld_update ( iyear, imon, me ) ! - return !................................... end subroutine radupdate !----------------------------------- diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta index 7f7ad7532..a8030d969 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_setup.meta @@ -1,12 +1,12 @@ [ccpp-table-properties] name = GFS_rrtmg_setup type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F dependencies = Radiation/radiation_aerosols.f dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f dependencies = Radiation/RRTMG/radlw_main.F90,Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_main.F90,Radiation/RRTMG/radsw_param.f - dependencies = MP/Thompson/module_mp_thompson.F90,photochem/module_ozphys.F90 + dependencies = MP/module_mp_radar.F90,MP/Thompson/module_mp_thompson.F90,photochem/module_ozphys.F90 ######################################################################## [ccpp-arg-table] @@ -364,7 +364,7 @@ intent = in [ipsd0] standard_name = initial_seed_for_mcica - long_name = initial permutaion seed for mcica radiation + long_name = initial permutation seed for mcica radiation units = 1 dimensions = () type = integer diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 index 79ae1559a..a335f56a4 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 @@ -1,8 +1,5 @@ !> \file GFS_rrtmgp_cloud_mp.F90 -!! -!> \defgroup GFS_rrtmgp_cloud_mp GFS_rrtmgp_cloud_mp.F90 -!! -!! \brief This module contains the interface for ALL cloud microphysics assumptions and +!! This module contains the interface for ALL cloud microphysics assumptions and !! the RRTMGP radiation scheme. Specific details below in subroutines. !! module GFS_rrtmgp_cloud_mp @@ -20,28 +17,23 @@ module GFS_rrtmgp_cloud_mp real (kind_phys), parameter :: & cld_limit_lower = 0.001, & cld_limit_ovcst = 1.0 - 1.0e-8, & - reliq_def = 10.0 , & ! Default liq radius to 10 micron (used when effr_in=F) - reice_def = 50.0, & ! Default ice radius to 50 micron (used when effr_in=F) - rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) - resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) - reice_min = 10.0, & ! Minimum ice size allowed by GFDL MP scheme - reice_max = 150.0 ! Maximum ice size allowed by GFDL MP scheme + reliq_def = 10.0 , & !< Default liq radius to 10 micron (used when effr_in=F) + reice_def = 50.0, & !< Default ice radius to 50 micron (used when effr_in=F) + rerain_def = 1000.0, & !< Default rain radius to 1000 micron (used when effr_in=F) + resnow_def = 250.0, & !< Default snow radius to 250 micron (used when effr_in=F) + reice_min = 10.0, & !< Minimum ice size allowed by GFDL MP scheme + reice_max = 150.0 !< Maximum ice size allowed by GFDL MP scheme public GFS_rrtmgp_cloud_mp_init, GFS_rrtmgp_cloud_mp_run, GFS_rrtmgp_cloud_mp_finalize contains -!>\defgroup gfs_rrtmgp_cloud_mp_mod GFS RRTMGP Cloud MP Module -!! \section arg_table_GFS_rrtmgp_cloud_mp_run -!! \htmlinclude GFS_rrtmgp_cloud_mp_run_html -!! -!> \ingroup GFS_rrtmgp_cloud_mp -!! -!! Here the cloud-radiative properties (optical-path, particle-size and sometimes cloud- +!> Here the cloud-radiative properties (optical-path, particle-size and sometimes cloud- !! fraction) are computed for cloud producing physics schemes (e.g GFDL-MP, Thompson-MP, !! MYNN-EDMF-pbl, GF-convective, and SAMF-convective clouds). +!> \section arg_table_GFS_rrtmgp_cloud_mp_run Argument Table +!! \htmlinclude GFS_rrtmgp_cloud_mp_run.html !! -!! \section GFS_rrtmgp_cloud_mp_run subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, & i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, i_cldice_nc, i_twa, kdt, & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_samf, doSWrad, doLWrad, effr_in, lmfshal, & @@ -50,8 +42,7 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic relhum, lsmask, xlon, xlat, dx, tv_lay, effrin_cldliq, effrin_cldice, & effrin_cldrain, effrin_cldsnow, tracer, cnv_mixratio, cld_cnv_frac, qci_conv, & deltaZ, deltaZc, deltaP, qc_mynn, qi_mynn, cld_pbl_frac, con_g, con_rd, con_eps, & - con_ttp, doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_smearclds, & - cld_frac, cld_lwp, cld_reliq, & + con_ttp, doGP_smearclds, cld_frac, cld_lwp, cld_reliq, & cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, precip_frac, & cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, cld_pbl_lwp, & cld_pbl_reliq, cld_pbl_iwp, cld_pbl_reice, lwp_ex, iwp_ex, lwp_fc, iwp_fc, & @@ -60,109 +51,111 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic ! Inputs integer, intent(in) :: & - nCol, & ! Number of horizontal grid points - nLev, & ! Number of vertical layers - ncnd, & ! Number of cloud condensation types. - nTracers, & ! Number of tracers from model. - i_cldliq, & ! Index into tracer array for cloud liquid. - i_cldice, & ! Index into tracer array for cloud ice. - i_cldrain, & ! Index into tracer array for cloud rain. - i_cldsnow, & ! Index into tracer array for cloud snow. - i_cldgrpl, & ! Index into tracer array for cloud groupel. - i_cldtot, & ! Index into tracer array for cloud total amount. - i_cldliq_nc, & ! cloud liquid number concentration. - i_cldice_nc, & ! cloud ice number concentration. - i_twa, & ! water friendly aerosol. - imfdeepcnv, & ! Choice of mass-flux deep convection scheme - imfdeepcnv_gf, & ! Flag for Grell-Freitas deep convection scheme - imfdeepcnv_samf, & ! Flag for scale awware mass flux convection scheme - kdt, & ! Current forecast iteration - imp_physics, & ! Choice of microphysics scheme - imp_physics_thompson, & ! Choice of Thompson - imp_physics_gfdl, & ! Choice of GFDL - icloud ! Control for cloud are fraction option + nCol, & !< Number of horizontal grid points + nLev, & !< Number of vertical layers + ncnd, & !< Number of cloud condensation types. + nTracers, & !< Number of tracers from model. + i_cldliq, & !< Index into tracer array for cloud liquid. + i_cldice, & !< Index into tracer array for cloud ice. + i_cldrain, & !< Index into tracer array for cloud rain. + i_cldsnow, & !< Index into tracer array for cloud snow. + i_cldgrpl, & !< Index into tracer array for cloud groupel. + i_cldtot, & !< Index into tracer array for cloud total amount. + i_cldliq_nc, & !< cloud liquid number concentration. + i_cldice_nc, & !< cloud ice number concentration. + i_twa, & !< water friendly aerosol. + imfdeepcnv, & !< Choice of mass-flux deep convection scheme + imfdeepcnv_gf, & !< Flag for Grell-Freitas deep convection scheme + imfdeepcnv_samf, & !< Flag for scale awware mass flux convection scheme + kdt, & !< Current forecast iteration + imp_physics, & !< Choice of microphysics scheme + imp_physics_thompson, & !< Choice of Thompson + imp_physics_gfdl, & !< Choice of GFDL + icloud !< Control for cloud are fraction option logical, intent(in) :: & - doSWrad, & ! Call SW radiation? - doLWrad, & ! Call LW radiation? - effr_in, & ! Provide hydrometeor radii from macrophysics? - lmfshal, & ! Flag for mass-flux shallow convection scheme used by Xu-Randall - ltaerosol, & ! Flag for aerosol option - mraerosol, & ! Flag for aerosol option - lgfdlmprad, & ! Flag for GFDLMP radiation interaction - do_mynnedmf, & ! Flag to activate MYNN-EDMF - uni_cld, & ! Flag for unified cloud scheme - lmfdeep2, & ! Flag for mass flux deep convection - doGP_cldoptics_LUT, & ! Flag to do GP cloud-optics (LUTs) - doGP_cldoptics_PADE, & ! (PADE approximation) - doGP_smearclds ! If true, add sgs clouds to gridmean clouds + doSWrad, & !< Call SW radiation? + doLWrad, & !< Call LW radiation? + effr_in, & !< Provide hydrometeor radii from macrophysics? + lmfshal, & !< Flag for mass-flux shallow convection scheme used by Xu-Randall + ltaerosol, & !< Flag for aerosol option + mraerosol, & !< Flag for aerosol option + lgfdlmprad, & !< Flag for GFDLMP radiation interaction + do_mynnedmf, & !< Flag to activate MYNN-EDMF + uni_cld, & !< Flag for unified cloud scheme + lmfdeep2, & !< Flag for mass flux deep convection + doGP_smearclds !< If true, add sgs clouds to gridmean clouds real(kind_phys), intent(in) :: & - con_g, & ! Physical constant: gravitational constant - con_rd, & ! Physical constant: gas-constant for dry air - con_ttp, & ! Triple point temperature of water (K) - con_eps ! Physical constant: gas constant air / gas constant H2O + con_g, & !< Physical constant: gravitational constant + con_rd, & !< Physical constant: gas-constant for dry air + con_ttp, & !< Triple point temperature of water (K) + con_eps !< Physical constant: gas constant air / gas constant H2O real(kind_phys), dimension(:), intent(in) :: & - lsmask, & ! Land/Sea mask - xlon, & ! Longitude - xlat, & ! Latitude - dx ! Characteristic grid lengthscale (m) - real(kind_phys), dimension(:,:), intent(in) :: & - tv_lay, & ! Virtual temperature (K) - t_lay, & ! Temperature (K) - qs_lay, & ! Saturation vapor pressure (Pa) - q_lay, & ! water-vapor mixing ratio (kg/kg) - relhum, & ! Relative humidity - p_lay, & ! Pressure at model-layers (Pa) - cnv_mixratio, & ! Convective cloud mixing-ratio (kg/kg) - qci_conv, & ! Convective cloud condesate after rainout (kg/kg) - deltaZ, & ! Layer-thickness (m) - deltaZc, & ! Layer-thickness, from layer centers (m) - deltaP, & ! Layer-thickness (Pa) - qc_mynn, & ! - qi_mynn, & ! - cld_pbl_frac ! - real(kind_phys), dimension(:,:), intent(inout) :: & - effrin_cldliq, & ! Effective radius for stratiform liquid cloud-particles (microns) - effrin_cldice, & ! Effective radius for stratiform ice cloud-particles (microns) - effrin_cldsnow ! Effective radius for stratiform snow cloud-particles (microns) + lsmask, & !< Land/Sea mask + xlon, & !< Longitude + xlat, & !< Latitude + dx !< Characteristic grid lengthscale (m) + real(kind_phys), dimension(:,:), intent(in), optional :: & + tv_lay, & !< Virtual temperature (K) + t_lay, & !< Temperature (K) + qs_lay, & !< Saturation vapor pressure (Pa) + q_lay, & !< water-vapor mixing ratio (kg/kg) + relhum, & !< Relative humidity + p_lay !< Pressure at model-layers (Pa) real(kind_phys), dimension(:,:), intent(in) :: & - effrin_cldrain ! Effective radius for stratiform rain cloud-particles (microns) - real(kind_phys), dimension(:,:), intent(in) :: & - p_lev ! Pressure at model-level interfaces (Pa) + cnv_mixratio !< Convective cloud mixing-ratio (kg/kg) + real(kind_phys), dimension(:,:), intent(in), optional :: & + qci_conv, & !< Convective cloud condesate after rainout (kg/kg) + deltaZ, & !< Layer-thickness (m) + deltaZc, & !< Layer-thickness, from layer centers (m) + deltaP, & !< Layer-thickness (Pa) + qc_mynn, & !< + qi_mynn !< + real(kind_phys), dimension(:,:), intent(in), optional :: & + cld_pbl_frac !< + real(kind_phys), dimension(:,:), intent(inout), optional :: & + effrin_cldliq, & !< Effective radius for stratiform liquid cloud-particles (microns) + effrin_cldice, & !< Effective radius for stratiform ice cloud-particles (microns) + effrin_cldsnow !< Effective radius for stratiform snow cloud-particles (microns) + real(kind_phys), dimension(:,:), intent(in), optional :: & + effrin_cldrain !< Effective radius for stratiform rain cloud-particles (microns) + real(kind_phys), dimension(:,:), intent(in), optional :: & + p_lev !< Pressure at model-level interfaces (Pa) real(kind_phys), dimension(:,:,:),intent(in) :: & - tracer ! Cloud condensate amount in layer by type () + tracer !< Cloud condensate amount in layer by type () ! Outputs real(kind_phys), dimension(:), intent(inout) :: & - lwp_ex, & ! Total liquid water path from explicit microphysics - iwp_ex, & ! Total ice water path from explicit microphysics - lwp_fc, & ! Total liquid water path from cloud fraction scheme - iwp_fc ! Total ice water path from cloud fraction scheme + lwp_ex, & !< Total liquid water path from explicit microphysics + iwp_ex, & !< Total ice water path from explicit microphysics + lwp_fc, & !< Total liquid water path from cloud fraction scheme + iwp_fc !< Total ice water path from cloud fraction scheme real(kind_phys), dimension(:), intent(out) :: & - cldfra2d ! Instantaneous 2D (max-in-column) cloud fraction + cldfra2d !< Instantaneous 2D (max-in-column) cloud fraction real(kind_phys), dimension(:,:),intent(inout) :: & - cld_frac, & ! Cloud-fraction for stratiform clouds - cld_lwp, & ! Water path for stratiform liquid cloud-particles - cld_reliq, & ! Effective radius for stratiform liquid cloud-particles - cld_iwp, & ! Water path for stratiform ice cloud-particles - cld_reice, & ! Effective radius for stratiform ice cloud-particles - cld_swp, & ! Water path for snow hydrometeors - cld_resnow, & ! Effective radius for snow hydrometeors - cld_rwp, & ! Water path for rain hydrometeors - cld_rerain, & ! Effective radius for rain hydrometeors - precip_frac, & ! Precipitation fraction - cld_cnv_frac, & ! Cloud-fraction for convective clouds - cld_cnv_lwp, & ! Water path for convective liquid cloud-particles - cld_cnv_reliq, & ! Effective radius for convective liquid cloud-particles - cld_cnv_iwp, & ! Water path for convective ice cloud-particles - cld_cnv_reice, & ! Effective radius for convective ice cloud-particles - cld_pbl_lwp, & ! Water path for SGS PBL liquid cloud-particles - cld_pbl_reliq, & ! Effective radius for SGS PBL liquid cloud-particles - cld_pbl_iwp, & ! Water path for SGS PBL ice cloud-particles - cld_pbl_reice ! Effective radius for SGS PBL ice cloud-particles + cld_frac, & !< Cloud-fraction for stratiform clouds + cld_lwp, & !< Water path for stratiform liquid cloud-particles + cld_reliq, & !< Effective radius for stratiform liquid cloud-particles + cld_iwp, & !< Water path for stratiform ice cloud-particles + cld_reice, & !< Effective radius for stratiform ice cloud-particles + cld_swp, & !< Water path for snow hydrometeors + cld_resnow, & !< Effective radius for snow hydrometeors + cld_rwp, & !< Water path for rain hydrometeors + cld_rerain !< Effective radius for rain hydrometeors + real(kind_phys), dimension(:,:),intent(inout), optional :: & + precip_frac, & !< Precipitation fraction + cld_cnv_frac, & !< Cloud-fraction for convective clouds + cld_cnv_lwp, & !< Water path for convective liquid cloud-particles + cld_cnv_reliq, & !< Effective radius for convective liquid cloud-particles + cld_cnv_iwp, & !< Water path for convective ice cloud-particles + cld_cnv_reice, & !< Effective radius for convective ice cloud-particles + cld_pbl_lwp, & !< Water path for SGS PBL liquid cloud-particles + cld_pbl_reliq, & !< Effective radius for SGS PBL liquid cloud-particles + cld_pbl_iwp, & !< Water path for SGS PBL ice cloud-particles + cld_pbl_reice !< Effective radius for SGS PBL ice cloud-particles character(len=*), intent(out) :: & - errmsg ! Error message + errmsg !< Error message integer, intent(out) :: & - errflg ! Error flag + errflg !< Error flag ! Local integer :: iCol, iLay @@ -279,23 +272,21 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from ! 2.5 - 21.5 microns for liquid clouds, ! 10 - 180 microns for ice-clouds - if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then - where(cld_reliq .lt. radliq_lwr) cld_reliq = radliq_lwr - where(cld_reliq .gt. radliq_upr) cld_reliq = radliq_upr - where(cld_reice .lt. radice_lwr) cld_reice = radice_lwr - where(cld_reice .gt. radice_upr) cld_reice = radice_upr - if (imfdeepcnv == imfdeepcnv_samf .or. imfdeepcnv == imfdeepcnv_gf) then - where(cld_cnv_reliq .lt. radliq_lwr) cld_cnv_reliq = radliq_lwr - where(cld_cnv_reliq .gt. radliq_upr) cld_cnv_reliq = radliq_upr - where(cld_cnv_reice .lt. radice_lwr) cld_cnv_reice = radice_lwr - where(cld_cnv_reice .gt. radice_upr) cld_cnv_reice = radice_upr - endif - if (do_mynnedmf) then - where(cld_pbl_reliq .lt. radliq_lwr) cld_pbl_reliq = radliq_lwr - where(cld_pbl_reliq .gt. radliq_upr) cld_pbl_reliq = radliq_upr - where(cld_pbl_reice .lt. radice_lwr) cld_pbl_reice = radice_lwr - where(cld_pbl_reice .gt. radice_upr) cld_pbl_reice = radice_upr - endif + where(cld_reliq .lt. radliq_lwr) cld_reliq = radliq_lwr + where(cld_reliq .gt. radliq_upr) cld_reliq = radliq_upr + where(cld_reice .lt. radice_lwr) cld_reice = radice_lwr + where(cld_reice .gt. radice_upr) cld_reice = radice_upr + if (imfdeepcnv == imfdeepcnv_samf .or. imfdeepcnv == imfdeepcnv_gf) then + where(cld_cnv_reliq .lt. radliq_lwr) cld_cnv_reliq = radliq_lwr + where(cld_cnv_reliq .gt. radliq_upr) cld_cnv_reliq = radliq_upr + where(cld_cnv_reice .lt. radice_lwr) cld_cnv_reice = radice_lwr + where(cld_cnv_reice .gt. radice_upr) cld_cnv_reice = radice_upr + endif + if (do_mynnedmf) then + where(cld_pbl_reliq .lt. radliq_lwr) cld_pbl_reliq = radliq_lwr + where(cld_pbl_reliq .gt. radliq_upr) cld_pbl_reliq = radliq_upr + where(cld_pbl_reice .lt. radice_lwr) cld_pbl_reice = radice_lwr + where(cld_pbl_reice .gt. radice_upr) cld_pbl_reice = radice_upr endif ! Instantaneous 2D (max-in-column) cloud fraction @@ -310,8 +301,7 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic end subroutine GFS_rrtmgp_cloud_mp_run -!> \ingroup GFS_rrtmgp_cloud_mp -!! Compute cloud radiative properties for Grell-Freitas convective cloud scheme. +!> Compute cloud radiative properties for Grell-Freitas convective cloud scheme. !! (Adopted from module_SGSCloud_RadPre) !! !! - The total convective cloud condensate is partitoned by phase, using temperature, into @@ -325,7 +315,6 @@ end subroutine GFS_rrtmgp_cloud_mp_run !! Xu-Randall? Xu-Randall is consistent with the Thompson MP scheme, but !! not GFDL-EMC) !! -!! \section cloud_mp_GF_gen General Algorithm subroutine cloud_mp_GF(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum, & qci_conv, con_ttp, con_g, alpha0, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, & cld_cnv_reice, cld_cnv_frac) @@ -333,28 +322,28 @@ subroutine cloud_mp_GF(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum, ! Inputs integer, intent(in) :: & - nCol, & ! Number of horizontal grid points - nLev ! Number of vertical layers + nCol, & !< Number of horizontal grid points + nLev !< Number of vertical layers real(kind_phys), dimension(:), intent(in) :: & - lsmask ! Land/Sea mask + lsmask !< Land/Sea mask real(kind_phys), intent(in) :: & - con_g, & ! Physical constant: gravitational constant - con_ttp, & ! Triple point temperature of water (K) - alpha0 ! + con_g, & !< Physical constant: gravitational constant + con_ttp, & !< Triple point temperature of water (K) + alpha0 !< real(kind_phys), dimension(:,:),intent(in) :: & - t_lay, & ! Temperature at layer centers (K) - p_lev, & ! Pressure at layer interfaces (Pa) - p_lay, & ! - qs_lay, & ! - relhum, & ! - qci_conv ! + t_lay, & !< Temperature at layer centers (K) + p_lev, & !< Pressure at layer interfaces (Pa) + p_lay, & !< + qs_lay, & !< + relhum, & !< + qci_conv !< ! Outputs real(kind_phys), dimension(:,:),intent(inout) :: & - cld_cnv_lwp, & ! Convective cloud liquid water path - cld_cnv_reliq, & ! Convective cloud liquid effective radius - cld_cnv_iwp, & ! Convective cloud ice water path - cld_cnv_reice, & ! Convective cloud ice effecive radius - cld_cnv_frac ! Convective cloud-fraction (1) + cld_cnv_lwp, & !< Convective cloud liquid water path + cld_cnv_reliq, & !< Convective cloud liquid effective radius + cld_cnv_iwp, & !< Convective cloud ice water path + cld_cnv_reice, & !< Convective cloud ice effecive radius + cld_cnv_frac !< Convective cloud-fraction (1) ! Local integer :: iCol, iLay real(kind_phys) :: tem1, deltaP, clwc, qc, qi @@ -390,8 +379,7 @@ subroutine cloud_mp_GF(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum, enddo end subroutine cloud_mp_GF -!> \ingroup GFS_rrtmgp_cloud_mp -!! Compute cloud radiative properties for MYNN-EDMF PBL cloud scheme. +!> Compute cloud radiative properties for MYNN-EDMF PBL cloud scheme. !! (Adopted from module_SGSCloud_RadPre) !! !! - Cloud-fraction, liquid, and ice condensate mixing-ratios from MYNN-EDMF cloud scheme @@ -400,7 +388,6 @@ end subroutine cloud_mp_GF !! - The liquid and ice cloud effective particle sizes are assigned reference values*. !! *TODO* Find references, include DOIs, parameterize magic numbers, etc... !! -!! \section cloud_mp_MYNN_gen General Algorithm subroutine cloud_mp_MYNN(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum, & qc_mynn, qi_mynn, con_ttp, con_g, cld_pbl_lwp, cld_pbl_reliq, cld_pbl_iwp, & cld_pbl_reice, cld_pbl_frac) @@ -408,28 +395,28 @@ subroutine cloud_mp_MYNN(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum ! Inputs integer, intent(in) :: & - nCol, & ! Number of horizontal grid points - nLev ! Number of vertical layers + nCol, & !< Number of horizontal grid points + nLev !< Number of vertical layers real(kind_phys), dimension(:), intent(in) :: & - lsmask ! Land/Sea mask + lsmask !< Land/Sea mask real(kind_phys), intent(in) :: & - con_g, & ! Physical constant: gravitational constant - con_ttp ! Triple point temperature of water (K) + con_g, & !< Physical constant: gravitational constant + con_ttp !< Triple point temperature of water (K) real(kind_phys), dimension(:,:),intent(in) :: & - t_lay, & ! Temperature at layer centers (K) - p_lev, & ! Pressure at layer interfaces (Pa) - p_lay, & ! - qs_lay, & ! - relhum, & ! - qc_mynn, & ! Liquid cloud mixing-ratio (MYNN PBL cloud) - qi_mynn, & ! Ice cloud mixing-ratio (MYNN PBL cloud) - cld_pbl_frac ! Cloud-fraction (MYNN PBL cloud) + t_lay, & !< Temperature at layer centers (K) + p_lev, & !< Pressure at layer interfaces (Pa) + p_lay, & !< + qs_lay, & !< + relhum, & !< + qc_mynn, & !< Liquid cloud mixing-ratio (MYNN PBL cloud) + qi_mynn, & !< Ice cloud mixing-ratio (MYNN PBL cloud) + cld_pbl_frac !< Cloud-fraction (MYNN PBL cloud) ! Outputs real(kind_phys), dimension(:,:),intent(inout) :: & - cld_pbl_lwp, & ! Convective cloud liquid water path - cld_pbl_reliq, & ! Convective cloud liquid effective radius - cld_pbl_iwp, & ! Convective cloud ice water path - cld_pbl_reice ! Convective cloud ice effecive radius + cld_pbl_lwp, & !< Convective cloud liquid water path + cld_pbl_reliq, & !< Convective cloud liquid effective radius + cld_pbl_iwp, & !< Convective cloud ice water path + cld_pbl_reice !< Convective cloud ice effecive radius ! Local integer :: iCol, iLay @@ -463,8 +450,7 @@ subroutine cloud_mp_MYNN(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum end subroutine cloud_mp_MYNN -!> \ingroup GFS_rrtmgp_cloud_mp -!! Compute cloud radiative properties for SAMF convective cloud scheme. +!> Compute cloud radiative properties for SAMF convective cloud scheme. !! !! - The total-cloud convective mixing-ratio is partitioned by phase into liquid/ice !! cloud properties. LWP and IWP are computed. @@ -474,7 +460,6 @@ end subroutine cloud_mp_MYNN !! - The convective cloud-fraction is computed using Xu-Randall (1996). !! (DJS asks: Does the SAMF scheme produce a cloud-fraction?) !! -!! \section cloud_mp_SAMF_gen General Algorithm subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, & cnv_mixratio, con_ttp, con_g, alpha0, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, & cld_cnv_reice, cld_cnv_frac) @@ -482,26 +467,26 @@ subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, ! Inputs integer, intent(in) :: & - nCol, & ! Number of horizontal grid points - nLev ! Number of vertical layers + nCol, & !< Number of horizontal grid points + nLev !< Number of vertical layers real(kind_phys), intent(in) :: & - con_g, & ! Physical constant: gravity (m s-2) - con_ttp, & ! Triple point temperature of water (K) - alpha0 ! + con_g, & !< Physical constant: gravity (m s-2) + con_ttp, & !< Triple point temperature of water (K) + alpha0 !< real(kind_phys), dimension(:,:),intent(in) :: & - t_lay, & ! Temperature at layer-centers (K) - p_lev, & ! Pressure at layer-interfaces (Pa) - p_lay, & ! Presure at layer-centers (Pa) - qs_lay, & ! Specific-humidity at layer-centers (kg/kg) - relhum, & ! Relative-humidity (1) - cnv_mixratio ! Convective cloud mixing-ratio (kg/kg) + t_lay, & !< Temperature at layer-centers (K) + p_lev, & !< Pressure at layer-interfaces (Pa) + p_lay, & !< Presure at layer-centers (Pa) + qs_lay, & !< Specific-humidity at layer-centers (kg/kg) + relhum, & !< Relative-humidity (1) + cnv_mixratio !< Convective cloud mixing-ratio (kg/kg) ! Outputs real(kind_phys), dimension(:,:),intent(inout) :: & - cld_cnv_lwp, & ! Convective cloud liquid water path - cld_cnv_reliq, & ! Convective cloud liquid effective radius - cld_cnv_iwp, & ! Convective cloud ice water path - cld_cnv_reice, & ! Convective cloud ice effecive radius - cld_cnv_frac ! Convective cloud-fraction + cld_cnv_lwp, & !< Convective cloud liquid water path + cld_cnv_reliq, & !< Convective cloud liquid effective radius + cld_cnv_iwp, & !< Convective cloud ice water path + cld_cnv_reice, & !< Convective cloud ice effecive radius + cld_cnv_frac !< Convective cloud-fraction ! Local integer :: iCol, iLay real(kind_phys) :: tem0, tem1, deltaP, clwc @@ -527,12 +512,10 @@ subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, end subroutine cloud_mp_SAMF -!> \ingroup GFS_rrtmgp_cloud_mp -!! This routine computes the cloud radiative properties for a "unified cloud". +!> This routine computes the cloud radiative properties for a "unified cloud". !! - "unified cloud" implies that the cloud-fraction is PROVIDED. !! - The cloud water path is computed for all provided cloud mixing-ratios and hydrometeors. !! - If particle sizes are provided, they are used. If not, default values are assigned. -!! \section cloud_mp_uni_gen General Algorithm subroutine cloud_mp_uni(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_cldrain, & i_cldsnow, i_cldgrpl, i_cldtot, effr_in, kdt, lsmask, p_lev, p_lay, t_lay, tv_lay,& effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, con_g, con_rd, con_ttp, & @@ -542,50 +525,50 @@ subroutine cloud_mp_uni(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_cldrai ! Inputs integer, intent(in) :: & - nCol, & ! Number of horizontal grid points - nLev, & ! Number of vertical layers - ncnd, & ! Number of cloud condensation types. - nTracers, & ! Number of tracers from model. - i_cldliq, & ! Index into tracer array for cloud liquid. - i_cldice, & ! Index into tracer array for cloud ice. - i_cldrain, & ! Index into tracer array for cloud rain. - i_cldsnow, & ! Index into tracer array for cloud snow. - i_cldgrpl, & ! Index into tracer array for cloud groupel. - i_cldtot, & ! Index into tracer array for cloud total amount. + nCol, & !< Number of horizontal grid points + nLev, & !< Number of vertical layers + ncnd, & !< Number of cloud condensation types. + nTracers, & !< Number of tracers from model. + i_cldliq, & !< Index into tracer array for cloud liquid. + i_cldice, & !< Index into tracer array for cloud ice. + i_cldrain, & !< Index into tracer array for cloud rain. + i_cldsnow, & !< Index into tracer array for cloud snow. + i_cldgrpl, & !< Index into tracer array for cloud groupel. + i_cldtot, & !< Index into tracer array for cloud total amount. kdt logical, intent(in) :: & - effr_in ! Provide hydrometeor radii from macrophysics? + effr_in !< Provide hydrometeor radii from macrophysics? real(kind_phys), intent(in) :: & - con_g, & ! Physical constant: gravitational constant - con_ttp, & ! Triple point temperature of water (K) - con_rd ! Physical constant: gas-constant for dry air + con_g, & !< Physical constant: gravitational constant + con_ttp, & !< Triple point temperature of water (K) + con_rd !< Physical constant: gas-constant for dry air real(kind_phys), dimension(:), intent(in) :: & lsmask real(kind_phys), dimension(:,:), intent(in) :: & - t_lay, & ! Temperature at model-layers (K) - tv_lay, & ! Virtual temperature (K) - p_lay, & ! Pressure at model-layers (Pa) - cld_frac, & ! Total cloud fraction - effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) - effrin_cldice, & ! Effective radius for ice cloud-particles (microns) - effrin_cldsnow ! Effective radius for snow cloud-particles (microns) - real(kind_phys), dimension(:,:), intent(in) ,optional :: & - effrin_cldrain ! Effective radius for rain cloud-particles (microns) + t_lay, & !< Temperature at model-layers (K) + tv_lay, & !< Virtual temperature (K) + p_lay, & !< Pressure at model-layers (Pa) + cld_frac, & !< Total cloud fraction + effrin_cldliq, & !< Effective radius for liquid cloud-particles (microns) + effrin_cldice, & !< Effective radius for ice cloud-particles (microns) + effrin_cldsnow !< Effective radius for snow cloud-particles (microns) + real(kind_phys), dimension(:,:), intent(in), optional :: & + effrin_cldrain !< Effective radius for rain cloud-particles (microns) real(kind_phys), dimension(:,:), intent(in) :: & - p_lev ! Pressure at model-level interfaces (Pa) + p_lev !< Pressure at model-level interfaces (Pa) real(kind_phys), dimension(:,:,:),intent(in) :: & - tracer ! Cloud condensate amount in layer by type () + tracer !< Cloud condensate amount in layer by type () ! Outputs real(kind_phys), dimension(:,:),intent(inout) :: & - cld_lwp, & ! Cloud liquid water path - cld_reliq, & ! Cloud liquid effective radius - cld_iwp, & ! Cloud ice water path - cld_reice, & ! Cloud ice effecive radius - cld_swp, & ! Cloud snow water path - cld_resnow, & ! Cloud snow effective radius - cld_rwp, & ! Cloud rain water path - cld_rerain ! Cloud rain effective radius + cld_lwp, & !< Cloud liquid water path + cld_reliq, & !< Cloud liquid effective radius + cld_iwp, & !< Cloud ice water path + cld_reice, & !< Cloud ice effecive radius + cld_swp, & !< Cloud snow water path + cld_resnow, & !< Cloud snow effective radius + cld_rwp, & !< Cloud rain water path + cld_rerain !< Cloud rain effective radius ! Local variables real(kind_phys) :: tem1,tem2,tem3,pfac,deltaP @@ -658,8 +641,8 @@ subroutine cloud_mp_uni(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_cldrai enddo ! nLev end subroutine cloud_mp_uni -!> \ingroup GFS_rrtmgp_cloud_mp -!! This routine computes the cloud radiative properties for the Thompson cloud micro- + +!> This routine computes the cloud radiative properties for the Thompson cloud micro- !! physics scheme. !! !! - The cloud water path is computed for all provided cloud mixing-ratios and hydrometeors. @@ -670,7 +653,6 @@ end subroutine cloud_mp_uni !! - The cloud-fraction is computed using Xu-Randall** (1996). !! **Additionally, Conditioned on relative-humidity** !! -!! \section cloud_mp_thompson_gen General Algorithm subroutine cloud_mp_thompson(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_cldrain,& i_cldsnow, i_cldgrpl, p_lev, p_lay, tv_lay, t_lay, tracer, qs_lay, q_lay, relhum, & con_ttp, con_g, con_rd, con_eps, alpha0, cnv_mixratio, lwp_ex, iwp_ex, lwp_fc, & @@ -679,49 +661,49 @@ subroutine cloud_mp_thompson(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_c ! Inputs logical, intent(in), optional :: & - cond_cfrac_onRH, & ! If true, cloud-fracion set to unity when rh>99% - doGP_smearclds ! If true, add sgs clouds to gridmean clouds + cond_cfrac_onRH, & !< If true, cloud-fracion set to unity when rh>99% + doGP_smearclds !< If true, add sgs clouds to gridmean clouds integer, intent(in) :: & - nCol, & ! Number of horizontal grid points - nLev, & ! Number of vertical layers - ncnd, & ! Number of cloud condensation types. - nTracers, & ! Number of tracers from model. - i_cldliq, & ! Index into tracer array for cloud liquid amount. - i_cldice, & ! cloud ice amount. - i_cldrain, & ! cloud rain amount. - i_cldsnow, & ! cloud snow amount. - i_cldgrpl ! cloud groupel amount. + nCol, & !< Number of horizontal grid points + nLev, & !< Number of vertical layers + ncnd, & !< Number of cloud condensation types. + nTracers, & !< Number of tracers from model. + i_cldliq, & !< Index into tracer array for cloud liquid amount. + i_cldice, & !< cloud ice amount. + i_cldrain, & !< cloud rain amount. + i_cldsnow, & !< cloud snow amount. + i_cldgrpl !< cloud groupel amount. real(kind_phys), intent(in) :: & - con_ttp, & ! Triple point temperature of water (K) - con_g, & ! Physical constant: gravitational constant - con_rd, & ! Physical constant: gas-constant for dry air - con_eps, & ! Physical constant: gas constant air / gas constant H2O - alpha0 ! + con_ttp, & !< Triple point temperature of water (K) + con_g, & !< Physical constant: gravitational constant + con_rd, & !< Physical constant: gas-constant for dry air + con_eps, & !< Physical constant: gas constant air / gas constant H2O + alpha0 !< real(kind_phys), dimension(:,:), intent(in) :: & - tv_lay, & ! Virtual temperature (K) - t_lay, & ! Temperature (K) - qs_lay, & ! Saturation vapor pressure (Pa) - q_lay, & ! water-vapor mixing ratio (kg/kg) - relhum, & ! Relative humidity - p_lay, & ! Pressure at model-layers (Pa) - cnv_mixratio ! Convective cloud mixing-ratio (kg/kg) + tv_lay, & !< Virtual temperature (K) + t_lay, & !< Temperature (K) + qs_lay, & !< Saturation vapor pressure (Pa) + q_lay, & !< water-vapor mixing ratio (kg/kg) + relhum, & !< Relative humidity + p_lay, & !< Pressure at model-layers (Pa) + cnv_mixratio !< Convective cloud mixing-ratio (kg/kg) real(kind_phys), dimension(:,:), intent(in) :: & - p_lev ! Pressure at model-level interfaces (Pa) + p_lev !< Pressure at model-level interfaces (Pa) real(kind_phys), dimension(:,:,:),intent(in) :: & - tracer ! Cloud condensate amount in layer by type () + tracer !< Cloud condensate amount in layer by type () ! In/Outs real(kind_phys), dimension(:), intent(inout) :: & - lwp_ex, & ! total liquid water path from explicit microphysics - iwp_ex, & ! total ice water path from explicit microphysics - lwp_fc, & ! total liquid water path from cloud fraction scheme - iwp_fc ! total ice water path from cloud fraction scheme + lwp_ex, & !< total liquid water path from explicit microphysics + iwp_ex, & !< total ice water path from explicit microphysics + lwp_fc, & !< total liquid water path from cloud fraction scheme + iwp_fc !< total ice water path from cloud fraction scheme real(kind_phys), dimension(:,:), intent(inout) :: & - cld_frac, & ! Total cloud fraction - cld_lwp, & ! Cloud liquid water path - cld_iwp, & ! Cloud ice water path - cld_swp, & ! Cloud snow water path - cld_rwp ! Cloud rain water path + cld_frac, & !< Total cloud fraction + cld_lwp, & !< Cloud liquid water path + cld_iwp, & !< Cloud ice water path + cld_swp, & !< Cloud snow water path + cld_rwp !< Cloud rain water path ! Local variables real(kind_phys) :: tem1, pfac, cld_mr, deltaP, tem2 @@ -756,14 +738,10 @@ subroutine cloud_mp_thompson(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_c cld_swp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,4) * tem1 * deltaP) ! Xu-Randall (1996) cloud-fraction. **Additionally, Conditioned on relative-humidity** - if (present(cond_cfrac_onRH) .and. relhum(iCol,iLay) > 0.99) then - cld_frac(iCol,iLay) = 1._kind_phys - else - cld_mr = cld_condensate(iCol,iLay,1) + cld_condensate(iCol,iLay,2) + & - cld_condensate(iCol,iLay,3) + cld_condensate(iCol,iLay,4) - cld_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & - qs_lay(iCol,iLay), relhum(iCol,iLay), cld_mr, alpha0) - endif + cld_mr = cld_condensate(iCol,iLay,1) + cld_condensate(iCol,iLay,2) + & + cld_condensate(iCol,iLay,3) + cld_condensate(iCol,iLay,4) + cld_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & + qs_lay(iCol,iLay), relhum(iCol,iLay), cld_mr, alpha0, cond_cfrac_onRH) enddo enddo @@ -791,23 +769,21 @@ subroutine cloud_mp_thompson(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, i_c end subroutine cloud_mp_thompson -!> \ingroup GFS_rrtmgp_cloud_mp -!! This function computes the cloud-fraction following. -!! Xu-Randall(1996) A Semiempirical Cloudiness Parameterization for Use in Climate Models -!! https://doi.org/10.1175/1520-0469(1996)053<3084:ASCPFU>2.0.CO;2 -!! -!! cld_frac = {1-exp[-alpha*cld_mr/((1-relhum)*qs_lay)**lambda]}*relhum**P +!> This function computes the cloud-fraction following +!! Xu-Randall(1996) \cite xu_and_randall_1996 !! -!! \section cld_frac_XuRandall_gen General Algorithm - function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) + function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha, cond_cfrac_onRH) implicit none ! Inputs + logical, intent(in), optional :: & + cond_cfrac_onRH ! If true, cloud-fracion set to unity when rh>99% + real(kind_phys), intent(in) :: & - p_lay, & ! Pressure (Pa) - qs_lay, & ! Saturation vapor-pressure (Pa) - relhum, & ! Relative humidity - cld_mr, & ! Total cloud mixing ratio - alpha ! Scheme parameter (default=100) + p_lay, & !< Pressure (Pa) + qs_lay, & !< Saturation vapor-pressure (Pa) + relhum, & !< Relative humidity + cld_mr, & !< Total cloud mixing ratio + alpha !< Scheme parameter (default=100) ! Outputs real(kind_phys) :: cld_frac_XuRandall @@ -820,14 +796,18 @@ function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) lambda = 0.50, & ! P = 0.25 - clwt = 1.0e-6 * (p_lay*0.001) + clwt = 1.0e-8 * (p_lay*0.001) if (cld_mr > clwt) then - onemrh = max(1.e-10, 1.0 - relhum) - tem1 = alpha / min(max((onemrh*qs_lay)**lambda,0.0001),1.0) - tem2 = max(min(tem1*(cld_mr - clwt), 50.0 ), 0.0 ) - tem3 = sqrt(sqrt(relhum)) ! This assumes "p" = 0.25. Identical, but cheaper than relhum**p - ! - cld_frac_XuRandall = max( tem3*(1.0-exp(-tem2)), 0.0 ) + if(present(cond_cfrac_onRH) .and. relhum > 0.99) then + cld_frac_XuRandall = 1. + else + onemrh = max(1.e-10, 1.0 - relhum) + tem1 = alpha / min(max((onemrh*qs_lay)**lambda,0.0001),1.0) + tem2 = max(min(tem1*(cld_mr - clwt), 50.0 ), 0.0 ) + tem3 = sqrt(sqrt(relhum)) ! This assumes "p" = 0.25. Identical, but cheaper than relhum**p + ! + cld_frac_XuRandall = max( tem3*(1.0-exp(-tem2)), 0.0 ) + endif else cld_frac_XuRandall = 0.0 endif @@ -835,11 +815,8 @@ function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) return end function - ! ###################################################################################### - ! This routine is a wrapper to update the Thompson effective particle sizes used by the - ! RRTMGP radiation scheme. - ! - ! ###################################################################################### + !> This routine is a wrapper to update the Thompson effective particle sizes used by the + !! RRTMGP radiation scheme. subroutine cmp_reff_Thompson(nLev, nCol, i_cldliq, i_cldice, i_cldsnow, i_cldice_nc, & i_cldliq_nc, i_twa, q_lay, p_lay, t_lay, tracer, con_eps, con_rd, ltaerosol, & mraerosol, lsmask, effrin_cldliq, effrin_cldice, effrin_cldsnow) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta index f67259b87..2b1f60d58 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta @@ -1,10 +1,10 @@ [ccpp-table-properties] name = GFS_rrtmgp_cloud_mp type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F dependencies = Radiation/radiation_tools.F90,Radiation/radiation_clouds.f,Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 - dependencies = MP/Thompson/module_mp_thompson_make_number_concentrations.F90,MP/Thompson/module_mp_thompson.F90 + dependencies = MP/module_mp_radar.F90,MP/Thompson/module_mp_thompson_make_number_concentrations.F90,MP/Thompson/module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] @@ -267,6 +267,7 @@ type = real kind = kind_phys intent = in + optional = True [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation @@ -275,6 +276,7 @@ type = real kind = kind_phys intent = in + optional = True [tv_lay] standard_name = virtual_temperature long_name = layer virtual temperature @@ -283,6 +285,7 @@ type = real kind = kind_phys intent = in + optional = True [t_lay] standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation @@ -291,6 +294,7 @@ type = real kind = kind_phys intent = in + optional = True [qs_lay] standard_name = saturation_vapor_pressure long_name = saturation vapor pressure @@ -299,6 +303,7 @@ type = real kind = kind_phys intent = in + optional = True [q_lay] standard_name = water_vapor_mixing_ratio long_name = water vaport mixing ratio @@ -307,6 +312,7 @@ type = real kind = kind_phys intent = in + optional = True [relhum] standard_name = relative_humidity long_name = layer relative humidity @@ -315,6 +321,7 @@ type = real kind = kind_phys intent = in + optional = True [effrin_cldliq] standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle long_name = eff. radius of cloud liquid water particle in micrometer @@ -323,6 +330,7 @@ type = real kind = kind_phys intent = inout + optional = True [effrin_cldice] standard_name = effective_radius_of_stratiform_cloud_ice_particle long_name = eff. radius of cloud ice water particle in micrometer @@ -331,6 +339,7 @@ type = real kind = kind_phys intent = inout + optional = True [effrin_cldrain] standard_name = effective_radius_of_stratiform_cloud_rain_particle long_name = effective radius of cloud rain particle in micrometers @@ -339,6 +348,7 @@ type = real kind = kind_phys intent = in + optional = True [effrin_cldsnow] standard_name = effective_radius_of_stratiform_cloud_snow_particle long_name = effective radius of cloud snow particle in micrometers @@ -347,6 +357,7 @@ type = real kind = kind_phys intent = inout + optional = True [tracer] standard_name = tracer_concentration long_name = model layer mean tracer concentration @@ -371,6 +382,7 @@ type = real kind = kind_phys intent = inout + optional = True [qci_conv] standard_name = convective_cloud_condesate_after_rainout long_name = convective cloud condesate after rainout @@ -379,6 +391,7 @@ type = real kind = kind_phys intent = in + optional = True [deltaZ] standard_name = layer_thickness long_name = layer_thickness @@ -387,6 +400,7 @@ type = real kind = kind_phys intent = in + optional = True [deltaZc] standard_name = layer_thickness_from_layer_center long_name = layer_thickness @@ -395,6 +409,7 @@ type = real kind = kind_phys intent = in + optional = True [deltaP] standard_name = layer_thickness_in_Pa long_name = layer_thickness_in_Pa @@ -403,6 +418,7 @@ type = real kind = kind_phys intent = in + optional = True [qc_mynn] standard_name = subgrid_scale_cloud_liquid_water_mixing_ratio long_name = subgrid cloud water mixing ratio from PBL scheme @@ -411,6 +427,7 @@ type = real kind = kind_phys intent = in + optional = True [qi_mynn] standard_name = subgrid_scale_cloud_ice_mixing_ratio long_name = subgrid cloud ice mixing ratio from PBL scheme @@ -419,6 +436,7 @@ type = real kind = kind_phys intent = in + optional = True [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -451,20 +469,6 @@ type = real kind = kind_phys intent = in -[doGP_cldoptics_PADE] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[doGP_cldoptics_LUT] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in [doGP_smearclds] standard_name = flag_for_implicit_sgs_cloud_in_RRTMGP long_name = logical flag to impicit SGS cloud in RRTMGP @@ -552,6 +556,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_cnv_lwp] standard_name = convective_cloud_liquid_water_path long_name = layer convective cloud liquid water path @@ -560,6 +565,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_cnv_iwp] standard_name = convective_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -568,6 +574,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_cnv_reliq] standard_name = mean_effective_radius_for_liquid_convective_cloud long_name = mean effective radius for liquid convective cloud @@ -576,6 +583,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_cnv_reice] standard_name = mean_effective_radius_for_ice_convective_cloud long_name = mean effective radius for ice convective cloud @@ -584,6 +592,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_pbl_frac] standard_name = subgrid_scale_cloud_area_fraction_in_atmosphere_layer long_name = subgrid cloud fraction from PBL scheme @@ -592,6 +601,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_lwp] standard_name = MYNN_SGS_cloud_liquid_water_path long_name = layer convective cloud liquid water path @@ -600,6 +610,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_pbl_iwp] standard_name = MYNN_SGS_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -608,6 +619,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_pbl_reliq] standard_name = mean_effective_radius_for_liquid_MYNN_SGS_cloud long_name = mean effective radius for liquid MYNN_SGS cloud @@ -616,6 +628,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_pbl_reice] standard_name = mean_effective_radius_for_ice_MYNN_SGS_cloud long_name = mean effective radius for ice MYNN_SGS cloud @@ -624,6 +637,7 @@ type = real kind = kind_phys intent = inout + optional = True [lwp_ex] standard_name = liq_water_path_from_microphysics long_name = total liquid water path from explicit microphysics diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90 index 0094f8165..069f7545c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.F90 @@ -1,8 +1,5 @@ !> \file GFS_rrtmgp_cloud_overlap.F90 -!! -!> \defgroup GFS_rrtmgp_cloud_overlap GFS_rrtmgp_cloud_overlap.F90 -!! -!! \brief This module contains EMC's interface to the different assumptions of vertical cloud +!! This file contains EMC's interface to the different assumptions of vertical cloud !! structuce, cloud overlap, used by McICA for cloud sampling in the RRTMGP longwave !! and shortwave schemes. !! @@ -15,22 +12,17 @@ module GFS_rrtmgp_cloud_overlap contains -!>\defgroup gfs_rrtmgp_cloud_overlap_mod GFS RRTMGP Cloud Overlap Module -!! \section arg_table_GFS_rrtmgp_cloud_overlap_run +!> \section arg_table_GFS_rrtmgp_cloud_overlap_run Argument Table !! \htmlinclude GFS_rrtmgp_cloud_overlap_run.html !! -!> \ingroup GFS_rrtmgp_cloud_overlap -!! !! This is identical (shares common-code) to RRTMG. The motivation for RRTMGP to have !! its own scheme is both organizational and philosophical*. !! !! *The number of "clouds" being produced by the model physics is often greater than one. !! rte-rrtmgp can accomodate multiple cloud-types. This module preservers this enhancement !! in the EMCs coupling to the RRTMGP scheme. -!! -!! \section GFS_rrtmgp_cloud_overlap_run subroutine GFS_rrtmgp_cloud_overlap_run(nCol, nLev, yearlen, doSWrad, doLWrad, & - julian, lat, p_lev, p_lay, tv_lay, deltaZc, con_pi, con_g, con_rd, con_epsq, & + julian, lat, deltaZc, con_pi, con_g, con_rd, con_epsq, & dcorr_con, idcor, iovr, iovr_dcorr, iovr_exp, iovr_exprand, idcor_con, & idcor_hogan, idcor_oreopoulos, cld_frac, cld_cnv_frac, iovr_convcld, top_at_1, & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_samf, de_lgth, cloud_overlap_param, & @@ -39,54 +31,52 @@ subroutine GFS_rrtmgp_cloud_overlap_run(nCol, nLev, yearlen, doSWrad, doLWrad, ! Inputs integer, intent(in) :: & - nCol, & ! Number of horizontal grid points - nLev, & ! Number of vertical layers - yearlen, & ! Length of current year (365/366) WTF? - imfdeepcnv, & ! - imfdeepcnv_gf, & ! - imfdeepcnv_samf, & ! - iovr, & ! Choice of cloud-overlap method - iovr_convcld, & ! Choice of convective cloud-overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method - idcor, & ! Choice of method for decorrelation length computation - idcor_con, & ! Flag for decorrelation-length. Use constant value - idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) - idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + nCol, & !< Number of horizontal grid points + nLev, & !< Number of vertical layers + yearlen, & !< Length of current year (365/366) WTF? + imfdeepcnv, & !< + imfdeepcnv_gf, & !< + imfdeepcnv_samf, & !< + iovr, & !< Choice of cloud-overlap method + iovr_convcld, & !< Choice of convective cloud-overlap method + iovr_dcorr, & !< Flag for decorrelation-length cloud overlap method + iovr_exp, & !< Flag for exponential cloud overlap method + iovr_exprand, & !< Flag for exponential-random cloud overlap method + idcor, & !< Choice of method for decorrelation length computation + idcor_con, & !< Flag for decorrelation-length. Use constant value + idcor_hogan, & !< Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) + idcor_oreopoulos !< Flag for decorrelation-length. (10.5194/acp-12-9097-2012) logical, intent(in) :: & - top_at_1, & ! Vertical ordering flag - doSWrad, & ! Call SW radiation? - doLWrad ! Call LW radiation + top_at_1, & !< Vertical ordering flag + doSWrad, & !< Call SW radiation? + doLWrad !< Call LW radiation real(kind_phys), intent(in) :: & - julian, & ! Julian day - con_pi, & ! Physical constant: pi - con_g, & ! Physical constant: gravitational constant - con_rd, & ! Physical constant: gas-constant for dry air - con_epsq, & ! Physical constant: Minimum value for specific humidity - dcorr_con ! Decorrelation-length (used if idcor = idcor_con) + julian, & !< Julian day + con_pi, & !< Physical constant: pi + con_g, & !< Physical constant: gravitational constant + con_rd, & !< Physical constant: gas-constant for dry air + con_epsq, & !< Physical constant: Minimum value for specific humidity + dcorr_con !< Decorrelation-length (used if idcor = idcor_con) real(kind_phys), dimension(:), intent(in) :: & - lat ! Latitude - real(kind_phys), dimension(:,:), intent(in) :: & - tv_lay, & ! Virtual temperature (K) - p_lay, & ! Pressure at model-layers (Pa) - cld_frac, & ! Total cloud fraction - cld_cnv_frac ! Convective cloud-fraction - real(kind_phys), dimension(:,:), intent(in) :: & - p_lev, & ! Pressure at model-level interfaces (Pa) - deltaZc ! Layer thickness (from layer-centers)(m) + lat !< Latitude + real(kind_phys), dimension(:,:), intent(in) :: & + cld_frac !< Total cloud fraction + real(kind_phys), dimension(:,:), intent(in), optional :: & + cld_cnv_frac !< Convective cloud-fraction + real(kind_phys), dimension(:,:), intent(in), optional :: & + deltaZc !< Layer thickness (from layer-centers)(m) ! Outputs real(kind_phys), dimension(:),intent(out) :: & - de_lgth ! Decorrelation length - real(kind_phys), dimension(:,:),intent(out) :: & - cloud_overlap_param, & ! Cloud-overlap parameter - cnv_cloud_overlap_param,& ! Convective cloud-overlap parameter - precip_overlap_param ! Precipitation overlap parameter + de_lgth !< Decorrelation length + real(kind_phys), dimension(:,:),intent(out), optional :: & + cloud_overlap_param, & !< Cloud-overlap parameter + cnv_cloud_overlap_param,& !< Convective cloud-overlap parameter + precip_overlap_param !< Precipitation overlap parameter character(len=*), intent(out) :: & - errmsg ! Error message + errmsg !< Error message integer, intent(out) :: & - errflg ! Error flag + errflg !< Error flag ! Local variables integer :: iCol,iLay diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.meta index 4d9af626d..1a379d7e9 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_overlap.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_cloud_overlap type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F dependencies = Radiation/radiation_tools.F90,Radiation/radiation_cloud_overlap.F90 @@ -60,30 +60,6 @@ type = real intent = in kind = kind_phys -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP - long_name = air pressure at vertical interface for radiation calculation - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP - long_name = air pressure at vertical layer for radiation calculation - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[tv_lay] - standard_name = virtual_temperature - long_name = layer virtual temperature - units = K - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in [deltaZc] standard_name = layer_thickness_from_layer_center long_name = layer_thickness @@ -92,6 +68,7 @@ type = real kind = kind_phys intent = in + optional = True [con_pi] standard_name = pi long_name = ratio of a circle's circumference to its diameter @@ -211,6 +188,7 @@ type = real kind = kind_phys intent = in + optional = True [top_at_1] standard_name = flag_for_vertical_ordering_in_radiation long_name = flag for vertical ordering in radiation @@ -255,6 +233,7 @@ type = real kind = kind_phys intent = out + optional = True [precip_overlap_param] standard_name = precip_overlap_param long_name = precipitation overlap parameter @@ -263,6 +242,7 @@ type = real kind = kind_phys intent = out + optional = True [cnv_cloud_overlap_param] standard_name = convective_cloud_overlap_param long_name = convective cloud overlap parameter @@ -271,6 +251,7 @@ type = real kind = kind_phys intent = out + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.F90 deleted file mode 100644 index 22fe2fc21..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_post.F90 +++ /dev/null @@ -1,394 +0,0 @@ -!> \file GFS_rrtmgp_post.F90 -!! -!> \defgroup GFS_rrtmgp_post GFS_rrtmgp_post.F90 -!! -!! \brief RRTMGP post-processing routine. -!! -module GFS_rrtmgp_post - use machine, only: kind_phys - use module_radlw_parameters, only: topflw_type, sfcflw_type - use module_radsw_parameters, only: topfsw_type, sfcfsw_type, cmpfsw_type - use mo_heating_rates, only: compute_heating_rate - use radiation_tools, only: check_error_msg - implicit none - - public GFS_rrtmgp_post_run - -contains - ! ######################################################################################## -!>\defgroup gfs_rrtmgp_post_mod GFS RRTMGP Post Module -!> \section arg_table_GFS_rrtmgp_post_run -!! \htmlinclude GFS_rrtmgp_post.html -!! -!! \ingroup GFS_rrtmgp_post -!! -!! \brief The all-sky radiation tendency is computed, the clear-sky tendency is computed -!! if requested. -!! -!! RRTMGP surface and TOA fluxes are copied to fields that persist between radiation/physics -!! calls. -!! -!! (optional) Save additional diagnostics. -!! -!! \section GFS_rrtmgp_post_run - ! ######################################################################################## - subroutine GFS_rrtmgp_post_run (nCol, nLev, nDay, iSFC, iTOA, idxday, doLWrad, doSWrad, & - do_lw_clrsky_hr, do_sw_clrsky_hr, save_diag, fhlwr, fhswr, sfc_alb_nir_dir, & - sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, p_lev, tsfa, coszen, coszdg, & - fluxlwDOWN_clrsky, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & - fluxswDOWN_clrsky, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, & - raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, cldtausw, scmpsw, fluxr, & - sfcdlw, sfculw, sfcflw, tsflw, htrlw, htrlwu, topflw, nirbmdi, nirdfdi, visbmdi, & - visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, sfcdsw, htrsw, sfcfsw, topfsw, & - htrswc, htrlwc, errmsg, errflg) - - ! Inputs - integer, intent(in) :: & - nCol, & ! Horizontal loop extent - nLev, & ! Number of vertical layers - nDay, & ! Number of daylit columns - iSFC, & ! Vertical index for surface level - iTOA ! Vertical index for TOA level - integer, intent(in), dimension(:) :: & - idxday ! Index array for daytime points - integer, intent(in), dimension(:,:) :: & - mbota, & ! Vertical indices for low, middle and high cloud tops - mtopa ! ertical indices for low, middle and high cloud bases - logical, intent(in) :: & - doLWrad, & ! Logical flags for lw radiation calls - doSWrad, & ! Logical flags for sw radiation calls - do_lw_clrsky_hr, & ! Output clear-sky LW heating-rate? - do_sw_clrsky_hr, & ! Output clear-sky SW heating-rate? - save_diag ! Output radiation diagnostics? - real(kind_phys), intent(in) :: & - fhlwr, & ! Frequency for LW radiation calls - fhswr ! Frequency for SW radiation calls - real(kind_phys), dimension(:), intent(in) :: & - tsfa, & ! Lowest model layer air temperature for radiation (K) - coszen, & ! Cosine(SZA) - coszdg, & ! Cosine(SZA), daytime - sfc_alb_nir_dir, & ! Surface albedo (direct) - sfc_alb_nir_dif, & ! Surface albedo (diffuse) - sfc_alb_uvvis_dir, & ! Surface albedo (direct) - sfc_alb_uvvis_dif ! Surface albedo (diffuse) - real(kind_phys), dimension(:,:), intent(in) :: & - p_lev, & ! Pressure @ model layer-interfaces (Pa) - fluxlwUP_allsky, & ! RRTMGP longwave all-sky flux (W/m2) - fluxlwDOWN_allsky, & ! RRTMGP longwave all-sky flux (W/m2) - fluxlwUP_clrsky, & ! RRTMGP longwave clear-sky flux (W/m2) - fluxlwDOWN_clrsky, & ! RRTMGP longwave clear-sky flux (W/m2) - fluxswUP_allsky, & ! RRTMGP shortwave all-sky flux (W/m2) - fluxswDOWN_allsky, & ! RRTMGP shortwave all-sky flux (W/m2) - fluxswUP_clrsky, & ! RRTMGP shortwave clear-sky flux (W/m2) - fluxswDOWN_clrsky ! RRTMGP shortwave clear-sky flux (W/m2) - real(kind_phys), intent(in) :: & - raddt ! Radiation time step - real(kind_phys), dimension(:,:), intent(in) :: & - aerodp, & ! Vertical integrated optical depth for various aerosol species - cldsa, & ! Fraction of clouds for low, middle, high, total and BL - cld_frac, & ! Total cloud fraction in each layer - cldtaulw, & ! approx 10.mu band layer cloud optical depth - cldtausw ! approx .55mu band layer cloud optical depth - type(cmpfsw_type), dimension(:), intent(in) :: & - scmpsw ! 2D surface fluxes, components: - ! uvbfc - total sky downward uv-b flux at (W/m2) - ! uvbf0 - clear sky downward uv-b flux at (W/m2) - ! nirbm - downward nir direct beam flux (W/m2) - ! nirdf - downward nir diffused flux (W/m2) - ! visbm - downward uv+vis direct beam flux (W/m2) - ! visdf - downward uv+vis diffused flux (W/m2) - - - real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr - - ! Outputs (mandatory) - real(kind_phys), dimension(:), intent(inout) :: & - tsflw, & ! LW sfc air temp during calculation (K) - sfcdlw, & ! LW sfc all-sky downward flux (W/m2) - sfculw, & ! LW sfc all-sky upward flux (W/m2) - nirbmdi, & ! SW sfc nir beam downward flux (W/m2) - nirdfdi, & ! SW sfc nir diff downward flux (W/m2) - visbmdi, & ! SW sfc uv+vis beam downward flux (W/m2) - visdfdi, & ! SW sfc uv+vis diff downward flux (W/m2) - nirbmui, & ! SW sfc nir beam upward flux (W/m2) - nirdfui, & ! SW sfc nir diff upward flux (W/m2) - visbmui, & ! SW sfc uv+vis beam upward flux (W/m2) - visdfui, & ! SW sfc uv+vis diff upward flux (W/m2) - sfcnsw, & ! SW sfc all-sky net flux (W/m2) flux into ground - sfcdsw ! SW sfc all-sky downward flux (W/m2) - real(kind_phys), dimension(:,:), intent(inout) :: & - htrlw, & ! LW all-sky heating rate (K/s) - htrsw, & ! SW all-sky heating rate (K/s) - htrlwu ! LW all-sky heating-rate updated in-between radiation calls. - type(sfcflw_type), dimension(:), intent(inout) :: & - sfcflw ! LW radiation fluxes at sfc - type(sfcfsw_type), dimension(:), intent(inout) :: & - sfcfsw ! SW radiation fluxes at sfc - type(topfsw_type), dimension(:), intent(inout) :: & - topfsw ! SW fluxes at top atmosphere - type(topflw_type), dimension(:), intent(inout) :: & - topflw ! LW fluxes at top atmosphere - character(len=*), intent(out) :: & - errmsg ! CCPP error message - integer, intent(out) :: & - errflg ! CCPP error code - - ! Outputs (optional) - real(kind_phys),dimension(:,:),intent(inout),optional :: & - htrlwc, & ! LW clear-sky heating-rate (K/s) - htrswc ! SW clear-sky heating rate (K/s) - - ! Local variables - integer :: i, j, k, itop, ibtc - real(kind_phys) :: tem0d, tem1, tem2 - real(kind_phys), dimension(nDay, nLev) :: thetaTendClrSky, thetaTendAllSky - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not. (doLWrad .or. doSWrad)) return - - if (doLWRad) then - ! ####################################################################################### - ! Compute LW heating-rates. - ! ####################################################################################### - - ! Clear-sky heating-rate (optional) - if (do_lw_clrsky_hr) then - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxlwUP_clrsky, & ! IN - RRTMGP upward longwave clear-sky flux profiles (W/m2) - fluxlwDOWN_clrsky, & ! IN - RRTMGP downward longwave clear-sky flux profiles (W/m2) - p_lev, & ! IN - Pressure @ layer-interfaces (Pa) - htrlwc)) ! OUT - Longwave clear-sky heating rate (K/sec) - endif - - ! All-sky heating-rate (mandatory) - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxlwUP_allsky, & ! IN - RRTMGP upward longwave all-sky flux profiles (W/m2) - fluxlwDOWN_allsky, & ! IN - RRTMGP downward longwave all-sky flux profiles (W/m2) - p_lev, & ! IN - Pressure @ layer-interfaces (Pa) - htrlw)) ! OUT - Longwave all-sky heating rate (K/sec) - - ! ####################################################################################### - ! Save LW outputs. - ! (Copy fluxes from RRTMGP types into model radiation types.) - ! ####################################################################################### - ! TOA fluxes - - topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) - topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA) - - ! Surface fluxes - sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC) - sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC) - sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC) - sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC) - - ! Save surface air temp for diurnal adjustment at model t-steps - tsflw (:) = tsfa(:) - - ! Radiation fluxes for other physics processes - sfcdlw(:) = sfcflw(:)%dnfxc - sfculw(:) = sfcflw(:)%upfxc - - ! Heating-rate at radiation timestep, used for adjustment between radiation calls. - htrlwu = htrlw - - ! ####################################################################################### - ! Save LW diagnostics - ! - For time averaged output quantities (including total-sky and clear-sky SW and LW - ! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base - ! pressure, and cloud top temperature; aerosols AOD, etc.), store computed results in - ! corresponding slots of array fluxr with appropriate time weights. - ! - Collect the fluxr data for wrtsfc - ! ####################################################################################### - if (save_diag) then - do i=1,nCol - ! LW all-sky fluxes - fluxr(i,1 ) = fluxr(i,1 ) + fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up - fluxr(i,19) = fluxr(i,19) + fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn - fluxr(i,20) = fluxr(i,20) + fhlwr * fluxlwUP_allsky( i,iSFC) ! total sky sfc lw up - ! LW clear-sky fluxes - fluxr(i,28) = fluxr(i,28) + fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up - fluxr(i,30) = fluxr(i,30) + fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn - fluxr(i,33) = fluxr(i,33) + fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up - enddo - - ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud is reversed for - ! the fluxr output. save interface pressure (pa) of top/bot - do j = 1, 3 - do i = 1, nCol - tem0d = raddt * cldsa(i,j) - itop = mtopa(i,j) - ibtc = mbota(i,j) - - ! Add optical depth and emissivity output - tem2 = 0. - do k=ibtc,itop - tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel - enddo - fluxr(i,46-j) = fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) - enddo - enddo - endif - endif - ! ####################################################################################### - ! ####################################################################################### - ! ####################################################################################### - ! ####################################################################################### - ! ####################################################################################### - ! ####################################################################################### - if (doSWRad) then - if (nDay .gt. 0) then - ! ################################################################################# - ! Compute SW heating-rates - ! ################################################################################# - - ! Clear-sky heating-rate (optional) - if (do_sw_clrsky_hr) then - htrswc(:,:) = 0._kind_phys - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxswUP_clrsky(idxday(1:nDay),:), & ! IN - Shortwave upward clear-sky flux profiles (W/m2) - fluxswDOWN_clrsky(idxday(1:nDay),:), & ! IN - Shortwave downward clear-sky flux profiles (W/m2) - p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) - thetaTendClrSky)) ! OUT - Clear-sky heating-rate (K/sec) - htrswc(idxday(1:nDay),:)=thetaTendClrSky !**NOTE** GP doesn't use radiation levels, it uses the model fields. Not sure if this is necessary - endif - - ! All-sky heating-rate (mandatory) - htrsw(:,:) = 0._kind_phys - call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & - fluxswUP_allsky(idxday(1:nDay),:), & ! IN - Shortwave upward all-sky flux profiles (W/m2) - fluxswDOWN_allsky(idxday(1:nDay),:), & ! IN - Shortwave downward all-sky flux profiles (W/m2) - p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) - thetaTendAllSky)) ! OUT - All-sky heating-rate (K/sec) - htrsw(idxday(1:nDay),:) = thetaTendAllSky - - ! ################################################################################# - ! Save SW outputs - ! (Copy fluxes from RRTMGP types into model radiation types.) - ! ################################################################################# - - ! TOA fluxes - topfsw(:)%upfxc = fluxswUP_allsky(:,iTOA) - topfsw(:)%upfx0 = fluxswUP_clrsky(:,iTOA) - topfsw(:)%dnfxc = fluxswDOWN_allsky(:,iTOA) - - ! Surface fluxes - sfcfsw(:)%upfxc = fluxswUP_allsky(:,iSFC) - sfcfsw(:)%upfx0 = fluxswUP_clrsky(:,iSFC) - sfcfsw(:)%dnfxc = fluxswDOWN_allsky(:,iSFC) - sfcfsw(:)%dnfx0 = fluxswDOWN_clrsky(:,iSFC) - - ! Surface down and up spectral component fluxes - ! - Save two spectral bands' surface downward and upward fluxes for output. - do i=1,nCol - nirbmdi(i) = scmpsw(i)%nirbm - nirdfdi(i) = scmpsw(i)%nirdf - visbmdi(i) = scmpsw(i)%visbm - visdfdi(i) = scmpsw(i)%visdf - nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(i) - nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(i) - visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(i) - visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(i) - enddo - else ! if_nday_block - ! ################################################################################# - ! Dark everywhere - ! ################################################################################# - htrsw(:,:) = 0.0 - sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) - topfsw = topfsw_type( 0.0, 0.0, 0.0 ) - do i=1,nCol - nirbmdi(i) = 0.0 - nirdfdi(i) = 0.0 - visbmdi(i) = 0.0 - visdfdi(i) = 0.0 - nirbmui(i) = 0.0 - nirdfui(i) = 0.0 - visbmui(i) = 0.0 - visdfui(i) = 0.0 - enddo - - if (do_sw_clrsky_hr) then - htrswc(:,:) = 0 - endif - endif ! end_if_nday - - ! Radiation fluxes for other physics processes - do i=1,nCol - sfcnsw(i) = sfcfsw(i)%dnfxc - sfcfsw(i)%upfxc - sfcdsw(i) = sfcfsw(i)%dnfxc - enddo - - ! ################################################################################# - ! Save SW diagnostics - ! - For time averaged output quantities (including total-sky and clear-sky SW and LW - ! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base - ! pressure, and cloud top temperature; aerosols AOD, etc.), store computed results in - ! corresponding slots of array fluxr with appropriate time weights. - ! - Collect the fluxr data for wrtsfc - ! ################################################################################# - if (save_diag) then - do i=1,nCol - fluxr(i,34) = aerodp(i,1) ! total aod at 550nm - fluxr(i,35) = aerodp(i,2) ! DU aod at 550nm - fluxr(i,36) = aerodp(i,3) ! BC aod at 550nm - fluxr(i,37) = aerodp(i,4) ! OC aod at 550nm - fluxr(i,38) = aerodp(i,5) ! SU aod at 550nm - fluxr(i,39) = aerodp(i,6) ! SS aod at 550nm - if (coszen(i) > 0.) then - ! SW all-sky fluxes - tem0d = fhswr * coszdg(i) / coszen(i) - fluxr(i,2 ) = fluxr(i,2) + topfsw(i)%upfxc * tem0d ! total sky top sw up - fluxr(i,3 ) = fluxr(i,3) + sfcfsw(i)%upfxc * tem0d - fluxr(i,4 ) = fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn - ! SW uv-b fluxes - fluxr(i,21) = fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn - fluxr(i,22) = fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn - ! SW TOA incoming fluxes - fluxr(i,23) = fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn - ! SW SFC flux components - fluxr(i,24) = fluxr(i,24) + visbmdi(i) * tem0d ! uv/vis beam sw dn - fluxr(i,25) = fluxr(i,25) + visdfdi(i) * tem0d ! uv/vis diff sw dn - fluxr(i,26) = fluxr(i,26) + nirbmdi(i) * tem0d ! nir beam sw dn - fluxr(i,27) = fluxr(i,27) + nirdfdi(i) * tem0d ! nir diff sw dn - ! SW clear-sky fluxes - fluxr(i,29) = fluxr(i,29) + topfsw(i)%upfx0 * tem0d - fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d - fluxr(i,32) = fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d - endif - enddo - - ! Save total and boundary-layer clouds - do i=1,nCol - fluxr(i,17) = fluxr(i,17) + raddt * cldsa(i,4) - fluxr(i,18) = fluxr(i,18) + raddt * cldsa(i,5) - enddo - - ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud - ! is reversed for the fluxr output. save interface pressure (pa) of top/bot - do j = 1, 3 - do i = 1, nCol - tem0d = raddt * cldsa(i,j) - itop = mtopa(i,j) - ibtc = mbota(i,j) - fluxr(i, 8-j) = fluxr(i, 8-j) + tem0d - fluxr(i,11-j) = fluxr(i,11-j) + tem0d * p_lev(i,itop) - fluxr(i,14-j) = fluxr(i,14-j) + tem0d * p_lev(i,ibtc) - fluxr(i,17-j) = fluxr(i,17-j) + tem0d * p_lev(i,itop) - - ! Add optical depth and emissivity output - tem1 = 0. - do k=ibtc,itop - tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel - enddo - fluxr(i,43-j) = fluxr(i,43-j) + tem0d * tem1 - enddo - enddo - endif - endif - - end subroutine GFS_rrtmgp_post_run -end module GFS_rrtmgp_post diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 index cbf8d161b..9745f4c98 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 @@ -1,9 +1,7 @@ !> \file GFS_rrtmgp_pre.F90 -!! -!> \defgroup GFS_rrtmgp_pre GFS_rrtmgp_pre.F90 -!! !! \brief This module contains code to prepare model fields for use by the RRTMGP !! radiation scheme. + module GFS_rrtmgp_pre use machine, only: kind_phys use funcphys, only: fpvs @@ -33,29 +31,24 @@ module GFS_rrtmgp_pre public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init contains -!>\defgroup gfs_rrtmgp_pre GFS RRTMGP Pre Module -!! \section arg_table_GFS_rrtmgp_pre_init +!> \section arg_table_GFS_rrtmgp_pre_init Argument Table !! \htmlinclude GFS_rrtmgp_pre_init.html !! -!> \ingroup GFS_rrtmgp_pre -!! -!! \brief Actuve gas-names are read from namelist. Set to interstitial%active_gases. -!! -!! \section GFS_rrtmgp_pre_init +!! Actuve gas-names are read from namelist. Set to interstitial%active_gases. subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, errflg) ! Inputs integer, intent(in) :: & - nGases ! Number of active gases in RRTMGP + nGases !< Number of active gases in RRTMGP character(len=*), intent(in) :: & - active_gases ! List of active gases from namelist - character(len=*), dimension(:), intent(out) :: & - active_gases_array ! List of active gases from namelist as array + active_gases !< List of active gases from namelist + character(len=*), dimension(:), intent(out), optional :: & + active_gases_array !< List of active gases from namelist as array ! Outputs character(len=*), intent(out) :: & - errmsg ! Error message + errmsg !< Error message integer, intent(out) :: & - errflg ! Error flag + errflg !< Error flag ! Local variables character(len=1) :: tempstr @@ -101,16 +94,10 @@ subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, end subroutine GFS_rrtmgp_pre_init - ! ######################################################################################### -!> \section arg_table_GFS_rrtmgp_pre_run +!> \section arg_table_GFS_rrtmgp_pre_run Argument Table !! \htmlinclude GFS_rrtmgp_pre_run.html !! -!> \ingroup GFS_rrtmgp_pre -!! -!! \brief Sanitize inputs for use in RRTMGP. -!! -!! \section GFS_rrtmgp_pre_run - ! ######################################################################################### +!! Sanitize inputs for use in RRTMGP. subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhlwr, & xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, coslat, sinlat, con_g, con_rd, & con_eps, con_epsm1, con_fvirt, con_epsqs, solhr, raddt, p_lay, t_lay, p_lev, t_lev, & @@ -122,79 +109,79 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl ! Inputs integer, intent(in) :: & - me, & ! MPI rank - nCol, & ! Number of horizontal grid points - nLev, & ! Number of vertical layers - ico2, & ! Flag for co2 radiation scheme - i_o3 ! Index into tracer array for ozone + me, & !< MPI rank + nCol, & !< Number of horizontal grid points + nLev, & !< Number of vertical layers + ico2, & !< Flag for co2 radiation scheme + i_o3 !< Index into tracer array for ozone type(ty_ozphys),intent(in) :: & ozphys logical, intent(in) :: & - doSWrad, & ! Call SW radiation? - doLWrad ! Call LW radiation + doSWrad, & !< Call SW radiation? + doLWrad !< Call LW radiation real(kind_phys), intent(in) :: & - fhswr, & ! Frequency of SW radiation call. - fhlwr ! Frequency of LW radiation call. + fhswr, & !< Frequency of SW radiation call. + fhlwr !< Frequency of LW radiation call. real(kind_phys), intent(in) :: & - con_g, & ! Physical constant: gravitational constant - con_rd, & ! Physical constant: gas-constant for dry air - con_eps, & ! Physical constant: Epsilon (Rd/Rv) - con_epsm1, & ! Physical constant: Epsilon (Rd/Rv) minus one - con_fvirt, & ! Physical constant: Inverse of epsilon minus one - con_epsqs, & ! Physical constant: Minimum saturation mixing-ratio (kg/kg) - con_pi, & ! Physical constant: Pi - solhr ! Time in hours after 00z at the current timestep + con_g, & !< Physical constant: gravitational constant + con_rd, & !< Physical constant: gas-constant for dry air + con_eps, & !< Physical constant: Epsilon (Rd/Rv) + con_epsm1, & !< Physical constant: Epsilon (Rd/Rv) minus one + con_fvirt, & !< Physical constant: Inverse of epsilon minus one + con_epsqs, & !< Physical constant: Minimum saturation mixing-ratio (kg/kg) + con_pi, & !< Physical constant: Pi + solhr !< Time in hours after 00z at the current timestep real(kind_phys), dimension(:), intent(in) :: & - xlon, & ! Longitude - xlat, & ! Latitude - tsfc, & ! Surface skin temperature (K) - coslat, & ! Cosine(latitude) - sinlat, & ! Sine(latitude) + xlon, & !< Longitude + xlat, & !< Latitude + tsfc, & !< Surface skin temperature (K) + coslat, & !< Cosine(latitude) + sinlat, & !< Sine(latitude) semis real(kind_phys), dimension(:,:), intent(in) :: & - prsl, & ! Pressure at model-layer centers (Pa) - tgrs, & ! Temperature at model-layer centers (K) - prslk, & ! Exner function at model layer centers (1) - prsi ! Pressure at model-interfaces (Pa) + prsl, & !< Pressure at model-layer centers (Pa) + tgrs, & !< Temperature at model-layer centers (K) + prslk, & !< Exner function at model layer centers (1) + prsi !< Pressure at model-interfaces (Pa) real(kind_phys), dimension(:,:,:), intent(in) :: & - qgrs ! Tracer concentrations (kg/kg) - character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array + qgrs !< Tracer concentrations (kg/kg) + character(len=*), dimension(:), intent(in), optional :: & + active_gases_array !< List of active gases from namelist as array ! Outputs character(len=*), intent(out) :: & - errmsg ! Error message + errmsg !< Error message integer, intent(out) :: & - errflg, & ! Error flag + errflg, & !< Error flag nDay integer, intent(inout) :: & - iSFC, & ! Vertical index for surface - iTOA ! Vertical index for TOA + iSFC, & !< Vertical index for surface + iTOA !< Vertical index for TOA logical, intent(inout) :: & - top_at_1 ! Vertical ordering flag + top_at_1 !< Vertical ordering flag real(kind_phys), intent(inout) :: & - raddt ! Radiation time-step + raddt !< Radiation time-step real(kind_phys), dimension(:), intent(inout) :: & - tsfg, & ! Ground temperature - tsfa, & ! Skin temperature - tsfc_radtime, & ! Surface temperature at radiation timestep - coszen, & ! Cosine of SZA - coszdg ! Cosine of SZA, daytime + tsfg, & !< Ground temperature + tsfa, & !< Skin temperature + tsfc_radtime, & !< Surface temperature at radiation timestep + coszen, & !< Cosine of SZA + coszdg !< Cosine of SZA, daytime integer, dimension(:), intent(inout) :: & - idxday ! Indices for daylit points - real(kind_phys), dimension(:,:), intent(inout) :: & - p_lay, & ! Pressure at model-layer - t_lay, & ! Temperature at model layer - q_lay, & ! Water-vapor mixing ratio (kg/kg) - tv_lay, & ! Virtual temperature at model-layers - relhum, & ! Relative-humidity at model-layers - qs_lay, & ! Saturation vapor pressure at model-layers - deltaZ, & ! Layer thickness (m) - deltaZc, & ! Layer thickness (m) (between layer centers) - deltaP, & ! Layer thickness (Pa) - p_lev, & ! Pressure at model-interface - sfc_emiss_byband, & ! - t_lev, & ! Temperature at model-interface + idxday !< Indices for daylit points + real(kind_phys), dimension(:,:), intent(inout), optional :: & + p_lay, & !< Pressure at model-layer + t_lay, & !< Temperature at model layer + q_lay, & !< Water-vapor mixing ratio (kg/kg) + tv_lay, & !< Virtual temperature at model-layers + relhum, & !< Relative-humidity at model-layers + qs_lay, & !< Saturation vapor pressure at model-layers + deltaZ, & !< Layer thickness (m) + deltaZc, & !< Layer thickness (m) (between layer centers) + deltaP, & !< Layer thickness (Pa) + p_lev, & !< Pressure at model-interface + sfc_emiss_byband, & !< + t_lev, & !< Temperature at model-interface vmr_o2, vmr_h2o, vmr_o3, vmr_ch4, vmr_n2o, vmr_co2 ! Local variables @@ -264,7 +251,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, i_o3, doSWrad, doLWrad, fhswr, fhl enddo ! Temperature at layer-interfaces - call cmp_tlev(nCol,nLev,lw_gas_props%get_press_min(),p_lay,t_lay,p_lev,tsfc,t_lev) + call cmp_tlev(nCol,nLev,real(lw_gas_props%get_press_min(),kind=kind_phys),p_lay,t_lay,p_lev,tsfc,t_lev) do iLev=1,nLev+1 do iCol=1,nCol if (t_lev(iCol,iLev) .le. lw_gas_props%get_temp_min()) t_lev(iCol,iLev) = & diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta index bd767d14b..d7ba78ab0 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.meta @@ -1,9 +1,9 @@ [ccpp-table-properties] name = GFS_rrtmgp_pre type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = tools/funcphys.f90,hooks/machine.F,Radiation/radiation_aerosols.f,photochem/module_ozphys.F90 - dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_gases.f,Radiation/radiation_tools.F90 + dependencies = Radiation/RRTMG/iounitdef.f,Radiation/radiation_astronomy.f,Radiation/radiation_gases.f,Radiation/radiation_tools.F90 ######################################################################## [ccpp-arg-table] @@ -32,6 +32,7 @@ type = character kind = len=128 intent = out + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -277,6 +278,7 @@ type = real kind = kind_phys intent = inout + optional = True [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation @@ -285,6 +287,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_lay] standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation @@ -293,6 +296,7 @@ type = real kind = kind_phys intent = inout + optional = True [t_lev] standard_name = air_temperature_at_interface_for_RRTMGP long_name = air temperature at vertical interface for radiation calculation @@ -301,6 +305,7 @@ type = real kind = kind_phys intent = inout + optional = True [deltaZ] standard_name = layer_thickness long_name = layer_thickness @@ -309,6 +314,7 @@ type = real kind = kind_phys intent = inout + optional = True [deltaZc] standard_name = layer_thickness_from_layer_center long_name = layer_thickness @@ -317,6 +323,7 @@ type = real kind = kind_phys intent = inout + optional = True [deltaP] standard_name = layer_thickness_in_Pa long_name = layer_thickness_in_Pa @@ -325,6 +332,7 @@ type = real kind = kind_phys intent = inout + optional = True [top_at_1] standard_name = flag_for_vertical_ordering_in_radiation long_name = flag for vertical ordering in radiation @@ -354,6 +362,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsfg] standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation @@ -378,6 +387,7 @@ type = real kind = kind_phys intent = inout + optional = True [relhum] standard_name = relative_humidity long_name = layer relative humidity @@ -386,6 +396,7 @@ type = real kind = kind_phys intent = inout + optional = True [qs_lay] standard_name = saturation_vapor_pressure long_name = saturation vapor pressure @@ -394,6 +405,7 @@ type = real kind = kind_phys intent = inout + optional = True [q_lay] standard_name = water_vapor_mixing_ratio long_name = water vaport mixing ratio @@ -402,6 +414,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_o2] standard_name = volume_mixing_ratio_for_o2 long_name = molar mixing ratio of o2 in with respect to dry air @@ -410,6 +423,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_h2o] standard_name = volume_mixing_ratio_for_h2o long_name = molar mixing ratio of h2o in with respect to dry air @@ -418,6 +432,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_o3] standard_name = volume_mixing_ratio_for_o3 long_name = molar mixing ratio of o3 in with respect to dry air @@ -426,6 +441,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_ch4] standard_name = volume_mixing_ratio_for_ch4 long_name = molar mixing ratio of ch4 in with respect to dry air @@ -434,6 +450,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_n2o] standard_name = volume_mixing_ratio_for_n2o long_name = molar mixing ratio of n2o in with respect to dry air @@ -442,6 +459,7 @@ type = real kind = kind_phys intent = inout + optional = True [vmr_co2] standard_name = volume_mixing_ratio_for_co2 long_name = molar mixing ratio of co2 in with respect to dry air @@ -450,6 +468,7 @@ type = real kind = kind_phys intent = inout + optional = True [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP long_name = list of active gases used by RRTMGP @@ -458,6 +477,7 @@ type = character kind = len=* intent = in + optional = True [coszdg] standard_name = cosine_of_solar_zenith_angle_on_radiation_timestep long_name = daytime mean cosz over rad call period @@ -490,6 +510,7 @@ type = real kind = kind_phys intent = inout + optional = True [nday] standard_name = daytime_points_dimension long_name = daytime points dimension diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 index 9f2b2a9f9..df3d69bdd 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.F90 @@ -31,8 +31,7 @@ module GFS_rrtmgp_setup contains -!> \defgroup GFS_rrtmgp_setup_mod GFS RRTMGP Scheme Setup Module -!! \section arg_table_GFS_rrtmgp_setup_init +!> \section arg_table_GFS_rrtmgp_setup_init Argument Table !! \htmlinclude GFS_rrtmgp_setup_init.html !! subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, & @@ -46,14 +45,14 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, ! Inputs logical, intent(in) :: do_RRTMGP integer, intent(in) :: & - imp_physics, & ! Flag for MP scheme - imp_physics_fer_hires, & ! Flag for fer-hires scheme - imp_physics_gfdl, & ! Flag for gfdl scheme - imp_physics_thompson, & ! Flag for thompsonscheme - imp_physics_wsm6, & ! Flag for wsm6 scheme - imp_physics_zhao_carr, & ! Flag for zhao-carr scheme - imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme - imp_physics_mg ! Flag for MG scheme + imp_physics, & !< Flag for MP scheme + imp_physics_fer_hires, & !< Flag for fer-hires scheme + imp_physics_gfdl, & !< Flag for gfdl scheme + imp_physics_thompson, & !< Flag for thompsonscheme + imp_physics_wsm6, & !< Flag for wsm6 scheme + imp_physics_zhao_carr, & !< Flag for zhao-carr scheme + imp_physics_zhao_carr_pdf, & !< Flag for zhao-carr+PDF scheme + imp_physics_mg !< Flag for MG scheme real(kind_phys), intent(in) :: & con_pi, con_t0c, con_c, con_boltz, con_plnk, con_solr_2008, con_solr_2002 real(kind_phys), dimension(:), intent(in) :: & @@ -74,8 +73,6 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 - - if (is_initialized) return ! Consistency checks if (.not. do_RRTMGP) then @@ -91,11 +88,6 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, iaerflg = mod(iaer, 1000) endif iaermdl = iaer/1000 ! control flag for aerosol scheme selection - if ( iaermdl < 0 .or. (iaermdl>2 .and. iaermdl/=5) ) then - errmsg = trim(errmsg) // ' Error -- IAER flag is incorrect, Abort' - errflg = 1 - return - endif ! Assign initial permutation seed for mcica cloud-radiation if ( isubc_sw>0 .or. isubc_lw>0 ) then @@ -125,11 +117,15 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, iyear0 = 0 monthd = 0 + if (is_initialized) return + ! Call initialization routines.. call sol_init ( me, isol, solar_file, con_solr_2008, con_solr_2002, con_pi ) call aer_init ( levr, me, iaermdl, iaerflg, lalw1bd, aeros_file, con_pi, con_t0c, & con_c, con_boltz, con_plnk, errflg, errmsg) + if(errflg/=0) return call gas_init ( me, co2usr_file, co2cyc_file, ico2, ictm, con_pi, errflg, errmsg ) + if(errflg/=0) return if ( me == 0 ) then print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit' @@ -137,13 +133,9 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, is_initialized = .true. - return end subroutine GFS_rrtmgp_setup_init - ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_setup_timestep_init - ! ######################################################################################### -!> \section arg_table_GFS_rrtmgp_setup_timestep_init +!> \section arg_table_GFS_rrtmgp_setup_timestep_init Argument Table !! \htmlinclude GFS_rrtmgp_setup_timestep_init.html !! subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad, me, & @@ -226,11 +218,13 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad endif iyear0 = iyear call sol_update(jdate, kyear, deltsw, deltim, lsol_chg, me, slag, sdec, cdec, solcon, con_pi, errmsg, errflg) + if(errflg/=0) return endif ! Update aerosols... if ( lmon_chg ) then call aer_update ( iyear, imon, me, iaermdl, aeros_file, errflg, errmsg) + if(errflg/=0) return endif ! Update trace gases (co2 only)... @@ -242,19 +236,16 @@ subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, doSWrad endif call gas_update (kyear, kmon, kday, khour, lco2_chg, me, co2dat_file, co2gbl_file, ictm,& ico2, errflg, errmsg ) + if(errflg/=0) return if (ntoz == 0) then call ozphys%update_o3clim(kmon, kday, khour, loz1st) endif if ( loz1st ) loz1st = .false. - return end subroutine GFS_rrtmgp_setup_timestep_init - ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_setup_finalize - ! ######################################################################################### -!> \section arg_table_GFS_rrtmgp_setup_finalize +!> \section arg_table_GFS_rrtmgp_setup_finalize Argument Table !! \htmlinclude GFS_rrtmgp_setup_finalize.html !! subroutine GFS_rrtmgp_setup_finalize (errmsg, errflg) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta index fecb716ed..763790cb9 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_setup.meta @@ -1,10 +1,10 @@ [ccpp-table-properties] name = GFS_rrtmgp_setup type = scheme - relative_path = ../../ - dependencies = hooks/machine.F,MP/Thompson/module_mp_thompson.F90 + dependencies_path = ../../ + dependencies = hooks/machine.F,MP/module_mp_radar.F90,MP/Thompson/module_mp_thompson.F90 dependencies = Radiation/radiation_aerosols.f,photochem/module_ozphys.F90 - dependencies = Radiation/radiation_gases.f,Radiation/radiation_astronomy.f + dependencies = Radiation/radiation_gases.f,Radiation/RRTMG/iounitdef.f,Radiation/radiation_astronomy.f ######################################################################## [ccpp-arg-table] @@ -263,7 +263,7 @@ intent = in [ipsd0] standard_name = initial_seed_for_mcica - long_name = initial permutaion seed for mcica radiation + long_name = initial permutation seed for mcica radiation units = 1 dimensions = () type = integer diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 index 36ed2815a..37311d958 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.F90 @@ -5,9 +5,7 @@ module GFS_stochastics contains -!>\defgroup gfs_stoch_mod GFS Stochastics Physics Module -!> @{ -!! This is the GFS stochastics physics driver module. +!> This is the GFS stochastics physics driver module. !! !> \section arg_table_GFS_stochastics_init Argument Table !! \htmlinclude GFS_stochastics_init.html @@ -64,7 +62,7 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc zmtnblck, sppt_wts, skebu_wts, skebv_wts, shum_wts,& diss_est, ugrs, vgrs, tgrs, qgrs_wv, & qgrs_cw, qgrs_rw, qgrs_sw, qgrs_iw, qgrs_gl, & - gu0, gv0, gt0, gq0_wv, dtdtnp, & + gu0, gv0, gt0, gq0_wv, dtdtnp, num_diag_buckets, & gq0_cw, gq0_rw, gq0_sw, gq0_iw, gq0_gl, & rain, rainc, tprcp, totprcp, cnvprcp, & totprcpb, cnvprcpb, cplflx, cpllnd, & @@ -87,14 +85,15 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc logical, intent(in) :: use_zmtnblck logical, intent(in) :: do_shum logical, intent(in) :: do_skeb + integer, intent(in) :: num_diag_buckets real(kind_phys), dimension(:), intent(in) :: zmtnblck ! sppt_wts only allocated if do_sppt == .true. - real(kind_phys), dimension(:,:), intent(inout) :: sppt_wts + real(kind_phys), dimension(:,:), intent(inout), optional :: sppt_wts ! skebu_wts, skebv_wts only allocated if do_skeb == .true. - real(kind_phys), dimension(:,:), intent(in) :: skebu_wts - real(kind_phys), dimension(:,:), intent(in) :: skebv_wts + real(kind_phys), dimension(:,:), intent(in), optional :: skebu_wts + real(kind_phys), dimension(:,:), intent(in), optional :: skebv_wts ! shum_wts only allocated if do_shum == .true. - real(kind_phys), dimension(:,:), intent(in) :: shum_wts + real(kind_phys), dimension(:,:), intent(in), optional :: shum_wts real(kind_phys), dimension(:,:), intent(in) :: diss_est real(kind_phys), dimension(:,:), intent(in) :: ugrs real(kind_phys), dimension(:,:), intent(in) :: vgrs @@ -119,30 +118,30 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc integer, intent(in) :: ntsw integer, intent(in) :: ntiw integer, intent(in) :: ntgl - real(kind_phys), dimension(:,:), intent(inout) :: dtdtnp + real(kind_phys), dimension(:,:), intent(inout), optional :: dtdtnp real(kind_phys), dimension(:), intent(in) :: rain real(kind_phys), dimension(:), intent(in) :: rainc real(kind_phys), dimension(:), intent(inout) :: tprcp real(kind_phys), dimension(:), intent(inout) :: totprcp real(kind_phys), dimension(:), intent(inout) :: cnvprcp - real(kind_phys), dimension(:), intent(inout) :: totprcpb - real(kind_phys), dimension(:), intent(inout) :: cnvprcpb + real(kind_phys), dimension(:,:), intent(inout) :: totprcpb + real(kind_phys), dimension(:,:), intent(inout) :: cnvprcpb logical, intent(in) :: cplflx logical, intent(in) :: cpllnd ! rain_cpl only allocated if cplflx == .true. or cplchm == .true. or cpllnd == .true. - real(kind_phys), dimension(:), intent(inout) :: rain_cpl + real(kind_phys), dimension(:), intent(inout), optional :: rain_cpl ! snow_cpl only allocated if cplflx == .true. or cplchm == .true. - real(kind_phys), dimension(:), intent(inout) :: snow_cpl + real(kind_phys), dimension(:), intent(inout), optional :: snow_cpl ! drain_cpl, dsnow_cpl only allocated if cplflx == .true. or cplchm == .true. - real(kind_phys), dimension(:), intent(in) :: drain_cpl - real(kind_phys), dimension(:), intent(in) :: dsnow_cpl + real(kind_phys), dimension(:), intent(in), optional :: drain_cpl + real(kind_phys), dimension(:), intent(in), optional :: dsnow_cpl real(kind_phys), dimension(:), intent(in) :: vfact_ca - real(kind_phys), dimension(:), intent(in) :: ca1 + real(kind_phys), dimension(:), intent(in), optional :: ca1 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg !--- local variables - integer :: k, i + integer :: k, i, ib real(kind=kind_phys) :: upert, vpert, tpert, qpert, qnew, sppt_vwt real(kind=kind_phys), dimension(1:im,1:km) :: ca @@ -236,11 +235,13 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc ! instantaneous precip rate going into land model at the next time step tprcp(:) = sppt_wts(:,15)*tprcp(:) totprcp(:) = totprcp(:) + (sppt_wts(:,15) - 1 )*rain(:) - ! acccumulated total and convective preciptiation + ! convective precipitation cnvprcp(:) = cnvprcp(:) + (sppt_wts(:,15) - 1 )*rainc(:) ! bucket precipitation adjustment due to sppt - totprcpb(:) = totprcpb(:) + (sppt_wts(:,15) - 1 )*rain(:) - cnvprcpb(:) = cnvprcpb(:) + (sppt_wts(:,15) - 1 )*rainc(:) + do ib=1,num_diag_buckets + totprcpb(:,ib) = totprcpb(:,ib) + (sppt_wts(:,15) - 1 )*rain(:) + cnvprcpb(:,ib) = cnvprcpb(:,ib) + (sppt_wts(:,15) - 1 )*rainc(:) + enddo if (cplflx .or. cpllnd) then rain_cpl(:) = rain_cpl(:) + (sppt_wts(:,15) - 1.0)*drain_cpl(:) @@ -340,11 +341,13 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc ! instantaneous precip rate going into land model at the next time step tprcp(:) = ca(:,15)*tprcp(:) totprcp(:) = totprcp(:) + (ca(:,15) - 1 )*rain(:) - ! acccumulated total and convective preciptiation - cnvprcp(:) = cnvprcp(:) + (ca(:,15) - 1 )*rainc(:) - ! bucket precipitation adjustment due to sppt - totprcpb(:) = totprcpb(:) + (ca(:,15) - 1 )*rain(:) - cnvprcpb(:) = cnvprcpb(:) + (ca(:,15) - 1 )*rainc(:) + ! convective precipitation + cnvprcp(:) = cnvprcp(:) + (ca(:,15) - 1 )*rainc(:) + ! bucket precipitation adjustment due to sppt + do ib=1,num_diag_buckets + totprcpb(:,ib) = totprcpb(:,ib) + (ca(:,15) - 1 )*rain(:) + cnvprcpb(:,ib) = cnvprcpb(:,ib) + (ca(:,15) - 1 )*rainc(:) + enddo if (cplflx .or. cpllnd) then rain_cpl(:) = rain_cpl(:) + (ca(:,15) - 1.0)*drain_cpl(:) @@ -372,5 +375,4 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc endif end subroutine GFS_stochastics_run -!> @} end module GFS_stochastics diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta index 6c55a09de..19f1911f2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_stochastics.meta @@ -83,6 +83,13 @@ dimensions = () type = integer intent = in +[num_diag_buckets] + standard_name = number_of_diagnostic_buckets + long_name = number of diagnostic bucket reset periods + units = count + dimensions = () + type = integer + intent = in [delt] standard_name = timestep_for_physics long_name = physics timestep @@ -148,6 +155,7 @@ type = real kind = kind_phys intent = in + optional = True [vfact_ca] standard_name = cellular_automata_vertical_weight long_name = vertical weight for ca @@ -172,6 +180,7 @@ type = real kind = kind_phys intent = inout + optional = True [skebu_wts] standard_name = skeb_x_wind_weights_from_coupled_process long_name = weights for stochastic skeb perturbation of x wind @@ -180,6 +189,7 @@ type = real kind = kind_phys intent = in + optional = True [skebv_wts] standard_name = skeb_y_wind_weights_from_coupled_process long_name = weights for stochastic skeb perturbation of y wind @@ -188,6 +198,7 @@ type = real kind = kind_phys intent = in + optional = True [shum_wts] standard_name = shum_weights_from_coupled_process long_name = weights for stochastic shum perturbation @@ -196,6 +207,7 @@ type = real kind = kind_phys intent = in + optional = True [diss_est] standard_name = dissipation_estimate_of_air_temperature_at_model_layers long_name = dissipation estimate model layer mean temperature @@ -316,6 +328,7 @@ type = real kind = kind_phys intent = inout + optional = True [gq0_cw] standard_name = cloud_liquid_water_mixing_ratio_of_new_state long_name = cloud condensed water mixing ratio updated by physics @@ -400,7 +413,7 @@ standard_name = accumulated_lwe_thickness_of_precipitation_amount_in_bucket long_name = accumulated total precipitation in bucket units = m - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,number_of_diagnostic_buckets) type = real kind = kind_phys intent = inout @@ -408,7 +421,7 @@ standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket long_name = cumulative convective precipitation in bucket units = m - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,number_of_diagnostic_buckets) type = real kind = kind_phys intent = inout @@ -434,6 +447,7 @@ type = real kind = kind_phys intent = inout + optional = True [snow_cpl] standard_name = cumulative_lwe_thickness_of_snow_amount_for_coupling long_name = total snow precipitation @@ -442,6 +456,7 @@ type = real kind = kind_phys intent = inout + optional = True [drain_cpl] standard_name = tendency_of_lwe_thickness_of_rain_amount_on_dynamics_timestep_for_coupling long_name = change in rain_cpl (coupling_type) @@ -450,6 +465,7 @@ type = real kind = kind_phys intent = in + optional = True [dsnow_cpl] standard_name = tendency_of_lwe_thickness_of_snowfall_amount_on_dynamics_timestep_for_coupling long_name = change in show_cpl (coupling_type) @@ -458,6 +474,7 @@ type = real kind = kind_phys intent = in + optional = True [ntcw] standard_name = index_of_cloud_liquid_water_mixing_ratio_in_tracer_concentration_array long_name = tracer index for cloud condensate (or liquid water) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 index c72e5c7b2..923cee897 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.F90 @@ -30,9 +30,10 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, flag_ logical, intent(in ), dimension(:) :: flag_cice real(kind=kind_phys), intent(in ), dimension(:) :: ctei_rm real(kind=kind_phys), intent(in ), dimension(:) :: xcosz, adjsfcdsw, adjsfcdlw, pgr, xmu, work1, work2 - real(kind=kind_phys), intent(in ), dimension(:) :: ulwsfc_cice + real(kind=kind_phys), intent(in ), dimension(:), optional :: ulwsfc_cice real(kind=kind_phys), intent(in ), dimension(:) :: cice - real(kind=kind_phys), intent(in ), dimension(:,:) :: htrsw, htrlw, htrlwu, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, prslk + real(kind=kind_phys), intent(in ), dimension(:,:) :: htrsw, htrlw, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, prslk + real(kind=kind_phys), intent(in ), dimension(:,:), optional :: htrlwu real(kind=kind_phys), intent(in ), dimension(:,:) :: prsi real(kind=kind_phys), intent(in ), dimension(:,:,:) :: lwhd integer, intent(inout), dimension(:) :: kinver diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta index de4db5f9f..a1f1660ad 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_2.meta @@ -148,6 +148,7 @@ type = real kind = kind_phys intent = in + optional = True [lwhd] standard_name = tendency_of_air_temperature_due_to_integrated_dynamics_through_earths_atmosphere long_name = idea sky lw heating rates @@ -291,6 +292,7 @@ type = real kind = kind_phys intent = in + optional = True [adjsfculw] standard_name = surface_upwelling_longwave_flux long_name = surface upwelling longwave flux at current time @@ -355,6 +357,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 index 5ca20ffc1..b3d59c095 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.F90 @@ -11,16 +11,16 @@ module GFS_suite_interstitial_3 subroutine GFS_suite_interstitial_3_run (otsptflag, & im, levs, nn, cscnv,imfshalcnv, imfdeepcnv, & imfshalcnv_samf, imfdeepcnv_samf, imfdeepcnv_c3, & - imfshalcnv_c3,progsigma, & + imfshalcnv_c3,progsigma,progomega, & first_time_step, restart, & satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, & xlon, xlat, gt0, gq0, sigmain,sigmaout,qmicro, & - imp_physics, imp_physics_mg, & + omegain,omegaout,imp_physics, imp_physics_mg, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & imp_physics_gfdl, imp_physics_thompson, dtidx, ntlnc, & imp_physics_wsm6, imp_physics_fer_hires, prsi, ntinc, & - imp_physics_nssl, & + imp_physics_nssl, imp_physics_tempo, & prsl, prslk, rhcbot,rhcpbl, rhctop, rhcmax, islmsk, & work1, work2, kpbl, kinver, ras, me, save_lnc, save_inc, & ldiag3d, qdiag3d, index_of_process_conv_trans, & @@ -35,10 +35,10 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & integer, intent(in ) :: im, levs, nn, ntrac, ntcw, ntiw, ntclamt, ntrw, ntsw,& ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, & - imp_physics_nssl, me, index_of_process_conv_trans + imp_physics_nssl, imp_physics_tempo, me, index_of_process_conv_trans integer, intent(in ), dimension(:) :: islmsk, kpbl, kinver logical, intent(in ) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras, progsigma - logical, intent(in ) :: first_time_step, restart + logical, intent(in ) :: first_time_step, restart, progomega integer, intent(in ) :: imfshalcnv, imfdeepcnv, imfshalcnv_samf,imfdeepcnv_samf integer, intent(in ) :: imfshalcnv_c3,imfdeepcnv_c3 integer, intent(in) :: ntinc, ntlnc @@ -54,8 +54,8 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & real(kind=kind_phys), intent(in ), dimension(:,:) :: gt0 real(kind=kind_phys), intent(in ), dimension(:,:,:) :: gq0 - real(kind=kind_phys), intent(inout ), dimension(:,:) :: sigmain - real(kind=kind_phys), intent(inout ), dimension(:,:) :: sigmaout,qmicro + real(kind=kind_phys), intent(inout ), dimension(:,:), optional :: sigmain, omegain + real(kind=kind_phys), intent(inout ), dimension(:,:), optional :: sigmaout, qmicro, omegaout real(kind=kind_phys), intent(inout), dimension(:,:) :: rhc, save_qc ! save_qi is not allocated for Zhao-Carr MP real(kind=kind_phys), intent(inout), dimension(:,:) :: save_qi @@ -81,7 +81,7 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & errmsg = '' errflg = 0 - ! In case of using prognostic updraf area fraction, initialize area fraction here + ! In case of using prognostic updraft area fraction, initialize area fraction here ! since progsigma_calc is called from both deep and shallow schemes. if(((imfshalcnv == imfshalcnv_samf) .or. (imfdeepcnv == imfdeepcnv_samf) & .or. (imfshalcnv == imfshalcnv_c3) .or. (imfdeepcnv == imfdeepcnv_c3)) & @@ -102,7 +102,26 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & enddo endif - + ! In case of using prognostic updraft velocity, initialize updraft velocity here + ! since progomega_calc is called from both deep and shallow schemes. + if(((imfshalcnv == imfshalcnv_samf) .or. (imfdeepcnv == imfdeepcnv_samf) & + .or. (imfshalcnv == imfshalcnv_c3) .or. (imfdeepcnv == imfdeepcnv_c3)) & + .and. progomega)then + if(first_time_step .and. .not. restart)then + do k=1,levs + do i=1,im + omegain(i,k)=0.0 + omegaout(i,k)=0.0 + enddo + enddo + endif + do k=1,levs + do i=1,im + omegaout(i,k)=0.0 + enddo + enddo + endif + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then tracers = 2 do n=2,ntrac @@ -187,7 +206,8 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & enddo elseif (imp_physics == imp_physics_gfdl) then clw(1:im,:,1) = gq0(1:im,:,ntcw) - elseif (imp_physics == imp_physics_thompson) then + elseif (imp_physics == imp_physics_thompson .or. & + imp_physics == imp_physics_tempo) then do k=1,levs do i=1,im clw(i,k,1) = gq0(i,k,ntiw) ! ice @@ -219,7 +239,8 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, & enddo endif - if(imp_physics == imp_physics_thompson .and. ldiag3d .and. qdiag3d) then + if((imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) & + .and. ldiag3d .and. qdiag3d) then if(dtidx(100+ntlnc,index_of_process_conv_trans)>0) then save_lnc = gq0(:,:,ntlnc) endif diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta index 22f57e354..4cf339e4d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_3.meta @@ -92,6 +92,13 @@ dimensions = () type = logical intent = in +[progomega] + standard_name = do_prognostic_updraft_velocity + long_name = flag for prognostic omega in cumuls scheme + units = flag + dimensions = () + type = logical + intent = in [first_time_step] standard_name = flag_for_first_timestep long_name = flag for first time step for time integration loop (cold/warmstart) @@ -244,6 +251,7 @@ type = real kind = kind_phys intent = inout + optional = True [sigmaout] standard_name = updraft_area_fraction_updated_by_physics long_name = convective updraft area fraction updated by physics @@ -252,6 +260,7 @@ type = real kind = kind_phys intent = inout + optional = True [qmicro] standard_name = instantaneous_tendency_of_specific_humidity_due_to_microphysics long_name = moisture tendency due to microphysics @@ -260,6 +269,25 @@ type = real kind = kind_phys intent = out + optional = True +[omegain] + standard_name = prognostic_updraft_velocity_in_convection + long_name = convective updraft velocity + units = Pa s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in + optional = True +[omegaout] + standard_name = updraft_velocity_updated_by_physics + long_name = convective updraft velocity updated by physics + units = Pa s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True [imp_physics] standard_name = control_for_microphysics_scheme long_name = choice of microphysics scheme @@ -302,6 +330,13 @@ dimensions = () type = integer intent = in +[imp_physics_tempo] + standard_name = identifier_for_tempo_microphysics_scheme + long_name = choice of TEMPO microphysics scheme + units = flag + dimensions = () + type = integer + intent = in [imp_physics_wsm6] standard_name = identifier_for_wsm6_microphysics_scheme long_name = choice of WSM6 microphysics scheme diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 index cbabb991b..f9a2b76ea 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90 @@ -10,13 +10,19 @@ module GFS_suite_interstitial_4 !! subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntrac, ntcw, ntiw, ntclamt, & ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, ntccn, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & - imp_physics_nssl, nssl_invertccn, nssl_ccn_on, & + imp_physics_nssl, imp_physics_tempo, nssl_invertccn, nssl_ccn_on, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, convert_dry_rho, dtf, save_qc, save_qi, con_pi, dtidx, dtend,& index_of_process_conv_trans, gq0, clw, prsl, save_tcp, con_rd, con_eps, nssl_cccn, nwfa, spechum, ldiag3d, & qdiag3d, save_lnc, save_inc, ntk, ntke, otsptflag, errmsg, errflg) use machine, only: kind_phys - use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber + use module_mp_thompson_make_number_concentrations, only: & + make_IceNumber_thompson => make_IceNumber, & + make_DropletNumber_thompson => make_DropletNumber + + use module_mp_tempo_utils, only: & + make_IceNumber_tempo => make_IceNumber, & + make_DropletNumber_tempo => make_DropletNumber implicit none @@ -25,7 +31,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr logical, intent(in) :: otsptflag(:)! on/off switch for tracer transport by updraft and integer, intent(in ) :: im, levs, tracers_total, ntrac, ntcw, ntiw, ntclamt, ntrw, & ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, ntccn, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & - imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_nssl + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_nssl, imp_physics_tempo logical, intent(in) :: ltaerosol, convert_dry_rho logical, intent(in) :: nssl_ccn_on, nssl_invertccn @@ -37,7 +43,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr ! dtend and dtidx are only allocated if ldiag3d logical, intent(in) :: ldiag3d, qdiag3d - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + real(kind=kind_phys), dimension(:,:,:), intent(inout), optional :: dtend integer, dimension(:,:), intent(in) :: dtidx integer, intent(in) :: index_of_process_conv_trans,ntk,ntke @@ -45,7 +51,8 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr real(kind=kind_phys), dimension(:,:,:), intent(inout) :: clw real(kind=kind_phys), dimension(:,:), intent(in) :: prsl real(kind=kind_phys), intent(in) :: con_rd, con_eps, nssl_cccn - real(kind=kind_phys), dimension(:,:), intent(in) :: nwfa, save_tcp + real(kind=kind_phys), dimension(:,:), intent(in), optional :: nwfa + real(kind=kind_phys), dimension(:,:), intent(in) :: save_tcp real(kind=kind_phys), dimension(:,:), intent(in) :: spechum character(len=*), intent( out) :: errmsg @@ -210,7 +217,8 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr enddo endif - if (imp_physics == imp_physics_thompson .and. (ntlnc>0 .or. ntinc>0)) then + if ((imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) .and. & + (ntlnc>0 .or. ntinc>0)) then if_convert_dry_rho: if (convert_dry_rho) then do k=1,levs do i=1,im @@ -224,7 +232,11 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) / (one-spechum(i,k)) !> - Convert number concentration from moist to dry nc_mp(i,k) = gq0(i,k,ntlnc) / (one-spechum(i,k)) - nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) + if (imp_physics == imp_physics_thompson) then + nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber_thompson(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) + else + nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber_tempo(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) + endif !> - Convert number concentrations from dry to moist gq0(i,k,ntlnc) = nc_mp(i,k) / (one+qv_mp(i,k)) endif @@ -232,8 +244,12 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr !> - Convert moist mixing ratio to dry mixing ratio qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) / (one-spechum(i,k)) !> - Convert number concentration from moist to dry - ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k)) - ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) + ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k)) + if (imp_physics == imp_physics_thompson) then + ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber_thompson(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) + else + ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber_tempo(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) + endif !> - Convert number concentrations from dry to moist gq0(i,k,ntinc) = ni_mp(i,k) / (one+qv_mp(i,k)) endif @@ -249,13 +265,21 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr !> - Update cloud water mixing ratio qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) !> - Update cloud water number concentration - gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) + if (imp_physics == imp_physics_thompson) then + gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) + make_DropletNumber_thompson(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) + else + gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) + make_DropletNumber_tempo(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) + endif endif if (ntinc>0) then !> - Update cloud ice mixing ratio qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) !> - Update cloud ice number concentration - gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) + if (imp_physics == imp_physics_thompson) then + gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) + make_IceNumber_thompson(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) + else + gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) + make_IceNumber_tempo(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) + endif endif enddo enddo @@ -290,4 +314,4 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr end subroutine GFS_suite_interstitial_4_run - end module GFS_suite_interstitial_4 \ No newline at end of file + end module GFS_suite_interstitial_4 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta index c0df52f1a..718b6ab95 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta @@ -2,8 +2,9 @@ [ccpp-table-properties] name = GFS_suite_interstitial_4 type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F + dependencies = MP/TEMPO/TEMPO/module_mp_tempo_utils.F90 dependencies = MP/Thompson/module_mp_thompson_make_number_concentrations.F90 ######################################################################## @@ -157,6 +158,13 @@ dimensions = () type = integer intent = in +[imp_physics_tempo] + standard_name = identifier_for_tempo_microphysics_scheme + long_name = choice of TEMPO microphysics scheme + units = flag + dimensions = () + type = integer + intent = in [imp_physics_zhao_carr] standard_name = identifier_for_zhao_carr_microphysics_scheme long_name = choice of Zhao-Carr microphysics scheme @@ -311,6 +319,7 @@ type = real kind = kind_phys intent = in + optional = True [spechum] standard_name = specific_humidity long_name = water vapor specific humidity @@ -334,6 +343,7 @@ type = real kind = kind_phys intent = inout + optional = True [ntk] standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer long_name = index for turbulent kinetic energy in the convectively transported tracer array diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.F90 deleted file mode 100644 index d74924d95..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.F90 +++ /dev/null @@ -1,32 +0,0 @@ -!> \file GFS_suite_interstitial_phys_reset.f90 -!! Contains code to reset physics-related interstitial variables in the GFS physics suite. - - module GFS_suite_interstitial_phys_reset - - contains - -!> \section arg_table_GFS_suite_interstitial_phys_reset_run Argument Table -!! \htmlinclude GFS_suite_interstitial_phys_reset_run.html -!! - subroutine GFS_suite_interstitial_phys_reset_run (Interstitial, Model, errmsg, errflg) - - use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type - use CCPP_typedefs, only: GFS_interstitial_type - - implicit none - - ! interface variables - type(GFS_interstitial_type), intent(inout) :: Interstitial - type(GFS_control_type), intent(in ) :: Model - character(len=*), intent( out) :: errmsg - integer, intent( out) :: errflg - - errmsg = '' - errflg = 0 - - call Interstitial%phys_reset(Model) - - end subroutine GFS_suite_interstitial_phys_reset_run - - end module GFS_suite_interstitial_phys_reset \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.meta deleted file mode 100644 index 947a1950f..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_phys_reset.meta +++ /dev/null @@ -1,39 +0,0 @@ -######################################################################## -[ccpp-table-properties] - name = GFS_suite_interstitial_phys_reset - type = scheme - dependencies = ../../hooks/machine.F - -######################################################################## -[ccpp-arg-table] - name = GFS_suite_interstitial_phys_reset_run - type = scheme -[Interstitial] - standard_name = GFS_interstitial_type_instance - long_name = derived type GFS_interstitial_type in FV3 - units = DDT - dimensions = () - type = GFS_interstitial_type - intent = inout -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT - dimensions = () - type = GFS_control_type - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.F90 deleted file mode 100644 index 78cd23501..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.F90 +++ /dev/null @@ -1,32 +0,0 @@ -!> \file GFS_suite_interstitial_rad_reset.f90 -!! Contains code to reset radiation-related interstitial variables - - module GFS_suite_interstitial_rad_reset - - contains - -!> \section arg_table_GFS_suite_interstitial_rad_reset_run Argument Table -!! \htmlinclude GFS_suite_interstitial_rad_reset_run.html -!! - subroutine GFS_suite_interstitial_rad_reset_run (Interstitial, Model, errmsg, errflg) - - use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type - use CCPP_typedefs, only: GFS_interstitial_type - - implicit none - - ! interface variables - type(GFS_interstitial_type), intent(inout) :: Interstitial - type(GFS_control_type), intent(in) :: Model - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - errmsg = '' - errflg = 0 - - call Interstitial%rad_reset(Model) - - end subroutine GFS_suite_interstitial_rad_reset_run - - end module GFS_suite_interstitial_rad_reset \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.meta deleted file mode 100644 index aaaff02f5..000000000 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_rad_reset.meta +++ /dev/null @@ -1,38 +0,0 @@ -[ccpp-table-properties] - name = GFS_suite_interstitial_rad_reset - type = scheme - dependencies = ../../hooks/machine.F - -######################################################################## -[ccpp-arg-table] - name = GFS_suite_interstitial_rad_reset_run - type = scheme -[Interstitial] - standard_name = GFS_interstitial_type_instance - long_name = derived type GFS_interstitial_type in FV3 - units = DDT - dimensions = () - type = GFS_interstitial_type - intent = inout -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT - dimensions = () - type = GFS_control_type - intent = in -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 index 53867f6cc..e5a20a77d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.F90 @@ -1,24 +1,20 @@ -! ######################################################################################### !> \file GFS_suite_stateout_update.f90 !! Update the state variables due to process-split physics from accumulated tendencies !! during that phase. !! Update gas concentrations, if using prognostic photolysis schemes. !! Also, set bounds on the mass-weighted rime factor when using Ferrier-Aligo microphysics. -! ######################################################################################### module GFS_suite_stateout_update - use machine, only: kind_phys - use module_ozphys, only: ty_ozphys + use machine, only: kind_phys implicit none + contains -! ######################################################################################### + !> \section arg_table_GFS_suite_stateout_update_run Argument Table !! \htmlinclude GFS_suite_stateout_update_run.html !! -! ######################################################################################### subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs, qgrs, & - dudt, dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, oz0, ntiw, nqrimef, imp_physics, & - imp_physics_fer_hires, epsq, ozphys, oz_phys_2015, oz_phys_2006, con_1ovg, prsl, & - dp, ozpl, qdiag3d, do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz, errmsg, errflg) + dudt, dvdt, dtdt, dqdt, gt0, gu0, gv0, gq0, ntiw, nqrimef, imp_physics, & + imp_physics_fer_hires, epsq, errmsg, errflg) ! Inputs integer, intent(in ) :: im @@ -26,25 +22,14 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs integer, intent(in ) :: ntrac integer, intent(in ) :: imp_physics,imp_physics_fer_hires integer, intent(in ) :: ntiw, nqrimef - real(kind=kind_phys), intent(in ) :: dtp, epsq, con_1ovg - real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs, prsl, dp - real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs, ozpl + real(kind=kind_phys), intent(in ) :: dtp, epsq + real(kind=kind_phys), intent(in ), dimension(:,:) :: tgrs, ugrs, vgrs + real(kind=kind_phys), intent(in ), dimension(:,:,:) :: qgrs real(kind=kind_phys), intent(in ), dimension(:,:) :: dudt, dvdt, dtdt real(kind=kind_phys), intent(in ), dimension(:,:,:) :: dqdt - logical, intent(in) :: qdiag3d - logical, intent(in) :: oz_phys_2015 - logical, intent(in) :: oz_phys_2006 - type(ty_ozphys), intent(in) :: ozphys - - ! Outputs (optional) - real(kind=kind_phys), intent(inout), dimension(:,:) :: & - do3_dt_prd, & ! Physics tendency: production and loss effect - do3_dt_ozmx, & ! Physics tendency: ozone mixing ratio effect - do3_dt_temp, & ! Physics tendency: temperature effect - do3_dt_ohoz ! Physics tendency: overhead ozone effect ! Outputs - real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0, oz0 + real(kind=kind_phys), intent(out), dimension(:,:) :: gt0, gu0, gv0 real(kind=kind_phys), intent(out), dimension(:,:,:) :: gq0 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -63,17 +48,6 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, tgrs, ugrs, vgrs gv0(:,:) = vgrs(:,:) + dvdt(:,:) * dtp gq0(:,:,:) = qgrs(:,:,:) + dqdt(:,:,:) * dtp - ! If using photolysis physics schemes, update (prognostic) gas concentrations using - ! updated state. - if (oz_phys_2015) then - call ozphys%run_o3prog_2015(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, qdiag3d, & - do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) - endif - if (oz_phys_2006) then - call ozphys%run_o3prog_2006(con_1ovg, dtp, prsl, gt0, dp, ozpl, oz0, qdiag3d, & - do3_dt_prd, do3_dt_ozmx, do3_dt_temp, do3_dt_ohoz) - endif - ! If using Ferrier-Aligo microphysics, set bounds on the mass-weighted rime factor. if (imp_physics == imp_physics_fer_hires) then do k=1,levs diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta index 608ee83da..8a0d784f2 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_stateout_update.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_suite_stateout_update type = scheme - dependencies = ../../hooks/machine.F,../../photochem/module_ozphys.F90 + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -37,34 +37,6 @@ type = real kind = kind_phys intent = in -[ozphys] - standard_name = dataset_for_ozone_physics - long_name = dataset for NRL ozone physics - units = mixed - dimensions = () - type = ty_ozphys - intent = in -[qdiag3d] - standard_name = flag_for_tracer_diagnostics_3D - long_name = flag for 3d tracer diagnostic fields - units = flag - dimensions = () - type = logical - intent = in -[oz_phys_2015] - standard_name = flag_for_nrl_2015_ozone_scheme - long_name = flag for new (2015) ozone physics - units = flag - dimensions = () - type = logical - intent = in -[oz_phys_2006] - standard_name = flag_for_nrl_2006_ozone_scheme - long_name = flag for new (2006) ozone physics - units = flag - dimensions = () - type = logical - intent = in [tgrs] standard_name = air_temperature long_name = model layer mean temperature @@ -161,14 +133,6 @@ type = real kind = kind_phys intent = out -[oz0] - standard_name = ozone_concentration_of_new_state - long_name = ozone concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [ntiw] standard_name = index_of_cloud_ice_mixing_ratio_in_tracer_concentration_array long_name = tracer index for ice water @@ -205,70 +169,6 @@ type = real kind = kind_phys intent = in -[con_1ovg] - standard_name = one_divided_by_the_gravitational_acceleration - long_name = inverse of gravitational acceleration - units = s2 m-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[prsl] - standard_name = air_pressure - long_name = mid-layer pressure - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = mixed - dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_data) - type = real - kind = kind_phys - intent = in -[dp] - standard_name = air_pressure_difference_between_midlayers - long_name = difference between mid-layer pressures - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = in -[do3_dt_prd] - standard_name = ozone_tendency_due_to_production_and_loss_rate - long_name = ozone tendency due to production and loss rate - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[do3_dt_ozmx] - standard_name = ozone_tendency_due_to_ozone_mixing_ratio - long_name = ozone tendency due to ozone mixing ratio - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[do3_dt_temp] - standard_name = ozone_tendency_due_to_temperature - long_name = ozone tendency due to temperature - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout -[do3_dt_ohoz] - standard_name = ozone_tendency_due_to_overhead_ozone_column - long_name = ozone tendency due to overhead ozone column - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys - intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 index 5ceeb6ac8..4cb2a017b 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.F90 @@ -18,7 +18,7 @@ module GFS_surface_composites_inter !! subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis_lnd, semis_ice, & adjsfcdlw, gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_wat,& - adjsfcusw, adjsfcdsw, adjsfcnsw, use_lake_model, errmsg, errflg) + adjsfcusw, adjsfcdsw, adjsfcnsw, errmsg, errflg) implicit none @@ -30,7 +30,6 @@ subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis adjsfcdlw, adjsfcdsw, adjsfcnsw real(kind=kind_phys), dimension(:), intent(inout) :: gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_wat real(kind=kind_phys), dimension(:), intent(out) :: adjsfcusw - integer, dimension(:), intent(in) :: use_lake_model ! CCPP error handling character(len=*), intent(out) :: errmsg diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta index ef3005583..d24779ac6 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_inter.meta @@ -116,13 +116,6 @@ type = real kind = kind_phys intent = in -[use_lake_model] - standard_name = flag_for_using_lake_model - long_name = flag indicating lake points using a lake model - units = flag - dimensions = (horizontal_loop_extent) - type = integer - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 index ab7528a62..d83ecc097 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 @@ -23,25 +23,25 @@ module GFS_surface_composites_post !! \htmlinclude GFS_surface_composites_post_run.html !! subroutine GFS_surface_composites_post_run ( & - im, kice, km, rd, rvrdm1, cplflx, cplwav2atm, frac_grid, flag_cice, thsfc_loc, islmsk, dry, wet, icy, wind, t1, q1, prsl1, & - landfrac, lakefrac, oceanfrac, zorl, zorlo, zorll, zorli, garea, frac_ice, & + im, kice, km, rd, rvrdm1, cplflx, cplwav2atm, cpl_fire, frac_grid, flag_cice, thsfc_loc, islmsk, dry, wet, icy, & + use_cdeps_data, mask_dat, wind, t1, q1, prsl1, landfrac, lakefrac, oceanfrac, zorl, zorlo, zorll, zorli, garea, frac_ice, & cd, cd_wat, cd_lnd, cd_ice, cdq, cdq_wat, cdq_lnd, cdq_ice, rb, rb_wat, rb_lnd, rb_ice, stress, stress_wat, stress_lnd, & stress_ice, ffmm, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh, ffhh_wat, ffhh_lnd, ffhh_ice, uustar, uustar_wat, uustar_lnd, & uustar_ice, fm10, fm10_wat, fm10_lnd, fm10_ice, fh2, fh2_wat, fh2_lnd, fh2_ice, tsurf_wat, tsurf_lnd, tsurf_ice, & cmm, cmm_wat, cmm_lnd, cmm_ice, chh, chh_wat, chh_lnd, chh_ice, gflx, gflx_wat, gflx_lnd, gflx_ice, ep1d, ep1d_wat, & ep1d_lnd, ep1d_ice, weasd, weasd_lnd, weasd_ice, snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & - tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, qss, qss_wat, qss_lnd, & - qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, tiice, & + tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, hflx_fire, evap_fire, & + qss, qss_wat, qss_lnd, qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, tiice, & sigmaf, zvfun, lheatstrg, h0facu, h0facs, hflxq, hffac, stc, lkm, iopt_lake, iopt_lake_clm, use_lake_model, & grav, prsik1, prslk1, prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice, huge, errmsg, errflg) implicit none integer, intent(in) :: im, kice, km, lkm, iopt_lake, iopt_lake_clm - logical, intent(in) :: cplflx, frac_grid, cplwav2atm, frac_ice - logical, intent(in) :: lheatstrg + logical, intent(in) :: cplflx, frac_grid, cplwav2atm, frac_ice, cpl_fire + logical, intent(in) :: lheatstrg, use_cdeps_data logical, dimension(:), intent(in) :: flag_cice, dry, icy - logical, dimension(:), intent(inout) :: wet + logical, dimension(:), intent(in) :: wet integer, dimension(:), intent(in) :: islmsk, use_lake_model real(kind=kind_phys), dimension(:), intent(in) :: wind, t1, q1, prsl1, landfrac, lakefrac, oceanfrac, & cd_wat, cd_lnd, cd_ice, cdq_wat, cdq_lnd, cdq_ice, rb_wat, rb_lnd, rb_ice, stress_wat, & @@ -51,6 +51,7 @@ subroutine GFS_surface_composites_post_run ( snowd_lnd, snowd_ice, tprcp_wat, tprcp_lnd, tprcp_ice, evap_wat, evap_lnd, evap_ice, hflx_wat, hflx_lnd, & hflx_ice, qss_wat, qss_lnd, qss_ice, tsfc_wat, zorlo, zorll, zorli, garea + real(kind=kind_phys), dimension(:), intent(in), optional :: hflx_fire, evap_fire, mask_dat real(kind=kind_phys), dimension(:), intent(inout) :: zorl, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & fh2, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc @@ -239,7 +240,14 @@ subroutine GFS_surface_composites_post_run ( if (icy(i)) then !tisfc(i) = tisfc(i) ! over lake or ocean ice when uncoupled elseif (wet(i)) then - tisfc(i) = tsfc_wat(i) ! over lake or ocean when uncoupled + !don't overwrite surface skin temperature over ice when using CDEPS inline over the mask + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + tisfc(i) = tsfc_wat(i) ! over lake or ocean when uncoupled + endif + else + tisfc(i) = tsfc_wat(i) ! over lake or ocean when uncoupled + endif else tisfc(i) = tsfcl(i) ! over land endif @@ -255,9 +263,18 @@ subroutine GFS_surface_composites_post_run ( ! tisfc(i) = tsfc(i) ! endif ! endif + if (.not. icy(i)) then - hice(i) = zero - cice(i) = zero + !don't overwrite sea ice thickness/fraction when using CDEPS inline over the mask + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + hice(i) = zero + cice(i) = zero + endif + else + hice(i) = zero + cice(i) = zero + endif endif enddo @@ -275,6 +292,10 @@ subroutine GFS_surface_composites_post_run ( else if (islmsk(i) == 1) then !-- land call composite_land + if (cpl_fire) then + hflx(i) = hflx(i) + hflx_fire(i) + evap(i) = evap(i) + evap_fire(i) + endif elseif (islmsk(i) == 0) then !-- water call composite_wet @@ -334,7 +355,14 @@ subroutine composite_wet tsfco(i) = tsfc_wat(i) ! over lake (and ocean when uncoupled) tsfc(i) = tsfco(i) tsfcl(i) = tsfc(i) - tisfc(i) = tsfc(i) + !don't overwrite surface skin temperature over ice when using CDEPS inline over the mask + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + tisfc(i) = tsfc(i) + endif + else + tisfc(i) = tsfc(i) + endif cmm(i) = cmm_wat(i) chh(i) = chh_wat(i) gflx(i) = gflx_wat(i) @@ -344,8 +372,16 @@ subroutine composite_wet evap(i) = evap_wat(i) hflx(i) = hflx_wat(i) qss(i) = qss_wat(i) - hice(i) = zero - cice(i) = zero + !don't overwrite sea ice thickness/fraction when using CDEPS inline over the mask + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + hice(i) = zero + cice(i) = zero + endif + else + hice(i) = zero + cice(i) = zero + endif end subroutine composite_wet subroutine composite_icy(is_clm) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta index 7224d7221..1d0005e18 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta @@ -2,7 +2,7 @@ [ccpp-table-properties] name = GFS_surface_composites_post type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F,SFC_Layer/UFS/sfc_diff.f ######################################################################## @@ -144,6 +144,22 @@ dimensions = (horizontal_loop_extent) type = logical intent = in +[use_cdeps_data] + standard_name = do_cdeps_inline + long_name = flag for using data provided by CDEPS inline (default false) + units = flag + dimensions = () + type = logical + intent = in +[mask_dat] + standard_name = land_sea_mask_from_data + long_name = landmask + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True [wind] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level @@ -816,6 +832,31 @@ type = real kind = kind_phys intent = in +[hflx_fire] + standard_name = kinematic_surface_upward_sensible_heat_flux_of_fire + long_name = kinematic surface upward sensible heat flux of fire + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[evap_fire] + standard_name = surface_upward_specific_humidity_flux_of_fire + long_name = kinematic surface upward latent heat flux of fire + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[cpl_fire] + standard_name = do_fire_coupling + long_name = flag controlling fire_behavior collection (default off) + units = flag + dimensions = () + type = logical + intent = in [qss] standard_name = surface_specific_humidity long_name = surface air saturation specific humidity diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 index fd16dea59..b6a52d16d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.F90 @@ -21,10 +21,11 @@ module GFS_surface_composites_pre !! \htmlinclude GFS_surface_composites_pre_run.html !! subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_lake_clm, & - flag_cice, cplflx, cplice, cplwav2atm, lsm, lsm_ruc, & + flag_cice, cplflx, cplice, cplwav2atm, lsm, lsm_ruc, use_cdeps_data, mask_dat, & + tsfco_dat, tice_dat, hice_dat, fice_dat, & landfrac, lakefrac, lakedepth, oceanfrac, frland, & dry, icy, lake, use_lake_model, wet, hice, cice, zorlo, zorll, zorli, & - snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & + snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat, tgrs1, & tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, & weasd, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, & tisfc, tsurf_wat, tsurf_lnd, tsurf_ice, & @@ -35,16 +36,19 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l ! Interface variables integer, intent(in ) :: im, lkm, kdt, lsm, lsm_ruc, iopt_lake, iopt_lake_clm - logical, intent(in ) :: cplflx, cplice, cplwav2atm, frac_grid + logical, intent(in ) :: cplflx, cplice, cplwav2atm, frac_grid, use_cdeps_data logical, dimension(:), intent(inout) :: flag_cice logical, dimension(:), intent(inout) :: dry, icy, lake, wet integer, dimension(:), intent(in ) :: use_lake_model real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac + real(kind=kind_phys), dimension(:), intent(in ), optional :: mask_dat + real(kind=kind_phys), dimension(:), intent(in ), optional :: fice_dat, hice_dat, tsfco_dat, tice_dat real(kind=kind_phys), dimension(:), intent(inout) :: cice, hice real(kind=kind_phys), dimension(:), intent( out) :: frland real(kind=kind_phys), dimension(:), intent(in ) :: snowd, tprcp, uustar, weasd, qss - - real(kind=kind_phys), dimension(:), intent(inout) :: tsfc, tsfco, tsfcl, tisfc + real(kind=kind_phys), dimension(:), intent(inout) :: tisfc + real(kind=kind_phys), dimension(:), intent(inout) :: tsfc, tsfco, tsfcl + real(kind=kind_phys), dimension(:), intent(inout) :: tgrs1 real(kind=kind_phys), dimension(:), intent(inout) :: snowd_lnd, snowd_ice, tprcp_wat, & tprcp_lnd, tprcp_ice, tsfc_wat, tsurf_wat,tsurf_lnd, tsurf_ice, & uustar_wat, uustar_lnd, uustar_ice, weasd_lnd, weasd_ice, & @@ -71,6 +75,19 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + if (use_cdeps_data) then + do i=1,im + if (mask_dat(i) > 0.0) then + tisfc(i) = tice_dat(i) + tsurf_ice(i) = tice_dat(i) + hice(i) = hice_dat(i) + cice(i) = fice_dat(i) + tsfc_wat(i) = tsfco_dat(i) + tsurf_wat(i) = tsfco_dat(i) + endif + enddo + endif do i=1,im if(use_lake_model(i) > 0) then @@ -86,7 +103,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (oceanfrac(i) > zero) then if (cice(i) >= min_seaice) then icy(i) = .true. - tisfc(i) = max(timin, min(tisfc(i), tgice)) if (cplflx) then islmsk_cice(i) = 4 flag_cice(i) = .true. @@ -111,7 +127,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (cice(i) >= min_lakeice) then icy(i) = .true. islmsk(i) = 2 - tisfc(i) = max(timin, min(tisfc(i), tgice)) else cice(i) = zero hice(i) = zero @@ -151,7 +166,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (oceanfrac(i) > zero) then if (cice(i) >= min_seaice) then icy(i) = .true. - tisfc(i) = max(timin, min(tisfc(i), tgice)) ! This cplice namelist option was added to deal with the ! situation of the FV3ATM-HYCOM coupling without an active sea ! ice (e.g., CICE6) component. By default, the cplice is true @@ -182,14 +196,32 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l else if (icy(i)) tsfco(i) = max(tisfc(i), tgice) endif + else + wet(i) = .false. ! no open ocean + endif + if(wet(i) .and. tsfco(i) < 0) then + 1013 format('using tgrs1 instead of bad tsfco(i=',I0,')=',E20.12,' slmsk(i)=',E12.7,' cice(i)=',E12.7,' islmsk(i)=',I0,' islmsk_cice(i)=',I0,' oceanfrac(i)=',E12.7,' cplice=',L1,' icy(i)=',L1,' cplflx=',L1) + write(0,1013) i,tsfco(i),slmsk(i),cice(i),islmsk(i),islmsk_cice(i),oceanfrac(i),cplice,icy(i),cplflx + tsfco(i) = tgrs1(i) + endif + !Set icy conditions according to CDEPS GL (Oceanfrac > 0) + if (use_cdeps_data) then + if (mask_dat(i) > 0.0) then + if (cice(i) >= min_lakeice) then + icy(i) = .true. + islmsk(i) = 2 + else + icy(i) = .false. + cice(i) = zero + hice(i) = zero + islmsk(i) = 0 + endif + endif endif else ! Not ocean and not land is_clm = lkm>0 .and. iopt_lake==iopt_lake_clm .and. use_lake_model(i)>0 if (cice(i) >= min_lakeice) then icy(i) = .true. - if(.not.is_clm) then - tisfc(i) = max(timin, min(tisfc(i), tgice)) - endif islmsk(i) = 2 else cice(i) = zero @@ -222,9 +254,16 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if (wet(i)) then ! Water uustar_wat(i) = uustar(i) + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + tsfc_wat(i) = tsfco(i) + tsurf_wat(i) = tsfco(i) + endif + else tsfc_wat(i) = tsfco(i) - tsurf_wat(i) = tsfco(i) - zorlo(i) = max(1.0e-5, min(one, zorlo(i))) + tsurf_wat(i) = tsfco(i) + endif + zorlo(i) = max(1.0e-5, min(one, zorlo(i))) ! DH* else zorlo(i) = huge @@ -249,10 +288,10 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l if(lsm /= lsm_ruc .and. .not.is_clm) then weasd_ice(i) = weasd(i) endif - tsurf_ice(i) = tisfc(i) - ep1d_ice(i) = zero - gflx_ice(i) = zero - zorli(i) = max(1.0e-5, min(one, zorli(i))) + tsurf_ice(i) = tisfc(i) + ep1d_ice(i) = zero + gflx_ice(i) = zero + zorli(i) = max(1.0e-5, min(one, zorli(i))) ! DH* else zorli(i) = huge diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta index 33e2f0523..935b0778f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_pre.meta @@ -70,6 +70,58 @@ dimensions = () type = integer intent = in +[use_cdeps_data] + standard_name = do_cdeps_inline + long_name = flag for using data provided by CDEPS inline (default false) + units = flag + dimensions = () + type = logical + intent = in +[mask_dat] + standard_name = land_sea_mask_from_data + long_name = landmask + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[tsfco_dat] + standard_name = sea_surface_temperature_from_data + long_name = sfc temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[tice_dat] + standard_name = surface_skin_temperature_over_ice_from_data + long_name = surface skin temperature over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[hice_dat] + standard_name = sea_ice_thickness_from_data + long_name = sea-ice thickness + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[fice_dat] + standard_name = sea_ice_area_fraction_of_sea_area_fraction_from_data + long_name = sea-ice concentration [0,1] + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True [landfrac] standard_name = land_area_fraction long_name = fraction of horizontal grid area occupied by land @@ -223,6 +275,14 @@ type = real kind = kind_phys intent = inout +[tgrs1] + standard_name = air_temperature_at_surface_adjacent_layer + long_name = mean temperature at lowest model layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [tprcp] standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total precipitation amount in each time step diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 index 7e8cfa753..648f6bf81 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 @@ -45,7 +45,7 @@ end subroutine GFS_surface_generic_post_init !> \section arg_table_GFS_surface_generic_post_run Argument Table !! \htmlinclude GFS_surface_generic_post_run.html !! - subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpllnd, lssav, dry, icy, wet, & + subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpllnd, cpl_fire, lssav, dry, icy, wet, & lsm, lsm_noahmp, dtf, ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1, & adjsfcdlw, adjsfcdsw, adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_wat, adjnirbmu, adjnirdfu, & adjvisbmu, adjvisdfu, t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, pah, pahi, & @@ -59,21 +59,23 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl implicit none integer, intent(in) :: im - logical, intent(in) :: cplflx, cplaqm, cplchm, cplwav, cpllnd, lssav + logical, intent(in) :: cplflx, cplaqm, cplchm, cplwav, cpllnd, cpl_fire, lssav logical, dimension(:), intent(in) :: dry, icy, wet integer, intent(in) :: lsm, lsm_noahmp real(kind=kind_phys), intent(in) :: dtf real(kind=kind_phys), dimension(:), intent(in) :: ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1, adjsfcdlw, adjsfcdsw, & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_wat, adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & - t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, pah, ecan, etran, edir, & + t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, pah, ecan, etran, edir + real(kind=kind_phys), dimension(:), intent(in), optional :: & waxy - real(kind=kind_phys), dimension(:), intent(inout) :: epi, gfluxi, t1, q1, u1, v1, dlwsfci_cpl, dswsfci_cpl, dlwsfc_cpl, & + real(kind=kind_phys), dimension(:), intent(inout) :: epi, gfluxi, t1, q1, u1, v1,gflux, evbsa, & + evcwa, transa, sbsnoa, snowca, snohfa, ep, tecan, tetran, tedir + real(kind=kind_phys), dimension(:), intent(inout), optional :: pahi, dlwsfci_cpl, dswsfci_cpl, dlwsfc_cpl, & dswsfc_cpl, dnirbmi_cpl, dnirdfi_cpl, dvisbmi_cpl, dvisdfi_cpl, dnirbm_cpl, dnirdf_cpl, dvisbm_cpl, dvisdf_cpl, & nlwsfci_cpl, nlwsfc_cpl, t2mi_cpl, q2mi_cpl, u10mi_cpl, v10mi_cpl, tsfci_cpl, psurfi_cpl, nnirbmi_cpl, nnirdfi_cpl, & - nvisbmi_cpl, nvisdfi_cpl, nswsfci_cpl, nswsfc_cpl, nnirbm_cpl, nnirdf_cpl, nvisbm_cpl, nvisdf_cpl, gflux, evbsa, & - evcwa, transa, sbsnoa, snowca, snohfa, ep, paha, tecan, tetran, tedir, twa, pahi + nvisbmi_cpl, nvisdfi_cpl, nswsfci_cpl, nswsfc_cpl, nnirbm_cpl, nnirdf_cpl, nvisbm_cpl, nvisdf_cpl, paha, twa real(kind=kind_phys), dimension(:), intent(inout) :: runoff, srunoff real(kind=kind_phys), dimension(:), intent(in) :: drain, runof @@ -134,9 +136,20 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl dswsfci_cpl (i) = adjsfcdsw(i) dlwsfc_cpl (i) = dlwsfc_cpl(i) + adjsfcdlw(i)*dtf dswsfc_cpl (i) = dswsfc_cpl(i) + adjsfcdsw(i)*dtf + enddo + endif + + if (cplflx .or. cpllnd .or. cpl_fire) then + do i=1,im psurfi_cpl (i) = pgr(i) enddo endif + if (cplflx .or. cpl_fire) then + do i=1,im + t2mi_cpl (i) = t2m(i) + q2mi_cpl (i) = q2m(i) + enddo + endif if (cplflx) then do i=1,im @@ -153,8 +166,6 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl nlwsfci_cpl(i) = adjsfcdlw(i) - adjsfculw_wat(i) endif nlwsfc_cpl (i) = nlwsfc_cpl(i) + nlwsfci_cpl(i)*dtf - t2mi_cpl (i) = t2m(i) - q2mi_cpl (i) = q2m(i) enddo endif diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta index 2c28b17d7..5e7949b8f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta @@ -126,6 +126,13 @@ dimensions = () type = logical intent = in +[cpl_fire] + standard_name = do_fire_coupling + long_name = flag controlling fire_behavior collection (default off) + units = flag + dimensions = () + type = logical + intent = in [lssav] standard_name = flag_for_diagnostics long_name = logical flag for storing diagnostics @@ -448,6 +455,7 @@ type = real kind = kind_phys intent = in + optional = True [epi] standard_name = instantaneous_surface_potential_evaporation long_name = instantaneous sfc potential evaporation @@ -504,6 +512,7 @@ type = real kind = kind_phys intent = inout + optional = True [dswsfci_cpl] standard_name = surface_downwelling_shortwave_flux_for_coupling long_name = instantaneous sfc downward sw flux @@ -512,6 +521,7 @@ type = real kind = kind_phys intent = inout + optional = True [dlwsfc_cpl] standard_name = cumulative_surface_downwelling_longwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc downward lw flux mulitplied by timestep @@ -520,6 +530,7 @@ type = real kind = kind_phys intent = inout + optional = True [dswsfc_cpl] standard_name = cumulative_surface_downwelling_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc downward sw flux multiplied by timestep @@ -528,6 +539,7 @@ type = real kind = kind_phys intent = inout + optional = True [dnirbmi_cpl] standard_name = surface_downwelling_direct_nir_shortwave_flux_for_coupling long_name = instantaneous sfc nir beam downward sw flux @@ -536,6 +548,7 @@ type = real kind = kind_phys intent = inout + optional = True [dnirdfi_cpl] standard_name = surface_downwelling_diffuse_nir_shortwave_flux_for_coupling long_name = instantaneous sfc nir diff downward sw flux @@ -544,6 +557,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvisbmi_cpl] standard_name = surface_downwelling_direct_uv_and_vis_shortwave_flux_for_coupling long_name = instantaneous sfc uv+vis beam downward sw flux @@ -552,6 +566,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvisdfi_cpl] standard_name = surface_downwelling_diffuse_uv_and_vis_shortwave_flux_for_coupling long_name = instantaneous sfc uv+vis diff downward sw flux @@ -560,6 +575,7 @@ type = real kind = kind_phys intent = inout + optional = True [dnirbm_cpl] standard_name = cumulative_surface_downwelling_direct_nir_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc nir beam downward sw flux multiplied by timestep @@ -568,6 +584,7 @@ type = real kind = kind_phys intent = inout + optional = True [dnirdf_cpl] standard_name = cumulative_surface_downwelling_diffuse_nir_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc nir diff downward sw flux multiplied by timestep @@ -576,6 +593,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvisbm_cpl] standard_name = cumulative_surface_downwelling_direct_uv_and_vis_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc uv+vis beam dnwd sw flux multiplied by timestep @@ -584,6 +602,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvisdf_cpl] standard_name = cumulative_surface_downwelling_diffuse_uv_and_vis_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc uv+vis diff dnwd sw flux multiplied by timestep @@ -592,6 +611,7 @@ type = real kind = kind_phys intent = inout + optional = True [nlwsfci_cpl] standard_name = surface_net_downwelling_longwave_flux_for_coupling long_name = instantaneous net sfc downward lw flux @@ -600,6 +620,7 @@ type = real kind = kind_phys intent = inout + optional = True [nlwsfc_cpl] standard_name = cumulative_surface_net_downwelling_longwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net downward lw flux multiplied by timestep @@ -608,6 +629,7 @@ type = real kind = kind_phys intent = inout + optional = True [t2mi_cpl] standard_name = temperature_at_2m_for_coupling long_name = instantaneous T2m @@ -616,6 +638,7 @@ type = real kind = kind_phys intent = inout + optional = True [q2mi_cpl] standard_name = specific_humidity_at_2m_for_coupling long_name = instantaneous Q2m @@ -624,6 +647,7 @@ type = real kind = kind_phys intent = inout + optional = True [u10mi_cpl] standard_name = x_wind_at_10m_for_coupling long_name = instantaneous U10m @@ -632,6 +656,7 @@ type = real kind = kind_phys intent = inout + optional = True [v10mi_cpl] standard_name = y_wind_at_10m_for_coupling long_name = instantaneous V10m @@ -640,6 +665,7 @@ type = real kind = kind_phys intent = inout + optional = True [tsfci_cpl] standard_name = surface_skin_temperature_for_coupling long_name = instantaneous sfc temperature @@ -648,6 +674,7 @@ type = real kind = kind_phys intent = inout + optional = True [psurfi_cpl] standard_name = surface_air_pressure_for_coupling long_name = instantaneous sfc pressure @@ -656,6 +683,7 @@ type = real kind = kind_phys intent = inout + optional = True [nnirbmi_cpl] standard_name = surface_net_downwelling_direct_nir_shortwave_flux_for_coupling long_name = instantaneous net nir beam sfc downward sw flux @@ -664,6 +692,7 @@ type = real kind = kind_phys intent = inout + optional = True [nnirdfi_cpl] standard_name = surface_net_downwelling_diffuse_nir_shortwave_flux_for_coupling long_name = instantaneous net nir diff sfc downward sw flux @@ -672,6 +701,7 @@ type = real kind = kind_phys intent = inout + optional = True [nvisbmi_cpl] standard_name = surface_net_downwelling_direct_uv_and_vis_shortwave_flux_for_coupling long_name = instantaneous net uv+vis beam downward sw flux @@ -680,6 +710,7 @@ type = real kind = kind_phys intent = inout + optional = True [nvisdfi_cpl] standard_name = surface_net_downwelling_diffuse_uv_and_vis_shortwave_flux_for_coupling long_name = instantaneous net uv+vis diff downward sw flux @@ -688,6 +719,7 @@ type = real kind = kind_phys intent = inout + optional = True [nswsfci_cpl] standard_name = surface_net_downwelling_shortwave_flux_for_coupling long_name = instantaneous net sfc downward sw flux @@ -696,6 +728,7 @@ type = real kind = kind_phys intent = inout + optional = True [nswsfc_cpl] standard_name = cumulative_surface_net_downwelling_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net downward sw flux multiplied by timestep @@ -704,6 +737,7 @@ type = real kind = kind_phys intent = inout + optional = True [nnirbm_cpl] standard_name = cumulative_surface_net_downwelling_direct_nir_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net nir beam downward sw flux multiplied by timestep @@ -712,6 +746,7 @@ type = real kind = kind_phys intent = inout + optional = True [nnirdf_cpl] standard_name = cumulative_surface_net_downwellling_diffuse_nir_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net nir diff downward sw flux multiplied by timestep @@ -720,6 +755,7 @@ type = real kind = kind_phys intent = inout + optional = True [nvisbm_cpl] standard_name = cumulative_surface_net_downwelling_direct_uv_and_vis_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net uv+vis beam downward sw rad flux multiplied by timestep @@ -728,6 +764,7 @@ type = real kind = kind_phys intent = inout + optional = True [nvisdf_cpl] standard_name = cumulative_surface_net_downwelling_diffuse_uv_and_vis_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net uv+vis diff downward sw rad flux multiplied by timestep @@ -736,6 +773,7 @@ type = real kind = kind_phys intent = inout + optional = True [gflux] standard_name = cumulative_surface_ground_heat_flux_multiplied_by_timestep long_name = cumulative groud conductive heat flux multiplied by timestep @@ -800,6 +838,7 @@ type = real kind = kind_phys intent = inout + optional = True [ep] standard_name = cumulative_surface_upward_potential_latent_heat_flux_multiplied_by_timestep long_name = cumulative surface upward potential latent heat flux multiplied by timestep @@ -840,6 +879,7 @@ type = real kind = kind_phys intent = in + optional = True [runoff] standard_name = total_runoff long_name = total water runoff @@ -904,6 +944,7 @@ type = real kind = kind_phys intent = inout + optional = True [lheatstrg] standard_name = flag_for_canopy_heat_storage_in_land_surface_scheme long_name = flag for canopy heat storage parameterization diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 index 5d321814c..8d9fe7de9 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.F90 @@ -61,8 +61,7 @@ end subroutine GFS_surface_generic_pre_init !! subroutine GFS_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, ivegsrc, stype, scolor,vtype, slope, & prsik_1, prslk_1, tsfc, phil, con_g, sigmaf, work3, zlvl, & - drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts, & - lndp_var_list, lndp_prt_list, & + lndp_type, n_var_lndp, sfc_wts, lndp_var_list, lndp_prt_list, & z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, & cplflx, flag_cice, islmsk_cice, slimskin_cpl, & wind, u1, v1, cnvwind, smcwlt2, smcref2, vtype_save, stype_save,scolor_save, slope_save, & @@ -87,14 +86,10 @@ subroutine GFS_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, real(kind=kind_phys), dimension(:), intent(inout) :: sigmaf, work3, zlvl ! Stochastic physics / surface perturbations - real(kind=kind_phys), dimension(:), intent(out) :: drain_cpl - real(kind=kind_phys), dimension(:), intent(out) :: dsnow_cpl - real(kind=kind_phys), dimension(:), intent(in) :: rain_cpl - real(kind=kind_phys), dimension(:), intent(in) :: snow_cpl integer, intent(in) :: lndp_type, n_var_lndp - character(len=3), dimension(:), intent(in) :: lndp_var_list - real(kind=kind_phys), dimension(:), intent(in) :: lndp_prt_list - real(kind=kind_phys), dimension(:,:), intent(in) :: sfc_wts + character(len=3), dimension(:), intent(in), optional :: lndp_var_list + real(kind=kind_phys), dimension(:), intent(in), optional :: lndp_prt_list + real(kind=kind_phys), dimension(:,:), intent(in), optional :: sfc_wts real(kind=kind_phys), dimension(:), intent(out) :: z01d real(kind=kind_phys), dimension(:), intent(out) :: zt1d real(kind=kind_phys), dimension(:), intent(out) :: bexp1d @@ -103,14 +98,14 @@ subroutine GFS_surface_generic_pre_run (nthreads, im, levs, vfrac, islmsk, isot, real(kind=kind_phys), intent(out) :: lndp_vgf logical, intent(in) :: cplflx - real(kind=kind_phys), dimension(:), intent(in) :: slimskin_cpl + real(kind=kind_phys), dimension(:), intent(in), optional :: slimskin_cpl logical, dimension(:), intent(inout) :: flag_cice integer, dimension(:), intent(out) :: islmsk_cice real(kind=kind_phys), dimension(:), intent(out) :: wind real(kind=kind_phys), dimension(:), intent(in ) :: u1, v1 ! surface wind enhancement due to convection - real(kind=kind_phys), dimension(:), intent(inout ) :: cnvwind + real(kind=kind_phys), dimension(:), intent(inout ), optional :: cnvwind ! real(kind=kind_phys), dimension(:), intent(out) :: smcwlt2, smcref2 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta index bbf7dd5c3..33b7cdf8c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_surface_generic_pre type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F,SFC_Models/Land/Noah/surface_perturbation.F90 ######################################################################## @@ -290,38 +290,6 @@ type = real kind = kind_phys intent = inout -[drain_cpl] - standard_name = tendency_of_lwe_thickness_of_rain_amount_on_dynamics_timestep_for_coupling - long_name = change in rain_cpl (coupling_type) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[dsnow_cpl] - standard_name = tendency_of_lwe_thickness_of_snowfall_amount_on_dynamics_timestep_for_coupling - long_name = change in show_cpl (coupling_type) - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[rain_cpl] - standard_name = cumulative_lwe_thickness_of_precipitation_amount_for_coupling - long_name = total rain precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[snow_cpl] - standard_name = cumulative_lwe_thickness_of_snow_amount_for_coupling - long_name = total snow precipitation - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [lndp_type] standard_name = control_for_stochastic_land_surface_perturbation long_name = index for stochastic land surface perturbations type @@ -344,6 +312,7 @@ type = real kind = kind_phys intent = in + optional = True [lndp_var_list] standard_name = land_surface_perturbation_variables long_name = variables to be perturbed for landperts @@ -352,6 +321,7 @@ type = character kind = len=3 intent = in + optional = True [lndp_prt_list] standard_name =land_surface_perturbation_magnitudes long_name = magnitude of perturbations for landperts @@ -360,6 +330,7 @@ type = real kind = kind_phys intent = in + optional = True [z01d] standard_name = perturbation_of_momentum_roughness_length long_name = perturbation of momentum roughness length @@ -437,6 +408,7 @@ type = real kind = kind_phys intent = in + optional = True [wind] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level @@ -469,6 +441,7 @@ type = real kind = kind_phys intent = inout + optional = True [smcwlt2] standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point long_name = wilting point (volumetric) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90 index c3030c144..913c1a7b6 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_loop_control_part1.F90 @@ -1,19 +1,15 @@ !> \file GFS_surface_loop_control_part1.F90 !! This file contains the GFS_surface_loop_control_part1 scheme. -!> \defgroup GFS_surface_loop_control GFS_surface_loop_control_part1 scheme -!! This module contains the GFS_surface_loop_control_part1 scheme. -!! @{ +!> This module contains the GFS_surface_loop_control_part1 scheme. module GFS_surface_loop_control_part1 contains -!> \brief Brief description of the subroutine +!> Brief description of the subroutine !! !! \section arg_table_GFS_surface_loop_control_part1_run Arguments !! \htmlinclude GFS_surface_loop_control_part1_run.html !! -!! \section gen_loop1 General Algorithm -!! \section detailed_loop1 Detailed Algorithm subroutine GFS_surface_loop_control_part1_run (im, iter, & wind, flag_guess, errmsg, errflg) @@ -45,4 +41,3 @@ subroutine GFS_surface_loop_control_part1_run (im, iter, & end subroutine GFS_surface_loop_control_part1_run end module GFS_surface_loop_control_part1 -!> @} diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 index 5a678a820..a159d899d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.F90 @@ -94,11 +94,10 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_sngl_prec) :: rinc4(5) real(kind=kind_dbl_prec) :: rinc8(5) - integer :: w3kindreal,w3kindint - integer :: iw3jdn + integer :: w3kindreal, w3kindint + integer :: iw3jdn integer :: jd0, jd1 real :: fjd @@ -115,19 +114,17 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, !--- jdat is being updated directly inside of FV3GFS_cap.F90 !--- update calendars and triggers - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then + call w3kind(w3kindreal, w3kindint) + !--- CCPP uses w3emc_d, therefore expecting the following values + if (w3kindreal == 8 .and. w3kindint==4) then rinc8(1:5) = 0 call w3difdat(jdat,idat,4,rinc8) sec = rinc8(4) - else if (w3kindreal == 4) then - rinc4(1:5) = 0 - call w3difdat(jdat,idat,4,rinc4) - sec = rinc4(4) else - write(0,*)' FATAL ERROR: Invalid w3kindreal' - call abort - endif + write(errmsg,'(*(a))') "FATAL ERROR: Invalid w3kindreal or w3kindint:", w3kindreal, w3kindint + errflg = 1 + return + end if phour = sec/con_hr !--- set current bucket hour zhour = phour diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta index c6dd95bce..bdf4ec8d5 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.fv3.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_time_vary_pre type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 index 17cf09ca9..5f305d24f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.F90 @@ -30,7 +30,7 @@ subroutine GFS_time_vary_pre_init (errmsg, errflg) errflg = 0 if (is_initialized) return - + !--- Call gfuncphys (funcphys.f) to compute all physics function tables. call gfuncphys () @@ -91,11 +91,10 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_sngl_prec) :: rinc4(5) real(kind=kind_dbl_prec) :: rinc8(5) - integer :: w3kindreal,w3kindint - integer :: iw3jdn + integer :: w3kindreal, w3kindint + integer :: iw3jdn integer :: jd0, jd1 real :: fjd @@ -114,19 +113,17 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, & !--- jdat is being updated directly inside of the time integration !--- loop of scm.F90 !--- update calendars and triggers - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then + call w3kind(w3kindreal, w3kindint) + !--- CCPP uses w3emc_d, therefore expecting the following values + if (w3kindreal == 8 .and. w3kindint==4) then rinc8(1:5) = 0 call w3difdat(jdat,idat,4,rinc8) sec = rinc8(4) - else if (w3kindreal == 4) then - rinc4(1:5) = 0 - call w3difdat(jdat,idat,4,rinc4) - sec = rinc4(4) else - write(0,*)' FATAL ERROR: Invalid w3kindreal' - call abort - endif + write(errmsg,'(*(a))') "FATAL ERROR: Invalid w3kindreal or w3kindint:", w3kindreal, w3kindint + errflg = 1 + return + end if phour = sec/con_hr !--- set current bucket hour zhour = phour diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta index af9afcdfe..3bebfbe65 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_time_vary_pre.scm.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_time_vary_pre type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 new file mode 100644 index 000000000..6a706456c --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.F90 @@ -0,0 +1,211 @@ +!>\file ccpp_suite_simulator.F90 +!! Description: This suite simulates the evolution of the internal physics state +!! represented by a CCPP Suite Definition File (SDF). +!! +!! To activate this suite it must be a) embedded within the SDF and b) activated through +!! the physics namelist. +!! The derived-data type "base_physics_process" contains the metadata needed to reconstruct +!! the temporal evolution of the state. An array of base_physics_process, physics_process, +!! is populated by the host during initialization and passed to the physics. Additionally, +!! this type holds any data, or type-bound procedures, required by the suite simulator(s). +!! +!! For this initial demonstration we are using 2-dimensional (height, time) forcing data, +!! which is on the same native vertical grid as the SCM. The dataset has a temporal +!! resolution of 1-hour, created by averaging all local times from a Tropical Warm Pool +!! International Cloud Experiment (TWPICE) case. This was to create a dataset with a +!! (constant) diurnal cycle. +! +! ######################################################################################## +module ccpp_suite_simulator + use machine, only: kind_phys + use module_ccpp_suite_simulator, only: base_physics_process, sim_LWRAD, sim_SWRAD, & + sim_PBL, sim_GWD, sim_DCNV, sim_SCNV, sim_cldMP + implicit none + public ccpp_suite_simulator_run +contains + + ! ###################################################################################### + ! + ! SUBROUTINE ccpp_suite_simulator_run + ! + ! ###################################################################################### +!! \section arg_table_ccpp_suite_simulator_run +!! \htmlinclude ccpp_suite_simulator_run.html +!! + subroutine ccpp_suite_simulator_run(do_ccpp_suite_sim, kdt, nCol, nLay, dtp, jdat, & + iactive_T, iactive_u, iactive_v, iactive_q, proc_start, proc_end, physics_process,& + in_pre_active, in_post_active, tgrs, ugrs, vgrs, qgrs, active_phys_tend, gt0, gu0,& + gv0, gq0, errmsg, errflg) + + ! Inputs + logical, intent(in) :: do_ccpp_suite_sim + integer, intent(in) :: kdt, nCol, nLay, jdat(8), iactive_T, iactive_u, & + iactive_v, iactive_q + real(kind_phys), intent(in) :: dtp, tgrs(:,:), ugrs(:,:), vgrs(:,:), qgrs(:,:,:), & + active_phys_tend(:,:,:) + ! Outputs + type(base_physics_process),intent(inout) :: physics_process(:) + real(kind_phys), intent(inout) :: gt0(:,:), gu0(:,:), gv0(:,:), gq0(:,:) + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg + integer, intent(inout) :: proc_start, proc_end + logical, intent(inout) :: in_pre_active, in_post_active + + ! Locals + integer :: iCol, year, month, day, hour, min, sec, iprc + real(kind_phys), dimension(nCol,nLay) :: gt1, gu1, gv1, dTdt, dudt, dvdt, gq1, dqdt + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. do_ccpp_suite_sim) return + + ! Current forecast time (Data-format specific) + year = jdat(1) + month = jdat(2) + day = jdat(3) + hour = jdat(5) + min = jdat(6) + sec = jdat(7) + + ! Set state at beginning of the physics timestep. + gt1(:,:) = tgrs(:,:) + gu1(:,:) = ugrs(:,:) + gv1(:,:) = vgrs(:,:) + gq1(:,:) = qgrs(:,:,1) + dTdt(:,:) = 0. + dudt(:,:) = 0. + dvdt(:,:) = 0. + dqdt(:,:) = 0. + + ! + ! Set bookeeping indices + ! + if (in_pre_active) then + proc_start = 1 + proc_end = max(1,physics_process(1)%iactive_scheme-1) + endif + if (in_post_active) then + proc_start = physics_process(1)%iactive_scheme + proc_end = size(physics_process) + endif + + ! + ! Simulate internal physics timestep evolution. + ! + do iprc = proc_start,proc_end + do iCol = 1,nCol + + ! Reset locals + physics_process(iprc)%tend1d%T(:) = 0. + physics_process(iprc)%tend1d%u(:) = 0. + physics_process(iprc)%tend1d%v(:) = 0. + physics_process(iprc)%tend1d%q(:) = 0. + + ! Using scheme simulator + ! Very simple... + ! Interpolate 2D data (time,level) tendency to local time. + ! Here the data is already on the SCM vertical coordinate. + ! + ! In theory the data can be of any dimensionality and the onus falls on the + ! developer to extend the type "base_physics_process" to work with for their + ! application. + ! + if (physics_process(iprc)%use_sim) then + if (physics_process(iprc)%name == "LWRAD") then + call sim_LWRAD(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "SWRAD")then + call sim_SWRAD(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "GWD")then + call sim_GWD(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "PBL")then + call sim_PBL(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "SCNV")then + call sim_SCNV(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "DCNV")then + call sim_DCNV(year, month, day, hour, min, sec, physics_process(iprc)) + endif + if (physics_process(iprc)%name == "cldMP")then + call sim_cldMP(year, month, day, hour, min, sec, physics_process(iprc)) + endif + + ! Using data tendency from "active" scheme(s). + else + if (iactive_T > 0) physics_process(iprc)%tend1d%T = active_phys_tend(iCol,:,iactive_T) + if (iactive_u > 0) physics_process(iprc)%tend1d%u = active_phys_tend(iCol,:,iactive_u) + if (iactive_v > 0) physics_process(iprc)%tend1d%v = active_phys_tend(iCol,:,iactive_v) + if (iactive_q > 0) physics_process(iprc)%tend1d%q = active_phys_tend(iCol,:,iactive_q) + endif + + ! Update state now? (time-split scheme) + if (physics_process(iprc)%time_split) then + gt1(iCol,:) = gt1(iCol,:) + (dTdt(iCol,:) + physics_process(iprc)%tend1d%T)*dtp + gu1(iCol,:) = gu1(iCol,:) + (dudt(iCol,:) + physics_process(iprc)%tend1d%u)*dtp + gv1(iCol,:) = gv1(iCol,:) + (dvdt(iCol,:) + physics_process(iprc)%tend1d%v)*dtp + gq1(iCol,:) = gq1(iCol,:) + (dqdt(iCol,:) + physics_process(iprc)%tend1d%q)*dtp + dTdt(iCol,:) = 0. + dudt(iCol,:) = 0. + dvdt(iCol,:) = 0. + dqdt(iCol,:) = 0. + ! Accumulate tendencies, update later? (process-split scheme) + else + dTdt(iCol,:) = dTdt(iCol,:) + physics_process(iprc)%tend1d%T + dudt(iCol,:) = dudt(iCol,:) + physics_process(iprc)%tend1d%u + dvdt(iCol,:) = dvdt(iCol,:) + physics_process(iprc)%tend1d%v + dqdt(iCol,:) = dqdt(iCol,:) + physics_process(iprc)%tend1d%q + endif + enddo ! END: Loop over columns + + ! Print diagnostics + if (physics_process(iprc)%use_sim) then + if (physics_process(iprc)%time_split) then + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (simulated)' + else + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (simulated)' + endif + else + if (physics_process(iprc)%time_split) then + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'time split scheme (active)' + else + write(*,'(a25,i2,a4,i2,a5,a10,a35)') 'CCPP suite simulator: ',iprc,' of ',proc_end,' ',physics_process(iprc)%name,'process split scheme (active)' + endif + write(*,'(a25,i2)') ' # prog. vars.: ',physics_process(1)%nprg_active + endif + enddo ! END: Loop over physics processes + + ! + ! Update state with accumulated tendencies (process-split only) + ! (Suites where active scheme is last physical process) + ! + iprc = minval([iprc,proc_end]) + if (.not. physics_process(iprc)%time_split) then + do iCol = 1,nCol + gt0(iCol,:) = gt1(iCol,:) + dTdt(iCol,:)*dtp + gu0(iCol,:) = gu1(iCol,:) + dudt(iCol,:)*dtp + gv0(iCol,:) = gv1(iCol,:) + dvdt(iCol,:)*dtp + gq0(iCol,:) = gq1(iCol,:) + dqdt(iCol,:)*dtp + enddo + endif + + ! + ! Update bookeeping indices + ! + if (in_pre_active) then + in_pre_active = .false. + in_post_active = .true. + endif + + if (size(physics_process) == proc_end) then + in_pre_active = .true. + in_post_active = .false. + endif + + end subroutine ccpp_suite_simulator_run + +end module ccpp_suite_simulator diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta new file mode 100644 index 000000000..3c91faaeb --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/ccpp_suite_simulator.meta @@ -0,0 +1,201 @@ +[ccpp-table-properties] + name = ccpp_suite_simulator + type = scheme + dependencies = ../../hooks/machine.F,module_ccpp_suite_simulator.F90 + +[ccpp-arg-table] + name = ccpp_suite_simulator_run + type = scheme +[do_ccpp_suite_sim] + standard_name = flag_for_ccpp_suite_simulator + long_name = flag for ccpp suite simulator + units = flag + dimensions = () + type = logical + intent = in +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[nLay] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[jdat] + standard_name = date_and_time_of_forecast_in_united_states_order + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer + intent = in +[proc_start] + standard_name = index_for_first_physics_process_in_CCPP_suite_simulator + long_name = index for first physics process in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = inout +[proc_end] + standard_name = index_for_last_physics_process_in_CCPP_suite_simulator + long_name = index for last physics process in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = inout +[in_pre_active] + standard_name = flag_to_indicate_location_in_physics_process_loop_before_active_scheme + long_name = flag to indicate location in physics process loop before active scheme + units = flag + dimensions = () + type = logical + intent = inout +[in_post_active] + standard_name = flag_to_indicate_location_in_physics_process_loop_after_active_scheme + long_name = flag to indicate location in physics process loop after active scheme + units = flag + dimensions = () + type = logical + intent = inout +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in +[active_phys_tend] + standard_name = tendencies_for_active_process_in_ccpp_suite_simulator + long_name = tendencies for active physics process in ccpp suite simulator + units = mixed + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_prognostics_varaibles_in_CCPP_suite_simulator) + type = real + kind = kind_phys + intent = in +[iactive_T] + standard_name = index_for_active_T_in_CCPP_suite_simulator + long_name = index into active process tracer array for temperature in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_u] + standard_name = index_for_active_u_in_CCPP_suite_simulator + long_name = index into active process tracer array for zonal wind in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_v] + standard_name = index_for_active_v_in_CCPP_suite_simulator + long_name = index into active process tracer array for meridional wind in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[iactive_q] + standard_name = index_for_active_q_in_CCPP_suite_simulator + long_name = index into active process tracer array for moisture in CCPP suite simulator + units = count + dimensions = () + type = integer + intent = in +[gt0] + standard_name = air_temperature_of_new_state + long_name = temperature updated by physics + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gu0] + standard_name = x_wind_of_new_state + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gv0] + standard_name = y_wind_of_new_state + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0] + standard_name = specific_humidity_of_new_state + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[physics_process] + standard_name = physics_process_type_for_CCPP_suite_simulator + long_name = physics process type for CCPP suite simulator + units = mixed + dimensions = (number_of_physics_process_in_CCPP_suite_simulator) + type = base_physics_process + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out \ No newline at end of file diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f index d8ef0a86d..749f778c1 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.f @@ -183,7 +183,7 @@ subroutine dcyc2t3_run & ! --- input/output: & dtdt,dtdtnp,htrlw, & ! --- outputs: - & adjsfcdsw,adjsfcdswc,adjsfcnsw,adjsfculw,adjsfcdlw, & + & adjsfcdsw,adjsfcdswc,adjsfcnsw,adjsfcdlw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & @@ -215,10 +215,10 @@ subroutine dcyc2t3_run & & deltim, fhswr, lfnc_k, lfnc_p0 real(kind=kind_phys), dimension(:), intent(in) :: & - & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & - & sfcdsw, sfcdswc, sfcnsw, sfculw, sfculw_med, tsfc, & - & tsfc_radtime - + & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & + & sfcdsw, sfcdswc, sfcnsw, sfculw, tsfc + real(kind=kind_phys), dimension(:), intent(in), optional :: & + & sfculw_med, tsfc_radtime real(kind=kind_phys), dimension(:), intent(in) :: & & tsfc_lnd, tsfc_ice, tsfc_wat, & & sfcemis_lnd, sfcemis_ice, sfcemis_wat @@ -230,7 +230,8 @@ subroutine dcyc2t3_run & real(kind=kind_phys), dimension(:,:), intent(in) :: swh, hlw, & & swhc, hlwc, p_lay, t_lay - real(kind=kind_phys), dimension(:,:), intent(in) :: p_lev, & + real(kind=kind_phys), dimension(:,:), intent(in) :: p_lev + real(kind=kind_phys), dimension(:,:), intent(in), optional :: & & flux2D_lwUP, flux2D_lwDOWN, fluxlwUP_jac real(kind_phys), intent(in ) :: con_g, con_cp, & @@ -240,12 +241,13 @@ subroutine dcyc2t3_run & ! --- input/output: - real(kind=kind_phys), dimension(:,:), intent(inout) :: dtdt, htrlw - real(kind=kind_phys), dimension(:,:), intent(inout) :: dtdtnp + real(kind=kind_phys), dimension(:,:), intent(inout) :: dtdt + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: & + & dtdtnp, htrlw ! --- outputs: real(kind=kind_phys), dimension(:), intent(out) :: & - & adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, & + & adjsfcdsw, adjsfcnsw, adjsfcdlw, xmu, xcosz, & & adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfcdswc @@ -355,7 +357,7 @@ subroutine dcyc2t3_run & ! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: dry==',dry(i) ! &,' wet=',wet(i),' icy=',icy(i),' tsfc3=',tsfc3(i,:) -! &,' sfcemis=',sfcemis(i,:),' adjsfculw=',adjsfculw(i,:) +! &,' sfcemis=',sfcemis(i,:) ! !> - normalize by average value over radiation period for daytime. diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta index 386b0ee0f..bf6fb1a47 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/dcyc2t3.meta @@ -407,6 +407,7 @@ type = real kind = kind_phys intent = in + optional = True [fluxlwUP_jac] standard_name = RRTMGP_jacobian_of_lw_flux_upward long_name = RRTMGP Jacobian upward longwave flux profile @@ -415,6 +416,7 @@ type = real kind = kind_phys intent = in + optional = True [t_lay] standard_name = air_temperature_of_new_state long_name = model layer mean temperature updated by physics @@ -447,6 +449,7 @@ type = real kind = kind_phys intent = in + optional = True [flux2D_lwDOWN] standard_name = RRTMGP_lw_flux_profile_downward_allsky_on_radiation_timestep long_name = RRTMGP downward longwave all-sky flux profile @@ -455,6 +458,7 @@ type = real kind = kind_phys intent = in + optional = True [pert_radtend] standard_name = flag_for_stochastic_radiative_heating_perturbations long_name = flag for stochastic radiative heating perturbations @@ -484,6 +488,7 @@ type = real kind = kind_phys intent = in + optional = True [dtdt] standard_name = process_split_cumulative_tendency_of_air_temperature long_name = total radiative heating rate at current time @@ -500,6 +505,7 @@ type = real kind = kind_phys intent = inout + optional = True [htrlw] standard_name = updated_tendency_of_air_temperature_due_to_longwave_heating_on_physics_timestep long_name = total sky longwave heating rate on physics time step @@ -508,6 +514,7 @@ type = real kind = kind_phys intent = inout + optional = True [adjsfcdsw] standard_name = surface_downwelling_shortwave_flux long_name = surface downwelling shortwave flux at current time @@ -540,14 +547,6 @@ type = real kind = kind_phys intent = out -[adjsfculw] - standard_name = surface_upwelling_longwave_flux - long_name = surface upwelling longwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land long_name = surface upwelling longwave flux at current time over land diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 index f5eecbd18..329121359 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/gcycle.F90 @@ -22,10 +22,12 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, & zorli, zorll, zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, & stype, scolor, shdmin, shdmax, snowd, cv, cvb, cvt, oro, oro_uf, & + cplflx, oceanfrac, & xlat_d, xlon_d, slmsk, imap, jmap, errmsg, errflg) ! ! use machine, only: kind_phys, kind_io8 + use sfccyc_module, only: sfccycle implicit none integer, intent(in) :: me, nthrds, nx, ny, isc, jsc, nsst, & @@ -33,19 +35,20 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, integer, intent(in) :: idate(:), ialb, isot, ivegsrc character(len = 64), intent(in) :: fn_nml character(len=*), intent(in) :: input_nml_file(:) - logical, intent(in) :: use_ufo, nst_anl, frac_grid + logical, intent(in) :: use_ufo, nst_anl, frac_grid, cplflx real(kind=kind_phys), intent(in) :: fhcyc, phour, landfrac(:), lakefrac(:), & - min_seaice, min_lakeice, & + min_seaice, min_lakeice,oceanfrac(:), & xlat_d(:), xlon_d(:) - real(kind=kind_phys), intent(inout) :: smc(:,:), & - slc(:,:), & - stc(:,:), & + real(kind=kind_phys), intent(inout), optional :: & smois(:,:), & sh2o(:,:), & tslb(:,:), & + tref(:) + real(kind=kind_phys), intent(inout) :: smc(:,:), & + slc(:,:), & + stc(:,:), & tiice(:,:), & tg3(:), & - tref(:), & tsfc(:), & tsfco(:), & tisfc(:), & @@ -102,11 +105,22 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, STCFC1 (nx*ny*max(lsoil,lsoil_lsm)), & SLCFC1 (nx*ny*max(lsoil,lsoil_lsm)) +! +! declare the variables (arrays) for cplflx, surface type dependent gcycle changes +! + real(kind=kind_io8) :: & + hice_save (nx*ny), & ! sea or lake ice thickness + fice_save (nx*ny), & ! sea or lake ice fraction + snowd_save (nx*ny), & ! water equivalent snow depth + snoalb_save (nx*ny), & ! maximum snow albedo + tisfc_save (nx*ny), & ! surface skin temperature over (sea or lake) ice + weasd_save (nx*ny) ! water equiv of acc snow depth over land and (sea or lake) ice + real (kind=kind_io8) :: min_ice(nx*ny) integer :: i_indx(nx*ny), j_indx(nx*ny) character(len=6) :: tile_num_ch - real(kind=kind_phys) :: sig1t + real(kind=kind_phys) :: sig1t(nx*ny) integer :: npts, nb, ix, jx, ls, ios, ll logical :: exists @@ -130,11 +144,25 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, sig1t = 0.0_kind_phys npts = nx*ny ! +! Some surface variables need to be updated by gcycle with coupled mode, and nsst mode dependent. A few variables are saved +! in order to be able to update them over the specific surface types only after call sfccycle +! + if ( cplflx ) then + hice_save = hice + fice_save = fice + snowd_save = snowd + snoalb_save = snoalb + tisfc_save = tisfc + weasd_save = weasd + endif + if ( nsst > 0 ) then TSFFCS = tref else TSFFCS = tsfco - end if + endif + + ! integer to real/double precision slpfcs = real(slope) vegfcs = real(vtype) @@ -224,7 +252,6 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, #ifndef INTERNAL_FILE_NML inquire (file=trim(fn_nml),exist=exists) if (.not. exists) then - write(6,*) 'gcycle:: namelist file: ',trim(fn_nml),' does not exist' errflg = 1 errmsg = 'ERROR(gcycle): namelist file: ',trim(fn_nml),' does not exist.' return @@ -250,11 +277,45 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, close (nlunit) #endif ! - if ( nsst > 0 ) then - tref = TSFFCS +! The gcycle resulted change is applied to some variables in the way of the coupled mode dependent, water surface type (ocean or lake) +! dependent and nsst mode dependent +! + if ( cplflx ) then +! In coupled mode, keep these variables the same as is (before sfccycle is called) over ocean + do ix=1,npts + if ( oceanfrac(ix) > 0.0_kind_phys ) then + hice(ix) = hice_save(ix) + fice(ix) = fice_save(ix) + snowd(ix) = snowd_save(ix) + snoalb(ix) = snoalb_save(ix) + tisfc(ix) = tisfc_save(ix) + weasd(ix) = weasd_save(ix) + endif + enddo +! In the coupled mode and when NSST is on, update tref over non-ocean + if ( nsst > 0 ) then + do ix=1,npts + if ( oceanfrac(ix) == 0.0_kind_phys ) then + tref(ix) = TSFFCS(ix) + endif + enddo +! In the coupled mode and when NSST is off, update tsfc and tsfco over non-ocean + else + do ix=1,npts + if ( oceanfrac(ix) == 0.0_kind_phys ) then + tsfc(ix) = TSFFCS(ix) + tsfco(ix) = TSFFCS(ix) + endif + enddo + endif +! The same as before (this modification) in uncoupled mode else - tsfc = TSFFCS - tsfco = TSFFCS + if ( nsst > 0 ) then + tref = TSFFCS + else + tsfc = TSFFCS + tsfco = TSFFCS + endif endif ! ! real/double precision to integer @@ -298,7 +359,6 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, fn_nml, ! ! if (Model%me .eq. 0) print*,'executed gcycle during hour=',fhour ! - RETURN - END + end subroutine gcycle end module gcycle_mod diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 index c08b5c5e5..b90b6fca7 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/iccninterp.F90 @@ -15,6 +15,7 @@ module iccninterp contains +!> SUBROUTINE read_cidata (me, master) use machine, only: kind_phys use iccn_def @@ -23,6 +24,7 @@ SUBROUTINE read_cidata (me, master) integer, intent(in) :: me integer, intent(in) :: master !--- locals + integer :: ncerr integer :: i, n, k, ncid, varid,j,it real(kind=kind_phys), allocatable, dimension(:) :: hyam,hybm real(kind=4), allocatable, dimension(:,:,:) :: ci_ps @@ -31,29 +33,29 @@ SUBROUTINE read_cidata (me, master) allocate (ciplin(lonscip,latscip,kcipl,timeci)) allocate (ccnin(lonscip,latscip,kcipl,timeci)) allocate (ci_pres(lonscip,latscip,kcipl,timeci)) - call nf_open("cam5_4_143_NAAI_monclimo2.nc", NF90_NOWRITE, ncid) - call nf_inq_varid(ncid, "lat", varid) - call nf_get_var(ncid, varid, ci_lat) - call nf_inq_varid(ncid, "lon", varid) - call nf_get_var(ncid, varid, ci_lon) - call nf_inq_varid(ncid, "PS", varid) - call nf_get_var(ncid, varid, ci_ps) - call nf_inq_varid(ncid, "hyam", varid) - call nf_get_var(ncid, varid, hyam) - call nf_inq_varid(ncid, "hybm", varid) - call nf_get_var(ncid, varid, hybm) - call nf_inq_varid(ncid, "NAAI", varid) - call nf_get_var(ncid, varid, ciplin) + ncerr = nf90_open("cam5_4_143_NAAI_monclimo2.nc", NF90_NOWRITE, ncid) + ncerr = nf90_inq_varid(ncid, "lat", varid) + ncerr = nf90_get_var(ncid, varid, ci_lat) + ncerr = nf90_inq_varid(ncid, "lon", varid) + ncerr = nf90_get_var(ncid, varid, ci_lon) + ncerr = nf90_inq_varid(ncid, "PS", varid) + ncerr = nf90_get_var(ncid, varid, ci_ps) + ncerr = nf90_inq_varid(ncid, "hyam", varid) + ncerr = nf90_get_var(ncid, varid, hyam) + ncerr = nf90_inq_varid(ncid, "hybm", varid) + ncerr = nf90_get_var(ncid, varid, hybm) + ncerr = nf90_inq_varid(ncid, "NAAI", varid) + ncerr = nf90_get_var(ncid, varid, ciplin) do it = 1,timeci do k=1, kcipl ci_pres(:,:,k,it)=hyam(k)*1.e5+hybm(k)*ci_ps(:,:,it) end do end do - call nf_close(ncid) - call nf_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) - call nf_inq_varid(ncid, "NPCCN", varid) - call nf_get_var(ncid, varid, ccnin) - call nf_close(ncid) + ncerr = nf90_close(ncid) + ncerr = nf90_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) + ncerr = nf90_inq_varid(ncid, "NPCCN", varid) + ncerr = nf90_get_var(ncid, varid, ccnin) + ncerr = nf90_close(ncid) !--- deallocate (hyam, hybm, ci_ps) if (me == master) then @@ -64,6 +66,7 @@ END SUBROUTINE read_cidata ! !********************************************************************** ! +!> SUBROUTINE setindxci(npts,dlat,jindx1,jindx2,ddy,dlon, & iindx1,iindx2,ddx) ! @@ -125,10 +128,11 @@ END SUBROUTINE setindxci !********************************************************************** !********************************************************************** ! +!> SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & iindx1,iindx2,ddx,lev, prsl, ciplout,ccnout) ! - USE MACHINE, ONLY : kind_phys + USE MACHINE, ONLY : kind_phys, kind_dbl_prec use iccn_def implicit none integer i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i @@ -144,10 +148,8 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & real(kind=kind_phys) ccnout(npts,lev),ccnpm(npts,kcipl) real(kind=kind_phys) cipres(npts,kcipl), prsl(npts,lev) real(kind=kind_phys) rjday + real(kind=kind_dbl_prec) rinc(5) integer jdow, jdoy, jday - real(8) RINC(5) - real(4) rinc4(5) - integer w3kindreal,w3kindint ! IDAT=0 IDAT(1)=IDATE(4) @@ -156,13 +158,7 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, & IDAT(5)=IDATE(1) RINC=0. RINC(2)=FHOUR - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4=rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif + CALL W3MOVDAT(RINC,IDAT,JDAT) ! jdow = 0 jdoy = 0 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 index cd1016053..a28a6906e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.F90 @@ -15,6 +15,9 @@ module maximum_hourly_diagnostics real(kind=kind_phys), parameter ::PQ0=379.90516E0, A2A=17.2693882, A3=273.16, A4=35.86, RHmin=1.0E-6 ! *DH + ! Conversion from flashes per five minutes to flashes per minute. + real(kind=kind_phys), parameter :: scaling_factor = 0.2 + contains #if 0 @@ -63,8 +66,9 @@ subroutine maximum_hourly_diagnostics_run(im, levs, reset, lradar, imp_physics, real(kind_phys), intent(in ) :: prsl(:,:) real(kind_phys), intent(inout) :: pratemax(:) - real(kind_phys), intent(in), dimension(:,:) :: prsi, qgraupel, qsnowwat, qicewat, wgrs - real(kind_phys), intent(inout), dimension(:) :: ltg1_max, ltg2_max, ltg3_max + real(kind_phys), intent(in), dimension(:,:) :: prsi, qgraupel, qsnowwat, qicewat + real(kind_phys), intent(in), dimension(:,:), optional :: wgrs + real(kind_phys), intent(inout), dimension(:), optional :: ltg1_max, ltg2_max, ltg3_max character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -195,7 +199,10 @@ subroutine lightning_threat_indices endif IF ( ltg1 .LT. clim1 ) ltg1 = 0. - + + ! Scale to flashes per minue + ltg1 = ltg1 * scaling_factor + IF ( ltg1 .GT. ltg1_max(i) ) THEN ltg1_max(i) = ltg1 ENDIF @@ -208,14 +215,19 @@ subroutine lightning_threat_indices ltg2 = coef2 * totice_colint(i) IF ( ltg2 .LT. clim2 ) ltg2 = 0. + + ! Scale to flashes per minute + ltg2 = ltg2 * scaling_factor IF ( ltg2 .GT. ltg2_max(i) ) THEN ltg2_max(i) = ltg2 ENDIF + ! This calculation is already in flashes per minute. ltg3_max(i) = 0.95 * ltg1_max(i) + 0.05 * ltg2_max(i) - IF ( ltg3_max(i) .LT. clim3 ) ltg3_max(i) = 0. + ! Thus, we must scale clim3. The compiler will optimize this away. + IF ( ltg3_max(i) .LT. clim3 * scaling_factor ) ltg3_max(i) = 0. enddo end subroutine lightning_threat_indices @@ -226,13 +238,12 @@ subroutine max_fields(phil,ref3D,grav,im,levs,refd,tk,refd263k) integer, intent(in) :: im,levs real (kind=kind_phys), intent(in) :: grav real (kind=kind_phys), intent(in),dimension(:,:) :: phil,ref3D,tk - integer :: i,k,ll,ipt,kpt + real (kind=kind_phys), intent(inout),dimension(:) :: refd,refd263k + ! Local + integer :: i,k,ll real :: dbz1avg,zmidp1,zmidloc,refl,fact real, dimension(im,levs) :: z - real, dimension(im) :: zintsfc - real, dimension(:), intent(inout) :: refd,refd263k - REAL :: dbz1(2),dbzk,dbzk1 - logical :: counter + REAL :: dbz1(2) do i=1,im do k=1,levs z(i,k)=phil(i,k)/grav diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta index 0c2d1bcbe..7108e2f97 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/maximum_hourly_diagnostics.meta @@ -246,6 +246,7 @@ type = real kind = kind_phys intent = in + optional = True [qgraupel] standard_name = graupel_mixing_ratio long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) @@ -296,27 +297,30 @@ [ltg1_max] standard_name = lightning_threat_index_1 long_name = lightning threat index 1 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout + optional = True [ltg2_max] standard_name = lightning_threat_index_2 long_name = lightning threat index 2 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout + optional = True [ltg3_max] standard_name = lightning_threat_index_3 long_name = lightning threat index 3 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout + optional = True [prsi] standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 new file mode 100644 index 000000000..56d1d0666 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.F90 @@ -0,0 +1,308 @@ +!>\file module_ccpp_suite_simulator.F90 +!! This module contains the type, base_physics_process, and supporting subroutines needed +!! by the ccpp suite simulator. + +module module_ccpp_suite_simulator + + use machine, only : kind_phys + implicit none + + public base_physics_process + +!> Type containing 1D (time) physics tendencies. + type phys_tend_1d + real(kind_phys), dimension(:), allocatable :: T + real(kind_phys), dimension(:), allocatable :: u + real(kind_phys), dimension(:), allocatable :: v + real(kind_phys), dimension(:), allocatable :: q + real(kind_phys), dimension(:), allocatable :: p + real(kind_phys), dimension(:), allocatable :: z + end type phys_tend_1d + +!> Type containing 2D (lev,time) physics tendencies. + type phys_tend_2d + real(kind_phys), dimension(:), allocatable :: time + real(kind_phys), dimension(:,:), allocatable :: T + real(kind_phys), dimension(:,:), allocatable :: u + real(kind_phys), dimension(:,:), allocatable :: v + real(kind_phys), dimension(:,:), allocatable :: q + real(kind_phys), dimension(:,:), allocatable :: p + real(kind_phys), dimension(:,:), allocatable :: z + end type phys_tend_2d + + ! Type containing 3D (loc,lev,time) physics tendencies. + type phys_tend_3d + real(kind_phys), dimension(:), allocatable :: time + real(kind_phys), dimension(:), allocatable :: lon + real(kind_phys), dimension(:), allocatable :: lat + real(kind_phys), dimension(:,:,:), allocatable :: T + real(kind_phys), dimension(:,:,:), allocatable :: u + real(kind_phys), dimension(:,:,:), allocatable :: v + real(kind_phys), dimension(:,:,:), allocatable :: q + end type phys_tend_3d + +!> Type containing 4D (lon,lat,lev,time) physics tendencies. + type phys_tend_4d + real(kind_phys), dimension(:), allocatable :: time + real(kind_phys), dimension(:,:), allocatable :: lon + real(kind_phys), dimension(:,:), allocatable :: lat + real(kind_phys), dimension(:,:,:,:), allocatable :: T + real(kind_phys), dimension(:,:,:,:), allocatable :: u + real(kind_phys), dimension(:,:,:,:), allocatable :: v + real(kind_phys), dimension(:,:,:,:), allocatable :: q + end type phys_tend_4d + +!> \section arg_table_base_physics_process Argument Table +!! \htmlinclude base_physics_process.html +!! +!! This type contains the meta information and data for each physics process. +!! + type base_physics_process + character(len=16) :: name !< Physics process name + logical :: time_split = .false. !< Is process time-split? + logical :: use_sim = .false. !< Is process "active"? + integer :: order !< Order of process in process-loop + type(phys_tend_1d) :: tend1d !< Instantaneous data + type(phys_tend_2d) :: tend2d !< 2-dimensional data + type(phys_tend_3d) :: tend3d !< Not used. Placeholder for 3-dimensional spatial data. + type(phys_tend_4d) :: tend4d !< Not used. Placeholder for 4-dimensional spatio-tempo data. + character(len=16) :: active_name !< "Active" scheme: Physics process name + integer :: iactive_scheme !< "Active" scheme: Order of process in process-loop + logical :: active_tsp !< "Active" scheme: Is process time-split? + integer :: nprg_active !< "Active" scheme: Number of prognostic variables + contains + generic, public :: linterp => linterp_1D, linterp_2D + procedure, private :: linterp_1D + procedure, private :: linterp_2D + procedure, public :: find_nearest_loc_2d_1d + procedure, public :: cmp_time_wts + end type base_physics_process + +contains + +!> Type-bound procedure to compute tendency profile for time-of-day. +!! For use with 1D data (level, time) tendencies with diurnal (24-hr) forcing. + function linterp_1D(this, var_name, year, month, day, hour, min, sec) result(err_message) + class(base_physics_process), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: err_message + integer :: ti(1), tf(1), ntime + real(kind_phys) :: w1, w2 + + ! Interpolation weights + call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) + + ntime = size(this%tend2d%T(1,:)) + + select case(var_name) + case("T") + if (tf(1) .le. ntime) then + this%tend1d%T = w1*this%tend2d%T(:,ti(1)) + w2*this%tend2d%T(:,tf(1)) + else + this%tend1d%T = this%tend2d%T(:,1) + endif + case("u") + if (tf(1) .le. ntime) then + this%tend1d%u = w1*this%tend2d%u(:,ti(1)) + w2*this%tend2d%u(:,tf(1)) + else + this%tend1d%u = this%tend2d%u(:,1) + endif + case("v") + if (tf(1) .le. ntime) then + this%tend1d%v = w1*this%tend2d%v(:,ti(1)) + w2*this%tend2d%v(:,tf(1)) + else + this%tend1d%v = this%tend2d%v(:,1) + endif + case("q") + if (tf(1) .le. ntime) then + this%tend1d%q = w1*this%tend2d%q(:,ti(1)) + w2*this%tend2d%q(:,tf(1)) + else + this%tend1d%q = this%tend2d%q(:,1) + endif + end select + err_message = "" + end function linterp_1D + +!> Type-bound procedure to compute tendency profile for time-of-day. +!! For use with 2D data (location, level, time) tendencies with diurnal (24-hr) forcing. +!! This assumes that the location dimension has a [longitude, latitude] allocated with +!! each location. + function linterp_2D(this, var_name, lon, lat, year, month, day, hour, min, sec) result(err_message) + class(base_physics_process), intent(inout) :: this + character(len=*), intent(in) :: var_name + integer, intent(in) :: year, month, day, hour, min, sec + real(kind_phys), intent(in) :: lon, lat + character(len=128) :: err_message + integer :: ti(1), tf(1), iNearest + real(kind_phys) :: w1, w2 + + ! Interpolation weights (temporal) + call this%cmp_time_wts(year, month, day, hour, min, sec, w1, w2, ti, tf) + + ! Grab data tendency closest to column [lon,lat] + iNearest = this%find_nearest_loc_2d_1d(lon,lat) + + select case(var_name) + case("T") + this%tend1d%T = w1*this%tend3d%T(iNearest,:,ti(1)) + w2*this%tend3d%T(iNearest,:,tf(1)) + case("u") + this%tend1d%u = w1*this%tend3d%u(iNearest,:,ti(1)) + w2*this%tend3d%u(iNearest,:,tf(1)) + case("v") + this%tend1d%v = w1*this%tend3d%v(iNearest,:,ti(1)) + w2*this%tend3d%v(iNearest,:,tf(1)) + case("q") + this%tend1d%q = w1*this%tend3d%q(iNearest,:,ti(1)) + w2*this%tend3d%q(iNearest,:,tf(1)) + end select + err_message = "" + end function linterp_2D + +!> Type-bound procedure to find nearest location. +!! For use with linterp_2D, NOT YET IMPLEMENTED. + pure function find_nearest_loc_2d_1d(this, lon, lat) + class(base_physics_process), intent(in) :: this + real(kind_phys), intent(in) :: lon, lat + integer :: find_nearest_loc_2d_1d + + find_nearest_loc_2d_1d = 1 + end function find_nearest_loc_2d_1d + +!> Type-bound procedure to compute linear interpolation weights for a diurnal (24-hour) +!! forcing. + subroutine cmp_time_wts(this, year, month, day, hour, minute, sec, w1, w2, ti, tf) + ! Inputs + class(base_physics_process), intent(in) :: this + integer, intent(in) :: year, month, day, hour, minute, sec + ! Outputs + integer,intent(out) :: ti(1), tf(1) + real(kind_phys),intent(out) :: w1, w2 + ! Locals + real(kind_phys) :: hrofday + + hrofday = hour*3600. + minute*60. + sec + ti = max(hour,1) + tf = min(ti + 1,24) + w1 = ((hour+1)*3600 - hrofday)/3600 + w2 = 1 - w1 + + end subroutine cmp_time_wts + +!> + subroutine sim_LWRAD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (allocated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + + end subroutine sim_LWRAD + +!> + subroutine sim_SWRAD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (allocated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + + end subroutine sim_SWRAD + +!> + subroutine sim_GWD( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (allocated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + + end subroutine sim_GWD + +!> + subroutine sim_PBL( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (allocated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_PBL + +!> + subroutine sim_DCNV( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (allocated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_DCNV + +!> + subroutine sim_SCNV( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (allocated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%u)) then + errmsg = process%linterp("u", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%v)) then + errmsg = process%linterp("v", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + + end subroutine sim_SCNV + +!> + subroutine sim_cldMP( year, month, day, hour, min, sec, process) + type(base_physics_process), intent(inout) :: process + integer, intent(in) :: year, month, day, hour, min, sec + character(len=128) :: errmsg + + if (allocated(process%tend2d%T)) then + errmsg = process%linterp("T", year,month,day,hour,min,sec) + endif + if (allocated(process%tend2d%q)) then + errmsg = process%linterp("q", year,month,day,hour,min,sec) + endif + end subroutine sim_cldMP + +end module module_ccpp_suite_simulator diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.meta new file mode 100644 index 000000000..55b9e07b1 --- /dev/null +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/module_ccpp_suite_simulator.meta @@ -0,0 +1,24 @@ +[ccpp-table-properties] + name = base_physics_process + type = ddt + dependencies = + +[ccpp-arg-table] + name = base_physics_process + type = ddt + +######################################################################## +[ccpp-table-properties] + name = module_ccpp_suite_simulator + type = module + dependencies = ../../hooks/machine.F + +[ccpp-arg-table] + name = module_ccpp_suite_simulator + type = module +[base_physics_process] + standard_name = base_physics_process + long_name = definition of type base_physics_process + units = DDT + dimensions = () + type = base_physics_process diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 index 835b468ff..797a1cd95 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/scm_sfc_flux_spec.F90 @@ -15,8 +15,7 @@ module scm_sfc_flux_spec CONTAINS !******************************************************************************************* -!! -!! \section arg_table_scm_sfc_flux_spec_init Argument Table +!> \section arg_table_scm_sfc_flux_spec_init Argument Table !! \htmlinclude scm_sfc_flux_spec_init.html !! subroutine scm_sfc_flux_spec_init(lheatstrg, errmsg, errflg) @@ -58,9 +57,9 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, use machine, only: kind_phys integer, intent(in) :: im, lkm - integer, intent(inout) :: islmsk(:) + integer, intent(inout) :: islmsk(:), use_lake_model(:) logical, intent(in) :: cplflx, cplice - logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:), use_lake_model(:) + logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:) real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman, min_seaice, tgice, min_lakeice real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), & spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:), oceanfrac(:), lakefrac(:), lakedepth(:) @@ -212,12 +211,12 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, do i = 1, im if ((wet(i) .or. icy(i)) .and. lakefrac(i) > 0.0_kind_phys) then if (lkm == 1 .and. lakefrac(i) >= 0.15 .and. lakedepth(i) > 1.0_kind_phys) then - use_lake_model(i) = .true. + use_lake_model(i) = 1 else - use_lake_model(i) = .false. + use_lake_model(i) = 0 endif else - use_lake_model(i) = .false. + use_lake_model(i) = 0 endif enddo ! diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F index 494b8f7dc..7b9960053 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sfcsub.F @@ -11,6 +11,7 @@ module sfccyc_module use machine , only : kind_io8,kind_io4 implicit none save + ! ! grib code for each parameter - used in subroutines sfccycle and setrmsk. ! @@ -52,8 +53,6 @@ function message(prefix,index) write(message,fmt='(a,a,i0)') trim(prefix), '-', index end function message - end module sfccyc_module - !>\ingroup mod_GFS_phys_time_vary !! This subroutine reads or interpolates surface climatology data in analysis !! and forecast mode. @@ -89,7 +88,6 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & &, ialb,isot,ivegsrc,tile_num_ch,i_index,j_index) ! use machine , only : kind_io8,kind_io4 - use sfccyc_module implicit none character(len=*), intent(in) :: tile_num_ch integer, intent(in) :: i_index(len), j_index(len), & @@ -2769,7 +2767,6 @@ subroutine dayoyr(iyr,imo,idy,ldy) subroutine hmskrd(lugb,imsk,jmsk,fnmskh, & & kpds5,slmskh,gausm,blnmsk,bltmsk,me) use machine , only : kind_io8,kind_io4 - use sfccyc_module, only : mdata, xdata, ydata implicit none integer kpds5,me,i,imsk,jmsk,lugb ! @@ -2802,10 +2799,9 @@ subroutine hmskrd(lugb,imsk,jmsk,fnmskh, & subroutine fixrdg(lugb,idim,jdim,fngrib, & & kpds5,gdata,gaus,blno,blto,me) use machine , only : kind_io8,kind_dbl_prec,kind_sngl_prec - use sfccyc_module, only : mdata implicit none integer lgrib,n,lskip,jret,j,ndata,lugi,jdim,idim,lugb, - & iret, me,kpds5,kdata,i,w3kindreal,w3kindint + & iret, me,kpds5,kdata,i ! character*(*) fngrib ! @@ -2813,7 +2809,6 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & logical gaus real (kind=kind_io8) blno,blto real (kind=kind_dbl_prec), allocatable :: data8(:) - real (kind=kind_sngl_prec), allocatable :: data4(:) ! logical*1, allocatable :: lbms(:) ! @@ -2849,6 +2844,7 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & jgds = -1 jpds(5) = kpds5 kpds = jpds + kgds = jgds ! call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata, & lskip,kpds,kgds,iret) @@ -2872,20 +2868,8 @@ subroutine fixrdg(lugb,idim,jdim,fngrib, & jpds = kpds0 lskip = -1 kdata=idim*jdim - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then call getgb(lugb,lugi,kdata,lskip,jpds,jgds,ndata,lskip, & kpds,kgds,lbms,data8,jret) - else if (w3kindreal == 4) then - allocate(data4(1:idim*jdim)) - call getgb(lugb,lugi,kdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec) - deallocate(data4) - else - write(0,*)' FATAL ERROR: Invalid w3kindreal' - call abort - endif ! if(jret == 0) then if(ndata.eq.0) then @@ -3105,8 +3089,11 @@ subroutine subst(data,imax,jmax,dlon,dlat,ijordr) enddo enddo else - do i=1,imax - data(imax-i+1,jj) = work(i,j) + do j=1,jmax + jj = jmax - j + 1 + do i=1,imax + data(imax-i+1,jj) = work(i,j) + enddo enddo endif else @@ -3136,7 +3123,6 @@ subroutine la2ga(regin,imxin,jmxin,rinlon,rinlat,rlon,rlat,inttyp,& & gauout,len,lmask,rslmsk,slmask & &, outlat, outlon,me) use machine , only : kind_io8,kind_io4 - use sfccyc_module , only : num_threads implicit none real (kind=kind_io8) wei4,wei3,wei2,sum2,sum1,sum3,wei1,sum4, & & wsum,tem,wsumiv,sums,sumn,wi2j2,x,y,wi1j1, & @@ -4024,6 +4010,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & ! read in snow depth/snow cover ! irtscv=0 + irtsno=0 if(fnsnoa(1:8).ne.' ') then do i=1,len scvanl(i)=0. @@ -4046,6 +4033,7 @@ subroutine analy(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & jpds=-1 jgds=-1 kpds=jpds + kgds=jgds call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata, & lskip,kpds,kgds,iret) close(lugb) @@ -4801,8 +4789,6 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & & irtvmn,irtvmx,irtslp,irtabs, & & irtvet,irtsot,irtsoc,irtalf, landice, me) use machine , only : kind_io8,kind_io4 - use sfccyc_module, only : veg_type_landice, soil_type_landice, & - & num_threads, zero, one,soil_color_landice implicit none integer k,i,im,id,iy,len,lsoil,ih,irtacn,irtsmc,irtscv,irtais, & & irttg3,irtstc,irtalf,me,irtsot,irtsoc,irtveg,irtvet, irtzor, & !irtsoc:soil color @@ -5521,7 +5507,6 @@ subroutine qcmxmn(ttl,fld,slimsk,sno,iceflg, & & rla,rlo,len,mode,percrit,lgchek,me) ! use machine , only : kind_io8,kind_io4 - use sfccyc_module , only : num_threads implicit none integer, intent(in) :: len, mode, me real (kind=kind_io8), intent(in) :: fldimx,fldimn,fldjmx,fldomn, & @@ -6267,7 +6252,6 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, & & data,imax,jmax,rlnout,rltout,lmask,rslmsk & &, gaus,blno, blto, kgds1, kpds4, lbms) use machine , only : kind_io8,kind_io4,kind_dbl_prec - use sfccyc_module implicit none real (kind=kind_io8) blno,blto,wlon,rnlat,crit,data_max integer i,j,ijmax,jgaul,igaul,kpds5,jmax,imax, kgds1, kspla @@ -6753,7 +6737,6 @@ subroutine setrmsk(kpds5,slmask,igaul,jgaul,wlon,rnlat, & subroutine ga2la(gauin,imxin,jmxin,regout,imxout,jmxout, & & wlon,rnlat,rlnout,rltout,gaus,blno, blto) use machine , only : kind_io8,kind_io4,kind_dbl_prec - use sfccyc_module , only : num_threads implicit none integer i1,i2,j2,ishft,i,jj,j1,jtem,jmxout,imxin,jmxin,imxout, & & j,iret @@ -7081,7 +7064,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & &, gaus, blno, blto, me,lprnt,iprnt, fnalbc2, ialb & &, tile_num_ch, i_index, j_index) ! - use machine , only : kind_io8,kind_io4 + use machine , only : kind_io8,kind_io4, kind_dbl_prec implicit none character(len=*), intent(in) :: tile_num_ch integer, intent(in) :: i_index(len), j_index(len) @@ -7141,9 +7124,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & data dayhf/ 15.5, 45.0, 74.5,105.0,135.5,166.0, & 196.5,227.5,258.0,288.5,319.0,349.5,380.5/ ! - real(8) fha(5) - real(4) fha4(5) - integer w3kindreal,w3kindint + real (kind=kind_dbl_prec) fha(5) integer ida(8),jda(8),ivtyp, kpd7 ! real (kind=kind_io8), allocatable :: tsf(:,:),sno(:,:), @@ -7235,13 +7216,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & ida(2) = im ida(3) = id ida(5) = ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - fha4 = fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif + call w3movdat(fha,ida,jda) jy = jda(1) jm = jda(2) jd = jda(3) @@ -7311,13 +7286,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & ida(2) = im ida(3) = id ida(5) = ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - fha4 = fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif + call w3movdat(fha,ida,jda) jy = jda(1) jm = jda(2) jd = jda(3) @@ -7697,7 +7666,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & ! points. so for efficiency, don't have fixrdc try to ! find a value at landice points as defined by the vet type (vet). allocate(slmask_noice(len)) - slmask_noice = 1.0 + slmask_noice = slmskl do i = 1, len if (nint(vet(i)) < 1 .or. & nint(vet(i)) == landice_cat) then @@ -7968,7 +7937,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & ! points. so for efficiency, don't have fixrdc try to ! find a value at landice points as defined by the vet type (vet). allocate(slmask_noice(len)) - slmask_noice=1.0 + slmask_noice = slmskl do i = 1, len if (nint(vet(i)) < 1 .or. & nint(vet(i)) == landice_cat) then @@ -8436,11 +8405,10 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & &, imsk, jmsk, slmskh, gaus,blno, blto & &, outlat, outlon, me) use machine , only : kind_io8,kind_dbl_prec,kind_sngl_prec - use sfccyc_module, only : mdata implicit none integer imax,jmax,ijmax,i,j,n,jret,inttyp,iret,imsk, & & jmsk,len,lugb,kpds5,mon,lskip,lgrib,ndata,lugi,me,kmami & - &, jj,w3kindreal,w3kindint + &, jj real (kind=kind_io8) wlon,elon,rnlat,dlat,dlon,rslat,blno,blto ! ! @@ -8452,7 +8420,6 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & real (kind=kind_io8) gdata(len), slmask(len) real (kind=kind_io8), allocatable :: data(:,:), rslmsk(:,:) real (kind=kind_dbl_prec), allocatable :: data8(:) - real (kind=kind_sngl_prec), allocatable :: data4(:) real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) ! logical lmask, yr2kc, gaus, ijordr @@ -8495,6 +8462,7 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & jpds(5) = kpds5 jpds(7) = kpds7 kpds = jpds + kgds = jgds call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata, & lskip,kpds,kgds,iret) if (me .eq. 0) then @@ -8520,17 +8488,8 @@ subroutine fixrdc(lugb,fngrib,kpds5,kpds7,mon,slmask, & jpds = kpds0 jpds(9) = mon if(jpds(9).eq.13) jpds(9) = 1 - call w3kind(w3kindreal,w3kindint) - if (w3kindreal==8) then - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data8,jret) - else if (w3kindreal==4) then - allocate(data4(1:mdata)) - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec) - deallocate(data4) - endif + call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, + & kpds,kgds,lbms,data8,jret) if (me .eq. 0) write(6,*) ' input grib file dates=', & (kpds(i),i=8,11) if(jret.eq.0) then @@ -8610,12 +8569,11 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & &, imsk, jmsk, slmskh, gaus,blno, blto & &, outlat, outlon, me) use machine , only : kind_io8,kind_dbl_prec,kind_sngl_prec - use sfccyc_module, only : mdata implicit none integer nrepmx,nvalid,imo,iyr,idy,jret,ihr,nrept,lskip,lugi, & & lgrib,j,ndata,i,inttyp,jmax,imax,ijmax,ij,jday,len,iret, & & jmsk,imsk,ih,kpds5,lugb,iy,id,im,jh,jd,jdoy,jdow,jm,me, & - & monend,jy,iy4,kmami,iret2,jj,w3kindreal,w3kindint + & monend,jy,iy4,kmami,iret2,jj real (kind=kind_io8) rnlat,rslat,wlon,elon,dlon,dlat,fh,blno, & & rjday,blto ! @@ -8637,7 +8595,6 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & real (kind=kind_io8) gdata(len), slmask(len) real (kind=kind_io8), allocatable :: data(:,:),rslmsk(:,:) real (kind=kind_dbl_prec), allocatable :: data8(:) - real (kind=kind_sngl_prec), allocatable :: data4(:) real (kind=kind_io8), allocatable :: rlngrb(:), rltgrb(:) ! logical lmask, yr2kc, gaus, ijordr @@ -8658,8 +8615,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & integer mjday(12) data mjday/31,28,31,30,31,30,31,31,30,31,30,31/ ! - real(8) fha(5) - real(4) fha4(5) + real (kind=kind_dbl_prec) fha(5) integer ida(8),jda(8) ! allocate(data8(1:mdata)) @@ -8678,13 +8634,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & ida(2)=im ida(3)=id ida(5)=ih - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - fha4=fha - call w3movdat(fha4,ida,jda) - else - call w3movdat(fha,ida,jda) - endif + call w3movdat(fha,ida,jda) jy=jda(1) jm=jda(2) jd=jda(3) @@ -8725,6 +8675,7 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & jgds=-1 jpds(5)=kpds5 kpds = jpds + kgds = jgds call getgbh(lugb,lugi,lskip,jpds,jgds,lgrib,ndata, & lskip,kpds,kgds,iret) if (me .eq. 0) then @@ -8767,17 +8718,8 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & jpds(10)=idy ! jpds(11)=ihr jpds(21)=(iyr-1)/100+1 - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data8,jret) - elseif (w3kindreal == 4) then - allocate (data4(1:mdata)) - call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, - & kpds,kgds,lbms,data4,jret) - data8(1:ndata) = real(data4(1:ndata), kind=kind_dbl_prec) - deallocate(data4) - endif + call getgb(lugb,lugi,mdata,lskip,jpds,jgds,ndata,lskip, + & kpds,kgds,lbms,data8,jret) if (me .eq. 0) write(6,*) ' input grib file dates=', & (kpds(i),i=8,11) if(jret.eq.0) then @@ -8807,13 +8749,10 @@ subroutine fixrda(lugb,fngrib,kpds5,slmask, & ! ! no matching ih found. search nearest hour ! - if(ihr.eq.6) then - ihr=0 - go to 50 - elseif(ihr.eq.12) then + if(ihr.gt.0.and.ihr.le.12) then ihr=0 go to 50 - elseif(ihr.eq.18) then + elseif(ihr.gt.0.and.ihr.le.23) then ihr=12 go to 50 elseif(ihr.eq.0.or.ihr.eq.-1) then @@ -8948,3 +8887,6 @@ subroutine snodpth2(glacir,snwmax,snoanl, len, me) return end !>@} + + end module sfccyc_module + diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 index 9c2e27611..b4adf8719 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.F90 @@ -22,18 +22,18 @@ module sgscloud_radpre !> \section arg_table_sgscloud_radpre_run Argument Table !! \htmlinclude sgscloud_radpre_run.html !! -!! cloud array description: ! -!! clouds(:,:,1) - layer total cloud fraction ! -!! clouds(:,:,2) - layer cloud liq water path ! -!! clouds(:,:,3) - mean effective radius for liquid cloud ! -!! clouds(:,:,4) - layer cloud ice water path ! -!! clouds(:,:,5) - mean effective radius for ice cloud ! -!! clouds(:,:,6) - layer rain drop water path ! -!! clouds(:,:,7) - mean effective radius for rain drop ! -!! clouds(:,:,8) - layer snow flake water path ! -!! clouds(:,:,9) - mean effective radius for snow flake -!! -!>\section sgscloud_radpre_mod SGS Cloud Scheme Pre General Algorithm +! cloud array description: ! +! clouds(:,:,1) - layer total cloud fraction ! +! clouds(:,:,2) - layer cloud liq water path ! +! clouds(:,:,3) - mean effective radius for liquid cloud ! +! clouds(:,:,4) - layer cloud ice water path ! +! clouds(:,:,5) - mean effective radius for ice cloud ! +! clouds(:,:,6) - layer rain drop water path ! +! clouds(:,:,7) - mean effective radius for rain drop ! +! clouds(:,:,8) - layer snow flake water path ! +! clouds(:,:,9) - mean effective radius for snow flake +! +! \section sgscloud_radpre_mod SGS Cloud Scheme Pre General Algorithm subroutine sgscloud_radpre_run( & im,dt,fhswr,levs, & flag_init,flag_restart, & @@ -81,18 +81,18 @@ subroutine sgscloud_radpre_run( & real(kind=kind_phys), dimension(:,:), intent(inout) :: qc, qi real(kind=kind_phys), dimension(:,:), intent(inout) :: qr, qs, qg ! note: qci_conv only allocated if GF is used - real(kind=kind_phys), dimension(:,:), intent(inout) :: qci_conv + real(kind=kind_phys), dimension(:,:), intent(inout), optional :: qci_conv real(kind=kind_phys), dimension(:,:), intent(inout) :: qlc, qli !for SAS - real(kind=kind_phys), dimension(:,:), intent(in) :: ud_mf + real(kind=kind_phys), dimension(:,:), intent(in), optional :: ud_mf real(kind=kind_phys), dimension(:,:), intent(in) :: T3D,delp real(kind=kind_phys), dimension(:,:), intent(in) :: qv,P3D,exner real(kind=kind_phys), dimension(:,:), intent(inout) :: & & clouds1,clouds2,clouds3,clouds4,clouds5, & & clouds8,clouds9 real(kind=kind_phys), dimension(:,:), intent(inout) :: qc_save, qi_save, qs_save - real(kind=kind_phys), dimension(:,:), intent(in) :: qc_bl, qi_bl, cldfra_bl + real(kind=kind_phys), dimension(:,:), intent(in), optional :: qc_bl, qi_bl, cldfra_bl real(kind=kind_phys), dimension(:), intent(in) :: slmsk, xlat, de_lgth - real(kind=kind_phys), dimension(:,:), intent(in) :: plyr, dz + real(kind=kind_phys), dimension(:,:), intent(in) :: plyr, dz real(kind=kind_phys), dimension(:,:), intent(inout) :: cldsa integer, dimension(:,:), intent(inout) :: mbota, mtopa integer, intent(in) :: iovr diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta index e094c3e12..57fa61dfe 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/sgscloud_radpre.meta @@ -1,10 +1,10 @@ [ccpp-table-properties] name = sgscloud_radpre type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = tools/funcphys.f90,hooks/machine.F dependencies = hooks/physcons.F90,Radiation/RRTMG/radcons.f90 - dependencies = Radiation/radiation_clouds.f,MP/Thompson/module_mp_thompson.F90 + dependencies = Radiation/radiation_clouds.f,MP/module_mp_radar.F90,MP/Thompson/module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] @@ -221,6 +221,7 @@ type = real kind = kind_phys intent = in + optional = True [qci_conv] standard_name = convective_cloud_condesate_after_rainout long_name = convective cloud condesate after rainout @@ -229,6 +230,7 @@ type = real kind = kind_phys intent = inout + optional = True [qlc] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array @@ -312,6 +314,7 @@ type = real kind = kind_phys intent = in + optional = True [QI_BL] standard_name = subgrid_scale_cloud_ice_mixing_ratio long_name = subgrid cloud ice mixing ratio from PBL scheme @@ -320,6 +323,7 @@ type = real kind = kind_phys intent = in + optional = True [CLDFRA_BL] standard_name = subgrid_scale_cloud_area_fraction_in_atmosphere_layer long_name = subgrid cloud fraction from PBL scheme @@ -328,6 +332,7 @@ type = real kind = kind_phys intent = in + optional = True [delp] standard_name = layer_pressure_thickness_for_radiation long_name = layer pressure thickness on radiation levels diff --git a/physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 b/physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 index 380ba9de5..43c98026b 100644 --- a/physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 +++ b/physics/MP/Ferrier_Aligo/module_MP_FER_HIRES.F90 @@ -108,9 +108,7 @@ MODULE MODULE_MP_FER_HIRES ! !----------------------------------------------------------------------------- -#ifdef MPI - USE mpi -#endif + USE mpi_f08 USE machine !MZ !MZ USE MODULE_CONSTANTS,ONLY : PI, CP, EPSQ, GRAV=>G, RHOL=>RHOWATER, & @@ -2447,9 +2445,7 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MPIRANK,MPIROOT,THREADS, & ! !----------------------------------------------------------------------- ! -#ifdef MPI - use mpi -#endif + use mpi_f08 IMPLICIT NONE ! !------------------------------------------------------------------------- @@ -2466,7 +2462,7 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MPIRANK,MPIROOT,THREADS, & REAL, INTENT(IN) :: GSMDT INTEGER, INTENT(IN) :: MPIRANK INTEGER, INTENT(IN) :: MPIROOT - INTEGER, INTENT(IN) :: MPI_COMM_COMP + TYPE(MPI_Comm), INTENT(IN) :: MPI_COMM_COMP INTEGER, INTENT(IN) :: THREADS CHARACTER(LEN=*), INTENT(OUT) :: errmsg INTEGER, INTENT(OUT) :: errflg @@ -2507,9 +2503,7 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MPIRANK,MPIROOT,THREADS, & if (.NOT. ALLOCATED(vsnowi)) ALLOCATE(vsnowi(MDImin:MDImax)) if (.NOT. ALLOCATED(vel_rf)) ALLOCATE(vel_rf(2:9,0:Nrime)) -#ifdef MPI call MPI_BARRIER(MPI_COMM_COMP,ierr) -#endif only_root_reads: if (MPIRANK==MPIROOT) then force_read_ferhires = .true. @@ -2567,7 +2561,6 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MPIRANK,MPIROOT,THREADS, & ENDIF endif only_root_reads ! -#ifdef MPI CALL MPI_BCAST(VENTR1,SIZE(VENTR1),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(VENTR2,SIZE(VENTR2),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(ACCRR, SIZE(ACCRR), MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) @@ -2580,7 +2573,6 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MPIRANK,MPIROOT,THREADS, & CALL MPI_BCAST(MASSI, SIZE(MASSI), MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(VSNOWI,SIZE(VSNOWI),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) CALL MPI_BCAST(VEL_RF,SIZE(VEL_RF),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) -#endif ! !--- Calculates coefficients for growth rates of ice nucleated in water diff --git a/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 b/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 index 938beae5d..1387dcbab 100644 --- a/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 +++ b/physics/MP/Ferrier_Aligo/mp_fer_hires.F90 @@ -36,6 +36,7 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & mpicomm, mpirank,mpiroot, & threads, errmsg, errflg) + USE mpi_f08 USE machine, ONLY : kind_phys USE MODULE_MP_FER_HIRES, ONLY : FERRIER_INIT_HR implicit none @@ -45,7 +46,7 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & real(kind_phys), intent(in) :: dtp integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_fer_hires - integer, intent(in) :: mpicomm + type(MPI_Comm), intent(in) :: mpicomm integer, intent(in) :: mpirank integer, intent(in) :: mpiroot integer, intent(in) :: threads @@ -139,7 +140,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & real(kind_phys), intent(in ) :: epsq,r_d,p608,cp,g real(kind_phys), intent(inout) :: t(:,:) real(kind_phys), intent(inout) :: q(:,:) - real(kind_phys), intent(inout) :: train(:,:) + real(kind_phys), intent(inout), optional :: train(:,:) real(kind_phys), intent(out ) :: sr(:) real(kind_phys), intent(inout) :: qc(:,:) real(kind_phys), intent(inout) :: qr(:,:) diff --git a/physics/MP/Ferrier_Aligo/mp_fer_hires.meta b/physics/MP/Ferrier_Aligo/mp_fer_hires.meta index 0f7be213e..0838bede2 100644 --- a/physics/MP/Ferrier_Aligo/mp_fer_hires.meta +++ b/physics/MP/Ferrier_Aligo/mp_fer_hires.meta @@ -55,7 +55,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank @@ -194,6 +194,7 @@ type = real kind = kind_phys intent = inout + optional = True [sr] standard_name = ratio_of_snowfall_to_rainfall long_name = snow ratio: ratio of snow to total precipitation (explicit only) diff --git a/physics/MP/GFDL/GFDL_parse_tracers.F90 b/physics/MP/GFDL/GFDL_parse_tracers.F90 deleted file mode 100644 index c81127101..000000000 --- a/physics/MP/GFDL/GFDL_parse_tracers.F90 +++ /dev/null @@ -1,41 +0,0 @@ -module parse_tracers - - integer, parameter :: NO_TRACER = -99 - - public get_tracer_index, NO_TRACER - -CONTAINS - - function get_tracer_index (tracer_names, name, me, master, debug) - - character(len=32), intent(in) :: tracer_names(:) - character(len=*), intent(in) :: name - integer, intent(in) :: me - integer, intent(in) :: master - logical, intent(in) :: debug - !--- local variables - integer :: get_tracer_index - integer :: i - - get_tracer_index = NO_TRACER - - do i=1, size(tracer_names) - if (trim(name) == trim(tracer_names(i))) then - get_tracer_index = i - exit - endif - enddo - - if (debug .and. (me == master)) then - if (get_tracer_index == NO_TRACER) then - print *,' PE ',me,' tracer with name '//trim(name)//' not found' - else - print *,' PE ',me,' tracer FOUND:',trim(name) - endif - endif - - return - - end function get_tracer_index - -end module parse_tracers diff --git a/physics/MP/GFDL/fv_sat_adj.F90 b/physics/MP/GFDL/fv_sat_adj.F90 index 53543485b..6fb0d73a1 100644 --- a/physics/MP/GFDL/fv_sat_adj.F90 +++ b/physics/MP/GFDL/fv_sat_adj.F90 @@ -46,7 +46,7 @@ module fv_sat_adj ! is_master ! ! -! gfdl_cloud_microphys_mod +! module_gfdl_param ! ql_gen, qi_gen, qi0_max, ql_mlt, ql0_max, qi_lim, qs_mlt, ! tau_r2g, tau_smlt, tau_i2s, tau_v2l, tau_l2v, tau_imlt, tau_l2r, ! rad_rain, rad_snow, rad_graupel, dw_ocean, dw_land, tintqs @@ -61,10 +61,11 @@ module fv_sat_adj cp_air => con_cp_dyn ! *DH use machine, only: kind_grid, kind_dyn - use gfdl_cloud_microphys_mod, only: ql_gen, qi_gen, qi0_max, ql_mlt, ql0_max, qi_lim, qs_mlt - use gfdl_cloud_microphys_mod, only: icloud_f, sat_adj0, t_sub, cld_min - use gfdl_cloud_microphys_mod, only: tau_r2g, tau_smlt, tau_i2s, tau_v2l, tau_l2v, tau_imlt, tau_l2r - use gfdl_cloud_microphys_mod, only: rad_rain, rad_snow, rad_graupel, dw_ocean, dw_land, tintqs + use module_gfdlmp_param, only: ql_gen, qi_gen, qi0_max, ql_mlt, ql0_max, qi_lim, qs_mlt + use module_gfdlmp_param, only: icloud_f, sat_adj0, t_sub, cld_min + use module_gfdlmp_param, only: tau_r2g, tau_smlt, tau_i2s, tau_v2l, tau_l2v, tau_imlt, tau_l2r + use module_gfdlmp_param, only: rad_rain, rad_snow, rad_graupel, dw_ocean, dw_land, tintqs + #ifdef MULTI_GASES use ccpp_multi_gases_mod, only: multi_gases_init, & multi_gases_finalize, & @@ -230,7 +231,7 @@ end subroutine fv_sat_adj_finalize !! \section arg_table_fv_sat_adj_run Argument Table !! \htmlinclude fv_sat_adj_run.html !! -subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, jsd, jed, & +subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, isc1, iec1, isc2, iec2, kmp, km, kmdelz, js, je, jsd, jed, jsc1, jec1, jsc2, jec2, & ng, hydrostatic, fast_mp_consv, te0_2d, te0, ngas, qvi, qv, ql, qi, qr, & qs, qg, hs, peln, delz, delp, pt, pkz, q_con, akap, cappa, area, dtdt, & out_dt, last_step, do_qa, qa, & @@ -245,6 +246,10 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, integer, intent(in) :: ie integer, intent(in) :: isd integer, intent(in) :: ied + integer, intent(in) :: isc1 + integer, intent(in) :: iec1 + integer, intent(in) :: isc2 + integer, intent(in) :: iec2 integer, intent(in) :: kmp integer, intent(in) :: km integer, intent(in) :: kmdelz @@ -252,6 +257,10 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, integer, intent(in) :: je integer, intent(in) :: jsd integer, intent(in) :: jed + integer, intent(in) :: jsc1 + integer, intent(in) :: jec1 + integer, intent(in) :: jsc2 + integer, intent(in) :: jec2 integer, intent(in) :: ng logical, intent(in) :: hydrostatic logical, intent(in) :: fast_mp_consv @@ -259,7 +268,11 @@ subroutine fv_sat_adj_run(mdt, zvir, is, ie, isd, ied, kmp, km, kmdelz, js, je, real(kind=kind_dyn), intent( out) :: te0(isd:ied, jsd:jed, 1:km) ! If multi-gases physics are not used, ngas is one and qvi identical to qv integer, intent(in) :: ngas +#ifdef MULTI_GASES real(kind=kind_dyn), intent(inout) :: qvi(isd:ied, jsd:jed, 1:km, 1:ngas) +#else + real(kind=kind_dyn), intent(inout) :: qvi(:,:,:,:) +#endif real(kind=kind_dyn), intent(inout) :: qv(isd:ied, jsd:jed, 1:km) real(kind=kind_dyn), intent(inout) :: ql(isd:ied, jsd:jed, 1:km) real(kind=kind_dyn), intent(inout) :: qi(isd:ied, jsd:jed, 1:km) diff --git a/physics/MP/GFDL/fv_sat_adj.meta b/physics/MP/GFDL/fv_sat_adj.meta index c91e438b7..98d803583 100644 --- a/physics/MP/GFDL/fv_sat_adj.meta +++ b/physics/MP/GFDL/fv_sat_adj.meta @@ -2,8 +2,8 @@ name = fv_sat_adj type = scheme dependencies = ../../hooks/machine.F,../../hooks/physcons.F90 - dependencies = module_gfdl_cloud_microphys.F90,multi_gases.F90 - dependencies = ../module_mp_radar.F90 + dependencies = ../multi_gases.F90,../module_mp_radar.F90 + dependencies = module_gfdlmp_param.F90 ######################################################################## [ccpp-arg-table] @@ -41,7 +41,7 @@ standard_name = gas_constants_for_multi_gases_physics long_name = gas constants for multi gases physics units = J kg-1 K-1 - dimensions = (0:number_of_gases_for_multi_gases_physics) + dimensions = (constant_zero:number_of_gases_for_multi_gases_physics) type = real kind = kind_dyn intent = in @@ -49,7 +49,7 @@ standard_name = specific_heat_capacities_for_multi_gases_physics long_name = specific heat capacities for multi gases physics units = J kg-1 K-1 - dimensions = (0:number_of_gases_for_multi_gases_physics) + dimensions = (constant_zero:number_of_gases_for_multi_gases_physics) type = real kind = kind_dyn intent = in @@ -137,6 +137,34 @@ dimensions = () type = integer intent = in +[isc1] + standard_name = starting_x_direction_index_alloc1 + long_name = starting X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[iec1] + standard_name = ending_x_direction_index_alloc1 + long_name = ending X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[isc2] + standard_name = starting_x_direction_index_alloc2 + long_name = starting X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[iec2] + standard_name = ending_x_direction_index_alloc2 + long_name = ending X direction index for allocation + units = count + dimensions = () + type = integer + intent = in [isd] standard_name = starting_x_direction_index_domain long_name = starting X direction index for domain @@ -200,6 +228,34 @@ dimensions = () type = integer intent = in +[jsc1] + standard_name = starting_y_direction_index_alloc1 + long_name = starting X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[jec1] + standard_name = ending_y_direction_index_alloc1 + long_name = ending X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[jsc2] + standard_name = starting_y_direction_index_alloc2 + long_name = starting X direction index for allocation + units = count + dimensions = () + type = integer + intent = in +[jec2] + standard_name = ending_y_direction_index_alloc2 + long_name = ending X direction index for allocation + units = count + dimensions = () + type = integer + intent = in [ng] standard_name = number_of_ghost_zones long_name = number of ghost zones defined in fv_mp @@ -233,7 +289,7 @@ standard_name = atmosphere_energy_content_at_Lagrangian_surface long_name = atmosphere total energy at Lagrangian surface units = J m-2 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = out @@ -248,7 +304,7 @@ standard_name = gas_tracers_for_multi_gas_physics_at_Lagrangian_surface long_name = gas tracers for multi gas physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics,1:number_of_gases_for_multi_gases_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,ccpp_constant_one:vertical_dimension_for_fast_physics,ccpp_constant_one:number_of_gases_for_multi_gases_physics) type = real kind = kind_dyn intent = inout @@ -256,7 +312,7 @@ standard_name = water_vapor_specific_humidity_at_Lagrangian_surface long_name = water vapor specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -264,7 +320,7 @@ standard_name = cloud_liquid_water_specific_humidity_at_Lagrangian_surface long_name = cloud liquid water specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -272,7 +328,7 @@ standard_name = cloud_ice_specific_humidity_at_Lagrangian_surface long_name = cloud ice specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -280,7 +336,7 @@ standard_name = cloud_rain_specific_humidity_at_Lagrangian_surface long_name = cloud rain specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -288,7 +344,7 @@ standard_name = cloud_snow_specific_humidity_at_Lagrangian_surface long_name = cloud snow specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -296,7 +352,7 @@ standard_name = cloud_graupel_specific_humidity_at_Lagrangian_surface long_name = cloud graupel specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -304,7 +360,7 @@ standard_name = surface_geopotential_at_Lagrangian_surface long_name = surface geopotential at Lagrangian surface units = m2 s-2 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1) type = real kind = kind_dyn intent = in @@ -312,7 +368,7 @@ standard_name = log_pressure_at_Lagrangian_surface long_name = logarithm of pressure at Lagrangian surface units = Pa - dimensions = (starting_x_direction_index:ending_x_direction_index,1:vertical_dimension_for_fast_physics_plus_one,starting_y_direction_index:ending_y_direction_index) + dimensions = (starting_x_direction_index_alloc2:ending_x_direction_index_alloc2,ccpp_constant_one:vertical_dimension_for_fast_physics_plus_one,starting_y_direction_index_alloc2:ending_y_direction_index_alloc2) type = real kind = kind_dyn intent = in @@ -320,7 +376,7 @@ standard_name = thickness_at_Lagrangian_surface long_name = thickness at Lagrangian_surface units = m - dimensions = (starting_x_direction_index:ending_x_direction_index,starting_y_direction_index:ending_y_direction_index,1:vertical_dimension_for_thickness_at_Lagrangian_surface) + dimensions = (starting_x_direction_index_alloc2:ending_x_direction_index_alloc2,starting_y_direction_index_alloc2:ending_y_direction_index_alloc2,ccpp_constant_one:vertical_dimension_for_thickness_at_Lagrangian_surface) type = real kind = kind_dyn intent = in @@ -328,7 +384,7 @@ standard_name = pressure_thickness_at_Lagrangian_surface long_name = pressure thickness at Lagrangian surface units = Pa - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = in @@ -336,7 +392,7 @@ standard_name = virtual_temperature_at_Lagrangian_surface long_name = virtual temperature at Lagrangian surface units = K - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -344,7 +400,7 @@ standard_name = finite_volume_mean_edge_pressure_raised_to_the_power_of_kappa long_name = finite-volume mean edge pressure in Pa raised to the power of kappa units = 1 - dimensions = (starting_x_direction_index:ending_x_direction_index,starting_y_direction_index:ending_y_direction_index,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc2:ending_x_direction_index_alloc2,starting_y_direction_index_alloc2:ending_y_direction_index_alloc2,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -352,7 +408,7 @@ standard_name = cloud_condensed_water_specific_humidity_at_Lagrangian_surface long_name = cloud condensed water specific humidity updated by fast physics at Lagrangian surface units = kg kg-1 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_condensed_water_at_Lagrangian_surface) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,ccpp_constant_one:vertical_dimension_for_condensed_water_at_Lagrangian_surface) type = real kind = kind_dyn intent = inout @@ -368,7 +424,7 @@ standard_name = cappa_moist_gas_constant_at_Lagrangian_surface long_name = cappa(i,j,k) = rdgas / ( rdgas + cvm(i)/(1.+r_vir*q(i,j,k,sphum)) ) units = none - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_cappa_at_Lagrangian_surface) + dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,ccpp_constant_one:vertical_dimension_for_cappa_at_Lagrangian_surface) type = real kind = kind_dyn intent = inout @@ -376,7 +432,7 @@ standard_name = cell_area_for_fast_physics long_name = area of the grid cell for fast physics units = m2 - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1) type = real kind = kind_grid intent = in @@ -384,7 +440,7 @@ standard_name = tendency_of_air_temperature_at_Lagrangian_surface long_name = air temperature tendency due to fast physics at Lagrangian surface units = K s-1 - dimensions = (starting_x_direction_index:ending_x_direction_index,starting_y_direction_index:ending_y_direction_index,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index:ending_x_direction_index,starting_y_direction_index:ending_y_direction_index,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = inout @@ -413,7 +469,7 @@ standard_name = cloud_fraction_at_Lagrangian_surface long_name = cloud fraction at Lagrangian surface units = none - dimensions = (starting_x_direction_index_domain:ending_x_direction_index_domain,starting_y_direction_index_domain:ending_y_direction_index_domain,1:vertical_dimension_for_fast_physics) + dimensions = (starting_x_direction_index_alloc1:ending_x_direction_index_alloc1,starting_y_direction_index_alloc1:ending_y_direction_index_alloc1,ccpp_constant_one:vertical_dimension_for_fast_physics) type = real kind = kind_dyn intent = out diff --git a/physics/MP/GFDL/module_gfdlmp_param.F90 b/physics/MP/GFDL/module_gfdlmp_param.F90 new file mode 100644 index 000000000..c20e22946 --- /dev/null +++ b/physics/MP/GFDL/module_gfdlmp_param.F90 @@ -0,0 +1,388 @@ +! ######################################################################################### +! ######################################################################################### +module module_gfdlmp_param + use machine, only: kind_phys + implicit none + public :: read_gfdlmp_nml + private + + ! ##################################################################################### + ! GFDL MP Version 1 parameters. + ! ##################################################################################### + real(kind_phys) :: tau_g2r = 600. !< graupel melting to rain time scale (s) + real(kind_phys) :: tau_g2v = 900. !< graupel sublimation time scale (s) + real(kind_phys) :: tau_v2g = 21600. !< graupel deposition -- make it a slow process time scale (s) + real(kind_phys) :: qc_crt = 5.0e-8 !< mini condensate mixing ratio to allow partial cloudiness + real(kind_phys) :: qr0_crt = 1.0e-4 !< rain to snow or graupel/hail threshold + !< lfo used * mixing ratio * = 1.e-4 (hail in lfo) + real(kind_phys) :: c_piacr = 5.0 !< accretion: rain to ice: + real(kind_phys) :: c_cracw = 0.9 !< rain accretion efficiency + real(kind_phys) :: alin = 842.0 !< "a" in lin1983 + real(kind_phys) :: clin = 4.8 !< "c" in lin 1983, 4.8 -- > 6. (to ehance ql -- > qs) + logical :: fast_sat_adj = .false. !< has fast saturation adjustments + logical :: use_ccn = .false. !< must be true when prog_ccn is false + logical :: use_ppm = .false. !< use ppm fall scheme + logical :: mono_prof = .true. !< perform terminal fall with mono ppm scheme + logical :: mp_print = .false. !< cloud microphysics debugging printout + logical :: de_ice = .false. !< to prevent excessive build - up of cloud ice from external sources + logical :: sedi_transport = .true. !< transport of momentum in sedimentation + + ! ##################################################################################### + ! GFDL MP common (v1/v3) parameters + ! ##################################################################################### + real(kind_phys) :: cld_min = 0.05 !< (v1/v3) minimum cloud fraction + real(kind_phys) :: t_min = 178. !< (v1/v3) min temp to freeze - dry all water vapor + real(kind_phys) :: t_sub = 184. !< (v1/v3) min temp for sublimation of cloud ice + real(kind_phys) :: mp_time = 150. !< (v1/v3) maximum micro - physics time step (sec) + real(kind_phys) :: rh_inc = 0.25 !< (v1/v3) rh increment for complete evaporation of cloud water and cloud ice + real(kind_phys) :: rh_inr = 0.25 !< (v1/v3) rh increment for minimum evaporation of rain + real(kind_phys) :: rh_ins = 0.25 !< (v1/v3) rh increment for sublimation of snow + real(kind_phys) :: tau_r2g = 900. !< (v1/v3) rain freezing during fast_sat time scale (s) + real(kind_phys) :: tau_smlt = 900. !< (v1/v3) snow melting time scale (s) + real(kind_phys) :: tau_i2s = 1000. !< (v1/v3) cloud ice to snow auto-conversion time scale (s) + real(kind_phys) :: tau_l2r = 900. !< (v1/v3) cloud water to rain auto-conversion time scale (s) + real(kind_phys) :: tau_v2l = 150. !< (v1/v3) water vapor to cloud water (condensation) time scale (s) + real(kind_phys) :: tau_l2v = 300. !< (v1/v3) cloud water to water vapor (evaporation) time scale (s) + real(kind_phys) :: dw_land = 0.20 !< (v1/v3) value for subgrid deviation / variability over land + real(kind_phys) :: dw_ocean = 0.10 !< (v1/v3) base value for ocean + real(kind_phys) :: ccn_o = 90. !< (v1/v3) ccn over ocean (cm^ - 3) + real(kind_phys) :: ccn_l = 270. !< (v1/v3) ccn over land (cm^ - 3) + real(kind_phys) :: sat_adj0 = 0.90 !< (v1/v3) adjustment factor (0: no, 1: full) during fast_sat_adj + real(kind_phys) :: qi_lim = 1. !< (v1/v3) cloud ice limiter (0: no, 1: full, >1: extra) to prevent large ice build up + real(kind_phys) :: ql_mlt = 2.0e-3 !< (v1/v3) max value of cloud water allowed from melted cloud ice + real(kind_phys) :: qs_mlt = 1.0e-6 !< (v1/v3) max cloud water due to snow melt + real(kind_phys) :: ql_gen = 1.0e-3 !< (v1/v3) max cloud water generation during remapping step if fast_sat_adj = .t. + real(kind_phys) :: qi_gen = 1.82e-6 !< (v1/v3) max cloud ice generation during remapping step (V1 ONLY. Computed internally in V3) + real(kind_phys) :: ql0_max = 2.0e-3 !< (v1/v3) max cloud water value (auto converted to rain) + real(kind_phys) :: qi0_max = 1.0e-4 !< (v1/v3) max cloud ice value (by other sources) + real(kind_phys) :: qi0_crt = 1.0e-4 !< (v1/v3) cloud ice to snow autoconversion threshold (was 1.e-4); + !< qi0_crt is highly dependent on horizontal resolution + real(kind_phys) :: qs0_crt = 1.0e-3 !< (v1/v3) snow to graupel density threshold (0.6e-3 in purdue lin scheme) + real(kind_phys) :: c_paut = 0.55 !< (v1/v3) autoconversion cloud water to rain (use 0.5 to reduce autoconversion) + real(kind_phys) :: vi_fac = 1. !< (v1/v3) if const_vi: 1 / 3 + real(kind_phys) :: vs_fac = 1. !< (v1/v3) if const_vs: 1. + real(kind_phys) :: vg_fac = 1. !< (v1/v3) if const_vg: 2. + real(kind_phys) :: vr_fac = 1. !< (v1/v3) if const_vr: 4. + real(kind_phys) :: vr_max = 12. !< (v1/v3) max fall speed for rain + real(kind_phys) :: rewmin = 5.0 !< (v1/v3) minimum effective radii (liquid) + real(kind_phys) :: reimin = 10.0 !< (v1/v3) minimum effective radii (ice) + real(kind_phys) :: reimax = 150.0 !< (v1/v3) maximum effective radii (ice) + real(kind_phys) :: rermax = 10000.0 !< (v1/v3) maximum effective radii (rain) + real(kind_phys) :: resmin = 150.0 !< (v1/v3) minimum effective radii (snow) + real(kind_phys) :: resmax = 10000.0 !< (v1/v3) maximum effective radii (snow) + real(kind_phys) :: regmax = 10000.0 !< (v1/v3) maximum effective radii (graupel) + ! + logical :: const_vi = .false. !< (v1/v3) if .t. the constants are specified by v * _fac + logical :: const_vs = .false. !< (v1/v3) if .t. the constants are specified by v * _fac + logical :: const_vg = .false. !< (v1/v3) if .t. the constants are specified by v * _fac + logical :: const_vr = .false. !< (v1/v3) if .t. the constants are specified by v * _fac + logical :: z_slope_liq = .true. !< (v1/v3) use linear mono slope for autocconversions + logical :: do_hail = .false. !< (v1/v3) use hail parameters instead of graupel + logical :: do_qa = .true. !< (v1/v3) do inline cloud fraction + logical :: rad_snow = .true. !< (v1/v3) consider snow in cloud fraciton calculation + logical :: rad_graupel = .true. !< (v1/v3) consider graupel in cloud fraction calculation + logical :: rad_rain = .true. !< (v1/v3) consider rain in cloud fraction calculation + logical :: do_sedi_heat = .true. !< (v1/v3) transport of heat in sedimentation + logical :: prog_ccn = .false. !< (v1/v3) do prognostic ccn (yi ming's method) + logical :: tintqs = .false. !< (v1/v3) + ! + integer :: icloud_f = 0 !< (v1/v3) GFDL cloud scheme + !< 0: subgrid variability based scheme + !< 1: same as 0, but for old fvgfs implementation + !< 2: binary cloud scheme + !< 3: extension of 0 + integer :: irain_f = 0 !< (v1/v3) cloud water to rain auto conversion scheme + !< 0: subgrid variability based scheme + !< 1: no subgrid varaibility + + ! ##################################################################################### + ! GFDL MP common (v1/v3) parameters, with different default values + ! ##################################################################################### + real(kind_phys) :: tice = 273.16 !< freezing temperature (K): ref: GFDL, GFS (DJS: V3=273.15) + real(kind_phys) :: tau_imlt = 600. !< cloud ice melting time scale (s) (DJS: V3=1200.) + real(kind_phys) :: rthresh = 10.0e-6 !< critical cloud drop radius (micro m) (DJS: v3=20.0e-6) + real(kind_phys) :: c_psaci = 0.02 !< accretion: cloud ice to snow (was 0.1 in zetac) (DJS: v3=0.05) + real(kind_phys) :: c_pgacs = 2.0e-3 !< snow to graupel "accretion" eff. (was 0.1 in zetac) (DJS: v3=0.01) + real(kind_phys) :: vi_max = 0.5 !< max fall speed for ice (DJS: v3=1.0) + real(kind_phys) :: vs_max = 5.0 !< max fall speed for snow (DJS: v3=2.0) + real(kind_phys) :: vg_max = 8.0 !< max fall speed for graupel (DJS: v3=12.0) + real(kind_phys) :: rewmax = 10.0 !< maximum effective radii (liquid) (DJS: v3=15.0) + real(kind_phys) :: rermin = 10.0 !< minimum effective radii (rain) (DJS: v3=15.0) + real(kind_phys) :: regmin = 300.0 !< minimum effective radii (graupel) (DJS: v3=150.0) + logical :: z_slope_ice = .false. !< use linear mono slope for autocconversions (DJS: v3=.true.) + logical :: do_sedi_w = .false. !< transport of vertical motion in sedimentation (DJS: v3=.true.) + logical :: fix_negative = .false. !< fix negative water species (DJS: v3=.true.) + integer :: reiflag = 1 !< cloud ice effective radius scheme (DJS: v3=5) + !< 1: Heymsfield and Mcfarquhar (1996) + !< 2: Donner et al. (1997) + !< 3: Fu (2007) + !< 4: Kristjansson et al. (2000) + !< 5: Wyser (1998) + !< 6: Sun and Rikus (1999), Sun (2001) + !< 7: effective radius + + ! ##################################################################################### + ! GFDL MP Version 3 parameters + ! ##################################################################################### + logical :: const_vw = .false. !< if .ture., the constants are specified by v * _fac + logical :: do_sedi_uv = .true. !< transport of horizontal momentum in sedimentation + logical :: do_sedi_melt = .true. !< melt cloud ice, snow, and graupel during sedimentation + logical :: liq_ice_combine = .false. !< combine all liquid water, combine all solid water + logical :: snow_grauple_combine = .true. !< combine snow and graupel + logical :: use_rhc_cevap = .false. !< cap of rh for cloud water evaporation + logical :: use_rhc_revap = .false. !< cap of rh for rain evaporation + logical :: do_cld_adj = .false. !< do cloud fraction adjustment + logical :: do_evap_timescale = .true. !< whether to apply a timescale to evaporation + logical :: do_cond_timescale = .false. !< whether to apply a timescale to condensation + logical :: consv_checker = .false. !< turn on energy and water conservation checker + logical :: do_warm_rain_mp = .false. !< do warm rain cloud microphysics only + logical :: do_wbf = .false. !< do Wegener Bergeron Findeisen process + logical :: do_psd_water_fall = .false. !< calculate cloud water terminal velocity based on PSD + logical :: do_psd_ice_fall = .false. !< calculate cloud ice terminal velocity based on PSD + logical :: do_psd_water_num = .false. !< calculate cloud water number concentration based on PSD + logical :: do_psd_ice_num = .false. !< calculate cloud ice number concentration based on PSD + logical :: do_new_acc_water = .false. !< perform the new accretion for cloud water + logical :: do_new_acc_ice = .false. !< perform the new accretion for cloud ice + logical :: cp_heating = .false. !< update temperature based on constant pressure + logical :: delay_cond_evap = .false. !< do condensation evaporation only at the last time step + logical :: do_subgrid_proc = .true. !< do temperature sentive high vertical resolution processes + logical :: fast_fr_mlt = .true. !< do freezing and melting in fast microphysics + logical :: fast_dep_sub = .true. !< do deposition and sublimation in fast microphysics + integer :: ntimes = 1 !< cloud microphysics sub cycles + integer :: nconds = 1 !< condensation sub cycles + integer :: inflag = 1 !< ice nucleation scheme + !< 1: Hong et al. (2004) + !< 2: Meyers et al. (1992) + !< 3: Meyers et al. (1992) + !< 4: Cooper (1986) + !< 5: Fletcher (1962) + integer :: igflag = 3 !< ice generation scheme + !< 1: WSM6 + !< 2: WSM6 with 0 at 0 C + !< 3: WSM6 with 0 at 0 C and fixed value at - 10 C + !< 4: combination of 1 and 3 + integer :: ifflag = 1 !< ice fall scheme + !< 1: Deng and Mace (2008) + !< 2: Heymsfield and Donner (1990) + integer :: rewflag = 1 !< cloud water effective radius scheme + !< 1: Martin et al. (1994) + !< 2: Martin et al. (1994), GFDL revision + !< 3: Kiehl et al. (1994) + !< 4: effective radius + integer :: rerflag = 1 !< rain effective radius scheme + !< 1: effective radius + integer :: resflag = 1 !< snow effective radius scheme + !< 1: effective radius + integer :: regflag = 1 !< graupel effective radius scheme + !< 1: effective radius + integer :: radr_flag = 1 !< radar reflectivity for rain + !< 1: Mark Stoelinga (2005) + !< 2: Smith et al. (1975), Tong and Xue (2005) + !< 3: Marshall-Palmer formula (https://en.wikipedia.org/wiki/DBZ_(meteorology)) + integer :: rads_flag = 1 !< radar reflectivity for snow + !< 1: Mark Stoelinga (2005) + !< 2: Smith et al. (1975), Tong and Xue (2005) + !< 3: Marshall-Palmer formula (https://en.wikipedia.org/wiki/DBZ_(meteorology)) + integer :: radg_flag = 1 !< radar reflectivity for graupel + !< 1: Mark Stoelinga (2005) + !< 2: Smith et al. (1975), Tong and Xue (2005) + !< 3: Marshall-Palmer formula (https://en.wikipedia.org/wiki/DBZ_(meteorology)) + integer :: sedflag = 1 !< sedimentation scheme + !< 1: implicit scheme + !< 2: explicit scheme + !< 3: lagrangian scheme + !< 4: combined implicit and lagrangian scheme + integer :: vdiffflag = 1 !< wind difference scheme in accretion + !< 1: Wisner et al. (1972) + !< 2: Mizuno (1990) + !< 3: Murakami (1990) + real(kind_phys) :: c_psacw = 1.0 !< cloud water to snow accretion efficiency + real(kind_phys) :: c_pracw = 0.8 !< cloud water to rain accretion efficiency + real(kind_phys) :: c_praci = 1.0 !< cloud ice to rain accretion efficiency + real(kind_phys) :: c_pgacw = 1.0 !< cloud water to graupel accretion efficiency + real(kind_phys) :: c_pgaci = 0.05 !< cloud ice to graupel accretion efficiency (was 0.1 in ZETAC) + real(kind_phys) :: c_pracs = 1.0 !< snow to rain accretion efficiency + real(kind_phys) :: c_psacr = 1.0 !< rain to snow accretion efficiency + real(kind_phys) :: c_pgacr = 1.0 !< rain to graupel accretion efficiency + real(kind_phys) :: alinw = 3.e7 !< "a" in Lin et al. (1983) for cloud water (Ikawa and Saito 1990) + real(kind_phys) :: alini = 7.e2 !< "a" in Lin et al. (1983) for cloud ice (Ikawa and Saita 1990) + real(kind_phys) :: alinr = 842.0 !< "a" in Lin et al. (1983) for rain (Liu and Orville 1969) + real(kind_phys) :: alins = 4.8 !< "a" in Lin et al. (1983) for snow (straka 2009) + real(kind_phys) :: aling = 1.0 !< "a" in Lin et al. (1983), similar to a, but for graupel (Pruppacher and Klett 2010) + real(kind_phys) :: alinh = 1.0 !< "a" in Lin et al. (1983), similar to a, but for hail (Pruppacher and Klett 2010) + real(kind_phys) :: blinw = 2.0 !< "b" in Lin et al. (1983) for cloud water (Ikawa and Saito 1990) + real(kind_phys) :: blini = 1.0 !< "b" in Lin et al. (1983) for cloud ice (Ikawa and Saita 1990) + real(kind_phys) :: blinr = 0.8 !< "b" in Lin et al. (1983) for rain (Liu and Orville 1969) + real(kind_phys) :: blins = 0.25 !< "b" in Lin et al. (1983) for snow (straka 2009) + real(kind_phys) :: bling = 0.5 !< "b" in Lin et al. (1983), similar to b, but for graupel (Pruppacher and Klett 2010) + real(kind_phys) :: blinh = 0.5 !< "b" in Lin et al. (1983), similar to b, but for hail (Pruppacher and Klett 2010) + real(kind_phys) :: vw_fac = 1.0 !< + real(kind_phys) :: vw_max = 0.01 !< maximum fall speed for cloud water (m/s) + real(kind_phys) :: tice_mlt = 273.16 !< can set ice melting temperature to 268 based on observation (Kay et al. 2016) (K) + real(kind_phys) :: tau_gmlt = 600.0 !< graupel melting time scale (s) + real(kind_phys) :: tau_wbf = 300.0 !< graupel melting time scale (s) + real(kind_phys) :: tau_revp = 0.0 !< rain evaporation time scale (s) + real(kind_phys) :: is_fac = 0.2 !< cloud ice sublimation temperature factor + real(kind_phys) :: ss_fac = 0.2 !< snow sublimation temperature factor + real(kind_phys) :: gs_fac = 0.2 !< graupel sublimation temperature factor + real(kind_phys) :: rh_fac_evap = 10.0 !< cloud water evaporation relative humidity factor + real(kind_phys) :: rh_fac_cond = 10.0 !< cloud water condensation relative humidity factor + real(kind_phys) :: sed_fac = 1.0 !< coefficient for sedimentation fall, scale from 1.0 (implicit) to 0.0 (lagrangian) + real(kind_phys) :: xr_a = 0.25 !< p value in Xu and Randall (1996) + real(kind_phys) :: xr_b = 100.0 !< alpha_0 value in Xu and Randall (1996) + real(kind_phys) :: xr_c = 0.49 !< gamma value in Xu and Randall (1996) + real(kind_phys) :: te_err = 1.e-5 !< 64bit: 1.e-14, 32bit: 1.e-7; turn off to save computer time + real(kind_phys) :: tw_err = 1.e-8 !< 64bit: 1.e-14, 32bit: 1.e-7; turn off to save computer time + real(kind_phys) :: rh_thres = 0.75 !< minimum relative humidity for cloud fraction + real(kind_phys) :: rhc_cevap = 0.85 !< maximum relative humidity for cloud water evaporation + real(kind_phys) :: rhc_revap = 0.85 !< maximum relative humidity for rain evaporation + real(kind_phys) :: f_dq_p = 1.0 !< cloud fraction adjustment for supersaturation + real(kind_phys) :: f_dq_m = 1.0 !< cloud fraction adjustment for undersaturation + real(kind_phys) :: fi2s_fac = 1.0 !< maximum sink of cloud ice to form snow: 0-1 + real(kind_phys) :: fi2g_fac = 1.0 !< maximum sink of cloud ice to form graupel: 0-1 + real(kind_phys) :: fs2g_fac = 1.0 !< maximum sink of snow to form graupel: 0-1 + real(kind_phys) :: n0w_sig = 1.1 !< intercept parameter (significand) of cloud water (Lin et al. 1983) (1/m^4) (Martin et al. 1994) + real(kind_phys) :: n0i_sig = 1.3 !< intercept parameter (significand) of cloud ice (Lin et al. 1983) (1/m^4) (McFarquhar et al. 2015) + real(kind_phys) :: n0r_sig = 8.0 !< intercept parameter (significand) of rain (Lin et al. 1983) (1/m^4) (Marshall and Palmer 1948) + real(kind_phys) :: n0s_sig = 3.0 !< intercept parameter (significand) of snow (Lin et al. 1983) (1/m^4) (Gunn and Marshall 1958) + real(kind_phys) :: n0g_sig = 4.0 !< intercept parameter (significand) of graupel (Rutledge and Hobbs 1984) (1/m^4) (Houze et al. 1979) + real(kind_phys) :: n0h_sig = 4.0 !< intercept parameter (significand) of hail (Lin et al. 1983) (1/m^4) (Federer and Waldvogel 1975) + real(kind_phys) :: n0w_exp = 41 !< intercept parameter (exponent) of cloud water (Lin et al. 1983) (1/m^4) (Martin et al. 1994) + real(kind_phys) :: n0i_exp = 18 !< intercept parameter (exponent) of cloud ice (Lin et al. 1983) (1/m^4) (McFarquhar et al. 2015) + real(kind_phys) :: n0r_exp = 6 !< intercept parameter (exponent) of rain (Lin et al. 1983) (1/m^4) (Marshall and Palmer 1948) + real(kind_phys) :: n0s_exp = 6 !< intercept parameter (exponent) of snow (Lin et al. 1983) (1/m^4) (Gunn and Marshall 1958) + real(kind_phys) :: n0g_exp = 6 !< intercept parameter (exponent) of graupel (Rutledge and Hobbs 1984) (1/m^4) (Houze et al. 1979) + real(kind_phys) :: n0h_exp = 4 !< intercept parameter (exponent) of hail (Lin et al. 1983) (1/m^4) (Federer and Waldvogel 1975) + real(kind_phys) :: muw = 6.0 !< shape parameter of cloud water in Gamma distribution (Martin et al. 1994) + real(kind_phys) :: mui = 3.35 !< shape parameter of cloud ice in Gamma distribution (McFarquhar et al. 2015) + real(kind_phys) :: mur = 1.0 !< shape parameter of rain in Gamma distribution (Marshall and Palmer 1948) + real(kind_phys) :: mus = 1.0 !< shape parameter of snow in Gamma distribution (Gunn and Marshall 1958) + real(kind_phys) :: mug = 1.0 !< shape parameter of graupel in Gamma distribution (Houze et al. 1979) + real(kind_phys) :: muh = 1.0 !< shape parameter of hail in Gamma distribution (Federer and Waldvogel 1975) + real(kind_phys) :: beta = 1.22 !< defined in Heymsfield and Mcfarquhar (1996) + real(kind_phys) :: rewfac = 1.0 !< this is a tuning parameter to compromise the inconsistency between + !< GFDL MP's PSD and cloud water radiative property's PSD assumption. + !< after the cloud water radiative property's PSD is rebuilt, + !< this parameter should be 1.0. + real(kind_phys) :: reifac = 1.0 !< this is a tuning parameter to compromise the inconsistency between + !< GFDL MP's PSD and cloud ice radiative property's PSD assumption. + !< after the cloud ice radiative property's PSD is rebuilt, + !< this parameter should be 1.0. + + ! ####################################################################################### + ! NAMELISTS + ! ####################################################################################### + + ! V1 namelist + namelist / gfdl_cloud_microphysics_nml / & + mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, vi_fac, & + vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, vs_max, vg_max, & + vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, qi0_crt, qr0_crt, fast_sat_adj, & + rh_inc, rh_ins, rh_inr, const_vi, const_vs, const_vg, const_vr, use_ccn, rthresh, & + ccn_l, ccn_o, qc_crt, tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, & + tau_l2v, tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, z_slope_liq, & + z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, rad_snow, rad_graupel, rad_rain, & + cld_min, use_ppm, mono_prof, do_sedi_heat, sedi_transport, do_sedi_w, de_ice, & + icloud_f, irain_f, mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, & + rermax, resmin, resmax, regmin, regmax, tintqs, do_hail + + ! V3 Namelist + namelist / gfdl_cloud_microphysics_v3_nml / & + t_min, t_sub, tau_r2g, tau_smlt, tau_gmlt, dw_land, dw_ocean, vw_fac, vi_fac, & + vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vw_max, vi_max, vs_max, & + vg_max, vr_max, qs_mlt, qs0_crt, ql0_max, qi0_max, qi0_crt, ifflag, rh_inc, rh_ins,& + rh_inr, const_vw, const_vi, const_vs, const_vg, const_vr, rthresh, ccn_l, ccn_o, & + igflag, c_paut, tau_imlt, tau_v2l, tau_l2v, tau_i2s, tau_l2r, qi_lim, ql_gen, & + do_hail, inflag, c_psacw, c_psaci, c_pracs, c_psacr, c_pgacr, c_pgacs, c_pgacw, & + c_pgaci, z_slope_liq, z_slope_ice, prog_ccn, c_pracw, c_praci, rad_snow, & + rad_graupel, rad_rain, cld_min, sedflag, sed_fac, do_sedi_uv, do_sedi_w, & + do_sedi_heat, icloud_f, irain_f, xr_a, xr_b, xr_c, ntimes, tau_revp, tice_mlt, & + do_cond_timescale, mp_time, consv_checker, te_err, tw_err, use_rhc_cevap, & + use_rhc_revap, tau_wbf, do_warm_rain_mp, rh_thres, f_dq_p, f_dq_m, do_cld_adj, & + rhc_cevap, rhc_revap, beta, liq_ice_combine, rewflag, reiflag, rerflag, resflag, & + regflag, rewmin, rewmax, reimin, reimax, rermin, rermax, resmin, resmax, regmin, & + regmax, fs2g_fac, fi2s_fac, fi2g_fac, do_sedi_melt, radr_flag, rads_flag, & + radg_flag, do_wbf, do_psd_water_fall, do_psd_ice_fall, n0w_sig, n0i_sig, n0r_sig, & + n0s_sig, n0g_sig, n0h_sig, n0w_exp, n0i_exp, n0r_exp, n0s_exp, n0g_exp, n0h_exp, & + muw, mui, mur, mus, mug, muh, alinw, alini, alinr, alins, aling, alinh, blinw, & + blini, blinr, blins, bling, blinh, do_new_acc_water, do_new_acc_ice, is_fac, & + ss_fac, gs_fac, rh_fac_evap, rh_fac_cond, snow_grauple_combine, do_psd_water_num, & + do_psd_ice_num, vdiffflag, rewfac, reifac, cp_heating, nconds, do_evap_timescale, & + delay_cond_evap, do_subgrid_proc, fast_fr_mlt, fast_dep_sub + ! + public & + tau_g2r, tau_g2v, tau_v2g, qc_crt, qr0_crt, c_piacr, c_cracw, alin, clin, & + fast_sat_adj, use_ccn, use_ppm, mono_prof, mp_print, de_ice, sedi_transport, & + t_min, t_sub, tau_r2g, tau_smlt, tau_gmlt, dw_land, dw_ocean, vw_fac, vi_fac, & + vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vw_max, vi_max, vs_max, & + vg_max, vr_max, qs_mlt, qs0_crt, ql0_max, qi0_max, qi0_crt, ifflag, rh_inc, rh_ins,& + rh_inr, const_vw, const_vi, const_vs, const_vg, const_vr, rthresh, ccn_l, ccn_o, & + igflag, c_paut, tau_imlt, tau_v2l, tau_l2v, tau_i2s, tau_l2r, qi_lim, ql_gen, & + do_hail, inflag, c_psacw, c_psaci, c_pracs, c_psacr, c_pgacr, c_pgacs, c_pgacw, & + c_pgaci, z_slope_liq, z_slope_ice, prog_ccn, c_pracw, c_praci, rad_snow, & + rad_graupel, rad_rain, cld_min, sedflag, sed_fac, do_sedi_uv, do_sedi_w, & + do_sedi_heat, icloud_f, irain_f, xr_a, xr_b, xr_c, ntimes, tau_revp, tice_mlt, & + do_cond_timescale, mp_time, consv_checker, te_err, tw_err, use_rhc_cevap, & + use_rhc_revap, tau_wbf, do_warm_rain_mp, rh_thres, f_dq_p, f_dq_m, do_cld_adj, & + rhc_cevap, rhc_revap, beta, liq_ice_combine, rewflag, reiflag, rerflag, resflag, & + regflag, rewmin, rewmax, reimin, reimax, rermin, rermax, resmin, resmax, regmin, & + regmax, fs2g_fac, fi2s_fac, fi2g_fac, do_sedi_melt, radr_flag, rads_flag, & + radg_flag, do_wbf, do_psd_water_fall, do_psd_ice_fall, n0w_sig, n0i_sig, n0r_sig, & + n0s_sig, n0g_sig, n0h_sig, n0w_exp, n0i_exp, n0r_exp, n0s_exp, n0g_exp, n0h_exp, & + muw, mui, mur, mus, mug, muh, alinw, alini, alinr, alins, aling, alinh, blinw, & + blini, blinr, blins, bling, blinh, do_new_acc_water, do_new_acc_ice, is_fac, & + ss_fac, gs_fac, rh_fac_evap, rh_fac_cond, snow_grauple_combine, do_psd_water_num, & + do_psd_ice_num, vdiffflag, rewfac, reifac, cp_heating, nconds, do_evap_timescale, & + delay_cond_evap, do_subgrid_proc, fast_fr_mlt, fast_dep_sub, qi_gen, sat_adj0, & + tice, tintqs +contains + + ! ####################################################################################### + ! Procedure to read GFDLMP namelists + ! ####################################################################################### + subroutine read_gfdlmp_nml(errmsg, errflg, unit, input_nml_file, fn_nml, version, iostat) + + character(len = *), intent(in ), optional :: input_nml_file(:) + character(len = *), intent(in ), optional :: fn_nml + integer, intent(in ), optional :: unit + integer, intent(in ), optional :: version + integer, intent(out), optional :: iostat + character(len=*), intent(out), optional :: errmsg + integer, intent(out), optional :: errflg + logical :: exists + ! Make sure that all inputs to read appropriate NML are provided, if not use default + ! parameters + if (present(unit) .and. present(iostat) .and. & + present(input_nml_file) .and. present(fn_nml) .and. & + present(version) .and. present(errflg) .and. & + present(errmsg)) then + + if ((version .ne. 1) .and. (version .ne. 3)) then + write (6, *) 'gfdl - mp :: invalid scheme version number' + errflg = 1 + errmsg = 'ERROR(module_gfdlmp_param): invalid scheme version number' + return + endif + +#ifdef INTERNAL_FILE_NML + if (version==1) read (input_nml_file, nml = gfdl_cloud_microphysics_nml) + if (version==3) read (input_nml_file, nml = gfdl_cloud_microphysics_v3_nml) +#else + inquire (file = trim (fn_nml), exist = exists) + if (.not. exists) then + write (6, *) 'gfdl - mp :: namelist file: ', trim (fn_nml), ' does not exist' + errflg = 1 + errmsg = 'ERROR(module_gfdlmp_param): namelist file '//trim (fn_nml)//' does not exist' + return + else + open (unit = unit, file = fn_nml, action = 'read' , status = 'old', iostat = iostat) + endif + rewind (unit) + if (version==1) read (unit, nml = gfdl_cloud_microphysics_nml) + if (version==3) read (unit, nml = gfdl_cloud_microphysics_v3_nml) + close (unit) +#endif + endif + end subroutine read_gfdlmp_nml + ! +end module module_gfdlmp_param diff --git a/physics/MP/GFDL/gfdl_cloud_microphys.F90 b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.F90 similarity index 97% rename from physics/MP/GFDL/gfdl_cloud_microphys.F90 rename to physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.F90 index 0fd84c7ea..6314b3577 100644 --- a/physics/MP/GFDL/gfdl_cloud_microphys.F90 +++ b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.F90 @@ -1,6 +1,9 @@ !> \file gfdl_cloud_microphys.F90 !! This file contains the CCPP entry point for the column GFDL cloud microphysics ( Chen and Lin (2013) !! \cite chen_and_lin_2013 ). + +!> This module contains the CCPP entry point for the column GFDL cloud microphysics ( Chen and Lin (2013) +!! \cite chen_and_lin_2013 ). module gfdl_cloud_microphys use gfdl_cloud_microphys_mod, only: gfdl_cloud_microphys_mod_init, & @@ -157,10 +160,10 @@ subroutine gfdl_cloud_microphys_run( logical, intent (in) :: lradar real(kind=kind_phys), intent(inout), dimension(:,:) :: refl_10cm logical, intent (in) :: reset, effr_in - real(kind=kind_phys), intent(inout), dimension(:,:) :: rew, rei, rer, res, reg + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: rew, rei, rer, res, reg logical, intent (in) :: cplchm ! ice and liquid water 3d precipitation fluxes - only allocated if cplchm is .true. - real(kind=kind_phys), intent(inout), dimension(:,:) :: pfi_lsan, pfl_lsan + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfi_lsan, pfl_lsan character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/MP/GFDL/gfdl_cloud_microphys.meta b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.meta similarity index 97% rename from physics/MP/GFDL/gfdl_cloud_microphys.meta rename to physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.meta index 719a340e5..2b7db1961 100644 --- a/physics/MP/GFDL/gfdl_cloud_microphys.meta +++ b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys.meta @@ -1,9 +1,10 @@ [ccpp-table-properties] name = gfdl_cloud_microphys type = scheme - dependencies = ../../hooks/machine.F - dependencies = ../module_mp_radar.F90 - dependencies = module_gfdl_cloud_microphys.F90 + dependencies = ../../../hooks/machine.F + dependencies = ../../module_mp_radar.F90 + dependencies = gfdl_cloud_microphys_mod.F90 + dependencies = ../module_gfdlmp_param.F90 ######################################################################## [ccpp-arg-table] @@ -410,6 +411,7 @@ type = real kind = kind_phys intent = inout + optional = True [rei] standard_name = effective_radius_of_stratiform_cloud_ice_particle long_name = eff. radius of cloud ice water particle in micrometer @@ -418,6 +420,7 @@ type = real kind = kind_phys intent = inout + optional = True [rer] standard_name = effective_radius_of_stratiform_cloud_rain_particle long_name = effective radius of cloud rain particle in micrometers @@ -426,6 +429,7 @@ type = real kind = kind_phys intent = inout + optional = True [res] standard_name = effective_radius_of_stratiform_cloud_snow_particle long_name = effective radius of cloud snow particle in micrometers @@ -434,6 +438,7 @@ type = real kind = kind_phys intent = inout + optional = True [reg] standard_name = effective_radius_of_stratiform_cloud_graupel_particle long_name = eff. radius of cloud graupel particle in micrometer @@ -442,6 +447,7 @@ type = real kind = kind_phys intent = inout + optional = True [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) @@ -457,6 +463,7 @@ type = real kind = kind_phys intent = inout + optional = True [pfl_lsan] standard_name = liquid_flux_due_to_large_scale_precipitation long_name = instantaneous 3D flux of liquid water from nonconvective precipitation @@ -465,6 +472,7 @@ type = real kind = kind_phys intent = inout + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys_mod.F90 similarity index 93% rename from physics/MP/GFDL/module_gfdl_cloud_microphys.F90 rename to physics/MP/GFDL/v1_2019/gfdl_cloud_microphys_mod.F90 index 5cab1abbc..c29a116fb 100644 --- a/physics/MP/GFDL/module_gfdl_cloud_microphys.F90 +++ b/physics/MP/GFDL/v1_2019/gfdl_cloud_microphys_mod.F90 @@ -27,7 +27,8 @@ ! ======================================================================= !>\defgroup mod_gfdl_cloud_mp GFDL Cloud MP modules !!\ingroup gfdlmp -!! This module contains the column GFDL Cloud microphysics scheme. + +!> This module contains the column GFDL Cloud microphysics scheme. module gfdl_cloud_microphys_mod ! use mpp_mod, only: stdlog, mpp_pe, mpp_root_pe, mpp_clock_id, & @@ -39,7 +40,22 @@ module gfdl_cloud_microphys_mod ! use fms_mod, only: write_version_number, open_namelist_file, & ! check_nml_error, file_exist, close_file + ! ----------------------------------------------------------------------- use module_mp_radar + use module_gfdlmp_param, only: read_gfdlmp_nml, mp_time, t_min, t_sub, & + tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, vi_fac, vr_fac, & + vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, vs_max, & + vg_max, vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, & + qi0_crt, qr0_crt, fast_sat_adj, rh_inc, rh_ins, rh_inr, const_vi, & + const_vs, const_vg, const_vr, use_ccn, rthresh, ccn_l, ccn_o, & + qc_crt, tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, & + tau_l2v, tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, & + c_pgacs, z_slope_liq, z_slope_ice, prog_ccn, c_cracw, alin, clin, & + tice, rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, & + mono_prof, do_sedi_heat, sedi_transport, do_sedi_w, de_ice, & + icloud_f, irain_f, mp_print, reiflag, rewmin, rewmax, reimin, & + reimax, rermin, rermax, resmin, resmax, regmin, regmax, tintqs, & + do_hail implicit none @@ -56,7 +72,7 @@ module gfdl_cloud_microphys_mod logical :: module_is_initialized = .false. logical :: qsmith_tables_initialized = .false. - character (len = 17) :: mod_name = 'gfdl_cloud_microphys' + character (len = 20) :: mod_name = 'gfdl_cloud_microphys' real, parameter :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 real, parameter :: rhos = 0.1e3, rhog = 0.4e3 @@ -145,21 +161,7 @@ module gfdl_cloud_microphys_mod real :: lv00 !< the same as lv0, except that cp_vap can be cp_vap or cv_vap ! cloud microphysics switchers - - integer :: icloud_f = 0 !< cloud scheme - integer :: irain_f = 0 !< cloud water to rain auto conversion scheme - - logical :: de_ice = .false. !< to prevent excessive build - up of cloud ice from external sources - logical :: sedi_transport = .true. !< transport of momentum in sedimentation - logical :: do_sedi_w = .false. !< transport of vertical motion in sedimentation - logical :: do_sedi_heat = .true. !< transport of heat in sedimentation - logical :: prog_ccn = .false. !< do prognostic ccn (yi ming's method) - logical :: do_qa = .true. !< do inline cloud fraction - logical :: rad_snow = .true. !< consider snow in cloud fraciton calculation - logical :: rad_graupel = .true. !< consider graupel in cloud fraction calculation - logical :: rad_rain = .true. !< consider rain in cloud fraction calculation - logical :: fix_negative = .false. !< fix negative water species - logical :: do_setup = .true. !< setup constants and parameters + logical :: do_setup = .true. !< setup constants and parameters logical :: p_nonhydro = .false. !< perform hydrosatic adjustment on air density real, allocatable :: table (:), table2 (:), table3 (:), tablew (:) @@ -182,171 +184,9 @@ module gfdl_cloud_microphys_mod ! qs0_crt = 0.6e-3 ! c_psaci = 0.1 ! c_pgacs = 0.1 - - ! ----------------------------------------------------------------------- - ! namelist parameters - ! ----------------------------------------------------------------------- - - real :: cld_min = 0.05 !< minimum cloud fraction - real :: tice = 273.16 !< set tice = 165. to trun off ice - phase phys (kessler emulator) - - real :: t_min = 178. !< min temp to freeze - dry all water vapor - real :: t_sub = 184. !< min temp for sublimation of cloud ice - real :: mp_time = 150. !< maximum micro - physics time step (sec) - - ! relative humidity increment - - real :: rh_inc = 0.25 !< rh increment for complete evaporation of cloud water and cloud ice - real :: rh_inr = 0.25 !< rh increment for minimum evaporation of rain - real :: rh_ins = 0.25 !< rh increment for sublimation of snow - - ! conversion time scale - - real :: tau_r2g = 900. !< rain freezing during fast_sat - real :: tau_smlt = 900. !< snow melting - real :: tau_g2r = 600. !< graupel melting to rain - real :: tau_imlt = 600. !< cloud ice melting - real :: tau_i2s = 1000. !< cloud ice to snow auto-conversion - real :: tau_l2r = 900. !< cloud water to rain auto-conversion - real :: tau_v2l = 150. !< water vapor to cloud water (condensation) - real :: tau_l2v = 300. !< cloud water to water vapor (evaporation) - real :: tau_g2v = 900. !< graupel sublimation - real :: tau_v2g = 21600. !< graupel deposition -- make it a slow process - - ! horizontal subgrid variability - - real :: dw_land = 0.20 !< base value for subgrid deviation / variability over land - real :: dw_ocean = 0.10 !< base value for ocean - - ! prescribed ccn - - real :: ccn_o = 90. !< ccn over ocean (cm^ - 3) - real :: ccn_l = 270. !< ccn over land (cm^ - 3) - - real :: rthresh = 10.0e-6 !< critical cloud drop radius (micro m) - - ! ----------------------------------------------------------------------- - ! wrf / wsm6 scheme: qi_gen = 4.92e-11 * (1.e3 * exp (0.1 * tmp)) ** 1.33 - ! optimized: qi_gen = 4.92e-11 * exp (1.33 * log (1.e3 * exp (0.1 * tmp))) - ! qi_gen ~ 4.808e-7 at 0 c; 1.818e-6 at - 10 c, 9.82679e-5 at - 40c - ! the following value is constructed such that qc_crt = 0 at zero c and @ - 10c matches - ! wrf / wsm6 ice initiation scheme; qi_crt = qi_gen * min (qi_lim, 0.1 * tmp) / den - ! ----------------------------------------------------------------------- - - real :: sat_adj0 = 0.90 !< adjustment factor (0: no, 1: full) during fast_sat_adj - - real :: qc_crt = 5.0e-8 !< mini condensate mixing ratio to allow partial cloudiness - - real :: qi_lim = 1. !< cloud ice limiter to prevent large ice build up - - real :: ql_mlt = 2.0e-3 !< max value of cloud water allowed from melted cloud ice - real :: qs_mlt = 1.0e-6 !< max cloud water due to snow melt - - real :: ql_gen = 1.0e-3 !< max cloud water generation during remapping step if fast_sat_adj = .t. - real :: qi_gen = 1.82e-6 !< max cloud ice generation during remapping step - - ! cloud condensate upper bounds: "safety valves" for ql & qi - - real :: ql0_max = 2.0e-3 !< max cloud water value (auto converted to rain) - real :: qi0_max = 1.0e-4 !< max cloud ice value (by other sources) - - real :: qi0_crt = 1.0e-4 !< cloud ice to snow autoconversion threshold (was 1.e-4); - !! qi0_crt is highly dependent on horizontal resolution - real :: qr0_crt = 1.0e-4 !< rain to snow or graupel/hail threshold - ! lfo used * mixing ratio * = 1.e-4 (hail in lfo) - real :: qs0_crt = 1.0e-3 !< snow to graupel density threshold (0.6e-3 in purdue lin scheme) - - real :: c_paut = 0.55 !< autoconversion cloud water to rain (use 0.5 to reduce autoconversion) - real :: c_psaci = 0.02 !< accretion: cloud ice to snow (was 0.1 in zetac) - real :: c_piacr = 5.0 !< accretion: rain to ice: - real :: c_cracw = 0.9 !< rain accretion efficiency - real :: c_pgacs = 2.0e-3 !< snow to graupel "accretion" eff. (was 0.1 in zetac) - - ! decreasing clin to reduce csacw (so as to reduce cloud water --- > snow) - - real :: alin = 842.0 !< "a" in lin1983 - real :: clin = 4.8 !< "c" in lin 1983, 4.8 -- > 6. (to ehance ql -- > qs) - - ! fall velocity tuning constants: - - logical :: const_vi = .false. !< if .t. the constants are specified by v * _fac - logical :: const_vs = .false. !< if .t. the constants are specified by v * _fac - logical :: const_vg = .false. !< if .t. the constants are specified by v * _fac - logical :: const_vr = .false. !< if .t. the constants are specified by v * _fac - - ! good values: - - real :: vi_fac = 1. !< if const_vi: 1 / 3 - real :: vs_fac = 1. !< if const_vs: 1. - real :: vg_fac = 1. !< if const_vg: 2. - real :: vr_fac = 1. !< if const_vr: 4. - - ! upper bounds of fall speed (with variable speed option) - - real :: vi_max = 0.5 !< max fall speed for ice - real :: vs_max = 5.0 !< max fall speed for snow - real :: vg_max = 8.0 !< max fall speed for graupel - real :: vr_max = 12. !< max fall speed for rain - - ! cloud microphysics switchers - - logical :: fast_sat_adj = .false. !< has fast saturation adjustments - logical :: z_slope_liq = .true. !< use linear mono slope for autocconversions - logical :: z_slope_ice = .false. !< use linear mono slope for autocconversions - logical :: use_ccn = .false. !< must be true when prog_ccn is false - logical :: use_ppm = .false. !< use ppm fall scheme - logical :: mono_prof = .true. !< perform terminal fall with mono ppm scheme - logical :: mp_print = .false. !< cloud microphysics debugging printout - logical :: do_hail = .false. !< use hail parameters instead of graupel - - ! real :: global_area = - 1. - + real :: log_10, tice0, t_wfr - integer :: reiflag = 1 - ! 1: Heymsfield and Mcfarquhar, 1996 - ! 2: Wyser, 1998 - - logical :: tintqs = .false. !< use temperature in the saturation mixing in PDF - - real :: rewmin = 5.0, rewmax = 10.0 - real :: reimin = 10.0, reimax = 150.0 - real :: rermin = 10.0, rermax = 10000.0 - real :: resmin = 150.0, resmax = 10000.0 - real :: regmin = 300.0, regmax = 10000.0 - - ! ----------------------------------------------------------------------- - ! namelist - ! ----------------------------------------------------------------------- - - namelist / gfdl_cloud_microphysics_nml / & - mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, & - vi_fac, vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, & - vs_max, vg_max, vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, & - qi0_crt, qr0_crt, fast_sat_adj, rh_inc, rh_ins, rh_inr, const_vi, & - const_vs, const_vg, const_vr, use_ccn, rthresh, ccn_l, ccn_o, qc_crt, & - tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, tau_l2v, & - tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, & - z_slope_liq, z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, & - rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, mono_prof, & - do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, & - mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, rermax, & - resmin, resmax, regmin, regmax, tintqs, do_hail - - public & - mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, & - vi_fac, vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vi_max, & - vs_max, vg_max, vr_max, qs_mlt, qs0_crt, qi_gen, ql0_max, qi0_max, & - qi0_crt, qr0_crt, fast_sat_adj, rh_inc, rh_ins, rh_inr, const_vi, & - const_vs, const_vg, const_vr, use_ccn, rthresh, ccn_l, ccn_o, qc_crt, & - tau_g2v, tau_v2g, sat_adj0, c_piacr, tau_imlt, tau_v2l, tau_l2v, & - tau_i2s, tau_l2r, qi_lim, ql_gen, c_paut, c_psaci, c_pgacs, & - z_slope_liq, z_slope_ice, prog_ccn, c_cracw, alin, clin, tice, & - rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, mono_prof, & - do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, & - mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, rermax, & - resmin, resmax, regmin, regmax, tintqs, do_hail - contains ! ----------------------------------------------------------------------- @@ -3595,30 +3435,21 @@ subroutine gfdl_cloud_microphys_mod_init (me, master, nlunit, input_nml_file, lo errflg = 0 errmsg = '' -#ifdef INTERNAL_FILE_NML - read (input_nml_file, nml = gfdl_cloud_microphysics_nml) -#else - inquire (file = trim (fn_nml), exist = exists) - if (.not. exists) then - write (6, *) 'gfdl - mp :: namelist file: ', trim (fn_nml), ' does not exist' - errflg = 1 - errmsg = 'ERROR(gfdl_cloud_microphys_mod_init): namelist file '//trim (fn_nml)//' does not exist' - return - else - open (unit = nlunit, file = fn_nml, action = 'read' , status = 'old', iostat = ios) - endif - rewind (nlunit) - read (nlunit, nml = gfdl_cloud_microphysics_nml) - close (nlunit) -#endif + ! ----------------------------------------------------------------------- + ! Read namelist + ! ----------------------------------------------------------------------- + call read_gfdlmp_nml(errmsg = errmsg, errflg = errflg, unit = nlunit, & + input_nml_file = input_nml_file, fn_nml = fn_nml, version=1, & + iostat = ios) + if(errflg/=0) return ! write version number and namelist to log file if (me == master) then write (logunit, *) " ================================================================== " - write (logunit, *) "gfdl_cloud_microphys_mod" - write (logunit, nml = gfdl_cloud_microphysics_nml) + write (logunit, *) "gfdl_cloud_microphysics_nml" endif + ! if (do_setup) then call setup_con call setupm diff --git a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.F90 b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.F90 new file mode 100644 index 000000000..eae68d4f3 --- /dev/null +++ b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.F90 @@ -0,0 +1,362 @@ +!> \file gfdl_cloud_microphys_v3.F90 +!! This file contains the CCPP entry point for the column GFDL cloud microphysics version 3 ( Chen and Lin (2013) +!! \cite chen_and_lin_2013 ). +module gfdl_cloud_microphys_v3 + + use gfdl_cloud_microphys_v3_mod, only: gfdl_cloud_microphys_v3_mod_init, & + gfdl_cloud_microphys_v3_mod_driver, & + gfdl_cloud_microphys_v3_mod_end, & + rad_ref, cld_eff_rad + + implicit none + + private + + public gfdl_cloud_microphys_v3_run, gfdl_cloud_microphys_v3_init, gfdl_cloud_microphys_v3_finalize + + logical :: is_initialized = .false. + +contains + +! ----------------------------------------------------------------------- +! CCPP entry points for gfdl cloud microphysics +! ----------------------------------------------------------------------- + +!>\brief The subroutine initializes the GFDL +!! cloud microphysics. +!! +!> \section arg_table_gfdl_cloud_microphys_v3_init Argument Table +!! \htmlinclude gfdl_cloud_microphys_v3_init.html +!! + + subroutine gfdl_cloud_microphys_v3_init (me, master, nlunit, input_nml_file, logunit, & + fn_nml, imp_physics, imp_physics_gfdl, do_shoc, & + hydrostatic, errmsg, errflg) + + implicit none + + integer, intent (in) :: me + integer, intent (in) :: master + integer, intent (in) :: nlunit + integer, intent (in) :: logunit + character(len=*), intent (in) :: fn_nml + character(len=*), intent (in) :: input_nml_file(:) + integer, intent( in) :: imp_physics + integer, intent( in) :: imp_physics_gfdl + logical, intent( in) :: do_shoc + logical, intent( in) :: hydrostatic + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + if (imp_physics/=imp_physics_gfdl) then + write(errmsg,'(*(a))') 'Namelist option for microphysics does not match choice in suite definition file' + errflg = 1 + return + end if + + if (do_shoc) then + write(errmsg,'(*(a))') 'SHOC is not currently compatible with GFDL MP v3' + errflg = 1 + return + endif + + call gfdl_cloud_microphys_v3_mod_init(me, master, nlunit, input_nml_file, logunit, fn_nml, hydrostatic, errmsg, errflg) + + is_initialized = .true. + + end subroutine gfdl_cloud_microphys_v3_init + + +! ======================================================================= +!>\brief The subroutine 'gfdl_cloud_microphys_v3_finalize' terminates the GFDL +!! cloud microphysics. +!! +!! \section arg_table_gfdl_cloud_microphys_v3_finalize Argument Table +!! \htmlinclude gfdl_cloud_microphys_v3_finalize.html +!! + subroutine gfdl_cloud_microphys_v3_finalize(errmsg, errflg) + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.is_initialized) return + + call gfdl_cloud_microphys_v3_mod_end() + + is_initialized = .false. + + end subroutine gfdl_cloud_microphys_v3_finalize + +!>\defgroup gfdlmp GFDL Cloud Microphysics Module +!! This is cloud microphysics package for GFDL global cloud resolving model. +!! The algorithms are originally derived from Lin et al. (1983) \cite lin_et_al_1983. +!! Most of the key elements have been simplified/improved. This code at this stage +!! bears little to no similarity to the original Lin MP. +!! Therefore, it is best to be called GFDL microphysics (GFDL MP) . +!! +!>\brief The module contains the GFDL cloud +!! microphysics (Chen and Lin (2013) \cite chen_and_lin_2013 ). +!> The module is paired with \ref fast_sat_adj, which performs the "fast" +!! processes. +!! +!>\brief The subroutine executes the full GFDL cloud microphysics. +!! \section arg_table_gfdl_cloud_microphys_v3_run Argument Table +!! \htmlinclude gfdl_cloud_microphys_v3_run.html +!! + subroutine gfdl_cloud_microphys_v3_run(fast_mp_consv, & + levs, im, rainmin, con_g, con_fvirt, con_rd, con_eps, garea, slmsk, snowd, & + gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, gq0_ntsw, gq0_ntgl, gq0_ntclamt, aerfld, & + gt0, gu0, gv0, vvl, prsl, phii, del, & + rain0, ice0, snow0, graupel0, prcp0, sr, oro, & + dtp, hydrostatic, lradar, refl_10cm, & + reset, effr_in, rew, rei, rer, res, reg, & + cplchm, pfi_lsan, pfl_lsan, con_one, con_p001, con_secinday, errmsg, errflg) + + use machine, only: kind_phys, kind_dyn, kind_dbl_prec + + implicit none + + ! interface variables + integer, intent(in ) :: levs, im + real(kind=kind_phys), intent(in ) :: con_g, con_fvirt, con_rd, con_eps, rainmin + real(kind=kind_phys), intent(in ) :: con_one, con_p001, con_secinday + real(kind=kind_phys), intent(in ), dimension(:) :: garea, slmsk, snowd, oro + real(kind=kind_phys), intent(inout), dimension(:,:) :: gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, & + gq0_ntsw, gq0_ntgl, gq0_ntclamt + real(kind_phys), intent(in ), dimension(:,:,:) :: aerfld + real(kind=kind_phys), intent(inout), dimension(:,:) :: gt0, gu0, gv0 + real(kind=kind_phys), intent(in ), dimension(:,:) :: vvl, prsl, del + real(kind=kind_phys), intent(in ), dimension(:,:) :: phii + + ! rain/snow/ice/graupel/precip amounts, fraction of frozen precip + !real(kind_phys), dimension(:) :: water0 + real(kind_phys), intent(out ), dimension(:), optional :: rain0 + real(kind_phys), intent(out ), dimension(:), optional :: snow0 + real(kind_phys), intent(out ), dimension(:), optional :: ice0 + real(kind_phys), intent(out ), dimension(:), optional :: graupel0 + real(kind_phys), intent(out ), dimension(:) :: prcp0 + real(kind_phys), intent(out ), dimension(:) :: sr + + real(kind_phys), intent(in) :: dtp ! physics time step + logical, intent (in) :: hydrostatic, fast_mp_consv + + logical, intent (in) :: lradar + real(kind=kind_phys), intent(inout), dimension(:,:) :: refl_10cm + logical, intent (in) :: reset, effr_in + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: rew, rei, rer, res, reg + logical, intent (in) :: cplchm + ! ice and liquid water 3d precipitation fluxes - only allocated if cplchm is .true. + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfi_lsan, pfl_lsan + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + integer :: iis, iie, jjs, jje, kks, kke, kbot, ktop + integer :: i, k, kk + real(kind=kind_phys), dimension(1:im,1:levs) :: delp, dz, uin, vin, pt, qv1, ql1, qi1, qr1, qs1, qg1, & + qa1, qnl, qni, pt_dt, qa_dt, u_dt, v_dt, w, qv_dt, ql_dt,& + qr_dt, qi_dt, qs_dt, qg_dt, p123, refl + real(kind=kind_phys), dimension(1:im,1:levs) :: q_con, cappa !for inline MP option + real(kind=kind_phys), dimension(1:im,1,1:levs) :: pfils, pflls + real(kind=kind_phys), dimension(1:im,1,1:levs) :: adj_vmr, te + real(kind=kind_phys), dimension(1:im,1:levs) :: prefluxw, prefluxr, prefluxi, prefluxs, prefluxg + real(kind=kind_phys), dimension(1:im) :: hs, gsize + real(kind=kind_dbl_prec), dimension(1:im) :: dte + !real(kind=kind_phys), dimension(:,:), allocatable :: den + real(kind=kind_phys), dimension(1:im) :: water0 + real(kind=kind_phys) :: onebg + real(kind=kind_phys) :: tem + logical last_step, do_inline_mp + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + iis = 1 + iie = im + jjs = 1 + jje = 1 + kks = 1 + kke = levs + ! flipping of vertical direction + ktop = 1 + kbot = levs + + onebg = con_one/con_g + + do k = 1, levs + kk = levs-k+1 + do i = 1, im + qv_dt(i,k) = 0.0 + ql_dt(i,k) = 0.0 + qr_dt(i,k) = 0.0 + qi_dt(i,k) = 0.0 + qs_dt(i,k) = 0.0 + qg_dt(i,k) = 0.0 + qa_dt(i,k) = 0.0 + pt_dt(i,k) = 0.0 + u_dt(i,k) = 0.0 + v_dt(i,k) = 0.0 + qnl(i,k) = aerfld(i,kk,11) ! sulfate + pfils(i,1,k) = 0.0 + pflls(i,1,k) = 0.0 + prefluxw(i,k) =0.0 + prefluxi(i,k) =0.0 + prefluxr(i,k) =0.0 + prefluxs(i,k) =0.0 + prefluxg(i,k) =0.0 + + ! flip vertical (k) coordinate top =1 + qv1(i,k) = gq0(i,kk) + ql1(i,k) = gq0_ntcw(i,kk) + qr1(i,k) = gq0_ntrw(i,kk) + qi1(i,k) = gq0_ntiw(i,kk) + qs1(i,k) = gq0_ntsw(i,kk) + qg1(i,k) = gq0_ntgl(i,kk) + qa1(i,k) = gq0_ntclamt(i,kk) + pt(i,k) = gt0(i,kk) + w(i,k) = -vvl(i,kk) * (con_one+con_fvirt * gq0(i,kk)) & + * gt0(i,kk) / prsl(i,kk) * (con_rd*onebg) + uin(i,k) = gu0(i,kk) + vin(i,k) = gv0(i,kk) + delp(i,k) = del(i,kk) + dz(i,k) = (phii(i,kk)-phii(i,kk+1))*onebg + p123(i,k) = prsl(i,kk) + qni(i,k) = 10. + q_con(i,k) = 0.0 + cappa(i,k) = 0.0 + enddo + enddo + + ! reset precipitation amounts to zero + water0 = 0 + rain0 = 0 + ice0 = 0 + snow0 = 0 + graupel0 = 0 + + ! Call MP driver + last_step = .false. + do_inline_mp = .false. + hs = oro(:) * con_g + gsize = sqrt(garea(:)) + + call gfdl_cloud_microphys_v3_mod_driver( qv1, ql1, qr1, qi1, qs1, qg1, qa1, qnl, qni, pt, w,& + uin, vin, dz, delp, gsize, dtp, hs, water0, rain0, & + ice0, snow0, graupel0, hydrostatic, iis, iie, kks, kke, q_con, cappa, & + fast_mp_consv, adj_vmr, te, dte, prefluxw, prefluxr, prefluxi, prefluxs, & + prefluxg, last_step, do_inline_mp ) + tem = dtp*con_p001/con_secinday + + ! fix negative values + do i = 1, im + !rain0(i) = max(con_d00, rain0(i)) + !snow0(i) = max(con_d00, snow0(i)) + !ice0(i) = max(con_d00, ice0(i)) + !graupel0(i) = max(con_d00, graupel0(i)) + if(water0(i)*tem < rainmin) then + water0(i) = 0.0 + endif + if(rain0(i)*tem < rainmin) then + rain0(i) = 0.0 + endif + if(ice0(i)*tem < rainmin) then + ice0(i) = 0.0 + endif + if(snow0(i)*tem < rainmin) then + snow0(i) = 0.0 + endif + if(graupel0(i)*tem < rainmin) then + graupel0(i) = 0.0 + endif + enddo + + ! calculate fraction of frozen precipitation using unscaled + ! values of rain0, ice0, snow0, graupel0 (for bit-for-bit) + do i=1,im + prcp0(i) = (rain0(i)+snow0(i)+ice0(i)+graupel0(i)) * tem + if ( prcp0(i) > rainmin ) then + sr(i) = (snow0(i) + ice0(i) + graupel0(i)) & + / (rain0(i) + snow0(i) + ice0(i) + graupel0(i)) + else + sr(i) = 0.0 + endif + enddo + + ! convert rain0, ice0, snow0, graupel0 from mm per day to m per physics timestep + water0 = water0*tem + rain0 = rain0*tem + ice0 = ice0*tem + snow0 = snow0*tem + graupel0 = graupel0*tem + + ! flip vertical coordinate back + do k=1,levs + kk = levs-k+1 + do i=1,im + gq0(i,k) = qv1(i,kk) + gq0_ntcw(i,k) = ql1(i,kk) + gq0_ntrw(i,k) = qr1(i,kk) + gq0_ntiw(i,k) = qi1(i,kk) + gq0_ntsw(i,k) = qs1(i,kk) + gq0_ntgl(i,k) = qg1(i,kk) + gq0_ntclamt(i,k) = qa1(i,kk) + gt0(i,k) = pt(i,kk) + gu0(i,k) = uin(i,kk) + gv0(i,k) = vin(i,kk) + refl_10cm(i,k) = refl(i,kk) + enddo + enddo + + ! output ice and liquid water 3d precipitation fluxes if requested + if (cplchm) then + do k=1,levs + kk = levs-k+1 + do i=1,im + pfi_lsan(i,k) = prefluxi (i,kk) + prefluxs (i,kk) + prefluxg (i,kk) + pfl_lsan(i,k) = prefluxr (i,kk) + enddo + enddo + endif + + if(effr_in) then + call cld_eff_rad (1, im, 1, levs, slmsk(1:im), & + prsl(1:im,1:levs), del(1:im,1:levs), & + gt0(1:im,1:levs), gq0(1:im,1:levs), & + gq0_ntcw(1:im,1:levs), gq0_ntiw(1:im,1:levs), & + gq0_ntrw(1:im,1:levs), gq0_ntsw(1:im,1:levs), & + gq0_ntgl(1:im,1:levs), gq0_ntclamt(1:im,1:levs), & + rew(1:im,1:levs), rei(1:im,1:levs), rer(1:im,1:levs),& + res(1:im,1:levs), reg(1:im,1:levs),snowd(1:im)) + endif + + if(lradar) then + call rad_ref (1, im, 1, 1, qv1(1:im,1:levs), qr1(1:im,1:levs), & + qs1(1:im,1:levs),qg1(1:im,1:levs),pt(1:im,1:levs), & + delp(1:im,1:levs), dz(1:im,1:levs), refl(1:im,1:levs), levs, hydrostatic, & + do_inline_mp, 1) + + do k=1,levs + kk = levs-k+1 + do i=1,im + refl_10cm(i,k) = max(-35.,refl(i,kk)) + enddo + enddo + endif + + end subroutine gfdl_cloud_microphys_v3_run + +end module gfdl_cloud_microphys_v3 diff --git a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.meta b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.meta new file mode 100644 index 000000000..3b022bf25 --- /dev/null +++ b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3.meta @@ -0,0 +1,541 @@ +[ccpp-table-properties] + name = gfdl_cloud_microphys_v3 + type = scheme + dependencies = ../../../hooks/machine.F + dependencies = ../../../hooks/physcons.F90 + dependencies = gfdl_cloud_microphys_v3_mod.F90 + +######################################################################## +[ccpp-arg-table] + name = gfdl_cloud_microphys_v3_init + type = scheme +[me] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in +[master] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in +[nlunit] + standard_name = iounit_of_namelist + long_name = fortran unit number for opening nameliust file + units = none + dimensions = () + type = integer + intent = in +[input_nml_file] + standard_name = filename_of_internal_namelist + long_name = character string to store full namelist contents + units = none + dimensions = (number_of_lines_in_internal_namelist) + type = character + kind = len=* + intent = in +[logunit] + standard_name = iounit_of_log + long_name = fortran unit number for writing logfile + units = none + dimensions = () + type = integer + intent = in +[fn_nml] + standard_name = filename_of_namelist + long_name = namelist filename + units = none + dimensions = () + type = character + kind = len=* + intent = in +[imp_physics] + standard_name = control_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_gfdl] + standard_name = identifier_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[do_shoc] + standard_name = flag_for_shoc + long_name = flag to indicate use of SHOC + units = flag + dimensions = () + type = logical + intent = in +[hydrostatic] + standard_name = flag_for_hydrostatic_solver + long_name = flag indicating hydrostatic solver + units = flag + dimensions = () + type = logical + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = gfdl_cloud_microphys_v3_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = gfdl_cloud_microphys_v3_run + type = scheme +[fast_mp_consv] + standard_name = flag_for_fast_microphysics_energy_conservation + long_name = flag for fast microphysics energy conservation + units = flag + dimensions = () + type = logical + intent = in +[levs] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[rainmin] + standard_name = lwe_thickness_of_minimum_rain_amount + long_name = minimum rain amount + units = m + dimensions = () + type = real + kind = kind_phys + intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[garea] + standard_name = cell_area + long_name = area of grid cell + units = m2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[slmsk] + standard_name = area_type + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[snowd] + standard_name = lwe_surface_snow + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[gq0] + standard_name = specific_humidity_of_new_state + long_name = water vapor specific humidity updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0_ntcw] + standard_name = cloud_liquid_water_mixing_ratio_of_new_state + long_name = cloud condensed water mixing ratio updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0_ntrw] + standard_name = rain_mixing_ratio_of_new_state + long_name = moist mixing ratio of rain updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0_ntiw] + standard_name = cloud_ice_mixing_ratio_of_new_state + long_name = moist mixing ratio of cloud ice updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0_ntsw] + standard_name = snow_mixing_ratio_of_new_state + long_name = moist mixing ratio of snow updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0_ntgl] + standard_name = graupel_mixing_ratio_of_new_state + long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gq0_ntclamt] + standard_name = cloud_area_fraction_in_atmosphere_layer_of_new_state + long_name = cloud fraction updated by physics + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[aerfld] + standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 + long_name = mass mixing ratio of aerosol from gocart or merra2 + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in +[gt0] + standard_name = air_temperature_of_new_state + long_name = air temperature updated by physics + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gu0] + standard_name = x_wind_of_new_state + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[gv0] + standard_name = y_wind_of_new_state + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[vvl] + standard_name = lagrangian_tendency_of_air_pressure + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between mid-layers + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[rain0] + standard_name = lwe_thickness_of_explicit_rain_amount + long_name = explicit rain on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = True +[ice0] + standard_name = lwe_thickness_of_ice_amount + long_name = ice fall on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = True +[snow0] + standard_name = lwe_thickness_of_snow_amount + long_name = snow fall on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = True +[graupel0] + standard_name = lwe_thickness_of_graupel_amount + long_name = graupel fall on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = True +[prcp0] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit precipitation (rain, ice, snow, graupel) on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[sr] + standard_name = ratio_of_snowfall_to_rainfall + long_name = snow ratio: ratio of snow to total precipitation + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[oro] + standard_name = height_above_mean_sea_level + long_name = height_above_mean_sea_level + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[hydrostatic] + standard_name = flag_for_hydrostatic_solver + long_name = flag indicating hydrostatic solver + units = flag + dimensions = () + type = logical + intent = in +[lradar] + standard_name = flag_for_radar_reflectivity + long_name = flag for radar reflectivity + units = flag + dimensions = () + type = logical + intent = in +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[reset] + standard_name = flag_reset_maximum_hourly_fields + long_name = flag for resetting maximum hourly fields + units = flag + dimensions = () + type = logical + intent = in +[effr_in] + standard_name = flag_for_cloud_effective_radii + long_name = flag for cloud effective radii calculations in GFDL microphysics + units = flag + dimensions = () + type = logical + intent = in +[rew] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle + long_name = eff. radius of cloud liquid water particle in micrometer + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[rei] + standard_name = effective_radius_of_stratiform_cloud_ice_particle + long_name = eff. radius of cloud ice water particle in micrometer + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[rer] + standard_name = effective_radius_of_stratiform_cloud_rain_particle + long_name = effective radius of cloud rain particle in micrometers + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[res] + standard_name = effective_radius_of_stratiform_cloud_snow_particle + long_name = effective radius of cloud snow particle in micrometers + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[reg] + standard_name = effective_radius_of_stratiform_cloud_graupel_particle + long_name = eff. radius of cloud graupel particle in micrometer + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[cplchm] + standard_name = flag_for_chemistry_coupling + long_name = flag controlling cplchm collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[pfi_lsan] + standard_name = ice_flux_due_to_large_scale_precipitation + long_name = instantaneous 3D flux of ice from nonconvective precipitation + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[pfl_lsan] + standard_name = liquid_flux_due_to_large_scale_precipitation + long_name = instantaneous 3D flux of liquid water from nonconvective precipitation + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[con_one] + standard_name = constant_one + long_name = mathematical constant of one + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_p001] + standard_name = constant_one_hundredth + long_name = mathematical constant for one hundredth + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_secinday] + standard_name = seconds_in_a_day + long_name = number of seconds in a day + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90 b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90 new file mode 100644 index 000000000..b15f2efd9 --- /dev/null +++ b/physics/MP/GFDL/v3_2022/gfdl_cloud_microphys_v3_mod.F90 @@ -0,0 +1,7334 @@ +!>\file gfdl_cloud_microphys_v3_mod.F90 +!! This file contains the entity of GFDL MP scheme Version 3. + +!*********************************************************************** +!* GNU Lesser General Public License +!* +!* This file is part of the FV3 dynamical core. +!* +!* The FV3 dynamical core is free software: you can redistribute it +!* and/or modify it under the terms of the +!* GNU Lesser General Public License as published by the +!* Free Software Foundation, either version 3 of the License, or +!* (at your option) any later version. +!* +!* The FV3 dynamical core is distributed in the hope that it will be +!* useful, but WITHOUT ANY WARRANTY; without even the implied warranty +!* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +!* See the GNU General Public License for more details. +!* +!* You should have received a copy of the GNU Lesser General Public +!* License along with the FV3 dynamical core. +!* If not, see . +!*********************************************************************** + +! ======================================================================= +! GFDL Cloud Microphysics Package (GFDL MP) Version 3 +! The algorithms are originally derived from Lin et al. (1983). +! Most of the key elements have been simplified / improved. +! This code at this stage bears little to no similarity to the original Lin MP in ZETAC. +! Developers: Linjiong Zhou and the GFDL FV3 Team +! References: +! Version 0: Chen and Lin (2011 doi: 10.1029/2011GL047629, 2013 doi: 10.1175/JCLI-D-12-00061.1) +! Version 1: Zhou et al. (2019 doi: 10.1175/BAMS-D-17-0246.1) +! Version 2: Harris et al. (2020 doi: 10.1029/2020MS002223), Zhou et al. (2022 doi: 10.25923/pz3c-8b96) +! Version 3: Zhou et al. (2022 doi: 10.1029/2021MS002971) +! ======================================================================= + +module gfdl_cloud_microphys_v3_mod + use machine, only: kind_phys, r8 => kind_dbl_prec + use module_gfdlmp_param, only: read_gfdlmp_nml, & + t_min, t_sub, tau_r2g, tau_smlt, tau_gmlt, dw_land, dw_ocean, vw_fac, vi_fac, & + vr_fac, vs_fac, vg_fac, ql_mlt, do_qa, fix_negative, vw_max, vi_max, vs_max, & + vg_max, vr_max, qs_mlt, qs0_crt, ql0_max, qi0_max, qi0_crt, ifflag, rh_inc, rh_ins,& + rh_inr, const_vw, const_vi, const_vs, const_vg, const_vr, rthresh, ccn_l, ccn_o, & + igflag, c_paut, tau_imlt, tau_v2l, tau_l2v, tau_i2s, tau_l2r, qi_lim, ql_gen, & + do_hail, inflag, c_psacw, c_psaci, c_pracs, c_psacr, c_pgacr, c_pgacs, c_pgacw, & + c_pgaci, z_slope_liq, z_slope_ice, prog_ccn, c_pracw, c_praci, rad_snow, & + rad_graupel, rad_rain, cld_min, sedflag, sed_fac, do_sedi_uv, do_sedi_w, & + do_sedi_heat, icloud_f, irain_f, xr_a, xr_b, xr_c, ntimes, tau_revp, tice_mlt, & + do_cond_timescale, mp_time, consv_checker, te_err, tw_err, use_rhc_cevap, & + use_rhc_revap, tau_wbf, do_warm_rain_mp, rh_thres, f_dq_p, f_dq_m, do_cld_adj, & + rhc_cevap, rhc_revap, beta, liq_ice_combine, rewflag, reiflag, rerflag, resflag, & + regflag, rewmin, rewmax, reimin, reimax, rermin, rermax, resmin, resmax, regmin, & + regmax, fs2g_fac, fi2s_fac, fi2g_fac, do_sedi_melt, radr_flag, rads_flag, & + radg_flag, do_wbf, do_psd_water_fall, do_psd_ice_fall, n0w_sig, n0i_sig, n0r_sig, & + n0s_sig, n0g_sig, n0h_sig, n0w_exp, n0i_exp, n0r_exp, n0s_exp, n0g_exp, n0h_exp, & + muw, mui, mur, mus, mug, muh, alinw, alini, alinr, alins, aling, alinh, blinw, & + blini, blinr, blins, bling, blinh, do_new_acc_water, do_new_acc_ice, is_fac, & + ss_fac, gs_fac, rh_fac_evap, rh_fac_cond, snow_grauple_combine, do_psd_water_num, & + do_psd_ice_num, vdiffflag, rewfac, reifac, cp_heating, nconds, do_evap_timescale, & + delay_cond_evap, do_subgrid_proc, fast_fr_mlt, fast_dep_sub, qi_gen, tice + use physcons, only: grav => con_g, & + rgrav => con_1ovg, & + pi => con_pi, & + boltzmann => con_boltz, & + avogadro => con_sbc, & + rdgas => con_rd, & + rvgas => con_rv, & + zvir => con_fvirt, & + runiver => con_runiver, & + cp_air => con_cp, & + c_ice => con_csol, & + !c_liq => con_cliq, & + !e00 => con_psat, & + hlv => con_hvap, & + hlf => con_hfus, & + rho0 => rhoair_IFS, & + rhos => rhosnow, & + one_r8 => con_one, & + con_amd, con_amw, visd, & + visk, vdifu, tcond, cdg, & + cdh, rhow => rhocw, & + rhoi => rhoci, & + rhor => rhocr, & + rhog => rhocg, & + rhoh => rhoch, qcmin, qfmin + private + + ! ----------------------------------------------------------------------- + ! interface functions + ! ----------------------------------------------------------------------- + + interface wqs + procedure wes_t + procedure wqs_trho + procedure wqs_ptqv + end interface wqs + + interface mqs + procedure mes_t + procedure mqs_trho + procedure mqs_ptqv + end interface mqs + + interface iqs + procedure ies_t + procedure iqs_trho + procedure iqs_ptqv + end interface iqs + + interface mhc + procedure mhc3 + procedure mhc4 + procedure mhc6 + end interface mhc + + interface wet_bulb + procedure wet_bulb_dry + procedure wet_bulb_moist + end interface wet_bulb + + ! ----------------------------------------------------------------------- + ! public subroutines and functions + ! ----------------------------------------------------------------------- + + public :: gfdl_cloud_microphys_v3_mod_init + public :: gfdl_cloud_microphys_v3_mod_driver + public :: gfdl_cloud_microphys_v3_mod_end + public :: cld_sat_adj, cld_eff_rad, rad_ref + public :: qs_init, wqs, mqs, mqs3d + public :: wet_bulb + public :: mtetw + + ! ----------------------------------------------------------------------- + ! initialization conditions + ! ----------------------------------------------------------------------- + + logical :: tables_are_initialized = .false. ! initialize satuation tables + + ! ----------------------------------------------------------------------- + ! Physical constants that differ from physcons + ! ----------------------------------------------------------------------- + real(kind_phys), parameter :: c_liq = 4.218e3 + real(kind = r8), parameter :: e00 = 611.21 ! saturation vapor pressure at 0 deg C (Pa), ref: IFS + + ! ----------------------------------------------------------------------- + ! derived physics constants + ! ----------------------------------------------------------------------- + real(kind_phys), parameter :: mmd = con_amd*1e-3 ! (g/mol) -> (kg/mol) + real(kind_phys), parameter :: mmv = con_amw*1e-3 ! (g/mol) -> (kg/mol) + real(kind_phys), parameter :: cv_air = cp_air - rdgas + real(kind_phys), parameter :: cp_vap = 4.0 * rvgas + real(kind_phys), parameter :: cv_vap = 3.0 * rvgas + real(kind_phys), parameter :: dc_vap = cp_vap - c_liq + real(kind_phys), parameter :: dc_ice = c_liq - c_ice + real(kind_phys), parameter :: d2_ice = cp_vap - c_ice + + ! ----------------------------------------------------------------------- + ! predefined parameters + ! ----------------------------------------------------------------------- + + integer, parameter :: length = 2621 ! length of the saturation table + real(kind_phys), parameter :: dz_min = 1.0e-2 ! used for correcting flipped height (m) + real(kind_phys), parameter :: dt_fr = 8.0 ! t_wfr - dt_fr: minimum temperature water can exist (Moore and Molinero 2011) + integer :: cfflag = 1 ! cloud fraction scheme + ! 1: GFDL cloud scheme + ! 2: Xu and Randall (1996) + ! 3: Park et al. (2016) + ! 4: Gultepe and Isaac (2007) + + ! ----------------------------------------------------------------------- + ! local shared variables + ! ----------------------------------------------------------------------- + ! Set during init. + real(kind = r8) :: lv0 + real(kind = r8) :: li0 + real(kind = r8) :: li2 + + real(kind_phys) :: acco (3, 10), acc (20) + real(kind_phys) :: cracs, csacr, cgacr, cgacs, csacw, craci, csaci, cgacw, cgaci, cracw + real(kind_phys) :: cssub (5), cgsub (5), crevp (5), cgfr (2), csmlt (4), cgmlt (4) + + real(kind_phys) :: t_wfr, fac_rc, c_air, c_vap, d0_vap + + real (kind = r8) :: lv00, li00, li20, cpaut + real (kind = r8) :: d1_vap, d1_ice, c1_vap, c1_liq, c1_ice + real (kind = r8) :: normw, normr, normi, norms, normg, normh + real (kind = r8) :: expow, expor, expoi, expos, expog, expoh + real (kind = r8) :: pcaw, pcar, pcai, pcas, pcag, pcah + real (kind = r8) :: pcbw, pcbr, pcbi, pcbs, pcbg, pcbh + real (kind = r8) :: edaw, edar, edai, edas, edag, edah + real (kind = r8) :: edbw, edbr, edbi, edbs, edbg, edbh + real (kind = r8) :: oeaw, oear, oeai, oeas, oeag, oeah + real (kind = r8) :: oebw, oebr, oebi, oebs, oebg, oebh + real (kind = r8) :: rraw, rrar, rrai, rras, rrag, rrah + real (kind = r8) :: rrbw, rrbr, rrbi, rrbs, rrbg, rrbh + real (kind = r8) :: tvaw, tvar, tvai, tvas, tvag, tvah + real (kind = r8) :: tvbw, tvbr, tvbi, tvbs, tvbg, tvbh + + real(kind_phys), allocatable :: table0 (:), table1 (:), table2 (:), table3 (:), table4 (:) + real(kind_phys), allocatable :: des0 (:), des1 (:), des2 (:), des3 (:), des4 (:) + +contains + +! ======================================================================= +! GFDL cloud microphysics initialization +! ======================================================================= + +subroutine gfdl_cloud_microphys_v3_mod_init (me, master, nlunit, input_nml_file, logunit, & + fn_nml, hydrostatic, errmsg, errflg) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: me + integer, intent (in) :: master + integer, intent (in) :: nlunit + integer, intent (in) :: logunit + + character (len = 64), intent (in) :: fn_nml + character (len = *), intent (in) :: input_nml_file (:) + logical, intent (in) :: hydrostatic + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: ios + logical :: exists + + ! Initialize CCPP error-handling + errflg = 0 + errmsg = '' + + ! ----------------------------------------------------------------------- + ! Read namelist + ! ----------------------------------------------------------------------- + call read_gfdlmp_nml(errmsg = errmsg, errflg = errflg, unit = nlunit, & + input_nml_file = input_nml_file, fn_nml = fn_nml, version=3, & + iostat = ios) + + ! Initialize scheme parameters + lv0 = hlv - dc_vap * tice ! 3148711.3338762247, evaporation latent heat coeff. at 0 deg K (J/kg) + li0 = hlf - dc_ice * tice ! 242413.92000000004, fussion latent heat coeff. at 0 deg K (J/kg) + li2 = lv0 + li0 ! 2906297.413876225, sublimation latent heat coeff. at 0 deg K (J/kg) + + ! ----------------------------------------------------------------------- + ! write version number and namelist to log file + ! ----------------------------------------------------------------------- + if (me == master) then + write (logunit, *) " ================================================================== " + write (logunit, *) "gfdl_cloud_microphysics_nml_v3" + endif + + ! ----------------------------------------------------------------------- + ! initialize microphysics variables + ! ----------------------------------------------------------------------- + + if (.not. tables_are_initialized) call qs_init + + call setup_mp + + ! ----------------------------------------------------------------------- + ! define various heat capacities and latent heat coefficients at 0 deg K + ! ----------------------------------------------------------------------- + + call setup_mhc_lhc (hydrostatic) + +end subroutine gfdl_cloud_microphys_v3_mod_init + +! ======================================================================= +! GFDL cloud microphysics driver +! ======================================================================= + +subroutine gfdl_cloud_microphys_v3_mod_driver (qv, ql, qr, qi, qs, qg, qa, qnl, qni, pt, wa, & + ua, va, delz, delp, gsize, dtm, hs, water, rain, ice, snow, graupel, & + hydrostatic, is, ie, ks, ke, q_con, cappa, consv_te, adj_vmr, te, dte, & + prefluxw, prefluxr, prefluxi, prefluxs, prefluxg, last_step, do_inline_mp) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: is, ie, ks, ke + + logical, intent (in) :: hydrostatic, last_step, consv_te, do_inline_mp + + real(kind_phys), intent (in) :: dtm + + real(kind_phys), intent (in), dimension (is:ie) :: hs, gsize + + real(kind_phys), intent (in), dimension (is:ie, ks:ke) :: qnl, qni + + real(kind_phys), intent (inout), dimension (is:ie, ks:ke) :: delp, delz, pt, ua, va, wa, te + real(kind_phys), intent (inout), dimension (is:ie, ks:ke) :: qv, ql, qr, qi, qs, qg, qa + real(kind_phys), intent (inout), dimension (is:ie, ks:ke) :: prefluxw, prefluxr, prefluxi, prefluxs, prefluxg + + real(kind_phys), intent (inout), dimension (is:, ks:) :: q_con, cappa + + real(kind_phys), intent (inout), dimension (is:ie) :: water, rain, ice, snow, graupel + + real(kind_phys), intent (out), dimension (is:ie, ks:ke) :: adj_vmr + + real (kind = r8), intent (out), dimension (is:ie) :: dte + + ! ----------------------------------------------------------------------- + ! major cloud microphysics driver + ! ----------------------------------------------------------------------- + + call mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, qa, & + qnl, qni, delz, is, ie, ks, ke, dtm, water, rain, ice, snow, graupel, & + gsize, hs, q_con, cappa, consv_te, adj_vmr, te, dte, prefluxw, prefluxr, & + prefluxi, prefluxs, prefluxg, last_step, do_inline_mp, .false., .true.) + +end subroutine gfdl_cloud_microphys_v3_mod_driver + +! ======================================================================= +! GFDL cloud microphysics end +! ======================================================================= + +subroutine gfdl_cloud_microphys_v3_mod_end + + implicit none + + ! ----------------------------------------------------------------------- + ! free up memory + ! ----------------------------------------------------------------------- + + deallocate (table0) + deallocate (table1) + deallocate (table2) + deallocate (table3) + deallocate (table4) + deallocate (des0) + deallocate (des1) + deallocate (des2) + deallocate (des3) + deallocate (des4) + + tables_are_initialized = .false. + +end subroutine gfdl_cloud_microphys_v3_mod_end + +! ======================================================================= +! setup cloud microphysics parameters +! ======================================================================= + +subroutine setup_mp + + implicit none + + integer :: i, k + + real(kind_phys) :: gcon, hcon, scm3, pisq, act (20), ace (20), occ (3), aone + + ! ----------------------------------------------------------------------- + ! complete freezing temperature + ! ----------------------------------------------------------------------- + + if (do_warm_rain_mp) then + t_wfr = t_min + else + t_wfr = tice - 40.0 + endif + + ! ----------------------------------------------------------------------- + ! cloud water autoconversion, Hong et al. (2004) + ! ----------------------------------------------------------------------- + + fac_rc = (4. / 3.) * pi * rhow * rthresh ** 3 + + aone = 2. / 9. * (3. / 4.) ** (4. / 3.) / pi ** (1. / 3.) + cpaut = c_paut * aone * grav / visd + + ! ----------------------------------------------------------------------- + ! terminal velocities parameters, Lin et al. (1983) + ! ----------------------------------------------------------------------- + + gcon = (4. * grav * rhog / (3. * cdg * rho0)) ** 0.5 + hcon = (4. * grav * rhoh / (3. * cdh * rho0)) ** 0.5 + + ! ----------------------------------------------------------------------- + ! part of the slope parameters + ! ----------------------------------------------------------------------- + + normw = pi * rhow * n0w_sig * gamma (muw + 3) + normi = pi * rhoi * n0i_sig * gamma (mui + 3) + normr = pi * rhor * n0r_sig * gamma (mur + 3) + norms = pi * rhos * n0s_sig * gamma (mus + 3) + normg = pi * rhog * n0g_sig * gamma (mug + 3) + normh = pi * rhoh * n0h_sig * gamma (muh + 3) + + expow = exp (n0w_exp / (muw + 3) * log (10.)) + expoi = exp (n0i_exp / (mui + 3) * log (10.)) + expor = exp (n0r_exp / (mur + 3) * log (10.)) + expos = exp (n0s_exp / (mus + 3) * log (10.)) + expog = exp (n0g_exp / (mug + 3) * log (10.)) + expoh = exp (n0h_exp / (muh + 3) * log (10.)) + + ! ----------------------------------------------------------------------- + ! parameters for particle concentration (pc), effective diameter (ed), + ! optical extinction (oe), radar reflectivity factor (rr), and + ! mass-weighted terminal velocity (tv) + ! ----------------------------------------------------------------------- + + pcaw = exp (3 / (muw + 3) * log (n0w_sig)) * gamma (muw) * exp (3 * n0w_exp / (muw + 3) * log (10.)) + pcai = exp (3 / (mui + 3) * log (n0i_sig)) * gamma (mui) * exp (3 * n0i_exp / (mui + 3) * log (10.)) + pcar = exp (3 / (mur + 3) * log (n0r_sig)) * gamma (mur) * exp (3 * n0r_exp / (mur + 3) * log (10.)) + pcas = exp (3 / (mus + 3) * log (n0s_sig)) * gamma (mus) * exp (3 * n0s_exp / (mus + 3) * log (10.)) + pcag = exp (3 / (mug + 3) * log (n0g_sig)) * gamma (mug) * exp (3 * n0g_exp / (mug + 3) * log (10.)) + pcah = exp (3 / (muh + 3) * log (n0h_sig)) * gamma (muh) * exp (3 * n0h_exp / (muh + 3) * log (10.)) + + pcbw = exp (muw / (muw + 3) * log (pi * rhow * gamma (muw + 3))) + pcbi = exp (mui / (mui + 3) * log (pi * rhoi * gamma (mui + 3))) + pcbr = exp (mur / (mur + 3) * log (pi * rhor * gamma (mur + 3))) + pcbs = exp (mus / (mus + 3) * log (pi * rhos * gamma (mus + 3))) + pcbg = exp (mug / (mug + 3) * log (pi * rhog * gamma (mug + 3))) + pcbh = exp (muh / (muh + 3) * log (pi * rhoh * gamma (muh + 3))) + + edaw = exp (- 1. / (muw + 3) * log (n0w_sig)) * (muw + 2) * exp (- n0w_exp / (muw + 3) * log (10.)) + edai = exp (- 1. / (mui + 3) * log (n0i_sig)) * (mui + 2) * exp (- n0i_exp / (mui + 3) * log (10.)) + edar = exp (- 1. / (mur + 3) * log (n0r_sig)) * (mur + 2) * exp (- n0r_exp / (mur + 3) * log (10.)) + edas = exp (- 1. / (mus + 3) * log (n0s_sig)) * (mus + 2) * exp (- n0s_exp / (mus + 3) * log (10.)) + edag = exp (- 1. / (mug + 3) * log (n0g_sig)) * (mug + 2) * exp (- n0g_exp / (mug + 3) * log (10.)) + edah = exp (- 1. / (muh + 3) * log (n0h_sig)) * (muh + 2) * exp (- n0h_exp / (muh + 3) * log (10.)) + + edbw = exp (1. / (muw + 3) * log (pi * rhow * gamma (muw + 3))) + edbi = exp (1. / (mui + 3) * log (pi * rhoi * gamma (mui + 3))) + edbr = exp (1. / (mur + 3) * log (pi * rhor * gamma (mur + 3))) + edbs = exp (1. / (mus + 3) * log (pi * rhos * gamma (mus + 3))) + edbg = exp (1. / (mug + 3) * log (pi * rhog * gamma (mug + 3))) + edbh = exp (1. / (muh + 3) * log (pi * rhoh * gamma (muh + 3))) + + oeaw = exp (1. / (muw + 3) * log (n0w_sig)) * pi * gamma (muw + 2) * & + exp (n0w_exp / (muw + 3) * log (10.)) + oeai = exp (1. / (mui + 3) * log (n0i_sig)) * pi * gamma (mui + 2) * & + exp (n0i_exp / (mui + 3) * log (10.)) + oear = exp (1. / (mur + 3) * log (n0r_sig)) * pi * gamma (mur + 2) * & + exp (n0r_exp / (mur + 3) * log (10.)) + oeas = exp (1. / (mus + 3) * log (n0s_sig)) * pi * gamma (mus + 2) * & + exp (n0s_exp / (mus + 3) * log (10.)) + oeag = exp (1. / (mug + 3) * log (n0g_sig)) * pi * gamma (mug + 2) * & + exp (n0g_exp / (mug + 3) * log (10.)) + oeah = exp (1. / (muh + 3) * log (n0h_sig)) * pi * gamma (muh + 2) * & + exp (n0h_exp / (muh + 3) * log (10.)) + + oebw = 2 * exp ((muw + 2) / (muw + 3) * log (pi * rhow * gamma (muw + 3))) + oebi = 2 * exp ((mui + 2) / (mui + 3) * log (pi * rhoi * gamma (mui + 3))) + oebr = 2 * exp ((mur + 2) / (mur + 3) * log (pi * rhor * gamma (mur + 3))) + oebs = 2 * exp ((mus + 2) / (mus + 3) * log (pi * rhos * gamma (mus + 3))) + oebg = 2 * exp ((mug + 2) / (mug + 3) * log (pi * rhog * gamma (mug + 3))) + oebh = 2 * exp ((muh + 2) / (muh + 3) * log (pi * rhoh * gamma (muh + 3))) + + rraw = exp (- 3 / (muw + 3) * log (n0w_sig)) * gamma (muw + 6) * & + exp (- 3 * n0w_exp / (muw + 3) * log (10.)) + rrai = exp (- 3 / (mui + 3) * log (n0i_sig)) * gamma (mui + 6) * & + exp (- 3 * n0i_exp / (mui + 3) * log (10.)) + rrar = exp (- 3 / (mur + 3) * log (n0r_sig)) * gamma (mur + 6) * & + exp (- 3 * n0r_exp / (mur + 3) * log (10.)) + rras = exp (- 3 / (mus + 3) * log (n0s_sig)) * gamma (mus + 6) * & + exp (- 3 * n0s_exp / (mus + 3) * log (10.)) + rrag = exp (- 3 / (mug + 3) * log (n0g_sig)) * gamma (mug + 6) * & + exp (- 3 * n0g_exp / (mug + 3) * log (10.)) + rrah = exp (- 3 / (muh + 3) * log (n0h_sig)) * gamma (muh + 6) * & + exp (- 3 * n0h_exp / (muh + 3) * log (10.)) + + rrbw = exp ((muw + 6) / (muw + 3) * log (pi * rhow * gamma (muw + 3))) + rrbi = exp ((mui + 6) / (mui + 3) * log (pi * rhoi * gamma (mui + 3))) + rrbr = exp ((mur + 6) / (mur + 3) * log (pi * rhor * gamma (mur + 3))) + rrbs = exp ((mus + 6) / (mus + 3) * log (pi * rhos * gamma (mus + 3))) + rrbg = exp ((mug + 6) / (mug + 3) * log (pi * rhog * gamma (mug + 3))) + rrbh = exp ((muh + 6) / (muh + 3) * log (pi * rhoh * gamma (muh + 3))) + + tvaw = exp (- blinw / (muw + 3) * log (n0w_sig)) * alinw * gamma (muw + blinw + 3) * & + exp (- blinw * n0w_exp / (muw + 3) * log (10.)) + tvai = exp (- blini / (mui + 3) * log (n0i_sig)) * alini * gamma (mui + blini + 3) * & + exp (- blini * n0i_exp / (mui + 3) * log (10.)) + tvar = exp (- blinr / (mur + 3) * log (n0r_sig)) * alinr * gamma (mur + blinr + 3) * & + exp (- blinr * n0r_exp / (mur + 3) * log (10.)) + tvas = exp (- blins / (mus + 3) * log (n0s_sig)) * alins * gamma (mus + blins + 3) * & + exp (- blins * n0s_exp / (mus + 3) * log (10.)) + tvag = exp (- bling / (mug + 3) * log (n0g_sig)) * aling * gamma (mug + bling + 3) * & + exp (- bling * n0g_exp / (mug + 3) * log (10.)) * gcon + tvah = exp (- blinh / (muh + 3) * log (n0h_sig)) * alinh * gamma (muh + blinh + 3) * & + exp (- blinh * n0h_exp / (muh + 3) * log (10.)) * hcon + + tvbw = exp (blinw / (muw + 3) * log (pi * rhow * gamma (muw + 3))) * gamma (muw + 3) + tvbi = exp (blini / (mui + 3) * log (pi * rhoi * gamma (mui + 3))) * gamma (mui + 3) + tvbr = exp (blinr / (mur + 3) * log (pi * rhor * gamma (mur + 3))) * gamma (mur + 3) + tvbs = exp (blins / (mus + 3) * log (pi * rhos * gamma (mus + 3))) * gamma (mus + 3) + tvbg = exp (bling / (mug + 3) * log (pi * rhog * gamma (mug + 3))) * gamma (mug + 3) + tvbh = exp (blinh / (muh + 3) * log (pi * rhoh * gamma (muh + 3))) * gamma (muh + 3) + + ! ----------------------------------------------------------------------- + ! Schmidt number, Sc ** (1 / 3) in Lin et al. (1983) + ! ----------------------------------------------------------------------- + + scm3 = exp (1. / 3. * log (visk / vdifu)) + + pisq = pi * pi + + ! ----------------------------------------------------------------------- + ! accretion between cloud water, cloud ice, rain, snow, and graupel or hail, Lin et al. (1983) + ! ----------------------------------------------------------------------- + + cracw = pi * n0r_sig * alinr * gamma (2 + mur + blinr) / & + (4. * exp ((2 + mur + blinr) / (mur + 3) * log (normr))) * & + exp ((1 - blinr) * log (expor)) + craci = pi * n0r_sig * alinr * gamma (2 + mur + blinr) / & + (4. * exp ((2 + mur + blinr) / (mur + 3) * log (normr))) * & + exp ((1 - blinr) * log (expor)) + csacw = pi * n0s_sig * alins * gamma (2 + mus + blins) / & + (4. * exp ((2 + mus + blins) / (mus + 3) * log (norms))) * & + exp ((1 - blins) * log (expos)) + csaci = pi * n0s_sig * alins * gamma (2 + mus + blins) / & + (4. * exp ((2 + mus + blins) / (mus + 3) * log (norms))) * & + exp ((1 - blins) * log (expos)) + if (do_hail) then + cgacw = pi * n0h_sig * alinh * gamma (2 + muh + blinh) * hcon / & + (4. * exp ((2 + muh + blinh) / (muh + 3) * log (normh))) * & + exp ((1 - blinh) * log (expoh)) + cgaci = pi * n0h_sig * alinh * gamma (2 + muh + blinh) * hcon / & + (4. * exp ((2 + muh + blinh) / (muh + 3) * log (normh))) * & + exp ((1 - blinh) * log (expoh)) + else + cgacw = pi * n0g_sig * aling * gamma (2 + mug + bling) * gcon / & + (4. * exp ((2 + mug + bling) / (mug + 3) * log (normg))) * & + exp ((1 - bling) * log (expog)) + cgaci = pi * n0g_sig * aling * gamma (2 + mug + bling) * gcon / & + (4. * exp ((2 + mug + bling) / (mug + 3) * log (normg))) * & + exp ((1 - bling) * log (expog)) + endif + + if (do_new_acc_water) then + + cracw = pisq * n0r_sig * n0w_sig * rhow / 24. + csacw = pisq * n0s_sig * n0w_sig * rhow / 24. + if (do_hail) then + cgacw = pisq * n0h_sig * n0w_sig * rhow / 24. + else + cgacw = pisq * n0g_sig * n0w_sig * rhow / 24. + endif + + endif + + if (do_new_acc_ice) then + + craci = pisq * n0r_sig * n0i_sig * rhoi / 24. + csaci = pisq * n0s_sig * n0i_sig * rhoi / 24. + if (do_hail) then + cgaci = pisq * n0h_sig * n0i_sig * rhoi / 24. + else + cgaci = pisq * n0g_sig * n0i_sig * rhoi / 24. + endif + + endif + + cracw = cracw * c_pracw + craci = craci * c_praci + csacw = csacw * c_psacw + csaci = csaci * c_psaci + cgacw = cgacw * c_pgacw + cgaci = cgaci * c_pgaci + + ! ----------------------------------------------------------------------- + ! accretion between cloud water, cloud ice, rain, snow, and graupel or hail, Lin et al. (1983) + ! ----------------------------------------------------------------------- + + cracs = pisq * n0r_sig * n0s_sig * rhos / 24. + csacr = pisq * n0s_sig * n0r_sig * rhor / 24. + if (do_hail) then + cgacr = pisq * n0h_sig * n0r_sig * rhor / 24. + cgacs = pisq * n0h_sig * n0s_sig * rhos / 24. + else + cgacr = pisq * n0g_sig * n0r_sig * rhor / 24. + cgacs = pisq * n0g_sig * n0s_sig * rhos / 24. + endif + + cracs = cracs * c_pracs + csacr = csacr * c_psacr + cgacr = cgacr * c_pgacr + cgacs = cgacs * c_pgacs + + ! act / ace / acc: + ! 1 - 2: racs (s - r) + ! 3 - 4: sacr (r - s) + ! 5 - 6: gacr (r - g) + ! 7 - 8: gacs (s - g) + ! 9 - 10: racw (w - r) + ! 11 - 12: raci (i - r) + ! 13 - 14: sacw (w - s) + ! 15 - 16: saci (i - s) + ! 17 - 18: sacw (w - g) + ! 19 - 20: saci (i - g) + + act (1) = norms + act (2) = normr + act (3) = act (2) + act (4) = act (1) + act (5) = act (2) + if (do_hail) then + act (6) = normh + else + act (6) = normg + endif + act (7) = act (1) + act (8) = act (6) + act (9) = normw + act (10) = act (2) + act (11) = normi + act (12) = act (2) + act (13) = act (9) + act (14) = act (1) + act (15) = act (11) + act (16) = act (1) + act (17) = act (9) + act (18) = act (6) + act (19) = act (11) + act (20) = act (6) + + ace (1) = expos + ace (2) = expor + ace (3) = ace (2) + ace (4) = ace (1) + ace (5) = ace (2) + if (do_hail) then + ace (6) = expoh + else + ace (6) = expog + endif + ace (7) = ace (1) + ace (8) = ace (6) + ace (9) = expow + ace (10) = ace (2) + ace (11) = expoi + ace (12) = ace (2) + ace (13) = ace (9) + ace (14) = ace (1) + ace (15) = ace (11) + ace (16) = ace (1) + ace (17) = ace (9) + ace (18) = ace (6) + ace (19) = ace (11) + ace (20) = ace (6) + + acc (1) = mus + acc (2) = mur + acc (3) = acc (2) + acc (4) = acc (1) + acc (5) = acc (2) + if (do_hail) then + acc (6) = muh + else + acc (6) = mug + endif + acc (7) = acc (1) + acc (8) = acc (6) + acc (9) = muw + acc (10) = acc (2) + acc (11) = mui + acc (12) = acc (2) + acc (13) = acc (9) + acc (14) = acc (1) + acc (15) = acc (11) + acc (16) = acc (1) + acc (17) = acc (9) + acc (18) = acc (6) + acc (19) = acc (11) + acc (20) = acc (6) + + occ (1) = 1. + occ (2) = 2. + occ (3) = 1. + + do i = 1, 3 + do k = 1, 10 + acco (i, k) = occ (i) * gamma (6 + acc (2 * k - 1) - i) * gamma (acc (2 * k) + i - 1) / & + (exp ((6 + acc (2 * k - 1) - i) / (acc (2 * k - 1) + 3) * log (act (2 * k - 1))) * & + exp ((acc (2 * k) + i - 1) / (acc (2 * k) + 3) * log (act (2 * k)))) * & + exp ((i - 3) * log (ace (2 * k - 1))) * exp ((4 - i) * log (ace (2 * k))) + enddo + enddo + + ! ----------------------------------------------------------------------- + ! rain evaporation, snow sublimation, and graupel or hail sublimation, Lin et al. (1983) + ! ----------------------------------------------------------------------- + + crevp (1) = 2. * pi * vdifu * tcond * rvgas * n0r_sig * gamma (1 + mur) / & + exp ((1 + mur) / (mur + 3) * log (normr)) * exp (2.0 * log (expor)) + crevp (2) = 0.78 + crevp (3) = 0.31 * scm3 * sqrt (alinr / visk) * gamma ((3 + 2 * mur + blinr) / 2) / & + exp ((3 + 2 * mur + blinr) / (mur + 3) / 2 * log (normr)) * & + exp ((1 + mur) / (mur + 3) * log (normr)) / gamma (1 + mur) * & + exp ((- 1 - blinr) / 2. * log (expor)) + crevp (4) = tcond * rvgas + crevp (5) = vdifu + + cssub (1) = 2. * pi * vdifu * tcond * rvgas * n0s_sig * gamma (1 + mus) / & + exp ((1 + mus) / (mus + 3) * log (norms)) * exp (2.0 * log (expos)) + cssub (2) = 0.78 + cssub (3) = 0.31 * scm3 * sqrt (alins / visk) * gamma ((3 + 2 * mus + blins) / 2) / & + exp ((3 + 2 * mus + blins) / (mus + 3) / 2 * log (norms)) * & + exp ((1 + mus) / (mus + 3) * log (norms)) / gamma (1 + mus) * & + exp ((- 1 - blins) / 2. * log (expos)) + cssub (4) = tcond * rvgas + cssub (5) = vdifu + + if (do_hail) then + cgsub (1) = 2. * pi * vdifu * tcond * rvgas * n0h_sig * gamma (1 + muh) / & + exp ((1 + muh) / (muh + 3) * log (normh)) * exp (2.0 * log (expoh)) + cgsub (2) = 0.78 + cgsub (3) = 0.31 * scm3 * sqrt (alinh * hcon / visk) * gamma ((3 + 2 * muh + blinh) / 2) / & + exp (1. / (muh + 3) * (3 + 2 * muh + blinh) / 2 * log (normh)) * & + exp (1. / (muh + 3) * (1 + muh) * log (normh)) / gamma (1 + muh) * & + exp ((- 1 - blinh) / 2. * log (expoh)) + else + cgsub (1) = 2. * pi * vdifu * tcond * rvgas * n0g_sig * gamma (1 + mug) / & + exp ((1 + mug) / (mug + 3) * log (normg)) * exp (2.0 * log (expog)) + cgsub (2) = 0.78 + cgsub (3) = 0.31 * scm3 * sqrt (aling * gcon / visk) * gamma ((3 + 2 * mug + bling) / 2) / & + exp ((3 + 2 * mug + bling) / (mug + 3) / 2 * log (normg)) * & + exp ((1 + mug) / (mug + 3) * log (normg)) / gamma (1 + mug) * & + exp ((- 1 - bling) / 2. * log (expog)) + endif + cgsub (4) = tcond * rvgas + cgsub (5) = vdifu + + ! ----------------------------------------------------------------------- + ! snow melting, Lin et al. (1983) + ! ----------------------------------------------------------------------- + + csmlt (1) = 2. * pi * tcond * n0s_sig * gamma (1 + mus) / & + exp ((1 + mus) / (mus + 3) * log (norms)) * exp (2.0 * log (expos)) + csmlt (2) = 2. * pi * vdifu * n0s_sig * gamma (1 + mus) / & + exp ((1 + mus) / (mus + 3) * log (norms)) * exp (2.0 * log (expos)) + csmlt (3) = cssub (2) + csmlt (4) = cssub (3) + + ! ----------------------------------------------------------------------- + ! graupel or hail melting, Lin et al. (1983) + ! ----------------------------------------------------------------------- + + if (do_hail) then + cgmlt (1) = 2. * pi * tcond * n0h_sig * gamma (1 + muh) / & + exp ((1 + muh) / (muh + 3) * log (normh)) * exp (2.0 * log (expoh)) + cgmlt (2) = 2. * pi * vdifu * n0h_sig * gamma (1 + muh) / & + exp ((1 + muh) / (muh + 3) * log (normh)) * exp (2.0 * log (expoh)) + else + cgmlt (1) = 2. * pi * tcond * n0g_sig * gamma (1 + mug) / & + exp ((1 + mug) / (mug + 3) * log (normg)) * exp (2.0 * log (expog)) + cgmlt (2) = 2. * pi * vdifu * n0g_sig * gamma (1 + mug) / & + exp ((1 + mug) / (mug + 3) * log (normg)) * exp (2.0 * log (expog)) + endif + cgmlt (3) = cgsub (2) + cgmlt (4) = cgsub (3) + + ! ----------------------------------------------------------------------- + ! rain freezing, Lin et al. (1983) + ! ----------------------------------------------------------------------- + + cgfr (1) = 1.e2 / 36 * pisq * n0r_sig * rhor * gamma (6 + mur) / & + exp ((6 + mur) / (mur + 3) * log (normr)) * exp (- 3.0 * log (expor)) + cgfr (2) = 0.66 + +end subroutine setup_mp + +! ======================================================================= +! define various heat capacities and latent heat coefficients at 0 deg K +! ======================================================================= + +subroutine setup_mhc_lhc (hydrostatic) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + logical, intent (in) :: hydrostatic + + if (hydrostatic) then + c_air = cp_air + c_vap = cp_vap + do_sedi_w = .false. + else + c_air = cv_air + c_vap = cv_vap + endif + d0_vap = c_vap - c_liq + + ! scaled constants (to reduce float point errors for 32-bit) + + d1_vap = d0_vap / c_air + d1_ice = dc_ice / c_air + + lv00 = (hlv - d0_vap * tice) / c_air + li00 = (hlf - dc_ice * tice) / c_air + li20 = lv00 + li00 + + c1_vap = c_vap / c_air + c1_liq = c_liq / c_air + c1_ice = c_ice / c_air + +end subroutine setup_mhc_lhc + +! ======================================================================= +! major cloud microphysics driver +! ======================================================================= + +subroutine mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, & + qa, qnl, qni, delz, is, ie, ks, ke, dtm, water, rain, ice, snow, graupel, & + gsize, hs, q_con, cappa, consv_te, adj_vmr, te, dte, prefluxw, prefluxr, & + prefluxi, prefluxs, prefluxg, last_step, do_inline_mp, do_mp_fast, do_mp_full) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: is, ie, ks, ke + + logical, intent (in) :: hydrostatic, last_step, consv_te, do_inline_mp + logical, intent (in) :: do_mp_fast, do_mp_full + + real(kind_phys), intent (in) :: dtm + + real(kind_phys), intent (in), dimension (is:ie) :: gsize, hs + + real(kind_phys), intent (in), dimension (is:ie, ks:ke) :: qnl, qni + + real(kind_phys), intent (inout), dimension (is:ie, ks:ke) :: delp, delz, pt, ua, va, wa + real(kind_phys), intent (inout), dimension (is:ie, ks:ke) :: qv, ql, qr, qi, qs, qg, qa + real(kind_phys), intent (inout), dimension (is:ie, ks:ke) :: prefluxw, prefluxr, prefluxi, prefluxs, prefluxg + + real(kind_phys), intent (inout), dimension (is:, ks:) :: q_con, cappa + + real(kind_phys), intent (inout), dimension (is:ie) :: water, rain, ice, snow, graupel + + real(kind_phys), intent (out), dimension (is:ie, ks:ke) :: te, adj_vmr + + real (kind = r8), intent (out), dimension (is:ie) :: dte + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: i, k + + real(kind_phys) :: rh_adj, rh_rain, ccn0, cin0, cond, q1, q2 + real(kind_phys) :: convt, dts, q_cond, t_lnd, t_ocn, h_var, tmp, nl, ni + + real(kind_phys), dimension (ks:ke) :: q_liq, q_sol, dp, dz, dp0 + real(kind_phys), dimension (ks:ke) :: qvz, qlz, qrz, qiz, qsz, qgz, qaz + real(kind_phys), dimension (ks:ke) :: den, pz, denfac, ccn, cin + real(kind_phys), dimension (ks:ke) :: u, v, w + + real(kind_phys), dimension (is:ie, ks:ke) :: pcw, edw, oew, rrw, tvw + real(kind_phys), dimension (is:ie, ks:ke) :: pci, edi, oei, rri, tvi + real(kind_phys), dimension (is:ie, ks:ke) :: pcr, edr, oer, rrr, tvr + real(kind_phys), dimension (is:ie, ks:ke) :: pcs, eds, oes, rrs, tvs + real(kind_phys), dimension (is:ie, ks:ke) :: pcg, edg, oeg, rrg, tvg + + real(kind_phys), dimension (is:ie) :: condensation, deposition + real(kind_phys), dimension (is:ie) :: evaporation, sublimation + + real (kind = r8) :: con_r8, c8, cp8 + + real (kind = r8), dimension (is:ie, ks:ke) :: te_beg_d, te_end_d, tw_beg_d, tw_end_d + real (kind = r8), dimension (is:ie, ks:ke) :: te_beg_m, te_end_m, tw_beg_m, tw_end_m + + real (kind = r8), dimension (is:ie) :: te_b_beg_d, te_b_end_d, tw_b_beg_d, tw_b_end_d, te_loss + real (kind = r8), dimension (is:ie) :: te_b_beg_m, te_b_end_m, tw_b_beg_m, tw_b_end_m + + real (kind = r8), dimension (ks:ke) :: tz, tzuv, tzw + + ! ----------------------------------------------------------------------- + ! time steps + ! ----------------------------------------------------------------------- + + ntimes = max (ntimes, int (dtm / min (dtm, mp_time))) + dts = dtm / real (ntimes, kind=kind_phys) + + ! ----------------------------------------------------------------------- + ! initialization of total energy difference and condensation diag + ! ----------------------------------------------------------------------- + + dte = 0.0 + cond = 0.0 + adj_vmr = 1.0 + + condensation = 0.0 + deposition = 0.0 + evaporation = 0.0 + sublimation = 0.0 + + ! ----------------------------------------------------------------------- + ! unit convert to mm/day + ! ----------------------------------------------------------------------- + + convt = 86400. * rgrav / dtm + + do i = is, ie + + ! ----------------------------------------------------------------------- + ! conversion of temperature + ! ----------------------------------------------------------------------- + + if (do_inline_mp) then + do k = ks, ke + q_cond = ql (i, k) + qr (i, k) + qi (i, k) + qs (i, k) + qg (i, k) + tz (k) = pt (i, k) / ((1. + zvir * qv (i, k)) * (1. - q_cond)) + enddo + else + do k = ks, ke + tz (k) = pt (i, k) + enddo + endif + + ! ----------------------------------------------------------------------- + ! calculate base total energy + ! ----------------------------------------------------------------------- + + if (consv_te) then + if (hydrostatic) then + do k = ks, ke + te (i, k) = - c_air * tz (k) * delp (i, k) + enddo + else + do k = ks, ke + te (i, k) = - mte (qv (i, k), ql (i, k), qr (i, k), qi (i, k), & + qs (i, k), qg (i, k), tz (k), delp (i, k), .true.) * grav + enddo + endif + endif + + ! ----------------------------------------------------------------------- + ! total energy checker + ! ----------------------------------------------------------------------- + + if (consv_checker) then + call mtetw (ks, ke, qv (i, :), ql (i, :), qr (i, :), qi (i, :), & + qs (i, :), qg (i, :), tz, ua (i, :), va (i, :), wa (i, :), & + delp (i, :), dte (i), 0.0, water (i), rain (i), ice (i), & + snow (i), graupel (i), 0.0, 0.0, dtm, te_beg_m (i, :), & + tw_beg_m (i, :), te_b_beg_m (i), tw_b_beg_m (i), .true., hydrostatic) + endif + + do k = ks, ke + + ! ----------------------------------------------------------------------- + ! convert specific ratios to mass mixing ratios + ! ----------------------------------------------------------------------- + + qvz (k) = qv (i, k) + qlz (k) = ql (i, k) + qrz (k) = qr (i, k) + qiz (k) = qi (i, k) + qsz (k) = qs (i, k) + qgz (k) = qg (i, k) + qaz (k) = qa (i, k) + + if (do_inline_mp) then + q_cond = qlz (k) + qrz (k) + qiz (k) + qsz (k) + qgz (k) + con_r8 = one_r8 - (qvz (k) + q_cond) + else + con_r8 = one_r8 - qvz (k) + endif + + dp0 (k) = delp (i, k) + dp (k) = delp (i, k) * con_r8 + con_r8 = one_r8 / con_r8 + qvz (k) = qvz (k) * con_r8 + qlz (k) = qlz (k) * con_r8 + qrz (k) = qrz (k) * con_r8 + qiz (k) = qiz (k) * con_r8 + qsz (k) = qsz (k) * con_r8 + qgz (k) = qgz (k) * con_r8 + + ! ----------------------------------------------------------------------- + ! dry air density and layer-mean pressure thickness + ! ----------------------------------------------------------------------- + + dz (k) = delz (i, k) + den (k) = - dp (k) / (grav * dz (k)) + pz (k) = den (k) * rdgas * tz (k) + + ! ----------------------------------------------------------------------- + ! for sedi_momentum transport + ! ----------------------------------------------------------------------- + + u (k) = ua (i, k) + v (k) = va (i, k) + if (.not. hydrostatic) then + w (k) = wa (i, k) + endif + + enddo + + do k = ks, ke + denfac (k) = sqrt (den (ke) / den (k)) + enddo + + ! ----------------------------------------------------------------------- + ! total energy checker + ! ----------------------------------------------------------------------- + + if (consv_checker) then + call mtetw (ks, ke, qvz, qlz, qrz, qiz, qsz, qgz, tz, u, v, w, & + dp, dte (i), 0.0, water (i), rain (i), ice (i), snow (i), & + graupel (i), 0.0, 0.0, dtm, te_beg_d (i, :), tw_beg_d (i, :), & + te_b_beg_d (i), tw_b_beg_d (i), .false., hydrostatic) + endif + + ! ----------------------------------------------------------------------- + ! cloud condensation nuclei (CCN), cloud ice nuclei (CIN) + ! ----------------------------------------------------------------------- + + if (prog_ccn) then + do k = ks, ke + ! boucher and lohmann (1995) + nl = min (1., abs (hs (i)) / (10. * grav)) * & + (10. ** 2.24 * (qnl (i, k) * den (k) * 1.e9) ** 0.257) + & + (1. - min (1., abs (hs (i)) / (10. * grav))) * & + (10. ** 2.06 * (qnl (i, k) * den (k) * 1.e9) ** 0.48) + ni = qni (i, k) + ccn (k) = max (10.0, nl) * 1.e6 + cin (k) = max (10.0, ni) * 1.e6 + ccn (k) = ccn (k) / den (k) + cin (k) = cin (k) / den (k) + enddo + else + ccn0 = (ccn_l * min (1., abs (hs (i)) / (10. * grav)) + & + ccn_o * (1. - min (1., abs (hs (i)) / (10. * grav)))) * 1.e6 + cin0 = 0.0 + do k = ks, ke + ccn (k) = ccn0 / den (k) + cin (k) = cin0 / den (k) + enddo + endif + + ! ----------------------------------------------------------------------- + ! subgrid deviation in horizontal direction + ! default area dependent form: use dx ~ 100 km as the base + ! ----------------------------------------------------------------------- + + t_lnd = dw_land * sqrt (gsize (i) / 1.e5) + t_ocn = dw_ocean * sqrt (gsize (i) / 1.e5) + tmp = min (1., abs (hs (i)) / (10. * grav)) + h_var = t_lnd * tmp + t_ocn * (1. - tmp) + h_var = min (0.20, max (0.01, h_var)) + + ! ----------------------------------------------------------------------- + ! relative humidity thresholds + ! ----------------------------------------------------------------------- + + rh_adj = 1. - h_var - rh_inc + rh_rain = max (0.35, rh_adj - rh_inr) + + ! ----------------------------------------------------------------------- + ! fix negative water species from outside + ! ----------------------------------------------------------------------- + + if (fix_negative) & + call neg_adj (ks, ke, tz, dp, qvz, qlz, qrz, qiz, qsz, qgz, cond) + + condensation (i) = condensation (i) + cond * convt + + ! ----------------------------------------------------------------------- + ! fast microphysics loop + ! ----------------------------------------------------------------------- + + if (do_mp_fast) then + + call mp_fast (ks, ke, tz, qvz, qlz, qrz, qiz, qsz, qgz, dtm, dp, den, & + ccn, cin, condensation (i), deposition (i), evaporation (i), & + sublimation (i), denfac, convt, last_step) + + endif + + ! ----------------------------------------------------------------------- + ! full microphysics loop + ! ----------------------------------------------------------------------- + + if (do_mp_full) then + + call mp_full (ks, ke, ntimes, tz, qvz, qlz, qrz, qiz, qsz, qgz, dp, dz, & + u, v, w, den, denfac, ccn, cin, dts, rh_adj, rh_rain, h_var, dte (i), & + water (i), rain (i), ice (i), snow (i), graupel (i), prefluxw (i, :), & + prefluxr (i, :), prefluxi (i, :), prefluxs (i, :), prefluxg (i, :), & + condensation (i), deposition (i), evaporation (i), sublimation (i), & + convt, last_step) + + endif + + ! ----------------------------------------------------------------------- + ! cloud fraction diagnostic + ! ----------------------------------------------------------------------- + + if (do_qa .and. last_step) then + call cloud_fraction (ks, ke, pz, den, qvz, qlz, qrz, qiz, qsz, qgz, qaz, & + tz, h_var, gsize (i)) + endif + + ! ======================================================================= + ! calculation of particle concentration (pc), effective diameter (ed), + ! optical extinction (oe), radar reflectivity factor (rr), and + ! mass-weighted terminal velocity (tv) + ! ======================================================================= + + pcw (i, :) = 0.0 + edw (i, :) = 0.0 + oew (i, :) = 0.0 + rrw (i, :) = 0.0 + tvw (i, :) = 0.0 + pci (i, :) = 0.0 + edi (i, :) = 0.0 + oei (i, :) = 0.0 + rri (i, :) = 0.0 + tvi (i, :) = 0.0 + pcr (i, :) = 0.0 + edr (i, :) = 0.0 + oer (i, :) = 0.0 + rrr (i, :) = 0.0 + tvr (i, :) = 0.0 + pcs (i, :) = 0.0 + eds (i, :) = 0.0 + oes (i, :) = 0.0 + rrs (i, :) = 0.0 + tvs (i, :) = 0.0 + pcg (i, :) = 0.0 + edg (i, :) = 0.0 + oeg (i, :) = 0.0 + rrg (i, :) = 0.0 + tvg (i, :) = 0.0 + + do k = ks, ke + if (qlz (k) .gt. qcmin) then + call cal_pc_ed_oe_rr_tv (qlz (k), den (k), blinw, muw, pcaw, pcbw, pcw (i, k), & + edaw, edbw, edw (i, k), oeaw, oebw, oew (i, k), rraw, rrbw, rrw (i, k), & + tvaw, tvbw, tvw (i, k)) + endif + if (qiz (k) .gt. qcmin) then + call cal_pc_ed_oe_rr_tv (qiz (k), den (k), blini, mui, pcai, pcbi, pci (i, k), & + edai, edbi, edi (i, k), oeai, oebi, oei (i, k), rrai, rrbi, rri (i, k), & + tvai, tvbi, tvi (i, k)) + endif + if (qrz (k) .gt. qcmin) then + call cal_pc_ed_oe_rr_tv (qrz (k), den (k), blinr, mur, pcar, pcbr, pcr (i, k), & + edar, edbr, edr (i, k), oear, oebr, oer (i, k), rrar, rrbr, rrr (i, k), & + tvar, tvbr, tvr (i, k)) + endif + if (qsz (k) .gt. qcmin) then + call cal_pc_ed_oe_rr_tv (qsz (k), den (k), blins, mus, pcas, pcbs, pcs (i, k), & + edas, edbs, eds (i, k), oeas, oebs, oes (i, k), rras, rrbs, rrs (i, k), & + tvas, tvbs, tvs (i, k)) + endif + if (do_hail) then + if (qgz (k) .gt. qcmin) then + call cal_pc_ed_oe_rr_tv (qgz (k), den (k), blinh, muh, pcah, pcbh, pcg (i, k), & + edah, edbh, edg (i, k), oeah, oebh, oeg (i, k), rrah, rrbh, rrg (i, k), & + tvah, tvbh, tvg (i, k)) + endif + else + if (qgz (k) .gt. qcmin) then + call cal_pc_ed_oe_rr_tv (qgz (k), den (k), bling, mug, pcag, pcbg, pcg (i, k), & + edag, edbg, edg (i, k), oeag, oebg, oeg (i, k), rrag, rrbg, rrg (i, k), & + tvag, tvbg, tvg (i, k)) + endif + endif + enddo + + ! ----------------------------------------------------------------------- + ! momentum transportation during sedimentation + ! update temperature before delp and q update + ! ----------------------------------------------------------------------- + + if (do_sedi_uv) then + do k = ks, ke + c8 = mhc (qvz (k), qlz (k), qrz (k), qiz (k), qsz (k), qgz (k)) * c_air + tzuv (k) = 0.5 * (ua (i, k) ** 2 + va (i, k) ** 2 - (u (k) ** 2 + v (k) ** 2)) / c8 + tz (k) = tz (k) + tzuv (k) + enddo + endif + + if (do_sedi_w) then + do k = ks, ke + c8 = mhc (qvz (k), qlz (k), qrz (k), qiz (k), qsz (k), qgz (k)) * c_air + tzw (k) = 0.5 * (wa (i, k) ** 2 - w (k) ** 2) / c8 + tz (k) = tz (k) + tzw (k) + enddo + endif + + ! ----------------------------------------------------------------------- + ! total energy checker + ! ----------------------------------------------------------------------- + + if (consv_checker) then + call mtetw (ks, ke, qvz, qlz, qrz, qiz, qsz, qgz, tz, u, v, w, & + dp, dte (i), 0.0, water (i), rain (i), ice (i), snow (i), & + graupel (i), 0.0, 0.0, dtm, te_end_d (i, :), tw_end_d (i, :), & + te_b_end_d (i), tw_b_end_d (i), .false., hydrostatic, te_loss (i)) + endif + + do k = ks, ke + + ! ----------------------------------------------------------------------- + ! convert mass mixing ratios back to specific ratios + ! ----------------------------------------------------------------------- + + if (do_inline_mp) then + q_cond = qlz (k) + qrz (k) + qiz (k) + qsz (k) + qgz (k) + con_r8 = one_r8 + qvz (k) + q_cond + else + con_r8 = one_r8 + qvz (k) + endif + + delp (i, k) = dp (k) * con_r8 + con_r8 = one_r8 / con_r8 + qvz (k) = qvz (k) * con_r8 + qlz (k) = qlz (k) * con_r8 + qrz (k) = qrz (k) * con_r8 + qiz (k) = qiz (k) * con_r8 + qsz (k) = qsz (k) * con_r8 + qgz (k) = qgz (k) * con_r8 + + q1 = qv (i, k) + ql (i, k) + qr (i, k) + qi (i, k) + qs (i, k) + qg (i, k) + q2 = qvz (k) + qlz (k) + qrz (k) + qiz (k) + qsz (k) + qgz (k) + adj_vmr (i, k) = ((one_r8 - q1) / (one_r8 - q2)) / (one_r8 + q2 - q1) + + qv (i, k) = qvz (k) + ql (i, k) = qlz (k) + qr (i, k) = qrz (k) + qi (i, k) = qiz (k) + qs (i, k) = qsz (k) + qg (i, k) = qgz (k) + qa (i, k) = qaz (k) + + ! ----------------------------------------------------------------------- + ! calculate some more variables needed outside + ! ----------------------------------------------------------------------- + + q_liq (k) = qlz (k) + qrz (k) + q_sol (k) = qiz (k) + qsz (k) + qgz (k) + q_cond = q_liq (k) + q_sol (k) + con_r8 = one_r8 - (qvz (k) + q_cond) + c8 = mhc (con_r8, qvz (k), q_liq (k), q_sol (k)) * c_air + +#ifdef USE_COND + q_con (i, k) = q_cond +#endif +#ifdef MOIST_CAPPA + tmp = rdgas * (1. + zvir * qvz (k)) + cappa (i, k) = tmp / (tmp + c8) +#endif + + enddo + + ! ----------------------------------------------------------------------- + ! momentum transportation during sedimentation + ! update temperature after delp and q update + ! ----------------------------------------------------------------------- + + if (do_sedi_uv) then + do k = ks, ke + tz (k) = tz (k) - tzuv (k) + q_liq (k) = qlz (k) + qrz (k) + q_sol (k) = qiz (k) + qsz (k) + qgz (k) + q_cond = q_liq (k) + q_sol (k) + con_r8 = one_r8 - (qvz (k) + q_cond) + c8 = mhc (con_r8, qvz (k), q_liq (k), q_sol (k)) * c_air + tzuv (k) = (0.5 * (ua (i, k) ** 2 + va (i, k) ** 2) * dp0 (k) - & + 0.5 * (u (k) ** 2 + v (k) ** 2) * delp (i, k)) / c8 / delp (i, k) + tz (k) = tz (k) + tzuv (k) + enddo + do k = ks, ke + ua (i, k) = u (k) + va (i, k) = v (k) + enddo + endif + + if (do_sedi_w) then + do k = ks, ke + tz (k) = tz (k) - tzw (k) + q_liq (k) = qlz (k) + qrz (k) + q_sol (k) = qiz (k) + qsz (k) + qgz (k) + q_cond = q_liq (k) + q_sol (k) + con_r8 = one_r8 - (qvz (k) + q_cond) + c8 = mhc (con_r8, qvz (k), q_liq (k), q_sol (k)) * c_air + tzw (k) = (0.5 * (wa (i, k) ** 2) * dp0 (k) - & + 0.5 * (w (k) ** 2) * delp (i, k)) / c8 / delp (i, k) + tz (k) = tz (k) + tzw (k) + enddo + do k = ks, ke + wa (i, k) = w (k) + enddo + endif + + ! ----------------------------------------------------------------------- + ! total energy checker + ! ----------------------------------------------------------------------- + + if (consv_checker) then + call mtetw (ks, ke, qv (i, :), ql (i, :), qr (i, :), qi (i, :), & + qs (i, :), qg (i, :), tz, ua (i, :), va (i, :), wa (i, :), & + delp (i, :), dte (i), 0.0, water (i), rain (i), ice (i), & + snow (i), graupel (i), 0.0, 0.0, dtm, te_end_m (i, :), & + tw_end_m (i, :), te_b_end_m (i), tw_b_end_m (i), .true., hydrostatic) + endif + + ! ----------------------------------------------------------------------- + ! calculate total energy loss or gain + ! ----------------------------------------------------------------------- + + if (consv_te) then + if (hydrostatic) then + do k = ks, ke + te (i, k) = te (i, k) + c_air * tz (k) * delp (i, k) + enddo + else + do k = ks, ke + te (i, k) = te (i, k) + mte (qv (i, k), ql (i, k), qr (i, k), qi (i, k), & + qs (i, k), qg (i, k), tz (k), delp (i, k), .true.) * grav + enddo + endif + endif + + ! ----------------------------------------------------------------------- + ! conversion of temperature + ! ----------------------------------------------------------------------- + + if (do_inline_mp) then + do k = ks, ke + q_cond = qlz (k) + qrz (k) + qiz (k) + qsz (k) + qgz (k) + if (cp_heating) then + con_r8 = one_r8 - (qvz (k) + q_cond) + c8 = mhc (con_r8, qvz (k), q_liq (k), q_sol (k)) * c_air + cp8 = con_r8 * cp_air + qvz (k) * cp_vap + q_liq (k) * c_liq + q_sol (k) * c_ice + delz (i, k) = delz (i, k) / pt (i, k) + pt (i, k) = pt (i, k) + (tz (k) * ((1. + zvir * qvz (k)) * (1. - q_cond)) - pt (i, k)) * c8 / cp8 + delz (i, k) = delz (i, k) * pt (i, k) + else + pt (i, k) = tz (k) * ((1. + zvir * qvz (k)) * (1. - q_cond)) + endif + enddo + else + do k = ks, ke + q_liq (k) = qlz (k) + qrz (k) + q_sol (k) = qiz (k) + qsz (k) + qgz (k) + q_cond = q_liq (k) + q_sol (k) + con_r8 = one_r8 - (qvz (k) + q_cond) + c8 = mhc (con_r8, qvz (k), q_liq (k), q_sol (k)) * c_air + pt (i, k) = pt (i, k) + (tz (k) - pt (i, k)) * c8 / cp_air + enddo + endif + + ! ----------------------------------------------------------------------- + ! total energy checker + ! ----------------------------------------------------------------------- + + if (consv_checker) then + if (abs (sum (te_end_d (i, :)) + te_b_end_d (i) - sum (te_beg_d (i, :)) - te_b_beg_d (i)) / & + (sum (te_beg_d (i, :)) + te_b_beg_d (i)) .gt. te_err) then + print*, "GFDL-MP-DRY TE: ", & + !(sum (te_beg_d (i, :)) + te_b_beg_d (i)), & + !(sum (te_end_d (i, :)) + te_b_end_d (i)), & + (sum (te_end_d (i, :)) + te_b_end_d (i) - sum (te_beg_d (i, :)) - te_b_beg_d (i)) / & + (sum (te_beg_d (i, :)) + te_b_beg_d (i)) + endif + if (abs (sum (tw_end_d (i, :)) + tw_b_end_d (i) - sum (tw_beg_d (i, :)) - tw_b_beg_d (i)) / & + (sum (tw_beg_d (i, :)) + tw_b_beg_d (i)) .gt. tw_err) then + print*, "GFDL-MP-DRY TW: ", & + !(sum (tw_beg_d (i, :)) + tw_b_beg_d (i)), & + !(sum (tw_end_d (i, :)) + tw_b_end_d (i)), & + (sum (tw_end_d (i, :)) + tw_b_end_d (i) - sum (tw_beg_d (i, :)) - tw_b_beg_d (i)) / & + (sum (tw_beg_d (i, :)) + tw_b_beg_d (i)) + endif + !print*, "GFDL MP TE DRY LOSS (%) : ", te_loss (i) / (sum (te_beg_d (i, :)) + te_b_beg_d (i)) * 100.0 + if (abs (sum (te_end_m (i, :)) + te_b_end_m (i) - sum (te_beg_m (i, :)) - te_b_beg_m (i)) / & + (sum (te_beg_m (i, :)) + te_b_beg_m (i)) .gt. te_err) then + print*, "GFDL-MP-WET TE: ", & + !(sum (te_beg_m (i, :)) + te_b_beg_m (i)), & + !(sum (te_end_m (i, :)) + te_b_end_m (i)), & + (sum (te_end_m (i, :)) + te_b_end_m (i) - sum (te_beg_m (i, :)) - te_b_beg_m (i)) / & + (sum (te_beg_m (i, :)) + te_b_beg_m (i)) + endif + if (abs (sum (tw_end_m (i, :)) + tw_b_end_m (i) - sum (tw_beg_m (i, :)) - tw_b_beg_m (i)) / & + (sum (tw_beg_m (i, :)) + tw_b_beg_m (i)) .gt. tw_err) then + print*, "GFDL-MP-WET TW: ", & + !(sum (tw_beg_m (i, :)) + tw_b_beg_m (i)), & + !(sum (tw_end_m (i, :)) + tw_b_end_m (i)), & + (sum (tw_end_m (i, :)) + tw_b_end_m (i) - sum (tw_beg_m (i, :)) - tw_b_beg_m (i)) / & + (sum (tw_beg_m (i, :)) + tw_b_beg_m (i)) + endif + !print*, "GFDL MP TE WET LOSS (%) : ", te_loss_0 (i) / (sum (te_beg_m (i, :)) + te_b_beg_m (i)) * 100.0 + endif + + enddo ! i loop + +end subroutine mpdrv + +! ======================================================================= +! fix negative water species +! ======================================================================= + +subroutine neg_adj (ks, ke, tz, dp, qv, ql, qr, qi, qs, qg, cond) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in), dimension (ks:ke) :: dp + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + + real(kind_phys), intent (out) :: cond + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: dq, sink + + real(kind_phys), dimension (ks:ke) :: q_liq, q_sol, lcpk, icpk, tcpk, tcp3 + + real (kind = r8), dimension (ks:ke) :: cvm, te8 + + ! ----------------------------------------------------------------------- + ! initialization + ! ----------------------------------------------------------------------- + + cond = 0 + + ! ----------------------------------------------------------------------- + ! calculate moist heat capacity and latent heat coefficients + ! ----------------------------------------------------------------------- + + call cal_mhc_lhc (ks, ke, qv, ql, qr, qi, qs, qg, q_liq, q_sol, cvm, te8, tz, & + lcpk, icpk, tcpk, tcp3) + + do k = ks, ke + + ! ----------------------------------------------------------------------- + ! fix negative solid-phase hydrometeors + ! ----------------------------------------------------------------------- + + ! if cloud ice < 0, borrow from snow + if (qi (k) .lt. 0.) then + sink = min (- qi (k), max (0., qs (k))) + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., 0., sink, - sink, 0.) + endif + + ! if snow < 0, borrow from graupel + if (qs (k) .lt. 0.) then + sink = min (- qs (k), max (0., qg (k))) + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., 0., 0., sink, - sink) + endif + + ! if graupel < 0, borrow from rain + if (qg (k) .lt. 0.) then + sink = min (- qg (k), max (0., qr (k))) + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., - sink, 0., 0., sink, te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + endif + + ! ----------------------------------------------------------------------- + ! fix negative liquid-phase hydrometeors + ! ----------------------------------------------------------------------- + + ! if rain < 0, borrow from cloud water + if (qr (k) .lt. 0.) then + sink = min (- qr (k), max (0., ql (k))) + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., - sink, sink, 0., 0., 0.) + endif + + ! if cloud water < 0, borrow from water vapor + if (ql (k) .lt. 0.) then + sink = min (- ql (k), max (0., qv (k))) + cond = cond + sink * dp (k) + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + - sink, sink, 0., 0., 0., 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + endif + + enddo + + ! ----------------------------------------------------------------------- + ! fix negative water vapor + ! ----------------------------------------------------------------------- + + ! if water vapor < 0, borrow water vapor from below + do k = ks, ke - 1 + if (qv (k) .lt. 0.) then + qv (k + 1) = qv (k + 1) + qv (k) * dp (k) / dp (k + 1) + qv (k) = 0. + endif + enddo + + ! if water vapor < 0, borrow water vapor from above + if (qv (ke) .lt. 0. .and. qv (ke - 1) .gt. 0.) then + dq = min (- qv (ke) * dp (ke), qv (ke - 1) * dp (ke - 1)) + qv (ke - 1) = qv (ke - 1) - dq / dp (ke - 1) + qv (ke) = qv (ke) + dq / dp (ke) + endif + +end subroutine neg_adj + +! ======================================================================= +! full microphysics loop +! ======================================================================= + +subroutine mp_full (ks, ke, ntimes, tz, qv, ql, qr, qi, qs, qg, dp, dz, u, v, w, & + den, denfac, ccn, cin, dts, rh_adj, rh_rain, h_var, dte, water, rain, ice, & + snow, graupel, prefluxw, prefluxr, prefluxi, prefluxs, prefluxg, & + condensation, deposition, evaporation, sublimation, convt, last_step) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + logical, intent (in) :: last_step + + integer, intent (in) :: ks, ke, ntimes + + real(kind_phys), intent (in) :: dts, rh_adj, rh_rain, h_var, convt + + real(kind_phys), intent (in), dimension (ks:ke) :: dp, dz, den, denfac + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, u, v, w, ccn, cin + real(kind_phys), intent (inout), dimension (ks:ke) :: prefluxw, prefluxr, prefluxi, prefluxs, prefluxg + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + real(kind_phys), intent (inout) :: water, rain, ice, snow, graupel + real(kind_phys), intent (inout) :: condensation, deposition + real(kind_phys), intent (inout) :: evaporation, sublimation + + real (kind = r8), intent (inout) :: dte + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: n + + real(kind_phys) :: w1, r1, i1, s1, g1, cond, dep, reevap, sub + + real(kind_phys), dimension (ks:ke) :: vtw, vtr, vti, vts, vtg, pfw, pfr, pfi, pfs, pfg + + do n = 1, ntimes + + ! ----------------------------------------------------------------------- + ! sedimentation of cloud ice, snow, graupel or hail, and rain + ! ----------------------------------------------------------------------- + + call sedimentation (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, & + dz, dp, vtw, vtr, vti, vts, vtg, w1, r1, i1, s1, g1, pfw, pfr, pfi, pfs, pfg, & + u, v, w, den, denfac, dte) + + water = water + w1 * convt + rain = rain + r1 * convt + ice = ice + i1 * convt + snow = snow + s1 * convt + graupel = graupel + g1 * convt + + prefluxw = prefluxw + pfw * convt + prefluxr = prefluxr + pfr * convt + prefluxi = prefluxi + pfi * convt + prefluxs = prefluxs + pfs * convt + prefluxg = prefluxg + pfg * convt + + ! ----------------------------------------------------------------------- + ! warm rain cloud microphysics + ! ----------------------------------------------------------------------- + + call warm_rain (dts, ks, ke, dp, dz, tz, qv, ql, qr, qi, qs, qg, & + den, denfac, vtw, vtr, ccn, rh_rain, h_var, reevap) + + evaporation = evaporation + reevap * convt + + ! ----------------------------------------------------------------------- + ! ice cloud microphysics + ! ----------------------------------------------------------------------- + + call ice_cloud (ks, ke, tz, qv, ql, qr, qi, qs, qg, den, & + denfac, vtw, vtr, vti, vts, vtg, dts, h_var) + + if (do_subgrid_proc) then + + ! ----------------------------------------------------------------------- + ! temperature sentive high vertical resolution processes + ! ----------------------------------------------------------------------- + + call subgrid_z_proc (ks, ke, den, denfac, dts, rh_adj, tz, qv, ql, & + qr, qi, qs, qg, dp, ccn, cin, cond, dep, reevap, sub, last_step) + + condensation = condensation + cond * convt + deposition = deposition + dep * convt + evaporation = evaporation + reevap * convt + sublimation = sublimation + sub * convt + + endif + + enddo + +end subroutine mp_full + +! ======================================================================= +! fast microphysics loop +! ======================================================================= + +subroutine mp_fast (ks, ke, tz, qv, ql, qr, qi, qs, qg, dtm, dp, den, & + ccn, cin, condensation, deposition, evaporation, sublimation, & + denfac, convt, last_step) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + logical, intent (in) :: last_step + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dtm, convt + + real(kind_phys), intent (in), dimension (ks:ke) :: dp, den, denfac + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, ccn, cin + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + real(kind_phys), intent (inout) :: condensation, deposition + real(kind_phys), intent (inout) :: evaporation, sublimation + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + logical :: cond_evap + + integer :: n + + real(kind_phys) :: cond, dep, reevap, sub + + real(kind_phys), dimension (ks:ke) :: q_liq, q_sol, lcpk, icpk, tcpk, tcp3 + + real (kind = r8), dimension (ks:ke) :: cvm, te8 + + ! ----------------------------------------------------------------------- + ! initialization + ! ----------------------------------------------------------------------- + + cond = 0 + dep = 0 + reevap = 0 + sub = 0 + + ! ----------------------------------------------------------------------- + ! calculate heat capacities and latent heat coefficients + ! ----------------------------------------------------------------------- + + call cal_mhc_lhc (ks, ke, qv, ql, qr, qi, qs, qg, q_liq, q_sol, cvm, te8, tz, & + lcpk, icpk, tcpk, tcp3) + + if (.not. do_warm_rain_mp .and. fast_fr_mlt) then + + ! ----------------------------------------------------------------------- + ! cloud ice melting to form cloud water and rain + ! ----------------------------------------------------------------------- + + call pimlt (ks, ke, dtm, qv, ql, qr, qi, qs, qg, tz, cvm, te8, & + lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! enforce complete freezing below t_wfr + ! ----------------------------------------------------------------------- + + call pcomp (ks, ke, qv, ql, qr, qi, qs, qg, tz, cvm, te8, & + lcpk, icpk, tcpk, tcp3) + + endif + + ! ----------------------------------------------------------------------- + ! cloud water condensation and evaporation + ! ----------------------------------------------------------------------- + + if (delay_cond_evap) then + cond_evap = last_step + else + cond_evap = .true. + endif + + if (cond_evap) then + do n = 1, nconds + call pcond_pevap (ks, ke, dtm, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + lcpk, icpk, tcpk, tcp3, cond, reevap) + enddo + endif + + condensation = condensation + cond * convt + evaporation = evaporation + reevap * convt + + if (.not. do_warm_rain_mp .and. fast_fr_mlt) then + + ! ----------------------------------------------------------------------- + ! cloud water freezing to form cloud ice and snow + ! ----------------------------------------------------------------------- + + call pifr (ks, ke, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, & + lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! Wegener Bergeron Findeisen process + ! ----------------------------------------------------------------------- + + call pwbf (ks, ke, dtm, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, & + lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! Bigg freezing mechanism + ! ----------------------------------------------------------------------- + + call pbigg (ks, ke, dtm, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, ccn, & + lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! rain freezing to form graupel + ! ----------------------------------------------------------------------- + + call pgfr_simp (ks, ke, dtm, qv, ql, qr, qi, qs, qg, tz, cvm, te8, & + lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! snow melting to form cloud water and rain + ! ----------------------------------------------------------------------- + + call psmlt_simp (ks, ke, dtm, qv, ql, qr, qi, qs, qg, tz, cvm, te8, & + lcpk, icpk, tcpk, tcp3) + + endif + + ! ----------------------------------------------------------------------- + ! cloud water to rain autoconversion + ! ----------------------------------------------------------------------- + + call praut_simp (ks, ke, dtm, tz, qv, ql, qr, qi, qs, qg) + + if (.not. do_warm_rain_mp .and. fast_dep_sub) then + + ! ----------------------------------------------------------------------- + ! cloud ice deposition and sublimation + ! ----------------------------------------------------------------------- + + call pidep_pisub (ks, ke, dtm, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + lcpk, icpk, tcpk, tcp3, cin, dep, sub) + + deposition = deposition + dep * convt + sublimation = sublimation + sub * convt + + ! ----------------------------------------------------------------------- + ! cloud ice to snow autoconversion + ! ----------------------------------------------------------------------- + + call psaut_simp (ks, ke, dtm, qv, ql, qr, qi, qs, qg, tz, den) + + ! ----------------------------------------------------------------------- + ! snow deposition and sublimation + ! ----------------------------------------------------------------------- + + call psdep_pssub (ks, ke, dtm, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + denfac, lcpk, icpk, tcpk, tcp3, dep, sub) + + ! ----------------------------------------------------------------------- + ! graupel deposition and sublimation + ! ----------------------------------------------------------------------- + + call pgdep_pgsub (ks, ke, dtm, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + denfac, lcpk, icpk, tcpk, tcp3, dep, sub) + + endif + +end subroutine mp_fast + +! ======================================================================= +! sedimentation of cloud ice, snow, graupel or hail, and rain +! ======================================================================= + +subroutine sedimentation (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & + vtw, vtr, vti, vts, vtg, w1, r1, i1, s1, g1, pfw, pfr, pfi, pfs, pfg, & + u, v, w, den, denfac, dte) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: dp, dz, den, denfac + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, u, v, w + + real(kind_phys), intent (out) :: w1, r1, i1, s1, g1 + + real(kind_phys), intent (out), dimension (ks:ke) :: vtw, vtr, vti, vts, vtg, pfw, pfr, pfi, pfs, pfg + + real (kind = r8), intent (inout) :: dte + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys), dimension (ks:ke) :: q_liq, q_sol, lcpk, icpk, tcpk, tcp3 + + real (kind = r8), dimension (ks:ke) :: te8, cvm + + w1 = 0. + r1 = 0. + i1 = 0. + s1 = 0. + g1 = 0. + + vtw = 0. + vtr = 0. + vti = 0. + vts = 0. + vtg = 0. + + pfw = 0. + pfr = 0. + pfi = 0. + pfs = 0. + pfg = 0. + + ! ----------------------------------------------------------------------- + ! calculate heat capacities and latent heat coefficients + ! ----------------------------------------------------------------------- + + call cal_mhc_lhc (ks, ke, qv, ql, qr, qi, qs, qg, q_liq, q_sol, cvm, te8, tz, & + lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! terminal fall and melting of falling cloud ice into rain + ! ----------------------------------------------------------------------- + + if (do_psd_ice_fall) then + call term_rsg (ks, ke, qi, den, denfac, vi_fac, blini, mui, tvai, tvbi, vi_max, const_vi, vti) + else + call term_ice (ks, ke, tz, qi, den, vi_fac, vi_max, const_vi, vti) + endif + + if (do_sedi_melt) then + call sedi_melt (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & + vti, r1, tau_imlt, icpk, "qi") + endif + + call terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & + vti, i1, pfi, u, v, w, dte, "qi") + + pfi (ks) = max (0.0, pfi (ks)) + do k = ke, ks + 1, -1 + pfi (k) = max (0.0, pfi (k) - pfi (k - 1)) + enddo + + ! ----------------------------------------------------------------------- + ! terminal fall and melting of falling snow into rain + ! ----------------------------------------------------------------------- + + call term_rsg (ks, ke, qs, den, denfac, vs_fac, blins, mus, tvas, tvbs, vs_max, const_vs, vts) + + if (do_sedi_melt) then + call sedi_melt (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & + vts, r1, tau_smlt, icpk, "qs") + endif + + call terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & + vts, s1, pfs, u, v, w, dte, "qs") + + pfs (ks) = max (0.0, pfs (ks)) + do k = ke, ks + 1, -1 + pfs (k) = max (0.0, pfs (k) - pfs (k - 1)) + enddo + + ! ----------------------------------------------------------------------- + ! terminal fall and melting of falling graupel into rain + ! ----------------------------------------------------------------------- + + if (do_hail) then + call term_rsg (ks, ke, qg, den, denfac, vg_fac, blinh, muh, tvah, tvbh, vg_max, const_vg, vtg) + else + call term_rsg (ks, ke, qg, den, denfac, vg_fac, bling, mug, tvag, tvbg, vg_max, const_vg, vtg) + endif + + if (do_sedi_melt) then + call sedi_melt (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & + vtg, r1, tau_gmlt, icpk, "qg") + endif + + call terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & + vtg, g1, pfg, u, v, w, dte, "qg") + + pfg (ks) = max (0.0, pfg (ks)) + do k = ke, ks + 1, -1 + pfg (k) = max (0.0, pfg (k) - pfg (k - 1)) + enddo + + ! ----------------------------------------------------------------------- + ! terminal fall of cloud water + ! ----------------------------------------------------------------------- + + if (do_psd_water_fall) then + + call term_rsg (ks, ke, ql, den, denfac, vw_fac, blinw, muw, tvaw, tvbw, vw_max, const_vw, vtw) + + call terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & + vtw, w1, pfw, u, v, w, dte, "ql") + + pfw (ks) = max (0.0, pfw (ks)) + do k = ke, ks + 1, -1 + pfw (k) = max (0.0, pfw (k) - pfw (k - 1)) + enddo + + endif + + ! ----------------------------------------------------------------------- + ! terminal fall of rain + ! ----------------------------------------------------------------------- + + call term_rsg (ks, ke, qr, den, denfac, vr_fac, blinr, mur, tvar, tvbr, vr_max, const_vr, vtr) + + call terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & + vtr, r1, pfr, u, v, w, dte, "qr") + + pfr (ks) = max (0.0, pfr (ks)) + do k = ke, ks + 1, -1 + pfr (k) = max (0.0, pfr (k) - pfr (k - 1)) + enddo + +end subroutine sedimentation + +! ======================================================================= +! terminal velocity for cloud ice +! ======================================================================= + +subroutine term_ice (ks, ke, tz, q, den, v_fac, v_max, const_v, vt) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + logical, intent (in) :: const_v + + real(kind_phys), intent (in) :: v_fac, v_max + + real(kind_phys), intent (in), dimension (ks:ke) :: q, den + + real (kind = r8), intent (in), dimension (ks:ke) :: tz + + real(kind_phys), intent (out), dimension (ks:ke) :: vt + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: qden + + real(kind_phys), parameter :: aa = - 4.14122e-5 + real(kind_phys), parameter :: bb = - 0.00538922 + real(kind_phys), parameter :: cc = - 0.0516344 + real(kind_phys), parameter :: dd = 0.00216078 + real(kind_phys), parameter :: ee = 1.9714 + + real(kind_phys), dimension (ks:ke) :: tc + + if (const_v) then + vt (:) = v_fac + else + do k = ks, ke + qden = q (k) * den (k) + if (q (k) .lt. qfmin) then + vt (k) = 0.0 + else + tc (k) = tz (k) - tice + if (ifflag .eq. 1) then + vt (k) = (3. + log10 (qden)) * (tc (k) * (aa * tc (k) + bb) + cc) + & + dd * tc (k) + ee + vt (k) = 0.01 * v_fac * exp (vt (k) * log (10.)) + endif + if (ifflag .eq. 2) & + vt (k) = v_fac * 3.29 * exp (0.16 * log (qden)) + vt (k) = min (v_max, max (0.0, vt (k))) + endif + enddo + endif + +end subroutine term_ice + +! ======================================================================= +! terminal velocity for rain, snow, and graupel, Lin et al. (1983) +! ======================================================================= + +subroutine term_rsg (ks, ke, q, den, denfac, v_fac, blin, mu, tva, tvb, v_max, const_v, vt) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + logical, intent (in) :: const_v + + real(kind_phys), intent (in) :: v_fac, blin, v_max, mu + + real (kind = r8), intent (in) :: tva, tvb + + real(kind_phys), intent (in), dimension (ks:ke) :: q, den, denfac + + real(kind_phys), intent (out), dimension (ks:ke) :: vt + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + if (const_v) then + vt (:) = v_fac + else + do k = ks, ke + if (q (k) .lt. qfmin) then + vt (k) = 0.0 + else + call cal_pc_ed_oe_rr_tv (q (k), den (k), blin, mu, & + tva = tva, tvb = tvb, tv = vt (k)) + vt (k) = v_fac * vt (k) * denfac (k) + vt (k) = min (v_max, max (0.0, vt (k))) + endif + enddo + endif + +end subroutine term_rsg + +! ======================================================================= +! melting during sedimentation +! ======================================================================= + +subroutine sedi_melt (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & + vt, r1, tau_mlt, icpk, qflag) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts, tau_mlt + + real(kind_phys), intent (in), dimension (ks:ke) :: vt, dp, dz, icpk + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + + real(kind_phys), intent (inout) :: r1 + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + character (len = 2), intent (in) :: qflag + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k, m + + real(kind_phys) :: dtime, sink, zs + + real(kind_phys), dimension (ks:ke) :: q + + real(kind_phys), dimension (ks:ke + 1) :: ze, zt + + real (kind = r8), dimension (ks:ke) :: cvm + + call zezt (ks, ke, dts, zs, dz, vt, ze, zt) + + select case (qflag) + case ("qi") + q = qi + case ("qs") + q = qs + case ("qg") + q = qg + case default + print *, "gfdl_mp: qflag error!" + end select + + ! ----------------------------------------------------------------------- + ! melting to rain + ! ----------------------------------------------------------------------- + + do k = ke - 1, ks, - 1 + if (vt (k) .lt. 1.e-10) cycle + if (q (k) .gt. qcmin) then + do m = k + 1, ke + if (zt (k + 1) .ge. ze (m)) exit + if (zt (k) .lt. ze (m + 1) .and. tz (m) .gt. tice) then + cvm (k) = mhc (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k)) + cvm (m) = mhc (qv (m), ql (m), qr (m), qi (m), qs (m), qg (m)) + dtime = min (dts, (ze (m) - ze (m + 1)) / vt (k)) + dtime = min (1.0, dtime / tau_mlt) + sink = min (q (k) * dp (k) / dp (m), dtime * (tz (m) - tice) / icpk (m)) + q (k) = q (k) - sink * dp (m) / dp (k) + if (zt (k) .lt. zs) then + r1 = r1 + sink * dp (m) + else + qr (m) = qr (m) + sink + endif + select case (qflag) + case ("qi") + qi (k) = q (k) + case ("qs") + qs (k) = q (k) + case ("qg") + qg (k) = q (k) + case default + print *, "gfdl_mp: qflag error!" + end select + tz (k) = (tz (k) * cvm (k) - li00 * sink * dp (m) / dp (k)) / & + mhc (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k)) + tz (m) = (tz (m) * cvm (m)) / & + mhc (qv (m), ql (m), qr (m), qi (m), qs (m), qg (m)) + endif + if (q (k) .lt. qcmin) exit + enddo + endif + enddo + +end subroutine sedi_melt + +! ======================================================================= +! melting during sedimentation +! ======================================================================= + +subroutine terminal_fall (dts, ks, ke, tz, qv, ql, qr, qi, qs, qg, dz, dp, & + vt, x1, m1, u, v, w, dte, qflag) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: vt, dp, dz + + character (len = 2), intent (in) :: qflag + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, u, v, w + + real(kind_phys), intent (inout) :: x1 + + real (kind = r8), intent (inout) :: dte + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + real(kind_phys), intent (out), dimension (ks:ke) :: m1 + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + logical :: no_fall + + real(kind_phys) :: zs + + real(kind_phys), dimension (ks:ke) :: dm, q + + real(kind_phys), dimension (ks:ke + 1) :: ze, zt + + real (kind = r8), dimension (ks:ke) :: te1, te2 + + m1 = 0.0 + + call zezt (ks, ke, dts, zs, dz, vt, ze, zt) + + select case (qflag) + case ("ql") + q = ql + case ("qr") + q = qr + case ("qi") + q = qi + case ("qs") + q = qs + case ("qg") + q = qg + case default + print *, "gfdl_mp: qflag error!" + end select + + call check_column (ks, ke, q, no_fall) + + if (no_fall) return + + ! ----------------------------------------------------------------------- + ! momentum transportation during sedimentation + ! ----------------------------------------------------------------------- + + if (do_sedi_w) then + do k = ks, ke + dm (k) = dp (k) * (1. + qv (k) + ql (k) + qr (k) + qi (k) + qs (k) + qg (k)) + enddo + endif + + ! ----------------------------------------------------------------------- + ! energy change during sedimentation + ! ----------------------------------------------------------------------- + + do k = ks, ke + te1 (k) = mte (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), tz (k), dp (k), .false.) + enddo + + ! ----------------------------------------------------------------------- + ! sedimentation + ! ----------------------------------------------------------------------- + + select case (qflag) + case ("ql") + q = ql + case ("qr") + q = qr + case ("qi") + q = qi + case ("qs") + q = qs + case ("qg") + q = qg + case default + print *, "gfdl_mp: qflag error!" + end select + + if (sedflag .eq. 1) & + call implicit_fall (dts, ks, ke, ze, vt, dp, q, x1, m1) + if (sedflag .eq. 2) & + call explicit_fall (dts, ks, ke, ze, vt, dp, q, x1, m1) + if (sedflag .eq. 3) & + call lagrangian_fall (ks, ke, zs, ze, zt, dp, q, x1, m1) + if (sedflag .eq. 4) & + call implicit_lagrangian_fall (dts, ks, ke, zs, ze, zt, vt, dp, q, & + x1, m1, sed_fac) + + select case (qflag) + case ("ql") + ql = q + case ("qr") + qr = q + case ("qi") + qi = q + case ("qs") + qs = q + case ("qg") + qg = q + case default + print *, "gfdl_mp: qflag error!" + end select + + ! ----------------------------------------------------------------------- + ! energy change during sedimentation + ! ----------------------------------------------------------------------- + + do k = ks, ke + te2 (k) = mte (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), tz (k), dp (k), .false.) + enddo + dte = dte + sum (te1) - sum (te2) + + ! ----------------------------------------------------------------------- + ! momentum transportation during sedimentation + ! ----------------------------------------------------------------------- + + if (do_sedi_uv) then + call sedi_uv (ks, ke, m1, dp, u, v) + endif + + if (do_sedi_w) then + call sedi_w (ks, ke, m1, w, vt, dm) + endif + + ! ----------------------------------------------------------------------- + ! energy change during sedimentation heating + ! ----------------------------------------------------------------------- + + do k = ks, ke + te1 (k) = mte (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), tz (k), dp (k), .false.) + enddo + + ! ----------------------------------------------------------------------- + ! heat exchanges during sedimentation + ! ----------------------------------------------------------------------- + + if (do_sedi_heat) then + call sedi_heat (ks, ke, dp, m1, dz, tz, qv, ql, qr, qi, qs, qg, c_ice) + endif + + ! ----------------------------------------------------------------------- + ! energy change during sedimentation heating + ! ----------------------------------------------------------------------- + + do k = ks, ke + te2 (k) = mte (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), tz (k), dp (k), .false.) + enddo + dte = dte + sum (te1) - sum (te2) + +end subroutine terminal_fall + +! ======================================================================= +! calculate ze zt for sedimentation +! ======================================================================= + +subroutine zezt (ks, ke, dts, zs, dz, vt, ze, zt) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: dz, vt + + real(kind_phys), intent (out) :: zs + + real(kind_phys), intent (out), dimension (ks:ke + 1) :: ze, zt + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: dt5 + + dt5 = 0.5 * dts + zs = 0.0 + ze (ke + 1) = zs + do k = ke, ks, - 1 + ze (k) = ze (k + 1) - dz (k) + enddo + zt (ks) = ze (ks) + do k = ks + 1, ke + zt (k) = ze (k) - dt5 * (vt (k - 1) + vt (k)) + enddo + zt (ke + 1) = zs - dts * vt (ke) + do k = ks, ke + if (zt (k + 1) .ge. zt (k)) zt (k + 1) = zt (k) - dz_min + enddo + +end subroutine zezt + +! ======================================================================= +! check if water species is large enough to fall +! ======================================================================= + +subroutine check_column (ks, ke, q, no_fall) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: q (ks:ke) + + logical, intent (out) :: no_fall + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + no_fall = .true. + + do k = ks, ke + if (q (k) .gt. qfmin) then + no_fall = .false. + exit + endif + enddo + +end subroutine check_column + +! ======================================================================= +! warm rain cloud microphysics +! ======================================================================= + +subroutine warm_rain (dts, ks, ke, dp, dz, tz, qv, ql, qr, qi, qs, qg, & + den, denfac, vtw, vtr, ccn, rh_rain, h_var, reevap) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts, rh_rain, h_var + + real(kind_phys), intent (in), dimension (ks:ke) :: dp, dz, den, denfac, vtw, vtr + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, ccn + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + real(kind_phys), intent (out) :: reevap + + ! ----------------------------------------------------------------------- + ! initialization + ! ----------------------------------------------------------------------- + + reevap = 0 + + ! ----------------------------------------------------------------------- + ! rain evaporation to form water vapor + ! ----------------------------------------------------------------------- + + call prevp (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg, den, denfac, rh_rain, h_var, dp, reevap) + + ! ----------------------------------------------------------------------- + ! rain accretion with cloud water + ! ----------------------------------------------------------------------- + + call pracw (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg, den, denfac, vtw, vtr) + + ! ----------------------------------------------------------------------- + ! cloud water to rain autoconversion + ! ----------------------------------------------------------------------- + + call praut (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg, den, ccn, h_var) + +end subroutine warm_rain + +! ======================================================================= +! rain evaporation to form water vapor, Lin et al. (1983) +! ======================================================================= + +subroutine prevp (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg, den, denfac, rh_rain, h_var, dp, reevap) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts, rh_rain, h_var + + real(kind_phys), intent (in), dimension (ks:ke) :: den, denfac, dp + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, qr, ql, qi, qs, qg + + real(kind_phys), intent (out) :: reevap + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: dqv, qsat, dqdt, tmp, t2, qden, q_plus, q_minus, sink + real(kind_phys) :: qpz, dq, dqh, tin, fac_revp, rh_tem + + real(kind_phys), dimension (ks:ke) :: q_liq, q_sol, lcpk, icpk, tcpk, tcp3 + + real (kind = r8), dimension (ks:ke) :: cvm, te8 + + ! ----------------------------------------------------------------------- + ! initialization + ! ----------------------------------------------------------------------- + + reevap = 0 + + ! ----------------------------------------------------------------------- + ! time-scale factor + ! ----------------------------------------------------------------------- + + fac_revp = 1. + if (tau_revp .gt. 1.e-6) then + fac_revp = 1. - exp (- dts / tau_revp) + endif + + ! ----------------------------------------------------------------------- + ! calculate heat capacities and latent heat coefficients + ! ----------------------------------------------------------------------- + + call cal_mhc_lhc (ks, ke, qv, ql, qr, qi, qs, qg, q_liq, q_sol, cvm, te8, tz, & + lcpk, icpk, tcpk, tcp3) + + do k = ks, ke + + tin = (tz (k) * cvm (k) - lv00 * ql (k)) / mhc (qv (k) + ql (k), qr (k), q_sol (k)) + + ! ----------------------------------------------------------------------- + ! calculate supersaturation and subgrid variability of water + ! ----------------------------------------------------------------------- + + qpz = qv (k) + ql (k) + qsat = wqs (tin, den (k), dqdt) + dqv = qsat - qv (k) + + dqh = max (ql (k), h_var * max (qpz, qcmin)) + dqh = min (dqh, 0.2 * qpz) + q_minus = qpz - dqh + q_plus = qpz + dqh + + ! ----------------------------------------------------------------------- + ! rain evaporation + ! ----------------------------------------------------------------------- + + rh_tem = qpz / qsat + + if (tz (k) .gt. t_wfr .and. qr (k) .gt. qcmin .and. dqv .gt. 0.0 .and. qsat .gt. q_minus) then + + if (qsat .gt. q_plus) then + dq = qsat - qpz + else + dq = 0.25 * (qsat - q_minus) ** 2 / dqh + endif + qden = qr (k) * den (k) + t2 = tin * tin + sink = psub (t2, dq, qden, qsat, crevp, den (k), denfac (k), blinr, mur, lcpk (k), cvm (k)) + sink = min (qr (k), dts * fac_revp * sink, dqv / (1. + lcpk (k) * dqdt)) + if (use_rhc_revap .and. rh_tem .ge. rhc_revap) then + sink = 0.0 + endif + + ! ----------------------------------------------------------------------- + ! alternative minimum evaporation in dry environmental air + ! ----------------------------------------------------------------------- + ! tmp = min (qr (k), dim (rh_rain * qsat, qv (k)) / (1. + lcpk (k) * dqdt)) + ! sink = max (sink, tmp) + + reevap = reevap + sink * dp (k) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + sink, 0., - sink, 0., 0., 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo ! k loop + +end subroutine prevp + +! ======================================================================= +! rain accretion with cloud water, Lin et al. (1983) +! ======================================================================= + +subroutine pracw (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg, den, denfac, vtw, vtr) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, denfac, vtw, vtr + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, qr, ql, qi, qs, qg + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: qden, sink + + do k = ks, ke + + if (tz (k) .gt. t_wfr .and. qr (k) .gt. qcmin .and. ql (k) .gt. qcmin) then + + qden = qr (k) * den (k) + if (do_new_acc_water) then + sink = dts * acr3d (vtr (k), vtw (k), ql (k), qr (k), cracw, acco (:, 5), & + acc (9), acc (10), den (k)) + else + sink = dts * acr2d (qden, cracw, denfac (k), blinr, mur) + sink = sink / (1. + sink) * ql (k) + endif + + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., - sink, sink, 0., 0., 0.) + + endif + + enddo + +end subroutine pracw + +! ======================================================================= +! cloud water to rain autoconversion, Hong et al. (2004) +! ======================================================================= + +subroutine praut (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg, den, ccn, h_var) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts, h_var + + real(kind_phys), intent (in), dimension (ks:ke) :: den + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, ccn + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + real(kind_phys), parameter :: so3 = 7.0 / 3.0 + real(kind_phys), parameter :: so1 = - 1.0 / 3.0 + + integer :: k + + real(kind_phys) :: sink, dq, qc + + real(kind_phys), dimension (ks:ke) :: dl, c_praut + + if (irain_f .eq. 0) then + + call linear_prof (ke - ks + 1, ql (ks), dl (ks), z_slope_liq, h_var) + + do k = ks, ke + + if (tz (k) .gt. t_wfr .and. ql (k) .gt. qcmin) then + + if (do_psd_water_num) then + call cal_pc_ed_oe_rr_tv (ql (k), den (k), blinw, muw, & + pca = pcaw, pcb = pcbw, pc = ccn (k)) + ccn (k) = ccn (k) / den (k) + endif + + qc = fac_rc * ccn (k) + dl (k) = min (max (qcmin, dl (k)), 0.5 * ql (k)) + dq = 0.5 * (ql (k) + dl (k) - qc) + + if (dq .gt. 0.) then + + c_praut (k) = cpaut * exp (so1 * log (ccn (k) * rhow)) + sink = min (1., dq / dl (k)) * dts * c_praut (k) * den (k) * & + exp (so3 * log (ql (k))) + sink = min (ql (k), sink) + + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., - sink, sink, 0., 0., 0.) + + endif + + endif + + enddo + + endif + + if (irain_f .eq. 1) then + + do k = ks, ke + + if (tz (k) .gt. t_wfr .and. ql (k) .gt. qcmin) then + + if (do_psd_water_num) then + call cal_pc_ed_oe_rr_tv (ql (k), den (k), blinw, muw, & + pca = pcaw, pcb = pcbw, pc = ccn (k)) + ccn (k) = ccn (k) / den (k) + endif + + qc = fac_rc * ccn (k) + dq = ql (k) - qc + + if (dq .gt. 0.) then + + c_praut (k) = cpaut * exp (so1 * log (ccn (k) * rhow)) + sink = min (dq, dts * c_praut (k) * den (k) * exp (so3 * log (ql (k)))) + sink = min (ql (k), sink) + + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., - sink, sink, 0., 0., 0.) + + endif + + endif + + enddo + + endif + +end subroutine praut + +! ======================================================================= +! ice cloud microphysics +! ======================================================================= + +subroutine ice_cloud (ks, ke, tz, qv, ql, qr, qi, qs, qg, den, & + denfac, vtw, vtr, vti, vts, vtg, dts, h_var) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts, h_var + + real(kind_phys), intent (in), dimension (ks:ke) :: den, denfac, vtw, vtr, vti, vts, vtg + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + real(kind_phys), dimension (ks:ke) :: di, q_liq, q_sol, lcpk, icpk, tcpk, tcp3 + + real (kind = r8), dimension (ks:ke) :: cvm, te8 + + ! ----------------------------------------------------------------------- + ! calculate heat capacities and latent heat coefficients + ! ----------------------------------------------------------------------- + + call cal_mhc_lhc (ks, ke, qv, ql, qr, qi, qs, qg, q_liq, q_sol, cvm, te8, tz, & + lcpk, icpk, tcpk, tcp3) + + if (.not. do_warm_rain_mp) then + + ! ----------------------------------------------------------------------- + ! cloud ice melting to form cloud water and rain + ! ----------------------------------------------------------------------- + + call pimlt (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! cloud water freezing to form cloud ice and snow + ! ----------------------------------------------------------------------- + + call pifr (ks, ke, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! vertical subgrid variability + ! ----------------------------------------------------------------------- + + call linear_prof (ke - ks + 1, qi, di, z_slope_ice, h_var) + + ! ----------------------------------------------------------------------- + ! snow melting (includes snow accretion with cloud water and rain) to form cloud water and rain + ! ----------------------------------------------------------------------- + + call psmlt (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac, & + vtw, vtr, vts, lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! graupel melting (includes graupel accretion with cloud water and rain) to form rain + ! ----------------------------------------------------------------------- + + call pgmlt (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac, & + vtw, vtr, vtg, lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! snow accretion with cloud ice + ! ----------------------------------------------------------------------- + + call psaci (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, denfac, vti, vts) + + ! ----------------------------------------------------------------------- + ! cloud ice to snow autoconversion + ! ----------------------------------------------------------------------- + + call psaut (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, di) + + ! ----------------------------------------------------------------------- + ! graupel accretion with cloud ice + ! ----------------------------------------------------------------------- + + call pgaci (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, denfac, vti, vtg) + + ! ----------------------------------------------------------------------- + ! snow accretion with rain and rain freezing to form graupel + ! ----------------------------------------------------------------------- + + call psacr_pgfr (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac, & + vtr, vts, lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! graupel accretion with snow + ! ----------------------------------------------------------------------- + + call pgacs (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, vts, vtg) + + ! ----------------------------------------------------------------------- + ! snow to graupel autoconversion + ! ----------------------------------------------------------------------- + + call pgaut (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den) + + ! ----------------------------------------------------------------------- + ! graupel accretion with cloud water and rain + ! ----------------------------------------------------------------------- + + call pgacw_pgacr (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac, & + vtr, vtg, lcpk, icpk, tcpk, tcp3) + + endif ! do_warm_rain_mp + +end subroutine ice_cloud + +! ======================================================================= +! cloud ice melting to form cloud water and rain, Lin et al. (1983) +! ======================================================================= + +subroutine pimlt (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, tmp, sink, fac_imlt + + fac_imlt = 1. - exp (- dts / tau_imlt) + + do k = ks, ke + + tc = tz (k) - tice_mlt + + if (tc .gt. 0 .and. qi (k) .gt. qcmin) then + + sink = fac_imlt * tc / icpk (k) + sink = min (qi (k), sink) + tmp = min (sink, dim (ql_mlt, ql (k))) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., tmp, sink - tmp, - sink, 0., 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine pimlt + +! ======================================================================= +! cloud water freezing to form cloud ice and snow, Lin et al. (1983) +! ======================================================================= + +subroutine pifr (ks, ke, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in), dimension (ks:ke) :: den + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, tmp, sink, qim + + do k = ks, ke + + tc = t_wfr - tz (k) + + if (tc .gt. 0. .and. ql (k) .gt. qcmin) then + + sink = ql (k) * tc / dt_fr + sink = min (ql (k), sink, tc / icpk (k)) + qim = qi0_crt / den (k) + tmp = min (sink, dim (qim, qi (k))) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., - sink, 0., tmp, sink - tmp, 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine pifr + +! ======================================================================= +! snow melting (includes snow accretion with cloud water and rain) to form cloud water and rain +! Lin et al. (1983) +! ======================================================================= + +subroutine psmlt (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac, & + vtw, vtr, vts, lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, denfac, vtw, vtr, vts + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, factor, tmp, sink, qden, dqdt, tin, dq, qsi + real(kind_phys) :: psacw, psacr, pracs + + do k = ks, ke + + tc = tz (k) - tice + + if (tc .ge. 0. .and. qs (k) .gt. qcmin) then + + psacw = 0. + qden = qs (k) * den (k) + if (ql (k) .gt. qcmin) then + if (do_new_acc_water) then + psacw = acr3d (vts (k), vtw (k), ql (k), qs (k), csacw, acco (:, 7), & + acc (13), acc (14), den (k)) + else + factor = acr2d (qden, csacw, denfac (k), blins, mus) + psacw = factor / (1. + dts * factor) * ql (k) + endif + endif + + psacr = 0. + pracs = 0. + if (qr (k) .gt. qcmin) then + psacr = min (acr3d (vts (k), vtr (k), qr (k), qs (k), csacr, acco (:, 2), & + acc (3), acc (4), den (k)), qr (k) / dts) + pracs = acr3d (vtr (k), vts (k), qs (k), qr (k), cracs, acco (:, 1), & + acc (1), acc (2), den (k)) + endif + + tin = tz (k) + qsi = iqs (tin, den (k), dqdt) + dq = qsi - qv (k) + sink = max (0., pmlt (tc, dq, qden, psacw, psacr, csmlt, den (k), denfac (k), blins, mus, & + lcpk (k), icpk (k), cvm (k))) + + sink = min (qs (k), (sink + pracs) * dts, tc / icpk (k)) + tmp = min (sink, dim (qs_mlt, ql (k))) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., tmp, sink - tmp, 0., - sink, 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine psmlt + +! ======================================================================= +! graupel melting (includes graupel accretion with cloud water and rain) to form rain +! Lin et al. (1983) +! ======================================================================= + +subroutine pgmlt (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac, & + vtw, vtr, vtg, lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, denfac, vtw, vtr, vtg + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, factor, sink, qden, dqdt, tin, dq, qsi + real(kind_phys) :: pgacw, pgacr + + do k = ks, ke + + tc = tz (k) - tice + + if (tc .ge. 0. .and. qg (k) .gt. qcmin) then + + pgacw = 0. + qden = qg (k) * den (k) + if (ql (k) .gt. qcmin) then + if (do_new_acc_water) then + pgacw = acr3d (vtg (k), vtw (k), ql (k), qg (k), cgacw, acco (:, 9), & + acc (17), acc (18), den (k)) + else + if (do_hail) then + factor = acr2d (qden, cgacw, denfac (k), blinh, muh) + else + factor = acr2d (qden, cgacw, denfac (k), bling, mug) + endif + pgacw = factor / (1. + dts * factor) * ql (k) + endif + endif + + pgacr = 0. + if (qr (k) .gt. qcmin) then + pgacr = min (acr3d (vtg (k), vtr (k), qr (k), qg (k), cgacr, acco (:, 3), & + acc (5), acc (6), den (k)), qr (k) / dts) + endif + + tin = tz (k) + qsi = iqs (tin, den (k), dqdt) + dq = qsi - qv (k) + if (do_hail) then + sink = max (0., pmlt (tc, dq, qden, pgacw, pgacr, cgmlt, den (k), denfac (k), & + blinh, muh, lcpk (k), icpk (k), cvm (k))) + else + sink = max (0., pmlt (tc, dq, qden, pgacw, pgacr, cgmlt, den (k), denfac (k), & + bling, mug, lcpk (k), icpk (k), cvm (k))) + endif + + sink = min (qg (k), sink * dts, tc / icpk (k)) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., sink, 0., 0., - sink, te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine pgmlt + +! ======================================================================= +! snow accretion with cloud ice, Lin et al. (1983) +! ======================================================================= + +subroutine psaci (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, denfac, vti, vts) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, denfac, vti, vts + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, factor, sink, qden + + do k = ks, ke + + tc = tz (k) - tice + + if (tc .lt. 0. .and. qi (k) .gt. qcmin) then + + sink = 0. + qden = qs (k) * den (k) + if (qs (k) .gt. qcmin) then + if (do_new_acc_ice) then + sink = dts * acr3d (vts (k), vti (k), qi (k), qs (k), csaci, acco (:, 8), & + acc (15), acc (16), den (k)) + else + factor = dts * acr2d (qden, csaci, denfac (k), blins, mus) + sink = factor / (1. + factor) * qi (k) + endif + endif + + sink = min (fi2s_fac * qi (k), sink) + + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., 0., - sink, sink, 0.) + + endif + + enddo + +end subroutine psaci + +! ======================================================================= +! cloud ice to snow autoconversion, Lin et al. (1983) +! ======================================================================= + +subroutine psaut (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, di) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, di + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, sink, fac_i2s, q_plus, qim, dq, tmp + + fac_i2s = 1. - exp (- dts / tau_i2s) + + do k = ks, ke + + tc = tz (k) - tice + + if (tc .lt. 0. .and. qi (k) .gt. qcmin) then + + sink = 0. + tmp = fac_i2s * exp (0.025 * tc) + di (k) = max (di (k), qcmin) + q_plus = qi (k) + di (k) + qim = qi0_crt / den (k) + if (q_plus .gt. (qim + qcmin)) then + if (qim .gt. (qi (k) - di (k))) then + dq = (0.25 * (q_plus - qim) ** 2) / di (k) + else + dq = qi (k) - qim + endif + sink = tmp * dq + endif + + sink = min (fi2s_fac * qi (k), sink) + + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., 0., - sink, sink, 0.) + + endif + + enddo + +end subroutine psaut + +! ======================================================================= +! graupel accretion with cloud ice, Lin et al. (1983) +! ======================================================================= + +subroutine pgaci (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, denfac, vti, vtg) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, denfac, vti, vtg + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, factor, sink, qden + + do k = ks, ke + + tc = tz (k) - tice + + if (tc .lt. 0. .and. qi (k) .gt. qcmin) then + + sink = 0. + qden = qg (k) * den (k) + if (qg (k) .gt. qcmin) then + if (do_new_acc_ice) then + sink = dts * acr3d (vtg (k), vti (k), qi (k), qg (k), cgaci, acco (:, 10), & + acc (19), acc (20), den (k)) + else + if (do_hail) then + factor = dts * acr2d (qden, cgaci, denfac (k), blinh, muh) + else + factor = dts * acr2d (qden, cgaci, denfac (k), bling, mug) + endif + sink = factor / (1. + factor) * qi (k) + endif + endif + + sink = min (fi2g_fac * qi (k), sink) + + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., 0., - sink, 0., sink) + + endif + + enddo + +end subroutine pgaci + +! ======================================================================= +! snow accretion with rain and rain freezing to form graupel, Lin et al. (1983) +! ======================================================================= + +subroutine psacr_pgfr (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac, & + vtr, vts, lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, denfac, vtr, vts + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, factor, sink + real(kind_phys) :: psacr, pgfr + + do k = ks, ke + + tc = tz (k) - tice + + if (tc .lt. 0. .and. qr (k) .gt. qcmin) then + + psacr = 0. + if (qs (k) .gt. qcmin) then + psacr = dts * acr3d (vts (k), vtr (k), qr (k), qs (k), csacr, acco (:, 2), & + acc (3), acc (4), den (k)) + endif + + pgfr = dts * cgfr (1) / den (k) * (exp (- cgfr (2) * tc) - 1.) * & + exp ((6 + mur) / (mur + 3) * log (6 * qr (k) * den (k))) + + sink = psacr + pgfr + factor = min (sink, qr (k), - tc / icpk (k)) / max (sink, qcmin) + psacr = factor * psacr + pgfr = factor * pgfr + + sink = min (qr (k), psacr + pgfr) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., - sink, 0., psacr, pgfr, te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine psacr_pgfr + +! ======================================================================= +! graupel accretion with snow, Lin et al. (1983) +! ======================================================================= + +subroutine pgacs (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den, vts, vtg) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, vts, vtg + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: sink + + do k = ks, ke + + if (tz (k) .lt. tice .and. qs (k) .gt. qcmin .and. qg (k) .gt. qcmin) then + + sink = dts * acr3d (vtg (k), vts (k), qs (k), qg (k), cgacs, acco (:, 4), & + acc (7), acc (8), den (k)) + sink = min (fs2g_fac * qs (k), sink) + + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., 0., 0., - sink, sink) + + endif + + enddo + +end subroutine pgacs + +! ======================================================================= +! snow to graupel autoconversion, Lin et al. (1983) +! ======================================================================= + +subroutine pgaut (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, factor, sink, qsm + + do k = ks, ke + + tc = tz (k) - tice + + if (tc .lt. 0. .and. qs (k) .gt. qcmin) then + + sink = 0 + qsm = qs0_crt / den (k) + if (qs (k) .gt. qsm) then + factor = dts * 1.e-3 * exp (0.09 * (tz (k) - tice)) + sink = factor / (1. + factor) * (qs (k) - qsm) + endif + + sink = min (fs2g_fac * qs (k), sink) + + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., 0., 0., - sink, sink) + + endif + + enddo + +end subroutine pgaut + +! ======================================================================= +! graupel accretion with cloud water and rain, Lin et al. (1983) +! ======================================================================= + +subroutine pgacw_pgacr (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, denfac, & + vtr, vtg, lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, denfac, vtr, vtg + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, factor, sink, qden + real(kind_phys) :: pgacw, pgacr + + do k = ks, ke + + tc = tz (k) - tice + + if (tc .lt. 0. .and. qg (k) .gt. qcmin) then + + pgacw = 0. + if (ql (k) .gt. qcmin) then + qden = qg (k) * den (k) + if (do_hail) then + factor = dts * acr2d (qden, cgacw, denfac (k), blinh, muh) + else + factor = dts * acr2d (qden, cgacw, denfac (k), bling, mug) + endif + pgacw = factor / (1. + factor) * ql (k) + endif + + pgacr = 0. + if (qr (k) .gt. qcmin) then + pgacr = min (dts * acr3d (vtg (k), vtr (k), qr (k), qg (k), cgacr, acco (:, 3), & + acc (5), acc (6), den (k)), qr (k)) + endif + + sink = pgacr + pgacw + factor = min (sink, dim (tice, tz (k)) / icpk (k)) / max (sink, qcmin) + pgacr = factor * pgacr + pgacw = factor * pgacw + + sink = pgacr + pgacw + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., - pgacw, - pgacr, 0., 0., sink, te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine pgacw_pgacr + +! ======================================================================= +! temperature sentive high vertical resolution processes +! ======================================================================= + +subroutine subgrid_z_proc (ks, ke, den, denfac, dts, rh_adj, tz, qv, ql, qr, & + qi, qs, qg, dp, ccn, cin, cond, dep, reevap, sub, last_step) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + logical, intent (in) :: last_step + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts, rh_adj + + real(kind_phys), intent (in), dimension (ks:ke) :: den, denfac, dp + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, ccn, cin + + real(kind_phys), intent (out) :: cond, dep, reevap, sub + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + logical :: cond_evap + + integer :: n + + real(kind_phys), dimension (ks:ke) :: q_liq, q_sol, q_cond, lcpk, icpk, tcpk, tcp3 + + real (kind = r8), dimension (ks:ke) :: cvm, te8 + + ! ----------------------------------------------------------------------- + ! initialization + ! ----------------------------------------------------------------------- + + cond = 0 + dep = 0 + reevap = 0 + sub = 0 + + ! ----------------------------------------------------------------------- + ! calculate heat capacities and latent heat coefficients + ! ----------------------------------------------------------------------- + + call cal_mhc_lhc (ks, ke, qv, ql, qr, qi, qs, qg, q_liq, q_sol, cvm, te8, tz, & + lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! instant processes (include deposition, evaporation, and sublimation) + ! ----------------------------------------------------------------------- + + if (.not. do_warm_rain_mp) then + + call pinst (ks, ke, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + lcpk, icpk, tcpk, tcp3, rh_adj, dep, sub, reevap) + + endif + + ! ----------------------------------------------------------------------- + ! cloud water condensation and evaporation + ! ----------------------------------------------------------------------- + + if (delay_cond_evap) then + cond_evap = last_step + else + cond_evap = .true. + endif + + if (cond_evap) then + do n = 1, nconds + call pcond_pevap (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + lcpk, icpk, tcpk, tcp3, cond, reevap) + enddo + endif + + if (.not. do_warm_rain_mp) then + + ! ----------------------------------------------------------------------- + ! enforce complete freezing below t_wfr + ! ----------------------------------------------------------------------- + + call pcomp (ks, ke, qv, ql, qr, qi, qs, qg, tz, cvm, te8, lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! Wegener Bergeron Findeisen process + ! ----------------------------------------------------------------------- + + call pwbf (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! Bigg freezing mechanism + ! ----------------------------------------------------------------------- + + call pbigg (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, ccn, lcpk, icpk, tcpk, tcp3) + + ! ----------------------------------------------------------------------- + ! cloud ice deposition and sublimation + ! ----------------------------------------------------------------------- + + call pidep_pisub (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + lcpk, icpk, tcpk, tcp3, cin, dep, sub) + + ! ----------------------------------------------------------------------- + ! snow deposition and sublimation + ! ----------------------------------------------------------------------- + + call psdep_pssub (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + denfac, lcpk, icpk, tcpk, tcp3, dep, sub) + + ! ----------------------------------------------------------------------- + ! graupel deposition and sublimation + ! ----------------------------------------------------------------------- + + call pgdep_pgsub (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + denfac, lcpk, icpk, tcpk, tcp3, dep, sub) + + endif + +end subroutine subgrid_z_proc + +! ======================================================================= +! instant processes (include deposition, evaporation, and sublimation) +! ======================================================================= + +subroutine pinst (ks, ke, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + lcpk, icpk, tcpk, tcp3, rh_adj, dep, sub, reevap) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: rh_adj + + real(kind_phys), intent (in), dimension (ks:ke) :: den, dp + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + real(kind_phys), intent (out) :: dep, reevap, sub + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: sink, tin, qpz, rh, dqdt, tmp, qsi + + do k = ks, ke + + ! ----------------------------------------------------------------------- + ! instant deposit all water vapor to cloud ice when temperature is super low + ! ----------------------------------------------------------------------- + + if (tz (k) .lt. t_min) then + + sink = dim (qv (k), qcmin) + dep = dep + sink * dp (k) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + - sink, 0., 0., sink, 0., 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + ! ----------------------------------------------------------------------- + ! instant evaporation / sublimation of all clouds when rh < rh_adj + ! ----------------------------------------------------------------------- + + qpz = qv (k) + ql (k) + qi (k) + tin = (te8 (k) - lv00 * qpz + li00 * (qs (k) + qg (k))) / & + mhc (qpz, qr (k), qs (k) + qg (k)) + + if (tin .gt. t_sub + 6.) then + + qsi = iqs (tin, den (k), dqdt) + rh = qpz / qsi + if (rh .lt. rh_adj) then + + sink = ql (k) + tmp = qi (k) + + reevap = reevap + sink * dp (k) + sub = sub + tmp * dp (k) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + sink + tmp, - sink, 0., - tmp, 0., 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + endif + + enddo + +end subroutine pinst + +! ======================================================================= +! cloud water condensation and evaporation, Hong and Lim (2006) +! ======================================================================= + +subroutine pcond_pevap (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + lcpk, icpk, tcpk, tcp3, cond, reevap) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, dp + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + real(kind_phys), intent (out) :: cond, reevap + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: sink, tin, qpz, dqdt, qsw, rh_tem, dq, factor, fac_l2v, fac_v2l + + fac_l2v = 1. - exp (- dts / tau_l2v) + fac_v2l = 1. - exp (- dts / tau_v2l) + + do k = ks, ke + + tin = tz (k) + qsw = wqs (tin, den (k), dqdt) + qpz = qv (k) + ql (k) + qi (k) + rh_tem = qpz / qsw + dq = qsw - qv (k) + if (dq .gt. 0.) then + if (do_evap_timescale) then + factor = min (1., fac_l2v * (rh_fac_evap * dq / qsw)) + else + factor = 1. + endif + sink = min (ql (k), factor * dq / (1. + tcp3 (k) * dqdt)) + if (use_rhc_cevap .and. rh_tem .ge. rhc_cevap) then + sink = 0. + endif + reevap = reevap + sink * dp (k) + else + if (do_cond_timescale) then + factor = min (1., fac_v2l * (rh_fac_cond * (- dq) / qsw)) + else + factor = 1. + endif + sink = - min (qv (k), factor * (- dq) / (1. + tcp3 (k) * dqdt)) + cond = cond - sink * dp (k) + endif + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + sink, - sink, 0., 0., 0., 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + enddo + +end subroutine pcond_pevap + +! ======================================================================= +! enforce complete freezing below t_wfr, Lin et al. (1983) +! ======================================================================= + +subroutine pcomp (ks, ke, qv, ql, qr, qi, qs, qg, tz, cvm, te8, lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, sink + + do k = ks, ke + + tc = t_wfr - tz (k) + + if (tc .gt. 0. .and. ql (k) .gt. qcmin) then + + sink = ql (k) * tc / dt_fr + sink = min (ql (k), sink, tc / icpk (k)) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., - sink, 0., sink, 0., 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine pcomp + +! ======================================================================= +! Wegener Bergeron Findeisen process, Storelvmo and Tan (2015) +! ======================================================================= + +subroutine pwbf (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, tin, sink, dqdt, qsw, qsi, qim, tmp, fac_wbf + + if (.not. do_wbf) return + + fac_wbf = 1. - exp (- dts / tau_wbf) + + do k = ks, ke + + tc = tice - tz (k) + + tin = tz (k) + qsw = wqs (tin, den (k), dqdt) + qsi = iqs (tin, den (k), dqdt) + + if (tc .gt. 0. .and. ql (k) .gt. qcmin .and. qi (k) .gt. qcmin .and. & + qv (k) .gt. qsi .and. qv (k) .lt. qsw) then + + sink = min (fac_wbf * ql (k), tc / icpk (k)) + qim = qi0_crt / den (k) + tmp = min (sink, dim (qim, qi (k))) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., - sink, 0., tmp, sink - tmp, 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine pwbf + +! ======================================================================= +! Bigg freezing mechanism, Bigg (1953) +! ======================================================================= + +subroutine pbigg (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, den, ccn, lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, ccn + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: sink, tc + + do k = ks, ke + + tc = tice - tz (k) + + if (tc .gt. 0 .and. ql (k) .gt. qcmin) then + + if (do_psd_water_num) then + call cal_pc_ed_oe_rr_tv (ql (k), den (k), blinw, muw, & + pca = pcaw, pcb = pcbw, pc = ccn (k)) + ccn (k) = ccn (k) / den (k) + endif + + sink = 100. / (rhow * ccn (k)) * dts * (exp (0.66 * tc) - 1.) * ql (k) ** 2 + sink = min (ql (k), sink, tc / icpk (k)) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., - sink, 0., sink, 0., 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine pbigg + +! ======================================================================= +! cloud ice deposition and sublimation, Hong et al. (2004) +! ======================================================================= + +subroutine pidep_pisub (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + lcpk, icpk, tcpk, tcp3, cin, dep, sub) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, dp + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, cin + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + real(kind_phys), intent (out) :: dep, sub + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: sink, tin, dqdt, qsi, dq, pidep, tmp, tc, qi_crt!,qi_gen + + do k = ks, ke + + if (tz (k) .lt. tice) then + + pidep = 0. + tin = tz (k) + qsi = iqs (tin, den (k), dqdt) + dq = qv (k) - qsi + tmp = dq / (1. + tcpk (k) * dqdt) + + if (qi (k) .gt. qcmin) then + if (.not. prog_ccn) then + if (inflag .eq. 1) & + cin (k) = 5.38e7 * exp (0.75 * log (qi (k) * den (k))) + if (inflag .eq. 2) & + cin (k) = exp (- 2.80 + 0.262 * (tice - tz (k))) * 1000.0 + if (inflag .eq. 3) & + cin (k) = exp (- 0.639 + 12.96 * (qv (k) / qsi - 1.0)) * 1000.0 + if (inflag .eq. 4) & + cin (k) = 5.e-3 * exp (0.304 * (tice - tz (k))) * 1000.0 + if (inflag .eq. 5) & + cin (k) = 1.e-5 * exp (0.5 * (tice - tz (k))) * 1000.0 + endif + if (do_psd_ice_num) then + call cal_pc_ed_oe_rr_tv (qi (k), den (k), blini, mui, & + pca = pcai, pcb = pcbi, pc = cin (k)) + cin (k) = cin (k) / den (k) + endif + pidep = dts * dq * 4.0 * 11.9 * exp (0.5 * log (qi (k) * den (k) * cin (k))) / & + (qsi * den (k) * (tcpk (k) * cvm (k)) ** 2 / (tcond * rvgas * tz (k) ** 2) + & + 1. / vdifu) + endif + + if (dq .gt. 0.) then + tc = tice - tz (k) + !qi_gen = 4.92e-11 * exp (1.33 * log (1.e3 * exp (0.1 * tc))) + if (igflag .eq. 1) & + qi_crt = qi_gen / den (k) + if (igflag .eq. 2) & + qi_crt = qi_gen * min (qi_lim, 0.1 * tc) / den (k) + if (igflag .eq. 3) & + qi_crt = 1.82e-6 * min (qi_lim, 0.1 * tc) / den (k) + if (igflag .eq. 4) & + qi_crt = max (qi_gen, 1.82e-6) * min (qi_lim, 0.1 * tc) / den (k) + sink = min (tmp, max (qi_crt - qi (k), pidep), tc / tcpk (k)) + dep = dep + sink * dp (k) + else + pidep = pidep * min (1., dim (tz (k), t_sub) * is_fac) + sink = max (pidep, tmp, - qi (k)) + sub = sub - sink * dp (k) + endif + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + - sink, 0., 0., sink, 0., 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine pidep_pisub + +! ======================================================================= +! snow deposition and sublimation, Lin et al. (1983) +! ======================================================================= + +subroutine psdep_pssub (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + denfac, lcpk, icpk, tcpk, tcp3, dep, sub) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, dp, denfac + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + real(kind_phys), intent (out) :: dep, sub + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: sink, tin, dqdt, qsi, qden, t2, dq, pssub + + do k = ks, ke + + if (qs (k) .gt. qcmin) then + + tin = tz (k) + qsi = iqs (tin, den (k), dqdt) + qden = qs (k) * den (k) + t2 = tz (k) * tz (k) + dq = qsi - qv (k) + pssub = psub (t2, dq, qden, qsi, cssub, den (k), denfac (k), blins, mus, tcpk (k), cvm (k)) + pssub = dts * pssub + dq = dq / (1. + tcpk (k) * dqdt) + if (pssub .gt. 0.) then + sink = min (pssub * min (1., dim (tz (k), t_sub) * ss_fac), qs (k)) + sub = sub + sink * dp (k) + else + sink = 0. + if (tz (k) .le. tice) then + sink = max (pssub, dq, (tz (k) - tice) / tcpk (k)) + endif + dep = dep - sink * dp (k) + endif + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + sink, 0., 0., 0., - sink, 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine psdep_pssub + +! ======================================================================= +! graupel deposition and sublimation, Lin et al. (1983) +! ======================================================================= + +subroutine pgdep_pgsub (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, dp, cvm, te8, den, & + denfac, lcpk, icpk, tcpk, tcp3, dep, sub) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den, dp, denfac + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + real(kind_phys), intent (out) :: dep, sub + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: sink, tin, dqdt, qsi, qden, t2, dq, pgsub + + do k = ks, ke + + if (qg (k) .gt. qcmin) then + + tin = tz (k) + qsi = iqs (tin, den (k), dqdt) + qden = qg (k) * den (k) + t2 = tz (k) * tz (k) + dq = qsi - qv (k) + if (do_hail) then + pgsub = psub (t2, dq, qden, qsi, cgsub, den (k), denfac (k), & + blinh, muh, tcpk (k), cvm (k)) + else + pgsub = psub (t2, dq, qden, qsi, cgsub, den (k), denfac (k), & + bling, mug, tcpk (k), cvm (k)) + endif + pgsub = dts * pgsub + dq = dq / (1. + tcpk (k) * dqdt) + if (pgsub .gt. 0.) then + sink = min (pgsub * min (1., dim (tz (k), t_sub) * gs_fac), qg (k)) + sub = sub + sink * dp (k) + else + sink = 0. + if (tz (k) .le. tice) then + sink = max (pgsub, dq, (tz (k) - tice) / tcpk (k)) + endif + dep = dep - sink * dp (k) + endif + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + sink, 0., 0., 0., 0., - sink, te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine pgdep_pgsub + +! ======================================================================= +! cloud fraction diagnostic +! ======================================================================= + +subroutine cloud_fraction (ks, ke, pz, den, qv, ql, qr, qi, qs, qg, qa, tz, h_var, gsize) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: h_var, gsize + + real(kind_phys), intent (in), dimension (ks:ke) :: pz, den + + real (kind = r8), intent (in), dimension (ks:ke) :: tz + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, qa + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: q_plus, q_minus + real(kind_phys) :: rh, rqi, tin, qsw, qsi, qpz, qstar, sigma, gam + real(kind_phys) :: dqdt, dq, liq, ice + real(kind_phys) :: qa10, qa100 + + real(kind_phys), dimension (ks:ke) :: q_liq, q_sol, q_cond, lcpk, icpk, tcpk, tcp3 + + real (kind = r8), dimension (ks:ke) :: cvm, te8 + + ! ----------------------------------------------------------------------- + ! calculate heat capacities and latent heat coefficients + ! ----------------------------------------------------------------------- + + call cal_mhc_lhc (ks, ke, qv, ql, qr, qi, qs, qg, q_liq, q_sol, cvm, te8, tz, & + lcpk, icpk, tcpk, tcp3) + + do k = ks, ke + + ! combine water species + + ice = q_sol (k) + q_sol (k) = qi (k) + if (rad_snow) then + q_sol (k) = qi (k) + qs (k) + if (rad_graupel) then + q_sol (k) = qi (k) + qs (k) + qg (k) + endif + endif + + liq = q_liq (k) + q_liq (k) = ql (k) + if (rad_rain) then + q_liq (k) = ql (k) + qr (k) + endif + + q_cond (k) = q_liq (k) + q_sol (k) + qpz = qv (k) + q_cond (k) + + ! use the "liquid - frozen water temperature" (tin) to compute saturated specific humidity + + ice = ice - q_sol (k) + liq = liq - q_liq (k) + tin = (te8 (k) - lv00 * qpz + li00 * ice) / mhc (qpz, liq, ice) + + ! calculate saturated specific humidity + + if (tin .le. t_wfr) then + qstar = iqs (tin, den (k), dqdt) + elseif (tin .ge. tice) then + qstar = wqs (tin, den (k), dqdt) + else + qsi = iqs (tin, den (k), dqdt) + qsw = wqs (tin, den (k), dqdt) + if (q_cond (k) .gt. qcmin) then + rqi = q_sol (k) / q_cond (k) + else + rqi = (tice - tin) / (tice - t_wfr) + endif + qstar = rqi * qsi + (1. - rqi) * qsw + endif + + ! cloud schemes + + rh = qpz / qstar + + if (cfflag .eq. 1) then + if (rh .gt. rh_thres .and. qpz .gt. qcmin) then + + dq = h_var * qpz + if (do_cld_adj) then + q_plus = qpz + dq * f_dq_p * min (1.0, max (0.0, (pz (k) - 200.e2) / & + (1000.e2 - 200.e2))) + else + q_plus = qpz + dq * f_dq_p + endif + q_minus = qpz - dq * f_dq_m + + if (icloud_f .eq. 2) then + if (qstar .lt. qpz) then + qa (k) = 1. + else + qa (k) = 0. + endif + elseif (icloud_f .eq. 3) then + if (qstar .lt. qpz) then + qa (k) = 1. + else + if (qstar .lt. q_plus) then + qa (k) = (q_plus - qstar) / (dq * f_dq_p) + else + qa (k) = 0. + endif + if (q_cond (k) .gt. qcmin) then + qa (k) = max (cld_min, qa (k)) + endif + qa (k) = min (1., qa (k)) + endif + else + if (qstar .lt. q_minus) then + qa (k) = 1. + else + if (qstar .lt. q_plus) then + if (icloud_f .eq. 0) then + qa (k) = (q_plus - qstar) / (dq * f_dq_p + dq * f_dq_m) + else + qa (k) = (q_plus - qstar) / ((dq * f_dq_p + dq * f_dq_m) * & + (1. - q_cond (k))) + endif + else + qa (k) = 0. + endif + if (q_cond (k) .gt. qcmin) then + qa (k) = max (cld_min, qa (k)) + endif + qa (k) = min (1., qa (k)) + endif + endif + else + qa (k) = 0. + endif + endif + + if (cfflag .eq. 2) then + if (rh .ge. 1.0) then + qa (k) = 1.0 + elseif (rh .gt. rh_thres .and. q_cond (k) .gt. qcmin) then + qa (k) = exp (xr_a * log (rh)) * (1.0 - exp (- xr_b * max (0.0, q_cond (k)) / & + max (1.e-5, exp (xr_c * log (max (1.e-10, 1.0 - rh) * qstar))))) + qa (k) = max (0.0, min (1., qa (k))) + else + qa (k) = 0.0 + endif + endif + + if (cfflag .eq. 3) then + if (q_cond (k) .gt. qcmin) then + qa (k) = 1. / 50. * (5.77 * (100. - gsize / 1000.) * & + exp (1.07 * log (max (qcmin * 1000., q_cond (k) * 1000.))) + & + 4.82 * (gsize / 1000. - 50.) * & + exp (0.94 * log (max (qcmin * 1000., q_cond (k) * 1000.)))) + qa (k) = qa (k) * (0.92 / 0.96 * q_liq (k) / q_cond (k) + & + 1.0 / 0.96 * q_sol (k) / q_cond (k)) + qa (k) = max (0.0, min (1., qa (k))) + else + qa (k) = 0.0 + endif + endif + + if (cfflag .eq. 4) then + sigma = 0.28 + exp (0.49 * log (max (qcmin * 1000., q_cond (k) * 1000.))) + gam = max (0.0, q_cond (k) * 1000.) / sigma + if (gam .lt. 0.18) then + qa10 = 0. + elseif (gam .gt. 2.0) then + qa10 = 1.0 + else + qa10 = - 0.1754 + 0.9811 * gam - 0.2223 * gam ** 2 + 0.0104 * gam ** 3 + qa10 = max (0.0, min (1., qa10)) + endif + if (gam .lt. 0.12) then + qa100 = 0. + elseif (gam .gt. 1.85) then + qa100 = 1.0 + else + qa100 = - 0.0913 + 0.7213 * gam + 0.1060 * gam ** 2 - 0.0946 * gam ** 3 + qa100 = max (0.0, min (1., qa100)) + endif + qa (k) = qa10 + (log10 (gsize / 1000.) - 1) * (qa100 - qa10) + qa (k) = max (0.0, min (1., qa (k))) + endif + + enddo + +end subroutine cloud_fraction + +! ======================================================================= +! piecewise parabolic lagrangian scheme +! this subroutine is the same as map1_q2 in fv_mapz_mod. +! ======================================================================= + +subroutine lagrangian_fall (ks, ke, zs, ze, zt, dp, q, precip, m1) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: zs + + real(kind_phys), intent (in), dimension (ks:ke + 1) :: ze, zt + + real(kind_phys), intent (in), dimension (ks:ke) :: dp + + real(kind_phys), intent (inout), dimension (ks:ke) :: q + + real(kind_phys), intent (inout) :: precip + + real(kind_phys), intent (out), dimension (ks:ke) :: m1 + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k, k0, n, m + + real(kind_phys) :: a4 (4, ks:ke), pl, pr, delz, esl + + real(kind_phys), parameter :: r3 = 1. / 3., r23 = 2. / 3. + + real(kind_phys), dimension (ks:ke) :: qm, dz + + ! ----------------------------------------------------------------------- + ! density: + ! ----------------------------------------------------------------------- + + do k = ks, ke + dz (k) = zt (k) - zt (k + 1) + q (k) = q (k) * dp (k) + a4 (1, k) = q (k) / dz (k) + qm (k) = 0. + enddo + + ! ----------------------------------------------------------------------- + ! construct vertical profile with zt as coordinate + ! ----------------------------------------------------------------------- + + call cs_profile (a4 (1, ks), dz (ks), ke - ks + 1) + + k0 = ks + do k = ks, ke + do n = k0, ke + if (ze (k) .le. zt (n) .and. ze (k) .ge. zt (n + 1)) then + pl = (zt (n) - ze (k)) / dz (n) + if (zt (n + 1) .le. ze (k + 1)) then + ! entire new grid is within the original grid + pr = (zt (n) - ze (k + 1)) / dz (n) + qm (k) = a4 (2, n) + 0.5 * (a4 (4, n) + a4 (3, n) - a4 (2, n)) * (pr + pl) - & + a4 (4, n) * r3 * (pr * (pr + pl) + pl ** 2) + qm (k) = qm (k) * (ze (k) - ze (k + 1)) + k0 = n + goto 555 + else + qm (k) = (ze (k) - zt (n + 1)) * (a4 (2, n) + 0.5 * (a4 (4, n) + & + a4 (3, n) - a4 (2, n)) * (1. + pl) - a4 (4, n) * (r3 * (1. + pl * (1. + pl)))) + if (n .lt. ke) then + do m = n + 1, ke + ! locate the bottom edge: ze (k + 1) + if (ze (k + 1) .lt. zt (m + 1)) then + qm (k) = qm (k) + q (m) + else + delz = zt (m) - ze (k + 1) + esl = delz / dz (m) + qm (k) = qm (k) + delz * (a4 (2, m) + 0.5 * esl * & + (a4 (3, m) - a4 (2, m) + a4 (4, m) * (1. - r23 * esl))) + k0 = m + goto 555 + endif + enddo + endif + goto 555 + endif + endif + enddo + 555 continue + enddo + + m1 (ks) = q (ks) - qm (ks) + do k = ks + 1, ke + m1 (k) = m1 (k - 1) + q (k) - qm (k) + enddo + precip = precip + m1 (ke) + + ! ----------------------------------------------------------------------- + ! convert back to * dry * mixing ratio: + ! dp must be dry air_mass (because moist air mass will be changed due to terminal fall) . + ! ----------------------------------------------------------------------- + + do k = ks, ke + q (k) = qm (k) / dp (k) + enddo + +end subroutine lagrangian_fall + +! ======================================================================= +! vertical profile reconstruction +! this subroutine is the same as cs_profile in fv_mapz_mod where iv = 0 and kord = 9 +! ======================================================================= + +subroutine cs_profile (a4, del, km) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: km + + real(kind_phys), intent (in) :: del (km) + + real(kind_phys), intent (inout) :: a4 (4, km) + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + logical :: extm (km) + + real(kind_phys) :: gam (km), q (km + 1), d4, bet, a_bot, grat, pmp, lac + real(kind_phys) :: pmp_1, lac_1, pmp_2, lac_2, da1, da2, a6da + + grat = del (2) / del (1) ! grid ratio + bet = grat * (grat + 0.5) + q (1) = (2. * grat * (grat + 1.) * a4 (1, 1) + a4 (1, 2)) / bet + gam (1) = (1. + grat * (grat + 1.5)) / bet + + do k = 2, km + d4 = del (k - 1) / del (k) + bet = 2. + 2. * d4 - gam (k - 1) + q (k) = (3. * (a4 (1, k - 1) + d4 * a4 (1, k)) - q (k - 1)) / bet + gam (k) = d4 / bet + enddo + + a_bot = 1. + d4 * (d4 + 1.5) + q (km + 1) = (2. * d4 * (d4 + 1.) * a4 (1, km) + a4 (1, km - 1) - a_bot * q (km)) & + / (d4 * (d4 + 0.5) - a_bot * gam (km)) + + do k = km, 1, - 1 + q (k) = q (k) - gam (k) * q (k + 1) + enddo + + ! ----------------------------------------------------------------------- + ! apply constraints + ! ----------------------------------------------------------------------- + + do k = 2, km + gam (k) = a4 (1, k) - a4 (1, k - 1) + enddo + + ! ----------------------------------------------------------------------- + ! top: + ! ----------------------------------------------------------------------- + + q (1) = max (q (1), 0.) + q (2) = min (q (2), max (a4 (1, 1), a4 (1, 2))) + q (2) = max (q (2), min (a4 (1, 1), a4 (1, 2)), 0.) + + ! ----------------------------------------------------------------------- + ! interior: + ! ----------------------------------------------------------------------- + + do k = 3, km - 1 + if (gam (k - 1) * gam (k + 1) .gt. 0.) then + ! apply large - scale constraints to all fields if not local max / min + q (k) = min (q (k), max (a4 (1, k - 1), a4 (1, k))) + q (k) = max (q (k), min (a4 (1, k - 1), a4 (1, k))) + else + if (gam (k - 1) .gt. 0.) then + ! there exists a local max + q (k) = max (q (k), min (a4 (1, k - 1), a4 (1, k))) + else + ! there exists a local min + q (k) = min (q (k), max (a4 (1, k - 1), a4 (1, k))) + ! positive-definite + q (k) = max (q (k), 0.0) + endif + endif + enddo + + ! ----------------------------------------------------------------------- + ! bottom: + ! ----------------------------------------------------------------------- + + q (km) = min (q (km), max (a4 (1, km - 1), a4 (1, km))) + q (km) = max (q (km), min (a4 (1, km - 1), a4 (1, km)), 0.) + q (km + 1) = max (q (km + 1), 0.) + + do k = 1, km + a4 (2, k) = q (k) + a4 (3, k) = q (k + 1) + enddo + + do k = 1, km + if (k .eq. 1 .or. k .eq. km) then + extm (k) = (a4 (2, k) - a4 (1, k)) * (a4 (3, k) - a4 (1, k)) .gt. 0. + else + extm (k) = gam (k) * gam (k + 1) .lt. 0. + endif + enddo + + ! ----------------------------------------------------------------------- + ! apply constraints + ! f (s) = al + s * [ (ar - al) + a6 * (1 - s) ] (0 <= s <= 1) + ! always use monotonic mapping + ! ----------------------------------------------------------------------- + + ! ----------------------------------------------------------------------- + ! top: + ! ----------------------------------------------------------------------- + + a4 (2, 1) = max (0., a4 (2, 1)) + + ! ----------------------------------------------------------------------- + ! Huynh's 2nd constraint for interior: + ! ----------------------------------------------------------------------- + + do k = 3, km - 2 + if (extm (k)) then + ! positive definite constraint only if true local extrema + if (a4 (1, k) .lt. qcmin .or. extm (k - 1) .or. extm (k + 1)) then + a4 (2, k) = a4 (1, k) + a4 (3, k) = a4 (1, k) + endif + else + a4 (4, k) = 6. * a4 (1, k) - 3. * (a4 (2, k) + a4 (3, k)) + if (abs (a4 (4, k)) .gt. abs (a4 (2, k) - a4 (3, k))) then + ! check within the smooth region if subgrid profile is non - monotonic + pmp_1 = a4 (1, k) - 2.0 * gam (k + 1) + lac_1 = pmp_1 + 1.5 * gam (k + 2) + a4 (2, k) = min (max (a4 (2, k), min (a4 (1, k), pmp_1, lac_1)), & + max (a4 (1, k), pmp_1, lac_1)) + pmp_2 = a4 (1, k) + 2.0 * gam (k) + lac_2 = pmp_2 - 1.5 * gam (k - 1) + a4 (3, k) = min (max (a4 (3, k), min (a4 (1, k), pmp_2, lac_2)), & + max (a4 (1, k), pmp_2, lac_2)) + endif + endif + enddo + + do k = 1, km - 1 + a4 (4, k) = 6. * a4 (1, k) - 3. * (a4 (2, k) + a4 (3, k)) + enddo + + k = km - 1 + if (extm (k)) then + a4 (2, k) = a4 (1, k) + a4 (3, k) = a4 (1, k) + a4 (4, k) = 0. + else + da1 = a4 (3, k) - a4 (2, k) + da2 = da1 ** 2 + a6da = a4 (4, k) * da1 + if (a6da .lt. - da2) then + a4 (4, k) = 3. * (a4 (2, k) - a4 (1, k)) + a4 (3, k) = a4 (2, k) - a4 (4, k) + elseif (a6da .gt. da2) then + a4 (4, k) = 3. * (a4 (3, k) - a4 (1, k)) + a4 (2, k) = a4 (3, k) - a4 (4, k) + endif + endif + + call cs_limiters (km - 1, a4) + + ! ----------------------------------------------------------------------- + ! bottom: + ! ----------------------------------------------------------------------- + + a4 (2, km) = a4 (1, km) + a4 (3, km) = a4 (1, km) + a4 (4, km) = 0. + +end subroutine cs_profile + +! ======================================================================= +! cubic spline (cs) limiters or boundary conditions +! a positive-definite constraint (iv = 0) is applied to tracers in every layer, +! adjusting the top-most and bottom-most interface values to enforce positive. +! this subroutine is the same as cs_limiters in fv_mapz_mod where iv = 0. +! ======================================================================= + +subroutine cs_limiters (km, a4) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: km + + real(kind_phys), intent (inout) :: a4 (4, km) ! ppm array + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys), parameter :: r12 = 1. / 12. + + do k = 1, km + if (a4 (1, k) .le. 0.) then + a4 (2, k) = a4 (1, k) + a4 (3, k) = a4 (1, k) + a4 (4, k) = 0. + else + if (abs (a4 (3, k) - a4 (2, k)) .lt. - a4 (4, k)) then + if ((a4 (1, k) + 0.25 * (a4 (3, k) - a4 (2, k)) ** 2 / a4 (4, k) + & + a4 (4, k) * r12) .lt. 0.) then + ! local minimum is negative + if (a4 (1, k) .lt. a4 (3, k) .and. a4 (1, k) .lt. a4 (2, k)) then + a4 (3, k) = a4 (1, k) + a4 (2, k) = a4 (1, k) + a4 (4, k) = 0. + elseif (a4 (3, k) .gt. a4 (2, k)) then + a4 (4, k) = 3. * (a4 (2, k) - a4 (1, k)) + a4 (3, k) = a4 (2, k) - a4 (4, k) + else + a4 (4, k) = 3. * (a4 (3, k) - a4 (1, k)) + a4 (2, k) = a4 (3, k) - a4 (4, k) + endif + endif + endif + endif + enddo + +end subroutine cs_limiters + +! ======================================================================= +! time-implicit monotonic scheme +! ======================================================================= + +subroutine implicit_fall (dts, ks, ke, ze, vt, dp, q, precip, m1) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke + 1) :: ze + + real(kind_phys), intent (in), dimension (ks:ke) :: vt, dp + + real(kind_phys), intent (inout), dimension (ks:ke) :: q + + real(kind_phys), intent (inout) :: precip + + real(kind_phys), intent (out), dimension (ks:ke) :: m1 + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys), dimension (ks:ke) :: dz, qm, dd + + do k = ks, ke + dz (k) = ze (k) - ze (k + 1) + dd (k) = dts * vt (k) + q (k) = q (k) * dp (k) + enddo + + qm (ks) = q (ks) / (dz (ks) + dd (ks)) + do k = ks + 1, ke + qm (k) = (q (k) + qm (k - 1) * dd (k - 1)) / (dz (k) + dd (k)) + enddo + + do k = ks, ke + qm (k) = qm (k) * dz (k) + enddo + + m1 (ks) = q (ks) - qm (ks) + do k = ks + 1, ke + m1 (k) = m1 (k - 1) + q (k) - qm (k) + enddo + precip = precip + m1 (ke) + + do k = ks, ke + q (k) = qm (k) / dp (k) + enddo + +end subroutine implicit_fall + +! ======================================================================= +! time-explicit monotonic scheme +! ======================================================================= + +subroutine explicit_fall (dts, ks, ke, ze, vt, dp, q, precip, m1) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke + 1) :: ze + + real(kind_phys), intent (in), dimension (ks:ke) :: vt, dp + + real(kind_phys), intent (inout), dimension (ks:ke) :: q + + real(kind_phys), intent (inout) :: precip + + real(kind_phys), intent (out), dimension (ks:ke) :: m1 + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: n, k, nstep + + real(kind_phys), dimension (ks:ke) :: dz, qm, q0, dd + + do k = ks, ke + dz (k) = ze (k) - ze (k + 1) + dd (k) = dts * vt (k) + q0 (k) = q (k) * dp (k) + enddo + + nstep = 1 + int (maxval (dd / dz)) + do k = ks, ke + dd (k) = dd (k) / nstep + q (k) = q0 (k) + enddo + + do n = 1, nstep + qm (ks) = q (ks) - q (ks) * dd (ks) / dz (ks) + do k = ks + 1, ke + qm (k) = q (k) - q (k) * dd (k) / dz (k) + q (k - 1) * dd (k - 1) / dz (k - 1) + enddo + q = qm + enddo + + m1 (ks) = q0 (ks) - qm (ks) + do k = ks + 1, ke + m1 (k) = m1 (k - 1) + q0 (k) - qm (k) + enddo + precip = precip + m1 (ke) + + do k = ks, ke + q (k) = qm (k) / dp (k) + enddo + +end subroutine explicit_fall + +! ======================================================================= +! combine time-implicit monotonic scheme with the piecewise parabolic lagrangian scheme +! ======================================================================= + +subroutine implicit_lagrangian_fall (dts, ks, ke, zs, ze, zt, vt, dp, q, & + precip, flux, sed_fac) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: zs, dts, sed_fac + + real(kind_phys), intent (in), dimension (ks:ke + 1) :: ze, zt + + real(kind_phys), intent (in), dimension (ks:ke) :: vt, dp + + real(kind_phys), intent (inout), dimension (ks:ke) :: q + + real(kind_phys), intent (inout) :: precip + + real(kind_phys), intent (out), dimension (ks:ke) :: flux + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + real(kind_phys) :: pre0, pre1 + + real(kind_phys), dimension (ks:ke) :: q0, q1, m0, m1 + + q0 = q + pre0 = precip + + call implicit_fall (dts, ks, ke, ze, vt, dp, q0, pre0, m0) + + q1 = q + pre1 = precip + + call lagrangian_fall (ks, ke, zs, ze, zt, dp, q1, pre1, m1) + + q = q0 * sed_fac + q1 * (1.0 - sed_fac) + flux = m0 * sed_fac + m1 * (1.0 - sed_fac) + precip = pre0 * sed_fac + pre1 * (1.0 - sed_fac) + +end subroutine implicit_lagrangian_fall + +! ======================================================================= +! vertical subgrid variability used for cloud ice and cloud water autoconversion +! edges: qe == qbar + / - dm +! ======================================================================= + +subroutine linear_prof (km, q, dm, z_var, h_var) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: km + + logical, intent (in) :: z_var + + real(kind_phys), intent (in) :: q (km), h_var + + real(kind_phys), intent (out) :: dm (km) + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: dq (km) + + if (z_var) then + do k = 2, km + dq (k) = 0.5 * (q (k) - q (k - 1)) + enddo + dm (1) = 0. + ! ----------------------------------------------------------------------- + ! use twice the strength of the positive definiteness limiter (Lin et al. 1994) + ! ----------------------------------------------------------------------- + do k = 2, km - 1 + dm (k) = 0.5 * min (abs (dq (k) + dq (k + 1)), 0.5 * q (k)) + if (dq (k) * dq (k + 1) .le. 0.) then + if (dq (k) .gt. 0.) then + dm (k) = min (dm (k), dq (k), - dq (k + 1)) + else + dm (k) = 0. + endif + endif + enddo + dm (km) = 0. + ! ----------------------------------------------------------------------- + ! impose a presumed background horizontal variability that is proportional to the value itself + ! ----------------------------------------------------------------------- + do k = 1, km + dm (k) = max (dm (k), 0.0, h_var * q (k)) + enddo + else + do k = 1, km + dm (k) = max (0.0, h_var * q (k)) + enddo + endif + +end subroutine linear_prof + +! ======================================================================= +! accretion function, Lin et al. (1983) +! ======================================================================= + +function acr2d (qden, c, denfac, blin, mu) + + implicit none + + real(kind_phys) :: acr2d + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: qden, c, denfac, blin, mu + + acr2d = denfac * c * exp ((2 + mu + blin) / (mu + 3) * log (6 * qden)) + +end function acr2d + +! ======================================================================= +! accretion function, Lin et al. (1983) +! ======================================================================= + +function acr3d (v1, v2, q1, q2, c, acco, acc1, acc2, den) + + implicit none + + real(kind_phys) :: acr3d + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: v1, v2, c, den, q1, q2, acco (3), acc1, acc2 + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: i + + real(kind_phys) :: t1, t2, tmp, vdiff + + t1 = exp (1. / (acc1 + 3) * log (6 * q1 * den)) + t2 = exp (1. / (acc2 + 3) * log (6 * q2 * den)) + + if (vdiffflag .eq. 1) vdiff = abs (v1 - v2) + if (vdiffflag .eq. 2) vdiff = sqrt ((1.20 * v1 - 0.95 * v2) ** 2. + 0.08 * v1 * v2) + if (vdiffflag .eq. 3) vdiff = sqrt ((1.00 * v1 - 1.00 * v2) ** 2. + 0.04 * v1 * v2) + + acr3d = c * vdiff / den + + tmp = 0 + do i = 1, 3 + tmp = tmp + acco (i) * exp ((6 + acc1 - i) * log (t1)) * exp ((acc2 + i - 1) * log (t2)) + enddo + + acr3d = acr3d * tmp + +end function acr3d + +! ======================================================================= +! ventilation coefficient, Lin et al. (1983) +! ======================================================================= + +function vent_coeff (qden, c1, c2, denfac, blin, mu) + + implicit none + + real(kind_phys) :: vent_coeff + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: qden, c1, c2, denfac, blin, mu + + vent_coeff = c1 + c2 * exp ((3 + 2 * mu + blin) / (mu + 3) / 2 * log (6 * qden)) * & + sqrt (denfac) / exp ((1 + mu) / (mu + 3) * log (6 * qden)) + +end function vent_coeff + +! ======================================================================= +! sublimation or evaporation function, Lin et al. (1983) +! ======================================================================= + +function psub (t2, dq, qden, qsat, c, den, denfac, blin, mu, cpk, cvm) + + implicit none + + real(kind_phys) :: psub + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: t2, dq, qden, qsat, c (5), den, denfac, blin, cpk, mu + + real (kind = r8), intent (in) :: cvm + + psub = c (1) * t2 * dq * exp ((1 + mu) / (mu + 3) * log (6 * qden)) * & + vent_coeff (qden, c (2), c (3), denfac, blin, mu) / & + (c (4) * t2 + c (5) * (cpk * cvm) ** 2 * qsat * den) + +end function psub + +! ======================================================================= +! melting function, Lin et al. (1983) +! ======================================================================= + +function pmlt (tc, dq, qden, pxacw, pxacr, c, den, denfac, blin, mu, lcpk, icpk, cvm) + + implicit none + + real(kind_phys) :: pmlt + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: tc, dq, qden, pxacw, pxacr, c (4), den, denfac, blin, lcpk, icpk, mu + + real (kind = r8), intent (in) :: cvm + + pmlt = (c (1) / (icpk * cvm) * tc / den - c (2) * lcpk / icpk * dq) * & + exp ((1 + mu) / (mu + 3) * log (6 * qden)) * & + vent_coeff (qden, c (3), c (4), denfac, blin, mu) + & + c_liq / (icpk * cvm) * tc * (pxacw + pxacr) + +end function pmlt + +! ======================================================================= +! sedimentation of horizontal momentum +! ======================================================================= + +subroutine sedi_uv (ks, ke, m1, dp, u, v) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in), dimension (ks:ke) :: m1, dp + + real(kind_phys), intent (inout), dimension (ks:ke) :: u, v + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + do k = ks + 1, ke + u (k) = (dp (k) * u (k) + m1 (k - 1) * u (k - 1)) / (dp (k) + m1 (k - 1)) + v (k) = (dp (k) * v (k) + m1 (k - 1) * v (k - 1)) / (dp (k) + m1 (k - 1)) + enddo + +end subroutine sedi_uv + +! ======================================================================= +! sedimentation of vertical momentum +! ======================================================================= + +subroutine sedi_w (ks, ke, m1, w, vt, dm) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in), dimension (ks:ke) :: m1, vt, dm + + real(kind_phys), intent (inout), dimension (ks:ke) :: w + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + w (ks) = w (ks) + m1 (ks) * vt (ks) / dm (ks) + do k = ks + 1, ke + w (k) = (dm (k) * w (k) + m1 (k - 1) * (w (k - 1) - vt (k - 1)) + m1 (k) * vt (k)) / & + (dm (k) + m1 (k - 1)) + enddo + +end subroutine sedi_w + +! ======================================================================= +! sedimentation of heat +! ======================================================================= + +subroutine sedi_heat (ks, ke, dm, m1, dz, tz, qv, ql, qr, qi, qs, qg, cw) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: cw + + real(kind_phys), intent (in), dimension (ks:ke) :: dm, m1, dz, qv, ql, qr, qi, qs, qg + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys), dimension (ks:ke) :: dgz, cv0 + + do k = ks + 1, ke + dgz (k) = - 0.5 * grav * (dz (k - 1) + dz (k)) + cv0 (k) = dm (k) * (cv_air + qv (k) * cv_vap + (qr (k) + ql (k)) * c_liq + & + (qi (k) + qs (k) + qg (k)) * c_ice) + cw * (m1 (k) - m1 (k - 1)) + enddo + + do k = ks + 1, ke + tz (k) = (cv0 (k) * tz (k) + m1 (k - 1) * (cw * tz (k - 1) + dgz (k))) / & + (cv0 (k) + cw * m1 (k - 1)) + enddo + +end subroutine sedi_heat + +! ======================================================================= +! fast saturation adjustments +! ======================================================================= + +subroutine cld_sat_adj (dtm, is, ie, ks, ke, hydrostatic, consv_te, & + adj_vmr, te, dte, qv, ql, qr, qi, qs, qg, qa, qnl, qni, hs, delz, & + pt, delp, q_con, cappa, gsize, last_step, do_sat_adj) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: is, ie, ks, ke + + logical, intent (in) :: hydrostatic, last_step, consv_te, do_sat_adj + + real(kind_phys), intent (in) :: dtm + + real(kind_phys), intent (in), dimension (is:ie) :: hs, gsize + + real(kind_phys), intent (in), dimension (is:ie, ks:ke) :: qnl, qni + + real(kind_phys), intent (inout), dimension (is:ie, ks:ke) :: delp, delz, pt, te + real(kind_phys), intent (inout), dimension (is:ie, ks:ke) :: qv, ql, qr, qi, qs, qg, qa + + real(kind_phys), intent (inout), dimension (is:, ks:) :: q_con, cappa + + real(kind_phys), intent (out), dimension (is:ie, ks:ke) :: adj_vmr + + real (kind = r8), intent (out), dimension (is:ie) :: dte + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + real(kind_phys), dimension (is:ie, ks:ke) :: ua, va, wa, prefluxw, prefluxr, prefluxi, prefluxs, prefluxg + + real(kind_phys), dimension (is:ie) :: water, rain, ice, snow, graupel + + ! ----------------------------------------------------------------------- + ! initialization + ! ----------------------------------------------------------------------- + + ua = 0.0 + va = 0.0 + wa = 0.0 + + water = 0.0 + rain = 0.0 + ice = 0.0 + snow = 0.0 + graupel = 0.0 + + prefluxw = 0.0 + prefluxr = 0.0 + prefluxi = 0.0 + prefluxs = 0.0 + prefluxg = 0.0 + + ! ----------------------------------------------------------------------- + ! major cloud microphysics driver + ! ----------------------------------------------------------------------- + + call mpdrv (hydrostatic, ua, va, wa, delp, pt, qv, ql, qr, qi, qs, qg, qa, & + qnl, qni, delz, is, ie, ks, ke, dtm, water, rain, ice, snow, graupel, & + gsize, hs, q_con, cappa, consv_te, adj_vmr, te, dte, prefluxw, prefluxr, & + prefluxi, prefluxs, prefluxg, last_step, .false., do_sat_adj, .false.) + +end subroutine cld_sat_adj + +! ======================================================================= +! rain freezing to form graupel, simple version +! ======================================================================= + +subroutine pgfr_simp (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, & + lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, sink, fac_r2g + + fac_r2g = 1. - exp (- dts / tau_r2g) + + do k = ks, ke + + tc = tz (k) - tice + + if (tc .lt. 0. .and. qr (k) .gt. qcmin) then + + sink = (- tc * 0.025) ** 2 * qr (k) + sink = min (qr (k), sink, - fac_r2g * tc / icpk (k)) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., - sink, 0., 0., sink, te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine pgfr_simp + +! ======================================================================= +! snow melting to form cloud water and rain, simple version +! ======================================================================= + +subroutine psmlt_simp (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, cvm, te8, & + lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real (kind = r8), intent (in), dimension (ks:ke) :: te8 + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + real(kind_phys), intent (inout), dimension (ks:ke) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (inout), dimension (ks:ke) :: cvm, tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, tmp, sink, fac_smlt + + fac_smlt = 1. - exp (- dts / tau_smlt) + + do k = ks, ke + + tc = tz (k) - tice + + if (tc .ge. 0. .and. qs (k) .gt. qcmin) then + + sink = (tc * 0.1) ** 2 * qs (k) + sink = min (qs (k), sink, fac_smlt * tc / icpk (k)) + tmp = min (sink, dim (qs_mlt, ql (k))) + + call update_qt (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., tmp, sink - tmp, 0., - sink, 0., te8 (k), cvm (k), tz (k), & + lcpk (k), icpk (k), tcpk (k), tcp3 (k)) + + endif + + enddo + +end subroutine psmlt_simp + +! ======================================================================= +! cloud water to rain autoconversion, simple version +! ======================================================================= + +subroutine praut_simp (ks, ke, dts, tz, qv, ql, qr, qi, qs, qg) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, sink, fac_l2r + + fac_l2r = 1. - exp (- dts / tau_l2r) + + do k = ks, ke + + tc = tz (k) - t_wfr + + if (tc .gt. 0 .and. ql (k) .gt. ql0_max) then + + sink = fac_l2r * (ql (k) - ql0_max) + + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., - sink, sink, 0., 0., 0.) + + endif + + enddo + +end subroutine praut_simp + +! ======================================================================= +! cloud ice to snow autoconversion, simple version +! ======================================================================= + +subroutine psaut_simp (ks, ke, dts, qv, ql, qr, qi, qs, qg, tz, den) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in) :: dts + + real(kind_phys), intent (in), dimension (ks:ke) :: den + + real(kind_phys), intent (inout), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + + real (kind = r8), intent (inout), dimension (ks:ke) :: tz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: tc, sink, fac_i2s, qim + + fac_i2s = 1. - exp (- dts / tau_i2s) + + do k = ks, ke + + tc = tz (k) - tice + + qim = qi0_max / den (k) + + if (tc .lt. 0. .and. qi (k) .gt. qim) then + + sink = fac_i2s * (qi (k) - qim) + + call update_qq (qv (k), ql (k), qr (k), qi (k), qs (k), qg (k), & + 0., 0., 0., - sink, sink, 0.) + + endif + + enddo + +end subroutine psaut_simp + +! ======================================================================= +! cloud radii diagnosis built for gfdl cloud microphysics +! ======================================================================= + +subroutine cld_eff_rad (is, ie, ks, ke, lsm, p, delp, t, qv, qw, qi, qr, qs, qg, qa, & + rew, rei, rer, res, reg, snowd, cnvw, cnvi) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: is, ie, ks, ke + + real(kind_phys), intent (in), dimension (is:ie) :: lsm, snowd + + real(kind_phys), intent (in), dimension (is:ie, ks:ke) :: delp, t, p + real(kind_phys), intent (in), dimension (is:ie, ks:ke) :: qv, qw, qi, qr, qs, qg, qa + + real(kind_phys), intent (in), dimension (is:ie, ks:ke), optional :: cnvw, cnvi + + real(kind_phys), intent (inout), dimension (is:ie, ks:ke) :: rew, rei, rer, res, reg + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: i, k, ind + + real(kind_phys), dimension (is:ie, ks:ke) :: qcw, qci, qcr, qcs, qcg + real(kind_phys), dimension (is:ie, ks:ke) :: qmw, qmr, qmi, qms, qmg + + real(kind_phys) :: dpg, rho, ccnw, mask, cor, tc, bw + real(kind_phys) :: lambdaw, lambdar, lambdai, lambdas, lambdag, rei_fac + + real(kind_phys) :: retab (138) = (/ & + 0.05000, 0.05000, 0.05000, 0.05000, 0.05000, 0.05000, & + 0.05500, 0.06000, 0.07000, 0.08000, 0.09000, 0.10000, & + 0.20000, 0.30000, 0.40000, 0.50000, 0.60000, 0.70000, & + 0.80000, 0.90000, 1.00000, 1.10000, 1.20000, 1.30000, & + 1.40000, 1.50000, 1.60000, 1.80000, 2.00000, 2.20000, & + 2.40000, 2.60000, 2.80000, 3.00000, 3.20000, 3.50000, & + 3.80000, 4.10000, 4.40000, 4.70000, 5.00000, 5.30000, & + 5.60000, 5.92779, 6.26422, 6.61973, 6.99539, 7.39234, & + 7.81177, 8.25496, 8.72323, 9.21800, 9.74075, 10.2930, & + 10.8765, 11.4929, 12.1440, 12.8317, 13.5581, 14.2319, & + 15.0351, 15.8799, 16.7674, 17.6986, 18.6744, 19.6955, & + 20.7623, 21.8757, 23.0364, 24.2452, 25.5034, 26.8125, & + 27.7895, 28.6450, 29.4167, 30.1088, 30.7306, 31.2943, & + 31.8151, 32.3077, 32.7870, 33.2657, 33.7540, 34.2601, & + 34.7892, 35.3442, 35.9255, 36.5316, 37.1602, 37.8078, & + 38.4720, 39.1508, 39.8442, 40.5552, 41.2912, 42.0635, & + 42.8876, 43.7863, 44.7853, 45.9170, 47.2165, 48.7221, & + 50.4710, 52.4980, 54.8315, 57.4898, 60.4785, 63.7898, & + 65.5604, 71.2885, 75.4113, 79.7368, 84.2351, 88.8833, & + 93.6658, 98.5739, 103.603, 108.752, 114.025, 119.424, & + 124.954, 130.630, 136.457, 142.446, 148.608, 154.956, & + 161.503, 168.262, 175.248, 182.473, 189.952, 197.699, & + 205.728, 214.055, 222.694, 231.661, 240.971, 250.639 /) + + qmw = qw + qmi = qi + qmr = qr + qms = qs + qmg = qg + + ! ----------------------------------------------------------------------- + ! merge convective cloud to total cloud + ! ----------------------------------------------------------------------- + + if (present (cnvw)) then + qmw = qmw + cnvw + endif + if (present (cnvi)) then + qmi = qmi + cnvi + endif + + ! ----------------------------------------------------------------------- + ! combine liquid and solid phases + ! ----------------------------------------------------------------------- + + if (liq_ice_combine) then + do i = is, ie + do k = ks, ke + qmw (i, k) = qmw (i, k) + qmr (i, k) + qmr (i, k) = 0.0 + qmi (i, k) = qmi (i, k) + qms (i, k) + qmg (i, k) + qms (i, k) = 0.0 + qmg (i, k) = 0.0 + enddo + enddo + endif + + ! ----------------------------------------------------------------------- + ! combine snow and graupel + ! ----------------------------------------------------------------------- + + if (snow_grauple_combine) then + do i = is, ie + do k = ks, ke + qms (i, k) = qms (i, k) + qmg (i, k) + qmg (i, k) = 0.0 + enddo + enddo + endif + + do i = is, ie + + do k = ks, ke + + qmw (i, k) = max (qmw (i, k), qcmin) + qmi (i, k) = max (qmi (i, k), qcmin) + qmr (i, k) = max (qmr (i, k), qcmin) + qms (i, k) = max (qms (i, k), qcmin) + qmg (i, k) = max (qmg (i, k), qcmin) + + + mask = min (max (lsm (i), 0.0), 2.0) + + dpg = abs (delp (i, k)) / grav + rho = p (i, k) / (rdgas * t (i, k) * (1. + zvir * qv (i, k))) + + tc = t (i, k) - tice + + if (rewflag .eq. 1) then + + ! ----------------------------------------------------------------------- + ! cloud water (Martin et al. 1994) + ! ----------------------------------------------------------------------- + + if (prog_ccn) then + ! boucher and lohmann (1995) + ccnw = (1.0 - abs (mask - 1.0)) * & + (10. ** 2.24 * (qa (i, k) * rho * 1.e9) ** 0.257) + & + abs (mask - 1.0) * & + (10. ** 2.06 * (qa (i, k) * rho * 1.e9) ** 0.48) + else + ccnw = ccn_o * abs (mask - 1.0) + ccn_l * (1.0 - abs (mask - 1.0)) + endif + + if (qmw (i, k) .gt. qcmin) then + qcw (i, k) = dpg * qmw (i, k) * 1.0e3 + rew (i, k) = exp (1.0 / 3.0 * log ((3.0 * qmw (i, k) * rho) / & + (4.0 * pi * rhow * ccnw))) * 1.0e4 + rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) + else + qcw (i, k) = 0.0 + rew (i, k) = rewmin + endif + + endif + + if (rewflag .eq. 2) then + + ! ----------------------------------------------------------------------- + ! cloud water (Martin et al. 1994, gfdl revision) + ! ----------------------------------------------------------------------- + + if (prog_ccn) then + ! boucher and lohmann (1995) + ccnw = (1.0 - abs (mask - 1.0)) * & + (10. ** 2.24 * (qa (i, k) * rho * 1.e9) ** 0.257) + & + abs (mask - 1.0) * & + (10. ** 2.06 * (qa (i, k) * rho * 1.e9) ** 0.48) + else + ccnw = 1.077 * ccn_o * abs (mask - 1.0) + 1.143 * ccn_l * (1.0 - abs (mask - 1.0)) + endif + + if (qmw (i, k) .gt. qcmin) then + qcw (i, k) = dpg * qmw (i, k) * 1.0e3 + rew (i, k) = exp (1.0 / 3.0 * log ((3.0 * qmw (i, k) * rho) / & + (4.0 * pi * rhow * ccnw))) * 1.0e4 + rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) + else + qcw (i, k) = 0.0 + rew (i, k) = rewmin + endif + + endif + + if (rewflag .eq. 3) then + + ! ----------------------------------------------------------------------- + ! cloud water (Kiehl et al. 1994) + ! ----------------------------------------------------------------------- + + if (qmw (i, k) .gt. qcmin) then + qcw (i, k) = dpg * qmw (i, k) * 1.0e3 + rew (i, k) = 14.0 * abs (mask - 1.0) + & + (8.0 + (14.0 - 8.0) * min (1.0, max (0.0, - tc / 30.0))) * & + (1.0 - abs (mask - 1.0)) + rew (i, k) = rew (i, k) + (14.0 - rew (i, k)) * & + min (1.0, max (0.0, snowd (i) / 1000.0)) ! snowd is in mm + rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) + else + qcw (i, k) = 0.0 + rew (i, k) = rewmin + endif + + endif + + if (rewflag .eq. 4) then + + ! ----------------------------------------------------------------------- + ! cloud water derived from PSD + ! ----------------------------------------------------------------------- + + if (qmw (i, k) .gt. qcmin) then + qcw (i, k) = dpg * qmw (i, k) * 1.0e3 + call cal_pc_ed_oe_rr_tv (qmw (i, k), rho, blinw, muw, & + eda = edaw, edb = edbw, ed = rew (i, k)) + rew (i, k) = rewfac * 0.5 * rew (i, k) * 1.0e6 + rew (i, k) = max (rewmin, min (rewmax, rew (i, k))) + else + qcw (i, k) = 0.0 + rew (i, k) = rewmin + endif + + endif + + if (reiflag .eq. 1) then + + ! ----------------------------------------------------------------------- + ! cloud ice (Heymsfield and Mcfarquhar 1996) + ! ----------------------------------------------------------------------- + + if (qmi (i, k) .gt. qcmin) then + qci (i, k) = dpg * qmi (i, k) * 1.0e3 + rei_fac = log (1.0e3 * qmi (i, k) * rho) + if (tc .lt. - 50) then + rei (i, k) = beta / 9.917 * exp (0.109 * rei_fac) * 1.0e3 + elseif (tc .lt. - 40) then + rei (i, k) = beta / 9.337 * exp (0.080 * rei_fac) * 1.0e3 + elseif (tc .lt. - 30) then + rei (i, k) = beta / 9.208 * exp (0.055 * rei_fac) * 1.0e3 + else + rei (i, k) = beta / 9.387 * exp (0.031 * rei_fac) * 1.0e3 + endif + rei (i, k) = max (reimin, min (reimax, rei (i, k))) + else + qci (i, k) = 0.0 + rei (i, k) = reimin + endif + + endif + + if (reiflag .eq. 2) then + + ! ----------------------------------------------------------------------- + ! cloud ice (Donner et al. 1997) + ! ----------------------------------------------------------------------- + + if (qmi (i, k) .gt. qcmin) then + qci (i, k) = dpg * qmi (i, k) * 1.0e3 + if (tc .le. - 55) then + rei (i, k) = 15.41627 + elseif (tc .le. - 50) then + rei (i, k) = 16.60895 + elseif (tc .le. - 45) then + rei (i, k) = 32.89967 + elseif (tc .le. - 40) then + rei (i, k) = 35.29989 + elseif (tc .le. - 35) then + rei (i, k) = 55.65818 + elseif (tc .le. - 30) then + rei (i, k) = 85.19071 + elseif (tc .le. - 25) then + rei (i, k) = 72.35392 + else + rei (i, k) = 92.46298 + endif + rei (i, k) = max (reimin, min (reimax, rei (i, k))) + else + qci (i, k) = 0.0 + rei (i, k) = reimin + endif + + endif + + if (reiflag .eq. 3) then + + ! ----------------------------------------------------------------------- + ! cloud ice (Fu 2007) + ! ----------------------------------------------------------------------- + + if (qmi (i, k) .gt. qcmin) then + qci (i, k) = dpg * qmi (i, k) * 1.0e3 + rei (i, k) = 47.05 + tc * (0.6624 + 0.001741 * tc) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) + else + qci (i, k) = 0.0 + rei (i, k) = reimin + endif + + endif + + if (reiflag .eq. 4) then + + ! ----------------------------------------------------------------------- + ! cloud ice (Kristjansson et al. 2000) + ! ----------------------------------------------------------------------- + + if (qmi (i, k) .gt. qcmin) then + qci (i, k) = dpg * qmi (i, k) * 1.0e3 + ind = min (max (int (t (i, k) - 136.0), 44), 138 - 1) + cor = t (i, k) - int (t (i, k)) + rei (i, k) = retab (ind) * (1. - cor) + retab (ind + 1) * cor + rei (i, k) = max (reimin, min (reimax, rei (i, k))) + else + qci (i, k) = 0.0 + rei (i, k) = reimin + endif + + endif + + if (reiflag .eq. 5) then + + ! ----------------------------------------------------------------------- + ! cloud ice (Wyser 1998) + ! ----------------------------------------------------------------------- + + if (qmi (i, k) .gt. qcmin) then + qci (i, k) = dpg * qmi (i, k) * 1.0e3 + bw = - 2. + 1.e-3 * log10 (rho * qmi (i, k) / 50.e-3) * & + exp (1.5 * log (max (1.e-10, - tc))) + rei (i, k) = 377.4 + bw * (203.3 + bw * (37.91 + 2.3696 * bw)) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) + else + qci (i, k) = 0.0 + rei (i, k) = reimin + endif + + endif + + if (reiflag .eq. 6) then + + ! ----------------------------------------------------------------------- + ! cloud ice (Sun and Rikus 1999, Sun 2001) + ! ----------------------------------------------------------------------- + + if (qmi (i, k) .gt. qcmin) then + qci (i, k) = dpg * qmi (i, k) * 1.0e3 + rei_fac = log (1.0e3 * qmi (i, k) * rho) + rei (i, k) = 45.8966 * exp (0.2214 * rei_fac) + & + 0.7957 * exp (0.2535 * rei_fac) * (tc + 190.0) + rei (i, k) = (1.2351 + 0.0105 * tc) * rei (i, k) + rei (i, k) = max (reimin, min (reimax, rei (i, k))) + else + qci (i, k) = 0.0 + rei (i, k) = reimin + endif + + endif + + if (reiflag .eq. 7) then + + ! ----------------------------------------------------------------------- + ! cloud ice derived from PSD + ! ----------------------------------------------------------------------- + + if (qmi (i, k) .gt. qcmin) then + qci (i, k) = dpg * qmi (i, k) * 1.0e3 + call cal_pc_ed_oe_rr_tv (qmi (i, k), rho, blini, mui, & + eda = edai, edb = edbi, ed = rei (i, k)) + rei (i, k) = reifac * 0.5 * rei (i, k) * 1.0e6 + rei (i, k) = max (reimin, min (reimax, rei (i, k))) + else + qci (i, k) = 0.0 + rei (i, k) = reimin + endif + + endif + + if (rerflag .eq. 1) then + + ! ----------------------------------------------------------------------- + ! rain derived from PSD + ! ----------------------------------------------------------------------- + + if (qmr (i, k) .gt. qcmin) then + qcr (i, k) = dpg * qmr (i, k) * 1.0e3 + call cal_pc_ed_oe_rr_tv (qmr (i, k), rho, blinr, mur, & + eda = edar, edb = edbr, ed = rer (i, k)) + rer (i, k) = 0.5 * rer (i, k) * 1.0e6 + rer (i, k) = max (rermin, min (rermax, rer (i, k))) + else + qcr (i, k) = 0.0 + rer (i, k) = rermin + endif + + endif + + if (resflag .eq. 1) then + + ! ----------------------------------------------------------------------- + ! snow derived from PSD + ! ----------------------------------------------------------------------- + + if (qms (i, k) .gt. qcmin) then + qcs (i, k) = dpg * qms (i, k) * 1.0e3 + call cal_pc_ed_oe_rr_tv (qms (i, k), rho, blins, mus, & + eda = edas, edb = edbs, ed = res (i, k)) + res (i, k) = 0.5 * res (i, k) * 1.0e6 + res (i, k) = max (resmin, min (resmax, res (i, k))) + else + qcs (i, k) = 0.0 + res (i, k) = resmin + endif + + endif + + if (regflag .eq. 1) then + + ! ----------------------------------------------------------------------- + ! graupel derived from PSD + ! ----------------------------------------------------------------------- + + if (qmg (i, k) .gt. qcmin) then + qcg (i, k) = dpg * qmg (i, k) * 1.0e3 + if (do_hail) then + call cal_pc_ed_oe_rr_tv (qmg (i, k), rho, blinh, muh, & + eda = edah, edb = edbh, ed = reg (i, k)) + else + call cal_pc_ed_oe_rr_tv (qmg (i, k), rho, bling, mug, & + eda = edag, edb = edbg, ed = reg (i, k)) + endif + reg (i, k) = 0.5 * reg (i, k) * 1.0e6 + reg (i, k) = max (regmin, min (regmax, reg (i, k))) + else + qcg (i, k) = 0.0 + reg (i, k) = regmin + endif + + endif + + enddo + + enddo + +end subroutine cld_eff_rad + +! ======================================================================= +! radar reflectivity +! ======================================================================= + +subroutine rad_ref (is, ie, js, je, qv, qr, qs, qg, pt, delp, & + delz, dbz, npz, hydrostatic, do_inline_mp, mp_top) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + logical, intent (in) :: hydrostatic, do_inline_mp + + integer, intent (in) :: is, ie, js, je + integer, intent (in) :: npz, mp_top + !integer, intent (in) :: sphum, liq_wat, ice_wat, rainwat, snowwat, graupel + + !real(kind_phys), intent (in) :: zvir + + real(kind_phys), intent (in), dimension (is:ie, js:je, npz) :: delz + + real(kind_phys), intent (in), dimension (is:ie, js:je, npz) :: pt, delp + + real(kind_phys), intent (in), dimension (is:ie, js:je, npz) :: qv, qr, qs, qg + + !real(kind_phys), intent (in), dimension (is:ie, npz + 1, js:je) :: peln + + !real(kind_phys), intent (out) :: allmax + + !real(kind_phys), intent (out), dimension (is:ie, js:je) :: maxdbz + + real(kind_phys), intent (out), dimension (is:ie, js:je, npz) :: dbz + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: i, j, k + + real(kind_phys), parameter :: alpha = 0.224, mp_const = 200 * exp (1.6 * log (3.6e6)) + + real (kind = r8) :: qden, z_e + real(kind_phys) :: fac_r, fac_s, fac_g + real(kind_phys) :: allmax + real(kind_phys), dimension (is:ie, js:je) :: maxdbz + + real(kind_phys), dimension (npz) :: den, denfac, qmr, qms, qmg, vtr, vts, vtg + + ! ----------------------------------------------------------------------- + ! return if the microphysics scheme doesn't include rain + ! ----------------------------------------------------------------------- + + !if (rainwat .lt. 1) return + + ! ----------------------------------------------------------------------- + ! initialization + ! ----------------------------------------------------------------------- + + dbz = - 20. + maxdbz = - 20. + allmax = - 20. + + ! ----------------------------------------------------------------------- + ! calculate radar reflectivity + ! ----------------------------------------------------------------------- + + do j = js, je + do i = is, ie + + ! ----------------------------------------------------------------------- + ! air density + ! ----------------------------------------------------------------------- + + do k = 1, npz + !if (hydrostatic) then + ! den (k) = delp (i, j, k) / ((peln (i, k + 1, j) - peln (i, k, j)) * & + ! rdgas * pt (i, j, k) * (1. + zvir * qv (i, j, k))) + !else + ! den (k) = - delp (i, j, k) / (grav * delz (i, j, k)) + !endif + + den (k) = - delp (i, j, k) / (grav * delz (i, j, k)) + qmr (k) = max (qcmin, qr (i, j, k)) + qms (k) = max (qcmin, qs (i, j, k)) + qmg (k) = max (qcmin, qg (i, j, k)) + enddo + + do k = 1, npz + denfac (k) = sqrt (den (npz) / den (k)) + enddo + + ! ----------------------------------------------------------------------- + ! fall speed + ! ----------------------------------------------------------------------- + + if (radr_flag .eq. 3) then + call term_rsg (1, npz, qmr, den, denfac, vr_fac, blinr, & + mur, tvar, tvbr, vr_max, const_vr, vtr) + vtr = vtr / rhor + endif + + if (rads_flag .eq. 3) then + call term_rsg (1, npz, qms, den, denfac, vs_fac, blins, & + mus, tvas, tvbs, vs_max, const_vs, vts) + vts = vts / rhos + endif + + if (radg_flag .eq. 3) then + if (do_hail .and. .not. do_inline_mp) then + call term_rsg (1, npz, qmg, den, denfac, vg_fac, blinh, & + muh, tvah, tvbh, vg_max, const_vg, vtg) + vtg = vtg / rhoh + else + call term_rsg (1, npz, qmg, den, denfac, vg_fac, bling, & + mug, tvag, tvbg, vg_max, const_vg, vtg) + vtg = vtg / rhog + endif + endif + + ! ----------------------------------------------------------------------- + ! radar reflectivity + ! ----------------------------------------------------------------------- + + do k = mp_top + 1, npz + z_e = 0. + + !if (rainwat .gt. 0) then + qden = den (k) * qmr (k) + if (qmr (k) .gt. qcmin) then + call cal_pc_ed_oe_rr_tv (qmr (k), den (k), blinr, mur, & + rra = rrar, rrb = rrbr, rr = fac_r) + else + fac_r = 0.0 + endif + if (radr_flag .eq. 1 .or. radr_flag .eq. 2) then + z_e = z_e + fac_r * 1.e18 + endif + if (radr_flag .eq. 3) then + z_e = z_e + mp_const * exp (1.6 * log (qden * vtr (k))) + endif + !endif + + !if (snowwat .gt. 0) then + qden = den (k) * qms (k) + if (qms (k) .gt. qcmin) then + call cal_pc_ed_oe_rr_tv (qms (k), den (k), blins, mus, & + rra = rras, rrb = rrbs, rr = fac_s) + else + fac_s = 0.0 + endif + if (rads_flag .eq. 1) then + if (pt (i, j, k) .lt. tice) then + z_e = z_e + fac_s * 1.e18 * alpha * (rhos / rhor) ** 2 + else + z_e = z_e + fac_s * 1.e18 * alpha * (rhos / rhor) ** 2 / alpha + endif + endif + if (rads_flag .eq. 2) then + if (pt (i, j, k) .lt. tice) then + z_e = z_e + fac_s * 1.e18 * alpha * (rhos / rhoi) ** 2 + else + z_e = z_e + fac_s * 1.e18 + endif + endif + if (rads_flag .eq. 3) then + z_e = z_e + mp_const * exp (1.6 * log (qden * vts (k))) + endif + !endif + + !if (graupel .gt. 0) then + qden = den (k) * qmg (k) + if (do_hail .and. .not. do_inline_mp) then + if (qmg (k) .gt. qcmin) then + call cal_pc_ed_oe_rr_tv (qmg (k), den (k), blinh, muh, & + rra = rrah, rrb = rrbh, rr = fac_g) + else + fac_g = 0.0 + endif + if (radg_flag .eq. 1) then + if (pt (i, j, k) .lt. tice) then + z_e = z_e + fac_g * 1.e18 * alpha * (rhoh / rhor) ** 2 + else + z_e = z_e + fac_g * 1.e18 * alpha * (rhoh / rhor) ** 2 / alpha + endif + endif + if (radg_flag .eq. 2) then + z_e = z_e + fac_g * 1.e18 + endif + else + if (qmg (k) .gt. qcmin) then + call cal_pc_ed_oe_rr_tv (qmg (k), den (k), bling, mug, & + rra = rrag, rrb = rrbg, rr = fac_g) + else + fac_g = 0.0 + endif + if (radg_flag .eq. 1) then + if (pt (i, j, k) .lt. tice) then + z_e = z_e + fac_g * 1.e18 * alpha * (rhog / rhor) ** 2 + else + z_e = z_e + fac_g * 1.e18 * alpha * (rhog / rhor) ** 2 / alpha + endif + endif + if (radg_flag .eq. 2) then + z_e = z_e + fac_g * 1.e18 + endif + endif + if (radg_flag .eq. 3) then + z_e = z_e + mp_const * exp (1.6 * log (qden * vtg (k))) + endif + !endif + + dbz (i, j, k) = 10. * log10 (max (0.01, z_e)) + enddo + + do k = mp_top + 1, npz + maxdbz (i, j) = max (dbz (i, j, k), maxdbz (i, j)) + enddo + + allmax = max (maxdbz (i, j), allmax) + + enddo + enddo + +end subroutine rad_ref + +! ======================================================================= +! moist heat capacity, 3 input variables +! ======================================================================= + +function mhc3 (qv, q_liq, q_sol) + + implicit none + + real (kind = r8) :: mhc3 + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: qv, q_liq, q_sol + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + mhc3 = one_r8 + qv * c1_vap + q_liq * c1_liq + q_sol * c1_ice + +end function mhc3 + +! ======================================================================= +! moist heat capacity, 4 input variables +! ======================================================================= + +function mhc4 (qd, qv, q_liq, q_sol) + + implicit none + + real (kind = r8) :: mhc4 + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: qv, q_liq, q_sol + + real (kind = r8), intent (in) :: qd + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + mhc4 = qd + qv * c1_vap + q_liq * c1_liq + q_sol * c1_ice + +end function mhc4 + +! ======================================================================= +! moist heat capacity, 6 input variables +! ======================================================================= + +function mhc6 (qv, ql, qr, qi, qs, qg) + + implicit none + + real (kind = r8) :: mhc6 + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: qv, ql, qr, qi, qs, qg + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + real(kind_phys) :: q_liq, q_sol + + q_liq = ql + qr + q_sol = qi + qs + qg + mhc6 = mhc (qv, q_liq, q_sol) + +end function mhc6 + +! ======================================================================= +! moist total energy +! ======================================================================= + +function mte (qv, ql, qr, qi, qs, qg, tk, dp, moist_q) + + implicit none + + real (kind = r8) :: mte + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + logical, intent (in) :: moist_q + + real(kind_phys), intent (in) :: qv, ql, qr, qi, qs, qg, dp + + real (kind = r8), intent (in) :: tk + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + real(kind_phys) :: q_liq, q_sol, q_cond + + real (kind = r8) :: cvm, con_r8 + + q_liq = ql + qr + q_sol = qi + qs + qg + q_cond = q_liq + q_sol + con_r8 = one_r8 - (qv + q_cond) + if (moist_q) then + cvm = mhc (con_r8, qv, q_liq, q_sol) + else + cvm = mhc (qv, q_liq, q_sol) + endif + mte = rgrav * cvm * c_air * tk * dp + +end function mte + +! ======================================================================= +! moist total energy and total water +! ======================================================================= + +subroutine mtetw (ks, ke, qv, ql, qr, qi, qs, qg, tz, ua, va, wa, delp, & + dte, vapor, water, rain, ice, snow, graupel, sen, stress, dts, & + te, tw, te_b, tw_b, moist_q, hydrostatic, te_loss) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + logical, intent (in) :: moist_q, hydrostatic + + real(kind_phys), intent (in) :: vapor, water, rain, ice, snow, graupel, dts, sen, stress + + real(kind_phys), intent (in), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg, ua, va, wa, delp + + real (kind = r8), intent (in) :: dte + + real (kind = r8), intent (in), dimension (ks:ke) :: tz + + real (kind = r8), intent (out) :: te_b, tw_b + + real (kind = r8), intent (out), optional :: te_loss + + real (kind = r8), intent (out), dimension (ks:ke) :: te, tw + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + real(kind_phys) :: q_cond + + real (kind = r8) :: con_r8 + + real(kind_phys), dimension (ks:ke) :: q_liq, q_sol + + real (kind = r8), dimension (ks:ke) :: cvm + + do k = ks, ke + q_liq (k) = ql (k) + qr (k) + q_sol (k) = qi (k) + qs (k) + qg (k) + q_cond = q_liq (k) + q_sol (k) + con_r8 = one_r8 - (qv (k) + q_cond) + if (moist_q) then + cvm (k) = mhc (con_r8, qv (k), q_liq (k), q_sol (k)) + else + cvm (k) = mhc (qv (k), q_liq (k), q_sol (k)) + endif + te (k) = (cvm (k) * tz (k) + lv00 * qv (k) - li00 * q_sol (k)) * c_air + if (hydrostatic) then + te (k) = te (k) + 0.5 * (ua (k) ** 2 + va (k) ** 2) + else + te (k) = te (k) + 0.5 * (ua (k) ** 2 + va (k) ** 2 + wa (k) ** 2) + endif + te (k) = rgrav * te (k) * delp (k) + tw (k) = rgrav * (qv (k) + q_cond) * delp (k) + enddo + te_b = (dte + (lv00 * c_air * vapor - li00 * c_air * (ice + snow + graupel)) * dts / 86400 + sen * dts + stress * dts) + tw_b = (vapor + water + rain + ice + snow + graupel) * dts / 86400 + + if (present (te_loss)) then + ! total energy change due to sedimentation and its heating + te_loss = dte + endif + +end subroutine mtetw + +! ======================================================================= +! calculate heat capacities and latent heat coefficients +! ======================================================================= + +subroutine cal_mhc_lhc (ks, ke, qv, ql, qr, qi, qs, qg, q_liq, q_sol, & + cvm, te8, tz, lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: ks, ke + + real(kind_phys), intent (in), dimension (ks:ke) :: qv, ql, qr, qi, qs, qg + + real (kind = r8), intent (in), dimension (ks:ke) :: tz + + real(kind_phys), intent (out), dimension (ks:ke) :: q_liq, q_sol, lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (out), dimension (ks:ke) :: cvm, te8 + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: k + + do k = ks, ke + q_liq (k) = ql (k) + qr (k) + q_sol (k) = qi (k) + qs (k) + qg (k) + cvm (k) = mhc (qv (k), q_liq (k), q_sol (k)) + te8 (k) = cvm (k) * tz (k) + lv00 * qv (k) - li00 * q_sol (k) + lcpk (k) = (lv00 + d1_vap * tz (k)) / cvm (k) + icpk (k) = (li00 + d1_ice * tz (k)) / cvm (k) + tcpk (k) = (li20 + (d1_vap + d1_ice) * tz (k)) / cvm (k) + tcp3 (k) = lcpk (k) + icpk (k) * min (1., dim (tice, tz (k)) / (tice - t_wfr)) + enddo + +end subroutine cal_mhc_lhc + +! ======================================================================= +! update hydrometeors +! ======================================================================= + +subroutine update_qq (qv, ql, qr, qi, qs, qg, dqv, dql, dqr, dqi, dqs, dqg) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: dqv, dql, dqr, dqi, dqs, dqg + + real(kind_phys), intent (inout) :: qv, ql, qr, qi, qs, qg + + qv = qv + dqv + ql = ql + dql + qr = qr + dqr + qi = qi + dqi + qs = qs + dqs + qg = qg + dqg + +end subroutine update_qq + +! ======================================================================= +! update hydrometeors and temperature +! ======================================================================= + +subroutine update_qt (qv, ql, qr, qi, qs, qg, dqv, dql, dqr, dqi, dqs, dqg, te8, & + cvm, tk, lcpk, icpk, tcpk, tcp3) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: dqv, dql, dqr, dqi, dqs, dqg + + real (kind = r8), intent (in) :: te8 + + real(kind_phys), intent (inout) :: qv, ql, qr, qi, qs, qg + + real(kind_phys), intent (out) :: lcpk, icpk, tcpk, tcp3 + + real (kind = r8), intent (out) :: cvm, tk + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + qv = qv + dqv + ql = ql + dql + qr = qr + dqr + qi = qi + dqi + qs = qs + dqs + qg = qg + dqg + + cvm = mhc (qv, ql, qr, qi, qs, qg) + tk = (te8 - lv00 * qv + li00 * (qi + qs + qg)) / cvm + + lcpk = (lv00 + d1_vap * tk) / cvm + icpk = (li00 + d1_ice * tk) / cvm + tcpk = (li20 + (d1_vap + d1_ice) * tk) / cvm + tcp3 = lcpk + icpk * min (1., dim (tice, tk) / (tice - t_wfr)) + +end subroutine update_qt + +! ======================================================================= +! calculation of particle concentration (pc), effective diameter (ed), +! optical extinction (oe), radar reflectivity factor (rr), and +! mass-weighted terminal velocity (tv) +! ======================================================================= + +subroutine cal_pc_ed_oe_rr_tv (q, den, blin, mu, pca, pcb, pc, eda, edb, ed, & + oea, oeb, oe, rra, rrb, rr, tva, tvb, tv) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: blin, mu + + real(kind_phys), intent (in) :: q, den + + real (kind = r8), intent (in), optional :: pca, pcb, eda, edb, oea, oeb, rra, rrb, tva, tvb + + real(kind_phys), intent (out), optional :: pc, ed, oe, rr, tv + + if (present (pca) .and. present (pcb) .and. present (pc)) then + pc = pca / pcb * exp (mu / (mu + 3) * log (6 * den * q)) + endif + if (present (eda) .and. present (edb) .and. present (ed)) then + ed = eda / edb * exp (1. / (mu + 3) * log (6 * den * q)) + endif + if (present (oea) .and. present (oeb) .and. present (oe)) then + oe = oea / oeb * exp ((mu + 2) / (mu + 3) * log (6 * den * q)) + endif + if (present (rra) .and. present (rrb) .and. present (rr)) then + rr = rra / rrb * exp ((mu + 6) / (mu + 3) * log (6 * den * q)) + endif + if (present (tva) .and. present (tvb) .and. present (tv)) then + tv = tva / tvb * exp (blin / (mu + 3) * log (6 * den * q)) + endif + +end subroutine cal_pc_ed_oe_rr_tv + +! ======================================================================= +! prepare saturation water vapor pressure tables +! ======================================================================= + +subroutine qs_init + + implicit none + + integer :: i + + if (.not. tables_are_initialized) then + + allocate (table0 (length)) + allocate (table1 (length)) + allocate (table2 (length)) + allocate (table3 (length)) + allocate (table4 (length)) + + allocate (des0 (length)) + allocate (des1 (length)) + allocate (des2 (length)) + allocate (des3 (length)) + allocate (des4 (length)) + + call qs_table0 (length) + call qs_table1 (length) + call qs_table2 (length) + call qs_table3 (length) + call qs_table4 (length) + + do i = 1, length - 1 + des0 (i) = max (0., table0 (i + 1) - table0 (i)) + des1 (i) = max (0., table1 (i + 1) - table1 (i)) + des2 (i) = max (0., table2 (i + 1) - table2 (i)) + des3 (i) = max (0., table3 (i + 1) - table3 (i)) + des4 (i) = max (0., table4 (i + 1) - table4 (i)) + enddo + des0 (length) = des0 (length - 1) + des1 (length) = des1 (length - 1) + des2 (length) = des2 (length - 1) + des3 (length) = des3 (length - 1) + des4 (length) = des4 (length - 1) + + tables_are_initialized = .true. + + endif + +end subroutine qs_init + +! ======================================================================= +! saturation water vapor pressure table, core function +! ======================================================================= + +subroutine qs_table_core (n, n_blend, do_smith_table, table) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: n, n_blend + + logical, intent (in) :: do_smith_table + + real(kind_phys), intent (out), dimension (n) :: table + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: i + integer, parameter :: n_min = 1600 + + real (kind = r8) :: delt = 0.1 + real (kind = r8) :: tmin, tem, esh + real (kind = r8) :: wice, wh2o, fac0, fac1, fac2 + real (kind = r8) :: esbasw, tbasw, esbasi, a, b, c, d, e + real (kind = r8) :: esupc (n_blend) + + esbasw = 1013246.0 + tbasw = tice + 100. + esbasi = 6107.1 + tmin = tice - n_min * delt + + ! ----------------------------------------------------------------------- + ! compute es over ice between - (n_min * delt) deg C and 0 deg C + ! ----------------------------------------------------------------------- + + if (do_smith_table) then + do i = 1, n_min + tem = tmin + delt * real (i - 1, kind=kind_phys) + a = - 9.09718 * (tice / tem - 1.) + b = - 3.56654 * log10 (tice / tem) + c = 0.876793 * (1. - tem / tice) + e = log10 (esbasi) + table (i) = 0.1 * exp ((a + b + c + e) * log (10.)) + enddo + else + do i = 1, n_min + tem = tmin + delt * real (i - 1, kind=kind_phys) + fac0 = (tem - tice) / (tem * tice) + fac1 = fac0 * li2 + fac2 = (d2_ice * log (tem / tice) + fac1) / rvgas + table (i) = e00 * exp (fac2) + enddo + endif + + ! ----------------------------------------------------------------------- + ! compute es over water between - (n_blend * delt) deg C and [ (n - n_min - 1) * delt] deg C + ! ----------------------------------------------------------------------- + + if (do_smith_table) then + do i = 1, n - n_min + n_blend + tem = tice + delt * (real (i - 1, kind=kind_phys) - n_blend) + a = - 7.90298 * (tbasw / tem - 1.) + b = 5.02808 * log10 (tbasw / tem) + c = - 1.3816e-7 * (exp ((1. - tem / tbasw) * 11.344 * log (10.)) - 1.) + d = 8.1328e-3 * (exp ((tbasw / tem - 1.) * (- 3.49149) * log (10.)) - 1.) + e = log10 (esbasw) + esh = 0.1 * exp ((a + b + c + d + e) * log (10.)) + if (i .le. n_blend) then + esupc (i) = esh + else + table (i + n_min - n_blend) = esh + endif + enddo + else + do i = 1, n - n_min + n_blend + tem = tice + delt * (real (i - 1, kind=kind_phys) - n_blend) + fac0 = (tem - tice) / (tem * tice) + fac1 = fac0 * lv0 + fac2 = (dc_vap * log (tem / tice) + fac1) / rvgas + esh = e00 * exp (fac2) + if (i .le. n_blend) then + esupc (i) = esh + else + table (i + n_min - n_blend) = esh + endif + enddo + endif + + ! ----------------------------------------------------------------------- + ! derive blended es over ice and supercooled water between - (n_blend * delt) deg C and 0 deg C + ! ----------------------------------------------------------------------- + + do i = 1, n_blend + tem = tice + delt * (real (i - 1, kind=kind_phys) - n_blend) + wice = 1.0 / (delt * n_blend) * (tice - tem) + wh2o = 1.0 / (delt * n_blend) * (tem - tice + delt * n_blend) + table (i + n_min - n_blend) = wice * table (i + n_min - n_blend) + wh2o * esupc (i) + enddo + +end subroutine qs_table_core + +! ======================================================================= +! saturation water vapor pressure table 0, water only +! useful for idealized experiments +! it can also be used in warm rain microphyscis only +! ======================================================================= + +subroutine qs_table0 (n) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: n + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: i + + real (kind = r8) :: delt = 0.1 + real (kind = r8) :: tmin, tem, fac0, fac1, fac2 + + tmin = tice - 160. + + ! ----------------------------------------------------------------------- + ! compute es over water only + ! ----------------------------------------------------------------------- + + do i = 1, n + tem = tmin + delt * real (i - 1, kind=kind_phys) + fac0 = (tem - tice) / (tem * tice) + fac1 = fac0 * lv0 + fac2 = (dc_vap * log (tem / tice) + fac1) / rvgas + table0 (i) = e00 * exp (fac2) + enddo + +end subroutine qs_table0 + +! ======================================================================= +! saturation water vapor pressure table 1, water and ice +! blended between -20 deg C and 0 deg C +! the most realistic saturation water vapor pressure for the full temperature range +! ======================================================================= + +subroutine qs_table1 (n) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: n + + call qs_table_core (n, 200, .false., table1) + +end subroutine qs_table1 + +! ======================================================================= +! saturation water vapor pressure table 2, water and ice +! same as table 1, but the blending is replaced with smoothing around 0 deg C +! it is not designed for mixed-phase cloud microphysics +! used for ice microphysics (< 0 deg C) or warm rain microphysics (> 0 deg C) +! ======================================================================= + +subroutine qs_table2 (n) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: n + + call qs_table_core (n, 0, .false., table2) + +end subroutine qs_table2 + +! ======================================================================= +! saturation water vapor pressure table 3, water and ice +! blended between -20 deg C and 0 deg C +! the same as table 1, but from smithsonian meteorological tables page 350 +! ======================================================================= + +subroutine qs_table3 (n) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: n + + call qs_table_core (n, 200, .true., table3) + +end subroutine qs_table3 + +! ======================================================================= +! saturation water vapor pressure table 4, water and ice +! same as table 3, but the blending is replaced with smoothing around 0 deg C +! the same as table 2, but from smithsonian meteorological tables page 350 +! ======================================================================= + +subroutine qs_table4 (n) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: n + + call qs_table_core (n, 0, .true., table4) + +end subroutine qs_table4 + +! ======================================================================= +! compute the saturated water pressure, core function +! ======================================================================= + +function es_core (length, tk, table, des) + + implicit none + + real(kind_phys) :: es_core + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: length + + real(kind_phys), intent (in) :: tk + + real(kind_phys), intent (in), dimension (length) :: table, des + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: it + + real(kind_phys) :: ap1, tmin + + if (.not. tables_are_initialized) call qs_init + + tmin = tice - 160. + ap1 = 10. * dim (tk, tmin) + 1. + ap1 = min (2621., ap1) + it = ap1 + es_core = table (it) + (ap1 - it) * des (it) + +end function es_core + +! ======================================================================= +! compute the saturated specific humidity, core function +! ======================================================================= + +function qs_core (length, tk, den, dqdt, table, des) + + implicit none + + real(kind_phys) :: qs_core + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: length + + real(kind_phys), intent (in) :: tk, den + + real(kind_phys), intent (in), dimension (length) :: table, des + + real(kind_phys), intent (out) :: dqdt + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: it + + real(kind_phys) :: ap1, tmin + + tmin = tice - 160. + ap1 = 10. * dim (tk, tmin) + 1. + ap1 = min (2621., ap1) + qs_core = es_core (length, tk, table, des) / (rvgas * tk * den) + it = ap1 - 0.5 + dqdt = 10. * (des (it) + (ap1 - it) * (des (it + 1) - des (it))) / (rvgas * tk * den) + +end function qs_core + +! ======================================================================= +! compute the saturated water pressure based on table 0, water only +! useful for idealized experiments +! it can also be used in warm rain microphyscis only +! ======================================================================= + +function wes_t (tk) + + implicit none + + real(kind_phys) :: wes_t + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: tk + + wes_t = es_core (length, tk, table0, des0) + +end function wes_t + +! ======================================================================= +! compute the saturated water pressure based on table 1, water and ice +! the most realistic saturation water vapor pressure for the full temperature range +! ======================================================================= + +function mes_t (tk) + + implicit none + + real(kind_phys) :: mes_t + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: tk + + mes_t = es_core (length, tk, table1, des1) + +end function mes_t + +! ======================================================================= +! compute the saturated water pressure based on table 2, water and ice +! it is not designed for mixed-phase cloud microphysics +! used for ice microphysics (< 0 deg C) or warm rain microphysics (> 0 deg C) +! ======================================================================= + +function ies_t (tk) + + implicit none + + real(kind_phys) :: ies_t + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: tk + + ies_t = es_core (length, tk, table2, des2) + +end function ies_t + +! ======================================================================= +! compute the saturated specific humidity based on table 0, water only +! useful for idealized experiments +! it can also be used in warm rain microphyscis only +! ======================================================================= + +function wqs_trho (tk, den, dqdt) + + implicit none + + real(kind_phys) :: wqs_trho + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: tk, den + + real(kind_phys), intent (out) :: dqdt + + wqs_trho = qs_core (length, tk, den, dqdt, table0, des0) + +end function wqs_trho + +! ======================================================================= +! compute the saturated specific humidity based on table 1, water and ice +! the most realistic saturation water vapor pressure for the full temperature range +! ======================================================================= + +function mqs_trho (tk, den, dqdt) + + implicit none + + real(kind_phys) :: mqs_trho + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: tk, den + + real(kind_phys), intent (out) :: dqdt + + mqs_trho = qs_core (length, tk, den, dqdt, table1, des1) + +end function mqs_trho + +! ======================================================================= +! compute the saturated specific humidity based on table 2, water and ice +! it is not designed for mixed-phase cloud microphysics +! used for ice microphysics (< 0 deg C) or warm rain microphysics (> 0 deg C) +! ======================================================================= + +function iqs_trho (tk, den, dqdt) + + implicit none + + real(kind_phys) :: iqs_trho + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: tk, den + + real(kind_phys), intent (out) :: dqdt + + iqs_trho = qs_core (length, tk, den, dqdt, table2, des2) + +end function iqs_trho + +! ======================================================================= +! compute the saturated specific humidity based on table 0, water only +! useful for idealized experiments +! it can also be used in warm rain microphyscis only +! ======================================================================= + +function wqs_ptqv (tk, pa, qv, dqdt) + + implicit none + + real(kind_phys) :: wqs_ptqv + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: tk, pa, qv + + real(kind_phys), intent (out) :: dqdt + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + real(kind_phys) :: den + + den = pa / (rdgas * tk * (1. + zvir * qv)) + + wqs_ptqv = wqs (tk, den, dqdt) + +end function wqs_ptqv + +! ======================================================================= +! compute the saturated specific humidity based on table 1, water and ice +! the most realistic saturation water vapor pressure for the full temperature range +! ======================================================================= + +function mqs_ptqv (tk, pa, qv, dqdt) + + implicit none + + real(kind_phys) :: mqs_ptqv + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: tk, pa, qv + + real(kind_phys), intent (out) :: dqdt + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + real(kind_phys) :: den + + den = pa / (rdgas * tk * (1. + zvir * qv)) + + mqs_ptqv = mqs (tk, den, dqdt) + +end function mqs_ptqv + +! ======================================================================= +! compute the saturated specific humidity based on table 2, water and ice +! it is not designed for mixed-phase cloud microphysics +! used for ice microphysics (< 0 deg C) or warm rain microphysics (> 0 deg C) +! ======================================================================= + +function iqs_ptqv (tk, pa, qv, dqdt) + + implicit none + + real(kind_phys) :: iqs_ptqv + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: tk, pa, qv + + real(kind_phys), intent (out) :: dqdt + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + real(kind_phys) :: den + + den = pa / (rdgas * tk * (1. + zvir * qv)) + + iqs_ptqv = iqs (tk, den, dqdt) + +end function iqs_ptqv + +! ======================================================================= +! compute the saturated specific humidity based on table 1, water and ice +! the most realistic saturation water vapor pressure for the full temperature range +! it is the 3d version of "mqs" +! ======================================================================= + +subroutine mqs3d (im, km, ks, tk, pa, qv, qs, dqdt) + + implicit none + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + integer, intent (in) :: im, km, ks + + real(kind_phys), intent (in), dimension (im, ks:km) :: tk, pa, qv + + real(kind_phys), intent (out), dimension (im, ks:km) :: qs + + real(kind_phys), intent (out), dimension (im, ks:km), optional :: dqdt + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + integer :: i, k + + real(kind_phys) :: dqdt0 + + if (present (dqdt)) then + do k = ks, km + do i = 1, im + qs (i, k) = mqs (tk (i, k), pa (i, k), qv (i, k), dqdt (i, k)) + enddo + enddo + else + do k = ks, km + do i = 1, im + qs (i, k) = mqs (tk (i, k), pa (i, k), qv (i, k), dqdt0) + enddo + enddo + endif + +end subroutine mqs3d + +! ======================================================================= +! compute wet buld temperature, core function +! Knox et al. (2017) +! ======================================================================= + +function wet_bulb_core (qv, tk, den, lcp) + + implicit none + + real(kind_phys) :: wet_bulb_core + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: qv, tk, den, lcp + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + logical :: do_adjust = .false. + + real(kind_phys) :: factor = 1. / 3. + real(kind_phys) :: qsat, tp, dqdt + + wet_bulb_core = tk + qsat = wqs (wet_bulb_core, den, dqdt) + tp = factor * (qsat - qv) / (1. + lcp * dqdt) * lcp + wet_bulb_core = wet_bulb_core - tp + + if (do_adjust .and. tp .gt. 0.0) then + qsat = wqs (wet_bulb_core, den, dqdt) + tp = (qsat - qv) / (1. + lcp * dqdt) * lcp + wet_bulb_core = wet_bulb_core - tp + endif + +end function wet_bulb_core + +! ======================================================================= +! compute wet buld temperature, dry air case +! ======================================================================= + +function wet_bulb_dry (qv, tk, den) + + implicit none + + real(kind_phys) :: wet_bulb_dry + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: qv, tk, den + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + real(kind_phys) :: lcp + + lcp = hlv / cp_air + + wet_bulb_dry = wet_bulb_core (qv, tk, den, lcp) + +end function wet_bulb_dry + +! ======================================================================= +! compute wet buld temperature, moist air case +! ======================================================================= + +function wet_bulb_moist (qv, ql, qi, qr, qs, qg, tk, den) + + implicit none + + real(kind_phys) :: wet_bulb_moist + + ! ----------------------------------------------------------------------- + ! input / output arguments + ! ----------------------------------------------------------------------- + + real(kind_phys), intent (in) :: qv, ql, qi, qr, qs, qg, tk, den + + ! ----------------------------------------------------------------------- + ! local variables + ! ----------------------------------------------------------------------- + + real(kind_phys) :: lcp, q_liq, q_sol + + real (kind = r8) :: cvm + + q_liq = ql + qr + q_sol = qi + qs + qg + cvm = mhc (qv, q_liq, q_sol) + lcp = (lv00 + d1_vap * tk) / cvm + + wet_bulb_moist = wet_bulb_core (qv, tk, den, lcp) + +end function wet_bulb_moist + +end module gfdl_cloud_microphys_v3_mod diff --git a/physics/MP/Morrison_Gettelman/aer_cloud.F b/physics/MP/Morrison_Gettelman/aer_cloud.F index a334428d1..36bdf47ac 100644 --- a/physics/MP/Morrison_Gettelman/aer_cloud.F +++ b/physics/MP/Morrison_Gettelman/aer_cloud.F @@ -620,10 +620,6 @@ subroutine aerosol_activate(tparc_in, pparc_in, sigwparc_in, & ! deallocate (kappa_par) - - -2033 return - END subroutine aerosol_activate ! @@ -808,7 +804,6 @@ SUBROUTINE AerConversion_base () AerPr_base_clean%dpg(9:11) = DPGI_aux(9:11) AerPr_base_clean%sig(9:11) = SIGI_aux(9:11) - RETURN ! END SUBROUTINE AerConversion_base @@ -920,7 +915,6 @@ SUBROUTINE AerConversion (aer_mass, AerPr, kappa, SULFATE, ORG, & end do end do - RETURN ! END SUBROUTINE AerConversion @@ -1013,7 +1007,6 @@ SUBROUTINE AerConversion1 (aer_mass, AerPr) end do end do - RETURN ! END SUBROUTINE AerConversion1 @@ -1382,7 +1375,6 @@ subroutine ccnspec (tparc,pparc,nmodes, ! *** end of subroutine ccnspec **************************************** ! - return end subroutine ccnspec @@ -1469,7 +1461,6 @@ subroutine pdfactiv (wparc,sigw, nact,smax,nmodes, smax = smax*scal endif ! - return ! ! *** end of subroutine pdfactiv **************************************** ! @@ -1591,7 +1582,6 @@ subroutine activate (wparc,ndroplet,smax,nmodes, smax = x3 ndroplet=ndrpl - return ! ! *** end of subroutine activate **************************************** ! @@ -1678,7 +1668,6 @@ subroutine sintegral (spar, summa, sum, summat,wparcel,nmodes, summa = summa + nd(j) 999 continue ! - return end subroutine sintegral !======================================================================= @@ -1732,7 +1721,6 @@ subroutine props(pres_par,temp_par,surt_par,dv_par,act_param, end if ! - return ! ! *** end of subroutine props ******************************************* ! @@ -1783,7 +1771,6 @@ real*8 function vpres (t) ! ! end of function vpres ! - return end function vpres @@ -1819,7 +1806,6 @@ real*8 function sft (t) tpars = t-273.15d0 sft = 0.0761-1.55e-4*tpars ! - return end function sft @@ -1859,7 +1845,6 @@ subroutine gauleg (x,w,n) w(i)=2.d0*xl/((1.d0-z*z)*pp*pp) w(n+1-i)=w(i) 12 continue - return end subroutine gauleg !C======================================================================= @@ -1885,7 +1870,6 @@ REAL*8 FUNCTION erf(x) else erf = axx endif - RETURN END FUNCTION @@ -1907,7 +1891,6 @@ REAL*8 FUNCTION erf(x) ! else ! erf=gammp(.5d0,x**2) ! endif -! return ! end function erf @@ -1934,7 +1917,6 @@ real*8 function gammln(xx) ser=ser+cof(j)/x 11 continue gammln=tmp+log(stp*ser) - return end function gammln @@ -1955,7 +1937,6 @@ end function gammln ! call gcf(gammcf,a,x,gln) ! gammp=1.d0-gammcf ! endif -! return ! end function gammp @@ -1996,7 +1977,6 @@ end function gammln !1 continue ! pause 'a too large, itmax too small' ! gammcf=exp(-x+a*log(x)-gln)*g -! return ! end subroutine gcf @@ -2030,7 +2010,6 @@ end function gammln !1 continue ! pause 'a too large, itmax too small' ! gamser=sum*exp(-x+a*log(x)-gln) -! return ! end subroutine gser ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -2146,7 +2125,6 @@ SUBROUTINE IceParam (sigma_w, denice_ice,ddry_ice,np_ice, end if - return END subroutine IceParam @@ -2239,7 +2217,6 @@ subroutine nice_Vdist(denice_ice,ddry_ice,np_ice, nhet=sum3*(vmax_ice-vmin_ice)*0.5d0 nlim=sum4*(vmax_ice-vmin_ice)*0.5d0 sc_ice=sum5*(vmax_ice-vmin_ice)*0.5d0 - RETURN END subroutine nice_Vdist @@ -2591,8 +2568,6 @@ subroutine nice_param(wpar_icex,denice_ice,ddry_ice,np_ice, sc_ice=min(shom_ice+1.0, sc_ice) - return - END subroutine nice_param !************************************************************* real*8 function FINDSMAX(SX,DSH, @@ -2670,7 +2645,6 @@ real*8 function VPRESWATER_ice(T) VPRESWATER_ice=EXP(VPRESWATER_ice) - return END function VPRESWATER_ice !************************************************************* @@ -2690,7 +2664,6 @@ real*8 function VPRESICE(T) VPRESICE = A(0)+(A(1)/T)+(A(2)*LOG(T))+(A(3)*T) VPRESICE=EXP(VPRESICE) - return END function VPRESICE !************************************************************* @@ -2711,7 +2684,7 @@ real*8 function DHSUB_ice(T) & A(4))**2))) DHSUB_ice=1000d0*DHSUB_ice/18d0 - return + END function DHSUB_ice !************************************************************* @@ -2730,7 +2703,7 @@ real*8 function DENSITYICE(T) TTEMP=T-273d0 DENSITYICE= 1000d0*(A(0)+(A(1)*TTEMP)+(A(2)*TTEMP*TTEMP)) - return + END function DENSITYICE !************************************************************* @@ -2768,7 +2741,7 @@ real*8 function WATDENSITY_ice(T) WATDENSITY=WATDENSITY*1000d0 WATDENSITY_ice=WATDENSITY - return + END function WATDENSITY_ice @@ -2914,8 +2887,6 @@ SUBROUTINE prop_ice(T, P, denice_ice,ddry_ice, del1bc_ice=cubicint_ice(Tc, T0bc, T0bc+5d0, 1d0, hbc) end if - RETURN - END SUBROUTINE prop_ice !************************************************************* @@ -2937,8 +2908,6 @@ SUBROUTINE gausspdf(x, dp, sigmav_ice,miuv_ice,normv_ice) &sigmav_ice/sq2pi_par/(normv_ice + 0.001) - RETURN - END SUBROUTINE gausspdf @@ -3967,7 +3936,6 @@ real function H_1(X, X_1, X_2, Hlo) if( X_2 <= X_1) stop 91919 - return end function @@ -3999,13 +3967,10 @@ real function H_1_smooth(X, X_1, X_2, Hlo, Hhi,dH1smooth) if( X_2 <= X_1) stop 91919 - return end function - - ! END ICE PARAMETERIZATION DONIF ! !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC diff --git a/physics/MP/Morrison_Gettelman/aerclm_def.F b/physics/MP/Morrison_Gettelman/aerclm_def.F index b6760f30c..3bfa6791a 100644 --- a/physics/MP/Morrison_Gettelman/aerclm_def.F +++ b/physics/MP/Morrison_Gettelman/aerclm_def.F @@ -3,15 +3,17 @@ module aerclm_def implicit none integer, parameter :: levsaer=72, ntrcaerm=15, timeaer=2 - integer :: latsaer, lonsaer, ntrcaer, levsw - integer :: n1sv, n2sv + integer :: latsaer, lonsaer, ntrcaer, levsw, tsaer + integer :: n1sv, n2sv, t1sv, t2sv integer :: iamin, iamax, jamin, jamax character*10 :: specname(ntrcaerm) + character*50 :: fname_dl real (kind=kind_phys):: aer_time(13) real (kind=kind_phys), allocatable, dimension(:) :: aer_lat real (kind=kind_phys), allocatable, dimension(:) :: aer_lon + real (kind=kind_phys), allocatable, dimension(:) :: aer_t real (kind=kind_io4), allocatable, dimension(:,:,:,:) :: aer_pres real (kind=kind_io4), allocatable, dimension(:,:,:,:,:) :: aerin diff --git a/physics/MP/Morrison_Gettelman/aerinterp.F90 b/physics/MP/Morrison_Gettelman/aerinterp.F90 index fcfe29607..15963db7d 100644 --- a/physics/MP/Morrison_Gettelman/aerinterp.F90 +++ b/physics/MP/Morrison_Gettelman/aerinterp.F90 @@ -9,16 +9,17 @@ module aerinterp implicit none - private read_netfaer + private read_netfaer, read_netfaer_dl, fdnx_fname public :: read_aerdata, setindxaer, aerinterpol,read_aerdataf + public :: read_aerdata_dl, aerinterpol_dl,read_aerdataf_dl contains logical function netcdf_check(status, errmsg, errflg, why) use netcdf implicit none - character(len=*), intent(inout) :: errmsg + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg integer, intent(in) :: status character(len=*), intent(in) :: why @@ -34,21 +35,407 @@ logical function netcdf_check(status, errmsg, errflg, why) endif END function netcdf_check - - SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) - use machine, only: kind_phys, kind_io4, kind_io8 +!!!!!!! + SUBROUTINE read_aerdata_dl (me, master, iflip, idate, FHOUR, errmsg, errflg) + use machine, only: kind_phys, kind_io4, kind_dbl_prec use aerclm_def use netcdf +!--- in/out + integer, intent(in) :: me, master, iflip, idate(4) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + real(kind=kind_phys), intent(in) :: fhour +!--- locals + integer :: ncid, varid, ndims, hmx + integer :: i, j, k, n, ii, imon, klev + character :: fname*50, mn*2, vname*10, dy*2, myr*4 + logical :: file_exist + integer :: dimids(NF90_MAX_VAR_DIMS) + integer :: dimlen(NF90_MAX_VAR_DIMS) + integer IDAT(8),JDAT(8) + real(kind=kind_phys) rjday + real(kind=kind_dbl_prec) rinc(5) + integer jdow, jdoy, jday + + errflg = 0 + errmsg = ' ' + +! +!! =================================================================== + if (me == master) then + if ( iflip == 0 ) then ! data from toa to sfc + print *, "GFS is top-down" + else + print *, "GFS is bottom-up" + endif + endif +!! found first day needed to interpolated + IDAT = 0 + IDAT(1) = IDATE(4) + IDAT(2) = IDATE(2) + IDAT(3) = IDATE(3) + IDAT(5) = IDATE(1) + RINC = 0. + RINC(2) = FHOUR + CALL W3MOVDAT(RINC,IDAT,JDAT) +! + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + +! +!! =================================================================== +!! check if all necessary files exist +!! =================================================================== + write(myr,'(i4.4)') jdat(1) + write(mn,'(i2.2)') jdat(2) + write(dy,'(i2.2)') jdat(3) + fname=trim("merra2_"//myr//mn//dy//".nc") + inquire (file = fname, exist = file_exist) + if (.not. file_exist) then + errmsg = 'Error in read_aerdata: file ' // trim(fname) // ' not found' + errflg = 1 + return + endif +! +!! =================================================================== +!! fetch dim spec and lat/lon from m01 data set +!! =================================================================== + ncid = -1 + if(.not.netcdf_check(nf90_open(fname , nf90_NOWRITE, ncid), & + errmsg, errflg, 'open '//trim(fname))) then + return + endif + + vname = trim(specname(1)) + varid = -1 + if(.not.netcdf_check(nf90_inq_varid(ncid, vname, varid), & + errmsg, errflg, 'find id of '//trim(vname)//' var')) then + return + endif + ndims = 0 + if(.not.netcdf_check(nf90_inquire_variable(ncid, varid, ndims=ndims, dimids=dimids), & + errmsg, errflg, 'inquire details about '//trim(vname)//' var')) then + return + endif + do i=1,ndims + if(.not.netcdf_check(nf90_inquire_dimension(ncid, dimids(i), len=dimlen(i)), & + errmsg, errflg, 'inquire details about dimension')) then + return + endif + enddo + +! specify latsaer, lonsaer, hmx + lonsaer = dimlen(1) + latsaer = dimlen(2) + levsw = dimlen(3) + tsaer = dimlen(4) + + if(me==master) then + print *, 'MERRA2 dim: ',dimlen(1:ndims) + endif + +! allocate arrays + + if (.not. allocated(aer_lat)) then + allocate(aer_lat(latsaer)) + allocate(aer_lon(lonsaer)) + allocate(aer_t(tsaer)) + endif + +! construct lat/lon array + varid = -1 + if(.not.netcdf_check(nf90_inq_varid(ncid, 'lat', varid), & + errmsg, errflg, 'find id of lat var')) then + return + endif + aer_lat = 0 + if(.not.netcdf_check(nf90_get_var(ncid, varid, aer_lat, (/ 1, 1, 1 /), (/latsaer, 1, 1/)), & + errmsg, errflg, 'read lat var')) then + return + endif + varid = -1 + if(.not.netcdf_check(nf90_inq_varid(ncid, 'lon', varid), & + errmsg, errflg, 'find id of lon var')) then + return + endif + aer_lon = 0 + if(.not.netcdf_check(nf90_get_var(ncid, varid, aer_lon, (/ 1, 1, 1 /), (/lonsaer, 1, 1/)), & + errmsg, errflg, 'read lon var')) then + return + endif + varid = -1 + if(.not.netcdf_check(nf90_inq_varid(ncid, 'time', varid), & + errmsg, errflg, 'find id of time var')) then + return + endif + aer_t = 0 + if(.not.netcdf_check(nf90_get_var(ncid, varid, aer_t, (/ 1, 1, 1 /), (/tsaer, 1, 1/)), & + errmsg, errflg, 'read t var')) then + return + endif + if(.not.netcdf_check(nf90_close(ncid), errmsg, errflg, 'close '//trim(fname))) then + return + endif + END SUBROUTINE read_aerdata_dl +! +!********************************************************************** + SUBROUTINE read_aerdataf_dl ( me, master, iflip, idate, FHOUR, errmsg, errflg) + use machine, only: kind_phys, kind_dbl_prec + use aerclm_def + !--- in/out integer, intent(in) :: me, master, iflip, idate(4) character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg + real(kind=kind_phys), intent(in) :: fhour +!--- locals + integer :: i, j, k, n, ii, imon, klev, n1, n2 + logical :: file_exist, fd_upb + integer IDAT(8),JDAT(8) + real(kind=kind_phys) rjday + real(kind=kind_dbl_prec) rinc(5) + integer jdow, jdoy, jday + character myr*4, mn*2, dy*2 + + integer, allocatable :: invardims(:) +! + if (.not. allocated(aerin)) then + allocate(aerin(iamin:iamax,jamin:jamax,levsaer,ntrcaerm,timeaer)) + allocate(aer_pres(iamin:iamax,jamin:jamax,levsaer,timeaer)) + endif + +! allocate local working arrays +!! found interpolation months + IDAT = 0 + IDAT(1) = IDATE(4) + IDAT(2) = IDATE(2) + IDAT(3) = IDATE(3) + IDAT(5) = IDATE(1) + RINC = 0. + RINC(2) = FHOUR + CALL W3MOVDAT(RINC,IDAT,JDAT) +! + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + write(myr,'(i4.4)') jdat(1) + write(mn,'(i2.2)') jdat(2) + write(dy,'(i2.2)') jdat(3) + fname_dl="merra2_"//myr//mn//dy//".nc" +! rjday is the minutes in a day + rjday = jdat(5)*60+jdat(6)+jdat(7)/60. +! +! n1sv saves the jdat(3), n2sv is the up boundary index + n1sv=jdat(3) + fd_upb=.false. + do j=2, tsaer + if ( aer_t(j)> rjday) then + n2sv = j + t2sv = aer_t(j) + fd_upb=.true. + exit + endif + enddo + if(fd_upb) then + t1sv = aer_t(j-1) + call read_netfaer_dl(fname_dl, j-1, iflip, 1, errmsg, errflg) + call read_netfaer_dl(fname_dl, n2sv, iflip, 2, errmsg, errflg) + else + t1sv = aer_t(tsaer) + call read_netfaer_dl(fname_dl, tsaer, iflip, 1, errmsg, errflg) + n2sv=1 + t2sv=1440. + call fdnx_fname (jdat(1), jdat(2),jdat(3),fname_dl) + call read_netfaer_dl(fname_dl, n2sv, iflip, 2, errmsg, errflg) + end if + END SUBROUTINE read_aerdataf_dl +!********************************************************************** +! + SUBROUTINE aerinterpol_dl( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, & + ddy,iindx1,iindx2,ddx,lev,prsl,aerout, errmsg,errflg) +! + use machine, only: kind_phys, kind_dbl_prec + use aerclm_def + + implicit none + integer, intent(out) :: errflg + character(*), intent(out) :: errmsg + integer, intent(in) :: iflip + integer i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i,ii, klev + real(kind=kind_phys) fhour,temj, tx1, tx2,temi, tem, tem1, tem2 + real(kind=kind_phys), dimension(npts) :: temij,temiy,temjx,ddxy + +! + + integer JINDX1(npts), JINDX2(npts), iINDX1(npts), iINDX2(npts) + integer me,idate(4), master, nthrds + integer IDAT(8),JDAT(8) +! + real(kind=kind_phys) DDY(npts), ddx(npts),ttt + real(kind=kind_phys) aerout(npts,lev,ntrcaer) + real(kind=kind_phys) aerpm(npts,levsaer,ntrcaer) + real(kind=kind_phys) prsl(npts,lev), aerpres(npts,levsaer) + real(kind=kind_phys) rjday + real(kind=kind_dbl_prec) rinc(5) + integer jdow, jdoy, jday + character myr*4, mn*2, dy*2 +! + errflg = 0 + errmsg = ' ' + IDAT = 0 + IDAT(1) = IDATE(4) + IDAT(2) = IDATE(2) + IDAT(3) = IDATE(3) + IDAT(5) = IDATE(1) + RINC = 0. + RINC(2) = FHOUR + CALL W3MOVDAT(RINC,IDAT,JDAT) +! + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) +! rjday is the minutes in a day + rjday = jdat(5)*60+jdat(6)+jdat(7)/60. + if(rjday >= t2sv .or. jdat(3).ne.n1sv) then !!need to either to read in a record or open a new file + call read_netfaer_dl(fname_dl,n2sv, iflip, 1, errmsg, errflg) + end if +!! =================================================================== + if(jdat(3).ne.n1sv) then ! a new day is produced from n2sv=1440 + n1sv=jdat(3) + t1sv=aer_t(1) + n2sv=2 + t2sv=aer_t(n2sv) + write(myr,'(i4.4)') jdat(1) + write(mn,'(i2.2)') jdat(2) + write(dy,'(i2.2)') jdat(3) + fname_dl="merra2_"//myr//mn//dy//".nc" + call read_netfaer_dl(fname_dl,n2sv, iflip, 2, errmsg, errflg) + else if (rjday >= t2sv) then + if(t2sv < aer_t(tsaer)) then + n1sv=jdat(3) + t1sv=t2sv + n2sv=n2sv+1 + t2sv=aer_t(n2sv) + write(myr,'(i4.4)') jdat(1) + write(mn,'(i2.2)') jdat(2) + write(dy,'(i2.2)') jdat(3) + fname_dl="merra2_"//myr//mn//dy//".nc" + call read_netfaer_dl(fname_dl,n2sv, iflip, 2, errmsg, errflg) + else !! need to read a new file + n1sv=jdat(3) + t1sv=aer_t(tsaer) + n2sv=1 + t2sv=1440. + call fdnx_fname (jdat(1), jdat(2),jdat(3),fname_dl) + call read_netfaer_dl(fname_dl, n2sv, iflip, 2, errmsg, errflg) + end if + end if +! + tx1 = (t2sv - rjday) / (t2sv - t1sv) + tx2 = 1.0 - tx1 + if (n2 > 12) n2 = n2 -12 + + do j=1,npts + TEMJ = 1.0 - DDY(J) + TEMI = 1.0 - DDX(J) + temij(j) = TEMI*TEMJ + temiy(j) = TEMI*DDY(j) + temjx(j) = TEMJ*DDX(j) + ddxy(j) = DDX(j)*DDY(J) + enddo + +#ifndef __GFORTRAN__ +!$OMP parallel num_threads(nthrds) default(none) & +!$OMP shared(npts,ntrcaer,aerin,aer_pres,prsl) & +!$OMP shared(ddx,ddy,jindx1,jindx2,iindx1,iindx2) & +!$OMP shared(aerpm,aerpres,aerout,lev,nthrds) & +!$OMP shared(temij,temiy,temjx,ddxy,tx1,tx2) & +!$OMP private(l,j,k,ii,i1,i2,j1,j2,tem,tem1,tem2) + +!$OMP do +#endif + DO L=1,levsaer + DO J=1,npts + J1 = JINDX1(J) + J2 = JINDX2(J) + I1 = IINDX1(J) + I2 = IINDX2(J) + DO ii=1,ntrcaer + aerpm(j,L,ii) = & + tx1*(TEMIJ(j)*aerin(I1,J1,L,ii,1)+DDXY(j)*aerin(I2,J2,L,ii,1) & + +TEMIY(j)*aerin(I1,J2,L,ii,1)+temjx(j)*aerin(I2,J1,L,ii,1))& + +tx2*(TEMIJ(j)*aerin(I1,J1,L,ii,2)+DDXY(j)*aerin(I2,J2,L,ii,2) & + +TEMIY(j)*aerin(I1,J2,L,ii,2)+temjx(j)*aerin(I2,J1,L,ii,2)) + ENDDO + + aerpres(j,L) = & + tx1*(TEMIJ(j)*aer_pres(I1,J1,L,1)+DDXY(j)*aer_pres(I2,J2,L,1) & + +TEMIY(j)*aer_pres(I1,J2,L,1)+temjx(j)*aer_pres(I2,J1,L,1))& + +tx2*(TEMIJ(j)*aer_pres(I1,J1,L,2)+DDXY(j)*aer_pres(I2,J2,L,2) & + +TEMIY(j)*aer_pres(I1,J2,L,2)+temjx(j)*aer_pres(I2,J1,L,2)) + ENDDO + ENDDO +#ifndef __GFORTRAN__ +!$OMP end do + +! don't flip, input is the same direction as GFS (bottom-up) +!$OMP do +#endif + DO J=1,npts + DO L=1,lev + if(prsl(j,L) >= aerpres(j,1)) then + DO ii=1, ntrcaer + aerout(j,L,ii) = aerpm(j,1,ii) !! sfc level + ENDDO + else if(prsl(j,L) <= aerpres(j,levsaer)) then + DO ii=1, ntrcaer + aerout(j,L,ii) = aerpm(j,levsaer,ii) !! toa top + ENDDO + else + DO k=1, levsaer-1 !! from sfc to toa + IF(prsl(j,L) <= aerpres(j,k) .and. prsl(j,L)>aerpres(j,k+1)) then + i1 = k + i2 = min(k+1,levsaer) + exit + ENDIF + ENDDO + tem = 1.0 / (aerpres(j,i1) - aerpres(j,i2)) + tem1 = (prsl(j,L) - aerpres(j,i2)) * tem + tem2 = (aerpres(j,i1) - prsl(j,L)) * tem + DO ii = 1, ntrcaer + aerout(j,L,ii) = aerpm(j,i1,ii)*tem1 + aerpm(j,i2,ii)*tem2 + ENDDO + endif + ENDDO !L-loop + ENDDO !J-loop +#ifndef __GFORTRAN__ +!$OMP end do + +!$OMP end parallel +#endif + + RETURN + END SUBROUTINE aerinterpol_dl + + SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) + use machine, only: kind_phys, kind_io4 + use aerclm_def + use netcdf + +!--- in/out + integer, intent(in) :: me, master, iflip, idate(4) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg !--- locals integer :: ncid, varid, ndims, hmx integer :: i, j, k, n, ii, imon, klev - character :: fname*50, mn*2, vname*10 + character :: fname*50, myr*4, mn*2, dy*2,vname*10 logical :: file_exist integer :: dimids(NF90_MAX_VAR_DIMS) integer :: dimlen(NF90_MAX_VAR_DIMS) @@ -67,7 +454,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) endif ! !! =================================================================== -!! check if all necessary files exist +!! check if one file exist !! =================================================================== do imon = 1, 12 write(mn,'(i2.2)') imon @@ -152,7 +539,7 @@ END SUBROUTINE read_aerdata ! !********************************************************************** SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) - use machine, only: kind_phys, kind_io4, kind_io8 + use machine, only: kind_phys, kind_dbl_prec use aerclm_def !--- in/out @@ -165,10 +552,8 @@ SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) logical :: file_exist integer IDAT(8),JDAT(8) real(kind=kind_phys) rjday - real(8) RINC(5) + real(kind=kind_dbl_prec) rinc(5) integer jdow, jdoy, jday - real(4) rinc4(5) - integer w3kindreal,w3kindint integer, allocatable :: invardims(:) ! @@ -186,13 +571,7 @@ SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg) IDAT(5) = IDATE(1) RINC = 0. RINC(2) = FHOUR - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - rinc4 = rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif + CALL W3MOVDAT(RINC,IDAT,JDAT) ! jdow = 0 jdoy = 0 @@ -282,15 +661,15 @@ END SUBROUTINE setindxaer SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, & ddy,iindx1,iindx2,ddx,lev,prsl,aerout, errmsg,errflg) ! - use machine, only: kind_phys, kind_io4, kind_io8 + use machine, only: kind_phys, kind_dbl_prec use aerclm_def implicit none - integer, intent(inout) :: errflg - character(*), intent(inout) :: errmsg + integer, intent(out) :: errflg + character(*), intent(out) :: errmsg integer, intent(in) :: iflip integer i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i,ii, klev - real(kind=kind_phys) fhour,temj, tx1, tx2,temi, tem + real(kind=kind_phys) fhour,temj, tx1, tx2,temi, tem, tem1, tem2 real(kind=kind_phys), dimension(npts) :: temij,temiy,temjx,ddxy ! @@ -304,11 +683,8 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, real(kind=kind_phys) aerpm(npts,levsaer,ntrcaer) real(kind=kind_phys) prsl(npts,lev), aerpres(npts,levsaer) real(kind=kind_phys) rjday + real(kind=kind_dbl_prec) rinc(5) integer jdow, jdoy, jday - real(8) RINC(5) - real(4) rinc4(5) - integer w3kindreal,w3kindint - ! errflg = 0 errmsg = ' ' @@ -319,13 +695,7 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, IDAT(5) = IDATE(1) RINC = 0. RINC(2) = FHOUR - call w3kind(w3kindreal,w3kindint) - if(w3kindreal == 4) then - rinc4 = rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif + CALL W3MOVDAT(RINC,IDAT,JDAT) ! jdow = 0 jdoy = 0 @@ -348,17 +718,12 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, #ifdef DEBUG if (me == master) write(*,*)"read in a new month MERRA2", n2 #endif - DO ii = 1, ntrcaerm - do j = jamin, jamax - do k = 1, levsaer - do i = iamin, iamax - aerin(i,j,k,ii,1) = aerin(i,j,k,ii,2) - enddo !i-loop (lon) - enddo !k-loop (lev) - enddo !j-loop (lat) - ENDDO ! ii-loop (ntracaerm) !! =================================================================== + call read_netfaer(n1, iflip, 1, errmsg, errflg) + if(errflg/=0) return call read_netfaer(n2, iflip, 2, errmsg, errflg) + if(errflg/=0) return +!! =================================================================== n1sv=n1 n2sv=n2 end if @@ -380,10 +745,9 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, !$OMP parallel num_threads(nthrds) default(none) & !$OMP shared(npts,ntrcaer,aerin,aer_pres,prsl) & !$OMP shared(ddx,ddy,jindx1,jindx2,iindx1,iindx2) & -!$OMP shared(aerpm,aerpres,aerout,lev,nthrds) & -!$OMP shared(temij,temiy,temjx,ddxy) & -!$OMP private(l,j,k,ii,i1,i2,j1,j2,tem) & -!$OMP copyin(tx1,tx2) firstprivate(tx1,tx2) +!$OMP shared(aerpm,aerpres,aerout,lev,nthrds) & +!$OMP shared(temij,temiy,temjx,ddxy,tx1,tx2) & +!$OMP private(l,j,k,ii,i1,i2,j1,j2,tem,tem1,tem2) !$OMP do #endif @@ -433,10 +797,10 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, ENDIF ENDDO tem = 1.0 / (aerpres(j,i1) - aerpres(j,i2)) - tx1 = (prsl(j,L) - aerpres(j,i2)) * tem - tx2 = (aerpres(j,i1) - prsl(j,L)) * tem + tem1 = (prsl(j,L) - aerpres(j,i2)) * tem + tem2 = (aerpres(j,i1) - prsl(j,L)) * tem DO ii = 1, ntrcaer - aerout(j,L,ii) = aerpm(j,i1,ii)*tx1 + aerpm(j,i2,ii)*tx2 + aerout(j,L,ii) = aerpm(j,i1,ii)*tem1 + aerpm(j,i2,ii)*tem2 ENDDO endif ENDDO !L-loop @@ -449,14 +813,162 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2, RETURN END SUBROUTINE aerinterpol +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! private subroutines + subroutine fdnx_fname(lyear, lmn, ldy, fname) + integer, intent(inout) ::lyear, lmn, ldy + character, intent(out) :: fname*50 + integer, dimension(12) :: mndy + character myr*4, mn*2, dy*2 + data mndy/31, 28, 31,30,31,30,31,31,30,31,30,31/ + ldy=ldy+1 + if(lmn==12) then + if(ldy>mndy(12)) then + ldy=1 + lmn=1 + lyear=lyear+1 + end if + else if(lmn==2) then + if (mod(lyear,4)==0) then + if(ldy>mndy(2)+1) then + ldy=1 + lmn=3 + end if + else + if(ldy>mndy(2)) then + ldy=1 + lmn=3 + end if + end if + else + if(ldy>mndy(lmn)) then + ldy=1 + lmn=lmn+1 + end if + end if + write(myr,'(i4.4)') lyear + write(mn,'(i2.2)') lmn + write(dy,'(i2.2)') ldy + fname="merra2_"//myr//mn//dy//".nc" + RETURN + END SUBROUTINE fdnx_fname + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine read_netfaer_dl(fname, nf, iflip,nt, errmsg,errflg) + use machine, only: kind_phys, kind_io4 + use aerclm_def + use netcdf + integer, intent(in) :: iflip, nf, nt + character,intent(in) :: fname*50 + integer, intent(out) :: errflg + character(*), intent(out) :: errmsg + integer :: ncid, varid, i,j,k,ii,klev + character :: vname*10 + real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff + real(kind=kind_io4),allocatable,dimension(:,:,:,:):: buffx + real(kind=kind_io4),allocatable,dimension(:,:) :: pres_tmp + integer lstart(4), lcount(4) + +!! =================================================================== + allocate (buff(lonsaer, latsaer, levsw)) + allocate (pres_tmp(lonsaer, levsw)) + allocate (buffx(lonsaer, latsaer, levsw, 1)) + + errflg = 0 + errmsg = ' ' + buff = 0 + pres_tmp = 0 + buffx = 0 + + ncid = -1 + if(.not.netcdf_check(nf90_open(trim(fname), nf90_NOWRITE, ncid), & + errmsg, errflg, 'open '//trim(fname))) then + return + endif + lstart=(/1,1,1,nf/) + lcount=(/lonsaer, latsaer, levsw,1/) +! ====> construct 3-d pressure array (Pa) + varid = -1 + if(.not.netcdf_check(nf90_inq_varid(ncid, "DELP", varid), & + errmsg, errflg, 'find id of DELP var')) then + return + endif + if(.not.netcdf_check(nf90_get_var(ncid, varid, buff, lstart, lcount), & + errmsg, errflg, 'read DELP var')) then + return + endif + do j = jamin, jamax + do i = iamin, iamax +! constract pres_tmp (top-down), note input is top-down + pres_tmp(i,1) = 0. + do k=2, levsw + pres_tmp(i,k) = pres_tmp(i,k-1)+buff(i,j,k) + enddo !k-loop + enddo !i-loop (lon) + +! extract pres_tmp to fill aer_pres (in Pa) + do k = 1, levsaer + if ( iflip == 0 ) then ! data from toa to sfc + klev = k + else ! data from sfc to top + klev = ( levsw - k ) + 1 + endif + do i = iamin, iamax + aer_pres(i,j,k,nt) = 1.d0*pres_tmp(i,klev) + enddo !i-loop (lon) + enddo !k-loop (lev) + enddo !j-loop (lat) + +! ====> construct 4-d aerosol array (kg/kg) +! merra2 data is top down +! for GFS, iflip 0: toa to sfc; 1: sfc to toa + DO ii = 1, ntrcaerm + vname=trim(specname(ii)) + varid = -1 + if(.not.netcdf_check(nf90_inq_varid(ncid, vname, varid), & + errmsg, errflg, 'get id of '//trim(vname)//' var')) then + return + endif + if(.not.netcdf_check(nf90_get_var(ncid, varid, buffx, lstart, lcount), & + errmsg, errflg, 'read '//trim(vname)//' var')) then + return + endif + + do j = jamin, jamax + do k = 1, levsaer +! input is from toa to sfc + if ( iflip == 0 ) then ! data from toa to sfc + klev = k + else ! data from sfc to top + klev = ( levsw - k ) + 1 + endif + do i = iamin, iamax + aerin(i,j,k,ii,nt) = 1.d0*buffx(i,j,klev,1) + if(aerin(i,j,k,ii,nt) < 0 .or. aerin(i,j,k,ii,nt) > 1.) then + aerin(i,j,k,ii,nt) = 1.e-15 + endif + enddo !i-loop (lon) + enddo !k-loop (lev) + enddo !j-loop (lat) + + ENDDO ! ii-loop (ntracaerm) + +! close the file + if(.not.netcdf_check(nf90_close(ncid), errmsg, errflg, 'close '//trim(fname))) then + return + endif + deallocate (buff, pres_tmp) + deallocate (buffx) + END SUBROUTINE read_netfaer_dl +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine read_netfaer(nf, iflip,nt, errmsg,errflg) - use machine, only: kind_phys, kind_io4, kind_io8 + use machine, only: kind_phys, kind_io4 use aerclm_def use netcdf integer, intent(in) :: iflip, nf, nt - integer, intent(inout) :: errflg - character(*), intent(inout) :: errmsg + integer, intent(out) :: errflg + character(*), intent(out) :: errmsg integer :: ncid, varid, i,j,k,ii,klev character :: fname*50, mn*2, vname*10 real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff diff --git a/physics/MP/Morrison_Gettelman/m_micro.F90 b/physics/MP/Morrison_Gettelman/m_micro.F90 index 714372d53..1cc866689 100644 --- a/physics/MP/Morrison_Gettelman/m_micro.F90 +++ b/physics/MP/Morrison_Gettelman/m_micro.F90 @@ -199,7 +199,7 @@ subroutine m_micro_run( im, lm, flipv, dt_i & & prsl_i,u_i,v_i,phil, omega_i, QLLS_i,QILS_i, & & lwheat_i,swheat_i real (kind=kind_phys), dimension(:,0:),intent(in):: prsi_i, phii - real (kind=kind_phys), dimension(:,:), intent(in) :: & + real (kind=kind_phys), dimension(:,:),intent(in) :: & & CNV_DQLDT_i, CLCN_i, QLCN_i, QICN_i, & & CNV_MFD_i, cf_upi, CNV_FICE_i, CNV_NDROP_i, & & CNV_NICE_i, w_upi @@ -214,8 +214,9 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! & CNVPRCP ! output - real (kind=kind_phys),dimension(:,:), intent(out) :: lwm_o, qi_o, & - cldreffl, cldreffi, cldreffr, cldreffs, cldreffg + real (kind=kind_phys),dimension(:,:), intent(out) :: lwm_o, qi_o + real (kind=kind_phys),dimension(:,:), intent(out) :: & + cldreffl, cldreffi, cldreffr, cldreffs, cldreffg real (kind=kind_phys),dimension(:), intent(out) :: rn_o, sr_o character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -224,10 +225,10 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! Anning Cheng 10/24/2016 twat for total water, diagnostic purpose integer, dimension(:), intent(inout):: KCBL real (kind=kind_phys),dimension(:,:),intent(inout):: q_io, t_io, & - & ncpl_io,ncpi_io,CLLS_io - real (kind=kind_phys),dimension(:,:),intent(inout):: rnw_io,snw_io,& - & ncpr_io, ncps_io, & - & qgl_io, ncgl_io + & ncpi_io + real (kind=kind_phys),dimension(:,:),intent(inout) :: & + rnw_io, snw_io, ncpr_io, ncps_io, qgl_io, ncgl_io, ncpl_io, & + CLLS_io ! *GJF !Moo real (kind=kind_phys),dimension(im,lm),intent(inout):: CLLS_io @@ -1986,7 +1987,6 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & end do end do - return end subroutine gw_prof !> @} @@ -2022,7 +2022,6 @@ subroutine find_cldtop(ncol, pver, cf, kcldtop) return endif - end subroutine find_cldtop end module m_micro diff --git a/physics/MP/Morrison_Gettelman/m_micro_pre.F90 b/physics/MP/Morrison_Gettelman/m_micro_pre.F90 index 9893e0db1..8bd75acad 100644 --- a/physics/MP/Morrison_Gettelman/m_micro_pre.F90 +++ b/physics/MP/Morrison_Gettelman/m_micro_pre.F90 @@ -25,9 +25,8 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq real(kind=kind_phys), intent(in) :: & gq0_ice(:,:), gq0_water(:,:), gq0_rain(:,:), gq0_snow(:,:), & gq0_graupel(:,:), gq0_rain_nc(:,:), gq0_snow_nc(:,:), & - gq0_graupel_nc(:,:), cld_shoc(:,:), cnvc(:,:), cnvw(:,:), & - gt0(:,:) - + gq0_graupel_nc(:,:), cnvc(:,:), cnvw(:,:), gt0(:,:) + real(kind=kind_phys), intent(in), optional :: cld_shoc(:,:) real(kind=kind_phys), intent(inout) :: & qrn(:,:), qsnw(:,:), qgl(:,:), ncpr(:,:), ncps(:,:), ncgl(:,:), & cld_frc_MG(:,:) @@ -132,4 +131,4 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq end subroutine m_micro_pre_run - end module m_micro_pre \ No newline at end of file + end module m_micro_pre diff --git a/physics/MP/Morrison_Gettelman/m_micro_pre.meta b/physics/MP/Morrison_Gettelman/m_micro_pre.meta index b8cd2ac32..296c64663 100644 --- a/physics/MP/Morrison_Gettelman/m_micro_pre.meta +++ b/physics/MP/Morrison_Gettelman/m_micro_pre.meta @@ -121,6 +121,7 @@ type = real kind = kind_phys intent = in + optional = True [cnvc] standard_name = convective_cloud_cover long_name = convective cloud cover diff --git a/physics/MP/Morrison_Gettelman/micro_mg3_0.F90 b/physics/MP/Morrison_Gettelman/micro_mg3_0.F90 index bca005bc9..a28de2d74 100644 --- a/physics/MP/Morrison_Gettelman/micro_mg3_0.F90 +++ b/physics/MP/Morrison_Gettelman/micro_mg3_0.F90 @@ -2,12 +2,9 @@ !! This file contains Morrison-Gettelman MP version 3.0 - !! Update of MG microphysics with prognostic hail OR graupel. -!>\ingroup mg2mg3 -!>\defgroup mg3_mp Morrison-Gettelman MP version 3.0 -!> @{ -!!--------------------------------------------------------------------------------- -!! Purpose: -!! MG microphysics version 3.0 - Update of MG microphysics with +!--------------------------------------------------------------------------------- +! Purpose: +!> MG microphysics version 3.0 - Update of MG microphysics with !! prognostic hail OR graupel. !! !! \authors Andrew Gettelman, Hugh Morrison @@ -248,8 +245,7 @@ module micro_mg3_0 contains !=============================================================================== -!>\ingroup mg3_mp -!! This subroutine initializes the microphysics +!> This subroutine initializes the microphysics !! and needs to be called once at start of simulation. !!\author Andrew Gettelman, Dec 2005 subroutine micro_mg_init( & @@ -433,8 +429,7 @@ end subroutine micro_mg_init !=============================================================================== !microphysics routine for each timestep goes here... -!>\ingroup mg3_mp -!! This subroutine calculates the MG3 microphysical processes. +!> This subroutine calculates the MG3 microphysical processes. !>\authors Hugh Morrison, Andrew Gettelman, NCAR, Peter Caldwell, LLNL !! e-mail: morrison@ucar.edu, andrew@ucar.edu !!\section mg3_micro_mg_tend MG3 micro_mg_tend General Algorithm @@ -4484,8 +4479,7 @@ end subroutine micro_mg_tend !OUTPUT CALCULATIONS !======================================================================== -!>\ingroup mg3_mp -!! This subroutine calculates effective radii for rain and cloud. +!> This subroutine calculates effective radii for rain and cloud. subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol,nlev) integer, intent(in) :: mgncol, nlev ! horizontal and vertical dimension real(r8), dimension(mgncol,nlev), intent(in) :: lamr ! rain size parameter (slope) @@ -4528,4 +4522,3 @@ end subroutine calc_rercld !======================================================================== end module micro_mg3_0 -!>@} diff --git a/physics/MP/NSSL/module_mp_nssl_2mom.F90 b/physics/MP/NSSL/module_mp_nssl_2mom.F90 index ad90ec81f..130f9bf9a 100644 --- a/physics/MP/NSSL/module_mp_nssl_2mom.F90 +++ b/physics/MP/NSSL/module_mp_nssl_2mom.F90 @@ -1,32 +1,11 @@ !> \file module_mp_nssl_2mom.F90 - - - - - - - +!! !--------------------------------------------------------------------- -! code snapshot: "Sep 22 2023" at "22:01:53" +! code snapshot: "Apr 17 2025" at "12:17:55" !--------------------------------------------------------------------- -!--------------------------------------------------------------------- -! IMPORTANT: Best results are attained using the 5th-order WENO (Weighted Essentially Non-Oscillatory) advection option (4) for scalars: -! moist_adv_opt = 4, -! scalar_adv_opt = 4, (can also use option 3, which is WENO without the positive definite filter) -! The WENO-5 scheme provides a 5th-order (horizontal and vertical) adaptive weighting of components that -! better preserve monotinicity in strong gradients. The standard 5th-order formulation is prone to undershoots -! (negative values) of mass and number concentrations at cloud edges. The WENO scheme helps -! to prevent undershoots and results in less noise at cloud and reflectivity boundaries. This is particularly -! useful for multi-moment schemes to preserve relationships between mass and number concentration. An option is also available -! for WENO-5 advection of momentum, but this can result in excessive damping of poorly-resolved features. For both scalar and momentum -! the steps 1 and 2 of the Runge-Kutta time integration use standare 5th-order advection, and the WENO-5 is applied on the 3rd (final) -! RK step. Option 3 applies the WENO-5, and option 4 adds the positive definite filter (as also used in option 1). -! -! WENO references: Jiang and Shu, 1996, J. Comp. Phys. v. 126, 202-223; Shu 2003, Int. J. Comp. Fluid Dyn. v. 17 107-118; -! -!>\ingroup mod_mp_nssl2m -!! This module provides a 1/2/3-moment bulk microphysics scheme based on a combination of + +!> This module provides a 1/2/3-moment bulk microphysics scheme based on a combination of !! Straka and Mansell (2005, JAM) and Zeigler (1985, JAS) and modified/upgraded in !! in Mansell, Zeigler, and Bruning (2010, JAS). Two-moment adaptive sedimentation !! follows Mansell (2010, JAS), using parameter infall = 4. @@ -74,7 +53,20 @@ ! ! !--------------------------------------------------------------------- -! Apr. 2023 +! Feb. 2025 +! - More accurate saturation mixing ratio calculation (iqvsopt=1) +! - Changed default droplet renucleation to irenuc=5, which allows extra nucleation at high supersaturation +! - Default explicit rain breakup for 3-moment (irainbreak=2) +! - Imposed reflectivity conservation in graupel->hail conversion (ihlcnh=3) and Bigg +! freezing (both 2- and 3-moment) +! - Option (nsplinter=1001) for ice crystal production by drop freezing/shattering (Sullivan et al. 2018) +! - Option (incwet = 1) to treat wet growth only for D > Dwet rather than all or nothing; results in +! slightly greater hail production due to maintaining dry growth at D < Dwet +! - Improved logic for sedimentation +! - Separated flushing of small masses into its own subroutine (smallvalues) +! - Some syntax fixes for issues with old versions of gfortran +!--------------------------------------------------------------------- +! Apr. 2023 (WRF-4.6) ! - Update to 3-moment for rain, graupel, and hail ! - Change default graupel/hail fall speeds to icdx/icdxhl=6 (Milbrandt & Morrison 2013) ! and also set default ehw0=0.9 and ehlw0=0.9 to compensate for lower fall speeds. @@ -176,8 +168,11 @@ !>\defgroup mod_nsslmp NSSL 2-moment microphysics modules -!!\ingroup nsslmp testphrase one -!! Module for NSSL cloud physics +!!\ingroup nsslmp + +!> This module contains 1/2/3-moment bulk microphysics scheme based on a combination of +!! Straka and Mansell (2005, JAM) and Zeigler (1985, JAS) and modified/upgraded in +!! in Mansell, Zeigler, and Bruning (2010, JAS). MODULE module_mp_nssl_2mom IMPLICIT NONE @@ -186,6 +181,7 @@ MODULE module_mp_nssl_2mom public nssl_2mom_init_const public calc_eff_radius public calcnfromq + private gamma_sp,gamxinf,GAML02, GAML02d300, GAML02d500, fqvs, fqis private gamma_dp, gamxinfdp, gamma_dpr private delbk, delabk @@ -274,6 +270,7 @@ MODULE module_mp_nssl_2mom integer, private :: itfall = 0 integer, private :: iscfall = 1 integer, private :: irfall = -1 + integer, private :: iifall = 0 integer, private :: isfall = 2 ! default limit with method II (more restrictive) logical, private :: do_accurate_sedimentation = .true. ! if true, recalculate fall speeds on sub time steps; (more expensive) ! if false, reuse fall speeds on multiple steps (can have a noticeable speedup) @@ -347,8 +344,9 @@ MODULE module_mp_nssl_2mom ! (first nucleation is done with a KW sat. adj. step) integer, private :: issfilt = 0 ! flag to turn on filtering of supersaturation field integer, private :: icnuclimit = 0 ! limit droplet nucleation based on Konwar et al. (2012) and Chandrakar et al. (2016) - integer, private :: irenuc = 2 ! =1 to always allow renucleation of droplets within the cloud (do no use, obsolete) + integer, private :: irenuc = 5 ! =1 to always allow renucleation of droplets within the cloud (do no use, obsolete) ! =2 renucleation following Twomey/Cohard&Pinty + ! =5 Similar to 7 but can produce extra activated nuclei from the 'smaller' CCN at higher SS ! =7 New renucleation that requires prediction of the number of activated nuclei ! i.e., not only at cloud base integer, private :: irenuc3d = 0 ! =1 to include horizontal gradient in renucleation of droplets within the cloud @@ -409,6 +407,8 @@ MODULE module_mp_nssl_2mom integer, private :: ierw = 1 ! for single-moment rain (LFO/Z) integer, private :: iehr0c = 0 ! 0 -> no collection for T > 0C; 1 -> turn on collection/shedding for T > 0C integer, private :: iehlr0c = 0 ! 0 -> no collection for T > 0C; 1 -> turn on collection/shedding for T > 0C + real , private :: eiw0 = 0.5 ! constant or max assumed ice-crystal-droplet collection efficiency + real , private :: esw0 = 0.5 ! constant or max assumed snow-droplet collection efficiency real , private :: ehw0 = 0.9 ! constant or max assumed graupel-droplet collection efficiency real , private :: erw0 = 1.0 ! constant assumed rain-droplet collection efficiency real , private :: ehlw0 = 0.9 ! constant or max assumed hail-droplet collection efficiency @@ -521,6 +521,8 @@ MODULE module_mp_nssl_2mom real :: sheddiamlg = 10.0e-03 ! diameter of hail to use fwmlarge real :: sheddiam0 = 20.0e-03 ! diameter of hail at which all water is shed + real :: fwmhtmptem = -15. ! temperature at which fwmhtmp fully switches to liquid water only being on large particles + integer :: ifwmhtmptemopt = 1 ! option to use fwmhtmptem (1) or dwet (2) for max liquid at T < 0. integer :: ifwmhopt = 2 ! option for calculating maximum liquid fraction when fwmh and/or fwmhl is set to -1 ! 1 = maximum based on size of maximum mass diameter ! 2 = integrate over spectrum for maximum liquid (experimental) @@ -558,6 +560,8 @@ MODULE module_mp_nssl_2mom real , private :: dwtempmin = 242. ! lowest temperature to allow wet growth conversion to hail real , private :: dwehwmin = 0. ! Minimum ehw to use to find wet growth diameter (if > ehw0, then wet growth diam becomes smaller) real , private :: dg0thresh = 0.15 ! graupel wet growth diameter above which we say do not bother + real , private :: wetgrthtoffset = -1. ! maximum temperature (Celcius) for wet growth (shedding) + real , private :: hailcnvtoffset = -2. ! maximum temperature (Celcius) for hail conversion integer :: ifddenfac = 0 ! = 1 to use density threshold to count FD as GR when converting to HL real :: fddenthresh = 500. ! if ifddenfac > 0, then hail from FD with lower density are considered to come from graupel integer :: icvhl2h = 0 ! allow conversion of hail back to graupel when hail density gets close to minimum allowed @@ -576,8 +580,18 @@ MODULE module_mp_nssl_2mom ! = 1 use mean diameter for breakup ! = 2 use maximum mass diameter for breakup ! = 3 use mass-weighted diameter for breakup - integer :: iraintailbreak = 0 ! 1 = on - real :: draintail = 8.e-3 ! starting size for rain breakup + integer :: irainbreak = -1 ! -1 : auto sets off for 2-moment and on (=2) for 3-moment + ! 0 = off + ! 1 = on (no diameter dependence) (recommend using option 2) + ! 2 = (recommended) as for 1, but apply factor of 1-ec0 to turn off a smaller diameter (ec0 is rain self-coll factor) + ! 10 = as for 1, but sets ec0=1 for rain self-collection (i.e., no passive breakup); set higher rainbreakfac for this option + ! 11 = breakup for DSD tail only; uses draintail etc. + integer :: ibincracr = 0 + real :: rainbreakfac = 1.0e6 ! 1.e6 for irainbreak=2 (reduce double counting); 2.0e6 for lower hand fit for irainbreak=10; 2.542e6 for 'best' fit + real :: draintail = 10.e-3 ! starting size for rain breakup (irainbreak = 11) + real :: drsmall = 1.e-3 ! size of small drops from breakup (irainbreak = 11) + real :: qrbrthresh1 = 0.1e-3 ! lower threshold rain content (kg/m^3) for large drop breakup (irainbreak=11) + real :: qrbrthresh2 = 1.0e-3 ! upper threshold rain content (kg/m^3) for large drop breakup (irainbreak=11) integer, private :: dmrauto = 0 ! = -1 no limiter on crcnw ! = 0 limit crcnw when qr > 1.2*L (Cohard-Pinty 2002) @@ -643,7 +657,7 @@ MODULE module_mp_nssl_2mom real, private :: alphasmlr0 = 14.0 ! shape parameter for drops formed from melting/shedding snow real, private :: delta_alphamlr = 0.5 ! offset from alphamax at which melting does not further collapse the shape parameter - integer :: iqvsopt = 0 ! =0 use old default for tabqvs; =1 use Bolton formulation (Rogers and Yau) + integer, private :: iqvsopt = 1 ! =0 use old default for tabqvs with e/p approx; =1 use Bolton formulation (Rogers and Yau) with e/(p-e) integer :: imaxsupopt = 4 ! how to treat saturation adjustment in two-moment droplets ! 1 = add droplets with same mean mass as current droplets @@ -671,6 +685,8 @@ MODULE module_mp_nssl_2mom integer, private :: lccn = 9 ! 0 or 9, other indices adjusted accordingly integer, private :: lccnuf = 0 integer, private :: lccna = 0 + integer, private :: lccnaco = 0 + integer, private :: lccnanu = 0 integer, private :: lcina = 0 integer, private :: lcin = 0 integer, private :: lnc = 9 @@ -800,6 +816,9 @@ MODULE module_mp_nssl_2mom real, private :: delqxw = 1.0e-10! 1.0e-12 ! real :: tindmn = 233, tindmx = 298.0 ! min and max temperatures where inductive charging is allowed + integer, private :: imorrgdnglimit = 0 ! flag to impose limit on graupel slope parameter + real, private :: morrdnglimit = 2000.E-6 + ! ! gamma function lookup table ! @@ -843,6 +862,7 @@ MODULE module_mp_nssl_2mom integer lvol(lc:lqmx) integer lz(lc:lqmx) integer lliq(li:lqmx) + integer linfall(lc:lqmx) integer denscale(lc:lqmx) ! flag for density scaling (mixing ratio conversion) integer ido(lc:lqmx) @@ -896,11 +916,11 @@ MODULE module_mp_nssl_2mom real xvfmn, xvfmx ! min, max frozen drop volumes real xvgmn, xvgmx ! min, max graupel volumes real xvhmn, xvhmn0, xvhmx, xvhmx0 ! min, max hail volumes - real xvhlmn, xvhlmx ! min, max lg hail volumes + real xvhlmn, xvhlmx, xvhlmx0 ! min, max lg hail volumes - real, parameter :: dhlmn = 0.3e-3, dhlmx = 40.e-3 + real, parameter :: dhlmn = 0.3e-3 real, parameter :: dhmn0 = 0.3e-3 - real, private :: dhmn = dhmn0, dhmx = -1. + real, private :: dhmn = dhmn0, dhmx = -1., dhlmx = -1. ! 40.e-3 real, parameter :: cwradn = 2.0e-6, xcradmn = cwradn ! minimum radius real, parameter :: cwradx = 60.e-6, xcradmx = cwradx ! maximum radius @@ -923,7 +943,7 @@ MODULE module_mp_nssl_2mom parameter( xvfmn=0.523599*(0.1e-3)**3, xvfmx=0.523599*(10.e-3)**3 ) ! mks xvfmx = (pi/6)*(10mm)**3 parameter( xvgmn=0.523599*(0.1e-3)**3, xvgmx=0.523599*(10.e-3)**3 ) ! mks xvfmx = (pi/6)*(10mm)**3 parameter( xvhmn0=0.523599*(0.3e-3)**3, xvhmx0=0.523599*(20.e-3)**3 ) ! mks xvfmx = (pi/6)*(20mm)**3 - parameter( xvhlmn=0.523599*(dhlmn)**3, xvhlmx=0.523599*(dhlmx)**3 ) ! mks xvfmx = (pi/6)*(40mm)**3 + parameter( xvhlmn=0.523599*(dhlmn)**3, xvhlmx0=0.523599*(40.e-3)**3 ) ! mks xvfmx = (pi/6)*(40mm)**3 ! ! electrical permitivity of air C / (N m**2) - check the units @@ -949,6 +969,7 @@ MODULE module_mp_nssl_2mom real, parameter :: cbwbolton = 29.65 ! constants for Bolton formulation real, parameter :: cawbolton = 17.67 + real, parameter :: esbolton = 6.112e2 real, parameter :: tfrh = 233.15 ! -------------------------- @@ -1002,14 +1023,49 @@ MODULE module_mp_nssl_2mom logical, parameter :: do_satadj_for_wrfchem = .true. - integer, parameter :: ac_opt = 0 ! option flag for alternate aerosol (for NUWRF only) + integer, private :: lcn_nu = 0 ! 27 ! need to check no conflict with other variables + integer, private :: lcn_ac = 0 ! 28 + integer, private :: lcn_co = 0 ! 29 + integer, private :: lcinp = 0 ! 30 + integer, private :: ac_opt = 0 ! option flag for: (1 and 2 currently for NUWRF only) + ! 0 : normal NSSL CCN physics + ! 1 : accumulation mode CN following Fridland et al. (2012, 2017), + ! where CCN number is sum of unactivated CCN and droplet concentrations + ! 2 : As for 1 but have three modes (but does not partition activated CCN) + ! 11: As for 1 but track activated CCN as a separate category (CN category advects only) + ! 22: As for 11 but 3 modes, each with its own activation tracer + real, private :: ac_wthresh = 10.0 ! for W < ac_wthresh, use max of sswater and diagnosed SS; otherwise use sswater logical, private :: nuaccoinp = .false. +! T.Iguchi Y2021 Update +! logical :: ac_only = .true. ! flag for considering ac_mode of CN only, or all nu,ac,co modes (still under construction) + + logical, private :: arg_para = .true. ! flag for Abdul-Razzak_and_Ghan parameterization works similarly to flag_qndrop, and neglects irenuc, ccna(mgs), and cnuc(mgs) + real, private :: nu_pmr = 7.5 * 1.e-3 * 1.e-6 ! aerosol radius (meter); these parameter values follow Cheng et al. (2007QJ) + real, private :: nu_pgw = 0.53 ! Unlike original Abdul-Razzak_and_Ghan, this value is used without log (Cheng et al. 2007QJ) + real, private :: nu_kappa = 0.07 ! ammonium sulfate as CCN (Petters and Kreidenweis, 2007ACP) + real, private :: ac_pmr = 3.8 * 1.e-2 * 1.e-6 ! aerosol radius (meter) + real, private :: ac_pgw = 0.69 + real, private :: ac_kappa = 0.61 ! ammonium sulfate as CCN (Petters and Kreidenweis, 2007ACP) + real, private :: co_pmr = 0.51 * 1.e-6 ! aerosol radius (meter) + real, private :: co_pgw = 0.77 + real, private :: co_kappa = 0.61 ! ammonium sulfate as CCN (Petters and Kreidenweis, 2007ACP) + + real, parameter :: cn_minlimit = 1.e3 ! 1.e3 m-3 = 0.001 cm-3 + + logical :: dm15_para = .false. ! flag for DeMott et al. (2015) parameterization for heterogenous freezing, regardless of "ibfc" + ! Note to users: Many of these options are for development and not guaranteed to perform well. ! Some may not be functional depending on the version of the code. ! Some may be useful for ensemble physics diversity. Feel free to contact Ted Mansell if you have questions ! in that regard. NAMELIST /nssl_mp_params/ & +! nuwrf 3-mode params + ac_opt,arg_para, & + ac_kappa, ac_pmr, ac_pgw, & + nu_kappa, nu_pmr, nu_pgw, & + co_kappa, co_pmr, co_pgw, & +! --- ndebug, ncdebug,& iusewetgraupel, & iusewethail, & @@ -1017,16 +1073,17 @@ MODULE module_mp_nssl_2mom idbzci, & vtmaxsed, & itfall,iscfall, & - infall,irfall,isfall, & + infall,irfall,isfall,iifall, & rssflg, & sssflg, & hssflg, & hlssflg, & + irainbreak, rainbreakfac, & irimdenopt,rimdenvwgt, & rimc1, rimc2, rimc3, rimc4, & idiagnosecnu, & icnuclimit, & - irenuc, & + irenuc, ccn, & restoreccn, ccntimeconst, cck, & decayufccn, ufccntimeconst, & switchccn, old_cccn, & @@ -1088,6 +1145,7 @@ MODULE module_mp_nssl_2mom ehimax, & ehsmax, & ecollmx, & + eiw0, esw0, & ehw0, ehlw0, & ehr0, ehlr0, & erw0, & @@ -1097,7 +1155,7 @@ MODULE module_mp_nssl_2mom iqcinit, & ssmxinit, & xvdmx, & - dhmn, dhmx, & + dhmn, dhmx, dhlmx, & fwms,fwmh,fwmhl, & ifwmhopt, & ihxw2rain, & @@ -1113,7 +1171,8 @@ MODULE module_mp_nssl_2mom rescale_low_alphah, & rescale_low_alphahl, & rescale_high_alpha, & - ihlcnh, hldia1,iusedw, dwehwmin, dwmin, dwmax, dwtempmin, dg0thresh, & + ihlcnh, hldia1,iusedw, dwehwmin, dwmin, dwmax, dwtempmin, dg0thresh, incwet, & + wetgrthtoffset, hailcnvtoffset, & icvhl2h, hldnmn,hdnmn, & hlcnhdia, hlcnhqmin, & isedonly, & @@ -1173,6 +1232,8 @@ REAL FUNCTION fqis(t) END FUNCTION fqis +!==========================================================================================! + ! ##################################################################### @@ -1214,6 +1275,7 @@ END SUBROUTINE nssl_2mom_init_const !! NSSL MP setup routine (sets local options and array indices) SUBROUTINE nssl_2mom_init( & & ims,ime, jms,jme, kms,kme, nssl_params, ipctmp, mixphase,ihvol,idoniconlytmp, & + & namelist_filename, internal_nml, & & nssl_graupelfallfac, & & nssl_hailfallfac, & & nssl_ehw0, & @@ -1228,6 +1290,7 @@ SUBROUTINE nssl_2mom_init( & & nssl_alphahl, & & nssl_alphar, & & nssl_density_on, nssl_hail_on, nssl_ccn_on, nssl_icecrystals_on, ccn_is_ccna, & + & nssl_ccn_opt, & & errmsg, errflg, & & infileunit, & & myrank, mpiroot & @@ -1247,14 +1310,20 @@ SUBROUTINE nssl_2mom_init( & & nssl_alphahl, & & nssl_alphar integer, intent(in), optional :: & - & nssl_icdx, & + & nssl_icdx, & & nssl_icdxhl, myrank, mpiroot, & - & nssl_ufccn - logical, intent(in), optional :: nssl_density_on, nssl_hail_on, nssl_ccn_on, nssl_icecrystals_on + & nssl_ufccn, & + & nssl_ccn_opt + logical, intent(in), optional :: nssl_density_on, nssl_ccn_on, nssl_hail_on, nssl_icecrystals_on integer, intent(inout), optional :: ccn_is_ccna integer, intent(in),optional :: infileunit + integer,parameter::strsize=64 + character(len=*), intent(in), optional :: internal_nml(:) + character(len=strsize), intent(in), optional :: namelist_filename + character(len=strsize) :: namelist_inputfile + ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -1274,7 +1343,7 @@ SUBROUTINE nssl_2mom_init( & integer :: hail_on = -1, density_on = -1, icecrystals_on = 1 integer :: ccn_on = -1 - double precision :: arg + double precision :: arg,cwch real :: temq integer :: igam integer :: i,il,j,l @@ -1347,7 +1416,7 @@ SUBROUTINE nssl_2mom_init( & ! hack to switch CCN field to CCNA (activated ccn) ! invertccn = .true. turn_on_ccna = .true. - irenuc = 7 + irenuc = 5 ENDIF ccnuf = Abs( nssl_params(14) ) IF ( present(nssl_ufccn) ) iufccn = nssl_ufccn @@ -1386,27 +1455,44 @@ SUBROUTINE nssl_2mom_init( & ipconc = ipctmp - IF ( ipconc < 5 ) THEN - ihlcnh = 0 - ENDIF IF ( ihlcnh <= 0 ) THEN - IF ( ipconc == 5 ) THEN + IF ( ipconc < 5 ) THEN + ihlcnh = 0 + ELSEIF ( ipconc == 5 ) THEN ihlcnh = 3 ELSEIF ( ipconc >= 6 ) THEN ihlcnh = 3 ENDIF ENDIF - - - - - IF ( .false. ) THEN ! set to true to enable internal namelist read - open(15,file='input.nml',status='old',form='formatted',action='read') - rewind(15) - read(15,NML=nssl_mp_params,iostat=istat) - close(15) + ! turn on active rain breakup by default for 3-moment rain since it has no implicit breakup from sedimentation + ! Check this after namelist read so that user can set irainbreak=0 to turn off + IF ( irainbreak == -1 ) THEN + IF ( ipconc >= 6 ) THEN + irainbreak = 2 + ELSE + irainbreak = 0 + ENDIF + ENDIF + +#ifdef INTERNAL_FILE_NML + read (internal_nml, nml = nssl_mp_params, iostat=istat) +#else + + namelist_inputfile = 'namelist.input' ! default for WRF/cm1 + IF ( present( namelist_filename ) ) THEN + namelist_inputfile = namelist_filename + ELSE + namelist_inputfile = 'input.nml' + ENDIF + + open(15,file=trim(namelist_inputfile),status='old',form='formatted',action='read') + rewind(15) + read(15,NML=nssl_mp_params,iostat=istat) + close(15) +#endif + IF ( .true. ) THEN ! set to true to enable internal namelist read IF ( present ( myrank ) .and. present ( mpiroot ) ) THEN IF ( myrank == mpiroot ) THEN IF ( istat /= 0 ) THEN @@ -1418,11 +1504,9 @@ SUBROUTINE nssl_2mom_init( & open(15,file='nssl_mp_params.out',status='unknown',form='formatted') write(15,NML=nssl_mp_params) close(15) - ENDIF - ENDIF - ENDIF - - + ENDIF + ENDIF + ENDIF IF ( iufccn > 0 ) THEN ! make sure to use option that uses UF ccn irenuc = 7 @@ -1436,6 +1520,9 @@ SUBROUTINE nssl_2mom_init( & IF ( present( nssl_ccn_on ) ) THEN IF ( nssl_ccn_on ) THEN ccn_on = 1 + IF ( present( nssl_ccn_opt ) ) THEN + IF ( nssl_ccn_opt > 10 ) ac_opt = 22 + ENDIF ELSE ccn_on = 0 irenuc = 2 @@ -1446,9 +1533,9 @@ SUBROUTINE nssl_2mom_init( & turn_on_ccna = .true. IF ( present( nssl_ccn_on ) ) THEN IF ( .not. nssl_ccn_on ) THEN - errmsg = 'NSSL_MP Error: Must have nssl_ccn_on=1 for irenuc >= 5!' - errflg = 1 - return + errmsg = 'NSSL_MP Error: Must have nssl_ccn_on=1/true for irenuc >= 5!' + errflg = 1 + return ENDIF ENDIF ENDIF @@ -1524,13 +1611,14 @@ SUBROUTINE nssl_2mom_init( & dtabqvs(l) = ((-caw*(-273.15 + temq))/(temq - cbw)**2 + & & caw/(temq - cbw))*tabqvs(l) ELSE - tabqvs(l) = exp(caw*(temq-273.15)/(temq-cbw)) + tabqvs(l) = exp(cawbolton*(temq-273.15)/(temq-cbwbolton)) dtabqvs(l) = ((-cawbolton*(-273.15 + temq))/(temq - cbwbolton)**2 + & & cawbolton/(temq - cbwbolton))*tabqvs(l) ENDIF tabqis(l) = exp(cai*(temq-273.15)/(temq-cbi)) dtabqis(l) = ((-cai*(-273.15 + temq))/(temq - cbi)**2 + & & cai/(temq - cbi))*tabqis(l) + end do bx(lr) = 0.85 @@ -1582,8 +1670,8 @@ SUBROUTINE nssl_2mom_init( & gmoi(igam) = gamma_dp(arg) end do - ! build lookup table to compute the number and mass fractions of rain drops - ! (imurain=1) greater than a given diameter. Used for qiacr and ciacr + ! build lookup table to compute the number and mass fractions of particles + ! (mu=1) greater than a given diameter. Used for qiacr and ciacr ! Uses incomplete gamma functions ! The terms with bxh or bxhl will be off if the actual bxh or bxhl is different from the base value (icdx=6 option) @@ -1671,6 +1759,8 @@ SUBROUTINE nssl_2mom_init( & lccn = 0 lccnuf = 0 lccna = 0 + lccnaco = 0 + lccnanu = 0 lnc = 0 lnr = 0 lni = 0 @@ -1694,9 +1784,15 @@ SUBROUTINE nssl_2mom_init( & IF ( ipconc == 0 ) THEN IF ( hail_on == 1 ) THEN ! turn on graupel density for 1-moment scheme - lvh = 9 - ltmp = 9 - denscale(lvh) = 1 + IF ( density_on >= 1 ) THEN ! turn on graupel density for 1-moment scheme + lvh = 9 + ltmp = 9 + denscale(lvh) = 1 + ELSE + ltmp = lhab + lvh = 0 + lvhl = 0 + ENDIF ELSE ! no hail, 'LFO' scheme ltmp = lhab lhl = 0 @@ -1836,7 +1932,8 @@ SUBROUTINE nssl_2mom_init( & !debug write(0,*) 'Setting lcin to ',lcin ENDIF na = ltmp - + + ln(:) = 0 ln(lc) = lnc ln(lr) = lnr ln(li) = lni @@ -1844,6 +1941,7 @@ SUBROUTINE nssl_2mom_init( & ln(lh) = lnh IF ( lhl .gt. 1 ) ln(lhl) = lnhl + ipc(:) = 0 ipc(lc) = 2 ipc(lr) = 3 ipc(li) = 1 @@ -2046,9 +2144,19 @@ SUBROUTINE nssl_2mom_init( & ido(lh) = idohw IF ( lhl .gt. 1 ) ido(lhl) = idohl + linfall(:) = infall + linfall(lc) = 0 IF ( irfall .lt. 0 ) irfall = infall IF ( isfall .lt. 0 ) isfall = infall + IF ( iifall .lt. 0 ) iifall = infall IF ( lzr > 0 ) irfall = 0 + IF ( lzs > 0 ) isfall = 0 + IF ( lzh > 0 ) linfall(lh) = 0 + IF ( lzhl > 0 .and. lhl > 0 ) linfall(lhl) = 0 + IF ( lzr > 0 .and. lf > 0 ) linfall(lf) = 0 + linfall(lr) = irfall + linfall(ls) = isfall + linfall(li) = iifall qccn = ccn/rho00 qccnuf = ccnuf/rho00 @@ -2079,6 +2187,19 @@ SUBROUTINE nssl_2mom_init( & ELSE xvhmx = 0.523599*(dhmx)**3 ENDIF + + IF ( dhlmx <= 0.0 ) THEN + xvhlmx = xvhlmx0 + ELSE + xvhlmx = 0.523599*(dhlmx)**3 + ENDIF + + IF ( ipconc == 5 .and. imorrgdnglimit >= 1 ) THEN + ! convert morrdnglimit to xvhmx equivalent + cwch = ((3. + alphah)*(2. + alphah)*(1.0 + alphah))**(-1./3.) + xvhmx = pi/6.0*(morrdnglimit/cwch)**3 + dhmx = morrdnglimit/cwch + ENDIF IF ( qhdpvdn < 0. ) qhdpvdn = xdnmn(lh) IF ( qhacidn < 0. ) qhacidn = xdnmn(lh) @@ -2266,11 +2387,10 @@ SUBROUTINE nssl_2mom_init( & iexy(lhl,ls) = iehlsw ; iexy(lhl,li) = iehli ; iexy(lhl,lc) = iehlc ; iexy(lhl,lr) = iehlr ; ENDIF - + ! IF ( icefallfac /= 1.0 ) write(0,*) 'icefallfac = ',icefallfac ! IF ( snowfallfac /= 1.0 ) write(0,*) 'snowfallfac = ',snowfallfac - RETURN END SUBROUTINE nssl_2mom_init @@ -2282,7 +2402,9 @@ END SUBROUTINE nssl_2mom_init SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw, chl, & cn, vhw, vhl, cna, cni, f_cn, f_cna, f_cina, & f_qc, f_qr, f_qi, f_qs, f_qh, f_qhl, & - cnuf, f_cnuf, & + cn_nu, cn_co, cinp, f_cnnu, f_cnco, f_cinp, & + cna_co, cna_nu, f_cnaco, f_cnanu, & + cnuf, f_cnuf, cn_ac, f_cnac, & zrw, zhw, zhl, f_zrw, f_zhw, f_zhl, f_vhw, f_vhl, & qsw, qhw, qhlw, & tt, th, pii, p, w, dn, dz, dtp, itimestep, & @@ -2304,8 +2426,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw rscghis_2d,rscghis_2dp,rscghis_2dn, & scr,scw,sci,scs,sch,schl,sctot, & elec_physics, & - induc,elecz,scion,sciona, & + induc,elecz,scion,sciona,f_scion,f_sciona, & noninduc,noninducp,noninducn, & + ssat3d,ssati,nssl_ssat_output, & pcc2, pre2, depsubr, & mnucf2, melr2, ctr2, & rim1_2, rim2_2,rim3_2, & @@ -2319,6 +2442,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! re_liquid, re_graupel, re_hail, re_icesnow, & ! vtcloud, vtrain, vtsnow, vtgraupel, vthail, & ipelectmp, & + isedonly_in, & diagflag,ke_diag, & errmsg, errflg, & nssl_progn, & ! wrf-chem @@ -2353,7 +2477,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw qi,qhl,ccw,crw,cci,csw,chw,chl,vhw,vhl integer, optional, intent(in) :: is_theta_or_temp logical, optional, intent(in) :: f_zrw, f_zhw, f_zhl, f_vhw, f_vhl ! not used yet + integer, optional, intent(in) :: nssl_ssat_output real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: dbz, vzf, cn, cna, cni, cnuf + real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: cn_nu, cn_ac, cn_co, cinp, cna_co, cna_nu + logical, optional, intent(in) :: f_cnnu, f_cnac, f_cnco, f_cinp, f_cnaco, f_cnanu + real, dimension(ims:ime, jms:jme), optional, intent(inout):: compdbz real, dimension(ims:ime, jms:jme), optional, intent(inout):: rscghis_2d, & ! 2D accumulation arrays for vertically-integrated charging rate rscghis_2dp, & ! 2D accumulation arrays for vertically-integrated charging rate (positive only) @@ -2365,11 +2493,12 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: & induc,noninduc,noninducp,noninducn ! charging rates: inductive, noninductive (all, positive, negative to graupel) real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(in) :: elecz ! elecsave = Ez - real, dimension(ims:ime, kms:kme, jms:jme,2),optional, intent(inout) :: scion + real, dimension(ims:ime, kms:kme, jms:jme, 2),optional, intent(inout) :: scion real, dimension(ims:ime, kms:kme, jms:jme), intent(in):: p,w,dz,dn real, dimension(ims:ime, kms:kme, jms:jme), intent(in):: pii real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: & + ssat3d, ssati, & pcc2, pre2, depsubr, & mnucf2, melr2, ctr2, & rim1_2, rim2_2,rim3_2, & @@ -2404,13 +2533,14 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw real, dimension(ims:ime, jms:jme), intent(out), optional :: & rainncw2, rainnci2 ! liquid rain, ice, accumulation rates real, optional, intent(in) :: dx,dy - real, intent(in):: dtp - integer, intent(in):: itimestep !, ccntype + real, intent(in) :: dtp + integer, intent(in) :: itimestep !, ccntype integer, intent(in), optional :: ntmul, ntcnt logical, optional, intent(in) :: lastloop logical, optional, intent(in) :: diagflag, f_cna, f_cn, f_cina, f_cnuf logical, optional, intent(in) :: f_qc, f_qr, f_qi, f_qs, f_qh, f_qhl - integer, optional, intent(in) :: ipelectmp, ke_diag + logical, optional, intent(in) :: f_scion,f_sciona + integer, optional, intent(in) :: ipelectmp, ke_diag, isedonly_in ! CCPP error handling character(len=*), intent( out) :: errmsg @@ -2424,7 +2554,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw logical :: flag_cnuf = .false. logical :: flag_ccn = .false. logical :: flag_qi = .true. - logical :: has_reqg_local = .false., has_reqh_local = .false. + logical :: has_reqr_local = .false., has_reqg_local = .false., has_reqh_local = .false. logical :: flag logical :: nwp_diagflag = .false. real :: cinchange, t7max,testmax,wmax @@ -2485,16 +2615,18 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw double precision :: wvol5,wvol10 real :: tmp,dv,dv1,tmpchg real :: rdt + real :: temp1, c1 double precision :: dt1,dt2 double precision :: timesed,timesed1,timesed2,timesed3, timegs, timenucond, timedbz,zmaxsed double precision :: timevtcalc,timesetvt - logical :: f_cnatmp, f_cinatmp + logical :: f_cnatmp, f_cinatmp, f_cnacotmp, f_cnanutmp logical :: has_wetscav integer :: kediagloc integer :: iunit + integer :: isedonly_local real :: ycent, y, emissrate, emissrate0, emissrate1, z, fac, factot real :: fach(kts:kte) @@ -2544,6 +2676,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( .not. flag_qi .and. ffrzs < 1.0 ) ffrzs = 1.0 + IF ( PRESENT ( has_reqr ) ) has_reqr_local = has_reqr > 0 IF ( PRESENT ( has_reqg ) ) has_reqg_local = has_reqg > 0 IF ( PRESENT ( has_reqh ) ) has_reqh_local = has_reqh > 0 @@ -2583,6 +2716,13 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ELSE ipelec = 0 ENDIF + + IF ( present( isedonly_in ) ) THEN + isedonly_local = isedonly_in + ELSE + isedonly_local = 0 + ENDIF + ! IF ( present( dbz ) ) THEN ! DO jy = jts,jte ! DO kz = kts,kte @@ -2635,10 +2775,9 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw infdo = 0 ENDIF - IF ( infall .ge. 3 .or. ipconc .ge. 6 ) THEN + IF ( Any(linfall(:) .ge. 3 ) .or. ipconc .ge. 6 ) THEN infdo = 2 ENDIF - IF ( present( HAILNCV ) .and. lhl < 1 ) THEN ! for WRF 3.1 compatibility HAILNCV(its:ite,jts:jte) = 0. @@ -2681,7 +2820,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! write(0,*) 'N2M: load an, jy,lccn = ',jy,lccn,qccn - IF ( present( pcc2 ) .and. makediag ) THEN + IF ( ( present( pcc2 ) .or. present( axtra ) ) .and. makediag ) THEN axtra2d(its:ite,1,kts:kte,:) = 0.0 ENDIF @@ -2745,7 +2884,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw IF ( lccna > 1 ) THEN IF ( present( cna ) .and. f_cnatmp ) THEN - an(ix,1,kz,lccna) = cna(ix,kz,jy) + an(ix,1,kz,lccna) = Max(0.0, cna(ix,kz,jy) ) ENDIF ENDIF @@ -2770,7 +2909,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw an(ix,1,kz,lnh) = chw(ix,kz,jy) IF ( lhl > 1 ) an(ix,1,kz,lnhl) = chl(ix,kz,jy) ENDIF - IF ( lvh > 0 ) an(ix,1,kz,lvh) = vhw(ix,kz,jy) + IF ( lvh > 0 .and. present( vhw ) ) an(ix,1,kz,lvh) = vhw(ix,kz,jy) IF ( lvhl > 0 .and. present( vhl ) ) an(ix,1,kz,lvhl) = vhl(ix,kz,jy) IF ( ipconc >= 6 ) THEN @@ -2836,7 +2975,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! ! saturation mixing ratio ! - t8s = t00(ix,1,kz)*tabqvs(ltemq) !saturation mixing ratio wrt water + IF ( iqvsopt == 0 ) THEN + t8s = t00(ix,1,kz)*tabqvs(ltemq) !saturation mixing ratio wrt water + ELSE + t8s = rdorv*esbolton*tabqvs(ltemq)/(pn(ix,1,kz) - esbolton*tabqvs(ltemq)) + ENDIF t9s = t00(ix,1,kz)*tabqis(ltemq) !saturation mixing ratio wrt ice ! @@ -2953,15 +3096,10 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ! IF ( .true. ) THEN -! #ifndef CM1 ! for real cases when hydrometeor mixing ratios have been initialized without concentrations IF ( itimestep == 1 .and. ipconc > 0 .and. loopcnt == 1 ) THEN call calcnfromq(nx,ny,nz,an,na,nor,nor,dn1) ENDIF -! IF ( itimestep == 3 .and. ipconc > 0 ) THEN -! call calcnfromq(nx,ny,nz,an,na,nor,nor,dn1) -! ENDIF -! #endif IF ( present(cu_used) .and. & ( present( qrcuten ) .or. present( qscuten ) .or. & @@ -2981,24 +3119,13 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw call calcnfromcuten(nx,ny,nz,ancuten,an,na,nor,nor,dn1) - DO kz = kts,kte - DO ix = its,ite - - - IF ( ipconc >= 6 ) THEN -! IF ( lzr > 0 ) an(ix,1,kz,lzr) = an(ix,1,kz,lzr) + ancuten(ix,1,kz,lzr) - ENDIF - - ENDDO - ENDDO - ENDIF !} ENDIF !} - - + IF ( isedonly_local == 0 ) THEN + call sediment1d(dtp,nx,ny,nz,an,na,nor,nor,xfall,dn1,dz2d,dz2dinv, & & t0,t7,infdo,jy,its,jts & & ,timesed1,timesed2,timesed3,zmaxsed,timesetvt) @@ -3019,11 +3146,11 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw & xfall(ix,1,lh)*1000./xdn0(lr) ) ENDIF IF ( present ( rainncw2 ) ) THEN ! rain only - rainncw2(ix,jy) = rainncw2(ix,jy) + dtp*dn1(ix,1,1)*xfall(ix,1,lr) + rainncw2(ix,jy) = rainncw2(ix,jy) + dtp*dn1(ix,1,1)*xfall(ix,1,lr) ENDIF IF ( present ( rainnci2 ) ) THEN ! ice only IF ( lhl > 1 ) THEN - rainnci2(ix,jy) =rainnci2(ix,jy) + dtp*dn1(ix,1,1)*(xfall(ix,1,ls)*1000./xdn0(lr) + & + rainnci2(ix,jy) = rainnci2(ix,jy) + dtp*dn1(ix,1,1)*(xfall(ix,1,ls)*1000./xdn0(lr) + & & xfall(ix,1,lh)*1000./xdn0(lr) + xfall(ix,1,lhl)*1000./xdn0(lr) ) ELSE rainnci2(ix,jy) = rainnci2(ix,jy) + dtp*dn1(ix,1,1)*(xfall(ix,1,ls)*1000./xdn0(lr) + & @@ -3044,11 +3171,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw SNOWNC(ix,jy) = SNOWNC(ix,jy) + SNOWNCV(ix,jy) ENDIF IF ( lhl > 1 ) THEN -!#ifdef CM1 -! IF ( .true. ) THEN -!#else IF ( present( HAILNC ) ) THEN -!#endif HAILNCV(ix,jy) = dtp*dn1(ix,1,1)*xfall(ix,1,lhl)*1000./xdn0(lr) IF ( loopcnt == loopmax ) HAILNC(ix,jy) = HAILNC(ix,jy) + HAILNCV(ix,jy) ! ELSEIF ( present( GRPLNCV ) ) THEN ! if no separate hail accum, then add to graupel @@ -3067,6 +3190,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDIF ENDDO + ENDIF ! isedonly_local + ! ENDIF ! .false. IF ( isedonly /= 1 ) THEN @@ -3121,6 +3246,14 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw & ,axtra2d, makediag & & ,ssat,t00,t77,flag_qndrop) +! Clean up tiny values of mixing ratio and final checks on max/min sizes + CALL smallvalues & + & (nx,ny,nz,na,jy & + & ,nor,nor,dtp,nx & + & ,t0 & + & ,an,dn1,wn & + & ,t77,flag_qndrop) + ! recalculate dn1 after temperature changes DO kz = kts,kte DO ix = its,ite @@ -3145,6 +3278,40 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDIF + IF ( ( present( ssat3d ) .and. present( nssl_ssat_output ) ) .and. makediag ) THEN + DO kz = kts,kte + DO ix = its,ite + + ! updated temperature and qv + temp1 = t0(ix,1,kz) ! an(ix,1,kz,lt)*t77(ix,1,kz) + ltemq = Int( (temp1-163.15)/fqsat+1.5 ) + ltemq = Min( nqsat, Max(1,ltemq) ) + + IF ( present( ssat3d ) .and. nssl_ssat_output >= 1 ) THEN + +! c1 = t00(ix,1,kz)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + c1 = (380.0/pn(ix,1,kz))*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + c1 = rdorv*esbolton*tabqvs(ltemq)/(pn(ix,1,kz) - esbolton*tabqvs(ltemq)) + ENDIF + + IF ( c1 > 0. ) THEN + ssat3d(ix,kz,jy) = 100.*(an(ix,1,kz,lv)/c1 - 1.0) ! from "new" values + ENDIF + + ENDIF + + IF ( present( ssati ) .and. nssl_ssat_output >= 2 ) THEN + t9s = (380.0/pn(ix,1,kz))*tabqis(ltemq) !saturation mixing ratio wrt ice + ssati(ix,kz,jy) = 100.*(an(ix,1,kz,lv)/t9s - 1.0) ! Min(t8s,max(an(ix,1,kz,lv),0.0))/t9s ! qv/qvi + ENDIF + + ENDDO + ENDDO + ENDIF + + ! compute diagnostic S-band reflectivity if needed IF ( present( dbz ) .and. makediag .and. lastlooptmp ) THEN @@ -3204,7 +3371,8 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw call calc_eff_radius & & (nx,ny,nz,na,jy & & ,nor,nor & - & ,t1=t1,t2=t2,t3=t3,t4=t4,t5=t5,t6=t6,f_t5=has_reqg_local, f_t6=has_reqh_local & + & ,t1=t1,t2=t2,t3=t3,t4=t4,t5=t5,t6=t6 & + & ,f_t4=has_reqr_local,f_t5=has_reqg_local, f_t6=has_reqh_local & & ,an=an,dn=dn1 ) DO kz = kts,kte @@ -3352,7 +3520,7 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw - IF ( lvh > 0 ) vhw(ix,kz,jy) = an(ix,1,kz,lvh) + IF ( lvh > 0 .and. present( vhw ) ) vhw(ix,kz,jy) = an(ix,1,kz,lvh) IF ( lvhl > 0 .and. present( vhl ) ) vhl(ix,kz,jy) = an(ix,1,kz,lvhl) #if ( WRF_CHEM == 1 ) @@ -3368,7 +3536,6 @@ SUBROUTINE nssl_2mom_driver(qv, qc, qr, qi, qs, qh, qhl, ccw, crw, cci, csw, chw ENDDO ENDDO - ENDDO ! jy @@ -3393,17 +3560,15 @@ REAL FUNCTION GAMMA_SP(xx) real xx integer j -! Double precision ser,stp,tmp,x,y,cof(6) - - real*8 ser,stp,tmp,x,y,cof(6) + double precision :: ser,stp,tmp,x,y,cof(6) SAVE cof,stp - DATA cof,stp/76.18009172947146d+0, & + DATA cof /76.18009172947146d+0, & & -86.50532032941677d0, & & 24.01409824083091d0, & & -1.231739572450155d0, & & 0.1208650973866179d-2,& - & -0.5395239384953d-5, & - & 2.5066282746310005d0/ + & -0.5395239384953d-5/ + DATA stp/2.5066282746310005d0/ IF ( xx <= 0.0 ) THEN write(0,*) 'Argument to gamma must be > 0!! xx = ',xx @@ -3789,20 +3954,18 @@ END function BETA DOUBLE PRECISION FUNCTION GAMMA_DP(xx) implicit none - double precision xx + double precision :: xx integer j -! Double precision ser,stp,tmp,x,y,cof(6) - - real*8 ser,stp,tmp,x,y,cof(6) + double precision ser,stp,tmp,x,y,cof(6) SAVE cof,stp - DATA cof,stp/76.18009172947146d+0, & + DATA cof /76.18009172947146d+0, & & -86.50532032941677d0, & & 24.01409824083091d0, & & -1.231739572450155d0, & & 0.1208650973866179d-2,& - & -0.5395239384953d-5, & - & 2.5066282746310005d0/ + & -0.5395239384953d-5/ + DATA stp/2.5066282746310005d0/ x = xx y = x @@ -3838,6 +4001,19 @@ SUBROUTINE GAMMADP(X,GA) integer :: k,m1,m double precision :: G(26) + + DATA G/1.0D0,0.5772156649015329D0, & + & -0.6558780715202538D0, -0.420026350340952D-1, & + & 0.1665386113822915D0,-.421977345555443D-1, & + & -.96219715278770D-2, .72189432466630D-2, & + & -.11651675918591D-2, -.2152416741149D-3, & + & .1280502823882D-3, -.201348547807D-4, & + & -.12504934821D-5, .11330272320D-5, & + & -.2056338417D-6, .61160950D-8, & + & .50020075D-8, -.11812746D-8, & + & .1043427D-9, .77823D-11, & + & -.36968D-11, .51D-12, & + & -.206D-13, -.54D-14, .14D-14, .1D-15/ IF (X.EQ.INT(X)) THEN IF (X.GT.0.0D0) THEN @@ -3861,18 +4037,6 @@ SUBROUTINE GAMMADP(X,GA) ELSE Z=X ENDIF - DATA G/1.0D0,0.5772156649015329D0, & - & -0.6558780715202538D0, -0.420026350340952D-1, & - & 0.1665386113822915D0,-.421977345555443D-1, & - & -.96219715278770D-2, .72189432466630D-2, & - & -.11651675918591D-2, -.2152416741149D-3, & - & .1280502823882D-3, -.201348547807D-4, & - & -.12504934821D-5, .11330272320D-5, & - & -.2056338417D-6, .61160950D-8, & - & .50020075D-8, -.11812746D-8, & - & .1043427D-9, .77823D-11, & - & -.36968D-11, .51D-12, & - & -.206D-13, -.54D-14, .14D-14, .1D-15/ GR=G(26) DO K=25,1,-1 GR=GR*Z+G(K) @@ -4067,7 +4231,7 @@ subroutine hailmaxd(dtp,nx,ny,nz,an,na,nor,norz,alpha2d,dn, & integer :: plo, phi integer :: ialp, i, j - logical :: debug_mpi = .TRUE. + logical :: debug_mpi = .false. ! ################################################################### @@ -4274,7 +4438,6 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ! real gz(-nor+ng1:nz+nor),z1d(-nor+ng1:nz+nor,4) real dtp real xfall(nx,ny,na) ! array for stuff landing on the ground -! real xfall0(nx,ny) ! dummy array integer infdo integer jslab ! which line of xfall to use @@ -4282,14 +4445,6 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & real tmp, vtmax, dtptmp, dtfrac real, parameter :: dz = 200. -! real :: xvt(nz+1,nx,3,lc:lhab) ! (nx,nz,2,lc:lhab) ! 1=mass-weighted, 2=number-weighted -! real :: tmpn(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) -! real :: tmpn2(-nor+ng1:nx+nor,-nor+ng1:ny+nor,-norz+ng1:nz+norz) -! real :: z(-nor+ng1:nx+nor,-norz+ng1:nz+norz,lr:lhab) -! real :: db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) - -! real :: rhovtzx(nz,nx) - real, allocatable :: db1(:,:), dtz1(:,:,:),dz2dinv(:,:),db1inv(:,:) ! db1(nx,nz+1),dtz1(nz+1,nx,0:1),dz2dinv(nz+1,nx),db1inv(nx,nz+1) real, allocatable :: rhovtzx(:,:) real, allocatable :: xfall0(:,:), xvt(:,:,:,:),tmpn(:,:,:),tmpn2(:,:,:),z(:,:,:) @@ -4300,33 +4455,6 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & integer :: ngs ! = 512 integer :: ngscnt,mgs,ipconc0 -! real :: qx(ngs,lv:lhab) -! real :: qxw(ngs,ls:lhab) -! real :: cx(ngs,lc:lhab) -! real :: xv(ngs,lc:lhab) -! real :: vtxbar(ngs,lc:lhab,3) -! real :: xmas(ngs,lc:lhab) -! real :: xdn(ngs,lc:lhab) -! real :: xdia(ngs,lc:lhab,3) -! real :: vx(ngs,li:lhab) -! real :: alpha(ngs,lc:lhab) -! real :: zx(ngs,lr:lhab) -! logical :: hasmass(nx,lc+1:lhab) -! -! integer igs(ngs),kgs(ngs) -! -! real rho0(ngs),temcg(ngs) -! -! real temg(ngs) -! -! real rhovt(ngs) -! -! real cwnc(ngs),cinc(ngs) -! real fadvisc(ngs),cwdia(ngs),cipmas(ngs) -! -! real cimasn,cimasx,cnina(ngs),cimas(ngs) -! -! real cnostmp(ngs) real, allocatable :: qx(:,:) real, allocatable :: qxw(:,:) @@ -4365,8 +4493,6 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & integer :: ixe, jye, kze integer :: plo, phi - logical :: debug_mpi = .TRUE. - ! ################################################################### @@ -4564,12 +4690,9 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & ENDIF ! (n .ge. 2) - IF ( il >= lr .and. ( infall .eq. 3 .or. infall .eq. 4 ) .and. ln(il) > 0 ) THEN - IF ( (il .eq. lr .and. irfall .eq. infall .and. lzr < 1) .or. & - (il .ge. lh .and. lz(il) .lt. 1 ) .or. (il == ls .and. isfall == infall ) ) THEN + IF ( il >= lr .and. ( linfall(il) .eq. 3 .or. linfall(il) .eq. 4 ) .and. ln(il) > 0 ) THEN call calczgr1d(nx,ny,nz,nor,na,an,ixe,kze, & & z,db1,jgs,ipconc, dnu(il), il, ln(il), qxmin(il), xvmn(il), xvmx(il), lvol(il), xdn0(il), ix ) - ENDIF ENDIF if (ndebug .gt. 0 ) write(0,*) 'dbg = 1b' @@ -4606,34 +4729,25 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & IF ( ipconc .gt. 0 ) THEN !{ IF ( ipconc .ge. ipc(il) ) THEN - IF ( ( infall .ge. 2 .or. (infall .eq. 0 .and. il .lt. lh) ) .and. lz(il) .lt. 1) THEN !{ + IF ( ( linfall(il) .ge. 2 ) .and. lz(il) .lt. 1) THEN !{ ! ! load number conc. into tmpn to do fallout by mass-weighted mean fall speed ! to put a lower bound on number conc. ! - IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. ( (il == ls .and. isfall .eq. infall ) & - & .or. il .eq. lh .or. il .eq. lhl .or. il == lf .or. & - & ( il .eq. lr .and. irfall .eq. infall) ) ) THEN - - ! set up for method I+II + IF ( linfall(il) == 3 .or. linfall(il) == 4 ) THEN + ! set up for method I or I+II DO kz = kzb,kze -! DO ix = ixb,ixe tmpn2(ix,jy,kz) = z(ix,kz,il) -! ENDDO ENDDO DO kz = kzb,kze -! DO ix = ixb,ixe tmpn(ix,jy,kz) = an(ix,jy,kz,ln(il)) -! ENDDO ENDDO ELSE ! set up for method II only DO kz = kzb,kze -! DO ix = ixb,ixe tmpn(ix,jy,kz) = an(ix,jy,kz,ln(il)) -! ENDDO ENDDO ENDIF @@ -4644,17 +4758,14 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & if (ndebug .gt. 0 ) write(0,*) 'dbg = 3f' in = 2 - IF ( infall .eq. 1 ) in = 1 + IF ( linfall(il) .eq. 1 ) in = 1 call fallout1d(nx,ny,nz,nor,na,dtptmp,dtfrac,jgs,xvt(1,1,in,il), & & an,db1,ln(il),0,xfall,dtz1,ix) - IF ( lz(il) .lt. 1 ) THEN ! if not 3-moment, run one of the correction schemes - IF ( (infall .ge. 2 .or. infall .eq. 3) .and. .not. (infall .eq. 0 .and. il .ge. lh) & - & .and. ( il .eq. lr .or. (il .ge. li .and. il .le. lhab) )) THEN -! : .or. il .eq. lhl )) THEN - + IF ( lz(il) .lt. 1 ) THEN ! { if not 3-moment, run one of the correction schemes + IF ( linfall(il) >= 2 ) THEN xfall0(:,jgs) = 0.0 IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. & @@ -4669,42 +4780,37 @@ subroutine sediment1d(dtp,nx,ny,nz,an,na,nor,norz,xfall,dn,dz3d,dz3dinv, & & tmpn,db1,1,0,xfall0,dtz1,ix) ENDIF - IF ( ( infall .eq. 3 .or. infall .eq. 4 ) .and. ( (il .eq. lr .and. irfall .eq. infall) & - & .or. il .ge. lh .or. (il == ls .and. isfall .eq. infall ) ) ) THEN -! "Method I" - dbz correction - + IF ( linfall(il) == 3 .or. linfall(il) == 4 ) THEN + ! "Method I" - dbz correction + ! Uses input tmpn2 (temp. Z-moment) to determine if new N and q values in an(:,:,:,ln(il)) + ! cause an increase in reflectivity moment. If so, either use N from mass-wgt Vt (tmpn) to replace + ! new N (infall=3; I) or use smaller N from tmpn or calculated from q and temporary Z (infall=4; I+II) + ! Uses 'z' array to check if new reflectivity is greater than pre-sedimentation reflectivity call calcnfromz1d(nx,ny,nz,nor,na,an,tmpn2,ixe,kze, & & z,db1,jgs,ipconc, dnu(il), il, ln(il), qxmin(il), xvmn(il), xvmx(il),tmpn, & & lvol(il), xdn0(il), infall, ix) - ELSEIF ( infall .eq. 5 .and. il .ge. lh .or. ( il == lr .and. irfall == 5 ) ) THEN + ELSEIF ( linfall(il) .eq. 5 .and. il .ge. lh .or. ( il == lr .and. irfall == 5 ) ) THEN DO kz = kzb,kze -! DO ix = ixb,ixe an(ix,jgs,kz,ln(il)) = Max( an(ix,jgs,kz,ln(il)), 0.5* ( an(ix,jgs,kz,ln(il)) + tmpn(ix,jy,kz) )) - -! ENDDO ENDDO ELSEIF ( .not. (il .eq. lr .and. irfall .eq. 0) .and. .not. (il .eq. ls .and. isfall .eq. 0) ) THEN ! "Method II" M-wgt N-fallout correction DO kz = kzb,kze -! DO ix = ixb,ixe - an(ix,jgs,kz,ln(il)) = Max( an(ix,jgs,kz,ln(il)), tmpn(ix,jy,kz) ) - -! ENDDO ENDDO - ENDIF - ENDIF ! lz(il) .lt. 1 + ENDIF !} + ENDIF - ENDIF - ENDIF + ENDIF !} lz(il) .lt. 1 + ENDIF ! ipconc > ipc - ENDIF !} + ENDIF !} (ipconc > 0) ENDDO ! n=1,ndfall @@ -4792,8 +4898,6 @@ subroutine fallout1d(nx,ny,nz,nor,na,dtp,dtfrac,jgs,vt, & integer :: ixb, jyb, kzb integer :: ixe, jye, kze - logical :: debug_mpi = .TRUE. - ! ################################################################### jy = 1 @@ -5219,7 +5323,7 @@ subroutine calcnfromq(nx,ny,nz,an,na,nor,norz,dn, & integer ix,jy,kz double precision vr,q,nrx,nrx2,rd,g1h,g1hl,g1r,g1s,zx,z,znew,zt,zxt,n1,laminv1 double precision :: zr, zs, zh, dninv - real, parameter :: xn0s = 3.0e6, xn0r = 8.0e6, xn0h = 2.0e5, xn0hl = 4.0e4 + real, parameter :: xn0s = 3.0e8, xn0r = 8.0e6, xn0h = 2.0e5, xn0hl = 4.0e4 real, parameter :: xdnr = 1000., xdns = 100. ,xdnh = 700.0, xdnhl = 900.0 real, parameter :: zhlfac = 1./(pi*xdnhl*xn0hl) real, parameter :: zhfac = 1./(pi*xdnh*xn0h) @@ -5762,7 +5866,7 @@ END subroutine calcnfromcuten SUBROUTINE calc_eff_radius & & (nx,ny,nz,na,jyslab & & ,nor,norz & - & ,t1,t2,t3,t4,t5,t6, f_t5,f_t6 & + & ,t1,t2,t3,t4,t5,t6, f_t4, f_t5,f_t6 & & ,qcw,qci,qsw,qrw & & ,ccw,cci,csw,crw & & ,an,dn ) @@ -5786,16 +5890,13 @@ SUBROUTINE calc_eff_radius & real,optional :: t4(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) real,optional :: t5(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) real,optional :: t6(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) - logical, optional :: f_t5, f_t6 ! flags to fill t5/t6 for graupel/hail + logical, optional :: f_t4, f_t5, f_t6 ! flags to fill t4/t5/t6 for rain/graupel/hail real, optional :: an(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz,na) real dn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) real, optional, dimension(nx,nz) :: qcw,qci,qsw,qrw,ccw,cci,csw,crw - - - ! local real pb(-norz+ng1:nz+norz) @@ -5826,10 +5927,17 @@ SUBROUTINE calc_eff_radius & real :: xdia(ngs,lc:lhab,3) real :: alpha(ngs,lc:lhab) - real :: gamc1,gamc2,gami1,gami2,gams1,gams2,gamr1,gamr2 - real :: factor_c, factor_i, factor_s, factor_r - real :: lam_c, lam_i, lam_s, lam_r + real :: gamc1,gamc2,gami1,gami2,gams1,gams2, factor_c, factor_i, factor_s + real :: lam_c, lam_i, lam_s, lam_r, lam_h, lam_hl + real :: gamr1,gamr2,gamh1,gamh2,factor_r,factor_h,factor_hl integer :: il + real :: hwdn,hldn + double precision :: numh, numhl,denomh,denomhl + + logical :: flag_t4, flag_t5, flag_t6 + + real, parameter :: qmin = 1.e-8 + real, parameter :: volmin = 1.e-30 ! ------------------------------------------------------------------------------- @@ -5844,6 +5952,28 @@ SUBROUTINE calc_eff_radius & nzend = nz kzbeg = 1 nzbeg = 1 + + flag_t4 = .false. + flag_t5 = .false. + flag_t6 = .false. + + IF ( present(f_t4) ) THEN + IF ( present(f_t4) ) THEN + flag_t4 = f_t4 + ENDIF + ENDIF + + IF ( present(f_t5) ) THEN + IF ( present(f_t5) ) THEN + flag_t5 = f_t5 + ENDIF + ENDIF + + IF ( present(f_t6) ) THEN + IF ( present(f_t6) ) THEN + flag_t6 = f_t6 + ENDIF + ENDIF jy = 1 pb(:) = 0.0 @@ -5870,6 +6000,9 @@ SUBROUTINE calc_eff_radius & ENDIF ENDIF + factor_h = ((Pi*(alphah+3.)*(alphah+1.)*(alphah+1.))/6.)**(1./3.) + factor_hl = ((Pi*(alphahl+3.)*(alphahl+1.)*(alphahl+1.))/6.)**(1./3.) + ! ! jy = 1 ! working on a 2d slab !! VERY IMPORTANT: SET jgs = jy @@ -5882,7 +6015,7 @@ SUBROUTINE calc_eff_radius & rho0(mgs) = dn(ix,jy,kz) IF ( present( an ) ) THEN - DO il = lc,ls + DO il = lc,lhab qx(mgs,il) = max(an(ix,jy,kz,il), 0.0) cx(mgs,il) = max(an(ix,jy,kz,ln(il)), 0.0) ENDDO @@ -5918,8 +6051,8 @@ SUBROUTINE calc_eff_radius & t3(ix,jy,kz) = 0.5*factor_s/lam_s ENDIF - IF ( present( t4 ) .and. present(qrw) .and. present(crw) ) THEN - IF ( qx(mgs,lr) > Max(1.e-8,qxmin(lr)) .and. cx(mgs,lr) > cxmin ) THEN + IF ( present( t4 ) .and.( ( present(qrw) .and. present(crw) ) .or. flag_t4 ) ) THEN + IF ( qx(mgs,lr) > Max(qmin,qxmin(lr)) .and. cx(mgs,lr) > cxmin ) THEN IF ( imurain == 1 ) THEN ! gamma-diameter ! Lambda for rain lam_r = factor_r *((xdn0(lr)*cx(mgs,lr))/(qx(mgs,lr)*rho0(mgs)))**(1./3.) @@ -5932,6 +6065,104 @@ SUBROUTINE calc_eff_radius & ENDIF ENDIF + IF ( present(t5) .and. flag_t5 ) THEN + + ! first: case when hail is off + + IF ( lhl < 1 .or. flag_t6 ) THEN + ! graupel only + IF ( qx(mgs,lh) > Max(qmin,qxmin(lh)) ) THEN + ! Lambda for graupel + hwdn = xdn0(lh) + IF ( lvh > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvh) > volmin ) THEN + hwdn = rho0(mgs)*qx(mgs,lh)/an(ix,jy,kz,lvh) + ENDIF + ENDIF + + lam_h = factor_h *((hwdn*cx(mgs,lh))/(qx(mgs,lh)*rho0(mgs)))**(1./3.) + t5(ix,jy,kz) = 0.5*(alphah+3.)/lam_h + ENDIF + + ELSE ! have hail, too, but do not have t6 array + + IF ( qx(mgs,lh) > Max(qmin,qxmin(lh)) .and. qx(mgs,lhl) < Max(qmin,qxmin(lhl)) ) THEN +! Lambda for graupel + hwdn = xdn0(lh) + IF ( lvh > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvh) > volmin ) THEN + hwdn = rho0(mgs)*qx(mgs,lh)/an(ix,jy,kz,lvh) + ENDIF + ENDIF + + lam_h = factor_h *((hwdn*cx(mgs,lh))/(qx(mgs,lh)*rho0(mgs)))**(1./3.) + t5(ix,jy,kz) = 0.5*(alphah+3.)/lam_h + + ELSEIF ( qx(mgs,lh) < Max(qmin,qxmin(lh)) .and. qx(mgs,lhl) > Max(qmin,qxmin(lhl)) ) THEN +! Lambda for hail + hldn = xdn0(lhl) + IF ( lvhl > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvhl) > volmin ) THEN + hldn = rho0(mgs)*qx(mgs,lhl)/an(ix,jy,kz,lvhl) + ENDIF + ENDIF + + lam_hl = factor_hl *((hldn*cx(mgs,lhl))/(qx(mgs,lhl)*rho0(mgs)))**(1./3.) + t5(ix,jy,kz) = 0.5*(alphahl+3.)/lam_hl + + ELSEIF ( qx(mgs,lh) > Max(qmin,qxmin(lh)) .and. qx(mgs,lhl) > Max(qmin,qxmin(lhl)) ) THEN +! r_eff graupel and hail combined + + hldn = xdn0(lhl) + IF ( lvhl > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvhl) > volmin ) THEN + hldn = rho0(mgs)*qx(mgs,lhl)/an(ix,jy,kz,lvhl) + ENDIF + ENDIF + + hwdn = xdn0(lh) + IF ( lvh > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvh) > volmin ) THEN + hwdn = rho0(mgs)*qx(mgs,lh)/an(ix,jy,kz,lvh) + ENDIF + ENDIF + + lam_h = factor_h *((hwdn*cx(mgs,lh))/(qx(mgs,lh)*rho0(mgs)))**(1./3.) + lam_hl = factor_hl *((hldn*cx(mgs,lhl))/(qx(mgs,lhl)*rho0(mgs)))**(1./3.) + + numh = cx(mgs,lh)*(alphah+3.)*(alphah+2.)*(alphah+1.)/lam_h**3 + numhl = cx(mgs,lhl)*(alphahl+3.)*(alphahl+2.)*(alphahl+1.)/lam_hl**3 + + denomh = cx(mgs,lh)*(alphah+2.)*(alphah+1.)/lam_h**2 + denomhl = cx(mgs,lhl)*(alphahl+2.)*(alphahl+1.)/lam_hl**2 + + t5(ix,jy,kz) = 0.5*(numh + numhl)/(denomh + denomhl) + + + ENDIF ! no t6 array + + ENDIF ! lhl + + ENDIF ! flag_t5 + + IF ( present(t6) .and. flag_t6 .and. lhl > 1 ) THEN + + IF ( qx(mgs,lhl) > Max(qmin,qxmin(lhl)) ) THEN +! Lambda for hail + hldn = xdn0(lhl) + IF ( lvhl > 1 ) THEN ! variable density + IF ( an(ix,jy,kz,lvhl) > volmin ) THEN + hldn = rho0(mgs)*qx(mgs,lhl)/an(ix,jy,kz,lvhl) + ENDIF + ENDIF + + lam_hl = factor_hl *((hldn*cx(mgs,lhl))/(qx(mgs,lhl)*rho0(mgs)))**(1./3.) + t6(ix,jy,kz) = 0.5*(alphahl+3.)/lam_hl + + ENDIF + + ENDIF ! t6 + ENDDO ! ix ENDDO ! kz @@ -5979,7 +6210,7 @@ SUBROUTINE QVEXCESS(ngs,mgs,qwvp0,qv0,qcw1,pres,thetap0,theta0, & integer itertd integer ltemq - real gamss + real gamss, tmp real theta(ngs), qvap(ngs), pqs(ngs), qcw(ngs), qwv(ngs) real qcwtmp(ngs), qss(ngs), qvs(ngs), qwvp(ngs) real dqcw(ngs), dqwv(ngs), dqvcnd(ngs) @@ -6020,7 +6251,13 @@ SUBROUTINE QVEXCESS(ngs,mgs,qwvp0,qv0,qcw1,pres,thetap0,theta0, & ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + pqs(mgs) = (380.0)/(pres(mgs)) + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvs(mgs) = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF + qss(mgs) = (0.01*ss1 + 1.0)*qvs(mgs) ! ! iterate adjustment @@ -6080,7 +6317,11 @@ SUBROUTINE QVEXCESS(ngs,mgs,qwvp0,qv0,qcw1,pres,thetap0,theta0, & ! tqvcon = temg(mgs)-cbw ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvs(mgs) = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF qcw(mgs) = max( 0.0, qcw(mgs) ) qwv(mgs) = max( 0.0, qvap(mgs)) qss(mgs) = (0.01*ss1 + 1.0)*qvs(mgs) @@ -6108,9 +6349,9 @@ END SUBROUTINE QVEXCESS !! Mean hydrometeor size and fall speed calculations SUBROUTINE setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & & xmas,vtxbar,xdn,xvmn0,xvmx0,xv,cdx,cdxgs, & - & ipconc1,ndebug1,ngs,nz,kgs,fadvisc, & + & ipconc1,ndebug1,ngs,nz,igs,kgs,fadvisc, & & cwmasn,cwmasx,cwradn,cnina,cimna,cimxa, & - & itype1a,itype2a,temcg,infdo,alpha,ildo,axx,bxx) + & itype1a,itype2a,temcg,infdo,alpha,axx,bxx,ildo) ! & itype1a,itype2a,temcg,infdo,alpha,ildo,axh,bxh,axhl,bxhl) @@ -6139,7 +6380,7 @@ SUBROUTINE setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & real cwc1, cimna, cimxa real cnina(ngs) - integer kgs(ngs) + integer igs(ngs),kgs(ngs) real fadvisc(ngs) real fsw @@ -7373,8 +7614,8 @@ SUBROUTINE setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & & (aax*(xdia(mgs,il,1) )**bbx * & & x)/y ! & Gamma(7.0 + alpha(mgs,il) + bbx)/Gamma(7. + alpha(mgs,il)) - IF ( .not. (vtxbar(mgs,il,1) > -1. .and. vtxbar(mgs,il,1) < 200. ) .or. & - .not. (vtxbar(mgs,il,3) > -1. .and. vtxbar(mgs,il,3) < 200. ) ) THEN + IF ( .not. (vtxbar(mgs,il,1) > -1. .and. vtxbar(mgs,il,1) < 250. ) .or. & + .not. (vtxbar(mgs,il,3) > -1. .and. vtxbar(mgs,il,3) < 250. ) ) THEN write(0,*) 'Setvtz: problem with vtxbar1/3: ',il,vtxbar(mgs,il,1),vtxbar(mgs,il,3),aax,bbx,x,y write(0,*) 'q, number, diam1,3(mm) = ', qx(mgs,il),cx(mgs,il),1000.*xdia(mgs,il,1),1000.*xdia(mgs,il,3) ! call commasmpi_abort() @@ -7612,7 +7853,7 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & logical ldoliq - real chw, qr, z, rd, alp, z1, g1, vr, nrx, tmp + real chw, qr, z, rd, alp, z1, g1, vr, nrx, tmp, tmpc, tmpz real vtmax real xvbarmax @@ -7635,7 +7876,7 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & logical :: debug_mpi = .false. - if (ndebugzf .gt. 0 ) write(0,*) "ZIEGFALL: ENTERED SUBROUTINE" + if (ndebugzf .gt. 0 ) write(0,*) "ZIEGFALL1D: ENTERED SUBROUTINE" ! ##################################################################### ! BEGIN EXECUTABLE @@ -7704,13 +7945,12 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & ngscnt = 0 - do kz = nzmpb,nz + do kz = 1,nz do ix = ixcol,ixcol flag = .false. - DO il = l1,l2 - flag = flag .or. ( an(ix,jy,kz,il) .gt. qxmin(il) ) + flag = flag .or. ( an(ix,jy,kz,il) > 0.0 ) ENDDO if ( flag ) then @@ -7719,7 +7959,7 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & ngscnt = ngscnt + 1 igs(ngscnt) = ix kgs(ngscnt) = kz - if ( ngscnt .eq. ngs ) goto 1100 + if ( ngscnt .eq. nz ) goto 1100 end if end do !!ix nxmpb = 1 @@ -7745,11 +7985,11 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & temg(mgs) = t0(igs(mgs),jy,kgs(mgs)) temcg(mgs) = temg(mgs) - tfr - + ! end do ! -! only need fadvisc for +! only need fadvisc for droplets IF ( lc .gt. 1 .and. (ildo == 0 .or. ildo == lc ) ) then do mgs = 1,ngscnt fadvisc(mgs) = advisc0*(416.16/(temg(mgs)+120.0))* & @@ -7798,58 +8038,52 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & cx(mgs,li) = Max(an(igs(mgs),jy,kgs(mgs),lni), 0.0) end do end if + if ( ipconc .ge. 2 .and. lc .gt. 1 .and. (ildo == 0 .or. ildo == lc ) ) then do mgs = 1,ngscnt cx(mgs,lc) = Max(an(igs(mgs),jy,kgs(mgs),lnc), 0.0) -! cx(mgs,lc) = Min( ccwmx, cx(mgs,lc) ) end do end if + if ( ipconc .ge. 3 .and. lr .gt. 1 .and. (ildo == 0 .or. ildo == lr ) ) then do mgs = 1,ngscnt cx(mgs,lr) = Max(an(igs(mgs),jy,kgs(mgs),lnr), 0.0) -! IF ( qx(mgs,lr) .le. qxmin(lr) ) THEN -! ELSE -! cx(mgs,lr) = Max( 0.0, cx(mgs,lr) ) -! ENDIF end do end if + if ( ipconc .ge. 4 .and. ls .gt. 1 .and. (ildo == 0 .or. ildo == ls ) ) then do mgs = 1,ngscnt cx(mgs,ls) = Max(an(igs(mgs),jy,kgs(mgs),lns), 0.0) -! IF ( qx(mgs,ls) .le. qxmin(ls) ) THEN -! ELSE -! cx(mgs,ls) = Max( 0.0, cx(mgs,ls) ) -! ENDIF end do end if if ( ipconc .ge. 5 .and. lh .gt. 1 .and. (ildo == 0 .or. ildo == lh ) ) then do mgs = 1,ngscnt - cx(mgs,lh) = Max(an(igs(mgs),jy,kgs(mgs),lnh), 0.0) -! IF ( qx(mgs,lh) .le. qxmin(lh) ) THEN -! ELSE -! cx(mgs,lh) = Max( 0.0, cx(mgs,lh) ) -! ENDIF - end do ENDIF if ( ipconc .ge. 5 .and. lhl .gt. 1 .and. (ildo == 0 .or. ildo == lhl ) ) then do mgs = 1,ngscnt - cx(mgs,lhl) = Max(an(igs(mgs),jy,kgs(mgs),lnhl), 0.0) -! IF ( qx(mgs,lhl) .le. qxmin(lhl) ) THEN -! cx(mgs,lhl) = 0.0 -! ELSEIF ( cx(mgs,lhl) .eq. 0.0 .and. qx(mgs,lhl) .lt. 3.0*qxmin(lhl) ) THEN -! qx(mgs,lhl) = 0.0 -! ELSE -! cx(mgs,lhl) = Max( 0.0, cx(mgs,lhl) ) -! ENDIF - end do end if - + + ! Vaporize tiny values + DO il = l1,l2 + IF ( lz(il) < 1 .and. ln(il) > 1 ) THEN + do mgs = 1,ngscnt + IF ( cx(mgs,il) <= cxmin .or. qx(mgs,il) < qxmin(il) ) THEN + cx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),lv) = an(igs(mgs),jgs,kgs(mgs),lv) + an(igs(mgs),jgs,kgs(mgs),il) + qx(mgs,il) = 0.0 + an(igs(mgs),jgs,kgs(mgs),il) = qx(mgs,il) + an(igs(mgs),jgs,kgs(mgs),ln(il)) = cx(mgs,il) + ENDIF + end do + ENDIF + ENDDO + do mgs = 1,ngscnt xdn(mgs,lc) = xdn0(lc) xdn(mgs,lr) = xdn0(lr) @@ -8277,7 +8511,7 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & ! check for artificial breakup (graupel/hail larger than allowed max size) - IF ( imaxdiaopt == 1 ) THEN + IF ( imaxdiaopt == 1 .or. il /= lr ) THEN xvbarmax = xvmx(il) ELSEIF ( imaxdiaopt == 2 ) THEN ! test against maximum mass diameter xvbarmax = xvmx(il) /((3. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) @@ -8293,7 +8527,16 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & IF ( tmp < cx(mgs,il) ) THEN ! breakup g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) - zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + ! check if incoming zx is consistent + ! Z from incoming cx, qx, and alpha + tmpz = g1/(pi/6.*xdn(mgs,il))**2 * ((rho0(mgs)*qx(mgs,il))**2)/tmp + IF ( tmpz > zx(mgs,il) ) THEN + ! find cx that gives zx + tmpc = g1/(pi/6.*xdn(mgs,il))**2 * ((rho0(mgs)*qx(mgs,il))**2)/zx(mgs,il) + cx(mgs,il) = Max(cx(mgs,il), tmpc) + ENDIF + zx(mgs,il) = g1/(pi/6.*xdn(mgs,il))**2 * ((rho0(mgs)*qx(mgs,il))**2)/cx(mgs,il) +! zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) chw = cx(mgs,il) @@ -8367,9 +8610,9 @@ subroutine ziegfall1d(nx,ny,nz,nor,norz,na,dtp,jgs,ixcol, & call setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & & xmas,vtxbar,xdn,xvmn,xvmx,xv,cdx,cdxgs, & - & ipconc,ndebugzf,ngs,nz,kgs,fadvisc, & + & ipconc,ndebugzf,ngs,nz,igs,kgs,fadvisc, & & cwmasn,cwmasx,cwradn,cnina,cimn,cimx, & - & itype1,itype2,temcg,infdo,alpha,ildo,axx,bxx) + & itype1,itype2,temcg,infdo,alpha,axx,bxx,ildo) ! & itype1,itype2,temcg,infdo,alpha,ildo,axh,bxh,axhl,bxhl) @@ -8575,12 +8818,12 @@ subroutine radardd02(nx,ny,nz,nor,na,an,temk, & real dtmp (nx,nz) real tmp - real*8 dtmps, dtmpr, dtmph, dtmphl, g1, zx, ze, x + double precision :: dtmps, dtmpr, dtmph, dtmphl, g1, zx, ze, x integer i,j,k,ix,jy,kz,ihcnt - real*8 xcnoh, xcnos, dadh, dads, zhdryc, zsdryc, zhwetc,zswetc - real*8 dadr + double precision :: xcnoh, xcnos, dadh, dads, zhdryc, zsdryc, zhwetc,zswetc + double precision :: dadr real dbzmax,dbzmin parameter ( dbzmin = 0 ) @@ -9603,7 +9846,7 @@ SUBROUTINE NUCOND & ! - real ccnc(ngs), ccna(ngs), cnuc(ngs), cwnccn(ngs) + real ccnc(ngs), ccna(ngs), cnuc(ngs), cwnccn(ngs), ccnaco(ngs), ccnanu(ngs) real :: ccnc_nu(ngs), ccnc_ac(ngs), ccnc_co(ngs) real ccncuf(ngs) real sscb ! 'cloud base' SS threshold @@ -9627,7 +9870,7 @@ SUBROUTINE NUCOND & real volb, t2s real, parameter :: aa1 = 9.44e15, aa2 = 5.78e3 ! a1 in Ziegler - real ec0, ex1, ft, rhoinv(ngs) + real rhoinv(ngs) real chw, g1, rd1 @@ -9653,6 +9896,7 @@ SUBROUTINE NUCOND & real dcrit real cn(ngs), cnuf(ngs) real :: ccwmax + integer ltemq @@ -9731,16 +9975,35 @@ SUBROUTINE NUCOND & integer, parameter :: iunit = 0 - real :: frac, hwdn, tmpg + real :: frac, hwdn, tmpg, xdia1, xdia3, cwch,xvol real :: cvm,cpm,rmm real, parameter :: cpv = 1885.0 ! specific heat of water vapor at constant pressure - + real, parameter :: Mair = 0.0284 ! MOLECULAR WEIGHT OF 'AIR' (KG/MOL) + + integer :: kstag integer :: count +! Addtion T.Iguchi Y2021 Update + real, parameter :: mwwater = 0.01801528 ! Molecular weight of water (kg/mol) + real, parameter :: rhowater = 997.0 ! Density of liquid water (kg/m3) + real, parameter :: gasconst = 8.3144598 ! Gas constant (m2 kg s-2 K-1 mol-1) + real :: sswater ! unit change supersaturation from percentage to n/a + real :: sigvl, aact + + real :: alpha_ar, gamma_ar, G_ar, evs, zeta, smax + real :: f_ac, g_ac, eta_ac + real :: f_nu, g_nu, eta_nu + real :: f_co, g_co, eta_co + + real :: sm_nu, sm_ac, sm_co, ss_ac, ss_nu, ss_co + real :: uu_nu, uu_ac, uu_co + + real :: cn_ac, cn_co, cn_nu + ! ------------------------------------------------------------------------------- itile = nxi jtile = ny @@ -9780,10 +10043,17 @@ SUBROUTINE NUCOND & ltemq = Int( (temp1-163.15)/fqsat+1.5 ) ltemq = Min( nqsat, Max(1,ltemq) ) - c1 = t00(ix,jy,kz)*tabqvs(ltemq) +! c1 = t00(ix,jy,kz)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + c1 = t00(ix,jy,kz)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + c1 = rdorv*esbolton*tabqvs(ltemq)/(pn(ix,jy,kz) + pb(kz) - esbolton*tabqvs(ltemq)) + ENDIF IF ( c1 > 0. ) THEN ssfilt(ix,jy,kz) = 100.*(an(ix,jy,kz,lv)/c1 - 1.0) ! from "new" values + ELSE + ssfilt(ix,jy,kz) = -100. ENDIF ENDDO @@ -9822,6 +10092,7 @@ SUBROUTINE NUCOND & do kz = kzb,kze do ix = nxmpb,nxi + pres(1) = pn(ix,jy,kz) + pb(kz) pqs(1) = 380.0/(pn(ix,jy,kz) + pb(kz)) theta(1) = an(ix,jy,kz,lt) temg(1) = t0(ix,jy,kz) @@ -9829,7 +10100,12 @@ SUBROUTINE NUCOND & temcg(1) = temg(1) - tfr ltemq = (temg(1)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(1) = pqs(1)*tabqvs(ltemq) + ! qvs(1) = pqs(1)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + qvs(1) = pqs(1)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvs(1) = rdorv*esbolton*tabqvs(ltemq)/(pres(1) - esbolton*tabqvs(ltemq)) + ENDIF qis(1) = pqs(1)*tabqis(ltemq) qss(1) = qvs(1) @@ -9908,11 +10184,21 @@ SUBROUTINE NUCOND & pqs(mgs) = (380.0)/(pres(mgs)) ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(mgs) = pqs(mgs)*tabqvs(ltemq) +! qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvs(mgs) = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF qis(mgs) = pqs(mgs)*tabqis(ltemq) ! qvap(mgs) = max( (qwvp(mgs) + qv0(mgs)), 0.0 ) - es(mgs) = 6.1078e2*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + es(mgs) = 6.1078e2*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + es(mgs) = esbolton*tabqvs(ltemq) + ENDIF +! es(mgs) = 6.1078e2*tabqvs(ltemq) qss(mgs) = qvs(mgs) @@ -9985,7 +10271,37 @@ SUBROUTINE NUCOND & ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + an(igs(mgs),jy,kgs(mgs),lccnuf) ELSE ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + IF ( lccna > 1 ) THEN + cnuc(mgs) = ccnc(mgs) + ENDIF ENDIF + IF ( lcn_nu > 1 ) THEN + ccnc_nu(mgs) = an(igs(mgs),jy,kgs(mgs),lcn_nu) + ENDIF + IF ( lcn_co > 1 ) THEN + ccnc_co(mgs) = an(igs(mgs),jy,kgs(mgs),lcn_co) + ENDIF + IF ( lccnaco > 1 ) THEN + ccnaco(mgs) = an(igs(mgs),jy,kgs(mgs),lccnaco) + ELSE + ccnaco(mgs) = 0.0 + ENDIF + IF ( lccnanu > 1 ) THEN + ccnanu(mgs) = an(igs(mgs),jy,kgs(mgs),lccnanu) + ELSE + ccnanu(mgs) = 0.0 + ENDIF + ELSEIF ( lccn > 1 .and. ( ac_opt == 1 .or. ac_opt == 11 ) ) THEN + ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + ! ccnc(mgs) = ccnc_ac(mgs) + cnuc(mgs) = ccnc(mgs) + cwnccn(mgs) = cnuc(mgs) + ! write(0,*) 'ccnc_ac,mgs = ', ccnc_ac(mgs),mgs,igs(mgs),jy,kgs(mgs) + ELSEIF ( lccn > 1 .and. ( ac_opt == 2 .or. ac_opt == 22 ) ) THEN + ccnc_nu(mgs) = an(igs(mgs),jy,kgs(mgs),lcn_nu) + ccnc(mgs) = an(igs(mgs),jy,kgs(mgs),lccn) + ! ccnc(mgs) = ccnc_ac(mgs) + ccnc_co(mgs) = an(igs(mgs),jy,kgs(mgs),lcn_co) ELSE ccnc(mgs) = cwnccn(mgs) ENDIF @@ -9997,9 +10313,21 @@ SUBROUTINE NUCOND & cnuf(mgs) = 0.0 IF ( lccna > 1 ) THEN ccna(mgs) = an(igs(mgs),jy,kgs(mgs),lccna) ! predicted count of activated ccn + IF ( ac_opt == 22 ) THEN + IF ( lccnaco > 1 ) THEN + ccnaco(mgs) = an(igs(mgs),jy,kgs(mgs),lccnaco) + ELSE + ccnaco(mgs) = 0.0 + ENDIF + IF ( lccnanu > 1 ) THEN + ccnanu(mgs) = an(igs(mgs),jy,kgs(mgs),lccnanu) + ELSE + ccnanu(mgs) = 0.0 + ENDIF + ENDIF ELSE IF ( lccn > 1 ) THEN - ccna(mgs) = cwnccn(mgs) - ccnc(mgs) ! diagnose activated ccn as background value - remaining unactivated ccn + ccna(mgs) = 0.0 ! WRF driver interface already has ccw subtracted from ccnc ELSE ccna(mgs) = cx(mgs,lc) ! approximation of number of activated ccn ENDIF @@ -10016,9 +10344,13 @@ SUBROUTINE NUCOND & DO mgs = 1,ngscnt ! default value of renucfrac is 0.0 IF ( irenuc /= 6 ) THEN - cnuc(mgs) = Max(ccnc(mgs),cwnccn(mgs))*(1. - renucfrac) + ccnc(mgs)*renucfrac + IF ( irenuc == 2 ) THEN + cnuc(mgs) = Max(ccnc(mgs),cwnccn(mgs))*(1. - renucfrac) + ccnc(mgs)*renucfrac + ELSE + cnuc(mgs) = ccnc(mgs)*(1. - renucfrac) + ccnc(mgs)*renucfrac + ENDIF ELSE - cnuc(mgs) = Max(ccnc(mgs),cwnccn(mgs))*(1. - renucfrac) + Max(0.0,ccnc(mgs) - ccna(mgs))*renucfrac + cnuc(mgs) = ccnc(mgs)*(1. - renucfrac) + Max(0.0,ccnc(mgs) - ccna(mgs))*renucfrac ENDIF IF ( renucfrac >= 0.999 ) THEN IF ( temg(mgs) < 265. ) THEN @@ -10429,16 +10761,27 @@ SUBROUTINE NUCOND & QEVAP= Min( qx(mgs,lc), R1*(qss(mgs)-qvap(mgs)) ) - IF ( qx(mgs,lc) <= QEVAP ) THEN ! GO TO 63 + IF ( qx(mgs,lc) <= QEVAP ) THEN !{ GO TO 63 qwvp(mgs) = qwvp(mgs) + qx(mgs,lc) thetap(mgs) = thetap(mgs) - felvcp(mgs)*qx(mgs,lc)/(pi0(mgs)) IF ( io_flag .and. nxtra > 1 ) THEN axtra(igs(mgs),jy,kgs(mgs),1) = -qx(mgs,lc)/dtp ENDIF qx(mgs,lc) = 0. - IF ( restoreccn ) THEN + IF ( restoreccn ) THEN !{ IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) + tmp = restoreccnfrac*cx(mgs,lc) + IF ( lccnaco > 1 .and. lccnanu > 1 ) THEN + ! restore CCN proportionally to each type, although coarse are presumably already lost to rain + tmp2 = ccna(mgs) + ccnaco(mgs) + ccnanu(mgs) + IF ( tmp2 > 0.0 ) THEN + ccna(mgs) = ccna(mgs) - tmp*ccna(mgs)/tmp2 + ccnaco(mgs) = ccnaco(mgs) - tmp*ccnaco(mgs)/tmp2 + ccnanu(mgs) = ccnanu(mgs) - tmp*ccnanu(mgs)/tmp2 + ENDIF + ELSE + ccna(mgs) = ccna(mgs) - tmp + ENDIF ELSEIF ( irenuc <= 2 ) THEN IF ( .not. invertccn ) THEN ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ) ) @@ -10446,16 +10789,27 @@ SUBROUTINE NUCOND & ccnc(mgs) = ccnc(mgs) + restoreccnfrac*cx(mgs,lc) ENDIF ENDIF - ENDIF + ENDIF !} cx(mgs,lc) = 0. - ELSE + ELSE !} { qctmp = qx(mgs,lc) qwvp(mgs) = qwvp(mgs) + QEVAP qx(mgs,lc) = qx(mgs,lc) - QEVAP IF ( qx(mgs,lc) .le. 0. ) THEN IF ( restoreccn ) THEN IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - restoreccnfrac*cx(mgs,lc) + tmp = restoreccnfrac*cx(mgs,lc) + IF ( lccnaco > 1 .and. lccnanu > 1 ) THEN + ! restore CCN proportionally to each type, although coarse are presumably already lost to rain + tmp2 = ccna(mgs) + ccnaco(mgs) + ccnanu(mgs) + IF ( tmp2 > 0.0 ) THEN + ccna(mgs) = ccna(mgs) - tmp*ccna(mgs)/tmp2 + ccnaco(mgs) = ccnaco(mgs) - tmp*ccnaco(mgs)/tmp2 + ccnanu(mgs) = ccnanu(mgs) - tmp*ccnanu(mgs)/tmp2 + ENDIF + ELSE + ccna(mgs) = ccna(mgs) - tmp + ENDIF ELSEIF ( irenuc <= 2 ) THEN ! ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + cx(mgs,lc) ) ) ! ccnc(mgs) = ccnc(mgs) + cx(mgs,lc) @@ -10471,7 +10825,19 @@ SUBROUTINE NUCOND & tmp = 0.9*QEVAP*cx(mgs,lc)/qctmp ! let droplets get smaller but also remove some. A factor of 1.0 would maintain same size IF ( restoreccn ) THEN IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) - restoreccnfrac*tmp + tmp = restoreccnfrac*tmp + IF ( lccnaco > 1 .and. lccnanu > 1 ) THEN + ! restore CCN proportionally to each type, although coarse are presumably already lost to rain + tmp2 = ccna(mgs) + ccnaco(mgs) + ccnanu(mgs) + IF ( tmp2 > 0.0 ) THEN + ccna(mgs) = ccna(mgs) - tmp*ccna(mgs)/tmp2 + ccnaco(mgs) = ccnaco(mgs) - tmp*ccnaco(mgs)/tmp2 + ccnanu(mgs) = ccnanu(mgs) - tmp*ccnanu(mgs)/tmp2 + ENDIF + ELSE + ccna(mgs) = ccna(mgs) - tmp + ENDIF + ! ccna(mgs) = ccna(mgs) - restoreccnfrac*tmp ELSEIF ( irenuc <= 2 ) THEN ! ccnc(mgs) = Max( ccnc(mgs), Min( qccn*rho0(mgs), ccnc(mgs) + tmp ) ) ! ccnc(mgs) = ccnc(mgs) + tmp @@ -10489,7 +10855,7 @@ SUBROUTINE NUCOND & axtra(igs(mgs),jy,kgs(mgs),1) = -QEVAP/dtp ENDIF - ENDIF + ENDIF !} GO TO 631 @@ -10613,7 +10979,11 @@ SUBROUTINE NUCOND & ltemq = Min( nqsat, Max(1,ltemq) ) ltemq1 = ltemq temp1 = temg(mgs) - p380 = 380.0/pres(mgs) + IF ( iqvsopt == 0 ) THEN + p380 = 380.0/pres(mgs) + ELSE + p380 = esbolton*rdorv/(pres(mgs) - es(mgs)) + ENDIF ! taus = Max( 0.05*dtp, Min(taus, 0.25*dtp ) ) ! nc = NInt(dtp/Min(1.0,0.5*taus)) @@ -10783,7 +11153,11 @@ SUBROUTINE NUCOND & temg(mgs) = theta(mgs)*f1 ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvs(mgs) = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF ! es(mgs) = 6.1078e2*tabqvs(ltemq) ! @@ -10821,7 +11195,7 @@ SUBROUTINE NUCOND & ! IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 ) THEN ! test -- fails ! IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. ccnc(mgs) > 0.1*cwnccn(mgs)) THEN ! test -- is OK IF ( ssf(mgs) > ssmx .and. ssf(mgs) < 20.0 .and. & - ( ccnc(mgs) > 0.05*cwnccn(mgs) .or. ( ac_opt > 0 .and. ccnc_ac(mgs) - cx(mgs,lc) > 0.0 ) ) ) THEN ! test + ( ccnc(mgs) > 0.05*cwnccn(mgs) .or. ( ac_opt > 0 .and. ccnc(mgs) - cx(mgs,lc) > 0.0 ) ) ) THEN ! test ! IF ( ssf(mgs) > ssmx ) THEN ! original condition CALL QVEXCESS(ngs,mgs,qwvp,qv0,qx(1,lc),pres,thetap,theta0,dcloud, & & pi0,tabqvs,nqsat,fqsat,cbw,fcqv1,felvcp,ssmx,pk,ngscnt) @@ -10844,7 +11218,12 @@ SUBROUTINE NUCOND & ! temg(mgs) = theta2temp( theta(mgs), pres(mgs) ) ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + ! qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvs(mgs) = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF ! es(mgs) = 6.1078e2*tabqvs(ltemq) !.... S. TWOMEY (1959) @@ -10857,11 +11236,11 @@ SUBROUTINE NUCOND & IF ( .not. flag_qndrop ) THEN ! { do not calculate number of droplets if using wrf-chem - IF ( ac_opt == 0 ) THEN + ! IF ( ac_opt == 0 ) THEN cnuctmp = cnuc(mgs) - ELSE - cnuctmp = ccnc_ac(mgs) - ENDIF + ! ELSE + ! cnuctmp = ccnc(mgs) + ! ENDIF ! IF ( ssmax(mgs) .lt. sscb .and. qx(mgs,lc) .gt. qxmin(lc)) THEN IF ( dcloud .gt. qxmin(lc) .and. wvel(mgs) > 0.0) THEN @@ -10894,11 +11273,11 @@ SUBROUTINE NUCOND & ! ccnc(mgs) = 0.0 ENDIF ELSE - cn(mgs) = Min( cn(mgs), ccnc_ac(mgs) ) + cn(mgs) = Min( cn(mgs), ccnc(mgs) ) ENDIF ! cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - IF ( irenuc <= 2 .and. lccna < 1 ) ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) - ccna(mgs) = ccna(mgs) + cn(mgs) + IF ( irenuc <= 2 .and. lccna < 1 ) ccnc(mgs) = Max(0.0, ccnc(mgs) - cn(mgs)) + ccna(mgs) = ccna(mgs) + cn(mgs) ENDIF ! write(91,*) 'nuc1: cn, ix, kz = ',cn(mgs),igs(mgs),kgs(mgs),wvel(mgs),cnexp,ccnc(mgs) @@ -11192,7 +11571,11 @@ SUBROUTINE NUCOND & ltemq = Int( (temp1-163.15)/fqsat+1.5 ) ltemq = Min( nqsat, Max(1,ltemq) ) - c1= pqs(mgs)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + c1 = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + c1 = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF IF ( c1 > 0. ) THEN ssf(mgs) = Max(0.0, 100.*((qv0(mgs) + qwvp(mgs))/c1 - 1.0) ) ! from "new" values ELSE @@ -11270,7 +11653,11 @@ SUBROUTINE NUCOND & ltemq = Min( nqsat, Max(1,ltemq) ) ! c1 = t00(igs(mgs),jy,kgs(mgs))*tabqvs(ltemq) - c1= pqs(mgs)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + c1 = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + c1 = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF ssf(mgs) = 0.0 IF ( c1 > 0. ) THEN @@ -11371,7 +11758,11 @@ SUBROUTINE NUCOND & ltemq = Min( nqsat, Max(1,ltemq) ) ! c1 = t00(igs(mgs),jy,kgs(mgs))*tabqvs(ltemq) - c1= pqs(mgs)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + c1 = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + c1 = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF ssf(mgs) = 0.0 IF ( c1 > 0. ) THEN @@ -11405,14 +11796,24 @@ SUBROUTINE NUCOND & ENDIF + ELSEIF ( irenuc == 9 .or. irenuc == 10 ) THEN ! } { + + write(0,*) 'irenuc=9 requires nuwrfmods=1' + + ELSEIF ( irenuc == 11 ) THEN ! } { + + write(0,*) 'irenuc=11 requires nuwrfmods=1' ENDIF ! } + ccna(mgs) = ccna(mgs) + cn(mgs) + + ENDIF ! irenuc >= 0 .and. .not. flag_qndrop - IF( cx(mgs,lc) .GT. 0. .AND. qx(mgs,lc) .LE. qxmin(lc)) cx(mgs,lc)=0. + ! IF( cx(mgs,lc) .GT. 0. .AND. qx(mgs,lc) .LE. qxmin(lc)) cx(mgs,lc)=0. GO TO 631 !.... NUCLEATION ON CLOUD INFLOW BOUNDARY POINT @@ -11445,39 +11846,39 @@ SUBROUTINE NUCOND & IF ( qvex .gt. 0.0 ) THEN - thetap(mgs) = thetap(mgs) + felvcp(mgs)*qvex/(pi0(mgs)) - IF ( io_flag .and. nxtra > 1 ) THEN - axtra(igs(mgs),jy,kgs(mgs),1) = axtra(igs(mgs),jy,kgs(mgs),1) + qvex/dtp - ENDIF - qwvp(mgs) = qwvp(mgs) - qvex - qx(mgs,lc) = qx(mgs,lc) + qvex - IF ( .not. flag_qndrop) THEN - IF ( imaxsupopt == 1 ) THEN - cn(mgs) = Min( Max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/Max( cwmasn5, xmas(mgs,lc) ) ) - ELSEIF ( imaxsupopt == 2 ) THEN - cn(mgs) = Min( Max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/Max( cwmasn5, Max(cwmas30,xmas(mgs,lc)) ) ) - ELSEIF ( imaxsupopt == 3 ) THEN - cn(mgs) = Min( Max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/Max( cwmasn5, Max(cwmasx,xmas(mgs,lc)) ) ) -! cn(mgs) = 1.5*cxmin - ELSEIF ( imaxsupopt == 4 ) THEN - cn(mgs) = Min( Max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/Max( cwmasn5, Max(cwmas20,xmas(mgs,lc)) ) ) + thetap(mgs) = thetap(mgs) + felvcp(mgs)*qvex/(pi0(mgs)) + IF ( io_flag .and. nxtra > 1 ) THEN + axtra(igs(mgs),jy,kgs(mgs),1) = axtra(igs(mgs),jy,kgs(mgs),1) + qvex/dtp ENDIF - IF ( lccna > 1 ) THEN - ccna(mgs) = ccna(mgs) + cn(mgs) - ELSE - ccnc(mgs) = Max( 0.0, ccnc(mgs) - cn(mgs) ) - ENDIF - cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - ENDIF - -! write(iunit,*) 'theta = ',theta0(mgs) + thetap(mgs) + qwvp(mgs) = qwvp(mgs) - qvex + qx(mgs,lc) = qx(mgs,lc) + qvex + IF ( .not. flag_qndrop) THEN + IF ( imaxsupopt == 1 ) THEN + cn(mgs) = Min( Max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/Max( cwmasn5, xmas(mgs,lc) ) ) + ELSEIF ( imaxsupopt == 2 ) THEN + cn(mgs) = Min( Max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/Max( cwmasn5, Max(cwmas30,xmas(mgs,lc)) ) ) + ELSEIF ( imaxsupopt == 3 ) THEN + cn(mgs) = Min( Max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/Max( cwmasn5, Max(cwmasx,xmas(mgs,lc)) ) ) +! cn(mgs) = 1.5*cxmin + ELSEIF ( imaxsupopt == 4 ) THEN + cn(mgs) = Min( Max(ccnc(mgs),cwnccn(mgs)), rho0(mgs)*qvex/Max( cwmasn5, Max(cwmas20,xmas(mgs,lc)) ) ) + ENDIF -! temg(mgs) = theta(mgs)*( pres(mgs) / poo ) ** cap + IF ( lccna > 1 ) THEN + !IF ( ac_opt == 0 ) THEN + ccna(mgs) = ccna(mgs) + cn(mgs) + !ENDIF + ELSE + ccnc(mgs) = Max( 0.0, ccnc(mgs) - cn(mgs) ) + ENDIF - ENDIF + cx(mgs,lc) = cx(mgs,lc) + cn(mgs) - - ENDIF + ENDIF ! flag_qndrop + + ENDIF ! ( qvex .gt. 0.0 ) + + ENDIF ! ( qv1 .gt. (ssmx*qvs1) ) ! ! Calculate droplet volume and check if it is within bounds. @@ -11497,7 +11898,6 @@ SUBROUTINE NUCOND & xmas(mgs,lc) = Max( xmas(mgs,lc), cwmasn ) cx(mgs,lc) = rho0(mgs)*qx(mgs,lc)/xmas(mgs,lc) ! IF ( cx(mgs,lc) > tmp*1.1 ) THEN -! write(0,*) 'nucond: kgs, ccw1,2 = ',kgs(mgs),tmp,cx(mgs,lc) ! ENDIF ENDIF ENDIF @@ -11579,11 +11979,27 @@ SUBROUTINE NUCOND & IF ( ipconc .ge. 2 ) THEN an(igs(mgs),jy,kgs(mgs),lnc) = Max(cx(mgs,lc) , 0.0) + ! IF ( ac_opt > 10 .and. (cx(mgs,lc) > 0. .or. ccna(mgs) > 0. ) ) THEN + ! write(0,*) 'i,k final cx/cna = ',igs(mgs),kgs(mgs),cx(mgs,lc),ccna(mgs) + ! ENDIF + IF ( lss > 1 ) an(igs(mgs),jy,kgs(mgs),lss) = Max( 0.0, ssmax(mgs) ) IF ( ac_opt == 0 ) THEN IF ( lccn .gt. 1 .and. lccna .lt. 1 ) THEN an(igs(mgs),jy,kgs(mgs),lccn) = Max(0.0, ccnc(mgs) ) ENDIF + ELSEIF ( ac_opt == 1 .and. lccn > 1) THEN + an(igs(mgs),jy,kgs(mgs),lccn) = Max( 0.0, ccnc(mgs) ) ! cn are depleted for ac_opt=1 or 2 + ELSEIF ( ac_opt == 11 .and. lccna > 1) THEN + ! an(igs(mgs),jy,kgs(mgs),lccna) = Max( 0.0, ccna(mgs) ) ! done below + ELSEIF ( ac_opt == 2 .and. lccn > 1) THEN + an(igs(mgs),jy,kgs(mgs),lccn) = Max( 0.0, ccnc(mgs) ) + an(igs(mgs),jy,kgs(mgs),lcn_nu) = Max( 0.0, ccnc_nu(mgs) ) + an(igs(mgs),jy,kgs(mgs),lcn_co) = Max( 0.0, ccnc_co(mgs) ) + ELSEIF ( ac_opt == 22 .and. lccna > 1) THEN + ! an(igs(mgs),jy,kgs(mgs),lccna) = Max( 0.0, ccna(mgs) ) ! done below + an(igs(mgs),jy,kgs(mgs),lccnanu) = Max( 0.0, ccnanu(mgs) ) + an(igs(mgs),jy,kgs(mgs),lccnaco) = Max( 0.0, ccnaco(mgs) ) ENDIF IF ( lccnuf .gt. 1 .and. .not. ( lccna .gt. 1 .and. i_uf_or_ccn > 0 ) ) THEN an(igs(mgs),jy,kgs(mgs),lccnuf) = Max(0.0, ccncuf(mgs) ) @@ -11591,7 +12007,7 @@ SUBROUTINE NUCOND & IF ( lccna .gt. 1 ) THEN an(igs(mgs),jy,kgs(mgs),lccna) = Max(0.0, ccna(mgs) ) ENDIF - ENDIF + ENDIF ! ipconc >= 2 IF ( ipconc .ge. 3 .and. rcond == 2 ) THEN an(igs(mgs),jy,kgs(mgs),lnr) = Max(cx(mgs,lr) , 0.0) ENDIF @@ -11624,17 +12040,74 @@ SUBROUTINE NUCOND & ! end of gather scatter (for this jy slice) -!#ifdef COMMAS -! GOTO 9999 -!#endif +! Redistribute inappreciable cloud particles and charge +! +! Redistribution everywhere in the domain... +! +! moved to separate subroutine (below) +! + + + + 9999 RETURN + + END SUBROUTINE NUCOND + +! ##################################################################### +! ##################################################################### +! Clean up tiny values of mixing ratio ! Redistribute inappreciable cloud particles and charge ! ! Redistribution everywhere in the domain... ! - IF ( .true. ) THEN - + subroutine smallvalues & + & (nx,ny,nz,na,jyslab & + & ,nor,norz,dtp,nxi & + & ,t0 & + & ,an,dn, w & + & ,t77,flag_qndrop & + & ) + + + implicit none + + integer :: nx,ny,nz,na,nxi + integer :: nor,norz, jyslab ! ,nht,ngt,igsr + real :: dtp ! time step + logical,intent(in) :: flag_qndrop + +! +! external temporary arrays +! + real t77(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real t0(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real an(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz,na) + real dn(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + real w(-nor+1:nx+nor,-nor+1:ny+nor,-norz+1:nz+norz) + + ! local + + + logical zerocx(lc:lqmx) + + real :: frac, hwdn, tmpg, xdia1, xdia3, cwch,xvol + + integer ix,kz,i,n, km1 + integer :: il + integer :: jy, jgs + real :: chw, g1, z1, tmp, tmp2, fw, tmpmx, qr + + +! Redistribute inappreciable cloud particles and charge +! +! Redistribution everywhere in the domain... +! + jy = 1 + frac = 1.0 ! 0.25 ! 1.0 ! 0.2 + + cwch = ((3. + alphah)*(2. + alphah)*(1.0 + alphah))**(-1./3.) ! ! alternate test version for ipconc .ge. 3 ! just vaporize stuff to prevent noise in the number concentrations @@ -11650,12 +12123,14 @@ SUBROUTINE NUCOND & DO il = lc,lhab IF ( iresetmoments == 1 .or. iresetmoments == il ) THEN IF ( ln(il) > 1 ) zerocx(il) = ( an(ix,jy,kz,ln(il)) < cxmin ) - IF ( lz(il) > 1 ) zerocx(il) = ( zerocx(il) .or. an(ix,jy,kz,lz(il)) < zxmin ) + IF ( lz(il) > 1 ) zerocx(il) = ( zerocx(il) .or. (an(ix,jy,kz,lz(il)) < zxmin) ) ELSE IF ( il == lc ) THEN - IF ( ln(il) > 1 ) zerocx(il) = ( an(ix,jy,kz,ln(il)) <= 0 ) .and. .not. flag_qndrop ! do not reset if progn=1 (WRF-CHEM) + IF ( ln(il) > 1 ) THEN + zerocx(il) = ( an(ix,jy,kz,ln(il)) <= 0.0 ) .and. .not. flag_qndrop ! do not reset if progn=1 (WRF-CHEM) + ENDIF ELSE - IF ( ln(il) > 1 ) zerocx(il) = ( an(ix,jy,kz,ln(il)) <= 0 ) + IF ( ln(il) > 1 ) zerocx(il) = ( an(ix,jy,kz,ln(il)) <= 0.0 ) ENDIF ENDIF ENDDO @@ -11699,7 +12174,7 @@ SUBROUTINE NUCOND & ENDIF !lzhl - if ( an(ix,jy,kz,lhl) .lt. frac*qxmin(lhl) .or. zerocx(lhl) ) then + if ( (an(ix,jy,kz,lhl) .lt. frac*qxmin(lhl)) .or. zerocx(lhl) ) then ! IF ( an(ix,jy,kz,lhl) .gt. 0 ) THEN an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lhl) @@ -11773,6 +12248,28 @@ SUBROUTINE NUCOND & ENDIF + IF ( lvhl .gt. 1 ) THEN + IF ( an(ix,jy,kz,lvhl) .gt. 0.0 ) THEN + hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/an(ix,jy,kz,lvhl) + ELSE + hwdn = xdn0(lhl) + ENDIF + hwdn = Max( xdnmn(lhl), hwdn ) + ELSE + hwdn = xdn0(lhl) + ENDIF + + IF ( ipconc >= 5 .and. an(ix,jy,kz,lhl) .gt. qxmin(lhl) ) THEN + qr = an(ix,jy,kz,lhl) + xvol = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/(hwdn*an(ix,jy,kz,lnhl)) + chw = an(ix,jy,kz,lnhl) + + IF ( xvol .lt. xvmn(lhl) .or. xvol .gt. xvmx(lhl) ) THEN + xvol = Min( xvmx(lhl), Max( xvmn(lhl),xvol ) ) + chw = dn(ix,jy,kz)*an(ix,jy,kz,lhl)/(xvol*hwdn) + an(ix,jy,kz,lnhl) = chw + ENDIF + ENDIF ! CHECK INTERCEPT IF ( ipconc == 5 .and. an(ix,jy,kz,lhl) .gt. qxmin(lhl) .and. alphahl .le. 0.1 .and. lnhl .gt. 1 .and. lzhl == 0 ) THEN @@ -11783,9 +12280,9 @@ SUBROUTINE NUCOND & hwdn = xdn0(lhl) ENDIF tmp = (hwdn*an(ix,jy,kz,lnhl))/(dn(ix,jy,kz)*an(ix,jy,kz,lhl)) - tmpg = an(ix,jy,kz,lnhl)*(tmp*(3.14159))**(1./3.) + tmpg = an(ix,jy,kz,lnhl)*(tmp*pi)**(1./3.) IF ( tmpg .lt. cnohlmn ) THEN - tmp = ( (hwdn)/(dn(ix,jy,kz)*an(ix,jy,kz,lhl))*(3.14159))**(1./3.) + tmp = ( (hwdn)/(dn(ix,jy,kz)*an(ix,jy,kz,lhl))*pi)**(1./3.) an(ix,jy,kz,lnhl) = (cnohlmn/tmp)**(3./4.) ENDIF @@ -11835,7 +12332,7 @@ SUBROUTINE NUCOND & ENDIF - if ( an(ix,jy,kz,lh) .lt. frac*qxmin(lh) .or. zerocx(lh) ) then + if ( (an(ix,jy,kz,lh) .lt. frac*qxmin(lh)) .or. zerocx(lh) ) then ! IF ( an(ix,jy,kz,lh) .gt. 0 ) THEN an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lh) @@ -11909,9 +12406,6 @@ SUBROUTINE NUCOND & ENDIF -! CHECK INTERCEPT - IF ( ipconc == 5 .and. an(ix,jy,kz,lh) .gt. qxmin(lh) .and. alphah .le. 0.1 .and. lnh .gt. 1 .and. lzh == 0 ) THEN - IF ( lvh .gt. 1 ) THEN IF ( an(ix,jy,kz,lvh) .gt. 0.0 ) THEN hwdn = dn(ix,jy,kz)*an(ix,jy,kz,lh)/an(ix,jy,kz,lvh) @@ -11922,22 +12416,51 @@ SUBROUTINE NUCOND & ELSE hwdn = xdn0(lh) ENDIF + + IF ( ipconc >= 5 .and. an(ix,jy,kz,lh) .gt. qxmin(lh) ) THEN + qr = an(ix,jy,kz,lh) + xvol = dn(ix,jy,kz)*an(ix,jy,kz,lh)/(hwdn*an(ix,jy,kz,lnh)) + chw = an(ix,jy,kz,lnh) + + IF ( xvol .lt. xvmn(lh) .or. xvol .gt. xvmx(lh) ) THEN + xvol = Min( xvmx(lh), Max( xvmn(lh),xvol ) ) + chw = dn(ix,jy,kz)*an(ix,jy,kz,lh)/(xvol*hwdn) + an(ix,jy,kz,lnh) = chw + ENDIF + ENDIF + +! CHECK INTERCEPT + IF ( ipconc == 5 .and. an(ix,jy,kz,lh) .gt. qxmin(lh) .and. alphah .le. 0.1 .and. lnh .gt. 1 .and. lzh == 0 ) THEN + tmp = (hwdn*an(ix,jy,kz,lnh))/(dn(ix,jy,kz)*an(ix,jy,kz,lh)) - tmpg = an(ix,jy,kz,lnh)*(tmp*(3.14159))**(1./3.) + tmpg = an(ix,jy,kz,lnh)*(tmp*pi)**(1./3.) IF ( tmpg .lt. cnohmn ) THEN ! tmpg = an(ix,jy,kz,lnh)*( (hwdn*an(ix,jy,kz,lnh))/(dn(ix,jy,kz)*an(ix,jy,kz,lh))*(3.14159))**(1./3.) ! tmpg = an(ix,jy,kz,lnh)**(4./3.)*( (hwdn)/(dn(ix,jy,kz)*an(ix,jy,kz,lh))*(3.14159))**(1./3.) - tmp = ( (hwdn)/(dn(ix,jy,kz)*an(ix,jy,kz,lh))*(3.14159))**(1./3.) + tmp = ( (hwdn)/(dn(ix,jy,kz)*an(ix,jy,kz,lh))*pi)**(1./3.) an(ix,jy,kz,lnh) = (cnohmn/tmp)**(3./4.) ENDIF ENDIF + + IF ( ipconc == 5 .and. imorrgdnglimit == 1 ) THEN + ! limit on characteristic diameter (i.e., 1/slope) + xdia3 = (xvol*6.*piinv)**(1./3.) + xdia1 = cwch*xdia3 + IF ( xdia1 > morrdnglimit ) THEN + xdia1 = morrdnglimit + xvol = pi/6.0*(xdia1/cwch)**3 + chw = dn(ix,jy,kz)*qr/(xvol*hwdn) + an(ix,jy,kz,lnh) = chw + xdia3 = (xvol*6.*piinv)**(1./3.) + ENDIF + + ENDIF end if - if ( an(ix,jy,kz,ls) .lt. frac*qxmin(ls) .or. zerocx(ls) & ! .or. an(ix,jy,kz,lns) .lt. 0.1 ! .and. - & ) then + if ( (an(ix,jy,kz,ls) .lt. frac*qxmin(ls)) .or. zerocx(ls) ) then IF ( t0(ix,jy,kz) .lt. 273.15 ) THEN ! IF ( an(ix,jy,kz,ls) .gt. 0 ) THEN an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,ls) @@ -11998,8 +12521,7 @@ SUBROUTINE NUCOND & an(ix,jy,kz,lzr) = Max(0.0, an(ix,jy,kz,lzr) ) ENDIF - if ( an(ix,jy,kz,lr) .lt. frac*qxmin(lr) .or. zerocx(lr) & - & ) then + if ( (an(ix,jy,kz,lr) .lt. frac*qxmin(lr)) .or. zerocx(lr) ) then an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lr) an(ix,jy,kz,lr) = 0.0 IF ( ipconc .ge. 3 ) THEN @@ -12016,8 +12538,7 @@ SUBROUTINE NUCOND & ! ! for qci ! - IF ( an(ix,jy,kz,li) .le. frac*qxmin(li) .or. zerocx(li) & ! .or. an(ix,jy,kz,lni) .lt. 0.1 - & ) THEN + IF ( (an(ix,jy,kz,li) .le. frac*qxmin(li)) .or. zerocx(li) ) THEN an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,li) an(ix,jy,kz,li)= 0.0 IF ( ipconc .ge. 1 ) THEN @@ -12025,41 +12546,11 @@ SUBROUTINE NUCOND & ENDIF ENDIF -! -! for qis -! - IF ( lis > 1 ) THEN ! { - IF ( an(ix,jy,kz,lis) .le. frac*qxmin(lis) .or. zerocx(lis) & ! .or. an(ix,jy,kz,lni) .lt. 0.1 - & ) THEN ! { { - an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lis) - an(ix,jy,kz,lis)= 0.0 - IF ( ipconc .ge. 1 ) THEN - an(ix,jy,kz,lnis) = 0.0 - ENDIF - - ELSEIF ( icespheres >= 2 ) THEN ! } { - km1 = Max(1, kz-1) - IF ( 0.5*( w(ix,jy,kz) + w(ix,jy,kz+1)) < -1.0 .or. & - & (icespheres == 3 .and. ( t0(ix,jy,kz) < 232.15 .or. an(ix,jy,kz,lc) < qxmin(lc) ) ) .or. & - & (icespheres == 5 .and. ( t0(ix,jy,kz) < 232.15 .or. & - & ( an(ix,jy,kz,lc) < qxmin(lc) .and. an(ix,jy,km1,lc) < qxmin(lc) )) ) .or. & - & (icespheres == 4 .and. ( t0(ix,jy,kz) < 235.15 )) ) THEN ! transfer to regular ice crystals in downdraft or at low temp - an(ix,jy,kz,li) = an(ix,jy,kz,li) + an(ix,jy,kz,lis) - an(ix,jy,kz,lni) = an(ix,jy,kz,lni) + an(ix,jy,kz,lnis) - an(ix,jy,kz,lis)= 0.0 - an(ix,jy,kz,lnis)= 0.0 - - ENDIF - - ENDIF ! } } - ENDIF ! } - ! ! for qcw ! - IF ( an(ix,jy,kz,lc) .le. frac*qxmin(lc) .or. zerocx(lc) & - & ) THEN + IF ( (an(ix,jy,kz,lc) .le. frac*qxmin(lc)) .or. zerocx(lc) ) THEN an(ix,jy,kz,lv) = an(ix,jy,kz,lv) + an(ix,jy,kz,lc) an(ix,jy,kz,lc)= 0.0 IF ( ipconc .ge. 2 ) THEN @@ -12067,19 +12558,36 @@ SUBROUTINE NUCOND & IF ( irenuc < 5 .and. lccna <= 1 ) THEN IF ( ac_opt == 0 ) THEN an(ix,jy,kz,lccn) = an(ix,jy,kz,lccn) + Max(0.0,an(ix,jy,kz,lnc)) + ELSEIF ( lccn > 1 ) THEN + an(ix,jy,kz,lccn) = an(ix,jy,kz,lccn) + Max(0.0,an(ix,jy,kz,lnc)) ENDIF ELSEIF ( lccna > 1 ) THEN - an(ix,jy,kz,lccna) = Max( 0.0, an(ix,jy,kz,lccna) - Max(0.0,an(ix,jy,kz,lnc)) ) + tmp = Max(0.0,an(ix,jy,kz,lnc)) + IF ( lccnaco > 1 .and. lccnanu > 1 ) THEN + ! restore CCN proportionally to each type, although coarse are presumably already lost to rain + tmp2 = an(ix,jy,kz,lccna) + an(ix,jy,kz,lccnaco) + an(ix,jy,kz,lccnanu) + IF ( tmp2 > 0.0 .and. tmp > 0.0 ) THEN + an(ix,jy,kz,lccna) = Max( 0.0, an(ix,jy,kz,lccna) - tmp*an(ix,jy,kz,lccna)/tmp2 ) + an(ix,jy,kz,lccnaco) = Max( 0.0, an(ix,jy,kz,lccnaco) - tmp*an(ix,jy,kz,lccnaco)/tmp2 ) + an(ix,jy,kz,lccnanu) = Max( 0.0, an(ix,jy,kz,lccnanu) - tmp*an(ix,jy,kz,lccnanu)/tmp2 ) + ENDIF + ELSE + an(ix,jy,kz,lccna) = Max( 0.0, an(ix,jy,kz,lccna) - tmp ) + ENDIF ENDIF ENDIF an(ix,jy,kz,lnc) = 0.0 IF ( lccn > 1 ) an(ix,jy,kz,lccn) = Max( 0.0, an(ix,jy,kz,lccn) ) - IF ( lccna > 0 .and. ac_opt == 0 ) THEN ! apply exponential decay to activated CCN to restore to environmental value +! IF ( lccna > 0 .and. ac_opt == 0 ) THEN ! apply exponential decay to activated CCN to restore to environmental value + IF ( lccna > 0 ) THEN ! apply exponential decay to activated CCN to restore to environmental value IF ( restoreccn ) THEN tmp = an(ix,jy,kz,li) + an(ix,jy,kz,ls) - - IF ( an(ix,jy,kz,lccna) > 1. .and. tmp < qxmin(li) ) an(ix,jy,kz,lccna) = an(ix,jy,kz,lccna)*Exp(-dtp/ccntimeconst) + IF ( tmp < qxmin(li) ) THEN + IF ( an(ix,jy,kz,lccna) > 1. .and. tmp < qxmin(li) ) an(ix,jy,kz,lccna) = an(ix,jy,kz,lccna)*Exp(-dtp/ccntimeconst) + IF ( lccnaco > 1 ) an(ix,jy,kz,lccnaco) = an(ix,jy,kz,lccnaco)*Exp(-dtp/ccntimeconst) + IF ( lccnanu > 1 ) an(ix,jy,kz,lccnanu) = an(ix,jy,kz,lccnanu)*Exp(-dtp/ccntimeconst) + ENDIF ENDIF ELSEIF ( lccn > 1 .and. restoreccn .and. ac_opt == 0 ) THEN ! in this case, we are treating the ccn field as ccna @@ -12088,7 +12596,8 @@ SUBROUTINE NUCOND & ! write(0,*) 'restore: k, qccn,exp = ',kz,qccn,dn(ix,jy,kz)*qccn,Exp(-dtp/ccntimeconst) ! write(0,*) 'ccn1,ccn2 = ',an(ix,jy,kz,lccn),dn(ix,jy,kz)*qccn - Max(0.0 , dn(ix,jy,kz)*qccn - an(ix,jy,kz,lccn))*Exp(-dtp/ccntimeconst) ! ENDIF - IF ( an(ix,jy,kz,lccn) > 1. .and. tmp < qxmin(li) .and. ( an(ix,jy,kz,lccn) < dn(ix,jy,kz)*qccn .or. .not. invertccn ) ) THEN + IF ( an(ix,jy,kz,lccn) > 1. .and. tmp < qxmin(li) .and. & + ( an(ix,jy,kz,lccn) < dn(ix,jy,kz)*qccn .or. .not. invertccn ) ) THEN ! an(ix,jy,kz,lccn) = & ! an(ix,jy,kz,lccn) + Max(0.0 , dn(ix,jy,kz)*qccn - an(ix,jy,kz,lccn))*(1.0 - Exp(-dtp/ccntimeconst)) ! Equivalent form after expanding last term: @@ -12106,20 +12615,8 @@ SUBROUTINE NUCOND & ! end do end do - ENDIF ! true/false - IF ( ndebug .ge. 1 ) write(6,*) 'END OF ICEZVD_DR' -! -! - - - 9999 RETURN - - END SUBROUTINE NUCOND - - -! ##################################################################### -! ##################################################################### + end subroutine smallvalues !>\ingroup mod_nsslmp !! Main microphysical processes routine @@ -12311,7 +12808,7 @@ subroutine nssl_2mom_gs & integer i,j,k,i1 integer kzb,kze real slope1, slope2 - real x1, x2, x3 + real x1, x2, x3, y1 real eps,eps2 parameter (eps=1.e-20,eps2=1.e-5) ! @@ -12446,12 +12943,13 @@ subroutine nssl_2mom_gs & real, parameter :: mfrag = 1.0e-10 ! assumed ice fragment mass for collisional splintering (Schuur & Rutledge 00b) double precision cautn(ngs), rh(ngs), nh(ngs) real ex1, ft, rhoinv(ngs) - double precision ec0(ngs) + real :: ec0(ngs) - real ac1,bc, taus, c1,d1,e1,f1,p380,tmp,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,temp3 ! , sstdy, super - real :: flim + real ac1,bc, c1,d1,e1,f1,p380,tmp,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,temp3 ! , sstdy, super + real :: flim, xmass real dw,dwr double precision :: tmpz, tmpzmlt + real :: tmpc real ratio, delx, dely real dbigg,volt real chgtmp,fac,mixedphasefac @@ -12621,8 +13119,8 @@ subroutine nssl_2mom_gs & real :: zx(ngs,lr:lhab) real :: zxmxd(ngs,lr:lhab) real :: g1x(ngs,lr:lhab) - + real :: g1xmax,g1xmin real :: qsimxdep(ngs) ! max sublimation of qi+qs+qis real :: qsimxsub(ngs) ! max depositionof qi+qs+qis logical,parameter :: DoSublimationFix = .true. @@ -12645,9 +13143,10 @@ subroutine nssl_2mom_gs & real :: qhgt10mm ! mass greater than 10mm real :: qhgt20mm ! mass greater than 20mm real :: fwmhtmp - real, parameter :: fwmhtmptem = -15. ! temperature at which fwmhtmp fully switches to liquid water only being on large particles +! real, parameter :: fwmhtmptem = -15. ! temperature at which fwmhtmp fully switches to liquid water only being on large particles real, parameter :: d1t = (6.0 * 0.268e-3/(917.* pi))**(1./3.) ! d1t is the diameter of the ice sphere with the mass (0.268e-3 kg) of an 8mm spherical drop real, parameter :: srasheym = 0.1389 ! slope fraction from Rasmussen and Heymsfield + real :: dtmp ! real swvent(ngs),hwvent(ngs),rwvent(ngs),hlvent(ngs),hwventy(ngs),hlventy(ngs),rwventz(ngs) real hxventtmp @@ -12667,6 +13166,7 @@ subroutine nssl_2mom_gs & real qhlmlr0, qhlmlr05, qhlmlr1, qhlmlr2,qhlmlr3, qhlmlr12, qhlmlr23 real qxd1, cxd1, zxd1 ! mass and number up to mltdiam1 real qxd05, cxd05 ! mass and number up to mltdiam1/2 + real :: qrbreak, crbreaksmall, crbreak, zrbreak, breakbin real :: qxd(ndiam+4), cxd(ndiam+4), qhml(ndiam+4), qhml0(ndiam+4) real :: dqxd(ndiam+4), dcxd(ndiam+4), dqhml(ndiam+4) @@ -12797,6 +13297,7 @@ subroutine nssl_2mom_gs & ! real qsaci(ngs) real qsacis(ngs) + real csacis(ngs) real qhaci(ngs) real qhacs(ngs) @@ -12805,6 +13306,7 @@ subroutine nssl_2mom_gs & real :: chacis0(ngs) real :: csaci0(ngs) ! collision rate only + real :: csacis0(ngs) ! collision rate only real :: chaci0(ngs) ! collision rate only real :: chacs0(ngs) ! collision rate only real :: chlaci0(ngs) @@ -12955,7 +13457,7 @@ subroutine nssl_2mom_gs & real ehxw(ngs),ehlw(ngs),egmw(ngs),ehw(ngs) real err(ngs),esr(ngs),eglr(ngs),eghr(ngs),efr(ngs) real ehxr(ngs),ehlr(ngs),egmr(ngs) - real eri(ngs),esi(ngs),egli(ngs),eghi(ngs),efi(ngs),efis(ngs) + real eri(ngs),esi(ngs),esis(ngs),egli(ngs),eghi(ngs),efi(ngs),efis(ngs) real ehxi(ngs),ehli(ngs),egmi(ngs),ehi(ngs),ehis(ngs),ehlis(ngs) real ers(ngs),ess(ngs),egls(ngs),eghs(ngs),efs(ngs),ehs(ngs),ehsfac(ngs) real ehscnv(ngs) @@ -12964,7 +13466,7 @@ subroutine nssl_2mom_gs & real ehsclsn(ngs),ehiclsn(ngs),ehisclsn(ngs) real efsclsn(ngs),eficlsn(ngs),efisclsn(ngs) real ehlsclsn(ngs),ehliclsn(ngs),ehlisclsn(ngs) - real esiclsn(ngs) + real esiclsn(ngs),esisclsn(ngs) real :: ehs_collsn = 0.5, ehi_collsn = 1.0 real :: efs_collsn = 0.5, efi_collsn = 1.0 @@ -13544,6 +14046,7 @@ subroutine nssl_2mom_gs & do ix = nxmpb,itile pqs(1) = t00(ix,jy,kz) + pres(1) = pn(ix,jy,kz) + pb(kz) theta(1) = an(ix,jy,kz,lt) temg(1) = t0(ix,jy,kz) @@ -13551,7 +14054,12 @@ subroutine nssl_2mom_gs & tqvcon = temg(1)-cbw ltemq = (temg(1)-163.15)/fqsat + 1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(1) = pqs(1)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + qvs(1) = pqs(1)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvs(1) = rdorv*esbolton*tabqvs(ltemq)/(pres(1) - esbolton*tabqvs(ltemq)) + ENDIF + IF ( iqis0 == 1 .or. temg(1) <= tfr+0.5 ) THEN qis(1) = pqs(1)*tabqis(ltemq) ELSE @@ -13637,7 +14145,13 @@ subroutine nssl_2mom_gs & pqs(mgs) = (380.0)/(pres(mgs)) ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + + IF ( iqvsopt == 0 ) THEN + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvs(mgs) = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF + IF ( iqis0 == 1 .or. temg(mgs) <= tfr+0.5 ) THEN qis(mgs) = pqs(mgs)*tabqis(ltemq) ELSE @@ -13870,6 +14384,12 @@ subroutine nssl_2mom_gs & IF ( ipconc .ge. 6 ) THEN + tmp = alphamax - 1.0 + g1xmax = (6.0 + tmp)*(5.0 + tmp)*(4.0 + tmp)/ & + & ((3.0 + tmp)*(2.0 + tmp)*(1.0 + tmp)) + g1xmin = (6.0 + alphamin)*(5.0 + alphamin)*(4.0 + alphamin)/ & + & ((3.0 + alphamin)*(2.0 + alphamin)*(1.0 + alphamin)) + IF ( lz(lr) .lt. 1 ) THEN g1x(:,lr) = (6.0 + alphar)*(5.0 + alphar)*(4.0 + alphar)/ & & ((3.0 + alphar)*(2.0 + alphar)*(1.0 + alphar)) @@ -13894,6 +14414,18 @@ subroutine nssl_2mom_gs & ENDIF + IF ( ipconc == 5 ) THEN + ! set up factors for ihlcnh=3 conversion + g1x(:,lr) = (6.0 + alphar)*(5.0 + alphar)*(4.0 + alphar)/ & + & ((3.0 + alphar)*(2.0 + alphar)*(1.0 + alphar)) + g1x(:,lh) = (6.0 + alphah)*(5.0 + alphah)*(4.0 + alphah)/ & + & ((3.0 + alphah)*(2.0 + alphah)*(1.0 + alphah)) + IF ( lhl > 0 ) THEN + g1x(:,lhl) = (6.0 + alphahl)*(5.0 + alphahl)*(4.0 + alphahl)/ & + & ((3.0 + alphahl)*(2.0 + alphahl)*(1.0 + alphahl)) + ENDIF + ENDIF + scx(:,:) = 0.0 ! ! set shape parameters @@ -14008,7 +14540,6 @@ subroutine nssl_2mom_gs & tmp = qx(mgs,li)+qx(mgs,ls)+qx(mgs,lh) IF ( lhl > 1 ) tmp = tmp + qx(mgs,lhl) - IF ( lf > 1 ) tmp = tmp + qx(mgs,lf) cvm = cv+cvv*qx(mgs,lv)+cpl*(qx(mgs,lc)+qx(mgs,lr)) & +cpigb*(tmp) @@ -14169,7 +14700,7 @@ subroutine nssl_2mom_gs & ! alpha(mgs,lr) = Min(alphamax, c1r*tanh(c2r*(xdia(mgs,lr,3)*1000. - c3r)) + c4r) ! IF ( igs(mgs) == 19 ) write(0,*) 'imy: i,k,alpr,xdia = ',igs(mgs),kgs(mgs),alpha(mgs,lr),xdia(mgs,lr,3)*1000. - ! M&M-C 2010: + ! Milbrandt & M-C 2010: tmp = 4. + alphar i = Int(dgami*(tmp)) del = tmp - dgam*i @@ -14190,7 +14721,7 @@ subroutine nssl_2mom_gs & xdia(mgs,lh,3) = (xv(mgs,lh)*6.*piinv)**(1./3.) ! mwfac*xdia(mgs,lh,1) ! (xv(mgs,lh)*cwc0*6.0)**(1./3.) ! alpha(mgs,lh) = Min(alphamax, c1h*tanh(c2h*(xdia(mgs,lh,3)*1000. - c3h)) + c4h) - ! M&M-C 2010: + ! Milbrandt & M-C 2010: tmp = 4. + dnu(lh) i = Int(dgami*(tmp)) del = tmp - dgam*i @@ -14712,7 +15243,7 @@ subroutine nssl_2mom_gs & ! check for artificial breakup (graupel/hail larger than allowed max size) - IF ( imaxdiaopt == 1 ) THEN + IF ( imaxdiaopt == 1 .or. il /= lr ) THEN xvbarmax = xvmx(il) ELSEIF ( imaxdiaopt == 2 ) THEN ! test against maximum mass diameter xvbarmax = xvmx(il) /((3. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) @@ -14739,12 +15270,21 @@ subroutine nssl_2mom_gs & IF ( tmp < cx(mgs,il) ) THEN ! artificial breakup has happened, so need to adjust reflectivity and find new shape parameter g1 = 36.*(6.0 + alpha(mgs,il))*(5.0 + alpha(mgs,il))*(4.0 + alpha(mgs,il))/ & & ((3.0 + alpha(mgs,il))*(2.0 + alpha(mgs,il))*(1.0 + alpha(mgs,il))*pi**2) - zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) +! zx(mgs,il) = zx(mgs,il) + g1*(rho0(mgs)/xdn(mgs,il))**2*( (qx(mgs,il)/tmp)**2 * (tmp-cx(mgs,il)) ) + ! check if incoming zx is consistent + ! Z from incoming cx, qx, and alpha + tmpz = g1/(pi/6.*xdn(mgs,il))**2 * ((rho0(mgs)*qx(mgs,il))**2)/tmp + IF ( tmpz > zx(mgs,il) ) THEN + tmpc = g1/(pi/6.*xdn(mgs,il))**2 * ((rho0(mgs)*qx(mgs,il))**2)/zx(mgs,il) + cx(mgs,il) = Max(cx(mgs,il), tmpc) + ! find cx that gives zx + ENDIF + zx(mgs,il) = g1/(pi/6.*xdn(mgs,il))**2 * ((rho0(mgs)*qx(mgs,il))**2)/cx(mgs,il) an(igs(mgs),jgs,kgs(mgs),lz(il)) = zx(mgs,il) - chw = cx(mgs,il) - qr = qx(mgs,il) - z = zx(mgs,il) + qr = qx(mgs,il) + chw = cx(mgs,il) + z = zx(mgs,il) rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) alp = (6.0+alpha(mgs,il))*(5.0+alpha(mgs,il))*(4.0+alpha(mgs,il))/ & @@ -14858,12 +15398,12 @@ subroutine nssl_2mom_gs & gf1palp(mgs) = y IF ( iferwisventr == 2 ) THEN +! ventrn = Gamma(alphar + 2.5 + br/2.)/Gamma(alphar + 1.) ! adapted from Wisner et al. 1972 tmp = alpha(mgs,lr) + 2.5 + br/2. i = Int(dgami*(tmp)) del = tmp - dgam*i x = gmoi(i) + (gmoi(i+1) - gmoi(i))*del*dgami -! ventrx(mgs) = Gamma_sp(alpha(mgs,lr) + 1.5 + br/6.)/Gamma_sp(alpha(mgs,lr) + 1.) ventrxn(mgs) = x/y @@ -15038,9 +15578,9 @@ subroutine nssl_2mom_gs & call setvtz(ngscnt,qx,qxmin,qxw,cx,rho0,rhovt,xdia,cno,cnostmp, & & xmas,vtxbar,xdn,xvmn,xvmx,xv,cdx,cdxgs, & - & ipconc,ndebug,ngs,nz,kgs,fadvisc, & + & ipconc,ndebug,ngs,nz,igs,kgs,fadvisc, & & cwmasn,cwmasx,cwradn,cnina,cimn,cimx, & - & itype1,itype2,temcg,infdo,alpha,0,axx,bxx) ! ,cdh,cdhl) + & itype1,itype2,temcg,infdo,alpha,axx,bxx,0) ! ,cdh,cdhl) ! & itype1,itype2,temcg,infdo,alpha,0,axh,bxh,axhl,bxhl) ! ,cdh,cdhl) @@ -15246,8 +15786,9 @@ subroutine nssl_2mom_gs & IF ( qx(mgs,il) > qxmin(il) .and. ivshdgs > 0 ) THEN ! tmpdiam is weighted diameter of d^(shedalp-1), so for shedalp=3, this is the area-weighted diameter or maximum mass diameter. - tmpdiam = (shedalp+alpha(mgs,il))*xdia(mgs,il,1) ! *( xdn(mgs,il)/917. )**(1./3.) ! erm added density factor for equiv. solid ice sphere 10.12.2015 - + ! tmpdiam = (shedalp+alpha(mgs,il))*xdia(mgs,il,1) ! *( xdn(mgs,il)/917. )**(1./3.) ! erm added density factor for equiv. solid ice sphere 10.12.2015 + tmpdiam = (shedalp+0.0)*xdia(mgs,il,1) ! *( xdn(mgs,il)/917. )**(1./3.) ! erm added density factor for equiv. solid ice sphere 10.12.2015 + ! imltshddmr IF ( tmpdiam > sheddiam0 ) THEN vshdgs(mgs,il) = 0.523599*(1.5e-3)**3/massfacshr ! 1.5mm drops from very large ice ELSEIF ( tmpdiam > sheddiam ) THEN ! intermediate size @@ -15407,7 +15948,7 @@ subroutine nssl_2mom_gs & if (xdia(mgs,lc,1).gt.ewi_dcmin .and. xdia(mgs,li,1).gt.ewi_dimin) then ! erm 5/10/2007 test following change: ! if (xdia(mgs,lc,1).gt.12.0e-06 .and. xdia(mgs,li,1).gt.50.0e-06) then - eiw(mgs) = 0.5 + eiw(mgs) = eiw0 end if if ( temg(mgs) .ge. 273.15 ) eiw(mgs) = 0.0 end if @@ -15582,6 +16123,7 @@ subroutine nssl_2mom_gs & ! ENDIF if ( temg(mgs) .gt. 273.15 ) esi(mgs) = 0.0 end if + ! ! ! @@ -16280,24 +16822,6 @@ subroutine nssl_2mom_gs & end do - IF ( lis > 1 .and. ipconc >= 5 ) THEN - do mgs = 1,ngscnt - qhacis(mgs) = 0.0 - qhacis0(mgs) = 0.0 - IF ( ehis(mgs) .gt. 0.0 ) THEN - - vt = Sqrt((vtxbar(mgs,lh,1)-vtxbar(mgs,lis,1))**2 + & - & 0.04*vtxbar(mgs,lh,1)*vtxbar(mgs,lis,1) ) - - qhacis0(mgs) = 0.25*pi*ehisclsn(mgs)*cx(mgs,lh)*qx(mgs,lis)*vt* & - & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + & - & dab1lh(mgs,lh,lis)*xdia(mgs,lh,3)*xdia(mgs,lis,3) + & - & da1(li)*xdia(mgs,lis,3)**2 ) - qhacis(mgs) = Min( ehis(mgs)*qhacis0(mgs), qxmxd(mgs,lis) ) - ENDIF - end do - ENDIF - ! ! do mgs = 1,ngscnt @@ -16548,6 +17072,9 @@ subroutine nssl_2mom_gs & end do ENDIF ! + qhlacis(:) = 0.0 + qhlacis0(:) = 0.0 + qhlacs(:) = 0.0 qhlacs0(:) = 0.0 IF ( lhl .gt. 1 ) THEN @@ -16669,7 +17196,7 @@ subroutine nssl_2mom_gs & ni = ni + cx(mgs,li)*Exp(- (40.e-6/xdia(mgs,li,1))**3 ) ENDIF IF ( imurain == 1 ) THEN ! gamma of diameter - IF ( iacrsize /= 4 ) THEN + IF ( iacrsize /= 4 ) THEN IF ( iacrsize .eq. 1 ) THEN ratio = 500.e-6/xdia(mgs,lr,1) ELSEIF ( iacrsize .eq. 2 ) THEN @@ -16703,10 +17230,10 @@ subroutine nssl_2mom_gs & qr = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*qx(mgs,lr) - ELSE ! iacrsize == 4 : use all - nr = cx(mgs,lr) - qr = qx(mgs,lr) - ENDIF + ELSE ! iacrsize == 4 : use all + nr = cx(mgs,lr) + qr = qx(mgs,lr) + ENDIF vt = Sqrt((vtxbar(mgs,lr,1)-vtxbar(mgs,li,1))**2 + & & 0.04*vtxbar(mgs,lr,1)*vtxbar(mgs,li,1) ) @@ -16715,9 +17242,9 @@ subroutine nssl_2mom_gs & & ( da0(li)*xdia(mgs,li,3)**2 + & & dab1lh(mgs,li,lr)*xdia(mgs,lh,3)*xdia(mgs,li,3) + & & da1(lr)*xdia(mgs,lr,3)**2 ) - + qiacr(mgs) = Min( qrmxd(mgs), qiacr(mgs) ) - + ciacr(mgs) = 0.25*pi*eri(mgs)*ni*nr*vt* & & ( da0(li)*xdia(mgs,li,3)**2 + & @@ -16805,7 +17332,13 @@ subroutine nssl_2mom_gs & ! ave. diam of freezing drops in microns IF ( qiacr(mgs)*dtp > qxmin(lh) .and. ciacr(mgs) > 1.e-3 ) THEN tmpdiam = 1.e6*( 6.*qiacr(mgs)/(1000.*pi*ciacr(mgs) ) )**(1./3.) ! avg. diameter of newly frozen drops in microns - csplinter(mgs) = lawson_splinter_fac*tmpdiam**4*ciacr(mgs) + fac = 1.0 + IF ( nsplinter .eq. 1001 ) THEN + ! fac = 0.2/sqrt(2.0*pi*10.**2)*Exp(-0.5*((258.-temg(mgs))/10.)**2 ) ! temperature dependence from Sullivan et al. 2018 ACP + ! ELSE + fac = 0.2*Exp(-0.5*((258.-temg(mgs))/10.)**2 ) ! temperature dependence from Sullivan et al. 2018 ACP + ENDIF + csplinter(mgs) = fac*lawson_splinter_fac*tmpdiam**4*ciacr(mgs) ENDIF ELSEIF ( nsplinter .ge. 0 ) THEN csplinter(mgs) = nsplinter*ciacr(mgs) @@ -16871,7 +17404,7 @@ subroutine nssl_2mom_gs & if ( ipconc .ge. 2 .or. ipelec .ge. 9 ) then do mgs = 1,ngscnt ciacw(mgs) = 0.0 - IF ( eiw(mgs) .gt. 0.0 ) THEN + IF ( eiw(mgs) .gt. 0.0 .and. xmas(mgs,lc) > 0.0 ) THEN ciacw(mgs) = qiacw(mgs)*rho0(mgs)/xmas(mgs,lc) ciacw(mgs) = min(ciacw(mgs),ccmxd(mgs)) ENDIF @@ -16882,6 +17415,7 @@ subroutine nssl_2mom_gs & if (ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: conc 18' if ( ipconc .ge. 2 .or. ipelec .ge. 1 ) then do mgs = 1,ngscnt + tmp1 = 0.0 cracw(mgs) = 0.0 cracr(mgs) = 0.0 ec0(mgs) = 1.e9 @@ -16897,7 +17431,7 @@ subroutine nssl_2mom_gs & & + 2.0*gf2*xdia(mgs,lc,1)*xdia(mgs,lr,1) & & + gf3*xdia(mgs,lr,2) ) ENDIF - ELSE ! IF ( ipconc .ge. 3 .and. + ELSE ! IF ( ipconc .ge. 3 .and. ) IF ( dmrauto <= 0 .or. rho0(mgs)*qx(mgs,lr) > 1.2*xl2p(mgs) ) THEN !{ IF ( 0.5*xdia(mgs,lr,3) .gt. rh(mgs) ) THEN ! { .or. cx(mgs,lr) .gt. nh(mgs) ! IF ( qx(mgs,lc) .gt. qxmin(lc) .and. qx(mgs,lr) .gt. qxmin(lr) ) THEN @@ -16926,7 +17460,7 @@ subroutine nssl_2mom_gs & ! Rain self collection (cracr) and break-up (factor of ec0) ! ! - ec0(mgs) = 2.e9 + ec0(mgs) = 1.0 ! 2.e9 IF ( qx(mgs,lr) .gt. qxmin(lr) ) THEN rwrad = 0.5*xdia(mgs,lr,3) @@ -16942,38 +17476,120 @@ subroutine nssl_2mom_gs & tmp = xdia(mgs,lr,3) - 0.1e-3 ENDIF -! IF ( xdia(mgs,lr,3) .gt. 2.0e-3 .or. icracr <= 0 ) THEN - IF ( tmp .gt. 1.9e-3 .or. icracr <= 0 ) THEN +! Using collection efficiency factor ec0 to simulate break-up that off-sets self-collection (Zieger 1985; Cohard & Pinty 2000) +! ec0 is 1 for rain diameter < 600 microns and then drop off toward zero until diameter of 2mm to represent passive breakup +! ec0 does not go negative here (i.e., does not follow other versions that create extra breakup at large rain diameter) + IF ( ( tmp .gt. 1.9e-3 .and. irainbreak /= 10 .and. irainbreak /= 20 ) .or. icracr <= 0 ) THEN ec0(mgs) = 0.0 cracr(mgs) = 0.0 + IF ( ibincracr == 3 ) THEN + tmp1 = aa1*(cx(mgs,lr)*xv(mgs,lr))**2* & + & (alpha(mgs,lr) + 6.)*(alpha(mgs,lr) + 5.)*(alpha(mgs,lr) + 4.)/ & + & ((alpha(mgs,lr) + 3.)*(alpha(mgs,lr) + 2.)*(alpha(mgs,lr) + 1.)) + ENDIF ELSE IF ( dmrauto <= 0 .or. rho0(mgs)*qx(mgs,lr) > 1.2*xl2p(mgs) ) THEN - IF ( xdia(mgs,lr,3) .lt. 6.1e-4 ) THEN + + IF ( xdia(mgs,lr,3) .lt. 6.1e-4 .or. irainbreak == 10 ) THEN ec0(mgs) = 1.0 ELSE - ec0(mgs) = Exp(-50.0*(50.0*(xdia(mgs,lr,3) - 6.0e-4))) + ec0(mgs) = Exp( -2500.0*(xdia(mgs,lr,3) - 6.0e-4) ) ENDIF + IF ( rwrad .ge. 50.e-6 ) THEN - cracr(mgs) = ec0(mgs)*aa2*cx(mgs,lr)**2*xv(mgs,lr) + tmp1 = aa2*cx(mgs,lr)**2*xv(mgs,lr) + cracr(mgs) = ec0(mgs)*tmp1 + IF ( irainbreak == 20 ) THEN + cracr(mgs) = tmp1 + ENDIF ELSE IF ( imurain == 3 ) THEN cracr(mgs) = ec0(mgs)*aa1*(cx(mgs,lr)*xv(mgs,lr))**2* & & (alpha(mgs,lr) + 2.)/(alpha(mgs,lr) + 1.) ELSE ! imurain == 1 - cracr(mgs) = ec0(mgs)*aa1*(cx(mgs,lr)*xv(mgs,lr))**2* & + tmp1 = aa1*(cx(mgs,lr)*xv(mgs,lr))**2* & & (alpha(mgs,lr) + 6.)*(alpha(mgs,lr) + 5.)*(alpha(mgs,lr) + 4.)/ & & ((alpha(mgs,lr) + 3.)*(alpha(mgs,lr) + 2.)*(alpha(mgs,lr) + 1.)) - + cracr(mgs) = ec0(mgs)*tmp1 + IF ( irainbreak == 20 ) THEN + cracr(mgs) = tmp1 + ENDIF ENDIF - ENDIF + ENDIF ! rwrad > 50 ! cracr(mgs) = Min(cracr(mgs),crmxd(mgs)) - ENDIF - ENDIF - ENDIF + ENDIF ! dmrauto <= 0 + ENDIF ! tmp > 1.9e-3 + + IF ( irainbreak == 100 ) THEN ! Morrison breakup + ec0(mgs) = 1.0 + IF ( xdia(mgs,lr,1) > 300.e-6 ) THEN + ec0(mgs) = 2. - Exp(2300.*(xdia(mgs,lr,1)-300.e-6)) + ENDIF + cracr(mgs) = 5.78*ec0(mgs)*cx(mgs,lr)*qx(mgs,lr) + ENDIF + + ENDIF ! ( qx(mgs,lr) .gt. qxmin(lr) ) + + ! active breakup option + crbreak = 0.0 + IF ( irainbreak == 1 .or. irainbreak == 10 ) THEN + crbreak = Max( 0.0, rainbreakfac* (rho0(mgs)*qx(mgs,lr))**2 ) ! hand fit to lower range of wkqss output + cracr(mgs) = cracr(mgs) - crbreak ! cracr is subtracted, so negative value for breakup + ELSEIF ( irainbreak == 2 .or. irainbreak == 20 ) THEN + ! irainbreak == 20 does not work as intended + crbreak = Max( 0.0, rainbreakfac*(1. - ec0(mgs))*(rho0(mgs)*qx(mgs,lr))**2 ) ! hand fit to lower range of wkqss output +! crbreak = Max(0.0, -0.18 + 1.139e6 * (rho0(mgs)*qx(mgs,lr) + 0.00038106)**2) + cracr(mgs) = cracr(mgs) - crbreak ! cracr is subtracted, so negative value for breakup + ELSEIF ( irainbreak == 11 .and. rho0(mgs)*qx(mgs,lr) > qrbrthresh1 .and. ipconc >= 5 ) THEN + + ! Ad hoc method to break up drops in the DSD tail (D > draintail) + + ratio = Min( maxratiolu, draintail/xdia(mgs,lr,1) ) + ! mass + tmp2 = gaminterp(ratio,alpha(mgs,lr),4,1) + qxd1 = qx(mgs,lr)*(tmp2) + qrbreak = dtpinv*qxd1 + + crbreaksmall = rho0(mgs)*qrbreak/(xdn(mgs,lr)*pi/6.*drsmall**3) + IF ( ( qxd1 > qxmin(lr)) ) THEN + + ! number + tmp = gaminterp(ratio,alpha(mgs,lr),1,1) + IF ( ipconc == 5 ) THEN + ! tmp = Min( 0.2, tmp ) + ENDIF + cxd1 = cx(mgs,lr)*( tmp) + IF ( rho0(mgs)*qx(mgs,lr) > qrbrthresh2 ) THEN + flim = 1.0 + ELSE + flim = (rho0(mgs)*qx(mgs,lr) - qrbrthresh1)/(qrbrthresh2 - qrbrthresh1) + ENDIF + crbreak = flim*(crbreaksmall - dtpinv*cxd1) + +! IF ( kgs(mgs) == 1 .and. qx(mgs,lr) > 0.1e-3 ) THEN +! write(0,*) 'crbreak: ',crbreak,crbreaksmall,dtpinv*cxd1,cx(mgs,lr),cracr(mgs) - crbreak +! ENDIF + cracr(mgs) = cracr(mgs) - crbreak ! cracr is subtracted, so negative value for breakup + + ! reflectivity -- not used yet: goes into zracr +! IF ( ipconc >= 6 .and. lzr > 1 ) THEN +! tmp3 = gaminterp(ratio,alpha(mgs,lr),11,1) +! zxd1 = zx(mgs,lr)*(tmp3) +! zrbreak = dtpinv*zxd1 +! ELSE +! zxd1 = 0 +! ENDIF +! zrbreak = Max(0.0, zrbreak - crbreaksmall*drsmall**6) + ELSEIF ( irainbreak == 12 ) THEN + crbreak = Max( 0.0, 3.8098 * (rho0(mgs)*qx(mgs,lr))**1.9416 ) ! best fit to lower range of wkqss (collision only) output + cracr(mgs) = cracr(mgs) - crbreak ! cracr is subtracted, so negative value for breakup + ENDIF + ENDIF ! cracw(mgs) = min(cracw(mgs),cxmxd(mgs,lc)) + end do end if @@ -17054,24 +17670,6 @@ subroutine nssl_2mom_gs & end if - chacis(:) = 0.0 - if ( lis > 1 .and. ipconc .ge. 5 .or. ipelec .ge. 1 ) then - do mgs = 1,ngscnt - IF ( ehis(mgs) .gt. 0.0 .or. ( ehisclsn(mgs) > 0.0 .and. ipelec > 0 )) THEN - - vt = Sqrt((vtxbar(mgs,lh,1)-vtxbar(mgs,lis,1))**2 + & - & 0.04*vtxbar(mgs,lh,1)*vtxbar(mgs,lis,1) ) - - chacis0(mgs) = 0.25*pi*ehisclsn(mgs)*cx(mgs,lh)*cx(mgs,lis)*vt* & - & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + & - & dab0lh(mgs,lh,lis)*xdia(mgs,lh,3)*xdia(mgs,lis,3) + & - & da0(lis)*xdia(mgs,lis,3)**2 ) - - - chacis(mgs) = min(ehis(mgs)*chacis0(mgs),cxmxd(mgs,lis)) - ENDIF - end do - end if ! ! if (ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: conc 22nn' @@ -17179,28 +17777,6 @@ subroutine nssl_2mom_gs & end if - IF ( lis > 1 .and. ipconc .ge. 5) THEN - - if (ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: conc 22kk' - chlacis(:) = 0.0 - chlacis0(:) = 0.0 - do mgs = 1,ngscnt - IF ( lhl .gt. 1 .and. ( ehlis(mgs) .gt. 0.0 .or. (ipelec > 0 .and. ehlisclsn(mgs) > 0.0) ) ) THEN - - vt = Sqrt((vtxbar(mgs,lhl,1)-vtxbar(mgs,lis,1))**2 + & - & 0.04*vtxbar(mgs,lhl,1)*vtxbar(mgs,lis,1) ) - - chlacis0(mgs) = 0.25*pi*ehlisclsn(mgs)*cx(mgs,lhl)*cx(mgs,lis)*vt* & - & ( da0lhl(mgs)*xdia(mgs,lhl,3)**2 + & - & dab0(lhl,lis)*xdia(mgs,lhl,3)*xdia(mgs,lis,3) + & - & da0(lis)*xdia(mgs,lis,3)**2 ) - - - chlacis(mgs) = min(ehlis(mgs)*chlacis0(mgs),cxmxd(mgs,lis)) - ENDIF - end do - ENDIF - ! ! if (ndebug .gt. 0 ) write(0,*) 'ICEZVD_GS: conc 22jj' @@ -17290,7 +17866,8 @@ subroutine nssl_2mom_gs & tmp = crcnw(mgs) tmp2 = qrcnw(mgs)*cx(mgs,lr)/qx(mgs,lr) ! try mass*diameter-weighted average of old and new Dmr (using full qc mass) - crcnw(mgs) = (tmp*xdia(mgs,lc,3)*qx(mgs,lc)+tmp2*xdia(mgs,lr,3)*qx(mgs,lr))/(xdia(mgs,lc,3)*qx(mgs,lc)+xdia(mgs,lr,3)*qx(mgs,lr)) + crcnw(mgs) = (tmp*xdia(mgs,lc,3)*qx(mgs,lc)+tmp2*xdia(mgs,lr,3)*qx(mgs,lr))/ & + (xdia(mgs,lc,3)*qx(mgs,lc)+xdia(mgs,lr,3)*qx(mgs,lr)) ELSEIF ( ( dmropt == 7 ) .and. qx(mgs,lr) > qxmin(lr) ) THEN tmp = crcnw(mgs) tmp2 = qrcnw(mgs)*cx(mgs,lr)/qx(mgs,lr) @@ -17300,7 +17877,8 @@ subroutine nssl_2mom_gs & tmp = crcnw(mgs) tmp2 = qrcnw(mgs)*cx(mgs,lr)/qx(mgs,lr) ! try sqrt(diameter)-weighted average of old and new Dmr - crcnw(mgs) = (tmp*sqrt(xdia(mgs,lc,3))+tmp2*sqrt(xdia(mgs,lr,3)))/(sqrt(xdia(mgs,lc,3))+sqrt(xdia(mgs,lr,3))) + crcnw(mgs) = (tmp*sqrt(xdia(mgs,lc,3))+tmp2*sqrt(xdia(mgs,lr,3)))/ & + (sqrt(xdia(mgs,lc,3))+sqrt(xdia(mgs,lr,3))) ENDIF ELSEIF ( dmrauto == 1 .and. cx(mgs,lr) > cxmin) THEN IF ( qx(mgs,lr) > qxmin(lr) ) THEN @@ -17569,16 +18147,45 @@ subroutine nssl_2mom_gs & ELSE !{ - - IF ( ipconc >= 6 .and. lzr > 1 ) THEN + + IF ( ipconc >= 5 .or. lzr > 1 ) THEN + + cxd1 = crfrz(mgs)*dtp + qxd1 = qrfrz(mgs)*dtp + ! interpolate along x, i.e., ratio; tmp1 = ziacrratio(i,j) + delx*dqiacrratioinv*(ziacrratio(ip1,j) - ziacrratio(i,j)) tmp2 = ziacrratio(i,jp1) + delx*dqiacrratioinv*(ziacrratio(ip1,jp1) - ziacrratio(i,jp1)) ! interpolate along alpha; - zrfrz(mgs) = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*zx(mgs,lr)*dtpinv + IF ( ipconc >= 6 .and. lzr > 1 ) THEN + zxd1 = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*zx(mgs,lr) + ! Do the correction for alphamax + zrfrz(mgs) = zxd1*dtpinv + ! tmp4 is the Z from the converted particles assuming shape of alphamax + tmp3 = g1xmax*(rho0(mgs)*qxd1)**2/((pi*xdn(mgs,lh)/6.0)**2) + tmp4 = tmp3/cxd1 + IF ( tmp4 > zxd1 ) THEN ! calculate new graupel/fd number to match zxd1 + ! increase cxd1 to make z,q,c rates consistent + ! cxd1 = g1xmax*(rho0(mgs)*qxd1)**2/(zxd1*(pi*xdn(mgs,lh)/6.0)**2) + cxd1 = tmp3/zxd1 + crfrzf(mgs) = dtpinv*cxd1 + ENDIF + ELSE + ! tmp5 is rain reflectivity moment + tmp5 = g1x(mgs,lr)*(rho0(mgs)*qx(mgs,lr))**2/((pi*xdn(mgs,lr)/6.)**2*cx(mgs,lr)) + zxd1 = (tmp1 + dely*dqiacralphainv*(tmp2 - tmp1))*tmp5 + ! tmp4 is the reflectivity of the newly-converted graupel particles (use g1x(lh) for loss term) + ! which we want to match zxd1 to prevent spurious increase in total reflectivity + tmp3 = g1x(mgs,lr)*(rho0(mgs)*qxd1)**2/((pi*xdn(mgs,lr)/6.0)**2) + tmp4 = tmp3/cxd1 + IF ( tmp4 > zxd1 ) THEN ! calculate new FD number to match zxd1 + crfrzf(mgs) = tmp3/zxd1*dtpinv + ENDIF + ENDIF ENDIF + IF ( ibiggsmallrain > 0 .and. xv(mgs,lr) < 2.*xvmn(lr) .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) ) THEN ! IF ( ibiggsmallrain > 0 .and. xv(mgs,lr) < xvbiggsnow .and. ( ibiggsnow == 1 .or. ibiggsnow == 3 ) ) THEN @@ -17616,7 +18223,7 @@ subroutine nssl_2mom_gs & ! j = Int(Max(0.0,Min(15.,alpha(mgs,lr)))*dqiacralphainv) ! j = Int(Max(alphamin,Min(alphamax,alpha(mgs,lr)))*dqiacralphainv) IF ( alp0flag ) THEN - j = Int(Max(0.0,Min(15.,alpha(mgs,lr)))*dqiacralphainv) + j = Int(Max(0.0,Min(alphamax,alpha(mgs,lr)))*dqiacralphainv) ELSE j = Int(Max(minalphalu,Min(maxalphalu,alpha(mgs,lr)))*dqiacralphainv) ENDIF @@ -17802,7 +18409,13 @@ subroutine nssl_2mom_gs & tmp = 0 IF ( qrfrz(mgs)*dtp > qxmin(lh) .and. crfrz(mgs) > 1.e-3 ) THEN tmpdiam = 1.e6*( 6.*qrfrz(mgs)/(1000.*pi*crfrz(mgs) ))**(1./3.) ! avg. diameter of newly frozen drops in microns - tmp = lawson_splinter_fac*tmpdiam**4*crfrz(mgs) + fac = 1.0 + IF ( nsplinter .eq. 1001 ) THEN + ! fac = 0.2/sqrt(2.0*pi*10.**2)*Exp(-0.5*((258.-temg(mgs))/10.)**2 ) ! temperature dependence from Sullivan et al. 2018 ACP + ! ELSE + fac = 0.2*Exp(-0.5*((258.-temg(mgs))/10.)**2 ) ! temperature dependence from Sullivan et al. 2018 ACP + ENDIF + tmp = fac*lawson_splinter_fac*tmpdiam**4*crfrz(mgs) ENDIF ELSEIF ( nsplinter .gt. 0 ) THEN tmp = nsplinter*crfrz(mgs) @@ -18268,6 +18881,7 @@ subroutine nssl_2mom_gs & IF ( ipconc >= 7 ) THEN + ! vent coeff. for reflectivity rate from evaporation alpr = Min(alpharmax,alpha(mgs,lr) ) tmp = alpr + 5.5 + br/2. @@ -18578,8 +19192,6 @@ subroutine nssl_2mom_gs & ELSEIF ( ibinhlmlr == 1 ) THEN ! use incomplete gamma functions to approximate the bin results -! #ifdef 1 -! #if (defined 1) && defined( COMMAS ) || defined( COMMASTMP ) ELSEIF ( ibinhlmlr == -1 ) THEN ! OLD VERSION use incomplete gamma functions to approximate the bin results @@ -19030,11 +19642,11 @@ subroutine nssl_2mom_gs & felscptmp = (fels(mgs)-rw*temg(mgs))/cvm ENDIF - IF ( eqtset > 2 ) THEN - pipert(mgs) = pipert(mgs) + (0 & - & +felspi(mgs)*dqci(mgs) & - & +felvpi(mgs)*dqcw(mgs))*dtp - ENDIF +! IF ( eqtset > 2 ) THEN +! pipert(mgs) = pipert(mgs) + (0 & +! & +felspi(mgs)*dqci(mgs) & +! & +felvpi(mgs)*dqcw(mgs)) ! *dtp +! ENDIF ! ! @@ -19052,7 +19664,13 @@ subroutine nssl_2mom_gs & tqvcon = temgtmp-cbw ltemq = (temgtmp-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvstmp = pqs(mgs)*tabqvs(ltemq) + + IF ( iqvsopt == 0 ) THEN + qvstmp = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvstmp = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF + qisstmp = pqs(mgs)*tabqis(ltemq) qctmp(mgs) = max( 0.0, qctmp(mgs) ) qitmp(mgs) = max( 0.0, qitmp(mgs) ) @@ -19276,8 +19894,8 @@ subroutine nssl_2mom_gs & ! ELSE ! cscnis(mgs) = 0.0 ! ENDIF + ! write(91,*) 'qi,qscni = ',igs(mgs),kgs(mgs),qx(mgs,li),qscni(mgs),cscnis(mgs),qidpv(mgs) ENDIF - IF ( iscni .ne. 4 ) THEN ! crystal aggregation to become snow ! erm 9/5/08 commented second line and added xv to 1st line (zrnic et al 1993) @@ -19318,7 +19936,133 @@ subroutine nssl_2mom_gs & end if end do + IF ( incwet < 1 ) THEN + dhwet(:) = d1t + dhlwet(:) = d1t + dfwet(:) = d1t + ENDIF + IF ( incwet >= 1 ) THEN + ! 'incwet' = incomplete gamma for wet growth + ! Find diameter where wet growth starts, then compute dry and wet growth + ! over [dwet,infinity]. Subtract dry growth from qxacw etc. to get total + ! dry growth part + dhwet(:) = dg0thresh + 0.0001 + dhlwet(:) = dg0thresh + 0.0001 + dfwet(:) = dg0thresh + 0.0001 + + DO mgs = 1,ngscnt + + sqrtrhovt = Sqrt( rhovt(mgs) ) + fventh = sqrtrhovt*(fpndl(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5) + fventm = sqrtrhovt*(fschm(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5) + ltemq = (tfr-163.15)/fqsat+1.5 + qvs0 = pqs(mgs)*tabqvs(ltemq) + denomdp = felf(mgs) + fcw(mgs)*temcg(mgs) + denominvdp = 1.d0/(felf(mgs) + fcw(mgs)*temcg(mgs)) + + IF (((qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. & + temg(mgs) .le. tfr + wetgrthtoffset .and. temg(mgs) .ge. 243.15 ) ) THEN +! dw = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*ehw(mgs)*qx(mgs,lc) - 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) +! dwr = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & +! 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) + x = 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & + 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 + IF ( x > 1.e-20 ) THEN + arg = Min(70.0, (-temcg(mgs)/x )) ! prevent overflow of the exp function in 32 bit + dwr = 0.01*(exp(arg) - 1.0) + ELSE + dwr = 1.e30 + ENDIF + d = dwr + + IF ( dwr < 0.2 .and. dwr > 0.0 .and. rho0(mgs)*(qx(mgs,lc)+qx(mgs,lr)) > 1.e-4 ) THEN + + h1 = ( -ftka(mgs)*temcg(mgs) - felv(mgs)*fwvdf(mgs)*rho0(mgs)*(qx(mgs,lv) - qvs0) ) + h2 = ehi(mgs)*qx(mgs,li)*rho0(mgs)*fci(mgs)*temcg(mgs) + h3 = Max(dwehwmin, ehw(mgs))*qx(mgs,lc) + h4 = ehr(mgs)* qx(mgs,lr) + ! iterate to find minimum diameter for wet growth. Start with value of dwr + DO n = 1,10 + d = Max(d, 1.e-4) + dold = d + vth = axx(mgs,lh)*d**bxx(mgs,lh) + x2 = fventh*sqrtrhovt*Sqrt(d*vth) + IF ( x2 > 1.4 ) THEN + ah = 0.78 + 0.308*x2 ! heat ventillation + ELSE + ah = 1.0 + 0.108*x2**2 ! mass ventillation (Beard and Pruppacher 1971, eq. 9) + ENDIF + + + d = 8.*ah*h1/ & + ( ( Max(0.001,vth - vtxbar(mgs,lc,1))*h3 + & + Max(0.001,vth - vtxbar(mgs,lr,1))*h4) *rho0(mgs)*denomdp + & + Max(0.001,vth - vtxbar(mgs,li,1))*h2) + + IF ( Abs(dold - d)/dold < 0.05 .or. ( n > 3 .and. d > dg0thresh ) ) EXIT + + ENDDO + ENDIF + + dhwet(mgs) = Min(dg0thresh + 0.0001, Max( d, dwetmin )) + ELSE + dhwet(mgs) = dg0thresh + 0.0001 + ENDIF + + IF (((qhlacw(mgs) + qhlacr(mgs))*dtp > qxmin(lhl) .and. qx(mgs,lhl) > 0.01e-3 & + .and. temg(mgs) .le. tfr + wetgrthtoffset .and. temg(mgs) .ge. 243.15 ) ) THEN +! dw = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*ehlw(mgs)*qx(mgs,lc) - 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) +! dwr = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*(ehlw(mgs)*qx(mgs,lc)+ehlr(mgs)*qx(mgs,lr)) - & +! 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) + x = 1.1e4 * rho0(mgs)*(ehlw(mgs)*qx(mgs,lc)+ehlr(mgs)*qx(mgs,lr)) - & + 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 + IF ( x > 1.e-20 ) THEN + arg = Min(70.0, (-temcg(mgs)/x )) ! prevent overflow of the exp function in 32 bit + dwr = 0.01*(exp(arg) - 1.0) + ELSE + dwr = 1.e30 + ENDIF + d = dwr + IF ( dwr < 0.2 .and. dwr > 0.0 .and. rho0(mgs)*(qx(mgs,lc)+qx(mgs,lr)) > 1.e-4 ) THEN + +! write(91,*) 'dw,dwr,temcg = ',100.*dw,100.*dwr,temcg(mgs) + h1 = ( -ftka(mgs)*temcg(mgs) - felv(mgs)*fwvdf(mgs)*rho0(mgs)*(qx(mgs,lv) - qvs0) ) + h2 = ehi(mgs)*qx(mgs,li)*rho0(mgs)*fci(mgs)*temcg(mgs) + h3 = Max(dwehwmin, ehlw(mgs))*qx(mgs,lc) + h4 = ehlr(mgs)* qx(mgs,lr) + ! iterate to find minimum diameter for wet growth. Start with value of dwr + DO n = 1,10 + d = Max(d, 1.e-4) + dold = d + vth = axx(mgs,lhl)*d**bxx(mgs,lhl) + x2 = fventh*sqrtrhovt*Sqrt(d*vth) + IF ( x2 > 1.4 ) THEN + ah = 0.78 + 0.308*x2 ! heat ventillation + ELSE + ah = 1.0 + 0.108*x2**2 ! mass ventillation (Beard and Pruppacher 1971, eq. 9) + ENDIF + + + d = 8.*ah*h1/ & + ( ( Max(0.001,vth - vtxbar(mgs,lc,1))*h3 + & + Max(0.001,vth - vtxbar(mgs,lr,1))*h4) *rho0(mgs)*denomdp + & + Max(0.001,vth - vtxbar(mgs,li,1))*h2) + + IF ( Abs(dold - d)/dold < 0.05 .or. ( n > 3 .and. d > dg0thresh ) ) EXIT + + ENDDO + ENDIF + + dhlwet(mgs) = Min(dg0thresh + 0.0001, Max( d, dwetmin ) ) + ELSE + dhlwet(mgs) = dg0thresh + 0.0001 + ENDIF + + + ENDDO + + ENDIF ! incwet @@ -19359,12 +20103,88 @@ subroutine nssl_2mom_gs & ! IF ( dnu(lh) .ne. 0. ) THEN ! qhwet(mgs) = qhdry(mgs) ! ELSE - IF ( incwet == 0 ) THEN + ! IF ( incwet == 0 ) THEN qhwet(mgs) = & & ( xdia(mgs,lh,1)*hwvent(mgs)*cx(mgs,lh)*fwet1(mgs) & & + fwet2(mgs)*(qhaci(mgs) + qhacs(mgs)) ) - qhwet(mgs) = max( 0.0, qhwet(mgs)) - ELSE + qhwet(mgs) = max( 0.0, qhwet(mgs)) + + IF ( incwet == 1 .and. qhwet(mgs) < qhdry(mgs) .and. dhwet(mgs) < dg0thresh ) THEN + ! ELSE + ! IF ( dhwet(mgs) < dg0thresh ) THEN + ! find portion of qc and qr collection that are dry/wet growth for d > dwet + + ratio = Min( maxratiolu, dhwet(mgs)/xdia(mgs,lh,1) ) + + tmp1 = gaminterp(ratio,alpha(mgs,lh),13,1) ! alpha + 3 + tmp2 = gaminterp(ratio,alpha(mgs,lh),12,1) ! alpha + 2 + tmp3 = gaminterp(ratio,alpha(mgs,lh), 9,1) ! alpha + 1 + + IF ( qhacw(mgs)*dtp > qxmin(lh) ) THEN + vt = abs(vtxbar(mgs,lh,1)-vtxbar(mgs,lc,1)) + + qxacwtmp = 0.25*pi*ehw(mgs)*cx(mgs,lh)*(qx(mgs,lc)-qcwresv(mgs))*vt* & + & ( tmp1*da0lh(mgs)*xdia(mgs,lh,3)**2 + & + & tmp2*dab1lh(mgs,lh,lc)*xdia(mgs,lh,3)*xdia(mgs,lc,3) + & + & tmp3*da1lc(mgs)*xdia(mgs,lc,3)**2 ) + ELSE + qxacwtmp = 0.0 + ENDIF + + IF ( qhacr(mgs)*dtp > qxmin(lh) ) THEN + + vt = Sqrt((vtxbar(mgs,lh,1)-vtxbar(mgs,lr,1))**2 + & + & 0.04*vtxbar(mgs,lh,1)*vtxbar(mgs,lr,1) ) + + qxacrtmp = 0.25*pi*ehr(mgs)*cx(mgs,lh)*qx(mgs,lr)*vt* & + & ( tmp1*da0lh(mgs)*xdia(mgs,lh,3)**2 + & + & tmp2*dab1lh(mgs,lh,lr)*xdia(mgs,lh,3)*xdia(mgs,lr,3) + & + & tmp3*da1lr(mgs)*xdia(mgs,lr,3)**2 ) + ELSE + qxacrtmp = 0.0 + ENDIF + + ! hwvent is where the size dependency is, so hxventtmp gives the portion for d > dwet + x = gaminterp(ratio,alpha(mgs,lh),9,1) ! alpha + 1 + y = gaminterp(ratio,alpha(mgs,lh),3,1) ! alpha + b/2 + 5/2 + + hxventtmp = 0.78*x + y*hwventy(mgs) ! & + + ! find the ice and snow collection for d > dwet + qxacitmp = 0.0 + IF ( qhaci(mgs)*dtp > qxmin(lh) ) THEN + vt = abs(vtxbar(mgs,lh,1)-vtxbar(mgs,li,1)) + + qxacitmp = 0.25*pi*ehiclsn(mgs)*cx(mgs,lh)*qx(mgs,li)*vt* & + & ( tmp1*da0lh(mgs)*xdia(mgs,lh,3)**2 + & + & tmp2*dab1lh(mgs,lh,li)*xdia(mgs,lh,3)*xdia(mgs,li,3) + & + & tmp3*da1(li)*xdia(mgs,li,3)**2 ) + ENDIF + + qxacstmp = 0.0 + IF ( qhacs(mgs)*dtp > qxmin(lh) ) THEN + vt = abs(vtxbar(mgs,lh,1)-vtxbar(mgs,ls,1)) + + qxacstmp = 0.25*pi*ehsclsn(mgs)*cx(mgs,lh)*qx(mgs,ls)*vt* & + & ( da0lh(mgs)*xdia(mgs,lh,3)**2 + & + & dab1lh(mgs,lh,ls)*xdia(mgs,lh,3)*xdia(mgs,ls,3) + & + & da1(ls)*xdia(mgs,ls,3)**2 ) + ENDIF + + qxwettmp = & + & xdia(mgs,lh,1)*hxventtmp*cx(mgs,lh)*fwet1(mgs) & + & + fwet2(mgs)*(qxacitmp + qxacstmp) + + ! as dry growth but subtract part for D > Dw and add wet growth for D > Dw + qhwet(mgs) = qhacw(mgs) + qhacr(mgs) + qhaci(mgs) + qhacs(mgs) & + - ehi(mgs)*qxacitmp - ehs(mgs)*qxacstmp & + - qxacwtmp - qxacrtmp + qxwettmp + + ! qhacw(mgs) = Min( qhacw(mgs), 0.5*qx(mgs,lc)*dtpinv ) + + ! ELSE ! for dwet > 15cm, just assume dry growth + ! qhwet(mgs) = qhdry(mgs) + ! ENDIF ENDIF ! ENDIF @@ -19372,13 +20192,88 @@ subroutine nssl_2mom_gs & qhlwet(mgs) = 0.0 IF ( lhl .gt. 1 ) THEN - IF ( incwet == 0 ) THEN + !IF ( incwet == 0 ) THEN qhlwet(mgs) = & & ( xdia(mgs,lhl,1)*hlvent(mgs)*cx(mgs,lhl)*fwet1(mgs) & & + fwet2(mgs)*(qhlaci(mgs) + qhlacs(mgs)) ) qhlwet(mgs) = max( 0.0, qhlwet(mgs)) - ELSE + IF ( incwet == 1 .and. qhlwet(mgs) < qhldry(mgs) .and. dhlwet(mgs) < dg0thresh ) THEN + !ELSE +!! || defined (WRFEXTRAS) + ! IF ( dhlwet(mgs) < dg0thresh ) THEN + ! find portion of qc and qr collection that are dry/wet growth for d > dwet + + ratio = Min( maxratiolu, dhlwet(mgs)/xdia(mgs,lhl,1) ) + + tmp1 = gaminterp(ratio,alpha(mgs,lhl),13,2) ! alpha + 3 + tmp2 = gaminterp(ratio,alpha(mgs,lhl),12,2) ! alpha + 2 + tmp3 = gaminterp(ratio,alpha(mgs,lhl), 9,2) ! alpha + 1 + + IF ( qhlacw(mgs)*dtp > qxmin(lhl) ) THEN + vt = abs(vtxbar(mgs,lhl,1)-vtxbar(mgs,lc,1)) + + qxacwtmp = 0.25*pi*ehlw(mgs)*cx(mgs,lhl)*(qx(mgs,lc)-qcwresv(mgs))*vt* & + & ( tmp1*da0lhl(mgs)*xdia(mgs,lhl,3)**2 + & + & tmp2*dab1lh(mgs,lhl,lc)*xdia(mgs,lhl,3)*xdia(mgs,lc,3) + & + & tmp3*da1lc(mgs)*xdia(mgs,lc,3)**2 ) + ELSE + qxacwtmp = 0.0 + ENDIF + + IF ( qhlacr(mgs)*dtp > qxmin(lhl) ) THEN + + vt = Sqrt((vtxbar(mgs,lhl,1)-vtxbar(mgs,lr,1))**2 + & + & 0.04*vtxbar(mgs,lhl,1)*vtxbar(mgs,lr,1) ) + + qxacrtmp = 0.25*pi*ehlr(mgs)*cx(mgs,lhl)*qx(mgs,lr)*vt* & + & ( tmp1*da0lhl(mgs)*xdia(mgs,lhl,3)**2 + & + & tmp2*dab1lh(mgs,lhl,lr)*xdia(mgs,lhl,3)*xdia(mgs,lr,3) + & + & tmp3*da1lr(mgs)*xdia(mgs,lr,3)**2 ) + ELSE + qxacrtmp = 0.0 + ENDIF + + x = gaminterp(ratio,alpha(mgs,lhl),9,2) ! alpha + 1 + y = gaminterp(ratio,alpha(mgs,lhl),3,2) ! alpha + b/2 + 5/2 + + hxventtmp = 0.78*x + y*hlventy(mgs) ! & + + qxacitmp = 0.0 + IF ( qhlaci(mgs)*dtp > qxmin(lhl) ) THEN + vt = abs(vtxbar(mgs,lhl,1)-vtxbar(mgs,li,1)) + + qxacitmp = 0.25*pi*ehliclsn(mgs)*cx(mgs,lhl)*qx(mgs,li)*vt* & + & ( tmp1*da0lhl(mgs)*xdia(mgs,lhl,3)**2 + & + & tmp2*dab1lh(mgs,lhl,li)*xdia(mgs,lhl,3)*xdia(mgs,li,3) + & + & tmp3*da1(li)*xdia(mgs,li,3)**2 ) + ENDIF + + qxacstmp = 0.0 + IF ( qhlacs(mgs)*dtp > qxmin(lhl) ) THEN + vt = abs(vtxbar(mgs,lhl,1)-vtxbar(mgs,ls,1)) + + qxacstmp = 0.25*pi*ehlsclsn(mgs)*cx(mgs,lhl)*qx(mgs,ls)*vt* & + & ( da0lhl(mgs)*xdia(mgs,lhl,3)**2 + & + & dab1lh(mgs,lhl,ls)*xdia(mgs,lhl,3)*xdia(mgs,ls,3) + & + & da1(ls)*xdia(mgs,ls,3)**2 ) + ENDIF + + qxwettmp = & + & xdia(mgs,lhl,1)*hxventtmp*cx(mgs,lhl)*fwet1(mgs) & + & + fwet2(mgs)*(qxacitmp + qxacstmp) + + ! qhlacw(mgs) + qhlacr(mgs) - qxacwtmp - qxacrtmp is the 'dry' growth + ! at smaller diameters +! qhlwet(mgs) = qhlacw(mgs) + qhlacr(mgs) - qxacwtmp - qxacrtmp + qxwettmp + ! as dry growth but subtract part for D > Dw and add wet growth for D > Dw + qhlwet(mgs) = qhlacw(mgs) + qhlacr(mgs) + qhlaci(mgs) + qhlacs(mgs) & + - ehli(mgs)*qxacitmp - ehls(mgs)*qxacstmp & + - qxacwtmp - qxacrtmp + qxwettmp + + ! ELSE + ! qhlwet(mgs) = qhldry(mgs) + ! ENDIF ENDIF ! incwet ENDIF @@ -19787,14 +20682,20 @@ subroutine nssl_2mom_gs & ltest = xdia(mgs,lh,1)*(4. + alpha(mgs,lh)) > Abs( hlcnhdia ) ! test on mass-weighted diameter ENDIF + ! if incwet > 0, then should use dhwet here to avoid calculating again IF ( iusedw == 0 .and. ihlcnh == 1 ) THEN dg0(mgs) = -1. ELSE - IF (((qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr-2.0 & - .and. temg(mgs) .gt. dwtempmin ) .or. ( wetgrowth(mgs) .and. qx(mgs,lh) > hlcnhqmin ) ) THEN + IF ( temg(mgs) .le. tfr+hailcnvtoffset .and. & + (( (qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin & + .and. temg(mgs) .gt. dwtempmin ) .or. ( wetgrowth(mgs) .and. qx(mgs,lh) > hlcnhqmin )) ) THEN ! dw = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*ehw(mgs)*qx(mgs,lc) - 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) ! dwr = 0.01*( Exp( -temcg(mgs)/( 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & ! 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 ) ) - 1.0 ) + IF ( incwet > 0 ) THEN + d = dhwet(mgs) + ELSE + ! First guess for dwet (not that good, but it is something) x = 1.1e4 * rho0(mgs)*(ehw(mgs)*qx(mgs,lc)+ehr(mgs)*qx(mgs,lr)) - & 1.3e3*rho0(mgs)*qx(mgs,li) + 1.0 IF ( x > 1.e-20 ) THEN @@ -19803,7 +20704,7 @@ subroutine nssl_2mom_gs & ELSE dwr = 1.e30 ENDIF - d = dwr + d = Min(dwr, dg0thresh + 0.0001) IF ( dwr < 0.2 .and. dwr > 0.0 .and. rho0(mgs)*(qx(mgs,lc)+qx(mgs,lr)) > 1.e-4 ) THEN sqrtrhovt = Sqrt( rhovt(mgs) ) fventh = sqrtrhovt*(fpndl(mgs)**(1./3.)) * (fakvisc(mgs))**(-0.5) @@ -19856,21 +20757,26 @@ subroutine nssl_2mom_gs & IF ( Abs(dold - d)/dold < 0.05 .or. ( n > 3 .and. d > dg0thresh ) ) EXIT ENDDO - ENDIF + + d = Min( d, dg0thresh + 0.0001 ) + ENDIF ! dwr < 0.2 .and. dwr > 0.0 + ENDIF ! incwet - dg0(mgs) = Min( dwmax, Max( d, dwmin ) ) + ! dg0(mgs) = Min( dwmax, Max( d, dwmin ) ) + dg0(mgs) = Max( d, dwmin ) ELSE - IF ( qx(mgs,lh) > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr-2.0 ) THEN - dg0(mgs) = dwmax - ELSE + ! IF ( qx(mgs,lh) > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin .and. temg(mgs) .le. tfr+hailcnvtoffset ) THEN + ! dg0(mgs) = dwmax + ! ELSE dg0(mgs) = dg0thresh + 0.0001 - ENDIF + ! ENDIF ENDIF IF ( ihlcnh == 3 .and. (qhacw(mgs) + qhacr(mgs))*dtp > qxmin(lh) .and. qx(mgs,lh) > hlcnhqmin & - .and. temg(mgs) .le. tfr-2.0 ) THEN + .and. temg(mgs) .le. tfr+hailcnvtoffset .and. temg(mgs) > 238.0 ) THEN ! set a secondary condition on to capture large graupel that is riming but not in wet growth - dg0(mgs) = Min( dg0(mgs), dg0thresh - 0.0001 ) +! dg0(mgs) = Min( dg0(mgs), dg0thresh - 0.0001 ) + dg0(mgs) = Min( dg0(mgs), dwmax ) ENDIF ENDIF @@ -19884,7 +20790,7 @@ subroutine nssl_2mom_gs & & ltest .and. qx(mgs,lh) .gt. hlcnhqmin ) .or. wtest ) THEN ! { ! : xdia(mgs,lh,3) .gt. 2.e-3 .and. qx(mgs,lh) .gt. 1.0e-3 THEN ! 0823.2008 erm test ! IF ( xdia(mgs,lh,3) .gt. 1.e-3 ) THEN - IF ( qhacw(mgs) .gt. 0.0 .and. qhacw(mgs) .gt. qhaci(mgs) .and. temg(mgs) .le. tfr-2.0 ) THEN ! { + IF ( qhacw(mgs) .gt. 0.0 .and. qhacw(mgs) .gt. qhaci(mgs) .and. temg(mgs) .le. tfr+hailcnvtoffset ) THEN ! { ! dh0 is the diameter dividing wet growth from dry growth (Ziegler 1985), modified by MY05 ! dh0 = 0.01*(exp(temcg(mgs)/(1.1e4*(qx(mgs,lc)+qx(mgs,lr)) - ! : 1.3e3*qx(mgs,li) + 1.0e-3 ) ) - 1.0) @@ -19898,6 +20804,7 @@ subroutine nssl_2mom_gs & ELSE dh0 = 1.e30 ENDIF + dg0(mgs) = Min(dh0, dg0thresh + 0.0001) ENDIF ! wtest ! dh0 = Max( dh0, 5.e-3 ) @@ -19932,7 +20839,7 @@ subroutine nssl_2mom_gs & IF ( wtest .and. & - ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr-2. .and. qx(mgs,lh) > hlcnhqmin ) ) THEN + ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr+hailcnvtoffset .and. qx(mgs,lh) > hlcnhqmin ) ) THEN ! convert number, mass, and reflectivity for d > dw IF ( ipconc == 5 ) THEN ! dg0(mgs) = Min( dg0(mgs), hldia1 ) @@ -19986,10 +20893,42 @@ subroutine nssl_2mom_gs & tmp3 = gaminterp(ratio,alpha(mgs,lh),11,1) zxd1 = flim*zx(mgs,lh)*(tmp3) zhlcnh(mgs) = dtpinv*zxd1 + + ! tmp4 is the Z from the converted particles assuming shape of alphamax + tmp3 = g1xmax*(rho0(mgs)*qxd1)**2/((pi*xdn(mgs,lh)/6.0)**2) + tmp4 = tmp3/cxd1 + IF ( tmp4 > zxd1 ) THEN ! calculate new hail number to match zxd1 + ! increase cxd1 to make z,q,c rates consistent + ! cxd1 = g1xmax*(rho0(mgs)*qxd1)**2/(zxd1*(pi*xdn(mgs,lh)/6.0)**2) + cxd1 = tmp3/zxd1 + chlcnhhl(mgs) = dtpinv*cxd1 + ENDIF ELSE zxd1 = 0 ENDIF + IF ( ipconc == 5 ) THEN ! Adjust cxd1 by reflectivity removed from graupel + tmp3 = gaminterp(ratio,alpha(mgs,lh),11,1) + ! tmp5 is graupel reflectivity moment + tmp5 = g1x(mgs,lh)*(rho0(mgs)*qx(mgs,lh))**2/((pi*xdn(mgs,lh)/6.)**2*cx(mgs,lh)) + zxd1 = flim*(tmp3)*tmp5 + ! tmp4 is the reflectivity of the newly-converted graupel particles (use g1x(lh) for loss term) + ! which we want to match zxd1 to prevent spurious increase in total reflectivity + tmp3 = g1x(mgs,lh)*(rho0(mgs)*qxd1)**2/((pi*xdn(mgs,lh)/6.0)**2) + tmp4 = tmp3/cxd1 + IF ( tmp4 > zxd1 ) THEN ! calculate new hail number to match zxd1 + ! cxd1 = g1x(mgs,lhl)*(rho0(mgs)*qxd1)**2/(zxd1*pi*xdn(mgs,lh)/6.0) ! trial form results in tiny hail + ! want the adjust size of the new hail so that Z is conserved, so increase number of + ! particles to make qxd1,zxd1, and C consistent. + ! want zxd1 = g1x(mgs,lh)*(rho0(mgs)*qxd1)**2/(c*(pi*xdn(mgs,lh)/6.0)**2) + ! Use g1x(mgs,lh) here instead of g1x(mgs,lhl) because rzxhlh will then multiply + ! by g1x(mgs,lhl)/g1x(mgs,lh) + ! cxd1 = g1x(mgs,lh)*(rho0(mgs)*qxd1)**2/(zxd1*(pi*xdn(mgs,lh)/6.0)**2) + cxd1 = tmp3/zxd1 + chlcnhhl(mgs) = dtpinv*cxd1 ! multiplied later by rzxhlh(mgs) + ENDIF + ENDIF + ELSE qhlcnh(mgs) = 0.0 ENDIF @@ -20015,7 +20954,7 @@ subroutine nssl_2mom_gs & ! convert number, mass, and reflectivity for d > hldia1, ! regardless of wet growth status, but as long as riming > 0 DO mgs = 1,ngscnt - IF ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr-2. .and. qx(mgs,lh) > qxmin(lh) ) THEN + IF ( qhacw(mgs)*dtp > qxmin(lh) .and. temg(mgs) .lt. tfr+hailcnvtoffset .and. qx(mgs,lh) > qxmin(lh) ) THEN ratio = Min( maxratiolu, hldia1/xdia(mgs,lh,1) ) ! number @@ -20050,7 +20989,7 @@ subroutine nssl_2mom_gs & ! qhlcnh(mgs) = 0.0 ! chlcnh(mgs) = 0.0 if ( wetgrowth(mgs) .and. temg(mgs) .lt. tfr-5. .and. qx(mgs,lh) > qxmin(lh) ) then - if ( qhacw(mgs).gt.1.e-6 .and. xdn(mgs,lh) > 700. ) then + if ( qhacw(mgs).gt.1.e-6 .and. ( xdn(mgs,lh) > 700. .or. lvh == 0 ) ) then qhlcnh(mgs) = & ((pi*xdn(mgs,lh)*cx(mgs,lh)) / (6.0*rho0(mgs)*dtp)) & *exp(-hldia1/xdia(mgs,lh,1)) & @@ -20783,6 +21722,7 @@ subroutine nssl_2mom_gs & ! ! ! + if (ndebug .gt. 0 ) write(0,*) 'dbg = 8a' ! ! @@ -20818,6 +21758,7 @@ subroutine nssl_2mom_gs & ! Cloud ice ! ! IF ( ipconc .ge. 1 ) THEN + if (ndebug .gt. 0 ) write(0,*) 'cloud ice sum' IF ( warmonly < 0.5 ) THEN IF ( ffrzs < 1.0 ) THEN @@ -20863,7 +21804,7 @@ subroutine nssl_2mom_gs & & +chlmul1(mgs) & & + csplinter(mgs) + csplinter2(mgs) & & +csmul(mgs) - + pccii(mgs) = pccii(mgs)*(1. - ffrzs) pccid(mgs) = & ! & il5(mgs)*(-cscni(mgs) - cscnvi(mgs) & ! - cwaci(mgs) & @@ -20984,6 +21925,7 @@ subroutine nssl_2mom_gs & pccii(mgs) = pccii(mgs) - (1.-frac)*il5(mgs)*(cwfrzc(mgs)+cwctfzc(mgs))*(1. - ffrzs) IF ( lhl .gt. 1 ) chlacw(mgs) = frac*chlacw(mgs) + ! STOP ENDIF @@ -21008,16 +21950,16 @@ subroutine nssl_2mom_gs & ! & -csmlr(mgs)/rzxs(mgs) & & -csmlrr(mgs) & & - cimlr(mgs) ) & + & - Min(0.0,cracr(mgs)) & ! cracr is negative if there is enough breakup & -crshr(mgs) !null at this point when wet snow/graupel included pcrwd(mgs) = & & il5(mgs)*(-ciacr(mgs) - crfrz(mgs) ) & ! - cipacr(mgs)) ! > -csacr(mgs) & & - chacr(mgs) - chlacr(mgs) & & +crcev(mgs) & - & - cracr(mgs) + & - Max(0.0,cracr(mgs)) ! > -il5(mgs)*ciracr(mgs) - ELSEIF ( warmonly < 0.8 ) THEN pcrwi(mgs) = & & crcnw(mgs) & @@ -21893,14 +22835,6 @@ subroutine nssl_2mom_gs & zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacr(mgs) ) ! zhacrf(mgs) = g1*zhacr - -! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*qhacr(mgs))**2)/(cx(mgs,lh)) - - IF ( z > zx(mgs,lh) ) THEN -! zhacr(mgs) = (z - zx(mgs,lh))*dtpinv - ELSE -! zhacr(mgs) = 0.0 - ENDIF ENDIF ! zhacr(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( tmp ) * qhacr(mgs) ) @@ -21911,12 +22845,7 @@ subroutine nssl_2mom_gs & ! : ((3.0 + alp)*(2.0 + alp)*(1.0 + alp)) IF ( qhacw(mgs) .gt. 0.0 ) THEN ! zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) - zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) - -! z = g1*(6.*rho0(mgs)/(pi*1000.))**2*( (qx(mgs,lh)+dtp*(qhacw(mgs)-qhmul1(mgs)))**2)/(cx(mgs,lh)) - IF ( z > zx(mgs,lh) ) THEN -! zhacw(mgs) = (z - zx(mgs,lh))*dtpinv - ENDIF + zhacw(mgs) = g1*(6.*rho0(mgs)/(pi*xdn(mgs,lh)))**2*( 2.*( qx(mgs,lh)/cx(mgs,lh)) * qhacw(mgs) ) ENDIF ELSE ! } { ! this is not used because of the 'true' above @@ -21992,18 +22921,18 @@ subroutine nssl_2mom_gs & r = rho0(mgs)*qhcns(mgs)/vhcns(mgs) ! density of new graupel particles IF ( imusnow == 3 ) THEN zhcns(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,ls)+2.)/(r**2*(alpha(mgs,ls)+1.)) * & - & ( 2.*tmp * qhcns(mgs) - tmp**2 * chcns(mgs) ) + & ( 2.*tmp * qhcns(mgs) - tmp**2 * chcnsh(mgs) ) ELSE write(0,*) 'Value of imusnow not valid. Must be 3 (fix me for =1). imusnow = ',imusnow STOP ENDIF ENDIF - IF ( qhcni(mgs) > 0.0 .and. chcni(mgs) > 0.0 .and. cx(mgs,li) > cxmin .and. vhcni(mgs) > 0 ) THEN + IF ( qhcni(mgs) > 0.0 .and. chcnih(mgs) > 0.0 .and. cx(mgs,li) > cxmin .and. vhcni(mgs) > 0 ) THEN tmp = qx(mgs,li)/cx(mgs,li) r = rho0(mgs)*qhcni(mgs)/vhcni(mgs) ! density of new graupel particles zhcni(mgs) = 3.6476*rho0(mgs)**2*(alpha(mgs,li)+2.)/(r**2*(alpha(mgs,li)+1.)) * & - & ( 2.*tmp * qhcni(mgs) - tmp**2 * chcni(mgs) ) + & ( 2.*tmp * qhcni(mgs) - tmp**2 * chcnih(mgs) ) ENDIF @@ -22026,14 +22955,6 @@ subroutine nssl_2mom_gs & & - il5(mgs)*zhlcnh(mgs) - IF ( igs(mgs) == 44 .and. kgs(mgs) == 23 .or. dtp*( pqhwi(mgs) + pqhwd(mgs) ) > qxmin(lh) ) THEN -! write(0,*) 'i,k,time = ',igs(mgs),kgs(mgs),time_real -! write(0,*) 'pzhwi,d = ',pzhwi(mgs),pzhwd(mgs),dtp*( pzhwi(mgs) + pzhwd(mgs) ),zx(mgs,lh) -! write(0,*) 'pqhwi,d = ',pqhwi(mgs),pqhwd(mgs),dtp*( pqhwi(mgs) + pqhwd(mgs) ),qx(mgs,lh) -! write(0,*) 'pchwi,d = ',pchwi(mgs),pchwd(mgs),dtp*( pchwi(mgs) + pchwd(mgs) ),cx(mgs,lh) - ENDIF - - ! IF ( zhcnhl(mgs) < 0.0 ) THEN ! write(0,*) 'Problem with zhcnhl! zhcnhl,qhcnhl,chcnhl = ',zhcnhl(mgs),qhcnhl(mgs),chcnhl(mgs) ! write(0,*) 'g1,tmp = ',g1x(mgs,lhl),tmp @@ -22295,7 +23216,7 @@ subroutine nssl_2mom_gs & zracw(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*1000.))**2*( 2.*tmp * qracw(mgs) ) ENDIF - IF ( cracr(mgs) > 0.0 .and. cx(mgs,lr) > 0.0 ) THEN + IF ( cracr(mgs) /= 0.0 .and. cx(mgs,lr) > 0.0 ) THEN zracr(mgs) = g1x(mgs,lr)*(6.*rho0(mgs)/(pi*1000.))**2*( tmp**2 * cracr(mgs) ) ENDIF @@ -22310,7 +23231,7 @@ subroutine nssl_2mom_gs & IF ( iferwisventr == 2 ) THEN vent1 = Min(0.0, (12./(pii*xdn(mgs,lr)))*xdia(mgs,lr,1)**3*fvce(mgs)*rwcap(mgs)*rwventz(mgs)) - zrcev(mgs) = Max( zrcev(mgs), vent1 ) + zrcev(mgs) = Max( dble(zrcev(mgs)), vent1 ) ENDIF ! IF ( ny == 2 .and. igs(mgs) == 20 ) THEN ! write(0,*) 'k,zrcevold,new,maxdep : ',kgs(mgs),zrcev(mgs),vent1,-zxmxd(mgs,lr),alpha(mgs,lr),cx(mgs,lr) @@ -22439,7 +23360,8 @@ subroutine nssl_2mom_gs & ! > + rho0(mgs)*qhshr(mgs)/xdn(mgs,lh) !xdn(mgs,lr) ! ENDIF - IF ( lzh > 1 .and. qx(mgs,lh) > qxmin(lh) ) THEN + IF ( lzh > 1 .and. qx(mgs,lh) > qxmin(lh) .and. & + vx(mgs,lh) + dtp*(pvhwi(mgs) + pvhwd(mgs)) > rho0(mgs)*qxmin(lh)/900. ) THEN ! Calculate change in reflectivity due to density changes xdn_new = rho0(mgs)*(qx(mgs,lh) + dtp*(pqhwi(mgs) + pqhwd(mgs) ))/ & @@ -22548,7 +23470,8 @@ subroutine nssl_2mom_gs & & + rho0(mgs)*(1-il5(mgs))*vhlmlr(mgs)/xdn(mgs,lhl) & & + vhlshdr(mgs) - vhlsoak(mgs) - IF ( lzhl > 1 .and. qx(mgs,lhl) > qxmin(lhl) ) THEN + IF ( lzhl > 1 .and. qx(mgs,lhl) > qxmin(lhl) .and. & + vx(mgs,lhl) + dtp*(pvhli(mgs) + pvhld(mgs)) > rho0(mgs)*qxmin(lhl)/900. ) THEN ! Calculate change in reflectivity due to density changes xdn_new = rho0(mgs)*(qx(mgs,lhl) + dtp*(pqhli(mgs) + pqhld(mgs) ))/ & @@ -22785,12 +23708,17 @@ subroutine nssl_2mom_gs & ! write(iunit,*) il5(mgs)*qscni(mgs), qscnvi(mgs) write(iunit,*) il5(mgs)*qsaci(mgs) - write(iunit,*) il5(mgs)*qrfrzs(mgs) + write(iunit,*) il5(mgs)*qrfrzs(mgs), qiacrs(mgs) write(iunit,*) il5(mgs)*qiacrs(mgs),il3(mgs)*(qiacrf(mgs)+qracif(mgs)),il3(mgs),qiacrf(mgs),qracif(mgs) write(iunit,*) il5(mgs)*qsdpv(mgs), qscev(mgs) - write(iunit,*) qsacw(mgs) + write(iunit,*) qsacw(mgs),qwfrzc(mgs), qwctfzc(mgs), qicichr(mgs) write(iunit,*) qsacr(mgs), qscnh(mgs) - write(iunit,*) 'pqswi = ',pqswi(mgs) + write(iunit,*) il2(mgs)*qsacr(mgs) + write(iunit,*) il5(mgs)*qicicnt(mgs)*ffrzs + write(iunit,*) il3(mgs)*(qiacrf(mgs)+qracif(mgs)) ! only applies for ipconc <= 3 + write(iunit,*) Max(0.0, qscev(mgs)) + write(iunit,*) qsacw(mgs) + qscnh(mgs) + write(iunit,*) 'pqswi = ',pqswi(mgs) write(iunit,*) -qhcns(mgs) write(iunit,*) -qracs(mgs) write(iunit,*) -qhacs(mgs) @@ -22965,6 +23893,7 @@ subroutine nssl_2mom_gs & qwvp(mgs) = qwvp(mgs) + & & dtp*(pqwvi(mgs)+pqwvd(mgs)) + ! qcwresv(mgs) = qx(mgs,lc) ! temporary save of old qc value qx(mgs,lc) = qx(mgs,lc) + & & dtp*(pqcwi(mgs)+pqcwd(mgs)) qx(mgs,lr) = qx(mgs,lr) + & @@ -23269,7 +24198,11 @@ subroutine nssl_2mom_gs & ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvs(mgs) = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF IF ( ( qvap(mgs) > qvs(mgs) .or. qx(mgs,lc) > qxmin(lc) ) .and. temg(mgs) > tfrh ) THEN tmp = (qvap(mgs) - qvs(mgs))/(1. + qvs(mgs)*felv(mgs)**2/(cp*rw*temg(mgs)**2) ) @@ -23313,7 +24246,11 @@ subroutine nssl_2mom_gs & ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + IF ( iqvsopt == 0 ) THEN + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvs(mgs) = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF qis(mgs) = pqs(mgs)*tabqis(ltemq) qss(mgs) = qvs(mgs) if ( temg(mgs) .lt. tfr ) then @@ -23381,7 +24318,7 @@ subroutine nssl_2mom_gs & IF ( eqtset > 2 ) THEN pipert(mgs) = pipert(mgs) & & +(felspi(mgs)*dqci(mgs) & - & +felvpi(mgs)*dqcw(mgs))*dtp + & +felvpi(mgs)*dqcw(mgs)) ! *dtp (remove dtp since dqxx are not rates) ENDIF end if ! dqwv(mgs) .lt. 0. (end of evap/sublim) @@ -23451,7 +24388,7 @@ subroutine nssl_2mom_gs & IF ( eqtset > 2 ) THEN pipert(mgs) = pipert(mgs) + (0 & & +felspi(mgs)*dqci(mgs) & - & +felvpi(mgs)*dqcw(mgs))*dtp + & +felvpi(mgs)*dqcw(mgs)) ! *dtp (remove dtp since dqxx are not rates) ENDIF qwvp(mgs) = qwvp(mgs) - ( dqvcnd(mgs) ) @@ -23475,7 +24412,12 @@ subroutine nssl_2mom_gs & tqvcon = temg(mgs)-cbw ltemq = (temg(mgs)-163.15)/fqsat+1.5 ltemq = Min( nqsat, Max(1,ltemq) ) - qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + + IF ( iqvsopt == 0 ) THEN + qvs(mgs) = pqs(mgs)*tabqvs(ltemq) + ELSEIF ( iqvsopt == 1 ) THEN + qvs(mgs) = rdorv*esbolton*tabqvs(ltemq)/(pres(mgs) - esbolton*tabqvs(ltemq)) + ENDIF qis(mgs) = pqs(mgs)*tabqis(ltemq) qx(mgs,lc) = max( 0.0, qx(mgs,lc) ) qitmp(mgs) = max( 0.0, qitmp(mgs) ) @@ -23629,7 +24571,7 @@ subroutine nssl_2mom_gs & IF ( qx(mgs,il) .le. 0.0 ) THEN cx(mgs,il) = 0.0 ELSE !{ - IF ( cx(mgs,il) .gt. cxmin ) THEN !{ + IF ( cx(mgs,il) .gt. cxmin .and. qx(mgs,il) > qxmin(il) ) THEN !{ only do this if mass is sufficient ! xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*Max(1.0e-9,cx(mgs,il))) ! xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*Max(cxmin,cx(mgs,il))) xv(mgs,il) = rho0(mgs)*qx(mgs,il)/(xdn(mgs,il)*cx(mgs,il)) @@ -23640,7 +24582,8 @@ subroutine nssl_2mom_gs & ! 8/26/2015 erm: apply imaxdiaopt for 2-moment also IF ( imaxdiaopt == 1 .or. il == lc .or. il == li .or. (il == lr .and. imurain == 3) .or. & - & (il == ls .and. imusnow == 3 ) ) THEN + & (il == ls .and. imusnow == 3 ) .or. ( il >= lh .and. lh > 0 ) ) THEN +! IF ( imaxdiaopt == 1 .or. (il == lr .and. imurain == 3) .or. .not. (il == lr .and. imurain == 1) ) THEN xvbarmax = xvmx(il) ELSEIF ( imaxdiaopt == 2 ) THEN ! test against maximum mass diameter xvbarmax = xvmx(il) /((3. + alpha(mgs,il))**3/((3. + alpha(mgs,il))*(2. + alpha(mgs,il))*(1. + alpha(mgs,il)))) @@ -23964,8 +24907,8 @@ subroutine nssl_2mom_gs & qr = qx(mgs,il) z = zx(mgs,il) - IF ( zx(mgs,il) .gt. 0. ) THEN !{ - + IF ( zx(mgs,il) .gt. zxmin .and. qr > qxmin(il) .and. chw > cxmin ) THEN !{ + ! rdi = z*(pi/6.*1000.)**2*chw/((rho0(mgs)*qr)**2) rdi = z*(pi/6.*xdn(mgs,il))**2*chw/((rho0(mgs)*qr)**2) diff --git a/physics/MP/NSSL/mp_nssl.F90 b/physics/MP/NSSL/mp_nssl.F90 index 0b111f7cd..d8db24d99 100644 --- a/physics/MP/NSSL/mp_nssl.F90 +++ b/physics/MP/NSSL/mp_nssl.F90 @@ -3,7 +3,8 @@ !>\defgroup nsslmp NSSL MP Module -!! This module contains the front end to NSSL microphysics scheme. + +!> This module contains the front end to NSSL microphysics scheme. module mp_nssl use machine, only : kind_phys @@ -27,8 +28,8 @@ module mp_nssl !! \htmlinclude mp_nssl_init.html !! subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & - mpirank, mpiroot,mpicomm, & - qc, qr, qi, qs, qh, & + fn_nml, input_nml_file, mpirank, mpiroot, & + mpicomm, qc, qr, qi, qs, qh, & ccw, crw, cci, csw, chw, vh, & con_g, con_rd, con_cp, con_rv, & con_t0c, con_cliq, con_csol, con_eps, & @@ -39,9 +40,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & use module_mp_nssl_2mom, only: nssl_2mom_init, nssl_2mom_init_const -#ifdef MPI - use mpi -#endif + use mpi_f08 implicit none @@ -51,12 +50,14 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & integer, intent( out) :: errflg integer, intent(in) :: threads logical, intent(in) :: restart + character(len=*), intent(in) :: fn_nml + character(len=*), intent(in) :: input_nml_file(:) real(kind_phys), intent(in) :: con_g, con_rd, con_cp, con_rv, & con_t0c, con_cliq, con_csol, con_eps integer, intent(in) :: mpirank integer, intent(in) :: mpiroot - integer, intent(in) :: mpicomm + type(MPI_Comm), intent(in) :: mpicomm integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_nssl real(kind_phys), intent(in) :: nssl_cccn, nssl_alphah, nssl_alphahl @@ -82,7 +83,6 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & real(kind_phys), parameter :: qmin = 1.e-12 integer :: ierr logical :: missing_vars = .False. - ! Initialize the CCPP error handling variables errflg = 0 @@ -156,11 +156,14 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & ! write(0,*) 'call nssl_2mom_init' CALL nssl_2mom_init(ims,ime, jms,jme, kms,kme,nssl_params,ipctmp=ipc,mixphase=0, & - ihvol=ihailv,nssl_ehw0=nssl_ehw0,nssl_ehlw0=nssl_ehlw0,errmsg=errmsg, & + namelist_filename=fn_nml,internal_nml=input_nml_file, & + ihvol=ihailv,nssl_ehw0=nssl_ehw0, & + nssl_ehlw0=nssl_ehlw0,errmsg=errmsg, & nssl_alphar=nssl_alphar, & nssl_alphah=nssl_alphah, & nssl_alphahl=nssl_alphahl, & nssl_cccn=nssl_cccn, & + nssl_ccn_on=nssl_ccn_on, & errflg=errflg,myrank=mpirank,mpiroot=mpiroot) ! For restart runs, the init is done here @@ -174,9 +177,7 @@ subroutine mp_nssl_init(ncol, nlev, errflg, errmsg, threads, restart, & IF ( .not. missing_vars .and. Any( qr > qmin .and. crw == 0.0 ) ) missing_vars = .true. IF ( .not. missing_vars .and. Any( qh > qmin .and. (chw == 0.0 .or. vh == 0.0) ) ) missing_vars = .true. -#ifdef MPI call MPI_Allreduce(missing_vars, missing_vars_global, 1, MPI_LOGICAL, MPI_LOR, mpicomm, ierr) -#endif is_initialized = .true. return @@ -224,25 +225,25 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & ! Hydrometeors logical, intent(in ) :: convert_dry_rho real(kind_phys), intent(inout) :: spechum(:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: cccn(:,:) !(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: cccna(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: cccn(:,:) !(1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: cccna(:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qc (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qr (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qi (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qs (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qh (:,:) !(1:ncol,1:nlev) graupel - real(kind_phys), intent(inout) :: qhl(:,:) !(1:ncol,1:nlev) hail + real(kind_phys), intent(inout), optional :: qhl(:,:) !(1:ncol,1:nlev) hail real(kind_phys), intent(inout) :: ccw(:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: crw(:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: cci(:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: csw(:,:) !(1:ncol,1:nlev) real(kind_phys), intent(inout) :: chw(:,:) !(1:ncol,1:nlev) graupel number - real(kind_phys), intent(inout) :: chl(:,:) !(1:ncol,1:nlev) hail number + real(kind_phys), intent(inout), optional :: chl(:,:) !(1:ncol,1:nlev) hail number real(kind_phys), intent(inout) :: vh (:,:) !(1:ncol,1:nlev) graupel volume - real(kind_phys), intent(inout) :: vhl(:,:) !(1:ncol,1:nlev) hail volume - real(kind_phys), intent(inout) :: zrw(:,:) !(1:ncol,1:nlev) rain reflectivity - real(kind_phys), intent(inout) :: zhw(:,:) !(1:ncol,1:nlev) graupel reflectivity - real(kind_phys), intent(inout) :: zhl(:,:) !(1:ncol,1:nlev) hail reflectivity + real(kind_phys), intent(inout), optional :: vhl(:,:) !(1:ncol,1:nlev) hail volume + real(kind_phys), intent(inout), optional :: zrw(:,:) !(1:ncol,1:nlev) rain reflectivity + real(kind_phys), intent(inout), optional :: zhw(:,:) !(1:ncol,1:nlev) graupel reflectivity + real(kind_phys), intent(inout), optional :: zhl(:,:) !(1:ncol,1:nlev) hail reflectivity ! State variables and timestep information real(kind_phys), intent(inout) :: tgrs (:,:) !(1:ncol,1:nlev) real(kind_phys), intent(in ) :: prsl (:,:) !(1:ncol,1:nlev) @@ -262,10 +263,10 @@ subroutine mp_nssl_run(ncol, nlev, con_g, con_rd, mpirank, & logical, intent(in ) :: do_radar_ref, first_time_step logical, intent(in) :: restart ! Cloud effective radii - real(kind_phys), intent(inout) :: re_cloud(:,:) ! (1:ncol,1:nlev) - real(kind_phys), intent(inout) :: re_ice(:,:) ! (1:ncol,1:nlev) - real(kind_phys), intent(inout) :: re_snow(:,:) ! (1:ncol,1:nlev) - real(kind_phys), intent(inout) :: re_rain(:,:) ! (1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: re_cloud(:,:) ! (1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: re_ice(:,:) ! (1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: re_snow(:,:) ! (1:ncol,1:nlev) + real(kind_phys), intent(inout), optional :: re_rain(:,:) ! (1:ncol,1:nlev) integer, intent(in) :: nleffr, nieffr, nseffr, nreffr integer, intent(in) :: imp_physics integer, intent(in) :: imp_physics_nssl diff --git a/physics/MP/NSSL/mp_nssl.meta b/physics/MP/NSSL/mp_nssl.meta index 8449f26cf..93a5aa65b 100644 --- a/physics/MP/NSSL/mp_nssl.meta +++ b/physics/MP/NSSL/mp_nssl.meta @@ -49,6 +49,22 @@ dimensions = () type = logical intent = in +[fn_nml] + standard_name = filename_of_namelist + long_name = namelist filename + units = none + dimensions = () + type = character + kind = len=* + intent = in +[input_nml_file] + standard_name = filename_of_internal_namelist + long_name = character string to store full namelist contents + units = none + dimensions = (number_of_lines_in_internal_namelist) + type = character + kind = len=* + intent = in [mpirank] standard_name = mpi_rank long_name = current MPI-rank @@ -68,7 +84,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [qc] standard_name = cloud_liquid_water_mixing_ratio @@ -409,6 +425,7 @@ type = real kind = kind_phys intent = inout + optional = True [cccn] standard_name = cloud_condensation_nuclei_number_concentration_of_new_state long_name = number concentration of cloud condensation nuclei updated by physics @@ -417,6 +434,7 @@ type = real kind = kind_phys intent = inout + optional = True [cccna] standard_name = activated_cloud_condensation_nuclei_number_concentration_of_new_state long_name = number concentration of activated cloud condensation nuclei updated by physics @@ -425,6 +443,7 @@ type = real kind = kind_phys intent = inout + optional = True [ccw] standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air_of_new_state long_name = cloud droplet number concentration @@ -473,6 +492,7 @@ type = real kind = kind_phys intent = inout + optional = True [vh] standard_name = graupel_volume_of_new_state long_name = graupel particle volume @@ -489,6 +509,7 @@ type = real kind = kind_phys intent = inout + optional = True [zrw] standard_name = reflectivity_of_rain_of_new_state long_name = rain reflectivity @@ -497,6 +518,7 @@ type = real kind = kind_phys intent = inout + optional = True [zhw] standard_name = reflectivity_of_graupel_of_new_state long_name = graupel reflectivity @@ -505,6 +527,7 @@ type = real kind = kind_phys intent = inout + optional = True [zhl] standard_name = reflectivity_of_hail_of_new_state long_name = hail reflectivity @@ -513,6 +536,7 @@ type = real kind = kind_phys intent = inout + optional = True [tgrs] standard_name = air_temperature_of_new_state long_name = model layer mean temperature @@ -646,6 +670,7 @@ type = real kind = kind_phys intent = inout + optional = True [re_ice] standard_name = effective_radius_of_stratiform_cloud_ice_particle long_name = eff. radius of cloud ice water particle in micrometer @@ -654,6 +679,7 @@ type = real kind = kind_phys intent = inout + optional = True [re_snow] standard_name = effective_radius_of_stratiform_cloud_snow_particle long_name = effective radius of cloud snow particle in micrometer @@ -662,6 +688,7 @@ type = real kind = kind_phys intent = inout + optional = True [re_rain] standard_name = effective_radius_of_stratiform_cloud_rain_particle long_name = effective radius of cloud rain particle in micrometers @@ -670,6 +697,7 @@ type = real kind = kind_phys intent = inout + optional = True [nleffr] standard_name = index_of_cloud_liquid_water_effective_radius_in_xyz_dimensioned_restart_array long_name = the index of cloud liquid water effective radius in phy_f3d diff --git a/physics/MP/TEMPO/TEMPO b/physics/MP/TEMPO/TEMPO new file mode 160000 index 000000000..c62efd27c --- /dev/null +++ b/physics/MP/TEMPO/TEMPO @@ -0,0 +1 @@ +Subproject commit c62efd27caa26f660edf24232f33f154e608b77a diff --git a/physics/MP/TEMPO/module_mp_tempo.F90 b/physics/MP/TEMPO/module_mp_tempo.F90 new file mode 100644 index 000000000..89c62f7ec --- /dev/null +++ b/physics/MP/TEMPO/module_mp_tempo.F90 @@ -0,0 +1,1506 @@ +! 3D TEMPO Driver for CCPP +!================================================================================================================= +module module_mp_tempo + + use machine, only: wp => kind_phys, sp => kind_sngl_prec, dp => kind_dbl_prec + use module_mp_tempo_params + use module_mp_tempo_utils, only : create_bins, table_Efrw, table_Efsw, table_dropEvap, & + table_ccnAct, qi_aut_qs, qr_acr_qg_par, qr_acr_qs_par, freezeH2O_par, calc_refl10cm, calc_effectRad + use module_mp_tempo_main, only : mp_tempo_main + use module_mp_radar + + implicit none + +contains + !================================================================================================================= + ! This subroutine handles initialzation of the microphysics scheme including building of lookup tables, + ! allocating arrays for the microphysics scheme, and defining gamma function variables. + subroutine tempo_init(is_aerosol_aware_in, merra2_aerosol_aware_in, is_hail_aware_in, & + mpicomm, mpirank, mpiroot, threads, errmsg, errflg) + + logical, intent(in) :: is_aerosol_aware_in + logical, intent(in) :: merra2_aerosol_aware_in + logical, intent(in), optional :: is_hail_aware_in + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot + integer, intent(in) :: threads + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg + + integer :: i, j, k, l, m, n + logical :: micro_init + real(wp) :: stime, etime + logical, parameter :: precomputed_tables = .false. + + ! Initialize physical constants + call mp_tempo_params_init() + + ! Set module variable is_aerosol_aware/merra2_aerosol_aware + configs%aerosol_aware = is_aerosol_aware_in + merra2_aerosol_aware = merra2_aerosol_aware_in + if (present(is_hail_aware_in)) then + configs%hail_aware = is_hail_aware_in + else + configs%hail_aware = .false. + endif + if (configs%aerosol_aware .and. merra2_aerosol_aware) then + errmsg = 'Logic error in tempo_init: only one of the two options can be true, ' // & + 'not both: is_aerosol_aware or merra2_aerosol_aware' + errflg = 1 + return + end if + if (mpirank==mpiroot) then + if (configs%aerosol_aware) then + write (*,'(a)') 'Using aerosol-aware version of TEMPO microphysics' + else if(merra2_aerosol_aware) then + write (*,'(a)') 'Using merra2 aerosol-aware version of TEMPO microphysics' + else + write (*,'(a)') 'Using non-aerosol-aware version of TEMPO microphysics' + end if + end if + + micro_init = .false. + + if (configs%hail_aware) then + dimNRHG = NRHG + else + av_g(idx_bg1) = av_g_old + bv_g(idx_bg1) = bv_g_old + dimNRHG = NRHG1 + endif + + if (mpirank==mpiroot) then + write (*,*) 'Hail-aware option is: ', configs%hail_aware + write (*,*) 'Hail-aware option dimNRHG is: ', dimNRHG + endif + + ! Allocate space for lookup tables (J. Michalakes 2009Jun08). + if (.not. allocated(tcg_racg)) then + allocate(tcg_racg(ntb_g1,ntb_g,dimNRHG,ntb_r1,ntb_r)) + micro_init = .true. + endif + + ! Rain-graupel (including array above tcg_racg) + if (.not. allocated(tmr_racg)) allocate(tmr_racg(ntb_g1,ntb_g,dimNRHG,ntb_r1,ntb_r)) + if (.not. allocated(tcr_gacr)) allocate(tcr_gacr(ntb_g1,ntb_g,dimNRHG,ntb_r1,ntb_r)) + if (.not. allocated(tnr_racg)) allocate(tnr_racg(ntb_g1,ntb_g,dimNRHG,ntb_r1,ntb_r)) + if (.not. allocated(tnr_gacr)) allocate(tnr_gacr(ntb_g1,ntb_g,dimNRHG,ntb_r1,ntb_r)) + + ! Rain-snow + if (.not. allocated(tcs_racs1)) allocate(tcs_racs1(ntb_s,ntb_t,ntb_r1,ntb_r)) + if (.not. allocated(tmr_racs1)) allocate(tmr_racs1(ntb_s,ntb_t,ntb_r1,ntb_r)) + if (.not. allocated(tcs_racs2)) allocate(tcs_racs2(ntb_s,ntb_t,ntb_r1,ntb_r)) + if (.not. allocated(tmr_racs2)) allocate(tmr_racs2(ntb_s,ntb_t,ntb_r1,ntb_r)) + if (.not. allocated(tcr_sacr1)) allocate(tcr_sacr1(ntb_s,ntb_t,ntb_r1,ntb_r)) + if (.not. allocated(tms_sacr1)) allocate(tms_sacr1(ntb_s,ntb_t,ntb_r1,ntb_r)) + if (.not. allocated(tcr_sacr2)) allocate(tcr_sacr2(ntb_s,ntb_t,ntb_r1,ntb_r)) + if (.not. allocated(tms_sacr2)) allocate(tms_sacr2(ntb_s,ntb_t,ntb_r1,ntb_r)) + if (.not. allocated(tnr_racs1)) allocate(tnr_racs1(ntb_s,ntb_t,ntb_r1,ntb_r)) + if (.not. allocated(tnr_racs2)) allocate(tnr_racs2(ntb_s,ntb_t,ntb_r1,ntb_r)) + if (.not. allocated(tnr_sacr1)) allocate(tnr_sacr1(ntb_s,ntb_t,ntb_r1,ntb_r)) + if (.not. allocated(tnr_sacr2)) allocate(tnr_sacr2(ntb_s,ntb_t,ntb_r1,ntb_r)) + + ! Cloud water freezing + if (.not. allocated(tpi_qcfz)) allocate(tpi_qcfz(ntb_c,nbc,ntb_t1,ntb_IN)) + if (.not. allocated(tni_qcfz)) allocate(tni_qcfz(ntb_c,nbc,ntb_t1,ntb_IN)) + + ! Rain freezing + if (.not. allocated(tpi_qrfz)) allocate(tpi_qrfz(ntb_r,ntb_r1,ntb_t1,ntb_IN)) + if (.not. allocated(tpg_qrfz)) allocate(tpg_qrfz(ntb_r,ntb_r1,ntb_t1,ntb_IN)) + if (.not. allocated(tni_qrfz)) allocate(tni_qrfz(ntb_r,ntb_r1,ntb_t1,ntb_IN)) + if (.not. allocated(tnr_qrfz)) allocate(tnr_qrfz(ntb_r,ntb_r1,ntb_t1,ntb_IN)) + + ! Ice growth and conversion to snow + if (.not. allocated(tps_iaus)) allocate(tps_iaus(ntb_i,ntb_i1)) + if (.not. allocated(tni_iaus)) allocate(tni_iaus(ntb_i,ntb_i1)) + if (.not. allocated(tpi_ide)) allocate(tpi_ide(ntb_i,ntb_i1)) + + ! Collision efficiencies + if (.not. allocated(t_efrw)) allocate(t_efrw(nbr,nbc)) + if (.not. allocated(t_efsw)) allocate(t_efsw(nbs,nbc)) + + ! Cloud water + if (.not. allocated(tnr_rev)) allocate(tnr_rev(nbr,ntb_r1,ntb_r)) + if (.not. allocated(tpc_wev)) allocate(tpc_wev(nbc,ntb_c,nbc)) + if (.not. allocated(tnc_wev)) allocate(tnc_wev(nbc,ntb_c,nbc)) + + ! CCN + if (.not. allocated(tnccn_act)) allocate(tnccn_act(ntb_arc,ntb_arw,ntb_art,ntb_arr,ntb_ark)) + + !================================================================================================================= + if_micro_init: if (micro_init) then + + !> - From Martin et al. (1994), assign gamma shape parameter mu for cloud + !! drops according to general dispersion characteristics (disp=~0.25 + !! for maritime and 0.45 for continental) + !.. disp=SQRT((mu+2)/(mu+1) - 1) so mu varies from 15 for Maritime + !.. to 2 for really dirty air. This not used in 2-moment cloud water + !.. scheme and nu_c used instead and varies from 2 to 15 (integer-only). + mu_c_l = min(15.0_wp, (1000.e6_wp/Nt_c_l + 2.)) + mu_c_o = min(15.0_wp, (1000.e6_wp/Nt_c_o + 2.)) + + !> - Compute Schmidt number to one-third used numerous times + Sc3 = Sc**(1./3.) + + !> - Compute minimum ice diam from mass, min snow/graupel mass from diam + D0i = (xm0i/am_i)**(1./bm_i) + xm0s = am_s * D0s**bm_s + xm0g = am_g(NRHG) * D0g**bm_g + + !> - Compute constants various exponents and gamma() associated with cloud, + !! rain, snow, and graupel + do n = 1, 15 + cce(1,n) = n + 1. + cce(2,n) = bm_r + n + 1. + cce(3,n) = bm_r + n + 4. + cce(4,n) = n + bv_c + 1. + cce(5,n) = bm_r + n + bv_c + 1. + ccg(1,n) = gamma(cce(1,n)) + ccg(2,n) = gamma(cce(2,n)) + ccg(3,n) = gamma(cce(3,n)) + ccg(4,n) = gamma(cce(4,n)) + ccg(5,n) = gamma(cce(5,n)) + ocg1(n) = 1.0 / ccg(1,n) + ocg2(n) = 1.0 / ccg(2,n) + enddo + + cie(1) = mu_i + 1. + cie(2) = bm_i + mu_i + 1. + cie(3) = bm_i + mu_i + bv_i + 1. + cie(4) = mu_i + bv_i + 1. + cie(5) = mu_i + 2. + cie(6) = bm_i*0.5 + mu_i + bv_i + 1. + cie(7) = bm_i*0.5 + mu_i + 1. + cig(1) = gamma(cie(1)) + cig(2) = gamma(cie(2)) + cig(3) = gamma(cie(3)) + cig(4) = gamma(cie(4)) + cig(5) = gamma(cie(5)) + cig(6) = gamma(cie(6)) + cig(7) = gamma(cie(7)) + oig1 = 1.0 / cig(1) + oig2 = 1.0 / cig(2) + obmi = 1.0 / bm_i + + cre(1) = bm_r + 1. + cre(2) = mu_r + 1. + cre(3) = bm_r + mu_r + 1. + cre(4) = bm_r*2. + mu_r + 1. + cre(5) = mu_r + bv_r + 1. + cre(6) = bm_r + mu_r + bv_r + 1. + cre(7) = bm_r*0.5 + mu_r + bv_r + 1. + cre(8) = bm_r + mu_r + bv_r + 3. + cre(9) = mu_r + bv_r + 3. + cre(10) = mu_r + 2. + cre(11) = 0.5*(bv_r + 5. + 2.*mu_r) + cre(12) = bm_r*0.5 + mu_r + 1. + cre(13) = bm_r*2. + mu_r + bv_r + 1. + + do n = 1, 13 + crg(n) = gamma(cre(n)) + enddo + + obmr = 1.0 / bm_r + ore1 = 1.0 / cre(1) + org1 = 1.0 / crg(1) + org2 = 1.0 / crg(2) + org3 = 1.0 / crg(3) + + cse(1) = bm_s + 1. + cse(2) = bm_s + 2. + cse(3) = bm_s*2. + cse(4) = bm_s + bv_s + 1. + cse(5) = bm_s*2. + bv_s + 1. + cse(6) = bm_s*2. + 1. + cse(7) = bm_s + mu_s + 1. + cse(8) = bm_s + mu_s + 2. + cse(9) = bm_s + mu_s + 3. + cse(10) = bm_s + mu_s + bv_s + 1. + cse(11) = bm_s*2. + mu_s + bv_s + 1. + cse(12) = bm_s*2. + mu_s + 1. + cse(13) = bv_s + 2. + cse(14) = bm_s + bv_s + cse(15) = mu_s + 1. + cse(16) = 1.0 + (1.0 + bv_s)/2. + + if (original_thompson) then + cse(17) = cse(16) + mu_s + 1. + cse(18) = bv_s + mu_s + 3. + do n = 1, 18 + csg(n) = gamma(cse(n)) + enddo + else + cse(17) = bm_s + bv_s + 2. + do n = 1, 17 + csg(n) = gamma(cse(n)) + enddo + endif + + oams = 1.0 / am_s + obms = 1.0 / bm_s + ocms = oams**obms + + cge(1,:) = bm_g + 1. + cge(2,:) = mu_g + 1. + cge(3,:) = bm_g + mu_g + 1. + cge(4,:) = bm_g*2. + mu_g + 1. + cge(10,:) = mu_g + 2. + cge(12,:) = bm_g*0.5 + mu_g + 1. + + do m = 1, NRHG + cge(5,m) = bm_g*2. + mu_g + bv_g(m) + 1. + cge(6,m) = bm_g + mu_g + bv_g(m) + 1. + cge(7,m) = bm_g*0.5 + mu_g + bv_g(m) + 1. + cge(8,m) = mu_g + bv_g(m) + 1. ! not used + cge(9,m) = mu_g + bv_g(m) + 3. + cge(11,m) = 0.5*(bv_g(m) + 5. + 2.*mu_g) + enddo + + do m = 1, NRHG + do n = 1, 12 + cgg(n,m) = gamma(cge(n,m)) + enddo + enddo + + oamg = 1.0 / am_g + obmg = 1.0 / bm_g + + do m = 1, NRHG + oamg(m) = 1.0 / am_g(m) + ocmg(m) = oamg(m)**obmg + enddo + + oge1 = 1.0 / cge(1,1) + ogg1 = 1.0 / cgg(1,1) + ogg2 = 1.0 / cgg(2,1) + ogg3 = 1.0 / cgg(3,1) + + !================================================================================================================= + ! Simplify various rate eqns the best we can now. + + ! Rain collecting cloud water and cloud ice + t1_qr_qc = PI * 0.25 * av_r * crg(9) + t1_qr_qi = PI * 0.25 * av_r * crg(9) + t2_qr_qi = PI * 0.25 * am_r*av_r * crg(8) + + ! Graupel collecting cloud water + ! t1_qg_qc = PI*.25*av_g * cgg(9) + + ! Snow collecting cloud water + t1_qs_qc = PI * 0.25 * av_s + + ! Snow collecting cloud ice + t1_qs_qi = PI * 0.25 * av_s + + ! Evaporation of rain; ignore depositional growth of rain. + t1_qr_ev = 0.78 * crg(10) + t2_qr_ev = 0.308 * Sc3 * SQRT(av_r) * crg(11) + + ! Sublimation/depositional growth of snow + t1_qs_sd = 0.86 + t2_qs_sd = 0.28 * Sc3 * SQRT(av_s) + + ! Melting of snow + t1_qs_me = PI * 4. *C_sqrd * olfus * 0.86 + t2_qs_me = PI * 4. *C_sqrd * olfus * 0.28 * Sc3 * SQRT(av_s) + + ! Sublimation/depositional growth of graupel + t1_qg_sd = 0.86 * cgg(10,1) + ! t2_qg_sd = 0.28*Sc3*SQRT(av_g) * cgg(11) + + ! Melting of graupel + t1_qg_me = PI * 4. * C_cube * olfus * 0.86 * cgg(10,1) + ! t2_qg_me = PI*4.*C_cube*olfus * 0.28*Sc3*SQRT(av_g) * cgg(11) + + + ! Constants for helping find lookup table indexes. + nic2 = nint(log10(r_c(1))) + nii2 = nint(log10(r_i(1))) + nii3 = nint(log10(Nt_i(1))) + nir2 = nint(log10(r_r(1))) + nir3 = nint(log10(N0r_exp(1))) + nis2 = nint(log10(r_s(1))) + nig2 = nint(log10(r_g(1))) + nig3 = nint(log10(N0g_exp(1))) + niIN2 = nint(log10(Nt_IN(1))) + + ! Create bins of cloud water (from minimum diameter to 100 microns). + Dc(1) = D0c*1.0_dp + dtc(1) = D0c*1.0_dp + do n = 2, nbc + Dc(n) = Dc(n-1) + 1.0e-6_dp + dtc(n) = (Dc(n) - Dc(n-1)) + enddo + + ! Create bins of cloud ice (from min diameter up to 2x min snow size). + call create_bins(numbins=nbi, lowbin=D0i*1.0_dp, highbin=D0s*2.0_dp, & + bins=Di, deltabins=dti) + + ! Create bins of rain (from min diameter up to 5 mm). + call create_bins(numbins=nbr, lowbin=D0r*1.0_dp, highbin=0.005_dp, & + bins=Dr, deltabins=dtr) + + ! Create bins of snow (from min diameter up to 2 cm). + call create_bins(numbins=nbs, lowbin=D0s*1.0_dp, highbin=0.02_dp, & + bins=Ds, deltabins=dts) + + ! Create bins of graupel (from min diameter up to 5 cm). + call create_bins(numbins=nbg, lowbin=D0g*1.0_dp, highbin=0.05_dp, & + bins=Dg, deltabins=dtg) + + ! Create bins of cloud droplet number concentration (1 to 3000 per cc). + call create_bins(numbins=nbc, lowbin=1.0_dp, highbin=3000.0_dp, & + bins=t_Nc) + t_Nc = t_Nc * 1.0e6_dp + nic1 = log(t_Nc(nbc)/t_Nc(1)) + + !================================================================================================================= + ! Create lookup tables for most costly calculations + + ! Assign mpicomm to module variable + mpi_communicator = mpicomm + + ! Standard tables are only written by master MPI task; + ! (physics init cannot be called by multiple threads, + ! hence no need to test for a specific thread number) + if (mpirank==mpiroot) then + thompson_table_writer = .true. + else + thompson_table_writer = .false. + end if + + precomputed_tables_1: if (.not.precomputed_tables) then + + call cpu_time(stime) + + do m = 1, ntb_r + do k = 1, ntb_r1 + do n = 1, dimNRHG + do j = 1, ntb_g + do i = 1, ntb_g1 + tcg_racg(i,j,n,k,m) = 0.0_dp + tmr_racg(i,j,n,k,m) = 0.0_dp + tcr_gacr(i,j,n,k,m) = 0.0_dp + tnr_racg(i,j,n,k,m) = 0.0_dp + tnr_gacr(i,j,n,k,m) = 0.0_dp + enddo + enddo + enddo + enddo + enddo + + do m = 1, ntb_r + do k = 1, ntb_r1 + do j = 1, ntb_t + do i = 1, ntb_s + tcs_racs1(i,j,k,m) = 0.0_dp + tmr_racs1(i,j,k,m) = 0.0_dp + tcs_racs2(i,j,k,m) = 0.0_dp + tmr_racs2(i,j,k,m) = 0.0_dp + tcr_sacr1(i,j,k,m) = 0.0_dp + tms_sacr1(i,j,k,m) = 0.0_dp + tcr_sacr2(i,j,k,m) = 0.0_dp + tms_sacr2(i,j,k,m) = 0.0_dp + tnr_racs1(i,j,k,m) = 0.0_dp + tnr_racs2(i,j,k,m) = 0.0_dp + tnr_sacr1(i,j,k,m) = 0.0_dp + tnr_sacr2(i,j,k,m) = 0.0_dp + enddo + enddo + enddo + enddo + + do m = 1, ntb_IN + do k = 1, ntb_t1 + do j = 1, ntb_r1 + do i = 1, ntb_r + tpi_qrfz(i,j,k,m) = 0.0_dp + tni_qrfz(i,j,k,m) = 0.0_dp + tpg_qrfz(i,j,k,m) = 0.0_dp + tnr_qrfz(i,j,k,m) = 0.0_dp + enddo + enddo + do j = 1, nbc + do i = 1, ntb_c + tpi_qcfz(i,j,k,m) = 0.0_dp + tni_qcfz(i,j,k,m) = 0.0_dp + enddo + enddo + enddo + enddo + + do j = 1, ntb_i1 + do i = 1, ntb_i + tps_iaus(i,j) = 0.0_dp + tni_iaus(i,j) = 0.0_dp + tpi_ide(i,j) = 0.0_dp + enddo + enddo + + do j = 1, nbc + do i = 1, nbr + t_Efrw(i,j) = 0.0 + enddo + do i = 1, nbs + t_Efsw(i,j) = 0.0 + enddo + enddo + + do k = 1, ntb_r + do j = 1, ntb_r1 + do i = 1, nbr + tnr_rev(i,j,k) = 0.0_dp + enddo + enddo + enddo + + do k = 1, nbc + do j = 1, ntb_c + do i = 1, nbc + tpc_wev(i,j,k) = 0.0_dp + tnc_wev(i,j,k) = 0.0_dp + enddo + enddo + enddo + + do m = 1, ntb_ark + do l = 1, ntb_arr + do k = 1, ntb_art + do j = 1, ntb_arw + do i = 1, ntb_arc + tnccn_act(i,j,k,l,m) = 1.0 + enddo + enddo + enddo + enddo + enddo + + if (mpirank==mpiroot) write (*,*)'creating microphysics lookup tables ... ' + if (mpirank==mpiroot) write (*,'(a, f5.2, a, f5.2, a, f5.2, a, f5.2)') & + ' using: mu_c_o=',mu_c_o,' mu_i=',mu_i,' mu_r=',mu_r,' mu_g=',mu_g + + !> - Call table_ccnact() to read a static file containing CCN activation of aerosols. The + !! data were created from a parcel model by Feingold & Heymsfield with + !! further changes by Eidhammer and Kriedenweis + if (mpirank==mpiroot) write(*,*) ' calling table_ccnAct routine' + call table_ccnAct(errmsg, errflg) + if (.not. errflg==0) return + + !> - Call table_efrw() and table_efsw() to creat collision efficiency table + !! between rain/snow and cloud water + if (mpirank==mpiroot) write(*,*) ' creating qc collision eff tables' + call table_Efrw + call table_Efsw + + !> - Call table_dropevap() to creat rain drop evaporation table + if (mpirank==mpiroot) write(*,*) ' creating rain evap table' + call table_dropEvap + + !> - Call qi_aut_qs() to create conversion of some ice mass into snow category + if (mpirank==mpiroot) write(*,*) ' creating ice converting to snow table' + call qi_aut_qs + + call cpu_time(etime) + if (mpirank==mpiroot) print '("Calculating TEMPO tables part 1 took ",f10.3," seconds.")', etime-stime + + end if precomputed_tables_1 + + !> - Call radar_init() to initialize various constants for computing radar reflectivity + call cpu_time(stime) + xam_r = am_r + xbm_r = bm_r + xmu_r = mu_r + xam_s = am_s + xbm_s = bm_s + xmu_s = mu_s + xam_g = am_g(idx_bg1) + xbm_g = bm_g + xmu_g = mu_g + call radar_init + call cpu_time(etime) + if (mpirank==mpiroot) print '("Calling radar_init took ",f10.3," seconds.")', etime-stime + + if_not_iiwarm: if (.not. iiwarm) then + + precomputed_tables_2: if (.not.precomputed_tables) then + + call cpu_time(stime) + + !> - Call qr_acr_qg() to create rain collecting graupel & graupel collecting rain table + if (mpirank==mpiroot) write(*,*) ' creating rain collecting graupel table' + call cpu_time(stime) + if (dimNRHG == NRHG) then + call qr_acr_qg_par(dimNRHG, qr_acr_qg_hailaware_file) + using_hail_aware_table = .true. + else + call qr_acr_qg_par(dimNRHG, qr_acr_qg_file) + endif + call cpu_time(etime) + if (mpirank==mpiroot) print '("Computing rain collecting graupel table took ",f10.3," seconds.")', etime-stime + + !> - Call qr_acr_qs() to create rain collecting snow & snow collecting rain table + if (mpirank==mpiroot) write (*,*) ' creating rain collecting snow table' + call cpu_time(stime) + call qr_acr_qs_par + call cpu_time(etime) + if (mpirank==mpiroot) print '("Computing rain collecting snow table took ",f10.3," seconds.")', etime-stime + + !> - Call freezeh2o() to create cloud water and rain freezing (Bigg, 1953) table + if (mpirank==mpiroot) write(*,*) ' creating freezing of water drops table' + call cpu_time(stime) + call freezeH2O_par(threads) + call cpu_time(etime) + if (mpirank==mpiroot) print '("Computing freezing of water drops table took ",f10.3," seconds.")', etime-stime + + call cpu_time(etime) + if (mpirank==mpiroot) print '("Calculating TEMPO tables part 2 took ",f10.3," seconds.")', etime-stime + + end if precomputed_tables_2 + + endif if_not_iiwarm + + if (mpirank==mpiroot) write(*,*) ' ... DONE microphysical lookup tables' + + endif if_micro_init + + end subroutine tempo_init + + !================================================================================================================= + ! This is a wrapper routine designed to transfer values from 3D to 1D. + ! Required microphysics variables are qv, qc, qr, nr, qi, ni, qs, qg + ! Optional microphysics variables are aerosol aware (nc, nwfa, nifa, nwfa2d, nifa2d), and hail aware (ng, qg) + + subroutine tempo_3d_to_1d_driver(qv, qc, qr, qi, qs, qg, qb, ni, nr, nc, ng, & + nwfa, nifa, nwfa2d, nifa2d, & + tt, th, pii, & + p, w, dz, dt_in, dt_inner, & + sedi_semi, decfl, lsm, & + RAINNC, RAINNCV, & + SNOWNC, SNOWNCV, & + ICENC, ICENCV, & + GRAUPELNC, GRAUPELNCV, SR, & + refl_10cm, diagflag, do_radar_ref, & + max_hail_diam_sfc, & + vt_dbz_wt, first_time_step, & + re_cloud, re_ice, re_snow, & + has_reqc, has_reqi, has_reqs, & + aero_ind_fdb, rand_perturb_on, & + kme_stoch, & + rand_pert, spp_prt_list, spp_var_list, & + spp_stddev_cutoff, n_var_spp, & + ids,ide, jds,jde, kds,kde, & ! domain dims + ims,ime, jms,jme, kms,kme, & ! memory dims + its,ite, jts,jte, kts,kte, & ! tile dims + fullradar_diag, istep, nsteps, & + errmsg, errflg, & + ! Extended diagnostics, array pointers + ! only associated if ext_diag flag is .true. + ext_diag, & + !vts1, txri, txrc, & + prw_vcdc, & + prw_vcde, tpri_inu, tpri_ide_d, & + tpri_ide_s, tprs_ide, tprs_sde_d, & + tprs_sde_s, tprg_gde_d, & + tprg_gde_s, tpri_iha, tpri_wfz, & + tpri_rfz, tprg_rfz, tprs_scw, tprg_scw, & + tprg_rcs, tprs_rcs, & + tprr_rci, tprg_rcg, & + tprw_vcd_c, tprw_vcd_e, tprr_sml, & + tprr_gml, tprr_rcg, & + tprr_rcs, tprv_rev, tten3, qvten3, & + qrten3, qsten3, qgten3, qiten3, niten3, & + nrten3, ncten3, qcten3, & + pfils, pflls) + + !..Subroutine arguments + integer, intent(in):: ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte + real(wp), dimension(ims:ime, kms:kme, jms:jme), intent(inout):: & + qv, qc, qr, qi, qs, qg, ni, nr + real(wp), dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: & + tt, th + real(wp), dimension(ims:ime, kms:kme, jms:jme), optional, intent(in):: & + pii + real(wp), dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: & + nc, nwfa, nifa, qb, ng + real(wp), dimension(ims:ime, jms:jme), optional, intent(in):: nwfa2d, nifa2d + integer, dimension(ims:ime, jms:jme), intent(in):: lsm + real(wp), dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: & + re_cloud, re_ice, re_snow + real(wp), dimension(ims:ime, kms:kme, jms:jme), intent(inout):: pfils, pflls + integer, intent(in) :: rand_perturb_on, kme_stoch, n_var_spp + real(wp), dimension(:,:), optional, intent(in) :: rand_pert + real(wp), dimension(:), optional, intent(in) :: spp_prt_list + real(wp), dimension(:), intent(in), optional :: spp_stddev_cutoff + character(len=10), optional, dimension(:), intent(in) :: spp_var_list + integer, intent(in):: has_reqc, has_reqi, has_reqs + + real(wp), dimension(ims:ime, kms:kme, jms:jme), intent(in):: & + p, w, dz + real(wp), dimension(ims:ime, jms:jme), intent(inout):: & + RAINNC, RAINNCV, SR + real(wp), dimension(ims:ime, jms:jme), optional, intent(inout):: & + SNOWNC, SNOWNCV, & + ICENC, ICENCV, & + GRAUPELNC, GRAUPELNCV + real(wp), dimension(ims:ime, kms:kme, jms:jme), intent(inout):: & + refl_10cm + real(wp), dimension(ims:ime, jms:jme), intent(inout):: & + max_hail_diam_sfc + real(wp), dimension(ims:ime, kms:kme, jms:jme), optional, intent(inout):: & + vt_dbz_wt + logical, intent(in) :: first_time_step + real(wp), intent(in):: dt_in, dt_inner + logical, intent(in) :: sedi_semi + integer, intent(in) :: decfl + ! To support subcycling: current step and maximum number of steps + integer, intent (in) :: istep, nsteps + logical, intent (in) :: fullradar_diag + ! Extended diagnostics, array pointers only associated if ext_diag flag is .true. + logical, intent (in) :: ext_diag + logical, optional, intent(in):: aero_ind_fdb + real(wp), optional, dimension(:,:,:), intent(inout):: & + !vts1, txri, txrc, & + prw_vcdc, & + prw_vcde, tpri_inu, tpri_ide_d, & + tpri_ide_s, tprs_ide, & + tprs_sde_d, tprs_sde_s, tprg_gde_d, & + tprg_gde_s, tpri_iha, tpri_wfz, & + tpri_rfz, tprg_rfz, tprs_scw, tprg_scw, & + tprg_rcs, tprs_rcs, & + tprr_rci, tprg_rcg, & + tprw_vcd_c, tprw_vcd_e, tprr_sml, & + tprr_gml, tprr_rcg, & + tprr_rcs, tprv_rev, tten3, qvten3, & + qrten3, qsten3, qgten3, qiten3, niten3, & + nrten3, ncten3, qcten3 + + !..Local variables + real(wp), dimension(kts:kte):: & + qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, qb1d, & + ni1d, nr1d, nc1d, ng1d, nwfa1d, nifa1d, & + t1d, p1d, w1d, dz1d, rho, dBZ, pfil1, pfll1 + !..Extended diagnostics, single column arrays + real(wp), dimension(:), allocatable:: & + !vtsk1, txri1, txrc1, & + prw_vcdc1, & + prw_vcde1, tpri_inu1, tpri_ide1_d, & + tpri_ide1_s, tprs_ide1, & + tprs_sde1_d, tprs_sde1_s, tprg_gde1_d, & + tprg_gde1_s, tpri_iha1, tpri_wfz1, & + tpri_rfz1, tprg_rfz1, tprs_scw1, tprg_scw1,& + tprg_rcs1, tprs_rcs1, & + tprr_rci1, tprg_rcg1, & + tprw_vcd1_c, tprw_vcd1_e, tprr_sml1, & + tprr_gml1, tprr_rcg1, & + tprr_rcs1, tprv_rev1, tten1, qvten1, & + qrten1, qsten1, qgten1, qiten1, niten1, & + nrten1, ncten1, qcten1 + + real(wp), dimension(kts:kte):: re_qc1d, re_qi1d, re_qs1d + + real(wp), dimension(its:ite, jts:jte):: pcp_ra, pcp_sn, pcp_gr, pcp_ic + real(wp) :: dt, pptrain, pptsnow, pptgraul, pptice + real(wp) :: qc_max, qr_max, qs_max, qi_max, qg_max, ni_max, nr_max + real(wp) :: ygra1, zans1 + real(dp) :: lamg, lam_exp, lamr, N0_min, N0_exp + integer:: lsml + real(wp) :: rand1, rand2, rand3, rand_pert_max + integer:: i, j, k, m + integer:: imax_qc,imax_qr,imax_qi,imax_qs,imax_qg,imax_ni,imax_nr + integer:: jmax_qc,jmax_qr,jmax_qi,jmax_qs,jmax_qg,jmax_ni,jmax_nr + integer:: kmax_qc,kmax_qr,kmax_qi,kmax_qs,kmax_qg,kmax_ni,kmax_nr + integer:: i_start, j_start, i_end, j_end + logical, optional, intent(in) :: diagflag + integer, optional, intent(in) :: do_radar_ref + logical :: melti = .false. + integer :: ndt, it + + ! CCPP error handling + character(len=*), optional, intent( out) :: errmsg + integer, optional, intent( out) :: errflg + + ! CCPP + if (present(errmsg)) errmsg = '' + if (present(errflg)) errflg = 0 + + ! No need to test for every subcycling step + test_only_once: if (first_time_step .and. istep==1) then + ! Activate this code when removing the guard above + + if ( (present(tt) .and. (present(th) .or. present(pii))) .or. & + (.not.present(tt) .and. .not.(present(th) .and. present(pii))) ) then + if (present(errmsg) .and. present(errflg)) then + write(errmsg, '(a)') 'Logic error in tempo_3d_to_1d_driver: provide either tt or th+pii' + errflg = 1 + return + else + write(*,'(a)') 'Logic error in tempo_3d_to_1d_driver: provide either tt or th+pii' + stop + end if + end if + + if (configs%aerosol_aware .and. (.not.present(nc) .or. & + .not.present(nwfa) .or. & + .not.present(nifa) .or. & + .not.present(nwfa2d) .or. & + .not.present(nifa2d) )) then + if (present(errmsg) .and. present(errflg)) then + write(errmsg, '(*(a))') 'Logic error in tempo_3d_to_1d_driver: provide nc, nwfa, nifa, nwfa2d', & + ' and nifa2d for aerosol-aware version of TEMPO microphysics' + errflg = 1 + return + else + write(*, '(*(a))') 'Logic error in tempo_3d_to_1d_driver: provide nc, nwfa, nifa, nwfa2d', & + ' and nifa2d for aerosol-aware version of TEMPO microphysics' + stop + end if + else if (merra2_aerosol_aware .and. (.not.present(nc) .or. & + .not.present(nwfa) .or. & + .not.present(nifa) )) then + if (present(errmsg) .and. present(errflg)) then + write(errmsg, '(*(a))') 'Logic error in tempo_3d_to_1d_driver: provide nc, nwfa, and nifa', & + ' for merra2 aerosol-aware version of TEMPO microphysics' + errflg = 1 + return + else + write(*, '(*(a))') 'Logic error in tempo_3d_to_1d_driver: provide nc, nwfa, and nifa', & + ' for merra2 aerosol-aware version of TEMPO microphysics' + stop + end if + else if (.not.configs%aerosol_aware .and. .not.merra2_aerosol_aware .and. & + (present(nwfa) .or. present(nifa) .or. present(nwfa2d) .or. present(nifa2d))) then + write(*,*) 'WARNING, nc/nwfa/nifa/nwfa2d/nifa2d present but is_aerosol_aware/merra2_aerosol_aware are FALSE' + end if + end if test_only_once + + ! These must be alwyas allocated + !allocate (vtsk1(kts:kte)) + !allocate (txri1(kts:kte)) + !allocate (txrc1(kts:kte)) + allocate_extended_diagnostics: if (ext_diag) then + allocate (prw_vcdc1(kts:kte)) + allocate (prw_vcde1(kts:kte)) + allocate (tpri_inu1(kts:kte)) + allocate (tpri_ide1_d(kts:kte)) + allocate (tpri_ide1_s(kts:kte)) + allocate (tprs_ide1(kts:kte)) + allocate (tprs_sde1_d(kts:kte)) + allocate (tprs_sde1_s(kts:kte)) + allocate (tprg_gde1_d(kts:kte)) + allocate (tprg_gde1_s(kts:kte)) + allocate (tpri_iha1(kts:kte)) + allocate (tpri_wfz1(kts:kte)) + allocate (tpri_rfz1(kts:kte)) + allocate (tprg_rfz1(kts:kte)) + allocate (tprs_scw1(kts:kte)) + allocate (tprg_scw1(kts:kte)) + allocate (tprg_rcs1(kts:kte)) + allocate (tprs_rcs1(kts:kte)) + allocate (tprr_rci1(kts:kte)) + allocate (tprg_rcg1(kts:kte)) + allocate (tprw_vcd1_c(kts:kte)) + allocate (tprw_vcd1_e(kts:kte)) + allocate (tprr_sml1(kts:kte)) + allocate (tprr_gml1(kts:kte)) + allocate (tprr_rcg1(kts:kte)) + allocate (tprr_rcs1(kts:kte)) + allocate (tprv_rev1(kts:kte)) + allocate (tten1(kts:kte)) + allocate (qvten1(kts:kte)) + allocate (qrten1(kts:kte)) + allocate (qsten1(kts:kte)) + allocate (qgten1(kts:kte)) + allocate (qiten1(kts:kte)) + allocate (niten1(kts:kte)) + allocate (nrten1(kts:kte)) + allocate (ncten1(kts:kte)) + allocate (qcten1(kts:kte)) + else + allocate (prw_vcdc1 (0)) + allocate (prw_vcde1 (0)) + allocate (tpri_inu1 (0)) + allocate (tpri_ide1_d(0)) + allocate (tpri_ide1_s(0)) + allocate (tprs_ide1 (0)) + allocate (tprs_sde1_d(0)) + allocate (tprs_sde1_s(0)) + allocate (tprg_gde1_d(0)) + allocate (tprg_gde1_s(0)) + allocate (tpri_iha1 (0)) + allocate (tpri_wfz1 (0)) + allocate (tpri_rfz1 (0)) + allocate (tprg_rfz1 (0)) + allocate (tprs_scw1 (0)) + allocate (tprg_scw1 (0)) + allocate (tprg_rcs1 (0)) + allocate (tprs_rcs1 (0)) + allocate (tprr_rci1 (0)) + allocate (tprg_rcg1 (0)) + allocate (tprw_vcd1_c(0)) + allocate (tprw_vcd1_e(0)) + allocate (tprr_sml1 (0)) + allocate (tprr_gml1 (0)) + allocate (tprr_rcg1 (0)) + allocate (tprr_rcs1 (0)) + allocate (tprv_rev1 (0)) + allocate (tten1 (0)) + allocate (qvten1 (0)) + allocate (qrten1 (0)) + allocate (qsten1 (0)) + allocate (qgten1 (0)) + allocate (qiten1 (0)) + allocate (niten1 (0)) + allocate (nrten1 (0)) + allocate (ncten1 (0)) + allocate (qcten1 (0)) + end if allocate_extended_diagnostics + + !+---+ + i_start = its + j_start = jts + i_end = ite + j_end = jte + + !..For idealized testing by developer. + ! if ( (ide-ids+1).gt.4 .and. (jde-jds+1).lt.4 .and. & + ! ids.eq.its.and.ide.eq.ite.and.jds.eq.jts.and.jde.eq.jte) then + ! i_start = its + 2 + ! i_end = ite + ! j_start = jts + ! j_end = jte + ! endif + + ! dt = dt_in + RAINNC(:,:) = 0.0 + SNOWNC(:,:) = 0.0 + ICENC(:,:) = 0.0 + GRAUPELNC(:,:) = 0.0 + pcp_ra(:,:) = 0.0 + pcp_sn(:,:) = 0.0 + pcp_gr(:,:) = 0.0 + pcp_ic(:,:) = 0.0 + pfils(:,:,:) = 0.0 + pflls(:,:,:) = 0.0 + rand_pert_max = 0.0 + ndt = max(nint(dt_in/dt_inner),1) + dt = dt_in/ndt + if(dt_in .le. dt_inner) dt= dt_in + + !Get the Thompson MP SPP magnitude and standard deviation cutoff, + !then compute rand_pert_max + + if (rand_perturb_on .ne. 0) then + do k =1,n_var_spp + select case (spp_var_list(k)) + case('mp') + rand_pert_max = spp_prt_list(k)*spp_stddev_cutoff(k) + end select + enddo + endif + + do it = 1, ndt + + qc_max = 0. + qr_max = 0. + qs_max = 0. + qi_max = 0. + qg_max = 0 + ni_max = 0. + nr_max = 0. + imax_qc = 0 + imax_qr = 0 + imax_qi = 0 + imax_qs = 0 + imax_qg = 0 + imax_ni = 0 + imax_nr = 0 + jmax_qc = 0 + jmax_qr = 0 + jmax_qi = 0 + jmax_qs = 0 + jmax_qg = 0 + jmax_ni = 0 + jmax_nr = 0 + kmax_qc = 0 + kmax_qr = 0 + kmax_qi = 0 + kmax_qs = 0 + kmax_qg = 0 + kmax_ni = 0 + kmax_nr = 0 + + j_loop: do j = j_start, j_end + i_loop: do i = i_start, i_end + + !+---+-----------------------------------------------------------------+ + !..Introduce stochastic parameter perturbations by creating as many scalar rand1, rand2, ... + !.. variables as needed to perturb different pieces of microphysics. gthompsn 21Mar2018 + ! Setting spp_mp_opt to 1 gives graupel Y-intercept pertubations (2^0) + ! 2 gives cloud water distribution gamma shape parameter perturbations (2^1) + ! 4 gives CCN & IN activation perturbations (2^2) + ! 3 gives both 1+2 + ! 5 gives both 1+4 + ! 6 gives both 2+4 + ! 7 gives all 1+2+4 + ! For now (22Mar2018), standard deviation should be up to 0.75 and cut-off at 3.0 + ! stddev in order to constrain the various perturbations from being too extreme. + !+---+-----------------------------------------------------------------+ + rand1 = 0.0 + rand2 = 0.0 + rand3 = 0.0 + if (rand_perturb_on .ne. 0) then + if (MOD(rand_perturb_on,2) .ne. 0) rand1 = rand_pert(i,1) + m = RSHIFT(ABS(rand_perturb_on),1) + if (MOD(m,2) .ne. 0) rand2 = rand_pert(i,1)*2. + m = RSHIFT(ABS(rand_perturb_on),2) + if (MOD(m,2) .ne. 0) rand3 = 0.25*(rand_pert(i,1)+rand_pert_max) + m = RSHIFT(ABS(rand_perturb_on),3) + endif + !+---+-----------------------------------------------------------------+ + + pptrain = 0. + pptsnow = 0. + pptgraul = 0. + pptice = 0. + RAINNCV(i,j) = 0. + IF ( PRESENT (snowncv) ) THEN + SNOWNCV(i,j) = 0. + ENDIF + IF ( PRESENT (icencv) ) THEN + ICENCV(i,j) = 0. + ENDIF + IF ( PRESENT (graupelncv) ) THEN + GRAUPELNCV(i,j) = 0. + ENDIF + SR(i,j) = 0. + + do k = kts, kte + if (present(tt)) then + t1d(k) = tt(i,k,j) + else + t1d(k) = th(i,k,j)*pii(i,k,j) + end if + p1d(k) = p(i,k,j) + w1d(k) = w(i,k,j) + dz1d(k) = dz(i,k,j) + qv1d(k) = qv(i,k,j) + qc1d(k) = qc(i,k,j) + qi1d(k) = qi(i,k,j) + qr1d(k) = qr(i,k,j) + qs1d(k) = qs(i,k,j) + qg1d(k) = qg(i,k,j) + ni1d(k) = ni(i,k,j) + nr1d(k) = nr(i,k,j) + rho(k) = RoverRv * p1d(k) / (R * t1d(k) * (qv1d(k)+RoverRv)) + + ! These arrays are always allocated and must be initialized + !vtsk1(k) = 0. + !txrc1(k) = 0. + !txri1(k) = 0. + initialize_extended_diagnostics: if (ext_diag) then + prw_vcdc1(k) = 0. + prw_vcde1(k) = 0. + tpri_inu1(k) = 0. + tpri_ide1_d(k) = 0. + tpri_ide1_s(k) = 0. + tprs_ide1(k) = 0. + tprs_sde1_d(k) = 0. + tprs_sde1_s(k) = 0. + tprg_gde1_d(k) = 0. + tprg_gde1_s(k) = 0. + tpri_iha1(k) = 0. + tpri_wfz1(k) = 0. + tpri_rfz1(k) = 0. + tprg_rfz1(k) = 0. + tprs_scw1(k) = 0. + tprg_scw1(k) = 0. + tprg_rcs1(k) = 0. + tprs_rcs1(k) = 0. + tprr_rci1(k) = 0. + tprg_rcg1(k) = 0. + tprw_vcd1_c(k) = 0. + tprw_vcd1_e(k) = 0. + tprr_sml1(k) = 0. + tprr_gml1(k) = 0. + tprr_rcg1(k) = 0. + tprr_rcs1(k) = 0. + tprv_rev1(k) = 0. + tten1(k) = 0. + qvten1(k) = 0. + qrten1(k) = 0. + qsten1(k) = 0. + qgten1(k) = 0. + qiten1(k) = 0. + niten1(k) = 0. + nrten1(k) = 0. + ncten1(k) = 0. + qcten1(k) = 0. + endif initialize_extended_diagnostics + enddo + lsml = lsm(i,j) + if (configs%aerosol_aware .or. merra2_aerosol_aware) then + do k = kts, kte + nc1d(k) = nc(i,k,j) + nwfa1d(k) = nwfa(i,k,j) + nifa1d(k) = nifa(i,k,j) + enddo + else + do k = kts, kte + if(lsml == 1) then + nc1d(k) = Nt_c_l / rho(k) + else + nc1d(k) = Nt_c_o / rho(k) + endif + nwfa1d(k) = nwfa_default + nifa1d(k) = nifa_default + enddo + endif + + ! ng and qb are optional hail-aware variables + if ((present(ng)) .and. (present(qb))) then + configs%hail_aware = .true. + do k = kts, kte + ng1d(k) = ng(i,k,j) + qb1d(k) = qb(i,k,j) + enddo + else + do k = kte, kts, -1 + ! This is the one-moment graupel formulation + if (qg1d(k) > R1) then + ygra1 = log10(max(1.e-9, qg1d(k)*rho(k))) + zans1 = 3.4 + 2.0/7.0*(ygra1+8.0) + ! zans1 = max(2.0, min(zans1, 6.0)) + N0_exp = max(gonv_min, min(10.0**(zans1), gonv_max)) + lam_exp = (n0_exp*am_g(idx_bg1)*cgg(1,1) / (rho(k)*qg1d(k)))**oge1 + lamg = lam_exp * (cgg(3,1)*ogg2*ogg1)**obmg + ng1d(k) = cgg(2,1) * ogg3*rho(k) * qg1d(k) * lamg**bm_g / am_g(idx_bg1) + ng1d(k) = max(R2, (ng1d(k)/rho(k))) + qb1d(k) = qg1d(k) / rho_g(idx_bg1) + else + ng1d(k) = 0 + qb1d(k) = 0 + endif + enddo + endif + + !> - Call mp_thompson() + call mp_tempo_main(qv1d=qv1d, qc1d=qc1d, qi1d=qi1d, qr1d=qr1d, qs1d=qs1d, qg1d=qg1d, qb1d=qb1d, & + ni1d=ni1d, nr1d=nr1d, nc1d=nc1d, ng1d=ng1d, nwfa1d=nwfa1d, nifa1d=nifa1d, t1d=t1d, p1d=p1d, & + w1d=w1d, dzq=dz1d, pptrain=pptrain, pptsnow=pptsnow, pptgraul=pptgraul, pptice=pptice, & + rand1=rand1, rand2=rand3, rand3=rand3, & + ext_diag=ext_diag, sedi_semi=sedi_semi, decfl=decfl, & + prw_vcdc1=prw_vcdc1, & + prw_vcde1=prw_vcde1, & + tpri_inu1=tpri_inu1, tpri_ide1_d=tpri_ide1_d, tpri_ide1_s=tpri_ide1_s, tprs_ide1=tprs_ide1, & + tprs_sde1_d=tprs_sde1_d, tprs_sde1_s=tprs_sde1_s, & + tprg_gde1_d=tprg_gde1_d, tprg_gde1_s=tprg_gde1_s, tpri_iha1=tpri_iha1, tpri_wfz1=tpri_wfz1, & + tpri_rfz1=tpri_rfz1, tprg_rfz1=tprg_rfz1, tprs_scw1=tprs_scw1, tprg_scw1=tprg_scw1, & + tprg_rcs1=tprg_rcs1, tprs_rcs1=tprs_rcs1, tprr_rci1=tprr_rci1, & + tprg_rcg1=tprg_rcg1, tprw_vcd1_c=tprw_vcd1_c, & + tprw_vcd1_e=tprw_vcd1_e, tprr_sml1=tprr_sml1, tprr_gml1=tprr_gml1, tprr_rcg1=tprr_rcg1, & + tprr_rcs1=tprr_rcs1, tprv_rev1=tprv_rev1, & + tten1=tten1, qvten1=qvten1, qrten1=qrten1, qsten1=qsten1, & + qgten1=qgten1, qiten1=qiten1, niten1=niten1, nrten1=nrten1, ncten1=ncten1, qcten1=qcten1, & + pfil1=pfil1, pfll1=pfll1, lsml=lsml, & + kts=kts, kte=kte, dt=dt, ii=i, jj=j, configs=configs) + + + pcp_ra(i,j) = pcp_ra(i,j) + pptrain + pcp_sn(i,j) = pcp_sn(i,j) + pptsnow + pcp_gr(i,j) = pcp_gr(i,j) + pptgraul + pcp_ic(i,j) = pcp_ic(i,j) + pptice + RAINNCV(i,j) = pptrain + pptsnow + pptgraul + pptice + RAINNC(i,j) = RAINNC(i,j) + pptrain + pptsnow + pptgraul + pptice + IF ( PRESENT(snowncv) .AND. PRESENT(snownc) ) THEN + ! Add ice to snow if separate ice not present + IF ( .NOT.PRESENT(icencv) .OR. .NOT.PRESENT(icenc) ) THEN + SNOWNCV(i,j) = pptsnow + pptice + SNOWNC(i,j) = SNOWNC(i,j) + pptsnow + pptice + ELSE + SNOWNCV(i,j) = pptsnow + SNOWNC(i,j) = SNOWNC(i,j) + pptsnow + ENDIF + ENDIF + ! Use separate ice if present (as in FV3) + IF ( PRESENT(icencv) .AND. PRESENT(icenc) ) THEN + ICENCV(i,j) = pptice + ICENC(i,j) = ICENC(i,j) + pptice + ENDIF + IF ( PRESENT(graupelncv) .AND. PRESENT(graupelnc) ) THEN + GRAUPELNCV(i,j) = pptgraul + GRAUPELNC(i,j) = GRAUPELNC(i,j) + pptgraul + ENDIF + SR(i,j) = (pptsnow + pptgraul + pptice)/(RAINNCV(i,j)+1.e-12) + + + + !..Reset lowest model level to initial state aerosols (fake sfc source). + !.. Changed 13 May 2013 to fake emissions in which nwfa2d is aerosol + !.. number tendency (number per kg per second). + if (configs%aerosol_aware) then + if ( present (aero_ind_fdb) ) then + if ( .not. aero_ind_fdb) then + nwfa1d(kts) = nwfa1d(kts) + nwfa2d(i,j)*dt + nifa1d(kts) = nifa1d(kts) + nifa2d(i,j)*dt + endif + else + nwfa1d(kts) = nwfa1d(kts) + nwfa2d(i,j)*dt + nifa1d(kts) = nifa1d(kts) + nifa2d(i,j)*dt + end if + + do k = kts, kte + nc(i,k,j) = nc1d(k) + nwfa(i,k,j) = nwfa1d(k) + nifa(i,k,j) = nifa1d(k) + enddo + endif + + if (merra2_aerosol_aware) then + do k = kts, kte + nc(i,k,j) = nc1d(k) + nwfa(i,k,j) = nwfa1d(k) + nifa(i,k,j) = nifa1d(k) + enddo + endif + + if ((present(ng)) .and. (present(qb))) then + do k = kts, kte + ng(i,k,j) = ng1d(k) + qb(i,k,j) = qb1d(k) + enddo + endif + + do k = kts, kte + qv(i,k,j) = qv1d(k) + qc(i,k,j) = qc1d(k) + qi(i,k,j) = qi1d(k) + qr(i,k,j) = qr1d(k) + qs(i,k,j) = qs1d(k) + qg(i,k,j) = qg1d(k) + ni(i,k,j) = ni1d(k) + nr(i,k,j) = nr1d(k) + pfils(i,k,j) = pfils(i,k,j) + pfil1(k) + pflls(i,k,j) = pflls(i,k,j) + pfll1(k) + if (present(tt)) then + tt(i,k,j) = t1d(k) + else + th(i,k,j) = t1d(k)/pii(i,k,j) + endif + + if (qc1d(k) .gt. qc_max) then + imax_qc = i + jmax_qc = j + kmax_qc = k + qc_max = qc1d(k) + elseif (qc1d(k) .lt. 0.0) then + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qc ', qc1d(k), & + ' at i,j,k=', i,j,k + endif + if (qr1d(k) .gt. qr_max) then + imax_qr = i + jmax_qr = j + kmax_qr = k + qr_max = qr1d(k) + elseif (qr1d(k) .lt. 0.0) then + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qr ', qr1d(k), & + ' at i,j,k=', i,j,k + endif + if (nr1d(k) .gt. nr_max) then + imax_nr = i + jmax_nr = j + kmax_nr = k + nr_max = nr1d(k) + elseif (nr1d(k) .lt. 0.0) then + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative nr ', nr1d(k), & + ' at i,j,k=', i,j,k + endif + if (qs1d(k) .gt. qs_max) then + imax_qs = i + jmax_qs = j + kmax_qs = k + qs_max = qs1d(k) + elseif (qs1d(k) .lt. 0.0) then + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qs ', qs1d(k), & + ' at i,j,k=', i,j,k + endif + if (qi1d(k) .gt. qi_max) then + imax_qi = i + jmax_qi = j + kmax_qi = k + qi_max = qi1d(k) + elseif (qi1d(k) .lt. 0.0) then + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qi ', qi1d(k), & + ' at i,j,k=', i,j,k + endif + if (qg1d(k) .gt. qg_max) then + imax_qg = i + jmax_qg = j + kmax_qg = k + qg_max = qg1d(k) + elseif (qg1d(k) .lt. 0.0) then + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qg ', qg1d(k), & + ' at i,j,k=', i,j,k + endif + if (ni1d(k) .gt. ni_max) then + imax_ni = i + jmax_ni = j + kmax_ni = k + ni_max = ni1d(k) + elseif (ni1d(k) .lt. 0.0) then + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative ni ', ni1d(k), & + ' at i,j,k=', i,j,k + endif + if (qv1d(k) .lt. 0.0) then + write(*,'(a,e16.7,a,3i8)') 'WARNING, negative qv ', qv1d(k), & + ' at i,j,k=', i,j,k + if (k.lt.kte-2 .and. k.gt.kts+1) then + write(*,*) ' below and above are: ', qv(i,k-1,j), qv(i,k+1,j) + qv(i,k,j) = max(1.e-7, 0.5*(qv(i,k-1,j) + qv(i,k+1,j))) + else + qv(i,k,j) = 1.e-7 + endif + endif + enddo + + assign_extended_diagnostics: if (ext_diag) then + do k=kts,kte + !vts1(i,k,j) = vtsk1(k) + !txri(i,k,j) = txri(i,k,j) + txri1(k) + !txrc(i,k,j) = txrc(i,k,j) + txrc1(k) + prw_vcdc(i,k,j) = prw_vcdc(i,k,j) + prw_vcdc1(k) + prw_vcde(i,k,j) = prw_vcde(i,k,j) + prw_vcde1(k) + tpri_inu(i,k,j) = tpri_inu(i,k,j) + tpri_inu1(k) + tpri_ide_d(i,k,j) = tpri_ide_d(i,k,j) + tpri_ide1_d(k) + tpri_ide_s(i,k,j) = tpri_ide_s(i,k,j) + tpri_ide1_s(k) + tprs_ide(i,k,j) = tprs_ide(i,k,j) + tprs_ide1(k) + tprs_sde_s(i,k,j) = tprs_sde_s(i,k,j) + tprs_sde1_s(k) + tprs_sde_d(i,k,j) = tprs_sde_d(i,k,j) + tprs_sde1_d(k) + tprg_gde_d(i,k,j) = tprg_gde_d(i,k,j) + tprg_gde1_d(k) + tprg_gde_s(i,k,j) = tprg_gde_s(i,k,j) + tprg_gde1_s(k) + tpri_iha(i,k,j) = tpri_iha(i,k,j) + tpri_iha1(k) + tpri_wfz(i,k,j) = tpri_wfz(i,k,j) + tpri_wfz1(k) + tpri_rfz(i,k,j) = tpri_rfz(i,k,j) + tpri_rfz1(k) + tprg_rfz(i,k,j) = tprg_rfz(i,k,j) + tprg_rfz1(k) + tprs_scw(i,k,j) = tprs_scw(i,k,j) + tprs_scw1(k) + tprg_scw(i,k,j) = tprg_scw(i,k,j) + tprg_scw1(k) + tprg_rcs(i,k,j) = tprg_rcs(i,k,j) + tprg_rcs1(k) + tprs_rcs(i,k,j) = tprs_rcs(i,k,j) + tprs_rcs1(k) + tprr_rci(i,k,j) = tprr_rci(i,k,j) + tprr_rci1(k) + tprg_rcg(i,k,j) = tprg_rcg(i,k,j) + tprg_rcg1(k) + tprw_vcd_c(i,k,j) = tprw_vcd_c(i,k,j) + tprw_vcd1_c(k) + tprw_vcd_e(i,k,j) = tprw_vcd_e(i,k,j) + tprw_vcd1_e(k) + tprr_sml(i,k,j) = tprr_sml(i,k,j) + tprr_sml1(k) + tprr_gml(i,k,j) = tprr_gml(i,k,j) + tprr_gml1(k) + tprr_rcg(i,k,j) = tprr_rcg(i,k,j) + tprr_rcg1(k) + tprr_rcs(i,k,j) = tprr_rcs(i,k,j) + tprr_rcs1(k) + tprv_rev(i,k,j) = tprv_rev(i,k,j) + tprv_rev1(k) + tten3(i,k,j) = tten3(i,k,j) + tten1(k) + qvten3(i,k,j) = qvten3(i,k,j) + qvten1(k) + qrten3(i,k,j) = qrten3(i,k,j) + qrten1(k) + qsten3(i,k,j) = qsten3(i,k,j) + qsten1(k) + qgten3(i,k,j) = qgten3(i,k,j) + qgten1(k) + qiten3(i,k,j) = qiten3(i,k,j) + qiten1(k) + niten3(i,k,j) = niten3(i,k,j) + niten1(k) + nrten3(i,k,j) = nrten3(i,k,j) + nrten1(k) + ncten3(i,k,j) = ncten3(i,k,j) + ncten1(k) + qcten3(i,k,j) = qcten3(i,k,j) + qcten1(k) + + enddo + endif assign_extended_diagnostics + + if (ndt>1 .and. it==ndt) then + + SR(i,j) = (pcp_sn(i,j) + pcp_gr(i,j) + pcp_ic(i,j))/(RAINNC(i,j)+1.e-12) + RAINNCV(i,j) = RAINNC(i,j) + IF ( PRESENT (snowncv) ) THEN + SNOWNCV(i,j) = SNOWNC(i,j) + ENDIF + IF ( PRESENT (icencv) ) THEN + ICENCV(i,j) = ICENC(i,j) + ENDIF + IF ( PRESENT (graupelncv) ) THEN + GRAUPELNCV(i,j) = GRAUPELNC(i,j) + ENDIF + endif + + ! Diagnostic calculations only for last step + ! if Thompson MP is called multiple times + last_step_only: IF ((ndt>1 .and. it==ndt) .or. & + (nsteps>1 .and. istep==nsteps) .or. & + (nsteps==1 .and. ndt==1)) THEN + +!! max_hail_diam_sfc(i,j) = hail_mass_99th_percentile(kts, kte, qg1d, t1d, p1d, qv1d) + + !> - Call calc_refl10cm() + + diagflag_present: IF ( PRESENT (diagflag) ) THEN + if (diagflag .and. do_radar_ref == 1) then + ! + ! Only set melti to true at the output times + if (fullradar_diag) then + melti=.true. + else + melti=.false. + endif + ! + if (present(vt_dbz_wt)) then + call calc_refl10cm (qv1d=qv1d, qc1d=qc1d, qr1d=qr1d, nr1d=nr1d, qs1d=qs1d, qg1d=qg1d, & + ng1d=ng1d, qb1d=qb1d, t1d=t1d, p1d=p1d, dBZ=dBZ, rand1=rand1, kts=kts, kte=kte, ii=i, jj=j, & + melti=melti, vt_dBZ=vt_dbz_wt(i,:,j), & + first_time_step=first_time_step, configs=configs) + else + call calc_refl10cm (qv1d=qv1d, qc1d=qc1d, qr1d=qr1d, nr1d=nr1d, qs1d=qs1d, qg1d=qg1d, & + ng1d=ng1d, qb1d=qb1d, t1d=t1d, p1d=p1d, dBZ=dBZ, rand1=rand1, kts=kts, kte=kte, ii=i, jj=j, & + melti=melti, configs=configs) + end if + do k = kts, kte + refl_10cm(i,k,j) = max(-35., dBZ(k)) + enddo + endif + ENDIF diagflag_present + + IF (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) THEN + do k = kts, kte + re_qc1d(k) = re_qc_min + re_qi1d(k) = re_qi_min + re_qs1d(k) = re_qs_min + enddo + !> - Call calc_effectrad() + call calc_effectRad (t1d=t1d, p1d=p1d, qv1d=qv1d, qc1d=qc1d, & + nc1d=nc1d, qi1d=qi1d, ni1d=ni1d, qs1d=qs1d, & + re_qc1d=re_qc1d, re_qi1d=re_qi1d, re_qs1d=re_qs1d, & + kts=kts, kte=kte, lsml=lsml, configs=configs) + do k = kts, kte + re_cloud(i,k,j) = max(re_qc_min, min(re_qc1d(k), re_qc_max)) + re_ice(i,k,j) = max(re_qi_min, min(re_qi1d(k), re_qi_max)) + re_snow(i,k,j) = max(re_qs_min, min(re_qs1d(k), re_qs_max)) + enddo + ENDIF + ENDIF last_step_only + + enddo i_loop + enddo j_loop + + ! DEBUG - GT + ! write(*,'(a,7(a,e13.6,1x,a,i3,a,i3,a,i3,a,1x))') 'MP-GT:', & + ! 'qc: ', qc_max, '(', imax_qc, ',', jmax_qc, ',', kmax_qc, ')', & + ! 'qr: ', qr_max, '(', imax_qr, ',', jmax_qr, ',', kmax_qr, ')', & + ! 'qi: ', qi_max, '(', imax_qi, ',', jmax_qi, ',', kmax_qi, ')', & + ! 'qs: ', qs_max, '(', imax_qs, ',', jmax_qs, ',', kmax_qs, ')', & + ! 'qg: ', qg_max, '(', imax_qg, ',', jmax_qg, ',', kmax_qg, ')', & + ! 'ni: ', ni_max, '(', imax_ni, ',', jmax_ni, ',', kmax_ni, ')', & + ! 'nr: ', nr_max, '(', imax_nr, ',', jmax_nr, ',', kmax_nr, ')' + ! END DEBUG - GT + enddo ! end of nt loop + + do j = j_start, j_end + do k = kts, kte + do i = i_start, i_end + pfils(i,k,j) = pfils(i,k,j)/dt_in + pflls(i,k,j) = pflls(i,k,j)/dt_in + enddo + enddo + enddo + + ! These are always allocated + !deallocate (vtsk1) + !deallocate (txri1) + !deallocate (txrc1) + deallocate_extended_diagnostics: if (ext_diag) then + deallocate (prw_vcdc1) + deallocate (prw_vcde1) + deallocate (tpri_inu1) + deallocate (tpri_ide1_d) + deallocate (tpri_ide1_s) + deallocate (tprs_ide1) + deallocate (tprs_sde1_d) + deallocate (tprs_sde1_s) + deallocate (tprg_gde1_d) + deallocate (tprg_gde1_s) + deallocate (tpri_iha1) + deallocate (tpri_wfz1) + deallocate (tpri_rfz1) + deallocate (tprg_rfz1) + deallocate (tprs_scw1) + deallocate (tprg_scw1) + deallocate (tprg_rcs1) + deallocate (tprs_rcs1) + deallocate (tprr_rci1) + deallocate (tprg_rcg1) + deallocate (tprw_vcd1_c) + deallocate (tprw_vcd1_e) + deallocate (tprr_sml1) + deallocate (tprr_gml1) + deallocate (tprr_rcg1) + deallocate (tprr_rcs1) + deallocate (tprv_rev1) + deallocate (tten1) + deallocate (qvten1) + deallocate (qrten1) + deallocate (qsten1) + deallocate (qgten1) + deallocate (qiten1) + deallocate (niten1) + deallocate (nrten1) + deallocate (ncten1) + deallocate (qcten1) + end if deallocate_extended_diagnostics + + END SUBROUTINE tempo_3d_to_1d_driver + !> @} + + !>\ingroup aathompson + SUBROUTINE tempo_finalize() + + IMPLICIT NONE + + if (ALLOCATED(tcg_racg)) DEALLOCATE(tcg_racg) + if (ALLOCATED(tmr_racg)) DEALLOCATE(tmr_racg) + if (ALLOCATED(tcr_gacr)) DEALLOCATE(tcr_gacr) + if (ALLOCATED(tnr_racg)) DEALLOCATE(tnr_racg) + if (ALLOCATED(tnr_gacr)) DEALLOCATE(tnr_gacr) + + if (ALLOCATED(tcs_racs1)) DEALLOCATE(tcs_racs1) + if (ALLOCATED(tmr_racs1)) DEALLOCATE(tmr_racs1) + if (ALLOCATED(tcs_racs2)) DEALLOCATE(tcs_racs2) + if (ALLOCATED(tmr_racs2)) DEALLOCATE(tmr_racs2) + if (ALLOCATED(tcr_sacr1)) DEALLOCATE(tcr_sacr1) + if (ALLOCATED(tms_sacr1)) DEALLOCATE(tms_sacr1) + if (ALLOCATED(tcr_sacr2)) DEALLOCATE(tcr_sacr2) + if (ALLOCATED(tms_sacr2)) DEALLOCATE(tms_sacr2) + if (ALLOCATED(tnr_racs1)) DEALLOCATE(tnr_racs1) + if (ALLOCATED(tnr_racs2)) DEALLOCATE(tnr_racs2) + if (ALLOCATED(tnr_sacr1)) DEALLOCATE(tnr_sacr1) + if (ALLOCATED(tnr_sacr2)) DEALLOCATE(tnr_sacr2) + + if (ALLOCATED(tpi_qcfz)) DEALLOCATE(tpi_qcfz) + if (ALLOCATED(tni_qcfz)) DEALLOCATE(tni_qcfz) + + if (ALLOCATED(tpi_qrfz)) DEALLOCATE(tpi_qrfz) + if (ALLOCATED(tpg_qrfz)) DEALLOCATE(tpg_qrfz) + if (ALLOCATED(tni_qrfz)) DEALLOCATE(tni_qrfz) + if (ALLOCATED(tnr_qrfz)) DEALLOCATE(tnr_qrfz) + + if (ALLOCATED(tps_iaus)) DEALLOCATE(tps_iaus) + if (ALLOCATED(tni_iaus)) DEALLOCATE(tni_iaus) + if (ALLOCATED(tpi_ide)) DEALLOCATE(tpi_ide) + + if (ALLOCATED(t_Efrw)) DEALLOCATE(t_Efrw) + if (ALLOCATED(t_Efsw)) DEALLOCATE(t_Efsw) + + if (ALLOCATED(tnr_rev)) DEALLOCATE(tnr_rev) + if (ALLOCATED(tpc_wev)) DEALLOCATE(tpc_wev) + if (ALLOCATED(tnc_wev)) DEALLOCATE(tnc_wev) + + if (ALLOCATED(tnccn_act)) DEALLOCATE(tnccn_act) + + END SUBROUTINE tempo_finalize + +end module module_mp_tempo + !+---+-----------------------------------------------------------------+ + !ctrlL + !+---+-----------------------------------------------------------------+ + !+---+-----------------------------------------------------------------+ + diff --git a/physics/MP/TEMPO/mp_tempo.F90 b/physics/MP/TEMPO/mp_tempo.F90 new file mode 100644 index 000000000..174eaac2e --- /dev/null +++ b/physics/MP/TEMPO/mp_tempo.F90 @@ -0,0 +1,1126 @@ +!>\file mp_tempo.F90 +!! This file contains aerosol-aware TEMPO MP scheme. + + +!>\defgroup aatempo Aerosol-Aware TEMPO MP Module +!! This module contains the aerosol-aware TEMPO microphysics scheme. +module mp_tempo + + use mpi_f08 + use machine, only : kind_phys + + use module_mp_tempo_params + use module_mp_tempo_utils, only : make_IceNumber, make_RainNumber, make_DropletNumber + use module_mp_tempo, only : tempo_init, tempo_3d_to_1d_driver, tempo_finalize + + implicit none + + public :: mp_tempo_init, mp_tempo_run, mp_tempo_finalize + + private + + integer, parameter :: ext_ndiag3d = 37 + + contains + +!> This subroutine is a wrapper around the actual tempo_init(). +!! \section arg_table_mp_tempo_init Argument Table +!! \htmlinclude mp_tempo_init.html +!! + subroutine mp_tempo_init(ncol, nlev, con_pi, con_t0c, con_rv, & + con_cp, con_rgas, con_boltz, con_amd, & + con_amw, con_avgd, con_hvap, con_hfus, & + con_g, con_rd, con_eps, & + restart, imp_physics, & + imp_physics_tempo, convert_dry_rho, & + spechum, qc, qr, qi, qs, qg, ni, nr, & + chw, vh, & + is_aerosol_aware, merra2_aerosol_aware, & + is_hail_aware, & + nc, nwfa2d, nifa2d, & + nwfa, nifa, tgrs, prsl, phil, area, & + aerfld, mpicomm, mpirank, mpiroot, & + threads, ext_diag, diag3d, & + is_initialized, errmsg, errflg) + + implicit none + + ! Interface variables + integer, intent(in ) :: ncol + integer, intent(in ) :: nlev + real(kind_phys), intent(in ) :: con_pi, con_t0c, con_rv, con_cp, con_rgas, & + con_boltz, con_amd, con_amw, con_avgd, & + con_hvap, con_hfus, con_g, con_rd, con_eps + logical, intent(in ) :: restart + logical, intent(inout) :: is_initialized + integer, intent(in ) :: imp_physics + integer, intent(in ) :: imp_physics_tempo + ! Hydrometeors + logical, intent(in ) :: convert_dry_rho + real(kind_phys), intent(inout) :: spechum(:,:) + real(kind_phys), intent(inout) :: qc(:,:) + real(kind_phys), intent(inout) :: qr(:,:) + real(kind_phys), intent(inout) :: qi(:,:) + real(kind_phys), intent(inout) :: qs(:,:) + real(kind_phys), intent(inout) :: qg(:,:) + real(kind_phys), intent(inout) :: ni(:,:) + real(kind_phys), intent(inout) :: nr(:,:) + real(kind_phys), intent(inout), optional :: chw(:,:), vh(:,:) + ! Aerosols + logical, intent(in ) :: is_aerosol_aware + logical, intent(in ) :: merra2_aerosol_aware + logical, intent(in ) :: is_hail_aware + real(kind_phys), intent(inout), optional :: nc(:,:) + real(kind_phys), intent(inout), optional :: nwfa(:,:) + real(kind_phys), intent(inout), optional :: nifa(:,:) + real(kind_phys), intent(inout), optional :: nwfa2d(:) + real(kind_phys), intent(inout), optional :: nifa2d(:) + real(kind_phys), intent(in) :: aerfld(:,:,:) + ! State variables + real(kind_phys), intent(in ) :: tgrs(:,:) + real(kind_phys), intent(in ) :: prsl(:,:) + real(kind_phys), intent(in ) :: phil(:,:) + real(kind_phys), intent(in ) :: area(:) + ! MPI information + type(MPI_Comm), intent(in ) :: mpicomm + integer, intent(in ) :: mpirank + integer, intent(in ) :: mpiroot + ! Threading/blocking information + integer, intent(in ) :: threads + ! Extended diagnostics + logical, intent(in ) :: ext_diag + real(kind_phys), intent(in ), optional :: diag3d(:,:,:) + ! CCPP error handling + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! + real(kind_phys) :: qv(1:ncol,1:nlev) ! kg kg-1 (water vapor mixing ratio) + real(kind_phys) :: hgt(1:ncol,1:nlev) ! m + real(kind_phys) :: rho(1:ncol,1:nlev) ! kg m-3 + real(kind_phys) :: orho(1:ncol,1:nlev) ! m3 kg-1 + real(kind_phys) :: nc_local(1:ncol,1:nlev) ! needed because nc is only allocated if is_aerosol_aware is true + ! + real (kind=kind_phys) :: h_01, z1, niIN3, niCCN3 + integer :: i, k + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + ! Consistency checks + if (imp_physics/=imp_physics_tempo) then + write(errmsg,'(*(a))') "Logic error: namelist choice of microphysics is different from TEMPO MP" + errflg = 1 + return + end if + + if (ext_diag) then + if (size(diag3d,dim=3) /= ext_ndiag3d) then + write(errmsg,'(*(a))') "Logic error: number of diagnostic 3d arrays from model does not match requirements" + errflg = 1 + return + end if + end if + + if (is_aerosol_aware .and. merra2_aerosol_aware) then + write(errmsg,'(*(a))') "Logic error: Only one TEMPO aerosol option can be true, either is_aerosol_aware or merra2_aerosol_aware)" + errflg = 1 + return + end if + + ! Call TEMPO init (also sets initial default values of physical constants) + if (mpirank==mpiroot) write(*,*) 'Calling tempo_init() with is_aerosol_aware = ', is_aerosol_aware + + call tempo_init(is_aerosol_aware_in=is_aerosol_aware, & + merra2_aerosol_aware_in=merra2_aerosol_aware, & + is_hail_aware_in=is_hail_aware, & + mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & + threads=threads, errmsg=errmsg, errflg=errflg) + if (errflg /= 0) return + + ! For restart runs, the init is done here + if (restart) then + is_initialized = .true. + return + end if + + ! Set local TEMPO MP module constants from host model and overwrite derived constants calculated in module_mp_tempo_params/mp_tempo_params_init() + PI = con_pi + lvap0 = con_hvap + lfus = con_hfus + lsub = lvap0 + lfus + olfus = 1./lfus + + Rv = con_Rv + R = con_rd + RoverRv = con_eps + Cp2 = con_cp + T_0 = con_t0c + R_uni = con_rgas + k_b = con_boltz + N_avo = con_avgd + + oRv = 1.0 / Rv + am_r = PI * rho_w2 / 6.0 + am_i = PI * rho_i / 6.0 + am_g = (/PI*rho_g(1)/6.0, & + PI*rho_g(2)/6.0, & + PI*rho_g(3)/6.0, & + PI*rho_g(4)/6.0, & + PI*rho_g(5)/6.0, & + PI*rho_g(6)/6.0, & + PI*rho_g(7)/6.0, & + PI*rho_g(8)/6.0, & + PI*rho_g(9)/6.0/) + + M_w = con_amw*1.0E-3 !module_mp_tempo expects kg/mol + M_a = con_amd*1.0E-3 !module_mp_tempo expects kg/mol + ma_w = M_w/N_avo + + ar_volume = 4.0 / 3.0 * PI * (2.5e-6)**3 + + ! Geopotential height in m2 s-2 to height in m + hgt = phil/con_g + + ! Ensure non-negative mass mixing ratios of all water variables + where(spechum<0) spechum = 1.0E-10 ! COMMENT, gthompsn, spechum should *never* be identically zero. + where(qc<0) qc = 0.0 + where(qr<0) qr = 0.0 + where(qi<0) qi = 0.0 + where(qs<0) qs = 0.0 + where(qg<0) qg = 0.0 + + !> - Convert specific humidity to water vapor mixing ratio. + !> - Also, hydrometeor variables are mass or number mixing ratio + !> - either kg of species per kg of dry air, or per kg of (dry + vapor). + if (merra2_aerosol_aware) then + call get_niwfa(aerfld, nifa, nwfa, ncol, nlev) + end if + + + qv = spechum/(1.0_kind_phys-spechum) + + if (convert_dry_rho) then + qc = qc/(1.0_kind_phys-spechum) + qr = qr/(1.0_kind_phys-spechum) + qi = qi/(1.0_kind_phys-spechum) + qs = qs/(1.0_kind_phys-spechum) + qg = qg/(1.0_kind_phys-spechum) + + ni = ni/(1.0_kind_phys-spechum) + nr = nr/(1.0_kind_phys-spechum) + if (is_hail_aware) then + chw = chw/(1.0_kind_phys-spechum) + vh = vh/(1.0_kind_phys-spechum) + endif + if (is_aerosol_aware .or. merra2_aerosol_aware) then + nc = nc/(1.0_kind_phys-spechum) + nwfa = nwfa/(1.0_kind_phys-spechum) + nifa = nifa/(1.0_kind_phys-spechum) + end if + end if + + ! Density of moist air in kg m-3 and inverse density of air + rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps)) + orho = 1.0/rho + + ! Ensure we have 1st guess ice number where mass non-zero but no number. + where(qi .LE. 0.0) ni=0.0 + where(qi .GT. 0 .and. ni .LE. 0.0) ni = make_IceNumber(qi*rho, tgrs) * orho + where(qi .EQ. 0.0 .and. ni .GT. 0.0) ni=0.0 + + ! Ensure we have 1st guess rain number where mass non-zero but no number. + where(qr .LE. 0.0) nr=0.0 + where(qr .GT. 0 .and. nr .LE. 0.0) nr = make_RainNumber(qr*rho, tgrs) * orho + where(qr .EQ. 0.0 .and. nr .GT. 0.0) nr=0.0 + + if (is_hail_aware) then + where(qg .LE. 0.0) chw=0.0 + where(qg .LE. 0.0) vh=0.0 + endif + + !..Check for existing aerosol data, both CCN and IN aerosols. If missing + !.. fill in just a basic vertical profile, somewhat boundary-layer following. + if (is_aerosol_aware) then + + ! Potential cloud condensation nuclei (CCN) + if (MAXVAL(nwfa) .lt. eps) then + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosols.' + do i = 1, ncol + if (hgt(i,1).le.1000.0) then + h_01 = 0.8 + elseif (hgt(i,1).ge.2500.0) then + h_01 = 0.01 + else + h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) + endif + niCCN3 = -1.0*ALOG(naCCN1/naCCN0)/h_01 + nwfa(i,1) = naCCN1+naCCN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niCCN3) + z1 = hgt(i,2)-hgt(i,1) + nwfa2d(i) = nwfa(i,1) * 0.000196 * (50./z1) + do k = 2, nlev + nwfa(i,k) = naCCN1+naCCN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niCCN3) + enddo + enddo + else + if (mpirank==mpiroot) write(*,*) ' Apparently initial CCN aerosols are present.' + if (MAXVAL(nwfa2d) .lt. eps) then + !+---+-----------------------------------------------------------------+ + !..Scale the lowest level aerosol data into an emissions rate. This is + !.. very far from ideal, but need higher emissions where larger amount + !.. of (climo) existing and lesser emissions where there exists fewer to + !.. begin as a first-order simplistic approach. Later, proper connection to + !.. emission inventory would be better, but, for now, scale like this: + !.. where: Nwfa=50 per cc, emit 0.875E4 aerosols per second per grid box unit + !.. that was tested as ~(20kmx20kmx50m = 2.E10 m**-3) + !+---+-----------------------------------------------------------------+ + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.' + do i = 1, ncol + z1 = hgt(i,2)-hgt(i,1) + nwfa2d(i) = nwfa(i,1) * 0.000196 * (50./z1) + enddo + else + if (mpirank==mpiroot) write(*,*) ' Apparently initial CCN aerosol surface emission rates are present.' + endif + endif + + ! Potential ice nuclei (IN) + if (MAXVAL(nifa) .lt. eps) then + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial IN aerosols.' + do i = 1, ncol + if (hgt(i,1).le.1000.0) then + h_01 = 0.8 + elseif (hgt(i,1).ge.2500.0) then + h_01 = 0.01 + else + h_01 = 0.8*cos(hgt(i,1)*0.001 - 1.0) + endif + niIN3 = -1.0*ALOG(naIN1/naIN0)/h_01 + nifa(i,1) = naIN1+naIN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niIN3) + nifa2d(i) = 0. + do k = 2, nlev + nifa(i,k) = naIN1+naIN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niIN3) + enddo + enddo + else + if (mpirank==mpiroot) write(*,*) ' Apparently initial IN aerosols are present.' + if (MAXVAL(nifa2d) .lt. eps) then + if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial IN aerosol surface emission rates, set to zero.' + ! calculate IN surface flux here, right now just set to zero + nifa2d = 0. + else + if (mpirank==mpiroot) write(*,*) ' Apparently initial IN aerosol surface emission rates are present.' + endif + endif + + ! Ensure we have 1st guess cloud droplet number where mass non-zero but no number. + where(qc .LE. 0.0) nc=0.0 + where(qc .GT. 0 .and. nc .LE. 0.0) nc = make_DropletNumber(qc*rho, nwfa*rho) * orho + where(qc .EQ. 0.0 .and. nc .GT. 0.0) nc = 0.0 + + ! Ensure non-negative aerosol number concentrations. + where(nwfa .LE. 0.0) nwfa = 1.1E6 + where(nifa .LE. 0.0) nifa = naIN1*0.01 + + ! Copy to local array for calculating cloud effective radii below + nc_local = nc + + else if (merra2_aerosol_aware) then + + ! Ensure we have 1st guess cloud droplet number where mass non-zero but no number. + where(qc .LE. 0.0) nc=0.0 + where(qc .GT. 0 .and. nc .LE. 0.0) nc = make_DropletNumber(qc*rho, nwfa*rho) * orho + where(qc .EQ. 0.0 .and. nc .GT. 0.0) nc = 0.0 + + else + + ! Constant droplet concentration for single moment cloud water as in + ! module_mp_thompson.F90, only needed for effective radii calculation + nc_local = Nt_c_l/rho + + end if + + if (convert_dry_rho) then + !qc = qc/(1.0_kind_phys+qv) + !qr = qr/(1.0_kind_phys+qv) + !qi = qi/(1.0_kind_phys+qv) + !qs = qs/(1.0_kind_phys+qv) + !qg = qg/(1.0_kind_phys+qv) + + ni = ni/(1.0_kind_phys+qv) + nr = nr/(1.0_kind_phys+qv) + if (is_hail_aware) then + chw = chw/(1.0_kind_phys+qv) + vh = vh/(1.0_kind_phys+qv) + endif + if (is_aerosol_aware .or. merra2_aerosol_aware) then + nc = nc/(1.0_kind_phys+qv) + nwfa = nwfa/(1.0_kind_phys+qv) + nifa = nifa/(1.0_kind_phys+qv) + end if + end if + + is_initialized = .true. + + end subroutine mp_tempo_init + + +!> \section arg_table_mp_tempo_run Argument Table +!! \htmlinclude mp_tempo_run.html +!! +!>\ingroup aatempo +!>\section gen_tempo_hrrr TEMPO MP General Algorithm +!>@{ + subroutine mp_tempo_run(ncol, nlev, con_g, con_rd, & + con_eps, convert_dry_rho, & + spechum, qc, qr, qi, qs, qg, ni, nr, & + chw, vh, & + is_aerosol_aware, is_hail_aware, & + merra2_aerosol_aware, nc, nwfa, nifa,& + nwfa2d, nifa2d, aero_ind_fdb, & + tgrs, prsl, phii, omega, & + sedi_semi, decfl, islmsk, dtp, & + dt_inner, & + first_time_step, istep, nsteps, & + prcp, rain, graupel, ice, snow, sr, & + refl_10cm, fullradar_diag, & + max_hail_diam_sfc, & + do_radar_ref, aerfld, & + mpicomm, mpirank, mpiroot, blkno, & + ext_diag, diag3d, reset_diag3d, & + spp_wts_mp, spp_mp, n_var_spp, & + spp_prt_list, spp_var_list, & + spp_stddev_cutoff, & + cplchm, pfi_lsan, pfl_lsan, & + is_initialized, errmsg, errflg) + + implicit none + + ! Interface variables + logical, intent(inout) :: is_initialized + ! Dimensions and constants + integer, intent(in ) :: ncol + integer, intent(in ) :: nlev + real(kind_phys), intent(in ) :: con_g + real(kind_phys), intent(in ) :: con_rd + real(kind_phys), intent(in ) :: con_eps + ! Hydrometeors + logical, intent(in ) :: convert_dry_rho + real(kind_phys), intent(inout) :: spechum(:,:) + real(kind_phys), intent(inout) :: qc(:,:) + real(kind_phys), intent(inout) :: qr(:,:) + real(kind_phys), intent(inout) :: qi(:,:) + real(kind_phys), intent(inout) :: qs(:,:) + real(kind_phys), intent(inout) :: qg(:,:) + real(kind_phys), intent(inout) :: ni(:,:) + real(kind_phys), intent(inout) :: nr(:,:) + real(kind_phys), optional, intent(inout) :: chw(:,:), vh(:,:) + ! Aerosols + logical, intent(in) :: is_aerosol_aware, fullradar_diag + logical, intent(in) :: merra2_aerosol_aware, is_hail_aware + real(kind_phys), optional, intent(inout) :: nc(:,:) + real(kind_phys), optional, intent(inout) :: nwfa(:,:) + real(kind_phys), optional, intent(inout) :: nifa(:,:) + real(kind_phys), optional, intent(in ) :: nwfa2d(:) + real(kind_phys), optional, intent(in ) :: nifa2d(:) + real(kind_phys), intent(in) :: aerfld(:,:,:) + logical, optional, intent(in ) :: aero_ind_fdb + ! State variables and timestep information + real(kind_phys), intent(inout) :: tgrs(:,:) + real(kind_phys), intent(in ) :: prsl(:,:) + real(kind_phys), intent(in ) :: phii(:,:) + real(kind_phys), intent(in ) :: omega(:,:) + integer, intent(in ) :: islmsk(:) + real(kind_phys), intent(in ) :: dtp + logical, intent(in ) :: first_time_step + integer, intent(in ) :: istep, nsteps + real, intent(in ) :: dt_inner + ! Precip/rain/snow/graupel fall amounts and fraction of frozen precip + real(kind_phys), intent(inout) :: prcp(:) + real(kind_phys), intent(inout), optional :: rain(:) + real(kind_phys), intent(inout), optional :: graupel(:) + real(kind_phys), intent(inout), optional :: ice(:) + real(kind_phys), intent(inout), optional :: snow(:) + real(kind_phys), intent( out) :: sr(:) + ! Radar reflectivity + real(kind_phys), intent(inout) :: refl_10cm(:,:) + real(kind_phys), intent(inout) :: max_hail_diam_sfc(:) + logical, intent(in ) :: do_radar_ref + logical, intent(in) :: sedi_semi + integer, intent(in) :: decfl + ! MPI and block information + integer, intent(in) :: blkno + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank + integer, intent(in) :: mpiroot + ! Extended diagnostic output + logical, intent(in) :: ext_diag + real(kind_phys), target, intent(inout), optional :: diag3d(:,:,:) + logical, intent(in) :: reset_diag3d + + ! CCPP error handling + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! SPP + integer, intent(in) :: spp_mp + integer, intent(in) :: n_var_spp + real(kind_phys), intent(in), optional :: spp_wts_mp(:,:) + real(kind_phys), intent(in), optional :: spp_prt_list(:) + character(len=10), intent(in), optional :: spp_var_list(:) + real(kind_phys), intent(in), optional :: spp_stddev_cutoff(:) + + logical, intent (in) :: cplchm + ! ice and liquid water 3d precipitation fluxes - only allocated if cplchm is .true. + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfi_lsan + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfl_lsan + + ! Local variables + + ! Reduced time step if subcycling is used + real(kind_phys) :: dtstep + integer :: ndt + ! Air density + real(kind_phys) :: rho(1:ncol,1:nlev) !< kg m-3 + ! Water vapor mixing ratio (instead of specific humidity) + real(kind_phys) :: qv(1:ncol,1:nlev) !< kg kg-1 + ! Vertical velocity and level width + real(kind_phys) :: w(1:ncol,1:nlev) !< m s-1 + real(kind_phys) :: dz(1:ncol,1:nlev) !< m + ! Rain/snow/graupel fall amounts + real(kind_phys) :: rain_mp(1:ncol) ! mm, dummy, not used + real(kind_phys) :: graupel_mp(1:ncol) ! mm, dummy, not used + real(kind_phys) :: ice_mp(1:ncol) ! mm, dummy, not used + real(kind_phys) :: snow_mp(1:ncol) ! mm, dummy, not used + real(kind_phys) :: delta_rain_mp(1:ncol) ! mm + real(kind_phys) :: delta_graupel_mp(1:ncol) ! mm + real(kind_phys) :: delta_ice_mp(1:ncol) ! mm + real(kind_phys) :: delta_snow_mp(1:ncol) ! mm + + real(kind_phys) :: pfils(1:ncol,1:nlev,1) + real(kind_phys) :: pflls(1:ncol,1:nlev,1) + ! Radar reflectivity + logical :: diagflag ! must be true if do_radar_ref is true, not used otherwise + integer :: do_radar_ref_mp ! integer instead of logical do_radar_ref + ! Effective cloud radii - turned off in CCPP (taken care off in radiation) + logical, parameter :: do_effective_radii = .false. + integer, parameter :: has_reqc = 0 + integer, parameter :: has_reqi = 0 + integer, parameter :: has_reqs = 0 + integer, parameter :: kme_stoch = 1 + integer :: spp_mp_opt + ! Dimensions used in mp_gt_driver + integer :: ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte + ! Pointer arrays for extended diagnostics + !real(kind_phys), dimension(:,:,:), pointer :: vts1 => null() + !real(kind_phys), dimension(:,:,:), pointer :: txri => null() + !real(kind_phys), dimension(:,:,:), pointer :: txrc => null() + real(kind_phys), dimension(:,:,:), pointer :: prw_vcdc => null() + real(kind_phys), dimension(:,:,:), pointer :: prw_vcde => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_inu => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_ide_d => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_ide_s => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_ide => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_sde_d => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_sde_s => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_gde_d => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_gde_s => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_iha => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_wfz => null() + real(kind_phys), dimension(:,:,:), pointer :: tpri_rfz => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_rfz => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_scw => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_scw => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_rcs => null() + real(kind_phys), dimension(:,:,:), pointer :: tprs_rcs => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_rci => null() + real(kind_phys), dimension(:,:,:), pointer :: tprg_rcg => null() + real(kind_phys), dimension(:,:,:), pointer :: tprw_vcd_c => null() + real(kind_phys), dimension(:,:,:), pointer :: tprw_vcd_e => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_sml => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_gml => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_rcg => null() + real(kind_phys), dimension(:,:,:), pointer :: tprr_rcs => null() + real(kind_phys), dimension(:,:,:), pointer :: tprv_rev => null() + real(kind_phys), dimension(:,:,:), pointer :: tten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qvten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qrten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qsten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qgten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qiten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: niten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: nrten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: ncten3 => null() + real(kind_phys), dimension(:,:,:), pointer :: qcten3 => null() + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_hail_aware .and. sedi_semi) then + write(errmsg, fmt='((a))') 'Cannot use hail-aware TEMPO with sedi_semi... plese set sedi_semi=.false.' + errflg = 1 + return + endif + + if (first_time_step .and. istep==1 .and. blkno==1) then + ! Check initialization state + if (.not.is_initialized) then + write(errmsg, fmt='((a))') 'mp_tempo_run called before mp_tempo_init' + errflg = 1 + return + end if + ! Check forr optional arguments of aerosol-aware microphysics + if (is_aerosol_aware .and. .not. (present(nc) .and. & + present(nwfa) .and. & + present(nifa) .and. & + present(nwfa2d) .and. & + present(nifa2d) )) then + write(errmsg,fmt='(*(a))') 'Logic error in mp_tempo_run:', & + ' aerosol-aware microphysics require all of the', & + ' following optional arguments:', & + ' nc, nwfa, nifa, nwfa2d, nifa2d' + errflg = 1 + return + else if (merra2_aerosol_aware .and. .not. (present(nc) .and. & + present(nwfa) .and. & + present(nifa) )) then + write(errmsg,fmt='(*(a))') 'Logic error in mp_tempo_run:', & + ' merra2 aerosol-aware microphysics require the', & + ' following optional arguments: nc, nwfa, nifa' + errflg = 1 + return + end if + ! Consistency cheecks - subcycling and inner loop at the same time are not supported + if (nsteps>1 .and. dt_inner < dtp) then + write(errmsg,'(*(a))') "Logic error: Subcycling and inner loop cannot be used at the same time" + errflg = 1 + return + else if (mpirank==mpiroot .and. nsteps>1) then + write(*,'(a,i0,a,a,f6.2,a)') 'TEMPO MP is using ', nsteps, ' substep(s) per time step with an ', & + 'effective time step of ', dtp/real(nsteps, kind=kind_phys), ' seconds' + else if (mpirank==mpiroot .and. dt_inner < dtp) then + ndt = max(nint(dtp/dt_inner),1) + write(*,'(a,i0,a,a,f6.2,a)') 'TEMPO MP is using ', ndt, ' inner loops per time step with an ', & + 'effective time step of ', dtp/real(ndt, kind=kind_phys), ' seconds' + end if + end if + + ! Set stochastic physics selection to apply all perturbations + if ( spp_mp==7 ) then + spp_mp_opt=7 + else + spp_mp_opt=0 + endif + + ! Set reduced time step if subcycling is used + if (nsteps>1) then + dtstep = dtp/real(nsteps, kind=kind_phys) + else + dtstep = dtp + end if + if (merra2_aerosol_aware) then + call get_niwfa(aerfld, nifa, nwfa, ncol, nlev) + end if + + !> - Convert specific humidity to water vapor mixing ratio. + !> - Also, hydrometeor variables are mass or number mixing ratio + !> - either kg of species per kg of dry air, or per kg of (dry + vapor). + + ! DH* - do this only if istep == 1? Would be ok if it was + ! guaranteed that nothing else in the same subcycle group + ! was using these arrays, but it is somewhat dangerous. + qv = spechum/(1.0_kind_phys-spechum) + + if (convert_dry_rho) then + qc = qc/(1.0_kind_phys-spechum) + qr = qr/(1.0_kind_phys-spechum) + qi = qi/(1.0_kind_phys-spechum) + qs = qs/(1.0_kind_phys-spechum) + qg = qg/(1.0_kind_phys-spechum) + + ni = ni/(1.0_kind_phys-spechum) + nr = nr/(1.0_kind_phys-spechum) + if (is_hail_aware) then + chw = chw/(1.0_kind_phys-spechum) + vh = vh/(1.0_kind_phys-spechum) + endif + if (is_aerosol_aware .or. merra2_aerosol_aware) then + nc = nc/(1.0_kind_phys-spechum) + nwfa = nwfa/(1.0_kind_phys-spechum) + nifa = nifa/(1.0_kind_phys-spechum) + end if + end if + ! *DH + + !> - Density of air in kg m-3 + rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps)) + + !> - Convert omega in Pa s-1 to vertical velocity w in m s-1 + w = -omega/(rho*con_g) + + !> - Layer width in m from geopotential in m2 s-2 + dz = (phii(:,2:nlev+1) - phii(:,1:nlev)) / con_g + + ! Accumulated values inside Thompson scheme, not used; + ! only use delta and add to inout variables (different units) + rain_mp = 0 + graupel_mp = 0 + ice_mp = 0 + snow_mp = 0 + delta_rain_mp = 0 + delta_graupel_mp = 0 + delta_ice_mp = 0 + delta_snow_mp = 0 + + ! Flags for calculating radar reflectivity; diagflag is redundant + if (do_radar_ref) then + diagflag = .true. + do_radar_ref_mp = 1 + else + diagflag = .false. + do_radar_ref_mp = 0 + end if + + ! Set internal dimensions + ids = 1 + ims = 1 + its = 1 + ide = ncol + ime = ncol + ite = ncol + jds = 1 + jms = 1 + jts = 1 + jde = 1 + jme = 1 + jte = 1 + kds = 1 + kms = 1 + kts = 1 + kde = nlev + kme = nlev + kte = nlev + if(cplchm) then + pfi_lsan = 0.0 + pfl_lsan = 0.0 + end if + + ! Set pointers for extended diagnostics + set_extended_diagnostic_pointers: if (ext_diag) then + if (reset_diag3d) then + diag3d = 0.0 + end if + !vts1 => diag3d(:,:,X:X) + !txri => diag3d(:,:,X:X) + !txrc => diag3d(:,:,X:X) + prw_vcdc => diag3d(:,:,1:1) + prw_vcde => diag3d(:,:,2:2) + tpri_inu => diag3d(:,:,3:3) + tpri_ide_d => diag3d(:,:,4:4) + tpri_ide_s => diag3d(:,:,5:5) + tprs_ide => diag3d(:,:,6:6) + tprs_sde_d => diag3d(:,:,7:7) + tprs_sde_s => diag3d(:,:,8:8) + tprg_gde_d => diag3d(:,:,9:9) + tprg_gde_s => diag3d(:,:,10:10) + tpri_iha => diag3d(:,:,11:11) + tpri_wfz => diag3d(:,:,12:12) + tpri_rfz => diag3d(:,:,13:13) + tprg_rfz => diag3d(:,:,14:14) + tprs_scw => diag3d(:,:,15:15) + tprg_scw => diag3d(:,:,16:16) + tprg_rcs => diag3d(:,:,17:17) + tprs_rcs => diag3d(:,:,18:18) + tprr_rci => diag3d(:,:,19:19) + tprg_rcg => diag3d(:,:,20:20) + tprw_vcd_c => diag3d(:,:,21:21) + tprw_vcd_e => diag3d(:,:,22:22) + tprr_sml => diag3d(:,:,23:23) + tprr_gml => diag3d(:,:,24:24) + tprr_rcg => diag3d(:,:,25:25) + tprr_rcs => diag3d(:,:,26:26) + tprv_rev => diag3d(:,:,27:27) + tten3 => diag3d(:,:,28:28) + qvten3 => diag3d(:,:,29:29) + qrten3 => diag3d(:,:,30:30) + qsten3 => diag3d(:,:,31:31) + qgten3 => diag3d(:,:,32:32) + qiten3 => diag3d(:,:,33:33) + niten3 => diag3d(:,:,34:34) + nrten3 => diag3d(:,:,35:35) + ncten3 => diag3d(:,:,36:36) + qcten3 => diag3d(:,:,37:37) + else + allocate(prw_vcdc (0,0,0)) + allocate(prw_vcde (0,0,0)) + allocate(tpri_inu (0,0,0)) + allocate(tpri_ide_d (0,0,0)) + allocate(tpri_ide_s (0,0,0)) + allocate(tprs_ide (0,0,0)) + allocate(tprs_sde_d (0,0,0)) + allocate(tprs_sde_s (0,0,0)) + allocate(tprg_gde_d (0,0,0)) + allocate(tprg_gde_s (0,0,0)) + allocate(tpri_iha (0,0,0)) + allocate(tpri_wfz (0,0,0)) + allocate(tpri_rfz (0,0,0)) + allocate(tprg_rfz (0,0,0)) + allocate(tprs_scw (0,0,0)) + allocate(tprg_scw (0,0,0)) + allocate(tprg_rcs (0,0,0)) + allocate(tprs_rcs (0,0,0)) + allocate(tprr_rci (0,0,0)) + allocate(tprg_rcg (0,0,0)) + allocate(tprw_vcd_c (0,0,0)) + allocate(tprw_vcd_e (0,0,0)) + allocate(tprr_sml (0,0,0)) + allocate(tprr_gml (0,0,0)) + allocate(tprr_rcg (0,0,0)) + allocate(tprr_rcs (0,0,0)) + allocate(tprv_rev (0,0,0)) + allocate(tten3 (0,0,0)) + allocate(qvten3 (0,0,0)) + allocate(qrten3 (0,0,0)) + allocate(qsten3 (0,0,0)) + allocate(qgten3 (0,0,0)) + allocate(qiten3 (0,0,0)) + allocate(niten3 (0,0,0)) + allocate(nrten3 (0,0,0)) + allocate(ncten3 (0,0,0)) + allocate(qcten3 (0,0,0)) + end if set_extended_diagnostic_pointers + !> - Call mp_gt_driver() with or without aerosols, with or without effective radii, ... + if (is_aerosol_aware) then + if (is_hail_aware) then + call tempo_3d_to_1d_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, qb=vh, ni=ni, nr=nr, & + nc=nc, ng=chw, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & + tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & + rainnc=rain_mp, rainncv=delta_rain_mp, & + snownc=snow_mp, snowncv=delta_snow_mp, & + icenc=ice_mp, icencv=delta_ice_mp, & + graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & + refl_10cm=refl_10cm, & + diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + max_hail_diam_sfc=max_hail_diam_sfc, & + has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & + aero_ind_fdb=aero_ind_fdb, rand_perturb_on=spp_mp_opt, & + kme_stoch=kme_stoch, & + rand_pert=spp_wts_mp, spp_var_list=spp_var_list, & + spp_prt_list=spp_prt_list, n_var_spp=n_var_spp, & + spp_stddev_cutoff=spp_stddev_cutoff, & + ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & + ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & + its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & + fullradar_diag=fullradar_diag, istep=istep, nsteps=nsteps, & + first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & + ! Extended diagnostics + ext_diag=ext_diag, pfils=pfils, pflls=pflls) + else + +! write(errmsg,'(*(a))') "TEMPO aerosol-aware UNTESTED -- DO NOT USE" +! errflg = 1 +! return + call tempo_3d_to_1d_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & + nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & + tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & + rainnc=rain_mp, rainncv=delta_rain_mp, & + snownc=snow_mp, snowncv=delta_snow_mp, & + icenc=ice_mp, icencv=delta_ice_mp, & + graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & + refl_10cm=refl_10cm, & + diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + max_hail_diam_sfc=max_hail_diam_sfc, & + has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & + aero_ind_fdb=aero_ind_fdb, rand_perturb_on=spp_mp_opt, & + kme_stoch=kme_stoch, & + rand_pert=spp_wts_mp, spp_var_list=spp_var_list, & + spp_prt_list=spp_prt_list, n_var_spp=n_var_spp, & + spp_stddev_cutoff=spp_stddev_cutoff, & + ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & + ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & + its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & + fullradar_diag=fullradar_diag, istep=istep, nsteps=nsteps, & + first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & + ! Extended diagnostics + ext_diag=ext_diag, pfils=pfils, pflls=pflls) + ! ! vts1=vts1, txri=txri, txrc=txrc, & + ! prw_vcdc=prw_vcdc, & + ! prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + ! tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & + ! tprs_sde_d=tprs_sde_d, & + ! tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + ! tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + ! tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + ! tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + ! tprs_rcs=tprs_rcs, & + ! tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & + ! tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + ! tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & + ! tprv_rev=tprv_rev, tten3=tten3, & + ! qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + ! qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + ! qcten3=qcten3, + endif + else if (merra2_aerosol_aware) then + write(errmsg,'(*(a))') "TEMPO aerosol-aware with MERRA2 UNTESTED -- DO NOT USE" + errflg = 1 + return + call tempo_3d_to_1d_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & + nc=nc, nwfa=nwfa, nifa=nifa, & + tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & + rainnc=rain_mp, rainncv=delta_rain_mp, & + snownc=snow_mp, snowncv=delta_snow_mp, & + icenc=ice_mp, icencv=delta_ice_mp, & + graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & + refl_10cm=refl_10cm, & + diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + max_hail_diam_sfc=max_hail_diam_sfc, & + has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & + aero_ind_fdb=aero_ind_fdb, rand_perturb_on=spp_mp_opt, & + kme_stoch=kme_stoch, & + rand_pert=spp_wts_mp, spp_var_list=spp_var_list, & + spp_prt_list=spp_prt_list, n_var_spp=n_var_spp, & + spp_stddev_cutoff=spp_stddev_cutoff, & + ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & + ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & + its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & + fullradar_diag=fullradar_diag, istep=istep, nsteps=nsteps, & + first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & + ! Extended diagnostics + ext_diag=ext_diag, pfils=pfils, pflls=pflls) + ! ! vts1=vts1, txri=txri, txrc=txrc, & + ! prw_vcdc=prw_vcdc, & + ! prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + ! tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & + ! tprs_sde_d=tprs_sde_d, & + ! tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + ! tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + ! tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + ! tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + ! tprs_rcs=tprs_rcs, & + ! tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & + ! tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + ! tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & + ! tprv_rev=tprv_rev, tten3=tten3, & + ! qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + ! qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + ! qcten3=qcten3, + else + call tempo_3d_to_1d_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & + tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & + rainnc=rain_mp, rainncv=delta_rain_mp, & + snownc=snow_mp, snowncv=delta_snow_mp, & + icenc=ice_mp, icencv=delta_ice_mp, & + graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & + refl_10cm=refl_10cm, & + diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + max_hail_diam_sfc=max_hail_diam_sfc, & + has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & + rand_perturb_on=spp_mp_opt, kme_stoch=kme_stoch, & + rand_pert=spp_wts_mp, spp_var_list=spp_var_list, & + spp_prt_list=spp_prt_list, n_var_spp=n_var_spp, & + spp_stddev_cutoff=spp_stddev_cutoff, & + ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & + ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & + its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & + fullradar_diag=fullradar_diag, istep=istep, nsteps=nsteps, & + first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & + ! Extended diagnostics + ext_diag=ext_diag, pfils=pfils, pflls=pflls) + !! vts1=vts1, txri=txri, txrc=txrc, & + ! prw_vcdc=prw_vcdc, & + ! prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + ! tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & + ! tprs_sde_d=tprs_sde_d, & + ! tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + ! tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + ! tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + ! tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + ! tprs_rcs=tprs_rcs, & + ! tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & + ! tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + ! tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & + ! tprv_rev=tprv_rev, tten3=tten3, & + ! qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + ! qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + ! qcten3=qcten3) + end if + if (errflg/=0) return + + ! DH* - do this only if istep == nsteps? Would be ok if it was + ! guaranteed that nothing else in the same subcycle group + ! was using these arrays, but it is somewhat dangerous. + + !> - Convert water vapor mixing ratio back to specific humidity + spechum = qv/(1.0_kind_phys+qv) + + if (convert_dry_rho) then + qc = qc/(1.0_kind_phys+qv) + qr = qr/(1.0_kind_phys+qv) + qi = qi/(1.0_kind_phys+qv) + qs = qs/(1.0_kind_phys+qv) + qg = qg/(1.0_kind_phys+qv) + + ni = ni/(1.0_kind_phys+qv) + nr = nr/(1.0_kind_phys+qv) + if (is_hail_aware) then + chw = chw/(1.0_kind_phys+qv) + vh = vh/(1.0_kind_phys+qv) + endif + if (is_aerosol_aware .or. merra2_aerosol_aware) then + nc = nc/(1.0_kind_phys+qv) + nwfa = nwfa/(1.0_kind_phys+qv) + nifa = nifa/(1.0_kind_phys+qv) + end if + end if + ! *DH + + !> - Convert rainfall deltas from mm to m (on physics timestep); add to inout variables + ! "rain" in Thompson MP refers to precipitation (total of liquid rainfall+snow+graupel+ice) + prcp = prcp + max(0.0, delta_rain_mp/1000.0_kind_phys) + graupel = graupel + max(0.0, delta_graupel_mp/1000.0_kind_phys) + ice = ice + max(0.0, delta_ice_mp/1000.0_kind_phys) + snow = snow + max(0.0, delta_snow_mp/1000.0_kind_phys) + rain = rain + max(0.0, (delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp))/1000.0_kind_phys) + + ! Recompute sr at last subcycling step + if (nsteps>1 .and. istep == nsteps) then + ! Unlike inside mp_gt_driver, rain does not contain frozen precip + sr = (snow + graupel + ice)/(rain + snow + graupel + ice +1.e-12) + end if + + ! output instantaneous ice/snow and rain water 3d precipitation fluxes + if(cplchm) then + pfi_lsan(:,:) = pfils(:,:,1) + pfl_lsan(:,:) = pflls(:,:,1) + end if + + ! DH* Not really needed because they go out of scope ... + ! But having them in here seems to cause problems with Intel? + ! It looked like this is also nullifying the pointers passed + ! from the CCPP caps. + !unset_extended_diagnostic_pointers: if (ext_diag) then + ! !vts1 => null() + ! !txri => null() + ! !txrc => null() + ! prw_vcdc => null() + ! prw_vcde => null() + ! tpri_inu => null() + ! tpri_ide_d => null() + ! tpri_ide_s => null() + ! tprs_ide => null() + ! tprs_sde_d => null() + ! tprs_sde_s => null() + ! tprg_gde_d => null() + ! tprg_gde_s => null() + ! tpri_iha => null() + ! tpri_wfz => null() + ! tpri_rfz => null() + ! tprg_rfz => null() + ! tprs_scw => null() + ! tprg_scw => null() + ! tprg_rcs => null() + ! tprs_rcs => null() + ! tprr_rci => null() + ! tprg_rcg => null() + ! tprw_vcd_c => null() + ! tprw_vcd_e => null() + ! tprr_sml => null() + ! tprr_gml => null() + ! tprr_rcg => null() + ! tprr_rcs => null() + ! tprv_rev => null() + ! tten3 => null() + ! qvten3 => null() + ! qrten3 => null() + ! qsten3 => null() + ! qgten3 => null() + ! qiten3 => null() + ! niten3 => null() + ! nrten3 => null() + ! ncten3 => null() + ! qcten3 => null() + !end if unset_extended_diagnostic_pointers + ! *DH + + end subroutine mp_tempo_run +!>@} + +!> \section arg_table_mp_tempo_finalize Argument Table +!! \htmlinclude mp_tempo_finalize.html +!! + subroutine mp_tempo_finalize(is_initialized, errmsg, errflg) + + implicit none + logical, intent(inout) :: is_initialized + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.is_initialized) return + + call tempo_finalize() + + is_initialized = .false. + + end subroutine mp_tempo_finalize + + subroutine get_niwfa(aerfld, nifa, nwfa, ncol, nlev) + ! To calculate nifa and nwfa from bins of aerosols. + ! In GOCART and MERRA2, aerosols are given as mixing ratio (kg/kg). To + ! convert from kg/kg to #/kg, the "unit mass" (mass of one particle) + ! within the mass bins is calculated. A lognormal size distribution + ! within aerosol bins is used to find the size based upon the median + ! mass. NIFA is mainly summarized over five dust bins and NWFA over the + ! other 10 bins. The parameters besides each bins are carefully tuned + ! for a good performance of the scheme. + ! + ! The fields for the last index of the aerfld array + ! are specified as below. + ! 1: dust bin 1, 0.1 to 1.0 micrometers + ! 2: dust bin 2, 1.0 to 1.8 micrometers + ! 3: dust bin 3, 1.8 to 3.0 micrometers + ! 4: dust bin 4, 3.0 to 6.0 micrometers + ! 5: dust bin 5, 6.0 to 10.0 micrometers + ! 6: sea salt bin 1, 0.03 to 0.1 micrometers + ! 7: sea salt bin 2, 0.1 to 0.5 micrometers + ! 8: sea salt bin 3, 0.5 to 1.5 micrometers + ! 9: sea salt bin 4, 1.5 to 5.0 micrometers + ! 10: sea salt bin 5, 5.0 to 10.0 micrometers + ! 11: Sulfate, 0.35 (mean) micrometers + ! 15: water-friendly organic carbon, 0.35 (mean) micrometers + ! + ! Bin densities are as follows: + ! 1: dust bin 1: 2500 kg/m2 + ! 2-5: dust bin 2-5: 2650 kg/m2 + ! 6-10: sea salt bins 6-10: 2200 kg/m2 + ! 11: sulfate: 1700 kg/m2 + ! 15: organic carbon: 1800 kg/m2 + + implicit none + integer, intent(in)::ncol, nlev + real (kind=kind_phys), dimension(:,:,:), intent(in) :: aerfld + real (kind=kind_phys), dimension(:,:), intent(out ):: nifa, nwfa + + nifa=(aerfld(:,:,1)/4.0737762+aerfld(:,:,2)/30.459203+aerfld(:,:,3)/153.45048+ & + aerfld(:,:,4)/1011.5142+ aerfld(:,:,5)/5683.3501)*1.e15 + + nwfa=((aerfld(:,:,6)/0.0045435214+aerfld(:,:,7)/0.2907854+aerfld(:,:,8)/12.91224+ & + aerfld(:,:,9)/206.2216+ aerfld(:,:,10)/4326.23)*9.+aerfld(:,:,11)/0.3053104*5+ & + aerfld(:,:,15)/0.3232698*8)*1.e15 + end subroutine get_niwfa + +end module mp_tempo diff --git a/physics/MP/TEMPO/mp_tempo.meta b/physics/MP/TEMPO/mp_tempo.meta new file mode 100644 index 000000000..0bac3e856 --- /dev/null +++ b/physics/MP/TEMPO/mp_tempo.meta @@ -0,0 +1,981 @@ +[ccpp-table-properties] + name = mp_tempo + type = scheme + dependencies = ../../hooks/machine.F + dependencies = ../module_mp_radar.F90 + dependencies = TEMPO/module_mp_tempo_params.F90 + dependencies = TEMPO/module_mp_tempo_utils.F90 + dependencies = TEMPO/module_mp_tempo_main.F90 + dependencies = module_mp_tempo.F90 + +######################################################################## +[ccpp-arg-table] + name = mp_tempo_init + type = scheme +[ncol] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[nlev] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rgas] + standard_name = molar_gas_constant + long_name = universal ideal molar gas constant + units = J K-1 mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_boltz] + standard_name = boltzmann_constant + long_name = Boltzmann constant + units = J K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_amd] + standard_name = molecular_weight_of_dry_air + long_name = molecular weight of dry air + units = g mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_amw] + standard_name = molecular_weight_of_water_vapor + long_name = molecular weight of water vapor + units = g mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_avgd] + standard_name = avogadro_consant + long_name = Avogadro constant + units = mol-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in +[imp_physics] + standard_name = control_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[imp_physics_tempo] + standard_name = identifier_for_tempo_microphysics_scheme + long_name = choice of TEMPO microphysics scheme + units = flag + dimensions = () + type = integer + intent = in +[convert_dry_rho] + standard_name = flag_for_converting_hydrometeors_from_moist_to_dry_air + long_name = flag for converting hydrometeors from moist to dry air + units = flag + dimensions = () + type = logical + intent = in +[spechum] + standard_name = specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qc] + standard_name = cloud_liquid_water_mixing_ratio + long_name = cloud water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qr] + standard_name = rain_mixing_ratio + long_name = rain water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qi] + standard_name = cloud_ice_mixing_ratio + long_name = ice water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qs] + standard_name = snow_mixing_ratio + long_name = snow water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qg] + standard_name = graupel_mixing_ratio + long_name = graupel mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[chw] + standard_name = mass_number_concentration_of_graupel_in_air + long_name = graupel number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[vh] + standard_name = graupel_volume + long_name = graupel particle volume + units = m3 kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[ni] + standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[nr] + standard_name = mass_number_concentration_of_rain_water_in_air + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[is_aerosol_aware] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol-aware physics + units = flag + dimensions = () + type = logical + intent = in +[is_hail_aware] + standard_name = flag_for_hail_physics + long_name = flag for hail-aware physics + units = flag + dimensions = () + type = logical + intent = in +[merra2_aerosol_aware] + standard_name = do_merra2_aerosol_awareness + long_name = flag for merra2 aerosol-aware physics for example the thompson microphysics + units = flag + dimensions = () + type = logical + intent = in +[nc] + standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[nwfa2d] + standard_name = tendency_of_hygroscopic_aerosols_at_surface_adjacent_layer + long_name = instantaneous fake water-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[nifa2d] + standard_name = tendency_of_nonhygroscopic_ice_nucleating_aerosols_at_surface_adjacent_layer + long_name = instantaneous fake ice-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[nwfa] + standard_name = mass_number_concentration_of_hygroscopic_aerosols + long_name = number concentration of water-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[nifa] + standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols + long_name = number concentration of ice-friendly aerosols + units = kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[aerfld] + standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 + long_name = mass mixing ratio of aerosol from gocart or merra2 + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in +[threads] + standard_name = number_of_openmp_threads + long_name = number of OpenMP threads available to scheme + units = count + dimensions = () + type = integer + intent = in +[ext_diag] + standard_name = flag_for_extended_diagnostic_output_from_thompson_microphysics + long_name = flag for extended diagnostic output from thompson microphysics + units = flag + dimensions = () + type = logical + intent = in +[diag3d] + standard_name = extended_diagnostics_output_from_thompson_microphysics + long_name = set of 3d arrays for extended diagnostics output from thompson microphysics + units = none + dimensions = (horizontal_dimension,vertical_layer_dimension,number_of_3d_diagnostic_output_arrays_from_thompson_microphysics) + type = real + kind = kind_phys + intent = in + optional = True +[is_initialized] + standard_name = flag_for_thompson_mp_scheme_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = mp_tempo_run + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[nlev] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[convert_dry_rho] + standard_name = flag_for_converting_hydrometeors_from_moist_to_dry_air + long_name = flag for converting hydrometeors from moist to dry air + units = flag + dimensions = () + type = logical + intent = in +[spechum] + standard_name = specific_humidity_of_new_state + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qc] + standard_name = cloud_liquid_water_mixing_ratio_of_new_state + long_name = cloud water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qr] + standard_name = rain_mixing_ratio_of_new_state + long_name = rain water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qi] + standard_name = cloud_ice_mixing_ratio_of_new_state + long_name = ice water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qs] + standard_name = snow_mixing_ratio_of_new_state + long_name = snow water mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[qg] + standard_name = graupel_mixing_ratio_of_new_state + long_name = graupel mixing ratio wrt dry+vapor (no condensates) + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[chw] + standard_name = mass_number_concentration_of_graupel_of_new_state + long_name = graupel number concentration + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[vh] + standard_name = graupel_volume_of_new_state + long_name = graupel particle volume + units = m3 kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[ni] + standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air_of_new_state + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[nr] + standard_name = mass_number_concentration_of_rain_of_new_state + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[is_aerosol_aware] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol-aware physics + units = flag + dimensions = () + type = logical + intent = in +[is_hail_aware] + standard_name = flag_for_hail_physics + long_name = flag for hail-aware physics + units = flag + dimensions = () + type = logical + intent = in +[merra2_aerosol_aware] + standard_name = do_merra2_aerosol_awareness + long_name = flag for merra2 aerosol-aware physics for example the thompson microphysics + units = flag + dimensions = () + type = logical + intent = in +[nc] + standard_name = mass_number_concentration_of_cloud_liquid_water_particles_in_air_of_new_state + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[nwfa] + standard_name = mass_number_concentration_of_hygroscopic_aerosols_of_new_state + long_name = number concentration of water-friendly aerosols + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[nifa] + standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_of_new_state + long_name = number concentration of ice-friendly aerosols + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[nwfa2d] + standard_name = tendency_of_hygroscopic_aerosols_at_surface_adjacent_layer + long_name = instantaneous fake water-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[nifa2d] + standard_name = tendency_of_nonhygroscopic_ice_nucleating_aerosols_at_surface_adjacent_layer + long_name = instantaneous fake ice-friendly surface aerosol source + units = kg-1 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[aero_ind_fdb] + standard_name = do_smoke_aerosol_indirect_feedback + long_name = flag for wfa ifa emission indirect feedback + units = flag + dimensions = () + type = logical + intent = in +[tgrs] + standard_name = air_temperature_of_new_state + long_name = model layer mean temperature + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[omega] + standard_name = lagrangian_tendency_of_air_pressure + long_name = layer mean vertical velocity + units = Pa s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[sedi_semi] + standard_name = flag_for_semi_Lagrangian_sedi_rain + long_name = flag for semi Lagrangian sedi of rain + units = flag + dimensions = () + type = logical + intent = in +[decfl] + standard_name = deformed_CFL_factor + long_name = deformed CFL factor + units = count + dimensions = () + type = integer + intent = in +[islmsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[dt_inner] + standard_name = time_step_for_inner_loop + long_name = time step for inner loop + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[first_time_step] + standard_name = flag_for_first_timestep + long_name = flag for first time step for time integration loop (cold/warmstart) + units = flag + dimensions = () + type = logical + intent = in +[istep] + standard_name = ccpp_loop_counter + long_name = loop counter for subcycling loops in CCPP + units = index + dimensions = () + type = integer + intent = in +[nsteps] + standard_name = ccpp_loop_extent + long_name = loop extent for subcycling loops in CCPP + units = count + dimensions = () + type = integer + intent = in +[prcp] + standard_name = lwe_thickness_of_explicit_precipitation_amount + long_name = explicit precipitation (rain, ice, snow, graupel) on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[rain] + standard_name = lwe_thickness_of_explicit_rain_amount + long_name = explicit rain fall on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = True +[graupel] + standard_name = lwe_thickness_of_graupel_amount + long_name = graupel fall on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = True +[ice] + standard_name = lwe_thickness_of_ice_amount + long_name = ice fall on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = True +[snow] + standard_name = lwe_thickness_of_snow_amount + long_name = snow fall on physics timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = True +[sr] + standard_name = ratio_of_snowfall_to_rainfall + long_name = ratio of snowfall to large-scale rainfall + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[refl_10cm] + standard_name = radar_reflectivity_10cm + long_name = instantaneous refl_10cm + units = dBZ + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[max_hail_diam_sfc] + standard_name = max_hail_diameter_sfc + long_name = instantaneous maximum hail diameter at lowest model level + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[fullradar_diag] + standard_name = do_full_radar_reflectivity + long_name = flag for computing full radar reflectivity + units = flag + dimensions = () + type = logical + intent = in +[do_radar_ref] + standard_name = flag_for_radar_reflectivity + long_name = flag for radar reflectivity + units = flag + dimensions = () + type = logical + intent = in +[aerfld] + standard_name = mass_mixing_ratio_of_aerosol_from_gocart_or_merra2 + long_name = mass mixing ratio of aerosol from gocart or merra2 + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in +[mpicomm] + standard_name = mpi_communicator + long_name = MPI communicator + units = index + dimensions = () + type = MPI_Comm + intent = in +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in +[blkno] + standard_name = ccpp_block_number + long_name = number of block for explicit data blocking in CCPP + units = index + dimensions = () + type = integer + intent = in +[ext_diag] + standard_name = flag_for_extended_diagnostic_output_from_thompson_microphysics + long_name = flag for extended diagnostic output from thompson microphysics + units = flag + dimensions = () + type = logical + intent = in +[diag3d] + standard_name = extended_diagnostics_output_from_thompson_microphysics + long_name = set of 3d arrays for extended diagnostics output from thompson microphysics + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_3d_diagnostic_output_arrays_from_thompson_microphysics) + type = real + kind = kind_phys + intent = inout + optional = True +[reset_diag3d] + standard_name = flag_reset_extended_diagnostics_output_arrays_from_thompson_microphysics + long_name = flag for resetting extended diagnostics output arrays from thompson microphysics + units = flag + dimensions = () + type = logical + intent = in +[spp_wts_mp] + standard_name = spp_weights_for_microphysics_scheme + long_name = spp weights for microphysics scheme + units = 1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + intent = in + optional = True +[spp_mp] + standard_name = control_for_microphysics_spp_perturbations + long_name = control for microphysics spp perturbations + units = count + dimensions = () + type = integer + intent = in +[n_var_spp] + standard_name = number_of_perturbed_spp_schemes + long_name = number of perturbed spp schemes + units = count + dimensions = () + type = integer + intent = in +[spp_prt_list] + standard_name = magnitude_of_spp_perturbations + long_name = magnitude of spp perturbations + units = 1 + dimensions = (number_of_perturbed_spp_schemes) + type = real + kind = kind_phys + intent = in + optional = True +[spp_stddev_cutoff] + standard_name = magnitude_of_spp_standard_deviation_cutoff + long_name = magnitude of spp standard deviation cutoff + units = 1 + dimensions = (number_of_perturbed_spp_schemes) + type = real + kind = kind_phys + intent = in + optional = True +[spp_var_list] + standard_name = perturbed_spp_schemes + long_name = perturbed spp schemes + units = none + dimensions = (number_of_perturbed_spp_schemes) + type = character + kind = len=10 + intent = in + optional = True +[cplchm] + standard_name = flag_for_chemistry_coupling + long_name = flag controlling cplchm collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[pfi_lsan] + standard_name = ice_flux_due_to_large_scale_precipitation + long_name = instantaneous 3D flux of ice from nonconvective precipitation + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[pfl_lsan] + standard_name = liquid_flux_due_to_large_scale_precipitation + long_name = instantaneous 3D flux of liquid water from nonconvective precipitation + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = True +[is_initialized] + standard_name = flag_for_thompson_mp_scheme_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = mp_tempo_finalize + type = scheme +[is_initialized] + standard_name = flag_for_thompson_mp_scheme_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/physics/MP/TEMPO/mp_tempo_post.F90 b/physics/MP/TEMPO/mp_tempo_post.F90 new file mode 100644 index 000000000..ea71d7f14 --- /dev/null +++ b/physics/MP/TEMPO/mp_tempo_post.F90 @@ -0,0 +1,146 @@ +module mp_tempo_post + + use machine, only : kind_phys + + implicit none + + public :: mp_tempo_post_init, mp_tempo_post_run, mp_tempo_post_finalize + + private + + logical :: is_initialized = .false. + + logical :: apply_limiter + +contains + +!! \section arg_table_mp_tempo_post_init Argument Table +!! \htmlinclude mp_tempo_post_init.html +!! + subroutine mp_tempo_post_init(ttendlim, errmsg, errflg) + + implicit none + + ! Interface variables + real(kind_phys), intent(in) :: ttendlim + + ! CCPP error handling + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Local variables + integer :: i + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Check initialization state + if (is_initialized) return + + if (ttendlim < 0) then + apply_limiter = .false. + else + apply_limiter = .true. + end if + + is_initialized = .true. + + end subroutine mp_tempo_post_init + +!> \section arg_table_mp_tempo_post_run Argument Table +!! \htmlinclude mp_tempo_post_run.html +!! + subroutine mp_tempo_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendlim, & + kdt, errmsg, errflg) + + implicit none + + ! Interface variables + integer, intent(in) :: ncol + integer, intent(in) :: nlev + real(kind_phys), dimension(:,:), intent(in) :: tgrs_save + real(kind_phys), dimension(:,:), intent(inout) :: tgrs + real(kind_phys), dimension(:,:), intent(in) :: prslk + real(kind_phys), intent(in) :: dtp + real(kind_phys), intent(in) :: ttendlim + integer, intent(in) :: kdt + + ! CCPP error handling + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Local variables + real(kind_phys), dimension(1:ncol,1:nlev) :: mp_tend + integer :: i, k +#ifdef DEBUG + integer :: events +#endif + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Check initialization state + if (.not.is_initialized) then + write(errmsg, fmt='((a))') 'mp_tempo_post_run called before mp_tempo_post_init' + errflg = 1 + return + end if + + ! If limiter is deactivated, return immediately + if (.not.apply_limiter) return + + ! mp_tend and ttendlim are expressed in potential temperature + mp_tend = (tgrs - tgrs_save)/prslk + +#ifdef DEBUG + events = 0 +#endif + do k=1,nlev + do i=1,ncol + mp_tend(i,k) = max( -ttendlim*dtp, min( ttendlim*dtp, mp_tend(i,k) ) ) + +#ifdef DEBUG + if (tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) .ne. tgrs(i,k)) then + write(0,'(a,3i6,3e16.7)') "mp_tempo_post_run mp_tend limiter: kdt, i, k, t_old, t_new, t_lim:", & + & kdt, i, k, tgrs_save(i,k), tgrs(i,k), tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) + events = events + 1 + end if +#endif + tgrs(i,k) = tgrs_save(i,k) + mp_tend(i,k)*prslk(i,k) + end do + end do + +#ifdef DEBUG + if (events > 0) then + write(0,'(a,i0,a,i0,a,i0)') "mp_tempo_post_run: ttendlim applied ", events, "/", nlev*ncol, & + & " times at timestep ", kdt + end if +#endif + + end subroutine mp_tempo_post_run + +!! \section arg_table_mp_tempo_post_finalize Argument Table +!! \htmlinclude mp_tempo_post_finalize.html +!! + subroutine mp_tempo_post_finalize(errmsg, errflg) + + implicit none + + ! CCPP error handling + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! initialize ccpp error handling variables + errmsg = '' + errflg = 0 + + ! Check initialization state + if (.not. is_initialized) return + + is_initialized = .false. + + end subroutine mp_tempo_post_finalize + +end module mp_tempo_post diff --git a/physics/photochem/h2ophys.meta b/physics/MP/TEMPO/mp_tempo_post.meta similarity index 53% rename from physics/photochem/h2ophys.meta rename to physics/MP/TEMPO/mp_tempo_post.meta index 9e9b03647..6661948c7 100644 --- a/physics/photochem/h2ophys.meta +++ b/physics/MP/TEMPO/mp_tempo_post.meta @@ -1,18 +1,19 @@ [ccpp-table-properties] - name = h2ophys + name = mp_tempo_post type = scheme - dependencies = ../hooks/machine.F + dependencies = ../../hooks/machine.F ######################################################################## [ccpp-arg-table] - name = h2ophys_init + name = mp_tempo_post_init type = scheme -[h2o_phys] - standard_name = flag_for_stratospheric_water_vapor_physics - long_name = flag for stratospheric water vapor physics - units = flag +[ttendlim] + standard_name = max_tendency_of_air_potential_temperature_due_to_large_scale_precipitation + long_name = temperature tendency limiter per physics time step + units = K s-1 dimensions = () - type = logical + type = real + kind = kind_phys intent = in [errmsg] standard_name = ccpp_error_message @@ -32,83 +33,89 @@ ######################################################################## [ccpp-arg-table] - name = h2ophys_run + name = mp_tempo_post_run type = scheme -[im] +[ncol] standard_name = horizontal_loop_extent long_name = horizontal loop extent units = count dimensions = () type = integer intent = in -[levs] +[nlev] standard_name = vertical_layer_dimension - long_name = number of vertical layers - units = count - dimensions = () - type = integer - intent = in -[kh2o] - standard_name = vertical_dimension_of_h2o_forcing_data - long_name = number of vertical layers in h2o forcing data + long_name = number of vertical levels units = count dimensions = () type = integer intent = in -[dt] - standard_name = timestep_for_physics - long_name = physics time step - units = s - dimensions = () +[tgrs_save] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[h2o] - standard_name = specific_humidity_of_new_state - long_name = water vapor specific humidity updated by physics - units = kg kg-1 +[tgrs] + standard_name = air_temperature_of_new_state + long_name = model layer mean temperature + units = K dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = inout -[ph2o] - standard_name = natural_log_of_h2o_forcing_data_pressure_levels - long_name = natural log of h2o forcing data pressure levels - units = 1 - dimensions = (vertical_dimension_of_h2o_forcing_data) +[prslk] + standard_name = dimensionless_exner_function + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in -[prsl] - standard_name = air_pressure - long_name = mid-layer pressure - units = Pa - dimensions = (horizontal_loop_extent,vertical_layer_dimension) +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () type = real kind = kind_phys intent = in -[h2opltc] - standard_name = stratospheric_water_vapor_forcing - long_name = water forcing data - units = mixed - dimensions = (horizontal_loop_extent,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) +[ttendlim] + standard_name = max_tendency_of_air_potential_temperature_due_to_large_scale_precipitation + long_name = temperature tendency limiter per physics time step + units = K s-1 + dimensions = () type = real kind = kind_phys intent = in -[h2o_coeff] - standard_name = number_of_coefficients_in_h2o_forcing_data - long_name = number of coefficients in h2o forcing data +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration units = index dimensions = () type = integer intent = in -[me] - standard_name = mpi_rank - long_name = rank of the current MPI task - units = index +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 dimensions = () type = integer - intent = in + intent = out + +######################################################################## +[ccpp-arg-table] + name = mp_tempo_post_finalize + type = scheme [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -124,4 +131,3 @@ dimensions = () type = integer intent = out - diff --git a/physics/MP/TEMPO/mp_tempo_pre.F90 b/physics/MP/TEMPO/mp_tempo_pre.F90 new file mode 100644 index 000000000..1e5b7b92d --- /dev/null +++ b/physics/MP/TEMPO/mp_tempo_pre.F90 @@ -0,0 +1,44 @@ +!>\file mp_tempo_pre.F90 +!! + +! CCPP license goes here, as well as further documentation +!>\ingroup aatempo +module mp_tempo_pre + + use machine, only : kind_phys + + implicit none + + public :: mp_tempo_pre_run + + private + + contains + +!> \section arg_table_mp_tempo_pre_run Argument Table +!! \htmlinclude mp_tempo_pre_run.html +!! + subroutine mp_tempo_pre_run(ncol, nlev, tgrs, tgrs_save, errmsg, errflg) + + implicit none + + ! Interface variables + integer, intent(in ) :: ncol + integer, intent(in ) :: nlev + real(kind_phys), intent(in ) :: tgrs(:,:) + real(kind_phys), intent( out) :: tgrs_save(:,:) + + ! CCPP error handling + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Save current air temperature for tendency limiters in mp_tempo_post + tgrs_save = tgrs + + end subroutine mp_tempo_pre_run + +end module mp_tempo_pre diff --git a/physics/MP/TEMPO/mp_tempo_pre.meta b/physics/MP/TEMPO/mp_tempo_pre.meta new file mode 100644 index 000000000..2c6b44c34 --- /dev/null +++ b/physics/MP/TEMPO/mp_tempo_pre.meta @@ -0,0 +1,54 @@ +[ccpp-table-properties] + name = mp_tempo_pre + type = scheme + dependencies = ../../hooks/machine.F + +######################################################################## +[ccpp-arg-table] + name = mp_tempo_pre_run + type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[nlev] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[tgrs] + standard_name = air_temperature_of_new_state + long_name = model layer mean temperature + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[tgrs_save] + standard_name = air_temperature_save + long_name = air temperature before entering a physics scheme + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/physics/MP/Thompson/module_mp_thompson.F90 b/physics/MP/Thompson/module_mp_thompson.F90 index 11f2b27e2..d78d9689c 100644 --- a/physics/MP/Thompson/module_mp_thompson.F90 +++ b/physics/MP/Thompson/module_mp_thompson.F90 @@ -3,7 +3,7 @@ !>\ingroup aathompson -!! This module computes the moisture tendencies of water vapor, +!> This module computes the moisture tendencies of water vapor, !! cloud droplets, rain, cloud ice (pristine), snow, and graupel. !! Prior to WRFv2.2 this code was based on Reisner et al (1998), but !! few of those pieces remain. A complete description is now found in @@ -62,9 +62,7 @@ module module_mp_thompson use machine, only: wp => kind_phys, sp => kind_sngl_prec, dp => kind_dbl_prec use module_mp_radar -#ifdef MPI - use mpi -#endif + use mpi_f08 implicit none @@ -92,10 +90,17 @@ module module_mp_thompson !.. droplet concentration and nu_c is also variable depending on local !.. droplet number concentration. !real(wp), parameter :: Nt_c = 100.e6 - real(wp), parameter :: Nt_c_o = 50.e6 - real(wp), parameter :: Nt_c_l = 100.e6 real(wp), parameter, private :: Nt_c_max = 1999.e6 + ! Tuning parameters + real(wp) :: Nt_c_l = 150.e6 ! Cloud number concentration over land (set in thompson_init) + real(wp) :: Nt_c_o = 50.e6 ! Cloud number concentration over ocean (set in thompson_init) + real(wp) :: av_i + real(wp) :: xnc_max = 1000.e3 + real(wp) :: ssati_min = 0.15 + real(wp) :: Nt_i_max = 4999.e3_dp + real(wp) :: rr_min = 1000.0 + !..Declaration of constants for assumed CCN/IN aerosols when none in !.. the input data. Look inside the init routine for modifications !.. due to surface land-sea points or vegetation characteristics. @@ -146,12 +151,12 @@ module module_mp_thompson real(wp), parameter, private :: av_r = 4854.0 real(wp), parameter, private :: bv_r = 1.0 real(wp), parameter, private :: fv_r = 195.0 - real(wp), parameter, private :: av_s = 40.0 - real(wp), parameter, private :: bv_s = 0.55 + real(wp), parameter :: av_s = 40.0 + real(wp), parameter :: bv_s = 0.55 real(wp), parameter, private :: fv_s = 100.0 real(wp), parameter, private :: av_g = 442.0 real(wp), parameter, private :: bv_g = 0.89 - real(wp), parameter, private :: bv_i = 1.0 + real(wp), parameter :: bv_i = 1.0 real(wp), parameter, private :: av_c = 0.316946E8 real(wp), parameter, private :: bv_c = 2.0 @@ -216,7 +221,7 @@ module module_mp_thompson real(wp), parameter, private :: xm0i = R1 real(wp), parameter, private :: D0c = 1.e-6 real(wp), parameter, private :: D0r = 50.e-6 - real(wp), parameter, private :: D0s = 300.e-6 + real(wp), parameter :: D0s = 300.e-6 real(wp), parameter, private :: D0g = 350.e-6 real(wp), private :: D0i, xm0s, xm0g @@ -419,7 +424,7 @@ module module_mp_thompson real(wp) :: t1_qs_me, t2_qs_me, t1_qg_me, t2_qg_me !..MPI communicator - integer :: mpi_communicator + TYPE(MPI_Comm):: mpi_communicator !..Write tables with master MPI task after computing them in thompson_init logical :: thompson_table_writer @@ -446,7 +451,8 @@ subroutine thompson_init(is_aerosol_aware_in, & logical, intent(in) :: is_aerosol_aware_in logical, intent(in) :: merra2_aerosol_aware_in - integer, intent(in) :: mpicomm, mpirank, mpiroot + type(MPI_Comm), intent(in) :: mpicomm + integer, intent(in) :: mpirank, mpiroot integer, intent(In) :: threads character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -455,7 +461,7 @@ subroutine thompson_init(is_aerosol_aware_in, & logical:: micro_init real(wp) :: stime, etime logical, parameter :: precomputed_tables = .FALSE. - + ! Set module derived constants am_r = PI*rho_w/6.0 am_g = PI*rho_g/6.0 @@ -1059,9 +1065,9 @@ subroutine mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & re_cloud, re_ice, re_snow real(wp), dimension(ims:ime, kms:kme, jms:jme), intent(inout):: pfils, pflls integer, intent(in) :: rand_perturb_on, kme_stoch, n_var_spp - real(wp), dimension(:,:), intent(in) :: rand_pert - real(wp), dimension(:), intent(in) :: spp_prt_list, spp_stddev_cutoff - character(len=10), dimension(:), intent(in) :: spp_var_list + real(wp), dimension(:,:), intent(in), optional :: rand_pert + real(wp), dimension(:), intent(in), optional :: spp_prt_list, spp_stddev_cutoff + character(len=10), dimension(:), intent(in), optional :: spp_var_list integer, intent(in):: has_reqc, has_reqi, has_reqs #if ( WRF_CHEM == 1 ) real(wp), dimension(ims:ime, kms:kme, jms:jme), intent(inout):: & @@ -1091,7 +1097,7 @@ subroutine mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ! Extended diagnostics, array pointers only associated if ext_diag flag is .true. logical, intent (in) :: ext_diag logical, optional, intent(in):: aero_ind_fdb - real(wp), dimension(:,:,:), intent(inout):: & + real(wp), dimension(:,:,:), optional, intent(inout):: & !vts1, txri, txrc, & prw_vcdc, & prw_vcde, tpri_inu, tpri_ide_d, & @@ -1249,44 +1255,6 @@ subroutine mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & allocate (nrten1(kts:kte)) allocate (ncten1(kts:kte)) allocate (qcten1(kts:kte)) - else - allocate (prw_vcdc1 (0)) - allocate (prw_vcde1 (0)) - allocate (tpri_inu1 (0)) - allocate (tpri_ide1_d(0)) - allocate (tpri_ide1_s(0)) - allocate (tprs_ide1 (0)) - allocate (tprs_sde1_d(0)) - allocate (tprs_sde1_s(0)) - allocate (tprg_gde1_d(0)) - allocate (tprg_gde1_s(0)) - allocate (tpri_iha1 (0)) - allocate (tpri_wfz1 (0)) - allocate (tpri_rfz1 (0)) - allocate (tprg_rfz1 (0)) - allocate (tprs_scw1 (0)) - allocate (tprg_scw1 (0)) - allocate (tprg_rcs1 (0)) - allocate (tprs_rcs1 (0)) - allocate (tprr_rci1 (0)) - allocate (tprg_rcg1 (0)) - allocate (tprw_vcd1_c(0)) - allocate (tprw_vcd1_e(0)) - allocate (tprr_sml1 (0)) - allocate (tprr_gml1 (0)) - allocate (tprr_rcg1 (0)) - allocate (tprr_rcs1 (0)) - allocate (tprv_rev1 (0)) - allocate (tten1 (0)) - allocate (qvten1 (0)) - allocate (qrten1 (0)) - allocate (qsten1 (0)) - allocate (qgten1 (0)) - allocate (qiten1 (0)) - allocate (niten1 (0)) - allocate (nrten1 (0)) - allocate (ncten1 (0)) - allocate (qcten1 (0)) end if allocate_extended_diagnostics !+---+ @@ -1806,43 +1774,43 @@ subroutine mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & !deallocate (txri1) !deallocate (txrc1) deallocate_extended_diagnostics: if (ext_diag) then - deallocate (prw_vcdc1) - deallocate (prw_vcde1) - deallocate (tpri_inu1) - deallocate (tpri_ide1_d) - deallocate (tpri_ide1_s) - deallocate (tprs_ide1) - deallocate (tprs_sde1_d) - deallocate (tprs_sde1_s) - deallocate (tprg_gde1_d) - deallocate (tprg_gde1_s) - deallocate (tpri_iha1) - deallocate (tpri_wfz1) - deallocate (tpri_rfz1) - deallocate (tprg_rfz1) - deallocate (tprs_scw1) - deallocate (tprg_scw1) - deallocate (tprg_rcs1) - deallocate (tprs_rcs1) - deallocate (tprr_rci1) - deallocate (tprg_rcg1) - deallocate (tprw_vcd1_c) - deallocate (tprw_vcd1_e) - deallocate (tprr_sml1) - deallocate (tprr_gml1) - deallocate (tprr_rcg1) - deallocate (tprr_rcs1) - deallocate (tprv_rev1) - deallocate (tten1) - deallocate (qvten1) - deallocate (qrten1) - deallocate (qsten1) - deallocate (qgten1) - deallocate (qiten1) - deallocate (niten1) - deallocate (nrten1) - deallocate (ncten1) - deallocate (qcten1) + deallocate (prw_vcdc1) + deallocate (prw_vcde1) + deallocate (tpri_inu1) + deallocate (tpri_ide1_d) + deallocate (tpri_ide1_s) + deallocate (tprs_ide1) + deallocate (tprs_sde1_d) + deallocate (tprs_sde1_s) + deallocate (tprg_gde1_d) + deallocate (tprg_gde1_s) + deallocate (tpri_iha1) + deallocate (tpri_wfz1) + deallocate (tpri_rfz1) + deallocate (tprg_rfz1) + deallocate (tprs_scw1) + deallocate (tprg_scw1) + deallocate (tprg_rcs1) + deallocate (tprs_rcs1) + deallocate (tprr_rci1) + deallocate (tprg_rcg1) + deallocate (tprw_vcd1_c) + deallocate (tprw_vcd1_e) + deallocate (tprr_sml1) + deallocate (tprr_gml1) + deallocate (tprr_rcg1) + deallocate (tprr_rcs1) + deallocate (tprv_rev1) + deallocate (tten1) + deallocate (qvten1) + deallocate (qrten1) + deallocate (qsten1) + deallocate (qgten1) + deallocate (qiten1) + deallocate (niten1) + deallocate (nrten1) + deallocate (ncten1) + deallocate (qcten1) end if deallocate_extended_diagnostics end subroutine mp_gt_driver @@ -1935,9 +1903,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qgten1, qiten1, niten1, nrten1, ncten1, qcten1, & pfil1, pfll1) -#ifdef MPI - use mpi -#endif + use mpi_f08 implicit none @@ -1956,7 +1922,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & logical, intent(in) :: ext_diag logical, intent(in) :: sedi_semi integer, intent(in) :: decfl - real(wp), dimension(:), intent(out) :: & + real(wp), dimension(:), intent(out), optional :: & !vtsk1, txri1, txrc1, & prw_vcdc1, & prw_vcde1, tpri_inu1, tpri_ide1_d, & @@ -2054,7 +2020,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & real(wp) :: Ef_ra, Ef_sa, Ef_ga real(wp) :: dtsave, odts, odt, odzq, hgt_agl, SR real(wp) :: xslw1, ygra1, zans1, eva_factor - real(wp) av_i integer :: i, k, k2, n, nn, nstep, k_0, kbot, IT, iexfrq integer, dimension(5) :: ksed1 integer :: nir, nis, nig, nii, nic, niin @@ -2079,8 +2044,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & odt = 1./dt odts = 1./dtsave iexfrq = 1 -! Transition value of coefficient matching at crossover from cloud ice to snow - av_i = av_s * D0s ** (bv_s - bv_i) !+---+-----------------------------------------------------------------+ !> - Initialize Source/sink terms. First 2 chars: "pr" represents source/sink of @@ -2306,7 +2269,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & ni(k) = max(R2, ni1d(k)*rho(k)) if (ni(k).le. R2) then lami = cie(2)/5.E-6 - ni(k) = min(4999.e3_dp, cig(1)*oig2*ri(k)/am_i*lami**bm_i) + ni(k) = min(Nt_i_max, cig(1)*oig2*ri(k)/am_i*lami**bm_i) endif L_qi(k) = .true. lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi @@ -2314,7 +2277,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & xDi = (bm_i + mu_i + 1.) * ilami if (xDi.lt. 5.E-6) then lami = cie(2)/5.E-6 - ni(k) = min(4999.e3_dp, cig(1)*oig2*ri(k)/am_i*lami**bm_i) + ni(k) = min(Nt_i_max, cig(1)*oig2*ri(k)/am_i*lami**bm_i) elseif (xDi.gt. 300.E-6) then lami = cie(2)/300.E-6 ni(k) = cig(1)*oig2*ri(k)/am_i*lami**bm_i @@ -2970,13 +2933,13 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Deposition nucleation of dust/mineral from DeMott et al (2010) !! we may need to relax the temperature and ssati constraints. - if ( (ssati(k).ge. 0.15) .or. (ssatw(k).gt. eps & + if ( (ssati(k).ge. ssati_min) .or. (ssatw(k).gt. eps & .and. temp(k).lt.253.15) ) then if (dustyIce .AND. (is_aerosol_aware .or. merra2_aerosol_aware)) then xnc = iceDeMott(tempc,qv(k),qvs(k),qvsi(k),rho(k),nifa(k)) xnc = xnc*(1.0 + 50.*rand3) else - xnc = min(1000.E3, TNO*EXP(ATO*(T_0-temp(k)))) + xnc = min(xnc_max, TNO*EXP(ATO*(T_0-temp(k)))) endif xni = ni(k) + (pni_rfz(k)+pni_wfz(k))*dtsave pni_inu(k) = 0.5*(xnc-xni + abs(xnc-xni))*odts @@ -2986,7 +2949,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Freezing of aqueous aerosols based on Koop et al (2001, Nature) xni = smo0(k)+ni(k) + (pni_rfz(k)+pni_wfz(k)+pni_inu(k))*dtsave - if ((is_aerosol_aware .or. merra2_aerosol_aware) .AND. homogIce .AND. (xni.le.4999.E3) & + if ((is_aerosol_aware .or. merra2_aerosol_aware) .AND. homogIce .AND. (xni.le.Nt_i_max) & .AND.(temp(k).lt.238).AND.(ssati(k).ge.0.4) ) then xnc = iceKoop(temp(k),qv(k),qvs(k),nwfa(k), dtsave) pni_iha(k) = xnc*odts @@ -3319,7 +3282,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & xDi = (bm_i + mu_i + 1.) * ilami if (xDi.lt. 5.E-6) then lami = cie(2)/5.E-6 - xni = min(4999.e3_dp, cig(1)*oig2*xri/am_i*lami**bm_i) + xni = min(Nt_i_max, cig(1)*oig2*xri/am_i*lami**bm_i) niten(k) = (xni-ni1d(k)*rho(k))*odts*orho elseif (xDi.gt. 300.E-6) then lami = cie(2)/300.E-6 @@ -3330,8 +3293,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & niten(k) = -ni1d(k)*odts endif xni=max(0.,(ni1d(k) + niten(k)*dtsave)*rho(k)) - if (xni.gt.4999.E3) & - niten(k) = (4999.E3-ni1d(k)*rho(k))*odts*orho + if (xni.gt.Nt_i_max) & + niten(k) = (Nt_i_max-ni1d(k)*rho(k))*odts*orho !> - Rain tendency qrten(k) = qrten(k) + (prr_wau(k) + prr_rcw(k) & @@ -3614,7 +3577,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ ! EVAPORATION elseif (clap .lt. -eps .AND. ssatw(k).lt.-1.E-6 .AND. & - (is_aerosol_aware .or. merra2_aerosol_aware)) then + is_aerosol_aware) then tempc = temp(k) - 273.15 otemp = 1./temp(k) rvs = rho(k)*qvs(k) @@ -4014,7 +3977,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pfll1(k) = pfll1(k) + sed_r(k)*DT*onstep(1) enddo - if (rr(kts).gt.R1*1000.) then + if (rr(kts).gt.R1*rr_min) then pptrain = pptrain + sed_r(kts)*DT*onstep(1) endif enddo @@ -4109,7 +4072,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pfil1(k) = pfil1(k) + sed_i(k)*DT*onstep(2) enddo - if (ri(kts).gt.R1*1000.) then + if (ri(kts).gt.R1*rr_min) then pptice = pptice + sed_i(kts)*DT*onstep(2) endif enddo @@ -4139,7 +4102,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pfil1(k) = pfil1(k) + sed_s(k)*DT*onstep(3) enddo - if (rs(kts).gt.R1*1000.) then + if (rs(kts).gt.R1*rr_min) then pptsnow = pptsnow + sed_s(kts)*DT*onstep(3) endif enddo @@ -4170,7 +4133,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pfil1(k) = pfil1(k) + sed_g(k)*DT*onstep(4) enddo - if (rg(kts).gt.R1*1000.) then + if (rg(kts).gt.R1*rr_min) then pptgraul = pptgraul + sed_g(kts)*DT*onstep(4) endif enddo @@ -4298,7 +4261,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & lami = cie(2)/300.E-6 endif ni1d(k) = min(cig(1)*oig2*qi1d(k)/am_i*lami**bm_i, & - 4999.e3_dp/rho(k)) + Nt_i_max/rho(k)) endif qr1d(k) = qr1d(k) + qrten(k)*DT nr1d(k) = max(R2/rho(k), nr1d(k) + nrten(k)*DT) @@ -4437,9 +4400,7 @@ subroutine qr_acr_qg good = 0 INQUIRE(FILE=qr_acr_qg_file, EXIST=lexist) -#ifdef MPI call MPI_BARRIER(mpi_communicator,ierr) -#endif IF ( lexist ) THEN OPEN(63,file=qr_acr_qg_file,form="unformatted",err=1234) !sms$serial begin @@ -4612,9 +4573,7 @@ subroutine qr_acr_qs good = 0 INQUIRE(FILE=qr_acr_qs_file, EXIST=lexist) -#ifdef MPI call MPI_BARRIER(mpi_communicator,ierr) -#endif IF ( lexist ) THEN !write(0,*) "ThompMP: read "//qr_acr_qs_file//" instead of computing" OPEN(63,file=qr_acr_qs_file,form="unformatted",err=1234) @@ -4873,9 +4832,7 @@ subroutine freezeH2O(threads) good = 0 INQUIRE(FILE=freeze_h2o_file,EXIST=lexist) -#ifdef MPI call MPI_BARRIER(mpi_communicator,ierr) -#endif IF ( lexist ) THEN !write(0,*) "ThompMP: read "//freeze_h2o_file//" instead of computing" OPEN(63,file=freeze_h2o_file,form="unformatted",err=1234) @@ -6253,14 +6210,14 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & end subroutine calc_refl10cm ! !------------------------------------------------------------------- +!> This routine is a semi-Lagrangian forward advection for hydrometeors +!! with mass conservation and positive definite advection +!! 2nd order interpolation with monotonic piecewise parabolic method is used. +!! This routine is under assumption of decfl < 1 for semi_Lagrangian +!!(Juang and Hong, 2010 \cite Henry_Juang_2010). SUBROUTINE semi_lagrange_sedim(km,dzl,wwl,rql,precip,pfsan,dt,R1) !------------------------------------------------------------------- ! -! This routine is a semi-Lagrangain forward advection for hydrometeors -! with mass conservation and positive definite advection -! 2nd order interpolation with monotonic piecewise parabolic method is used. -! This routine is under assumption of decfl < 1 for semi_Lagrangian -! ! dzl depth of model layer in meter ! wwl terminal velocity at model layer m/s ! rql dry air density*mixing ratio diff --git a/physics/MP/Thompson/module_mp_thompson_make_number_concentrations.F90 b/physics/MP/Thompson/module_mp_thompson_make_number_concentrations.F90 index 7618b0a9f..81ccd8c16 100644 --- a/physics/MP/Thompson/module_mp_thompson_make_number_concentrations.F90 +++ b/physics/MP/Thompson/module_mp_thompson_make_number_concentrations.F90 @@ -2,6 +2,8 @@ !! This file contains !>\ingroup aathompson + +!>This module ocntains lookup tables of radiative effective radius of cloud ice, rain and water. module module_mp_thompson_make_number_concentrations use module_mp_thompson, only: PI diff --git a/physics/MP/Thompson/mp_thompson.F90 b/physics/MP/Thompson/mp_thompson.F90 index 657788d97..666a8a53f 100644 --- a/physics/MP/Thompson/mp_thompson.F90 +++ b/physics/MP/Thompson/mp_thompson.F90 @@ -3,13 +3,15 @@ !>\defgroup aathompson Aerosol-Aware Thompson MP Module -!! This module contains the aerosol-aware Thompson microphysics scheme. + +!> This module contains the aerosol-aware Thompson microphysics scheme. module mp_thompson + use mpi_f08 use machine, only : kind_phys - + use module_mp_thompson, only : thompson_init, mp_gt_driver, thompson_finalize, calc_effectRad - use module_mp_thompson, only : naIN0, naIN1, naCCN0, naCCN1, eps, Nt_c_l, Nt_c_o + use module_mp_thompson, only : naIN0, naIN1, naCCN0, naCCN1, eps use module_mp_thompson, only : re_qc_min, re_qc_max, re_qi_min, re_qi_max, re_qs_min, re_qs_max use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber, make_RainNumber @@ -20,8 +22,6 @@ module mp_thompson private - logical :: is_initialized = .False. - integer, parameter :: ext_ndiag3d = 37 contains @@ -34,6 +34,9 @@ subroutine mp_thompson_init(ncol, nlev, con_pi, con_t0c, con_rv, & con_cp, con_rgas, con_boltz, con_amd, & con_amw, con_avgd, con_hvap, con_hfus, & con_g, con_rd, con_eps, & + con_Nt_c_l, con_Nt_c_o, con_av_i, & + con_xnc_max, con_ssati_min, con_Nt_i_max,& + con_rr_min, & restart, imp_physics, & imp_physics_thompson, convert_dry_rho, & spechum, qc, qr, qi, qs, qg, ni, nr, & @@ -42,9 +45,11 @@ subroutine mp_thompson_init(ncol, nlev, con_pi, con_t0c, con_rv, & nwfa, nifa, tgrs, prsl, phil, area, & aerfld, mpicomm, mpirank, mpiroot, & threads, ext_diag, diag3d, & - errmsg, errflg) + is_initialized, errmsg, errflg) use module_mp_thompson, only : PI, T_0, Rv, R, RoverRv, Cp use module_mp_thompson, only : R_uni, k_b, M_w, M_a, N_avo, lvap0, lfus + use module_mp_thompson, only : av_i, av_s, D0s, bv_s, bv_i + use module_mp_thompson, only : nt_c_l, nt_c_o, xnc_max, ssati_min, Nt_i_max, rr_min implicit none @@ -54,7 +59,10 @@ subroutine mp_thompson_init(ncol, nlev, con_pi, con_t0c, con_rv, & real(kind_phys), intent(in ) :: con_pi, con_t0c, con_rv, con_cp, con_rgas, & con_boltz, con_amd, con_amw, con_avgd, & con_hvap, con_hfus, con_g, con_rd, con_eps + real(kind_phys), optional, intent(in ) :: con_Nt_c_l, con_Nt_c_o, con_av_i, con_xnc_max, & + con_ssati_min, con_Nt_i_max, con_rr_min logical, intent(in ) :: restart + logical, intent(inout) :: is_initialized integer, intent(in ) :: imp_physics integer, intent(in ) :: imp_physics_thompson ! Hydrometeors @@ -70,11 +78,11 @@ subroutine mp_thompson_init(ncol, nlev, con_pi, con_t0c, con_rv, & ! Aerosols logical, intent(in ) :: is_aerosol_aware logical, intent(in ) :: merra2_aerosol_aware - real(kind_phys), intent(inout) :: nc(:,:) - real(kind_phys), intent(inout) :: nwfa(:,:) - real(kind_phys), intent(inout) :: nifa(:,:) - real(kind_phys), intent(inout) :: nwfa2d(:) - real(kind_phys), intent(inout) :: nifa2d(:) + real(kind_phys), intent(inout), optional :: nc(:,:) + real(kind_phys), intent(inout), optional :: nwfa(:,:) + real(kind_phys), intent(inout), optional :: nifa(:,:) + real(kind_phys), intent(inout), optional :: nwfa2d(:) + real(kind_phys), intent(inout), optional :: nifa2d(:) real(kind_phys), intent(in) :: aerfld(:,:,:) ! State variables real(kind_phys), intent(in ) :: tgrs(:,:) @@ -82,14 +90,14 @@ subroutine mp_thompson_init(ncol, nlev, con_pi, con_t0c, con_rv, & real(kind_phys), intent(in ) :: phil(:,:) real(kind_phys), intent(in ) :: area(:) ! MPI information - integer, intent(in ) :: mpicomm + type(MPI_Comm), intent(in ) :: mpicomm integer, intent(in ) :: mpirank integer, intent(in ) :: mpiroot ! Threading/blocking information integer, intent(in ) :: threads ! Extended diagnostics logical, intent(in ) :: ext_diag - real(kind_phys), intent(in ) :: diag3d(:,:,:) + real(kind_phys), intent(in ), optional :: diag3d(:,:,:) ! CCPP error handling character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg @@ -125,6 +133,22 @@ subroutine mp_thompson_init(ncol, nlev, con_pi, con_t0c, con_rv, & lvap0 = con_hvap lfus = con_hfus + if (present(con_nt_c_l)) nt_c_l = con_nt_c_l + if (present(con_nt_c_o)) nt_c_o = con_nt_c_o + if (present(con_av_i)) then + if (con_av_i > 0.) then + av_i = con_av_i + else + av_i = av_s * D0s ** (bv_s - bv_i) ! Transition value of coefficient matching at crossover from cloud ice to snow + end if + else + av_i = av_s * D0s ** (bv_s - bv_i) ! Transition value of coefficient matching at crossover from cloud ice to snow + end if + if (present(con_xnc_max)) xnc_max = con_xnc_max + if (present(con_ssati_min)) ssati_min = con_ssati_min + if (present(con_Nt_i_max)) Nt_i_max = con_Nt_i_max + if (present(con_rr_min)) rr_min = con_rr_min + ! Consistency checks if (imp_physics/=imp_physics_thompson) then write(errmsg,'(*(a))') "Logic error: namelist choice of microphysics is different from Thompson MP" @@ -152,7 +176,7 @@ subroutine mp_thompson_init(ncol, nlev, con_pi, con_t0c, con_rv, & mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & threads=threads, errmsg=errmsg, errflg=errflg) if (errflg /= 0) return - + ! For restart runs, the init is done here if (restart) then is_initialized = .true. @@ -359,12 +383,12 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & spp_prt_list, spp_var_list, & spp_stddev_cutoff, & cplchm, pfi_lsan, pfl_lsan, & - errmsg, errflg) + is_initialized, errmsg, errflg) implicit none ! Interface variables - + logical, intent(inout) :: is_initialized ! Dimensions and constants integer, intent(in ) :: ncol integer, intent(in ) :: nlev @@ -416,12 +440,12 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & integer, intent(in) :: decfl ! MPI and block information integer, intent(in) :: blkno - integer, intent(in) :: mpicomm + type(MPI_Comm), intent(in) :: mpicomm integer, intent(in) :: mpirank integer, intent(in) :: mpiroot ! Extended diagnostic output logical, intent(in) :: ext_diag - real(kind_phys), target, intent(inout) :: diag3d(:,:,:) + real(kind_phys), target, intent(inout), optional :: diag3d(:,:,:) logical, intent(in) :: reset_diag3d ! CCPP error handling @@ -431,15 +455,15 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! SPP integer, intent(in) :: spp_mp integer, intent(in) :: n_var_spp - real(kind_phys), intent(in) :: spp_wts_mp(:,:) - real(kind_phys), intent(in) :: spp_prt_list(:) - character(len=10), intent(in) :: spp_var_list(:) - real(kind_phys), intent(in) :: spp_stddev_cutoff(:) + real(kind_phys), intent(in), optional :: spp_wts_mp(:,:) + real(kind_phys), intent(in), optional :: spp_prt_list(:) + character(len=10), intent(in), optional :: spp_var_list(:) + real(kind_phys), intent(in), optional :: spp_stddev_cutoff(:) logical, intent (in) :: cplchm ! ice and liquid water 3d precipitation fluxes - only allocated if cplchm is .true. - real(kind=kind_phys), intent(inout), dimension(:,:) :: pfi_lsan - real(kind=kind_phys), intent(inout), dimension(:,:) :: pfl_lsan + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfi_lsan + real(kind=kind_phys), intent(inout), dimension(:,:), optional :: pfl_lsan ! Local variables @@ -709,47 +733,9 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & nrten3 => diag3d(:,:,35:35) ncten3 => diag3d(:,:,36:36) qcten3 => diag3d(:,:,37:37) - else - allocate(prw_vcdc (0,0,0)) - allocate(prw_vcde (0,0,0)) - allocate(tpri_inu (0,0,0)) - allocate(tpri_ide_d (0,0,0)) - allocate(tpri_ide_s (0,0,0)) - allocate(tprs_ide (0,0,0)) - allocate(tprs_sde_d (0,0,0)) - allocate(tprs_sde_s (0,0,0)) - allocate(tprg_gde_d (0,0,0)) - allocate(tprg_gde_s (0,0,0)) - allocate(tpri_iha (0,0,0)) - allocate(tpri_wfz (0,0,0)) - allocate(tpri_rfz (0,0,0)) - allocate(tprg_rfz (0,0,0)) - allocate(tprs_scw (0,0,0)) - allocate(tprg_scw (0,0,0)) - allocate(tprg_rcs (0,0,0)) - allocate(tprs_rcs (0,0,0)) - allocate(tprr_rci (0,0,0)) - allocate(tprg_rcg (0,0,0)) - allocate(tprw_vcd_c (0,0,0)) - allocate(tprw_vcd_e (0,0,0)) - allocate(tprr_sml (0,0,0)) - allocate(tprr_gml (0,0,0)) - allocate(tprr_rcg (0,0,0)) - allocate(tprr_rcs (0,0,0)) - allocate(tprv_rev (0,0,0)) - allocate(tten3 (0,0,0)) - allocate(qvten3 (0,0,0)) - allocate(qrten3 (0,0,0)) - allocate(qsten3 (0,0,0)) - allocate(qgten3 (0,0,0)) - allocate(qiten3 (0,0,0)) - allocate(niten3 (0,0,0)) - allocate(nrten3 (0,0,0)) - allocate(ncten3 (0,0,0)) - allocate(qcten3 (0,0,0)) end if set_extended_diagnostic_pointers !> - Call mp_gt_driver() with or without aerosols, with or without effective radii, ... - if (is_aerosol_aware .or. merra2_aerosol_aware) then + if (is_aerosol_aware) then call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & @@ -791,6 +777,48 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & qcten3=qcten3, pfils=pfils, pflls=pflls) + else if (merra2_aerosol_aware) then + call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & + nc=nc, nwfa=nwfa, nifa=nifa, & + tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & + sedi_semi=sedi_semi, decfl=decfl, lsm=islmsk, & + rainnc=rain_mp, rainncv=delta_rain_mp, & + snownc=snow_mp, snowncv=delta_snow_mp, & + icenc=ice_mp, icencv=delta_ice_mp, & + graupelnc=graupel_mp, graupelncv=delta_graupel_mp, sr=sr, & + refl_10cm=refl_10cm, & + diagflag=diagflag, do_radar_ref=do_radar_ref_mp, & + max_hail_diam_sfc=max_hail_diam_sfc, & + has_reqc=has_reqc, has_reqi=has_reqi, has_reqs=has_reqs, & + aero_ind_fdb=aero_ind_fdb, rand_perturb_on=spp_mp_opt, & + kme_stoch=kme_stoch, & + rand_pert=spp_wts_mp, spp_var_list=spp_var_list, & + spp_prt_list=spp_prt_list, n_var_spp=n_var_spp, & + spp_stddev_cutoff=spp_stddev_cutoff, & + ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde, & + ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme, & + its=its, ite=ite, jts=jts, jte=jte, kts=kts, kte=kte, & + fullradar_diag=fullradar_diag, istep=istep, nsteps=nsteps, & + first_time_step=first_time_step, errmsg=errmsg, errflg=errflg, & + ! Extended diagnostics + ext_diag=ext_diag, & + ! vts1=vts1, txri=txri, txrc=txrc, & + prw_vcdc=prw_vcdc, & + prw_vcde=prw_vcde, tpri_inu=tpri_inu, tpri_ide_d=tpri_ide_d, & + tpri_ide_s=tpri_ide_s, tprs_ide=tprs_ide, & + tprs_sde_d=tprs_sde_d, & + tprs_sde_s=tprs_sde_s, tprg_gde_d=tprg_gde_d, & + tprg_gde_s=tprg_gde_s, tpri_iha=tpri_iha, & + tpri_wfz=tpri_wfz, tpri_rfz=tpri_rfz, tprg_rfz=tprg_rfz, & + tprs_scw=tprs_scw, tprg_scw=tprg_scw, tprg_rcs=tprg_rcs, & + tprs_rcs=tprs_rcs, & + tprr_rci=tprr_rci, tprg_rcg=tprg_rcg, tprw_vcd_c=tprw_vcd_c, & + tprw_vcd_e=tprw_vcd_e, tprr_sml=tprr_sml, tprr_gml=tprr_gml, & + tprr_rcg=tprr_rcg, tprr_rcs=tprr_rcs, & + tprv_rev=tprv_rev, tten3=tten3, & + qvten3=qvten3, qrten3=qrten3, qsten3=qsten3, qgten3=qgten3, & + qiten3=qiten3, niten3=niten3, nrten3=nrten3, ncten3=ncten3, & + qcten3=qcten3, pfils=pfils, pflls=pflls) else call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtstep, dt_inner=dt_inner, & @@ -878,59 +906,16 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & pfl_lsan(:,:) = pflls(:,:,1) end if - unset_extended_diagnostic_pointers: if (ext_diag) then - !vts1 => null() - !txri => null() - !txrc => null() - prw_vcdc => null() - prw_vcde => null() - tpri_inu => null() - tpri_ide_d => null() - tpri_ide_s => null() - tprs_ide => null() - tprs_sde_d => null() - tprs_sde_s => null() - tprg_gde_d => null() - tprg_gde_s => null() - tpri_iha => null() - tpri_wfz => null() - tpri_rfz => null() - tprg_rfz => null() - tprs_scw => null() - tprg_scw => null() - tprg_rcs => null() - tprs_rcs => null() - tprr_rci => null() - tprg_rcg => null() - tprw_vcd_c => null() - tprw_vcd_e => null() - tprr_sml => null() - tprr_gml => null() - tprr_rcg => null() - tprr_rcs => null() - tprv_rev => null() - tten3 => null() - qvten3 => null() - qrten3 => null() - qsten3 => null() - qgten3 => null() - qiten3 => null() - niten3 => null() - nrten3 => null() - ncten3 => null() - qcten3 => null() - end if unset_extended_diagnostic_pointers - end subroutine mp_thompson_run !>@} !> \section arg_table_mp_thompson_finalize Argument Table !! \htmlinclude mp_thompson_finalize.html !! - subroutine mp_thompson_finalize(errmsg, errflg) + subroutine mp_thompson_finalize(is_initialized, errmsg, errflg) implicit none - + logical, intent(inout) :: is_initialized character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg diff --git a/physics/MP/Thompson/mp_thompson.meta b/physics/MP/Thompson/mp_thompson.meta index b880d2e26..09e292672 100644 --- a/physics/MP/Thompson/mp_thompson.meta +++ b/physics/MP/Thompson/mp_thompson.meta @@ -135,6 +135,69 @@ type = real kind = kind_phys intent = in +[con_Nt_c_l] + standard_name = prescribed_number_concentration_of_cloud_liquid_water_particles_in_air_over_land + long_name = volumetric number concentration of cloud liquid water droplets in air over land points + units = m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = True +[con_Nt_c_o] + standard_name = prescribed_number_concentration_of_cloud_liquid_water_particles_in_air_over_ocean + long_name = volumetric number concentration of cloud liquid water droplets in air over ocean points + units = m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = True +[con_av_i] + standard_name = cloud_ice_to_snow_tuning_parameter + long_name = transition value of coefficient matching at crossover from cloud ice to snow + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = True +[con_xnc_max] + standard_name = maximum_mass_number_concentration_of_cloud_liquid_water_particles_in_air_used_in_deposition_nucleation + long_name = maximum mass number concentration of cloud liquid water particles in air + units = kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = True +[con_ssati_min] + standard_name = minimum_threshold_supersaturation_over_ice_for_deposition_nucleation + long_name = minimum supersaturation over ice threshold for deposition nucleation + units = fraction + dimensions = () + type = real + kind = kind_phys + intent = in + optional = True +[con_Nt_i_max] + standard_name = maximum_threshold_number_concentration_of_cloud_ice_water_crystals_in_air + long_name = maximum threshold number concentration of cloud ice water crystals in air + units = m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = True +[con_rr_min] + standard_name = multiplicative_tuning_parameter_for_microphysical_sedimentation_minimum_threshold + long_name = multiplicative tuning parameter for microphysical sedimentation minimum threshold + units = 1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = True [restart] standard_name = flag_for_restart long_name = flag for restart (warmstart) or coldstart @@ -249,6 +312,7 @@ type = real kind = kind_phys intent = inout + optional = True [nwfa2d] standard_name = tendency_of_hygroscopic_aerosols_at_surface_adjacent_layer long_name = instantaneous fake water-friendly surface aerosol source @@ -257,6 +321,7 @@ type = real kind = kind_phys intent = inout + optional = True [nifa2d] standard_name = tendency_of_nonhygroscopic_ice_nucleating_aerosols_at_surface_adjacent_layer long_name = instantaneous fake ice-friendly surface aerosol source @@ -265,6 +330,7 @@ type = real kind = kind_phys intent = inout + optional = True [nwfa] standard_name = mass_number_concentration_of_hygroscopic_aerosols long_name = number concentration of water-friendly aerosols @@ -273,6 +339,7 @@ type = real kind = kind_phys intent = inout + optional = True [nifa] standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols long_name = number concentration of ice-friendly aerosols @@ -281,6 +348,7 @@ type = real kind = kind_phys intent = inout + optional = True [tgrs] standard_name = air_temperature long_name = model layer mean temperature @@ -326,7 +394,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank @@ -364,6 +432,14 @@ type = real kind = kind_phys intent = in + optional = True +[is_initialized] + standard_name = flag_for_thompson_mp_scheme_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -515,6 +591,7 @@ type = real kind = kind_phys intent = inout + optional = True [nwfa] standard_name = mass_number_concentration_of_hygroscopic_aerosols_of_new_state long_name = number concentration of water-friendly aerosols @@ -523,6 +600,7 @@ type = real kind = kind_phys intent = inout + optional = True [nifa] standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols_of_new_state long_name = number concentration of ice-friendly aerosols @@ -531,6 +609,7 @@ type = real kind = kind_phys intent = inout + optional = True [nwfa2d] standard_name = tendency_of_hygroscopic_aerosols_at_surface_adjacent_layer long_name = instantaneous fake water-friendly surface aerosol source @@ -539,6 +618,7 @@ type = real kind = kind_phys intent = in + optional = True [nifa2d] standard_name = tendency_of_nonhygroscopic_ice_nucleating_aerosols_at_surface_adjacent_layer long_name = instantaneous fake ice-friendly surface aerosol source @@ -547,6 +627,7 @@ type = real kind = kind_phys intent = in + optional = True [aero_ind_fdb] standard_name = do_smoke_aerosol_indirect_feedback long_name = flag for wfa ifa emission indirect feedback @@ -735,7 +816,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank @@ -773,6 +854,7 @@ type = real kind = kind_phys intent = inout + optional = True [reset_diag3d] standard_name = flag_reset_extended_diagnostics_output_arrays_from_thompson_microphysics long_name = flag for resetting extended diagnostics output arrays from thompson microphysics @@ -787,6 +869,7 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real intent = in + optional = True [spp_mp] standard_name = control_for_microphysics_spp_perturbations long_name = control for microphysics spp perturbations @@ -809,6 +892,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_stddev_cutoff] standard_name = magnitude_of_spp_standard_deviation_cutoff long_name = magnitude of spp standard deviation cutoff @@ -817,6 +901,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_var_list] standard_name = perturbed_spp_schemes long_name = perturbed spp schemes @@ -825,6 +910,7 @@ type = character kind = len=10 intent = in + optional = True [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) @@ -840,6 +926,7 @@ type = real kind = kind_phys intent = inout + optional = True [pfl_lsan] standard_name = liquid_flux_due_to_large_scale_precipitation long_name = instantaneous 3D flux of liquid water from nonconvective precipitation @@ -848,6 +935,14 @@ type = real kind = kind_phys intent = inout + optional = True +[is_initialized] + standard_name = flag_for_thompson_mp_scheme_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -868,6 +963,13 @@ [ccpp-arg-table] name = mp_thompson_finalize type = scheme +[is_initialized] + standard_name = flag_for_thompson_mp_scheme_initialization + long_name = flag carrying scheme initialization status + units = flag + dimensions = () + type = logical + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/MP/Thompson/mp_thompson_post.F90 b/physics/MP/Thompson/mp_thompson_post.F90 index 392f734a5..7b333f2b1 100644 --- a/physics/MP/Thompson/mp_thompson_post.F90 +++ b/physics/MP/Thompson/mp_thompson_post.F90 @@ -1,5 +1,10 @@ +!> \file mp_thompson_post.F90 +!! + +!>This module contain the post processing of Thompson microphysics module mp_thompson_post + use mpi_f08 use machine, only : kind_phys implicit none @@ -14,7 +19,7 @@ module mp_thompson_post contains -!! \section arg_table_mp_thompson_post_init Argument Table +!> \section arg_table_mp_thompson_post_init Argument Table !! \htmlinclude mp_thompson_post_init.html !! subroutine mp_thompson_post_init(ttendlim, errmsg, errflg) @@ -66,7 +71,7 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli real(kind_phys), intent(in) :: ttendlim integer, intent(in) :: kdt ! MPI information - integer, intent(in ) :: mpicomm + type(MPI_Comm), intent(in ) :: mpicomm integer, intent(in ) :: mpirank integer, intent(in ) :: mpiroot ! CCPP error handling @@ -124,7 +129,7 @@ subroutine mp_thompson_post_run(ncol, nlev, tgrs_save, tgrs, prslk, dtp, ttendli end subroutine mp_thompson_post_run -!! \section arg_table_mp_thompson_post_finalize Argument Table +!> \section arg_table_mp_thompson_post_finalize Argument Table !! \htmlinclude mp_thompson_post_finalize.html !! subroutine mp_thompson_post_finalize(errmsg, errflg) diff --git a/physics/MP/Thompson/mp_thompson_post.meta b/physics/MP/Thompson/mp_thompson_post.meta index 43e89b29c..85704316f 100644 --- a/physics/MP/Thompson/mp_thompson_post.meta +++ b/physics/MP/Thompson/mp_thompson_post.meta @@ -101,7 +101,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [mpirank] standard_name = mpi_rank diff --git a/physics/MP/Thompson/mp_thompson_pre.F90 b/physics/MP/Thompson/mp_thompson_pre.F90 index 3e65fd478..3fe78e4d1 100644 --- a/physics/MP/Thompson/mp_thompson_pre.F90 +++ b/physics/MP/Thompson/mp_thompson_pre.F90 @@ -1,8 +1,9 @@ !>\file mp_thompson_pre.F90 !! -! CCPP license goes here, as well as further documentation !>\ingroup aathompson + +!> This module contains the pre-processing of Thompson cloud microphysics module mp_thompson_pre use machine, only : kind_phys diff --git a/physics/MP/Zhao_Carr/zhaocarr_gscond.f b/physics/MP/Zhao_Carr/zhaocarr_gscond.f index 50f9358f4..1d22c09ac 100644 --- a/physics/MP/Zhao_Carr/zhaocarr_gscond.f +++ b/physics/MP/Zhao_Carr/zhaocarr_gscond.f @@ -100,10 +100,10 @@ subroutine zhaocarr_gscond_run (im,km,dt,dtf,prsl,ps,q,clw1 & integer, intent(in) :: im, km, ipr real(kind=kind_phys), intent(in) :: dt, dtf real(kind=kind_phys), intent(in) :: prsl(:,:), ps(:) - real(kind=kind_phys), intent(inout) :: q(:,:) + real(kind=kind_phys), intent(inout) :: q(:,:), t(:,:) real(kind=kind_phys), intent(in) :: clw1(:,:), clw2(:,:) real(kind=kind_phys), intent(out) :: cwm(:,:) - real(kind=kind_phys), intent(inout) :: t(:,:) & + real(kind=kind_phys), intent(inout) :: & &, tp(:,:), qp(:,:), psp(:) & &, tp1(:,:), qp1(:,:), psp1(:) real(kind=kind_phys), intent(in) :: u(:,:) diff --git a/physics/MP/calpreciptype.f90 b/physics/MP/calpreciptype.f90 index 2166e1b5c..792c0ba84 100644 --- a/physics/MP/calpreciptype.f90 +++ b/physics/MP/calpreciptype.f90 @@ -1,12 +1,11 @@ !>\file calpreciptype.f90 !! This file contains the subroutines that calculates dominant precipitation type. +!> This module defines four algorithms that are called to calculate dominant precipitation type, and the +!!tallies are sumed in calwxt_dominant(). module calpreciptype_mod contains -!>\ingroup gfs_calpreciptype -!! Foure algorithms are called to calculate dominant precipitation type, and the -!!tallies are sumed in calwxt_dominant(). -!! + !>\section gen_calp GFS calpreciptype General Algorithm subroutine calpreciptype(kdt,nrcm,im,ix,lm,lp1,randomno, & xlat,xlon, & @@ -215,10 +214,8 @@ subroutine calpreciptype(kdt,nrcm,im,ix,lm,lp1,randomno, & deallocate (twet,rh,td) return end -! -!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& -!>\ingroup gfs_calpreciptype -!! This subroutine computes precipitation type using a decision tree approach that uses + +!> This subroutine computes precipitation type using a decision tree approach that uses !! variables such as integrated wet bulb temperatue below freezing and lowest layer !! temperature (Baldwin et al. 1994 \cite baldwin_et_al_1994) subroutine calwxt(lm,lp1,t,q,pmid,pint, & @@ -472,7 +469,6 @@ subroutine calwxt(lm,lp1,t,q,pmid,pint, & ! ! code adapted for wrf post 24 august 2005 g manikin !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -!>\ingroup gfs_calpreciptype !> This subroutine is written and provided by Jim Ramer at NOAA/ESRL !!(Ramer (1993) \cite ramer_1993). subroutine calwxt_ramer(lm,lp1,t,q,pmid,rh,td,pint,ptyp) @@ -875,7 +871,6 @@ function xmytw(t,td,p) ! and layer lmh = bottom ! !$$$ -!>\ingroup gfs_calpreciptype !>this routine computes precipitation type using a decision tree !! approach that uses the so-called "energy method" of Bourgouin(2000) !! \cite bourgouin_2000. @@ -1044,7 +1039,6 @@ subroutine calwxt_bourg(lm,lp1,rn,g,t,q,pmid,pint,zint,ptype) return end ! -!>\ingroup gfs_calpreciptype !> This subroutine computes precipitation type using a decision tree !! approach that uses variables such as integrated wet bulb temperature !! below freezing and lowest layer temperature (Baldwin et al.1994 @@ -1307,7 +1301,6 @@ subroutine calwxt_revised(lm,lp1,t,q,pmid,pint, & return end ! -!>\ingroup gfs_calpreciptype !> This subroutine takes the precipitation type solutions from !! different algorithms and sums them up to give a dominant type. !! diff --git a/physics/MP/module_mp_radar.F90 b/physics/MP/module_mp_radar.F90 index 96a4348d0..bf290e516 100644 --- a/physics/MP/module_mp_radar.F90 +++ b/physics/MP/module_mp_radar.F90 @@ -68,8 +68,7 @@ MODULE module_mp_radar !+---+-----------------------------------------------------------------+ !+---+-----------------------------------------------------------------+ -!>\ingroup thompson_radar -!! +!> subroutine radar_init IMPLICIT NONE @@ -189,13 +188,11 @@ end subroutine radar_init !+---+-----------------------------------------------------------------+ !+---+-----------------------------------------------------------------+ -!>\ingroup thompson_radar - COMPLEX*16 FUNCTION m_complex_water_ray(lambda,T) - !> Complex refractive Index of Water as function of Temperature T !! [deg C] and radar wavelength lambda [m]; valid for !! lambda in [0.001,1.0] m; T in [-10.0,30.0] deg C !! after Ray (1972) + COMPLEX*16 FUNCTION m_complex_water_ray(lambda,T) IMPLICIT NONE DOUBLE PRECISION, INTENT(IN):: T,lambda @@ -264,8 +261,7 @@ END FUNCTION m_complex_ice_maetzler !+---+-----------------------------------------------------------------+ -!>ingroup thompson_radar -!! +!> subroutine rayleigh_soak_wetgraupel (x_g, a_geo, b_geo, fmelt, & meltratio_outside, m_w, m_i, lambda, C_back, & mixingrule,matrix,inclusion, & @@ -362,8 +358,7 @@ subroutine rayleigh_soak_wetgraupel (x_g, a_geo, b_geo, fmelt, & end subroutine rayleigh_soak_wetgraupel !+---+-----------------------------------------------------------------+ -!>\ingroup thompson_radar -!! +!> complex*16 function get_m_mix_nested (m_a, m_i, m_w, volair, & volice, volwater, mixingrule, host, matrix, & inclusion, hostmatrix, hostinclusion, cumulerror) @@ -493,8 +488,7 @@ complex*16 function get_m_mix_nested (m_a, m_i, m_w, volair, & end function get_m_mix_nested !+---+-----------------------------------------------------------------+ -!>\ingroup thompson_radar -!! +!> COMPLEX*16 FUNCTION get_m_mix (m_a, m_i, m_w, volair, volice, & volwater, mixingrule, matrix, inclusion, error) @@ -535,8 +529,7 @@ COMPLEX*16 FUNCTION get_m_mix (m_a, m_i, m_w, volair, volice, & END FUNCTION get_m_mix !+---+-----------------------------------------------------------------+ -!>\ingroup thompson_radar -!! +!> COMPLEX*16 FUNCTION m_complex_maxwellgarnett(vol1, vol2, vol3, & m1, m2, m3, inclusion, error) @@ -584,7 +577,7 @@ COMPLEX*16 FUNCTION m_complex_maxwellgarnett(vol1, vol2, vol3, & END FUNCTION m_complex_maxwellgarnett !+---+-----------------------------------------------------------------+ -!>\ingroup thompson_radar +!> REAL FUNCTION GAMMLN(XX) ! --- RETURNS THE VALUE LN(GAMMA(XX)) FOR XX > 0. IMPLICIT NONE @@ -610,7 +603,7 @@ REAL FUNCTION GAMMLN(XX) END FUNCTION GAMMLN ! (C) Copr. 1986-92 Numerical Recipes Software 2.02 !+---+-----------------------------------------------------------------+ -!>\ingroup thompson_radar +!> REAL FUNCTION WGAMMA(y) IMPLICIT NONE diff --git a/physics/MP/GFDL/multi_gases.F90 b/physics/MP/multi_gases.F90 similarity index 100% rename from physics/MP/GFDL/multi_gases.F90 rename to physics/MP/multi_gases.F90 diff --git a/physics/PBL/HEDMF/hedmf.f b/physics/PBL/HEDMF/hedmf.f index 4b010a121..b75526ba6 100644 --- a/physics/PBL/HEDMF/hedmf.f +++ b/physics/PBL/HEDMF/hedmf.f @@ -104,7 +104,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & real(kind=kind_phys), intent(inout) :: dv(:,:), du(:,:), & & tau(:,:), rtg(:,:,:) ! dtend is only allocated if ldiag3d or qdiag3d are true - real(kind=kind_phys), intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: index_of_x_wind, index_of_y_wind, & & index_of_process_pbl, index_of_temperature, ntqv, rtg_ozone_index diff --git a/physics/PBL/HEDMF/hedmf.meta b/physics/PBL/HEDMF/hedmf.meta index be0c83741..3d9b492c0 100644 --- a/physics/PBL/HEDMF/hedmf.meta +++ b/physics/PBL/HEDMF/hedmf.meta @@ -530,8 +530,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - active = (flag_for_diagnostics_3D) intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/PBL/MYJ/myjpbl_wrapper.F90 b/physics/PBL/MYJ/myjpbl_wrapper.F90 index 387007ca3..cfa4fff09 100644 --- a/physics/PBL/MYJ/myjpbl_wrapper.F90 +++ b/physics/PBL/MYJ/myjpbl_wrapper.F90 @@ -32,29 +32,29 @@ end subroutine myjpbl_wrapper_init !! !###=================================================================== SUBROUTINE myjpbl_wrapper_run( & - & restart,do_myjsfc, & - & im,levs,dt_phs, & - & kdt,ntrac,ntke, & - & ntcw,ntiw,ntrw,ntsw,ntgl, & - & ugrs, vgrs, tgrs, qgrs, & - & prsl, prsi, phii, hprime1, & - & prsik_1, prslk_1, prslki, tsfc, qsfc, & - & phy_myj_qsfc, phy_myj_thz0, phy_myj_qz0, & - & phy_myj_uz0, phy_myj_vz0, phy_myj_z0base, & - & phy_myj_akhs, phy_myj_akms, & - & phy_myj_chkqlm, phy_myj_elflx, & - & phy_myj_a1u, phy_myj_a1t, phy_myj_a1q, & - & pblh, kpbl, kinver, slmsk, & - & garea, ustar, cm, ch, wind, & - & snowd, zorl, evap, hflx, & - & dudt, dvdt, dtdt, dqdt, & - & dusfc,dvsfc,dtsfc,dqsfc, & - & dkt,xkzm_m, xkzm_h,xkzm_s, gamt,gamq, & - & con_cp,con_g,con_rd, & - & me, lprnt, gen_tend, ldiag3d, dtend, dtidx, & - & index_of_temperature, index_of_x_wind, & - & index_of_y_wind, index_of_process_pbl, & - & ntqv, errmsg, errflg ) + restart,do_myjsfc, & + im,levs,dt_phs, & + kdt,ntrac,ntke, & + ntcw,ntiw,ntrw,ntsw,ntgl, & + ugrs, vgrs, tgrs, qgrs, & + prsl, prsi, phii, hprime1, & + prsik_1, prslk_1, prslki, tsfc, qsfc, & + phy_myj_qsfc, phy_myj_thz0, phy_myj_qz0, & + phy_myj_uz0, phy_myj_vz0, phy_myj_z0base, & + phy_myj_akhs, phy_myj_akms, & + phy_myj_chkqlm, phy_myj_elflx, & + phy_myj_a1u, phy_myj_a1t, phy_myj_a1q, & + pblh, kpbl, kinver, slmsk, & + garea, ustar, cm, ch, wind, & + snowd, zorl, evap, hflx, & + dudt, dvdt, dtdt, dqdt, & + dusfc,dvsfc,dtsfc,dqsfc, & + dkt,xkzm_m, xkzm_h,xkzm_s, gamt,gamq, & + con_cp,con_g,con_rd, & + me, lprnt, gen_tend, ldiag3d, dtend, dtidx, & + index_of_temperature, index_of_x_wind, & + index_of_y_wind, index_of_process_pbl, & + ntqv, errmsg, errflg ) ! @@ -92,7 +92,7 @@ SUBROUTINE myjpbl_wrapper_run( & real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:) integer, intent(in) :: index_of_temperature, index_of_x_wind, & - & index_of_y_wind, index_of_process_pbl, ntqv + index_of_y_wind, index_of_process_pbl, ntqv !MYJ-1D integer,intent(in) :: im, levs @@ -104,18 +104,18 @@ SUBROUTINE myjpbl_wrapper_run( & !MYJ-2D real(kind=kind_phys),dimension(:),intent(in) :: & - & prsik_1, prslk_1, prslki, slmsk, garea, & + prsik_1, prslk_1, prslki, slmsk, garea, & snowd, evap, hflx, cm, ch, wind, hprime1 real(kind=kind_phys),dimension(:),intent(inout) :: & - & zorl, ustar, tsfc, qsfc - real(kind=kind_phys),dimension(:),intent(inout) :: & - & phy_myj_qsfc, phy_myj_thz0, phy_myj_qz0, & - & phy_myj_uz0, phy_myj_vz0, phy_myj_z0base, & - & phy_myj_akhs, phy_myj_akms, & - & phy_myj_chkqlm, phy_myj_elflx, & - & phy_myj_a1u, phy_myj_a1t, phy_myj_a1q + zorl, ustar, tsfc, qsfc + real(kind=kind_phys),dimension(:),intent(inout),optional :: & + phy_myj_thz0, phy_myj_z0base, phy_myj_chkqlm, & + phy_myj_akhs, phy_myj_akms, phy_myj_qz0, & + phy_myj_qsfc, phy_myj_elflx, phy_myj_a1u, & + phy_myj_a1t, phy_myj_a1q, phy_myj_uz0, & + phy_myj_vz0 real(kind=kind_phys),dimension(:),intent(out) :: & - & pblh,dusfc,dvsfc,dtsfc,dqsfc,gamt,gamq + pblh,dusfc,dvsfc,dtsfc,dqsfc,gamt,gamq integer,dimension(:),intent(out) :: kpbl integer,dimension(:),intent(in) :: kinver @@ -123,7 +123,7 @@ SUBROUTINE myjpbl_wrapper_run( & real(kind=kind_phys),dimension(:,:),intent(in) :: & phii, prsi real(kind=kind_phys),dimension(:,:),intent(in) :: & - & ugrs, vgrs, tgrs, prsl + ugrs, vgrs, tgrs, prsl ! real(kind=kind_phys),dimension(:,:),intent(inout) :: & ! dudt, dvdt, dtdt, dkt real(kind=kind_phys),dimension(:,:),intent(inout) :: & @@ -133,7 +133,7 @@ SUBROUTINE myjpbl_wrapper_run( & !MYJ-4D real(kind=kind_phys),dimension(:,:,:),intent(inout) :: & - & qgrs,dqdt + qgrs,dqdt !LOCAL integer :: ntsd, k, k1, i, kx1 @@ -150,8 +150,8 @@ SUBROUTINE myjpbl_wrapper_run( & ustar1,z0,pblh_myj, & elflx,mixht,ct real(kind=kfpt), dimension(im,levs) :: & - & u_myj, v_myj, t_myj, q_myj, th_myj, & - & cw, dz_myj, pmid, q2, exner, del + u_myj, v_myj, t_myj, q_myj, th_myj, & + cw, dz_myj, pmid, q2, exner, del real(kind=kfpt), dimension(im,levs+1) :: pint real(kind=kfpt),dimension(im,levs) :: & rublten,rvblten,rthblten,rqvblten,rqcblten @@ -161,15 +161,15 @@ SUBROUTINE myjpbl_wrapper_run( & real(kind=kfpt),dimension(im) :: thlm,qlm real(kind=kfpt),dimension(im,13) :: phy_f2d_myj real(kind=kfpt), dimension(im,levs) :: xcofh & - & ,xkzo,xkzmo + ,xkzo,xkzmo real(kind=kind_phys) :: g, r_d, g_inv, cappa real(kind=kind_phys) :: thz0, qz0, a1u, a1t, a1q real(kind=kind_phys) :: z0m, aa1u, aa1t, z1uov, z1tox real(kind=kind_phys) :: tmax,tmin,t_myj1 real(kind=kind_phys),dimension(im) :: & - & thsfc,sfcz,tsfc1, & - & sm,work3,wind1,work4 & - & ,rho,qfc1,gdx,xkzm_hx,xkzm_mx,tx1, tx2 + thsfc,sfcz,tsfc1, & + sm,work3,wind1,work4 & + ,rho,qfc1,gdx,xkzm_hx,xkzm_mx,tx1, tx2 ! real(kind=kind_phys), dimension(im,levs,ntrac) :: & ! & qgrs_myj real(kind=kind_phys),dimension(im,levs) :: dkt2 diff --git a/physics/PBL/MYJ/myjpbl_wrapper.meta b/physics/PBL/MYJ/myjpbl_wrapper.meta index 281396eed..9b76ac453 100644 --- a/physics/PBL/MYJ/myjpbl_wrapper.meta +++ b/physics/PBL/MYJ/myjpbl_wrapper.meta @@ -238,6 +238,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_thz0] standard_name = air_potential_temperature_at_top_of_viscous_sublayer long_name = potential temperat at viscous sublayer top over water @@ -246,6 +247,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_qz0] standard_name = specific_humidity_at_top_of_viscous_sublayer long_name = specific humidity at_viscous sublayer top over water @@ -254,6 +256,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_uz0] standard_name = x_wind_at_top_of_viscous_sublayer long_name = u wind component at viscous sublayer top over water @@ -262,6 +265,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_vz0] standard_name = y_wind_at_top_of_viscous_sublayer long_name = v wind component at viscous sublayer top over water @@ -270,6 +274,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_z0base] standard_name = baseline_surface_roughness_length long_name = baseline surface roughness length for momentum in mete @@ -278,6 +283,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_akhs] standard_name = heat_exchange_coefficient_for_MYJ_schemes long_name = surface heat exchange_coefficient for MYJ schemes @@ -286,6 +292,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_akms] standard_name = momentum_exchange_coefficient_for_MYJ_schemes long_name = surface momentum exchange_coefficient for MYJ schemes @@ -294,6 +301,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_chkqlm] standard_name = control_for_surface_layer_evaporation long_name = surface layer evaporation switch @@ -302,6 +310,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_elflx] standard_name = surface_upward_specific_humidity_flux_for_mellor_yamada_janjic_surface_layer_scheme long_name = kinematic surface latent heat flux @@ -310,6 +319,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_a1u] standard_name = weight_for_momentum_at_top_of_viscous_sublayer long_name = Weight for momentum at viscous layer top @@ -318,6 +328,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_a1t] standard_name = weight_for_potental_temperature_at_top_of_viscous_sublayer long_name = Weight for potental temperature at viscous layer top @@ -326,6 +337,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_a1q] standard_name = weight_for_specific_humidity_at_top_of_viscous_sublayer long_name = Weight for Specfic Humidity at viscous layer top @@ -334,6 +346,7 @@ type = real kind = kind_phys intent = inout + optional = True [pblh] standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness @@ -594,6 +607,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/PBL/MYNN_EDMF/bl_mynn_common.f90 b/physics/PBL/MYNN_EDMF/bl_mynn_common.f90 index 3e02f94b0..47b172808 100644 --- a/physics/PBL/MYNN_EDMF/bl_mynn_common.f90 +++ b/physics/PBL/MYNN_EDMF/bl_mynn_common.f90 @@ -7,7 +7,7 @@ !! module (module_bl_mynn) further below: !>\ingroup gp_mynnedmf -!! Define Model-specific constants/parameters +!! This module defines model-specific constants/parameters. module bl_mynn_common !------------------------------------------ diff --git a/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 index a0f647083..509c50c45 100644 --- a/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 +++ b/physics/PBL/MYNN_EDMF/module_bl_mynn.F90 @@ -248,6 +248,7 @@ ! Many of these changes are now documented in references listed above. !==================================================================== +!> This module contains the entity of MYNN-EDMF PBL scheme MODULE module_bl_mynn use bl_mynn_common,only: & @@ -350,12 +351,12 @@ MODULE module_bl_mynn CONTAINS ! ================================================================== -!>\ingroup gsd_mynn_edmf -!! This subroutine is the GSD MYNN-EDNF PBL driver routine,which +!>\ingroup gp_mynnedmf +!! This subroutine is the MYNN-EDNF PBL driver routine,which !! encompassed the majority of the subroutines that comprise the !! procedures that ultimately solve for tendencies of !! \f$U, V, \theta, q_v, q_c, and q_i\f$. -!!\section gen_mynn_bl_driver GSD mynn_bl_driver General Algorithm +!!\section gen_mynn_bl_driver mynn_bl_driver General Algorithm !> @{ SUBROUTINE mynn_bl_driver( & &initflag,restart,cycling, & @@ -452,10 +453,6 @@ SUBROUTINE mynn_bl_driver( & ! closure : <= 2.5; Level 2.5 ! 2.5< and <3; Level 2.6 ! = 3; Level 3 - -! SGT: Changed this to use assumed shape arrays (dimension(:,:,:)) with no "optional" arguments -! to prevent a crash on Cheyenne. Do not change it back without testing if the code runs -! on Cheyenne with the GNU compiler. real(kind_phys), intent(in) :: delt real(kind_phys), dimension(:), intent(in) :: dx @@ -467,7 +464,9 @@ SUBROUTINE mynn_bl_driver( & real(kind_phys), dimension(:), intent(in):: ust, & &ch,qsfc,ps,wspd real(kind_phys), dimension(:,:), intent(inout) :: & - &Qke,Tsq,Qsq,Cov,qke_adv + &Qke,Tsq,Qsq,Cov + real(kind_phys), dimension(:,:), intent(inout) :: & + &qke_adv real(kind_phys), dimension(:,:), intent(inout) :: & &rublten,rvblten,rthblten,rqvblten,rqcblten, & &rqiblten,rqsblten,rqniblten,rqncblten, & @@ -480,7 +479,7 @@ SUBROUTINE mynn_bl_driver( & &ts,znt,hfx,qfx,uoce,voce !These 10 arrays are only allocated when bl_mynn_output > 0 - real(kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & & edmf_a,edmf_w,edmf_qt,edmf_thl,edmf_ent,edmf_qc, & & sub_thl3D,sub_sqv3D,det_thl3D,det_sqv3D @@ -493,14 +492,16 @@ SUBROUTINE mynn_bl_driver( & real(kind_phys), dimension(ims:ime) :: psig_bl,psig_shcu integer,dimension(:),intent(INOUT) :: & - &KPBL,ktop_plume + &KPBL + integer,dimension(:),intent(INOUT) :: & + &ktop_plume real(kind_phys), dimension(:), intent(out) :: & &maxmf,maxwidth,ztop_plume real(kind_phys), dimension(:,:), intent(inout) :: el_pbl - real(kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & &qWT,qSHEAR,qBUOY,qDISS,dqke ! 3D budget arrays are not allocated when tke_budget == 0 ! 1D (local) budget arrays are used for passing between subroutines. @@ -509,16 +510,17 @@ SUBROUTINE mynn_bl_driver( & real(kind_phys), dimension(:,:), intent(out) :: Sh3D,Sm3D - real(kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout) :: & &qc_bl,qi_bl,cldfra_bl real(kind_phys), dimension(kts:kte) :: qc_bl1D,qi_bl1D, & &cldfra_bl1D,qc_bl1D_old,qi_bl1D_old,cldfra_bl1D_old ! smoke/chemical arrays integer, intent(IN ) :: nchem, kdvel, ndvel - real(kind_phys), dimension(:,:,:), intent(INOUT) :: chem3d - real(kind_phys), dimension(:,:), intent(IN) :: vdep - real(kind_phys), dimension(:), intent(IN) :: frp,EMIS_ANT_NO + real(kind_phys), dimension(:,:,:), intent(INOUT), optional :: chem3d + real(kind_phys), dimension(:,:), intent(IN), optional :: vdep + real(kind_phys), dimension(:), intent(IN), optional :: frp + real(kind_phys), dimension(:), intent(IN) :: EMIS_ANT_NO !local real(kind_phys), dimension(kts:kte ,nchem) :: chem1 real(kind_phys), dimension(kts:kte+1,nchem) :: s_awchem1 @@ -575,7 +577,7 @@ SUBROUTINE mynn_bl_driver( & ! Stochastic fields integer, intent(IN) :: spp_pbl - real(kind_phys), dimension(:,:), intent(IN) :: pattern_spp_pbl + real(kind_phys), dimension(:,:), intent(IN), optional :: pattern_spp_pbl real(kind_phys), dimension(KTS:KTE) :: rstoch_col ! Substepping TKE @@ -1505,10 +1507,10 @@ END SUBROUTINE mynn_bl_driver ! !------------------------------------------------------------------- -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine initializes the mixing length, TKE, \f$\theta^{'2}\f$, !! \f$q^{'2}\f$, and \f$\theta^{'}q^{'}\f$. -!!\section gen_mym_ini GSD MYNN-EDMF mym_initialize General Algorithm +!!\section gen_mym_ini MYNN-EDMF mym_initialize General Algorithm !> @{ SUBROUTINE mym_initialize ( & & kts,kte,xland, & @@ -1691,7 +1693,7 @@ END SUBROUTINE mym_initialize ! These are defined on the walls of the grid boxes. ! -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine calculates the level 2, non-dimensional wind shear !! \f$G_M\f$ and vertical temperature gradient \f$G_H\f$ as well as !! the level 2 stability funcitons \f$S_h\f$ and \f$S_m\f$. @@ -1712,7 +1714,7 @@ END SUBROUTINE mym_initialize !!\param gh \f$G_H\f$ divided by \f$L^{2}/q^{2}\f$ (\f$s^{-2}\f$) !!\param sm stability function for momentum, at Level 2 !!\param sh stability function for heat, at Level 2 -!!\section gen_mym_level2 GSD MYNN-EDMF mym_level2 General Algorithm +!!\section gen_mym_level2 MYNN-EDMF mym_level2 General Algorithm !! @ { SUBROUTINE mym_level2 (kts,kte, & & dz, & @@ -1843,7 +1845,7 @@ END SUBROUTINE mym_level2 ! NOTE: the mixing lengths are meant to be calculated at the full- ! sigmal levels (or interfaces beween the model layers). ! -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine calculates the mixing lengths. SUBROUTINE mym_length ( & & kts,kte,xland, & @@ -2242,7 +2244,7 @@ SUBROUTINE mym_length ( & END SUBROUTINE mym_length ! ================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine was taken from the BouLac scheme in WRF-ARW and modified for !! integration into the MYNN PBL scheme. WHILE loops were added to reduce the !! computational expense. This subroutine computes the length scales up and down @@ -2405,7 +2407,7 @@ SUBROUTINE boulac_length0(k,kts,kte,zw,dz,qtke,theta,lb1,lb2) END SUBROUTINE boulac_length0 ! ================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine was taken from the BouLac scheme in WRF-ARW !! and modified for integration into the MYNN PBL scheme. !! WHILE loops were added to reduce the computational expense. @@ -2596,10 +2598,10 @@ END SUBROUTINE boulac_length ! # dtl, dqw, dtv, gm and gh are allowed to share storage units with ! dfm, dfh, dfq, tcd and qcd, respectively, for saving memory. ! -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine calculates the vertical diffusivity coefficients and the !! production terms for the turbulent quantities. -!>\section gen_mym_turbulence GSD mym_turbulence General Algorithm +!>\section gen_mym_turbulence mym_turbulence General Algorithm !! Two subroutines mym_level2() and mym_length() are called within this !!subrouine to collect variable to carry out successive calculations: !! - mym_level2() calculates the level 2 nondimensional wind shear \f$G_M\f$ @@ -2626,7 +2628,7 @@ SUBROUTINE mym_turbulence ( & & sh, sm, & & El, & & Dfm, Dfh, Dfq, Tcd, Qcd, Pdk, Pdt, Pdq, Pdc, & - & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D, & + & qWT1D,qSHEAR1D,qBUOY1D,qDISS1D, & & tke_budget, & & Psig_bl,Psig_shcu,cldfra_bl1D, & & bl_mynn_mixlength, & @@ -3190,7 +3192,7 @@ END SUBROUTINE mym_turbulence ! scheme (program). ! !------------------------------------------------------------------- -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine predicts the turbulent quantities at the next step. SUBROUTINE mym_predict (kts,kte, & & closure, & @@ -3593,7 +3595,7 @@ END SUBROUTINE mym_predict ! Set these values to those adopted by you. ! !------------------------------------------------------------------- -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine calculates the nonconvective component of the !! subgrid cloud fraction and mixing ratio as well as the functions used to !! calculate the buoyancy flux. Different cloud PDFs can be selected by @@ -4020,7 +4022,7 @@ SUBROUTINE mym_condensation (kts,kte, & END SUBROUTINE mym_condensation ! ================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine solves for tendencies of U, V, \f$\theta\f$, qv, !! qc, and qi SUBROUTINE mynn_tendencies(kts,kte,i, & @@ -5354,7 +5356,7 @@ SUBROUTINE mynn_mix_chem(kts,kte,i, & END SUBROUTINE mynn_mix_chem ! ================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf SUBROUTINE retrieve_exchange_coeffs(kts,kte,& &dfm,dfh,dz,K_m,K_h) @@ -5382,7 +5384,7 @@ SUBROUTINE retrieve_exchange_coeffs(kts,kte,& END SUBROUTINE retrieve_exchange_coeffs ! ================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf SUBROUTINE tridiag(n,a,b,c,d) !! to solve system of linear eqs on tridiagonal matrix n times n @@ -5418,7 +5420,7 @@ SUBROUTINE tridiag(n,a,b,c,d) END SUBROUTINE tridiag ! ================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf subroutine tridiag2(n,a,b,c,d,x) implicit none ! a - sub-diagonal (means it is the diagonal below the main diagonal) @@ -5453,7 +5455,7 @@ subroutine tridiag2(n,a,b,c,d,x) end subroutine tridiag2 ! ================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf subroutine tridiag3(kte,a,b,c,d,x) !ccccccccccccccccccccccccccccccc @@ -5495,7 +5497,7 @@ subroutine tridiag3(kte,a,b,c,d,x) end subroutine tridiag3 ! ================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine calculates hybrid diagnotic boundary-layer height (PBLH). !! !! NOTES ON THE PBLH FORMULATION: The 1.5-theta-increase method defines @@ -5512,7 +5514,7 @@ end subroutine tridiag3 !!the TKE-method more during stable conditions (PBLH < 400 m). !!A variable tke threshold (TKEeps) is used since no hard-wired !!value could be found to work best in all conditions. -!>\section gen_get_pblh GSD get_pblh General Algorithm +!>\section gen_get_pblh get_pblh General Algorithm !> @{ SUBROUTINE GET_PBLH(KTS,KTE,zi,thetav1D,qke1D,zw1D,dz1D,landsea,kzi) @@ -5658,7 +5660,7 @@ END SUBROUTINE GET_PBLH !> @} ! ================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine is the Dynamic Multi-Plume (DMP) Mass-Flux Scheme. !! !! dmp_mf() calculates the nonlocal turbulent transport from the dynamic @@ -6824,7 +6826,7 @@ SUBROUTINE DMP_mf( & END SUBROUTINE DMP_MF !================================================================= -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This subroutine subroutine condensation_edmf(QT,THL,P,zagl,THV,QC) ! @@ -7384,7 +7386,7 @@ SUBROUTINE SCALE_AWARE(dx,PBL1,Psig_bl,Psig_shcu) END SUBROUTINE SCALE_AWARE ! ===================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! \author JAYMES- added 22 Apr 2015 !! This function calculates saturation vapor pressure. Separate ice and liquid functions !! are used (identical to those in module_mp_thompson.F, v3.6). Then, the @@ -7438,7 +7440,7 @@ END FUNCTION esat_blend ! ==================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This function extends function "esat" and returns a "blended" !! saturation mixing ratio. Tice currently set to 240 K, t0c = 273.15 K. !!\author JAYMES @@ -7495,7 +7497,7 @@ END FUNCTION qsat_blend ! =================================================================== -!>\ingroup gsd_mynn_edmf +!>\ingroup gp_mynnedmf !! This function interpolates the latent heats of vaporization and sublimation into !! a single, temperature-dependent, "blended" value, following !! Chaboureau and Bechtold (2002) \cite Chaboureau_2002, Appendix. diff --git a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 index 487753027..ff2e9e24f 100644 --- a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.F90 @@ -140,7 +140,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & ! <=== ntlnc, ntinc & dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc,& ! <=== ntwa, ntia & dqdt_cccn, & ! <=== ntccn - & flag_for_pbl_generic_tend, & + & tmf, flag_for_pbl_generic_tend, & & dtend, dtidx, index_of_temperature, & & index_of_x_wind, index_of_y_wind, ntke, & & ntqv, ntcw, ntiw, ntsw, & @@ -155,7 +155,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & icloud_bl, do_mynnsfclay, & & imp_physics, imp_physics_gfdl, & & imp_physics_thompson, imp_physics_wsm6, & - & imp_physics_fa, & + & imp_physics_fa, imfdeepcnv, imfdeepcnv_c3, & + & imfdeepcnv_samf, & & chem3d, frp, mix_chem, rrfs_sd, enh_mix, & & nchem, ndvel, vdep, smoke_dbg, & & imp_physics_nssl, nssl_ccn_on, & @@ -172,7 +173,7 @@ SUBROUTINE mynnedmf_wrapper_run( & implicit none !------------------------------------------------------------------- - real(kind_phys) :: huge + real(kind_phys), intent(in) :: huge character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -205,7 +206,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & bl_mynn_output, & & imp_physics, imp_physics_wsm6, & & imp_physics_thompson, imp_physics_gfdl, & - & imp_physics_nssl, imp_physics_fa, & + & imp_physics_nssl, imp_physics_fa, imfdeepcnv, & + & imfdeepcnv_c3, imfdeepcnv_samf, & & spp_pbl, & & tke_budget real(kind_phys), intent(in) :: & @@ -244,38 +246,43 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind_phys), dimension(:,:), intent(inout) :: & & dtdt, dudt, dvdt, & & dqdt_water_vapor, dqdt_liquid_cloud, dqdt_ice, & - & dqdt_snow, & - & dqdt_cloud_droplet_num_conc, dqdt_ice_num_conc, & - & dqdt_ozone, dqdt_water_aer_num_conc, dqdt_ice_aer_num_conc - real(kind_phys), dimension(:,:), intent(inout) ::dqdt_cccn + & dqdt_snow, dqdt_ice_num_conc, dqdt_ozone + real(kind_phys), dimension(:,:), intent(inout), optional :: & + & dqdt_cloud_droplet_num_conc, dqdt_water_aer_num_conc, & + & dqdt_ice_aer_num_conc + real(kind_phys), dimension(:,:), intent(inout) :: qke, & + & EL_PBL, Sh3D, Sm3D, qc_bl, qi_bl, cldfra_bl + real(kind_phys), dimension(:,:), intent(inout), optional :: & + & dqdt_cccn real(kind_phys), dimension(:,:), intent(inout) :: & - & qke, qke_adv, EL_PBL, Sh3D, Sm3D, & - & qc_bl, qi_bl, cldfra_bl + & qke_adv + real(kind_phys), dimension(:,:,:), intent(out) :: tmf !These 10 arrays are only allocated when bl_mynn_output > 0 - real(kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(inout), optional :: & & edmf_a,edmf_w,edmf_qt, & & edmf_thl,edmf_ent,edmf_qc, & & sub_thl,sub_sqv,det_thl,det_sqv real(kind_phys), dimension(:,:), intent(inout) :: & - & dqke,qWT,qSHEAR,qBUOY,qDISS - real(kind_phys), dimension(:,:), intent(inout) :: & & t3d,qgrs_water_vapor,qgrs_liquid_cloud,qgrs_ice, & & qgrs_snow real(kind_phys), dimension(:,:), intent(in) :: & + & qgrs_cloud_ice_num_conc, & & u,v,omega, & & exner,prsl,prsi, & - & qgrs_cloud_droplet_num_conc, & - & qgrs_cloud_ice_num_conc, & - & qgrs_ozone, & + & qgrs_ozone + real(kind_phys), dimension(:,:), intent(in), optional :: & & qgrs_water_aer_num_conc, & + & qgrs_cloud_droplet_num_conc, & & qgrs_ice_aer_num_conc - real(kind_phys), dimension(:,:), intent(in) ::qgrs_cccn + real(kind_phys), dimension(:,:), intent(in), optional :: qgrs_cccn real(kind_phys), dimension(:,:), intent(out) :: & & Tsq, Qsq, Cov, exch_h, exch_m + real(kind_phys), dimension(:,:), intent(out), optional :: & + & dqke, qWT, qSHEAR, qBUOY, qDISS real(kind_phys), dimension(:), intent(in) :: xmu real(kind_phys), dimension(:,:), intent(in) :: htrsw, htrlw ! spp_wts_pbl only allocated if spp_pbl == 1 - real(kind_phys), dimension(:,:), intent(in) :: spp_wts_pbl + real(kind_phys), dimension(:,:), intent(in), optional :: spp_wts_pbl !LOCAL real(kind_phys), dimension(im,levs) :: & @@ -287,10 +294,10 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind_phys), allocatable :: old_ozone(:,:) !smoke/chem arrays - real(kind_phys), dimension(:), intent(inout) :: frp + real(kind_phys), dimension(:), intent(inout), optional :: frp logical, intent(in) :: mix_chem, enh_mix, rrfs_sd - real(kind_phys), dimension(:,:,:), intent(inout) :: chem3d - real(kind_phys), dimension(:,: ), intent(inout) :: vdep + real(kind_phys), dimension(:,:,:), intent(inout), optional :: chem3d + real(kind_phys), dimension(:,: ), intent(in), optional :: vdep real(kind_phys), dimension(im) :: emis_ant_no !MYNN-2D @@ -298,8 +305,9 @@ SUBROUTINE mynnedmf_wrapper_run( & & dx,zorl,slmsk,tsurf,qsfc,ps, & & hflx,qflx,ust,wspd,rb,recmol + real(kind_phys), dimension(:), intent(in), optional :: & + & dusfc_cice,dvsfc_cice,dtsfc_cice,dqsfc_cice real(kind_phys), dimension(:), intent(in) :: & - & dusfc_cice,dvsfc_cice,dtsfc_cice,dqsfc_cice, & & stress_wat,hflx_wat,qflx_wat, & & oceanfrac,fice @@ -310,14 +318,17 @@ SUBROUTINE mynnedmf_wrapper_run( & & pblh,dusfc_diag,dvsfc_diag,dtsfc_diag,dqsfc_diag real(kind_phys), dimension(:), intent(out) :: & & ch,dtsfc1,dqsfc1,dusfc1,dvsfc1, & - & dtsfci_diag,dqsfci_diag,dusfci_diag,dvsfci_diag, & + & dtsfci_diag,dqsfci_diag,dusfci_diag,dvsfci_diag + real(kind_phys), dimension(:), intent(out) :: & & maxMF,maxwidth,ztop_plume integer, dimension(:), intent(inout) :: & - & kpbl,ktop_plume + & kpbl + integer, dimension(:), intent(inout) :: & + & ktop_plume - real(kind_phys), dimension(:), intent(inout) :: & + real(kind_phys), dimension(:), intent(inout), optional :: & & dusfc_cpl,dvsfc_cpl,dtsfc_cpl,dqsfc_cpl - real(kind_phys), dimension(:), intent(inout) :: & + real(kind_phys), dimension(:), intent(inout), optional :: & & dusfci_cpl,dvsfci_cpl,dtsfci_cpl,dqsfci_cpl !LOCAL @@ -550,6 +561,13 @@ SUBROUTINE mynnedmf_wrapper_run( & enddo enddo + do k=1,levs + do i=1,im + tmf(i,k,1)=0. + enddo + enddo + + ! Check incoming moist species to ensure non-negative values ! First, create height difference (dz) do k=1,levs @@ -1023,6 +1041,15 @@ SUBROUTINE mynnedmf_wrapper_run( & deallocate(save_qke_adv) endif + if(imfdeepcnv == imfdeepcnv_c3 .or. imfdeepcnv == imfdeepcnv_samf)then + !LB: save PBL q-tendency for use in prognostic closure + do k=1,levs + do i=1,im + tmf(i,k,1)=dqdt_water_vapor(i,k) + enddo + enddo + endif + CONTAINS SUBROUTINE dtend_helper(itracer,field,mult) diff --git a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta index 00589dfe5..e7b8a5a32 100644 --- a/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta +++ b/physics/PBL/MYNN_EDMF/mynnedmf_wrapper.meta @@ -320,6 +320,7 @@ type = real kind = kind_phys intent = in + optional = True [qgrs_cloud_ice_num_conc] standard_name = mass_number_concentration_of_cloud_ice_water_crystals_in_air long_name = number concentration of ice @@ -344,6 +345,7 @@ type = real kind = kind_phys intent = in + optional = True [qgrs_ice_aer_num_conc] standard_name = mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols long_name = number concentration of ice-friendly aerosols @@ -352,6 +354,7 @@ type = real kind = kind_phys intent = in + optional = True [qgrs_cccn] standard_name = cloud_condensation_nuclei_number_concentration long_name = number concentration of cloud condensation nuclei @@ -360,6 +363,7 @@ type = real kind = kind_phys intent = inout + optional = True [prsl] standard_name = air_pressure long_name = mean layer pressure @@ -568,6 +572,7 @@ type = real kind = kind_phys intent = in + optional = True [dvsfc_cice] standard_name = surface_y_momentum_flux_from_coupled_process long_name = sfc y momentum flux for coupling @@ -576,6 +581,7 @@ type = real kind = kind_phys intent = in + optional = True [dtsfc_cice] standard_name = surface_upward_sensible_heat_flux_from_coupled_process long_name = sfc sensible heat flux for coupling @@ -584,6 +590,7 @@ type = real kind = kind_phys intent = in + optional = True [dqsfc_cice] standard_name = surface_upward_latent_heat_flux_from_coupled_process long_name = sfc latent heat flux for coupling @@ -592,6 +599,7 @@ type = real kind = kind_phys intent = in + optional = True [hflx_wat] standard_name = kinematic_surface_upward_sensible_heat_flux_over_water long_name = kinematic surface upward sensible heat flux over water @@ -661,6 +669,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfci_cpl] standard_name = surface_y_momentum_flux_for_coupling long_name = instantaneous sfc v momentum flux @@ -669,6 +678,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtsfci_cpl] standard_name = surface_upward_sensible_heat_flux_for_coupling long_name = instantaneous sfc sensible heat flux @@ -677,6 +687,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqsfci_cpl] standard_name = surface_upward_latent_heat_flux_for_coupling long_name = instantaneous sfc latent heat flux @@ -685,6 +696,7 @@ type = real kind = kind_phys intent = inout + optional = True [dusfc_cpl] standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc u momentum flux multiplied by timestep @@ -693,6 +705,7 @@ type = real kind = kind_phys intent = inout + optional = True [dvsfc_cpl] standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc v momentum flux multiplied by timestep @@ -701,6 +714,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtsfc_cpl] standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc sensible heat flux multiplied by timestep @@ -709,6 +723,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqsfc_cpl] standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc latent heat flux multiplied by timestep @@ -717,6 +732,7 @@ type = real kind = kind_phys intent = inout + optional = True [recmol] standard_name = reciprocal_of_obukhov_length long_name = one over obukhov length @@ -813,6 +829,7 @@ type = real kind = kind_phys intent = out + optional = True [qwt] standard_name = tke_tendency_due_to_vertical_transport long_name = tke tendency due to vertical transport and diffusion @@ -821,6 +838,7 @@ type = real kind = kind_phys intent = out + optional = True [qshear] standard_name = tke_tendency_due_to_shear long_name = tke tendency due to shear @@ -829,6 +847,7 @@ type = real kind = kind_phys intent = out + optional = True [qbuoy] standard_name = tke_tendency_due_to_buoyancy long_name = tke tendency due to buoyancy production or consumption @@ -837,6 +856,7 @@ type = real kind = kind_phys intent = out + optional = True [qdiss] standard_name = tke_tendency_due_to_dissipation long_name = tke tendency due to the dissipation of tke @@ -845,6 +865,7 @@ type = real kind = kind_phys intent = out + optional = True [PBLH] standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness @@ -892,6 +913,7 @@ type = real kind = kind_phys intent = inout + optional = True [edmf_w] standard_name = emdf_updraft_vertical_velocity long_name = updraft vertical velocity from mass flux scheme @@ -900,6 +922,7 @@ type = real kind = kind_phys intent = inout + optional = True [edmf_qt] standard_name = emdf_updraft_total_water long_name = updraft total water from mass flux scheme @@ -908,6 +931,7 @@ type = real kind = kind_phys intent = inout + optional = True [edmf_thl] standard_name = emdf_updraft_theta_l long_name = updraft theta-l from mass flux scheme @@ -916,6 +940,7 @@ type = real kind = kind_phys intent = inout + optional = True [edmf_ent] standard_name = emdf_updraft_entrainment_rate long_name = updraft entrainment rate from mass flux scheme @@ -924,6 +949,7 @@ type = real kind = kind_phys intent = inout + optional = True [edmf_qc] standard_name = emdf_updraft_cloud_water long_name = updraft cloud water from mass flux scheme @@ -932,6 +958,7 @@ type = real kind = kind_phys intent = inout + optional = True [sub_thl] standard_name = theta_subsidence_tendency long_name = updraft theta subsidence tendency @@ -940,6 +967,7 @@ type = real kind = kind_phys intent = inout + optional = True [sub_sqv] standard_name = water_vapor_subsidence_tendency long_name = updraft water vapor subsidence tendency @@ -948,6 +976,7 @@ type = real kind = kind_phys intent = inout + optional = True [det_thl] standard_name = theta_detrainment_tendency long_name = updraft theta detrainment tendency @@ -956,6 +985,7 @@ type = real kind = kind_phys intent = inout + optional = True [det_sqv] standard_name = water_vapor_detrainment_tendency long_name = updraft water vapor detrainment tendency @@ -964,6 +994,7 @@ type = real kind = kind_phys intent = inout + optional = True [maxwidth] standard_name = maximum_width_of_plumes long_name = maximum width of plumes per grid column @@ -1067,6 +1098,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqdt_ice_num_conc] standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_cloud_ice_water_crystals_in_air long_name = number conc. of ice tendency due to model physics @@ -1083,6 +1115,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqdt_ice_aer_num_conc] standard_name = process_split_cumulative_tendency_of_mass_number_concentration_of_nonhygroscopic_ice_nucleating_aerosols long_name = number conc. of ice-friendly aerosols tendency due to model physics @@ -1091,6 +1124,7 @@ type = real kind = kind_phys intent = inout + optional = True [dqdt_cccn] standard_name = tendency_of_cloud_condensation_nuclei_number_concentration_due_to_model_physics long_name = number concentration of cloud condensation nuclei tendency due to model physics @@ -1099,6 +1133,15 @@ type = real kind = kind_phys intent = inout + optional = True +[tmf] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = out [flag_for_pbl_generic_tend] standard_name = flag_for_generic_tendency_due_to_planetary_boundary_layer long_name = true if GFS_PBL_generic should calculate tendencies @@ -1114,6 +1157,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index @@ -1376,6 +1420,27 @@ dimensions = () type = integer intent = in +[imfdeepcnv] + standard_name = control_for_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv_c3] + standard_name = identifier_for_c3_deep_convection + long_name = flag for C3 deep convection scheme + units = flag + dimensions = () + type = integer + intent = in +[imfdeepcnv_samf] + standard_name = identifer_for_scale_aware_mass_flux_deep_convection + long_name = flag for SAMF deep convection scheme + units = flag + dimensions = () + type = integer + intent = in [nssl_ccn_on] standard_name = nssl_ccn_on long_name = CCN activation flag in NSSL micro @@ -1391,6 +1456,7 @@ type = real kind = kind_phys intent = inout + optional = True [frp] standard_name = frp_hourly long_name = hourly fire radiative power @@ -1399,6 +1465,7 @@ type = real kind = kind_phys intent = inout + optional = True [rrfs_sd] standard_name = do_smoke_coupling long_name = flag controlling rrfs_sd collection (default off) @@ -1442,6 +1509,7 @@ type = real kind = kind_phys intent = in + optional = True [smoke_dbg] standard_name = do_smoke_debug long_name = flag for rrfs smoke plumerise debug @@ -1471,6 +1539,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_pbl] standard_name = control_for_pbl_spp_perturbations long_name = control for pbl spp perturbations diff --git a/physics/PBL/SATMEDMF/mfscu.f b/physics/PBL/SATMEDMF/mfscu.f index e0c184139..a9faa735e 100644 --- a/physics/PBL/SATMEDMF/mfscu.f +++ b/physics/PBL/SATMEDMF/mfscu.f @@ -1,6 +1,8 @@ !>\file mfscu.f !! This file contains the mass flux and downdraft parcel preperties !! parameterization for stratocumulus-top-driven turbulence. + + module mfscu_mod contains !>\ingroup satmedmf diff --git a/physics/PBL/SATMEDMF/mfscuq.f b/physics/PBL/SATMEDMF/mfscuq.f index d690dce05..a934cf5e9 100644 --- a/physics/PBL/SATMEDMF/mfscuq.f +++ b/physics/PBL/SATMEDMF/mfscuq.f @@ -1,5 +1,7 @@ !>\file mfscuq.f -!! This file contains the mass flux and downdraft parcel preperties +!! + +!> This module contains the mass flux and downdraft parcel properties !! parameterization for stratocumulus-top-driven turbulence (updated version). module mfscuq_mod contains @@ -445,6 +447,9 @@ subroutine mfscuq(im,ix,km,kmscu,ntcw,ntrac1,delt, do i = 1, im if(cnvflg(i) .and. & (k >= mrad(i) .and. k < krad(i))) then + if (sigma(i) > ra1(i)) then + xmfd(i,k) = sigma(i) * xmfd(i,k) / ra1(i) + endif xmfd(i,k) = scaldfunc(i) * xmfd(i,k) dz = zl(i,k+1) - zl(i,k) xmmx = dz / dt2 diff --git a/physics/PBL/SATMEDMF/satmedmfvdif.F b/physics/PBL/SATMEDMF/satmedmfvdif.F index 79f7bbea1..43995f88a 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdif.F +++ b/physics/PBL/SATMEDMF/satmedmfvdif.F @@ -42,7 +42,6 @@ subroutine satmedmfvdif_init (satmedmf, end subroutine satmedmfvdif_init !> \defgroup satmedmf GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF) Scheme Module -!! @{ !! \brief This subroutine contains all of the logic for the !! scale-aware TKE-based moist eddy-diffusion mass-flux (TKE-EDMF) scheme. !! @@ -60,7 +59,6 @@ end subroutine satmedmfvdif_init !! -# A mass-flux approach is also used to represent the stratocumulus-top-induced turbulence !! (mfscu.f). !! \section detail_satmedmfvidf GFS satmedmfvdif Detailed Algorithm -!> @{ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & @@ -84,7 +82,8 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & integer, intent(out) :: kpbl(:) ! logical, intent(in) :: gen_tend, ldiag3d - real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend + real(kind=kind_phys), intent(inout), dimension(:,:,:), optional ::& + & dtend integer, intent(in) :: index_of_temperature,index_of_x_wind, & & index_of_y_wind, ntqv, ntoz, dtidx(:,:), index_of_process_pbl ! @@ -1542,6 +1541,5 @@ subroutine satmedmfvdif_run(im,km,ntrac,ntcw,ntiw,ntke, & !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! return end subroutine satmedmfvdif_run -!> @} end module satmedmfvdif diff --git a/physics/PBL/SATMEDMF/satmedmfvdif.meta b/physics/PBL/SATMEDMF/satmedmfvdif.meta index b94e74d6c..2f0e0514d 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdif.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdif.meta @@ -503,7 +503,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - intent = in + intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.F b/physics/PBL/SATMEDMF/satmedmfvdifq.F index 7b54b6d12..5ebb947ac 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.F +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.F @@ -1,12 +1,19 @@ !> \file satmedmfvdifq.F -!! This file contains the CCPP-compliant SATMEDMF scheme (updated version) which + +!> This file contains the CCPP-compliant SATMEDMF scheme (updated version) which !! computes subgrid vertical turbulence mixing using scale-aware TKE-based moist !! eddy-diffusion mass-flux (TKE-EDMF) parameterization (by Jongil Han). +!! if(tte_edmf=.true.), the TKE-EDMF parameterization becomes +!! TTE(total turbulent energy)-based moist (TTE-EDMF) parameterization +!! module satmedmfvdifq use mfpbltq_mod use tridi_mod use mfscuq_mod + !PCC_CANOPY_utilities + use canopy_utils_mod + contains !> \defgroup module_satmedmfvdifq GFS TKE-EDMF PBL Module @@ -26,6 +33,12 @@ module satmedmfvdifq !! with additional improvements on MF working with Cu schemes !! Xiaomin Chen, 5/2/2022 !! +!! Incorporate the TTE-EDMF; if (tte_edmf=.true.), +!! TKE-EDMF scheme becomes TTE-EDMF scheme and the variable 'te' +!! is read as TTE; if (tte_edmf=.false.), the variable 'te' is +!! read as TKE, 5/22/2025 +!! +!! !> \section arg_table_satmedmfvdifq_init Argument Table !! \htmlinclude satmedmfvdifq_init.html !! @@ -72,20 +85,28 @@ end subroutine satmedmfvdifq_init !! (mfpbltq.f), is represented using a mass flux approach (Siebesma et al.(2007) \cite Siebesma_2007 ). !! -# A mass-flux approach is also used to represent the stratocumulus-top-induced turbulence !! (mfscuq.f). -!! \section detail_satmedmfvidfq GFS satmedmfvdifq Detailed Algorithm +!! \section detail_satmedmfvidfq GFS satmedmfvdifq Detailed Algorithm subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & - & ntiw,ntke,grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & - & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu, & - & garea,zvfun,sigmaf, & + & ntiw,ntke,grav,pi,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & +!The following three variables are for SA-3D-TKE + & def_1,def_2,def_3,sa3dtke,dku3d_h,dku3d_e, & + & dv,du,tdt,rtg,u1,v1,t1,q1,usfco,vsfco,use_oceanuv, & + & swh,hlw,xmu,garea,zvfun,sigmaf, & & psk,rbsoil,zorl,u10m,v10m,fm,fh, & & tsea,heat,evap,stress,spd1,kpbl, & - & prsi,del,prsl,prslk,phii,phil,delt, & - & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl,dkt,dku, & + & prsi,del,prsl,prslk,phii,phil,delt,tte_edmf, & + & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl,dkt,dku,tkeh, & & kinver,xkzm_m,xkzm_h,xkzm_s,dspfac,bl_upfr,bl_dnfr, & - & rlmx,elmx,sfc_rlm,tc_pbl, & + & rlmx,elmx,sfc_rlm,tc_pbl,use_lpt, & +!IVAI: canopy inputs from AQM + & do_canopy, cplaqm, claie, cfch, cfrt, cclu, cpopu, & +!IVAI & ntqv,dtend,dtidx,index_of_temperature,index_of_x_wind, & & index_of_y_wind,index_of_process_pbl,gen_tend,ldiag3d, & & errmsg,errflg) +!IVAI: aux arrays +! & naux2d,naux3d,aux2d,aux3d) + ! use machine , only : kind_phys use funcphys , only : fpvs @@ -97,20 +118,30 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & ntke, ntqv integer, intent(in) :: sfc_rlm integer, intent(in) :: tc_pbl + integer, intent(in) :: use_lpt integer, intent(in) :: kinver(:) integer, intent(out) :: kpbl(:) logical, intent(in) :: gen_tend,ldiag3d ! - real(kind=kind_phys), intent(in) :: grav,rd,cp,rv,hvap,hfus,fv, & + real(kind=kind_phys), intent(in) :: grav,pi,rd,cp,rv,hvap,hfus,fv, & & eps,epsm1 real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s real(kind=kind_phys), intent(in) :: dspfac, bl_upfr, bl_dnfr real(kind=kind_phys), intent(in) :: rlmx, elmx +!PCC CANOPY------------------------------------ + logical, intent(in) :: do_canopy, cplaqm +!IVAI: canopy inputs + real(kind=kind_phys), optional, intent(in) :: claie(:), cfch(:), & + & cfrt(:), cclu(:), cpopu(:) + !---------------------------------------------- real(kind=kind_phys), intent(inout) :: dv(:,:), du(:,:), & - & tdt(:,:), rtg(:,:,:) + & tdt(:,:), rtg(:,:,:), tkeh(:,:) real(kind=kind_phys), intent(in) :: & & u1(:,:), v1(:,:), & + & usfco(:), vsfco(:), & & t1(:,:), q1(:,:,:), & +!The following two variables are for SA-3D-TKE + & def_1(:,:), def_2(:,:), def_3(:,:), & & swh(:,:), hlw(:,:), & & xmu(:), garea(:), & & zvfun(:), sigmaf(:), & @@ -123,52 +154,66 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & prsi(:,:), del(:,:), & & prsl(:,:), prslk(:,:), & & phii(:,:), phil(:,:) - real(kind=kind_phys), intent(inout), dimension(:,:,:) :: dtend + real(kind=kind_phys), intent(inout), dimension(:,:,:), optional ::& + & dtend integer, intent(in) :: dtidx(:,:), index_of_temperature, & & index_of_x_wind, index_of_y_wind, index_of_process_pbl + logical, intent(in) :: use_oceanuv real(kind=kind_phys), intent(out) :: & & dusfc(:), dvsfc(:), & & dtsfc(:), dqsfc(:), & & hpbl(:) real(kind=kind_phys), intent(out) :: & & dkt(:,:), dku(:,:) + ! + logical, intent(in) :: sa3dtke !flag for SA-3D-TKE scheme +! +! flag for tke dissipative heating logical, intent(in) :: dspheat +! flag for TTE-EDMF scheme + logical, intent(in) :: tte_edmf +! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg -! flag for tke dissipative heating +!For passing dku to the dyn_core (SA-3D-TKE scheme) + real(kind=kind_phys), intent(out) :: + & dku3d_h(:,:),dku3d_e(:,:) + ! !---------------------------------------------------------------------- !*** !*** local variables + real(kind=kind_phys) spd1_m !*** integer i,is,k,n,ndt,km1,kmpbl,kmscu,ntrac1,idtend integer kps,kbx,kmx integer lcld(im),kcld(im),krad(im),mrad(im) integer kx1(im), kb1(im), kpblx(im) ! - real(kind=kind_phys) tke(im,km), tkeh(im,km-1), e2(im,0:km) + real(kind=kind_phys) te(im,km), tei(im,km-1), tke(im,km), + & tteh(im,km), tesq(im,km-1),e2(im,0:km) ! real(kind=kind_phys) theta(im,km),thvx(im,km), thlvx(im,km), & qlx(im,km), thetae(im,km),thlx(im,km), & slx(im,km), svx(im,km), qtx(im,km), & tvx(im,km), pix(im,km), radx(im,km-1), - & dkq(im,km-1),cku(im,km-1), ckt(im,km-1) + & dkq(im,km-1) ! real(kind=kind_phys) plyr(im,km), rhly(im,km), cfly(im,km), & qstl(im,km) ! real(kind=kind_phys) dtdz1(im), gdx(im), - & phih(im), phim(im), + & phih(im), phim(im), phihs(im), & phims(im), prn(im,km-1), & rbdn(im), rbup(im), thermal(im), & ustar(im), wstar(im), hpblx(im), & ust3(im), wst3(im), rho_a(im), & z0(im), crb(im), tkemean(im), & hgamt(im), hgamq(im), - & wscale(im),vpert(im), - & zol(im), sflux(im), + & wscale(im),vpert(im), thvs(im), + & zol(im), sflux(im), ris(im), & sumx(im), tx1(im), tx2(im) ! real(kind=kind_phys) radmin(im) @@ -182,7 +227,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & ! real(kind=kind_phys) elm(im,km), ele(im,km), & ckz(im,km), chz(im,km), - & diss(im,km-1),prod(im,km-1), + & diss(im,km-1),prod(im,km-1), & bf(im,km-1), shr2(im,km-1), wush(im,km), & xlamue(im,km-1), xlamde(im,km-1), & gotvx(im,km), rlam(im,km-1) @@ -238,32 +283,83 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & rlmn, rlmn0, rlmn1, rlmn2, & ttend, utend, vtend, qtend, & zfac, zfmin, vk, spdk2, - & tkmin, tkbmx, xkgdx, + & tkmin, tkbmx, disste, xkgdx, & xkinv1, xkinv2, & zlup, zldn, cs0, csmf, & tem, tem1, tem2, tem3, & ptem, ptem0, ptem1, ptem2 +! +!The following variables are for SA-3D-TKE + integer kk + real(kind=kind_phys) thetal(im,km),dku_les(im,km),dkt_les(im,km), + & elmh(im,km),ele_les(im,km),pftke(im), + & dkq_les(im,km),pfl(im),pfdx(im), + & dku_h(im,km),dkq_h(im,km), + & elmhfac,elmhmx,ckh,elm_les, + & cpl1,cpl2,cpl3,cpl4,cpl5,cpl6, + & cptke1,cptke2,cptke3 + integer ktkemax(im) + real(kind=kind_phys) tkemax(im),scl(im) + real(kind=kind_phys) sclmax,sclmin,dkmaxles +! end of SA-3D-TKE variables ! real(kind=kind_phys) slfac ! real(kind=kind_phys) vegflo, vegfup, z0lo, z0up, vc0, zc0 ! real(kind=kind_phys) ck0, ck1, ch0, ch1, ce0, rchck +! +! + real(kind=kind_phys) epotte ! real(kind=kind_phys) qlcr, zstblmax, hcrinv ! real(kind=kind_phys) h1 real(kind=kind_phys) bfac, mffac + + real(kind=kind_phys) qice(im,km),qliq(im,km) + +!PCC_CANOPY------------------------------------ + integer COUNTCAN,KCAN + integer kount !IVAI + real(kind=kind_phys) FCH, MOL, HOL, TLCAN, + & SIGMACAN, RRCAN, BBCAN, + & AACAN, ZCAN, ZFL, BOTCAN, + & EDDYVEST1, EDDYVEST_INT + + ! in canopy eddy diffusivity [ m**2/s ] + real(kind=kind_phys), allocatable :: EDDYVESTX ( : ) + ! in canopy layer [m] + real(kind=kind_phys), allocatable :: ZCANX ( : ) + ! Declare local maximum canopy layers + integer, parameter :: MAXCAN = 1000 + integer, parameter :: mvt = 30 ! use 30 instead of 27 + !Based on MODIS IGBP 20 Category Dataset + real :: fch_table(mvt) !< top of canopy (m) + data ( fch_table(i),i=1,mvt) / + & 20.0, 20.0, 18.0, 16.0, 16.0, 1.10, + & 1.10, 13.0, 10.0, 1.00, 5.00, 2.00, + & 15.0, 1.50, 0.00, 0.00, 0.00, 4.00, + & 2.00, 0.50, 0.00, 0.00, 0.00, 0.00, + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / +!---------------------------------------------- + +!IVAI +! integer, intent(in) :: naux2d,naux3d +! real(kind_phys), intent(inout) :: aux2d(:,:) +! real(kind_phys), intent(inout) :: aux3d(:,:,:) +!IVAI + !! parameter(bfac=100.) - parameter(wfac=7.0,cfac=4.5) + parameter(wfac=7.0) parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1) parameter(vk=0.4,rimin=-100.,slfac=0.1) parameter(rbcr=0.25,zolcru=-0.02,tdzmin=1.e-3) parameter(rlmn=30.,rlmn0=5.,rlmn1=5.,rlmn2=10.) - parameter(prmin=0.25,prmax=4.0) - parameter(pr0=1.0,prtke=1.0,prscu=0.67) + parameter(prmin=0.25) + parameter(pr0=1.0,prtke=1.0) parameter(f0=1.e-4,crbmin=0.15,crbmax=0.35) parameter(tkmin=1.e-9,tkbmx=0.2,dspmax=10.0) parameter(qmin=1.e-8,qlmin=1.e-12,zfmin=1.e-8) @@ -271,14 +367,27 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & parameter(elmfac=1.0,elefac=1.0,cql=100.) parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=1000.) parameter(qlcr=3.5e-5,zstblmax=2500.) - parameter(xkinv1=0.4,xkinv2=0.3) + parameter(xkinv1=0.15,xkinv2=0.3) parameter(h1=0.33333333,hcrinv=250.) parameter(vegflo=0.1,vegfup=1.0,z0lo=0.1,z0up=1.0) parameter(vc0=1.0,zc0=1.0) - parameter(ck1=0.15,ch1=0.15) parameter(cs0=0.4,csmf=0.5) parameter(rchck=1.5,ndt=20) - + !The following variables are for SA-3D-TKE + parameter(cpl1=0.280,cpl2=0.870,cpl3=0.913) + parameter(cpl4=0.153,cpl5=0.278,cpl6=0.720) + parameter(cptke1=0.07,cptke2=0.142,cptke3=0.071) + parameter(dkmaxles=300.0,sclmin=500.,sclmax=2500.) + parameter(elmhfac=1.5,elmhmx=1000.,ckh=0.4) +! +!PCC_CANOPY------------------------------------ + if (do_canopy) then + if(.not.allocated(EDDYVESTX)) + & allocate( EDDYVESTX ( MAXCAN ) ) + if(.not.allocated(ZCANX)) + & allocate( ZCANX ( MAXCAN ) ) + endif +!---------------------------------------------- if (tc_pbl == 0) then ck0 = 0.4 ch0 = 0.4 @@ -288,6 +397,21 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & ch0 = 0.55 ce0 = 0.12 endif +! + if(tte_edmf) then + cfac = 3.0 + prmax = 6.0 + prscu = 0.4 + ck1 = 0.16 + ch1 = 0.16 + else + cfac = 4.5 + prmax = 4.0 + prscu = 0.67 + ck1 = 0.15 + ch1 = 0.15 + endif +! gravi = 1.0 / grav g = grav gocp = g / cp @@ -314,7 +438,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & km1 = km - 1 kmpbl = km / 2 kmscu = km / 2 -!> - Compute physical height of the layer centers and interfaces from +!> - Compute physical height of the layer centers and interfaces from !! the geopotential height (\p zi and \p zl) do k=1,km do i=1,im @@ -342,18 +466,33 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & do i=1,im gdx(i) = sqrt(garea(i)) enddo -!> - Initialize tke value at vertical layer centers and interfaces +!> - Initialize tke value at vertical layer centers and interfaces !! from tracer (\p tke and \p tkeh) do k=1,km do i=1,im - tke(i,k) = max(q1(i,k,ntke), tkmin) + te(i,k) = max(q1(i,k,ntke), tkmin) + tkeh(i,k) = 0 + tteh(i,k) = 0 enddo enddo - do k=1,km1 - do i=1,im - tkeh(i,k) = 0.5 * (tke(i,k) + tke(i,k+1)) + if(tte_edmf) then + do k=1,km1 + do i=1,im + tteh(i,k) = 0.5 * (te(i,k) + te(i,k+1)) + enddo enddo - enddo + else + do k = 1, km + do i = 1, im + tke(i,k) = te(i,k) + enddo + enddo + do k=1,km1 + do i=1,im + tkeh(i,k) = 0.5 * (tke(i,k) + tke(i,k+1)) + enddo + enddo + endif !> - Compute reciprocal of \f$ \Delta z \f$ (rdzt) do k = 1,km1 do i=1,im @@ -429,6 +568,8 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & hpbl(i) = 0. kpblx(i) = 1 hpblx(i) = 0. + pfl(i)=1.0 + pftke(i)=1.0 pblflg(i)= .true. sfcflg(i)= .true. if(rbsoil(i) > 0.) sfcflg(i) = .false. @@ -442,11 +583,11 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & kcld(i) = km1 endif enddo -! +! !> - Compute a function for green vegetation fraction and surface roughness. !! Entrainment rate in updraft is a function of vegetation fraction and surface !! roughness length -! +! do i = 1,im tem = (sigmaf(i) - vegflo) / (vegfup - vegflo) tem = min(max(tem, 0.), 1.) @@ -457,20 +598,30 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & enddo ! !> - Compute \f$\theta\f$(theta), and \f$q_l\f$(qlx), \f$\theta_e\f$(thetae), -!! \f$\theta_v\f$(thvx),\f$\theta_{l,v}\f$ (thlvx) including ice water +!! \f$\theta_v\f$(thvx),\f$\theta_{l,v}\f$ (thlvx) including ice water do k=1,km do i=1,im pix(i,k) = psk(i) / prslk(i,k) theta(i,k) = t1(i,k) * pix(i,k) + qice(i,k) = 0.0 + qliq(i,k) = 0.0 if(ntiw > 0) then tem = max(q1(i,k,ntcw),qlmin) - tem1 = max(q1(i,k,ntiw),qlmin) + qliq(i,k) = tem + if(sa3dtke) then + tem1=max(q1(i,k,ntiw)+q1(i,k,5)+q1(i,k,6),qlmin) !for SA-3D-TKE + qice(i,k) = tem1 + else + tem1=max(q1(i,k,ntiw),qlmin) + qice(i,k) = tem1 + endif qlx(i,k) = tem + tem1 ptem = hvap*tem + (hvap+hfus)*tem1 - slx(i,k) = cp * t1(i,k) + phil(i,k) - ptem + slx(i,k) = cp * t1(i,k) + phil(i,k) - ptem else qlx(i,k) = max(q1(i,k,ntcw),qlmin) - slx(i,k) = cp * t1(i,k) + phil(i,k) - hvap*qlx(i,k) + slx(i,k) = cp * t1(i,k) + phil(i,k) - hvap*qlx(i,k) + qliq(i,k) = qlx(i,k) endif tem2 = 1.+fv*max(q1(i,k,1),qmin)-qlx(i,k) thvx(i,k) = theta(i,k) * tem2 @@ -485,8 +636,8 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & gotvx(i,k) = g / thvx(i,k) enddo enddo - -!> - Compute an empirical cloud fraction based on +! +!> - Compute an empirical cloud fraction based on !! Xu and Randall (1996) \cite xu_and_randall_1996 do k = 1, km do i = 1, im @@ -537,7 +688,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! -!> - Initialize diffusion coefficients to 0 and calculate the total +!> - Initialize diffusion coefficients to 0 and calculate the total !! radiative heating rate (dku, dkt, radx) do k=1,km do i=1,im @@ -548,15 +699,13 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & do k=1,km1 do i=1,im dkq(i,k) = 0. - cku(i,k) = 0. - ckt(i,k) = 0. tem = zi(i,k+1)-zi(i,k) radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) enddo enddo !> - Compute stable/unstable PBL flag (pblflg) based on the total !! surface energy flux (\e false if the total surface energy flux -!! is into the surface) +!! is into the surface) do i = 1,im sflux(i) = heat(i) + evap(i)*fv*theta(i,1) if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. @@ -567,12 +716,12 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & !! - Compute critical bulk Richardson number (\f$Rb_{cr}\f$) (crb) !! - For the unstable PBL, crb is a constant (0.25) !! - For the stable boundary layer (SBL), \f$Rb_{cr}\f$ varies -!! with the surface Rossby number, \f$R_{0}\f$, as given by +!! with the surface Rossby number, \f$R_{0}\f$, as given by !! Vickers and Mahrt (2004) \cite Vickers_2004 !! \f[ !! Rb_{cr}=0.16(10^{-7}R_{0})^{-0.18} !! \f] -!! \f[ +!! \f[ !! R_{0}=\frac{U_{10}}{f_{0}z_{0}} !! \f] !! where \f$U_{10}\f$ is the wind speed at 10m above the ground surface, @@ -580,12 +729,13 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & !! length. To avoid too much variation, we restrict \f$Rb_{cr}\f$ to vary !! within the range of 0.15~0.35 do i = 1,im + thvs(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) if(pblflg(i)) then ! thermal(i) = thvx(i,1) thermal(i) = thlvx(i,1) crb(i) = rbcr else - thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + thermal(i) = thvs(i) tem = sqrt(u10m(i)**2+v10m(i)**2) tem = max(tem, 1.) robn = tem / (f0 * z0(i)) @@ -603,7 +753,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & ustar(i) = sqrt(stress(i)) enddo ! -!> - Compute buoyancy \f$\frac{\partial \theta_v}{\partial z}\f$ (bf) +!> - Compute buoyancy \f$\frac{\partial \theta_v}{\partial z}\f$ (bf) !! and the wind shear squared (shr2) ! do k = 1, km1 @@ -747,7 +897,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & endif enddo ! -!> - Compute mean tke within pbl + if(.not.tte_edmf) then +! +!> - Compute mean tke within pbl for TKE-EDMF ! do i = 1, im sumx(i) = 0. @@ -767,6 +919,8 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & tkemean(i) = tkemean(i) / sumx(i) endif enddo +! + endif ! !> - Compute wind shear term as a sink term for updraft and downdraft !! velocity @@ -814,17 +968,19 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & phih(i) = sqrt(tem) phim(i) = sqrt(phih(i)) tem1 = 1.0 / (1. - aphi16*zol(i)) - phims(i) = sqrt(sqrt(tem1)) + phihs(i) = sqrt(tem1) + phims(i) = sqrt(phihs(i)) else phim(i) = 1. + aphi5*zol1 phih(i) = phim(i) phims(i) = 1. + aphi5*zol(i) + phihs(i) = phims(i) endif enddo ! !> - The \f$z/L\f$ (zol) is used as the stability criterion for the PBL.Currently, !! strong unstable (convective) PBL for \f$z/L < -0.02\f$ and weakly and moderately -!! unstable PBL for \f$0>z/L>-0.02\f$ +!! unstable PBL for \f$0>z/L>-0.02\f$ !> - Compute the velocity scale \f$w_s\f$ (wscale) (eqn 22 of Han et al. 2019). It !! is represented by the value scaled at the top of the surface layer: !! \f[ @@ -915,6 +1071,74 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & endif enddo ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute tke using tte & ri for TTE-EDMF +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + if(tte_edmf) then +! + do i = 1, im + tem = phims(i) * phims(i) + ris(i) = zol(i) * phihs(i) / tem + ris(i) = max(ris(i), rimin) + enddo + do k = 1, km1 + do i = 1, im + ptem = sfcfrac*hpbl(i) + if (zl(i,k) <= ptem) then + ri = ris(i) + else + if(k == 1) then + tem = gotvx(i,1) * (thlvx(i,1)-thvs(i)) + tem1 = tem / zl(i,1) + tem1 = 0.5 * (tem1 + bf(i,1)) + ptem = max((u1(i,1)**2+v1(i,1)**2), 1.) + ptem1 = ptem / (zl(i,1) * zl(i,1)) + ptem1 = 0.5 * (ptem1 + shr2(i,1)) + ri = max(tem1/ptem1, rimin) + else + tem1 = 0.5 * (bf(i,k-1) + bf(i,k)) + ptem1 = 0.5 * (shr2(i,k-1) + shr2(i,k)) + ri = max(tem1/ptem1, rimin) + endif + endif + if(ri < 0) then + tem = 2. * ri - pr0 + epotte = ri / tem + else + tem = pr0 + 3. * ri + epotte = ri / tem + endif + tke(i,k) = te(i,k) * (1. - epotte) + enddo + enddo + do i=1,im + tke(i,km) = tke(i,km1) + enddo +! +!> - Compute mean tke within pbl for TTE-EDMF +! + do i = 1, im + sumx(i) = 0. + tkemean(i) = 0. + enddo + do k = 1, kmpbl + do i = 1, im + if(k < kpbl(i)) then + dz = zi(i,k+1) - zi(i,k) + tkemean(i) = tkemean(i) + tke(i,k) * dz + sumx(i) = sumx(i) + dz + endif + enddo + enddo + do i = 1, im + if(tkemean(i) > 0. .and. sumx(i) > 0.) then + tkemean(i) = tkemean(i) / sumx(i) + endif + enddo +! + endif ! end of if(tte_edmf) +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! look for stratocumulus !> ## Determine whether stratocumulus layers exist and compute quantities @@ -948,11 +1172,11 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & do i = 1, im if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. enddo -!> - Starting at the PBL top and going downward, if the level is less +!> - Starting at the PBL top and going downward, if the level is less !! than the cloud top, find the level of the minimum radiative heating !! rate wihin the cloud. If the level of the minimum is the lowest model !! level or the minimum radiative heating rate is positive, then set -!! scuflg to F. +!! scuflg to F. do i = 1, im flg(i)=scuflg(i) enddo @@ -978,7 +1202,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> ## Compute components for mass flux mixing by large thermals !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!> - If the PBL is convective, the updraft properties are initialized +!> - If the PBL is convective, the updraft properties are initialized !! to be the same as the state variables. do k = 1, km do i = 1, im @@ -1012,7 +1236,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & pcnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, & gdx,hpbl,kpbl,vpert,buou,wush,tkemean,vez0fun,xmf, & tcko,qcko,ucko,vcko,xlamue,bl_upfr) -!> - Call mfscuq(), which is a new mass-flux parameterization for +!> - Call mfscuq(), which is a new mass-flux parameterization for !! stratocumulus-top-induced turbulence mixing. For details of the mfscuq subroutine, step into its documentation ::mfscuq call mfscuq(im,im,km,kmscu,ntcw,ntrac1,dt2, & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, @@ -1165,7 +1389,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & !! l_2=min(l_{up},l_{down}) !!\f] !! and dissipation length scale \f$l_d\f$ is given by: -!!\f[ +!!\f[ !! l_d=(l_{up}l_{down})^{1/2} !!\f] !! where \f$l_{up}\f$ and \f$l_{down}\f$ are the distances that a parcel @@ -1183,11 +1407,13 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & ptem2 = sqrt(zlup*zldn) ele(i,k) = elefac * ptem2 ele(i,k) = max(ele(i,k), tem1) + elmh(i,k)= elmhfac * ele(i,k) ele(i,k) = min(ele(i,k), elmx) + elmh(i,k)= min(elmh(i,k), elmhmx) ! enddo enddo -!> - Compute the surface layer length scale (\f$l_1\f$) following +!> - Compute the surface layer length scale (\f$l_1\f$) following !! Nakanishi (2001) \cite Nakanish_2001 (eqn 9 of Han et al.(2019) \cite Han_2019) do k = 1, km1 do i = 1, im @@ -1233,16 +1459,49 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & do i = 1, im elm(i,km) = elm(i,km1) ele(i,km) = ele(i,km1) + elmh(i,km)= elmh(i,km1) enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> ## Compute eddy diffusivities !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + if(tte_edmf) then +! + do k = 1, km1 + do i = 1, im + ptem = sfcfrac*hpbl(i) + if (zi(i,k+1) <= ptem) then + ri = ris(i) + else + ri = max(bf(i,k)/shr2(i,k),rimin) + endif + if(ri < 0) then + tem = 2. * ri - pr0 + epotte = ri / tem + else + tem = pr0 + 3. * ri + epotte = ri / tem + endif + tkeh(i,k) = tteh(i,k) * (1. - epotte) + tesq(i,k) = tkeh(i,k) / sqrt(tteh(i,k)) + enddo + enddo +! + else +! + do k = 1, km1 + do i = 1, im + tesq(i,k) = sqrt(tkeh(i,k)) + enddo + enddo +! + endif ! do k = 1, km1 do i = 1, im tem = 0.5 * (elm(i,k) + elm(i,k+1)) - tem = tem * sqrt(tkeh(i,k)) + tem = tem * tesq(i,k) ri = max(bf(i,k)/shr2(i,k),rimin) if(k < kpbl(i)) then if(pcnvflg(i)) then @@ -1258,23 +1517,27 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & endif endif else - if(ri < 0.) then ! unstable regime - dku(i,k) = ck1 * tem - dkt(i,k) = rchck * dku(i,k) - else ! stable regime - dkt(i,k) = ch1 * tem - prnum = 1.0 + 2.1 * ri - prnum = min(prnum,prmax) - dku(i,k) = dkt(i,k) * prnum - endif + if(ri < 0.) then ! unstable regime + dku(i,k) = ck1 * tem + dkt(i,k) = rchck * dku(i,k) + else ! stable regime + dkt(i,k) = ch1 * tem + prnum = pr0 + 2.1 * ri + prnum = min(prnum,prmax) + dku(i,k) = dkt(i,k) * prnum + endif endif ! if(scuflg(i)) then if(k >= mrad(i) .and. k < krad(i)) then - tem1 = ckz(i,k) * tem - ptem1 = tem1 / prscu - dku(i,k) = max(dku(i,k), tem1) - dkt(i,k) = max(dkt(i,k), ptem1) + if(tte_edmf) then + tem1 = ck0 * tem + else + tem1 = ckz(i,k) * tem + endif + ptem1 = tem1 / prscu + dku(i,k) = max(dku(i,k), tem1) + dkt(i,k) = max(dkt(i,k), ptem1) endif endif ! @@ -1289,6 +1552,342 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & ! enddo enddo +! +!The following is for SA-3D-TKE + if(sa3dtke) then +! 1. compute LES component of km, kh, and kq (Deardorff 1980) +! calculate thetal + do k=1,km + do i=1,im + pix(i,k) = psk(i) / prslk(i,k) + theta(i,k) = t1(i,k) * pix(i,k) + tem=theta(i,k)/t1(i,k) + if(ntiw > 0) then + tem1=max(q1(i,k,ntcw),qlmin)+ + & max(q1(i,k,ntiw)+q1(i,k,5)+q1(i,k,6),qlmin) + thetal(i,k)=theta(i,k)-(hvap+hfus)/cp*tem*tem1 + else + tem1=max(q1(i,k,ntcw),qlmin) + thetal(i,k)=theta(i,k)-hvap/cp*tem*tem1 + endif + enddo + enddo + + do k=1,km + do i=1,im + dku_les(i,k) = 0. + dkt_les(i,k) = 0. + dkq_les(i,k) = 0. + enddo + enddo +! +! eddy diffusivities at model interface (zm level) in LES scale +! + do k = 1, km1 + do i = 1, im + tem=gotvx(i,k)*(thetal(i,k+1)-thetal(i,k))*rdzt(i,k) + dz = zl(i,k+1) - zl(i,k) + tem1=(garea(i)*dz)**h1 +! calculate LES mixing length + if(tem > 0.0) then + elm_les=0.76*sqrt(tke(i,k))/sqrt(tem) + elm_les=min(elm_les,tem1) + else + elm_les=tem1 + endif +! calculate km, kh, and kq for LES + dku_les(i,k)=0.1*elm_les*sqrt(tkeh(i,k)) + dkt_les(i,k)=(1.0+2.0*elm_les/tem1)*dku_les(i,k) + dkq_les(i,k)=dkt_les(i,k) + dku_les(i,k) = min(dku_les(i,k),dkmaxles) + dkt_les(i,k) = min(dkt_les(i,k),dkmaxles) + dkq_les(i,k) = min(dkq_les(i,k),dkmaxles) + enddo + enddo +! +! calculate blending coefficients for km, kt, kq, and nonlocal mixing +! finding scale of large eddies from TKE + do i=1,im + tkemax(i) = tke(i,1) + ktkemax(i) = 1 + enddo + do k = 2, kmpbl + do i = 1, im + if(tke(i,k) > tkemax(i)) then + tkemax(i) = tke(i,k) + ktkemax(i) = k + endif + enddo + enddo + do i=1,im + flg(i) = .true. + scl(i) = 0. + if(zl(i,ktkemax(i)) > sclmax) then + flg(i) = .false. + scl(i) = sclmin + endif + enddo + do k = 1, kmpbl + do i = 1, im + if(flg(i) .and. k > ktkemax(i)) then + scl(i) = zl(i,k) + tem = 0.5*tkemax(i) + if(tke(i,k) < tem) flg(i) = .false. + endif + enddo + enddo + do i=1,im + scl(i)=max(scl(i), sclmin) + scl(i)=min(scl(i), sclmax) + scl(i)=max(scl(i), hpbl(i)) + pfdx(i)=gdx(i)/scl(i) + enddo +! + do i = 1, im +! partition function for local fluxes + pfl(i)=cpl1*(pfdx(i)**2+cpl2*pfdx(i)**0.5-cpl3)/ + & (pfdx(i)**2+cpl4*pfdx(i)**0.5+cpl5)+cpl6 + pfl(i)=min(max(pfl(i),0.0),1.0) +! partition function for TKE + pftke(i)=(pfdx(i)**2+cptke1*pfdx(i)**(2./3.))/ + & (pfdx(i)**2+cptke2*pfdx(i)**(2./3.)+cptke3) + pftke(i)=min(max(pftke(i),0.0),1.0) + enddo +! +! blending LES and MS components of vertical km,kt, and kq +! + do k = 1,km1 + do i=1,im + dkq(i,k)=(1.0-pfl(i))*dkq_les(i,k)+pfl(i)*dkq(i,k) + dkt(i,k)=(1.0-pfl(i))*dkt_les(i,k)+pfl(i)*dkt(i,k) + dku(i,k)=(1.0-pfl(i))*dku_les(i,k)+pfl(i)*dku(i,k) + enddo + enddo +! +! 2. compute MS horizontal km +! + do k = 1, km + do i = 1, im + dku_h(i,k)=ckh*elmh(i,k)*sqrt(tke(i,k)) + dkq_h(i,k)=dku_h(i,k) + enddo + enddo +! +! eddy diffusivities at model layer (zl level) in LES scale +! + do k = 1, km1 + do i = 1, im + if(k > 1) then + dz = zl(i,k+1) - zl(i,k-1) + tem=gotvx(i,k)*(thetal(i,k+1)-thetal(i,k-1))/dz + else + dz = zl(i,k+1) + tem=gotvx(i,k)*(thetal(i,k+1)-thvs(i))/dz + endif + dz = zi(i,k+1) - zi(i,k) + tem1=(garea(i)*dz)**h1 +! calculate LES mixing length + if(tem > 0.0) then + elm_les=0.76*sqrt(tke(i,k))/sqrt(tem) + elm_les=min(elm_les,tem1) + else + elm_les=tem1 + endif + ele_les(i,k)=elm_les +! calculate km, kh, and kq for LES + dku_les(i,k)=0.1*elm_les*sqrt(tke(i,k)) + dkq_les(i,k)=(1.0+2.0*elm_les/tem1)*dku_les(i,k) + dku_les(i,k) = min(dku_les(i,k),dkmaxles) + dkq_les(i,k) = min(dkq_les(i,k),dkmaxles) + enddo + enddo +! + do k = 1,km1 + do i=1,im + dku_h(i,k)=(1.0-pfl(i))*dku_les(i,k)+pfl(i)*dku_h(i,k) + dkq_h(i,k)=(1.0-pfl(i))*dkq_les(i,k)+pfl(i)*dkq_h(i,k) + enddo + enddo + do i = 1, im + dku_h(i,km)=dku_h(i,km1) + dkq_h(i,km)=dkq_h(i,km1) + enddo +! + endif !sa3dtke + +!PCC_CANOPY------------------------------------ + kount=0 !IVAI + if (do_canopy .and. cplaqm) then + +!IVAI +! print*, 'SATMEDMFVDIFQ_RUN: CLAIE = ', claie(:) +! print*, 'SATMEDMFVDIFQ_RUN: CFCH = ' , cfch (:) +! print*, 'SATMEDMFVDIFQ_RUN: CFRT = ' , cfrt (:) +! print*, 'SATMEDMFVDIFQ_RUN: CCLU = ' , cclu (:) +! print*, 'SATMEDMFVDIFQ_RUN: CPOPU= ' , cpopu(:) +! 2D aux arrays: canopy data in diffusion +! aux2d(:,1) = cfch (:) +! aux2d(:,2) = claie(:) +! aux2d(:,3) = cfrt(:) + +! 3D aux arrays: before canopy correction +! aux3d(:,:,1) = dkq(:,:) +! aux3d(:,:,2) = dkt(:,:) +! aux3d(:,:,3) = dku(:,:) +!IVAI + do k = 1, km1-1 + do i = 1, im + +!IVAI: AQM canopy Inputs +! FCH = fch_table(vegtype(i)) !top of canopy from look-up table + FCH = cfch(i) !top of canopy from AQM canopy inputs + IF (k .EQ. 1) THEN !use model layer interfaces + KCAN = 1 + ELSE + IF ( cfch(i) .GT. zi(i,k) + & .AND. cfch(i) .LE. zi(i,k+1) ) THEN + KCAN = 1 + ELSE + KCAN = 0 + END IF + END IF + + IF (KCAN .EQ. 1) THEN !canopy inside model layer +! Check for other Contiguous Canopy Grid Cell Conditions + +! Not a contigous canopy cell + IF ( claie(i) .LT. 0.1 + & .OR. cfch (i) .LT. 0.5 +!IVAI: modified contiguous canopy condition +! & .OR. MAX(0.0, 1.0 - cfrt(i)) .GT. 0.5 + & .OR. MAX(0.0, 1.0 - cfrt(i)) .GT. 0.75 +!IVAI + & .OR. cpopu(i) .GT. 10000.0 + & .OR. (EXP(-0.5*claie(i)*cclu(i)) .GT. 0.45 + & .AND. cfch(i) .LT. 18.) ) THEN + + +!TODO: Canopy Inputs +! IF ( XCANOPYLAI .LT. 0.1 !from canopy inputs +! IF ( lai(i) .LT. 0.1 !from LSM +! & .OR. FCH .LT. 0.5 ) THEN +! & .OR. MAX(0.0, 1.0 - XCANOPYFRT) .GT. 0.5 +! & .OR. POPU .GT. 10000.0 +! & .OR. EXP(-0.5*XCANOPYLAI*XCANOPYCLU).GT. 0.45 +! & .AND. FCH .LT. 18.0 ) THEN + + dkt(i,k)= dkt(i,k) + dkq(i,k)= dkq(i,k) + dku(i,k)= dku(i,k) + + ELSE ! There is a contiguous forest canopy, apply correction over canopy layers + +! Output contiguous canopy mask +! if (kount .EQ. 0 ) aux2d(i,5) = aux2d(i,5) + 1 + +!Raupauch M. R. A Practical Lagrangian method for relating scalar +!concentrations to +! source distributions in vegetation canopies. Q. J. R. Meteor. Soc. +! (1989), 115, pp 609-632 + MOL = zol(i)/zl(i,k) !Monin-Obukhov Length in layer + HOL = FCH/MOL !local canopy stability parameter (hc/MOL) + ZCAN = zi(i,k+1) ! Initialize each model layer top that contains canopy (m) + ! Integrate across total model interface + ZFL = ZCAN ! Set ZFL = ZCAN + COUNTCAN = 0 ! Initialize canopy layers + + IF (k .EQ. 1) THEN !Find bottom in each model layer + BOTCAN = 0.5 + ELSE + BOTCAN = zi(i,k) + END IF + + DO WHILE (ZCAN.GE.BOTCAN) + ! TLCAN = Lagrangian timescale + TLCAN = (FCH/ustar(i)) * ( + & (0.256 * (ZCAN-(0.75*FCH))/FCH ) + + & (0.492*EXP((-0.256*ZCAN/FCH)/0.492)) ) + IF ( HOL .LT. -0.1 ) THEN !STRONG UNSTABLE + IF ( ZCAN/FCH .GT. 1.25 ) THEN !SIGMACAN = Eulerian vertical velocity variance + SIGMACAN = 1.25*ustar(i) + END IF + IF ( ZCAN/FCH .GE. 0.175 + & .AND. ZCAN/FCH .LE. 1.25 ) THEN + SIGMACAN = ustar(i) * ( 0.75 + + & (0.5 * COS((PI/1.06818) * + & (1.25 - (ZCAN/FCH)))) ) + END IF + IF ( ZCAN/FCH .LT. 0.175 ) THEN + SIGMACAN = 0.25*ustar(i) + END IF + END IF + IF ( HOL .GE. -0.1 .AND. HOL .LT. 0.1 ) THEN !WEAKLY UNSTABLE to NEUTRAL + IF ( ZCAN/FCH .GT. 1.25 ) THEN + SIGMACAN = 1.0*ustar(i) + END IF + IF ( ZCAN/FCH .GE. 0.175 + & .AND. ZCAN/FCH .LE. 1.25 ) THEN + SIGMACAN = ustar(i) * ( 0.625 + + & (0.375* COS((PI/1.06818) * + & (1.25 - (ZCAN/FCH)))) ) + END IF + IF ( ZCAN/FCH .LT. 0.175 ) THEN + SIGMACAN = 0.25*ustar(i) + END IF + END IF + IF ( HOL .GE. 0.1 .AND. HOL .LT. 0.9 ) THEN !STABLE + IF ( ZCAN/FCH .GT. 1.25 ) THEN + SIGMACAN = 0.25*(4.375 - (3.75*HOL))*ustar(i) + END IF + IF ( ZCAN/FCH .GE. 0.175 + & .AND. ZCAN/FCH .LE. 1.25 ) THEN + RRCAN=4.375-(3.75*HOL) + AACAN=(0.125*RRCAN) + 0.125 + BBCAN=(0.125*RRCAN) - 0.125 + SIGMACAN = ustar(i) * ( AACAN + + & (BBCAN * COS((PI/1.06818) * + & (1.25 - (ZCAN/FCH)))) ) + END IF + IF ( ZCAN/FCH .LT. 0.175 ) THEN + SIGMACAN = 0.25*ustar(i) + END IF + END IF + IF ( HOL .GE. 0.9 ) THEN !VERY STABLE + SIGMACAN = 0.25*ustar(i) + END IF + IF ( ZCAN .EQ. ZFL ) THEN ! Each model layer that includes canopy + EDDYVEST1 = (SIGMACAN*SIGMACAN)*TLCAN + ELSE IF ( ZCAN .LE. FCH ) THEN !in-canopy layers and set arrays + COUNTCAN = COUNTCAN + 1 + ZCANX (COUNTCAN) = ZCAN + EDDYVESTX (COUNTCAN) = (SIGMACAN*SIGMACAN)*TLCAN + END IF + ZCAN = ZCAN-0.5 !step down in-canopy resolution of 0.5m + END DO !end loop on canopy layers + EDDYVEST_INT = IntegrateTrapezoid((ZCANX(COUNTCAN:1:-1) + & ),EDDYVESTX(COUNTCAN:1:-1)) / ZFL + dkt(i,k)= (dkt(i,k)/EDDYVEST1) * EDDYVEST_INT !Scale dkt to resolved eddy diffusivity + dkq(i,k)= (dkq(i,k)/EDDYVEST1) * EDDYVEST_INT !Scale dkq to resolved eddy diffusivity + dku(i,k)= (dku(i,k)/EDDYVEST1) * EDDYVEST_INT !Scale dku to resolved eddy diffusivity + +!IVAI: Output contiguos canopy correction bottom layer and 3D +! if ( kount .EQ. 0) +! & aux2d(i,4) = 1./EDDYVEST1 * EDDYVEST_INT +! aux3d(i,k,4) = 1./EDDYVEST1 * EDDYVEST_INT +!IVAI + + END IF ! contigous canopy conditions + + END IF ! (KCAN .EQ. 1) model layer(s) containing canopy + + enddo !i + + kount = kount + 1 !IVAI + + enddo !k + + endif !do_canopy .and. cplaqm + !> ## Compute TKE. !! - Compute a minimum TKE deduced from background diffusivity for momentum. ! @@ -1309,7 +1908,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!> - Compute buoyancy and shear productions of TKE +!> - Compute buoyancy and shear productions of TKE or TTE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! do k = 1, km1 @@ -1329,7 +1928,12 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & tem = tem + ptem1 + ptem2 buop = 0.5 * (gotvx(i,1) * sflux(i) + tem) ! - tem1 = dku(i,1) * shr2(i,1) + if(sa3dtke) then + tem = 2. * dku_h(i,1) + tem1 = dku(i,1)*def_1(i,1)+tem*def_2(i,1) + else + tem1 = dku(i,1) * shr2(i,1) + endif ! tem = (u1(i,2)-u1(i,1))*rdzt(i,1) ! if(pcnvflg(i)) then @@ -1385,8 +1989,15 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & endif buop = tem + ptem1 + ptem2 ! - tem1 = dku(i,k-1) * shr2(i,k-1) - tem2 = dku(i,k) * shr2(i,k) + if(sa3dtke) then +! obtaining 3d shear production from dycore + tem2 = 2.*dku_h(i,k) + tem1 = dku(i,k-1)*def_1(i,k-1) + tem2 = dku(i,k)*def_1(i,k)+tem2*def_2(i,k) + else + tem1 = dku(i,k-1) * shr2(i,k-1) + tem2 = dku(i,k) * shr2(i,k) + endif tem = 0.5 * (tem1 + tem2) tem1 = (u1(i,k+1)-u1(i,k))*rdzt(i,k) tem2 = (u1(i,k)-u1(i,k-1))*rdzt(i,k-1) @@ -1427,38 +2038,98 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & endif shrp = shrp + ptem1 + ptem2 endif - prod(i,k) = buop + shrp + if(tte_edmf) then + if(buop > 0.) then + prod(i,k) = 2. * buop + shrp + else + prod(i,k) = shrp + endif + else + prod(i,k) = buop + shrp + endif enddo enddo ! !---------------------------------------------------------------------- -!> - First predict tke due to tke production & dissipation(diss) +!> - First predict te due to te production & dissipation(diss) ! - dtn = dt2 / float(ndt) - do n = 1, ndt - do k = 1,km1 + if(sa3dtke) then +!The following is for SA-3D-TKE + dtn = dt2 / float(ndt) + do n = 1, ndt + do k = 1,km1 + do i=1,im + tem = sqrt(te(i,k)) +! calculating 3D TKE transport and pressure correlation + ptem1 = ce0 / ele(i,k) + dz = zi(i,k+1) - zi(i,k) + tem1=(garea(i)*dz)**h1 + tem2=0.19+0.51*ele_les(i,k)/tem1 + ptem2= tem2 / ele_les(i,k) + ptem=(1.0-pftke(i))*ptem2+pftke(i)*ptem1 + disste = ptem * te(i,k) * tem + tem1 = prod(i,k) + te(i,k) / dtn + disste=max(min(disste, tem1), 0.) + if(.not. tte_edmf) diss(i,k) = disste +! tem=2.0*def_3(i,k) + tem=def_3(i,k) +! tem=min(tem,1.0) + te(i,k) = te(i,k) + dtn * (prod(i,k)-disste+tem) +! te(i,k) = max(te(i,k), tkmin) + te(i,k) = max(te(i,k), tkmnz(i,k)) + enddo + enddo + enddo + else + dtn = dt2 / float(ndt) + do n = 1, ndt + do k = 1,km1 do i=1,im - tem = sqrt(tke(i,k)) + tem = sqrt(te(i,k)) ptem = ce0 / ele(i,k) - diss(i,k) = ptem * tke(i,k) * tem - tem1 = prod(i,k) + tke(i,k) / dtn - diss(i,k)=max(min(diss(i,k), tem1), 0.) - tke(i,k) = tke(i,k) + dtn * (prod(i,k)-diss(i,k)) -! tke(i,k) = max(tke(i,k), tkmin) - tke(i,k) = max(tke(i,k), tkmnz(i,k)) + disste = ptem * te(i,k) * tem + tem1 = prod(i,k) + te(i,k) / dtn + disste = max(min(disste, tem1), 0.) + if(.not. tte_edmf) diss(i,k) = disste + te(i,k) = te(i,k) + dtn * (prod(i,k)-disste) + te(i,k) = max(te(i,k), tkmnz(i,k)) +! te(i,k) = max(te(i,k), tkmin) + enddo + enddo + enddo + endif !sa3dtke +! +! TKE dissipation for dissipative heating computation in TTE-EDMF +! + if(tte_edmf) then + do k = 1, km1 + do i = 1, im + tem = sqrt(tke(i,k)) + if(sa3dtke) then + ptem1 = ce0 / ele(i,k) + dz = zi(i,k+1) - zi(i,k) + tem1=(garea(i)*dz)**h1 + tem2=0.19+0.51*ele_les(i,k)/tem1 + ptem2= tem2 / ele_les(i,k) + ptem=(1.0-pftke(i))*ptem2+pftke(i)*ptem1 + diss(i,k) = ptem * tke(i,k) * tem + else + ptem = ce0 / ele(i,k) + diss(i,k) = ptem * tke(i,k) * tem + endif enddo enddo - enddo + endif ! -!> - Compute updraft & downdraft properties for TKE +!> - Compute updraft & downdraft properties for TKE or TTE ! do k = 1, km do i = 1, im if(pcnvflg(i)) then - qcko(i,k,ntke) = tke(i,k) + qcko(i,k,ntke) = te(i,k) endif if(scuflg(i)) then - qcdo(i,k,ntke) = tke(i,k) + qcdo(i,k,ntke) = te(i,k) endif enddo enddo @@ -1469,7 +2140,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & tem = 0.5 * xlamue(i,k-1) * dz factor = 1. + tem qcko(i,k,ntke)=((1.-tem)*qcko(i,k-1,ntke)+tem* - & (tke(i,k)+tke(i,k-1)))/factor + & (te(i,k)+te(i,k-1)))/factor endif enddo enddo @@ -1481,7 +2152,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & tem = 0.5 * xlamde(i,k) * dz factor = 1. + tem qcdo(i,k,ntke)=((1.-tem)*qcdo(i,k+1,ntke)+tem* - & (tke(i,k)+tke(i,k+1)))/factor + & (te(i,k)+te(i,k+1)))/factor endif endif enddo @@ -1553,32 +2224,33 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & ! enddo ! -! for tke +! for TKE or TTE ! do k=1,kps do i=1,im - tkeh(i,k) = 0.5 * (tke(i,k)+tke(i,k+1)) + tei(i,k) = 0.5 * (te(i,k)+te(i,k+1)) enddo enddo + do k=1,kps do i=1,im - e_diff(i,k) = tke(i,k) - tke(i,k+1) + e_diff(i,k) = te(i,k) - te(i,k+1) enddo enddo do i=1,im - if(tke(i,1) >= 0.) then - e_diff(i,0) = max(0.,2.*tke(i,1)-tke(i,2))- - & tke(i,1) + if(te(i,1) >= 0.) then + e_diff(i,0) = max(0.,2.*te(i,1)-te(i,2))- + & te(i,1) else - e_diff(i,0) = min(0.,2.*tke(i,1)-tke(i,2))- - & tke(i,1) + e_diff(i,0) = min(0.,2.*te(i,1)-te(i,2))- + & te(i,1) endif enddo ! do k = 1, kps do i = 1, im kmx = max(kpbl(i), krad(i)) - e_half(i,k) = tkeh(i,k) + e_half(i,k) = tei(i,k) if((pcnvflg(i) .or. scuflg(i)) .and. (k < kmx)) then tem = 0. if(pcnvflg(i) .and. k < kpbl(i)) then @@ -1593,26 +2265,26 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & if(abs(e_diff(i,k)) > 1.e-22) & rrkp = e_diff(i,k+1) / e_diff(i,k) phkp = (rrkp+abs(rrkp)) / (1.+abs(rrkp)) - e_half(i,k) = tke(i,k+1) + - & phkp*(tkeh(i,k)-tke(i,k+1)) + e_half(i,k) = te(i,k+1) + + & phkp*(tei(i,k)-te(i,k+1)) elseif (tem < 0.) then rrkp = 0. if(abs(e_diff(i,k)) > 1.e-22) & rrkp = e_diff(i,k-1) / e_diff(i,k) phkp = (rrkp+abs(rrkp)) / (1.+abs(rrkp)) - e_half(i,k) = tke(i,k) + - & phkp*(tkeh(i,k)-tke(i,k)) + e_half(i,k) = te(i,k) + + & phkp*(tei(i,k)-te(i,k)) endif endif enddo enddo ! !---------------------------------------------------------------------- -!> - Compute tridiagonal matrix elements for turbulent kinetic energy +!> - Compute tridiagonal matrix elements for TKE or TTE ! do i=1,im ad(i,1) = 1.0 - f1(i,1) = tke(i,1) + f1(i,1) = te(i,1) enddo ! do k = 1,km1 @@ -1635,9 +2307,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & ptem2 = dtodsu * ptem ptem = qcko(i,k,ntke) + qcko(i,k+1,ntke) f1(i,k) = f1(i,k) - ptem * ptem1 - f1(i,k+1) = tke(i,k+1) + ptem * ptem2 + f1(i,k+1) = te(i,k+1) + ptem * ptem2 else - f1(i,k+1) = tke(i,k+1) + f1(i,k+1) = te(i,k+1) endif ! if(scuflg(i)) then @@ -1667,7 +2339,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & c call tridit(im,km,1,al,ad,au,f1,au,f1) ! -! Negative TKE is set to zero after borrowing it from positive +! Negative TKE or TTE are set to zero after borrowing it from positive ! values within the mass-flux transport layers ! do i = 1,im @@ -1733,9 +2405,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & enddo enddo ! -! To remove negative TKEs which were leaked out of the mass-flux transport layers -! by eddy diffusion or potential negative TKEs from the diffusion scheme, -! positive TKEs are borrowed again now from the entire layers +! To remove negative TKEs or TTEs which were leaked out of the mass-flux transport layers +! by eddy diffusion or potential negative TKEs or TTEs from the diffusion scheme, +! positive TKEs or TTEs are borrowed again now from the entire layers ! do i = 1,im tsumn(i) = 0. @@ -1772,7 +2444,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & enddo enddo c -!> - Recover the tendency of tke +!> - Recover the tendency of TKE or TTE c do k = 1,km do i = 1,im @@ -1813,6 +2485,10 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & rdz = rdzt(i,k) tem1 = dsig * dkt(i,k) * rdz dsdzt = tem1 * gocp + if (use_lpt > 0) then + dsdzt = dsdzt-tem1*elocp*(qliq(i,k+1)-qliq(i,k))*rdz + & -(1+0.33/2.5)*tem1*elocp*(qice(i,k+1)-qice(i,k))*rdz + endif dsdz2 = tem1 * rdz au(i,k) = -dtodsd*dsdz2 al(i,k) = -dtodsu*dsdz2 @@ -2375,10 +3051,18 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & ! dvsfc(i) = dvsfc(i)+conw*del(i,k)*vtend enddo enddo - do i = 1,im - dusfc(i) = -1.*rho_a(i)*stress(i)*u1(i,1)/spd1(i) - dvsfc(i) = -1.*rho_a(i)*stress(i)*v1(i,1)/spd1(i) - enddo + if (use_oceanuv) then + do i = 1,im + spd1_m=sqrt( (u1(i,1)-usfco(i))**2+(v1(i,1)-vsfco(i))**2 ) + dusfc(i) = -1.*rho_a(i)*stress(i)*(u1(i,1)-usfco(i))/spd1_m + dvsfc(i) = -1.*rho_a(i)*stress(i)*(v1(i,1)-vsfco(i))/spd1_m + enddo + else + do i = 1,im + dusfc(i) = -1.*rho_a(i)*stress(i)*u1(i,1)/spd1(i) + dvsfc(i) = -1.*rho_a(i)*stress(i)*v1(i,1)/spd1(i) + enddo + endif ! if(ldiag3d .and. .not. gen_tend) then idtend = dtidx(index_of_x_wind,index_of_process_pbl) @@ -2409,6 +3093,14 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & hpbl(i) = hpblx(i) kpbl(i) = kpblx(i) enddo + if(sa3dtke) then + do k = 1, km + do i = 1, im + dku3d_h(i,k) = dku_h(i,k) ! pass dku3d_h to dyn_core + dku3d_e(i,k) = dkq_h(i,k) ! pass dku3d_e to dyn_core + enddo + enddo + endif !sa3dtke ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! return diff --git a/physics/PBL/SATMEDMF/satmedmfvdifq.meta b/physics/PBL/SATMEDMF/satmedmfvdifq.meta index ff718f138..002389307 100644 --- a/physics/PBL/SATMEDMF/satmedmfvdifq.meta +++ b/physics/PBL/SATMEDMF/satmedmfvdifq.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = satmedmfvdifq type = scheme - dependencies = ../../tools/funcphys.f90,../../hooks/machine.F,../mfpbltq.f,mfscuq.f,../tridi.f + dependencies = ../../tools/funcphys.f90,../../tools/canopy_utils_mod.f,../../hooks/machine.F,../mfpbltq.f,mfscuq.f,../tridi.f ######################################################################## [ccpp-arg-table] @@ -105,6 +105,14 @@ type = real kind = kind_phys intent = in +[pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [rd] standard_name = gas_constant_of_dry_air long_name = ideal gas constant for dry air @@ -217,6 +225,29 @@ type = real kind = kind_phys intent = in +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[use_oceanuv] + standard_name = do_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = flag + dimensions = () + type = logical + intent = in [t1] standard_name = air_temperature long_name = layer mean air temperature @@ -233,6 +264,30 @@ type = real kind = kind_phys intent = in +[def_1] + standard_name = square_of_vertical_shear_due_to_dynamics + long_name = square of vertical shear calculated from dynamics + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[def_2] + standard_name = square_of_horizontal_shear_due_to_dynamics + long_name = square of horizontal shear calculated from dynamics + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[def_3] + standard_name = horizontal_transfer_rate_of_tke_due_to_dynamics + long_name = rate of horizontal TKE transfer and pressure correlation calculated from dynamics + units = m2 s-3 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in [swh] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep long_name = total sky shortwave heating rate @@ -440,6 +495,13 @@ type = real kind = kind_phys intent = in +[tte_edmf] + standard_name = flag_for_scale_aware_TTE_moist_EDMF_PBL + long_name = flag for scale-aware TTE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in [dspheat] standard_name = flag_TKE_dissipation_heating long_name = flag for using TKE dissipation heating @@ -447,6 +509,13 @@ dimensions = () type = logical intent = in +[sa3dtke] + standard_name = do_scale_aware_3d_tke + long_name = flag for scale-aware 3d tke scheme + units = flag + dimensions = () + type = logical + intent = in [dusfc] standard_name = instantaneous_surface_x_momentum_flux long_name = x momentum flux @@ -487,6 +556,14 @@ type = real kind = kind_phys intent = out +[tkeh] + standard_name = vertical_turbulent_kinetic_energy_at_interface + long_name = vertical turbulent kinetic energy at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout [dkt] standard_name = atmosphere_heat_diffusivity long_name = atmospheric heat diffusivity @@ -503,6 +580,22 @@ type = real kind = kind_phys intent = out +[dku3d_h] + standard_name = horizontal_atmosphere_momentum_diffusivity_for_dynamics + long_name = horizontal atmospheric momentum diffusivity for dynamics + units = m2 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[dku3d_e] + standard_name = horizontal_atmosphere_tke_diffusivity_for_dynamics + long_name = horizontal atmospheric tke diffusivity for dynamics + units = m2 s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [kinver] standard_name = index_of_highest_temperature_inversion long_name = index of highest temperature inversion @@ -574,6 +667,65 @@ type = real kind = kind_phys intent = in +[do_canopy] + standard_name = flag_for_canopy_option + long_name = flag for in-canopy eddy diffusivity adjustment option + units = flag + dimensions = () + type = logical + intent = in +[cplaqm] + standard_name = flag_for_air_quality_coupling + long_name = flag controlling cplaqm collection (default off) + units = flag + dimensions = () + type = logical + intent = in +[claie] + standard_name = canopy_leaf_area_index + long_name = canopy leaf area index + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[cfch] + standard_name = canopy_forest_height + long_name = canopy forest height + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[cfrt] + standard_name = canopy_forest_fraction + long_name = canopy forest fraction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[cclu] + standard_name = canopy_clumping_index + long_name = canopy clumping index + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[cpopu] + standard_name = canopy_population_density + long_name = population density used for canopy correction + units = km-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True [sfc_rlm] standard_name = choice_of_near_surface_mixing_length_in_boundary_layer_mass_flux_scheme long_name = choice of near surface mixing length in boundary layer mass flux scheme @@ -588,6 +740,13 @@ dimensions = () type = integer intent = in +[use_lpt] + standard_name = control_for_using_LPT_for_TC_applications_in_the_PBL_scheme + long_name = control for using LPT in TC applications in the PBL scheme + units = none + dimensions = () + type = integer + intent = in [ntqv] standard_name = index_of_specific_humidity_in_tracer_concentration_array long_name = tracer index for water vapor (specific humidity) @@ -602,7 +761,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - intent = in + intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/PBL/SHOC/moninshoc.f b/physics/PBL/SHOC/moninshoc.f index eb6cbd002..994b78bf6 100644 --- a/physics/PBL/SHOC/moninshoc.f +++ b/physics/PBL/SHOC/moninshoc.f @@ -78,7 +78,8 @@ subroutine moninshoc_run (im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, & tau real(kind=kind_phys), dimension(:,:,:), intent(inout) :: rtg - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: dtend + real(kind=kind_phys), dimension(:,:,:), intent(inout), optional ::& + & dtend integer, dimension(:,:), intent(in) :: dtidx integer, intent(in) :: index_of_temperature, index_of_x_wind, & index_of_y_wind, index_of_process_pbl, ntqv diff --git a/physics/PBL/SHOC/moninshoc.meta b/physics/PBL/SHOC/moninshoc.meta index 474689ea0..37e090943 100644 --- a/physics/PBL/SHOC/moninshoc.meta +++ b/physics/PBL/SHOC/moninshoc.meta @@ -456,7 +456,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - intent = in + intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/PBL/SHOC/shoc.F90 b/physics/PBL/SHOC/shoc.F90 index 797be6aec..b9860dc33 100644 --- a/physics/PBL/SHOC/shoc.F90 +++ b/physics/PBL/SHOC/shoc.F90 @@ -52,7 +52,8 @@ subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_ real(kind=kind_phys), intent(in), dimension(:,:) :: prsl, delp, phil, u, v, omega, rhc, prnum real(kind=kind_phys), intent(in), dimension(:,:) :: phii ! - real(kind=kind_phys), intent(inout), dimension(:,:) :: gt0, cld_sgs, tke, tkh, wthv_sec + real(kind=kind_phys), intent(inout), dimension(:,:) :: gt0, tke, tkh, wthv_sec + real(kind=kind_phys), intent(inout), dimension(:,:) :: cld_sgs real(kind=kind_phys), intent(inout), dimension(:,:,:) :: gq0 character(len=*), intent(out) :: errmsg diff --git a/physics/PBL/YSU/ysuvdif.F90 b/physics/PBL/YSU/ysuvdif.F90 index bfae11d39..09ba28625 100644 --- a/physics/PBL/YSU/ysuvdif.F90 +++ b/physics/PBL/YSU/ysuvdif.F90 @@ -101,7 +101,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d,karman, & intent(inout) :: utnp,vtnp,ttnp real(kind=kind_phys), dimension( :,:,: ) , & intent(inout) :: qtnp - real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), ntqv, index_of_temperature, & index_of_x_wind, index_of_y_wind, index_of_process_pbl ! diff --git a/physics/PBL/YSU/ysuvdif.meta b/physics/PBL/YSU/ysuvdif.meta index 20e96a92d..0e2eb4ccd 100644 --- a/physics/PBL/YSU/ysuvdif.meta +++ b/physics/PBL/YSU/ysuvdif.meta @@ -466,7 +466,8 @@ dimensions = (horizontal_loop_extent,vertical_layer_dimension,cumulative_change_of_state_variables_outer_index_max) type = real kind = kind_phys - intent = in + intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/PBL/mfpbl.f b/physics/PBL/mfpbl.f index dac548711..c9629ac2b 100644 --- a/physics/PBL/mfpbl.f +++ b/physics/PBL/mfpbl.f @@ -1,9 +1,12 @@ !> \file mfpbl.f !! This file contains the subroutine that calculates the updraft properties and mass flux for use in the Hybrid EDMF PBL scheme. + +!> This module contains the subroutine that calculates the updraft properties and mass flux +!! for use in the Hybrid EDMF PBL scheme. module mfpbl_mod contains -!> \ingroup HEDMF -!! \brief This subroutine is used for calculating the mass flux and updraft properties. + +!> \brief This subroutine is used for calculating the mass flux and updraft properties. !! !! The mfpbl routines works as follows: if the PBL is convective, first, the ascending parcel entrainment rate is calculated as a !! function of height. Next, a surface parcel is initiated according to surface layer properties and the updraft buoyancy is calculated diff --git a/physics/PBL/mfpblt.f b/physics/PBL/mfpblt.f index 67e554b92..52179b35a 100644 --- a/physics/PBL/mfpblt.f +++ b/physics/PBL/mfpblt.f @@ -1,11 +1,15 @@ !>\file mfpblt.f !! This file contains the subroutine that calculates mass flux and !! updraft parcel properties for thermals driven by surface heating +!! for use in the TKE-EDMF PBL scheme. + +!> This module contains the subroutine that calculates mass flux and +!! updraft parcel properties for thermals driven by surface heating !! for use in the TKE-EDMF PBL scheme. module mfpblt_mod contains -!>\ingroup satmedmf -!! This subroutine computes mass flux and updraft parcel properties for + +!> This subroutine computes mass flux and updraft parcel properties for !! thermals driven by surface heating. !!\section mfpblt_gen GFS mfpblt General Algorithm !> @{ diff --git a/physics/PBL/mfpbltq.f b/physics/PBL/mfpbltq.f index a93862a41..8bf687757 100644 --- a/physics/PBL/mfpbltq.f +++ b/physics/PBL/mfpbltq.f @@ -1,5 +1,9 @@ !>\file mfpbltq.f -!! This file contains the subroutine that calculates mass flux and +!! This file contains the subroutine that computes mass flux and +!! updraft parcel properties for +!! thermals driven by surface heating + +!> This module contains the subroutine that calculates mass flux and !! updraft parcel properties for thermals driven by surface heating !! for use in the TKE-EDMF PBL scheme (updated version). module mfpbltq_mod @@ -374,6 +378,9 @@ subroutine mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,delt, do k = 1, kmpbl do i = 1, im if (cnvflg(i) .and. k < kpbl(i)) then + if (sigma(i) > a1) then + xmf(i,k) = sigma(i) * xmf(i,k) / a1 + endif xmf(i,k) = scaldfunc(i) * xmf(i,k) dz = zl(i,k+1) - zl(i,k) xmmx = dz / dt2 diff --git a/physics/PBL/saYSU/shinhongvdif.meta b/physics/PBL/saYSU/shinhongvdif.meta index 8b1d48605..3e919d78f 100644 --- a/physics/PBL/saYSU/shinhongvdif.meta +++ b/physics/PBL/saYSU/shinhongvdif.meta @@ -444,6 +444,7 @@ type = real kind = kind_phys intent = inout + optional = True [dtidx] standard_name = cumulative_change_of_state_variables_outer_index long_name = index of state-variable and process in last dimension of diagnostic tendencies array AKA cumulative_change_index diff --git a/physics/PBL/tridi.f b/physics/PBL/tridi.f index 13898ad43..28faaed2e 100644 --- a/physics/PBL/tridi.f +++ b/physics/PBL/tridi.f @@ -1,5 +1,8 @@ !>\file tridi.f !! These subroutines are originally internal subroutines in moninedmf.f + +!> This module contains routine to compute tridiagonal matrix elements for TKE, heat, moist +!! and momentum module tridi_mod contains diff --git a/physics/Radiation/RRTMG/iounitdef.f b/physics/Radiation/RRTMG/iounitdef.f index c6a4e591f..3f298b9d3 100644 --- a/physics/Radiation/RRTMG/iounitdef.f +++ b/physics/Radiation/RRTMG/iounitdef.f @@ -1,3 +1,7 @@ +!>\file iounitdef.f +!! This file defines fortran unit numbers for input/output data +!! files for the NCEP GFS model. + !!!!! ========================================================== !!!!! !!!!! module "module_iounitdef description !!!!! !!!!! ========================================================== !!!!! @@ -44,6 +48,8 @@ !!!!! ========================================================== !!!!! !========================================! +!> this module defines fortran unit numbers for input/output data +!! files for the ncep gfs model. module module_iounitdef ! !........................................! ! diff --git a/physics/Radiation/RRTMG/module_bfmicrophysics.f b/physics/Radiation/RRTMG/module_bfmicrophysics.f index caff7fc61..6285653d2 100644 --- a/physics/Radiation/RRTMG/module_bfmicrophysics.f +++ b/physics/Radiation/RRTMG/module_bfmicrophysics.f @@ -1,5 +1,5 @@ -!>\file module_bfmicrophysics.f This file contains some subroutines used -!! in microphysics. +!>\file module_bfmicrophysics.f +!!This file contains some subroutines used in microphysics. !> This module contains some subroutines used in microphysics. MODULE module_microphysics diff --git a/physics/Radiation/RRTMG/rad_sw_pre.F90 b/physics/Radiation/RRTMG/rad_sw_pre.F90 index b7c3faf4c..83a0385a8 100644 --- a/physics/Radiation/RRTMG/rad_sw_pre.F90 +++ b/physics/Radiation/RRTMG/rad_sw_pre.F90 @@ -1,12 +1,11 @@ !>\file rad_sw_pre.F90 !! This file gathers the sunlit points for the shortwave radiation schemes. +!> This module gathers the sunlit points for the shortwave radiation schemes. module rad_sw_pre contains -!> \defgroup rad_sw_pre GFS Radiation-SW Pre -!! This module gathers the sunlit points for the shortwave radiation schemes. -!> @{ + !> \section arg_table_rad_sw_pre_run Argument Table !! \htmlinclude rad_sw_pre_run.html !! @@ -49,5 +48,4 @@ subroutine rad_sw_pre_run (im, lsswr, coszen, nday, idxday, errmsg, errflg) endif end subroutine rad_sw_pre_run -!> @} end module rad_sw_pre diff --git a/physics/Radiation/RRTMG/radcons.f90 b/physics/Radiation/RRTMG/radcons.f90 index 0ca7eeb19..decf79990 100644 --- a/physics/Radiation/RRTMG/radcons.f90 +++ b/physics/Radiation/RRTMG/radcons.f90 @@ -2,10 +2,6 @@ !! This file contains module radcons. -!> \defgroup radcons GFS RRTMG Constants Module -!> This module contains some of the most frequently used math and physics -!! constants for RRTMG. - !> This module contains some of the most frequently used math and physics !! constants for RRTMG. module radcons diff --git a/physics/Radiation/RRTMG/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 index 7bc1ea80c..57bebd88f 100644 --- a/physics/Radiation/RRTMG/radlw_main.F90 +++ b/physics/Radiation/RRTMG/radlw_main.F90 @@ -630,7 +630,8 @@ subroutine rrtmg_lw_run & real (kind=kind_phys), dimension(:), intent(in) :: sfemis, & & sfgtmp, de_lgth - real (kind=kind_phys), dimension(npts,nlay), intent(in) :: alpha + real (kind=kind_phys), dimension(npts,nlay),intent(in) :: & + alpha real (kind=kind_phys), dimension(:,:,:),intent(in):: & & aeraod, aerssa @@ -759,14 +760,14 @@ subroutine rrtmg_lw_run & end if endif ! end if_ilwcliq -!> -# Change random number seed value for each radiation invocation +!> - Change random number seed value for each radiation invocation !! (isubclw =1 or 2). if ( isubclw == 1 ) then ! advance prescribed permutation seed do i = 1, npts ipseed(i) = ipsdlw0 + i enddo - elseif ( isubclw == 2 ) then ! use input array of permutaion seeds + elseif ( isubclw == 2 ) then ! use input array of permutation seeds do i = 1, npts ipseed(i) = icseed(i) enddo @@ -781,7 +782,7 @@ subroutine rrtmg_lw_run & lab_do_iplon : do iplon = 1, npts -!> -# Read surface emissivity. +!> - Read surface emissivity. if (sfemis(iplon) > eps .and. sfemis(iplon) <= 1.0) then ! input surface emissivity do j = 1, nbands semiss(j) = sfemis(iplon) @@ -795,7 +796,7 @@ subroutine rrtmg_lw_run & stemp = sfgtmp(iplon) ! surface ground temp if (iovr == iovr_dcorr) delgth= de_lgth(iplon) ! clouds decorr-length -!> -# Prepare atmospheric profile for use in rrtm. +!> - Prepare atmospheric profile for use in rrtm. ! the vertical index of internal array is from surface to top ! --- ... molecular amounts are input or converted to volume mixing ratio @@ -819,7 +820,7 @@ subroutine rrtmg_lw_run & dz(k) = dzlyr(iplon,k1) if (iovr == iovr_exp .or. iovr == iovr_exprand) alph(k) = alpha(iplon,k) ! alpha decorrelation -!> -# Set absorber amount for h2o, co2, and o3. +!> - Set absorber amount for h2o, co2, and o3. !test use ! h2ovmr(k)= max(f_zero,qlyr(iplon,k1)*amdw) ! input mass mixing ratio @@ -840,7 +841,7 @@ subroutine rrtmg_lw_run & colamt(k,3) = max(temcol(k), coldry(k)*o3vmr(k)) ! o3 enddo -!> -# Set up column amount for rare gases n2o,ch4,o2,co,ccl4,cf11,cf12, +!> - Set up column amount for rare gases n2o,ch4,o2,co,ccl4,cf11,cf12, !! cf22, convert from volume mixing ratio to molec/cm2 based on !! coldry (scaled to 1.0e-20). @@ -871,7 +872,7 @@ subroutine rrtmg_lw_run & enddo endif -!> -# Set aerosol optical properties. +!> - Set aerosol optical properties. do k = 1, nlay k1 = nlp1 - k @@ -881,7 +882,7 @@ subroutine rrtmg_lw_run & enddo enddo -!> -# Read cloud optical properties. +!> - Read cloud optical properties. if (ilwcliq > 0) then ! use prognostic cloud method do k = 1, nlay k1 = nlp1 - k @@ -906,7 +907,7 @@ subroutine rrtmg_lw_run & cldfrc(0) = f_one ! padding value only cldfrc(nlp1) = f_zero ! padding value only -!> -# Compute precipitable water vapor for diffusivity angle adjustments. +!> - Compute precipitable water vapor for diffusivity angle adjustments. tem1 = f_zero tem2 = f_zero @@ -1026,7 +1027,7 @@ subroutine rrtmg_lw_run & endif ! top_at_1 -!> -# Compute column amount for broadening gases. +!> - Compute column amount for broadening gases. do k = 1, nlay summol = f_zero @@ -1036,7 +1037,7 @@ subroutine rrtmg_lw_run & colbrd(k) = coldry(k) - summol enddo -!> -# Compute diffusivity angle adjustments. +!> - Compute diffusivity angle adjustments. tem1 = 1.80 tem2 = 1.50 @@ -1064,7 +1065,7 @@ subroutine rrtmg_lw_run & ! print *,' o3vmr ',o3vmr ! endif -!> -# For cloudy atmosphere, call cldprop() to set cloud optical +!> - For cloudy atmosphere, call cldprop() to set cloud optical !! properties. lcf1 = .false. @@ -1115,7 +1116,7 @@ subroutine rrtmg_lw_run & ! print *,' cldfrac',cldfrc ! endif -!> -# Calling setcoef() to compute various coefficients needed in +!> - Calling setcoef() to compute various coefficients needed in !! radiative transfer calculations. call setcoef & ! --- inputs: @@ -1150,7 +1151,7 @@ subroutine rrtmg_lw_run & ! print *,'indfor',indfor ! endif -!> -# Call taumol() to calculte the gaseous optical depths and Plank +!> - Call taumol() to calculte the gaseous optical depths and Plank !! fractions for each longwave spectral band. call taumol & @@ -1177,7 +1178,7 @@ subroutine rrtmg_lw_run & ! enddo ! endif -!> -# Call the radiative transfer routine based on cloud scheme +!> - Call the radiative transfer routine based on cloud scheme !! selection. Compute the upward/downward radiative fluxes, and !! heating rates for both clear or cloudy atmosphere. !!\n - call rtrn(): clouds are assumed as randomly overlaping in a @@ -1223,7 +1224,7 @@ subroutine rrtmg_lw_run & endif ! end if_isubclw_block -!> -# Save outputs. +!> - Save outputs. topflx(iplon)%upfxc = totuflux(nlay) topflx(iplon)%upfx0 = totuclfl(nlay) @@ -1434,18 +1435,18 @@ subroutine rlwinit( me, rad_hr_units, inc_minor_gas, ilwcliq, & & 'sub-column clouds approximation applied' elseif ( isubclw == 1 ) then print *,' --- Using MCICA sub-colum clouds approximation ', & - & 'with a prescribed sequence of permutaion seeds' + & 'with a prescribed sequence of permutation seeds' elseif ( isubclw == 2 ) then print *,' --- Using MCICA sub-colum clouds approximation ', & & 'with provided input array of permutation seeds' endif endif -!> -# Setup default surface emissivity for each band. +!> - Setup default surface emissivity for each band. semiss0(:) = f_one -!> -# Setup constant factors for flux and heating rate +!> - Setup constant factors for flux and heating rate !! the 1.0e-2 is to convert pressure from mb to \f$N/m^2\f$. pival = 2.0 * asin(f_one) @@ -1460,7 +1461,7 @@ subroutine rlwinit( me, rad_hr_units, inc_minor_gas, ilwcliq, & heatfac = con_g * 1.0e-2 / con_cp ! (in k/second) endif -!> -# Compute lookup tables for transmittance, tau transition +!> - Compute lookup tables for transmittance, tau transition !! function, and clear sky tau (for the cloudy sky radiative !! transfer). tau is computed as a function of the tau !! transition function, transmittance is calculated as a @@ -1668,7 +1669,7 @@ subroutine cldprop & enddo enddo -!> -# Compute cloud radiative properties for a cloudy column: +!> - Compute cloud radiative properties for a cloudy column: !!\n - Compute cloud radiative properties for rain and snow (tauran,tausnw) !!\n - Calculation of absorption coefficients due to water clouds(tauliq) !!\n - Calculation of absorption coefficients due to ice clouds (tauice). @@ -1796,7 +1797,7 @@ subroutine cldprop & endif lab_if_ilwcliq -!> -# if GFS_typedefs::isubclw > 0, call mcica_subcol() to distribute +!> - if GFS_typedefs::isubclw > 0, call mcica_subcol() to distribute !! cloud properties to each g-point. if ( isubclw > 0 ) then ! mcica sub-col clouds approx @@ -1829,7 +1830,6 @@ subroutine cldprop & endif ! end if_isubclw_block - return ! .................................. end subroutine cldprop ! ---------------------------------- @@ -1894,7 +1894,7 @@ subroutine mcica_subcol & ! !===> ... begin here ! -!> -# Call random_setseed() to advance randum number generator by ipseed values. +!> - Call random_setseed() to advance randum number generator by ipseed values. call random_setseed & ! --- inputs: @@ -1903,7 +1903,7 @@ subroutine mcica_subcol & & stat & & ) -!> -# Sub-column set up according to overlapping assumption: +!> - Sub-column set up according to overlapping assumption: !! - For random overlap, pick a random value at every level !! - For max-random overlap, pick a random value at every level !! - For maximum overlap, pick same random numebr at every level @@ -2092,7 +2092,7 @@ subroutine mcica_subcol & end select -!> -# Generate subcolumns for homogeneous clouds. +!> - Generate subcolumns for homogeneous clouds. do k = 1, nlay tem1 = f_one - cldf(k) @@ -2102,7 +2102,6 @@ subroutine mcica_subcol & enddo enddo - return ! .................................. end subroutine mcica_subcol ! ---------------------------------- @@ -2243,7 +2242,7 @@ subroutine setcoef & ! !===> ... begin here ! -!> -# Calculate information needed by the radiative transfer routine +!> - Calculate information needed by the radiative transfer routine !! that is specific to this atmosphere, especially some of the !! coefficients and indices needed to compute the optical depths !! by interpolating data from stored reference atmospheres. @@ -2260,7 +2259,7 @@ subroutine setcoef & enddo ! --- ... begin layer loop -!> -# Calculate the integrated Planck functions for each band at the +!> - Calculate the integrated Planck functions for each band at the !! surface, level, and layer temperatures. laytrop = 0 @@ -2282,7 +2281,7 @@ subroutine setcoef & & * (totplnk(indlev+1,i) - totplnk(indlev,i)) ) enddo -!> -# Find the two reference pressures on either side of the +!> - Find the two reference pressures on either side of the !! layer pressure. store them in jp and jp1. store in fp the !! fraction of the difference (in ln(pressure)) between these !! two values that the layer pressure lies. @@ -2294,7 +2293,7 @@ subroutine setcoef & fp = max(f_zero, min(f_one, 5.0*(preflog(jp(k))-plog) )) !org fp = 5.0 * (preflog(jp(k)) - plog) -!> -# Determine, for each reference pressure (jp and jp1), which +!> - Determine, for each reference pressure (jp and jp1), which !! reference temperature (these are different for each !! reference pressure) is nearest the layer temperature but does !! not exceed it. store these indices in jt and jt1, resp. @@ -2312,7 +2311,7 @@ subroutine setcoef & !org ft = tem1 - float(jt (k) - 3) !org ft1 = tem2 - float(jt1(k) - 3) -!> -# We have now isolated the layer ln pressure and temperature, +!> - We have now isolated the layer ln pressure and temperature, !! between two reference pressures and two reference temperatures !!(for each reference pressure). we multiply the pressure !! fraction fp with the appropriate temperature fractions to get @@ -2328,7 +2327,7 @@ subroutine setcoef & forfac(k) = pavel(k)*stpfac / (tavel(k)*(1.0 + h2ovmr(k))) selffac(k) = h2ovmr(k) * forfac(k) -!> -# Set up factors needed to separately include the minor gases +!> - Set up factors needed to separately include the minor gases !! in the calculation of absorption coefficient. scaleminor(k) = pavel(k) / tavel(k) @@ -2338,7 +2337,7 @@ subroutine setcoef & indminor(k) = min(18, max(1, int(tem1))) minorfrac(k) = tem1 - float(indminor(k)) -!> -# If the pressure is less than ~100mb, perform a different +!> - If the pressure is less than ~100mb, perform a different !! set of species interpolations. if (plog > 4.56) then @@ -2349,14 +2348,14 @@ subroutine setcoef & indfor(k) = min(2, max(1, int(tem1))) forfrac(k) = tem1 - float(indfor(k)) -!> -# Set up factors needed to separately include the water vapor +!> - Set up factors needed to separately include the water vapor !! self-continuum in the calculation of absorption coefficient. tem1 = (tavel(k) - 188.0) / 7.2 indself(k) = min(9, max(1, int(tem1)-7)) selffrac(k) = tem1 - float(indself(k) + 7) -!> -# Setup reference ratio to be used in calculation of binary +!> - Setup reference ratio to be used in calculation of binary !! species parameter in lower atmosphere. rfrate(k,1,1) = chi_mls(1,jp(k)) / chi_mls(2,jp(k)) @@ -2383,7 +2382,7 @@ subroutine setcoef & indself(k) = 0 selffrac(k) = f_zero -!> -# Setup reference ratio to be used in calculation of binary +!> - Setup reference ratio to be used in calculation of binary !! species parameter in upper atmosphere. rfrate(k,1,1) = chi_mls(1,jp(k)) / chi_mls(2,jp(k)) @@ -2394,14 +2393,13 @@ subroutine setcoef & endif -!> -# Rescale \a selffac and \a forfac for use in taumol. +!> - Rescale \a selffac and \a forfac for use in taumol. selffac(k) = colamt(k,1) * selffac(k) forfac(k) = colamt(k,1) * forfac(k) enddo ! end do_k layer loop - return ! .................................. end subroutine setcoef ! ---------------------------------- @@ -2613,7 +2611,7 @@ subroutine rtrn & radtotd = f_zero radclrd = f_zero -!> -# Downward radiative transfer loop. +!> - Downward radiative transfer loop. do k = nlay, 1, -1 @@ -2692,7 +2690,7 @@ subroutine rtrn & enddo ! end do_k_loop -!> -# Compute spectral emissivity & reflectance, include the +!> - Compute spectral emissivity & reflectance, include the !! contribution of spectrally varying longwave emissivity and !! reflection from the surface to the upward radiative transfer. @@ -2702,15 +2700,15 @@ subroutine rtrn & reflct = f_one - semiss(ib) rad0 = semiss(ib) * fracs(ig,1) * pklay(ib,0) -!> -# Compute total sky radiance. +!> - Compute total sky radiance. radtotu = rad0 + reflct*radtotd toturad(0,ib) = toturad(0,ib) + radtotu -!> -# Compute clear sky radiance +!> - Compute clear sky radiance radclru = rad0 + reflct*radclrd clrurad(0,ib) = clrurad(0,ib) + radclru -!> -# Upward radiative transfer loop. +!> - Upward radiative transfer loop. do k = 1, nlay clfr = cldfrc(k) @@ -2746,7 +2744,7 @@ subroutine rtrn & enddo ! end do_ig_loop -!> -# Process longwave output from band for total and clear streams. +!> - Process longwave output from band for total and clear streams. !! Calculate upward, downward, and net flux. flxfac = wtdiff * fluxfac @@ -2999,7 +2997,7 @@ subroutine rtrnmr & if (cldfrc(k) > eps) then -!> -# Setup maximum/random cloud overlap. +!> - Setup maximum/random cloud overlap. if (cldfrc(k+1) >= cldfrc(k)) then if (lstcldu(k)) then @@ -3143,7 +3141,7 @@ subroutine rtrnmr & enddo -!> -# Initialize for radiative transfer +!> - Initialize for radiative transfer do ib = 1, NBANDS do k = 0, NLAY @@ -3169,7 +3167,7 @@ subroutine rtrnmr & radtotd = f_zero radclrd = f_zero -!> -# Downward radiative transfer loop: +!> - Downward radiative transfer loop: do k = nlay, 1, -1 @@ -3266,7 +3264,7 @@ subroutine rtrnmr & enddo ! end do_k_loop -!> -# Compute spectral emissivity & reflectance, include the +!> - Compute spectral emissivity & reflectance, include the !! contribution of spectrally varying longwave emissivity and !! reflection from the surface to the upward radiative transfer. @@ -3276,15 +3274,15 @@ subroutine rtrnmr & reflct = f_one - semiss(ib) rad0 = semiss(ib) * fracs(ig,1) * pklay(ib,0) -!> -# Compute total sky radiance. +!> - Compute total sky radiance. radtotu = rad0 + reflct*radtotd toturad(0,ib) = toturad(0,ib) + radtotu -!> -# Compute clear sky radiance. +!> - Compute clear sky radiance. radclru = rad0 + reflct*radclrd clrurad(0,ib) = clrurad(0,ib) + radclru -!> -# Upward radiative transfer loop: +!> - Upward radiative transfer loop: do k = 1, nlay @@ -3338,7 +3336,7 @@ subroutine rtrnmr & enddo ! end do_ig_loop -!> -# Process longwave output from band for total and clear streams. +!> - Process longwave output from band for total and clear streams. !! calculate upward, downward, and net flux. flxfac = wtdiff * fluxfac @@ -3588,7 +3586,7 @@ subroutine rtrnmc & radtotd = f_zero radclrd = f_zero -!> -# Downward radiative transfer loop. +!> - Downward radiative transfer loop. !!\n - Clear sky, gases contribution !!\n - Total sky, gases+clouds contribution !!\n - Cloudy layer @@ -3672,7 +3670,7 @@ subroutine rtrnmc & enddo ! end do_k_loop -!> -# Compute spectral emissivity & reflectance, include the +!> - Compute spectral emissivity & reflectance, include the !! contribution of spectrally varying longwave emissivity and !! reflection from the surface to the upward radiative transfer. @@ -3682,15 +3680,15 @@ subroutine rtrnmc & reflct = f_one - semiss(ib) rad0 = semiss(ib) * fracs(ig,1) * pklay(ib,0) -!> -# Compute total sky radiance. +!> - Compute total sky radiance. radtotu = rad0 + reflct*radtotd toturad(0,ib) = toturad(0,ib) + radtotu -!> -# Compute clear sky radiance. +!> - Compute clear sky radiance. radclru = rad0 + reflct*radclrd clrurad(0,ib) = clrurad(0,ib) + radclru -!> -# Upward radiative transfer loop. +!> - Upward radiative transfer loop. !!\n - Compute total sky radiance !!\n - Compute clear sky radiance @@ -3731,7 +3729,7 @@ subroutine rtrnmc & enddo ! end do_ig_loop -!> -# Process longwave output from band for total and clear streams. +!> - Process longwave output from band for total and clear streams. !! Calculate upward, downward, and net flux. flxfac = wtdiff * fluxfac @@ -3750,7 +3748,7 @@ subroutine rtrnmc & totdclfl(k) = totdclfl(k) * flxfac enddo -!> -# Calculate net fluxes and heating rates. +!> - Calculate net fluxes and heating rates. fnet(0) = totuflux(0) - totdflux(0) do k = 1, nlay @@ -3759,7 +3757,7 @@ subroutine rtrnmc & htr (k) = (fnet(k-1) - fnet(k)) * rfdelp(k) enddo -!> -# Optional clear sky heating rates. +!> - Optional clear sky heating rates. if ( lhlw0 ) then fnetc(0) = totuclfl(0) - totdclfl(0) @@ -3769,7 +3767,7 @@ subroutine rtrnmc & enddo endif -!> -# Optional spectral band heating rates. +!> - Optional spectral band heating rates. if ( lhlwb ) then do ib = 1, nbands fnet(0) = (toturad(0,ib) - totdrad(0,ib)) * flxfac diff --git a/physics/Radiation/RRTMG/radlw_main.meta b/physics/Radiation/RRTMG/radlw_main.meta index f7c80fb20..ec90cc533 100644 --- a/physics/Radiation/RRTMG/radlw_main.meta +++ b/physics/Radiation/RRTMG/radlw_main.meta @@ -363,6 +363,7 @@ type = real kind = kind_phys intent = inout + optional = True [cld_lwp] standard_name = cloud_liquid_water_path long_name = cloud liquid water path diff --git a/physics/Radiation/RRTMG/radsw_main.F90 b/physics/Radiation/RRTMG/radsw_main.F90 index fe63963f5..d21c07d5a 100644 --- a/physics/Radiation/RRTMG/radsw_main.F90 +++ b/physics/Radiation/RRTMG/radsw_main.F90 @@ -689,7 +689,8 @@ subroutine rrtmg_sw_run & isubcsw, iovr, iswmode, iovr_dcorr, iovr_exp, iovr_exprand, & iovr_rand, iovr_maxrand, iovr_max - integer, dimension(:), intent(in) :: idxday, icseed + integer, dimension(:), intent(in) :: idxday + integer, dimension(:), intent(in) :: icseed logical, intent(in) :: lprnt, lsswr, inc_minor_gas, top_at_1 @@ -725,7 +726,8 @@ subroutine rrtmg_sw_run & real (kind=kind_phys), intent(in) :: cosz(npts), solcon, & & de_lgth(npts) - real (kind=kind_phys), dimension(npts,nlay), intent(in) :: alpha + real (kind=kind_phys), dimension(npts,nlay),intent(in) :: & + alpha ! --- outputs: real (kind=kind_phys), dimension(:,:), intent(inout) :: hswc @@ -876,7 +878,7 @@ subroutine rrtmg_sw_run & do i = 1, npts ipseed(i) = ipsdsw0 + i enddo - elseif ( isubcsw == 2 ) then ! use input array of permutaion seeds + elseif ( isubcsw == 2 ) then ! use input array of permutation seeds do i = 1, npts ipseed(i) = icseed(i) enddo diff --git a/physics/Radiation/RRTMG/radsw_main.meta b/physics/Radiation/RRTMG/radsw_main.meta index 2169a26f0..55b7c29b3 100644 --- a/physics/Radiation/RRTMG/radsw_main.meta +++ b/physics/Radiation/RRTMG/radsw_main.meta @@ -424,6 +424,7 @@ type = real kind = kind_phys intent = inout + optional = True [fdncmp] standard_name = components_of_surface_downward_shortwave_fluxes long_name = derived type for special components of surface downward shortwave fluxes @@ -431,6 +432,7 @@ dimensions = (horizontal_loop_extent) type = cmpfsw_type intent = inout + optional = True [cld_lwp] standard_name = cloud_liquid_water_path long_name = cloud liquid water path diff --git a/physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 b/physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 index 1dd225514..082428b08 100644 --- a/physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 +++ b/physics/Radiation/RRTMG/rrtmg_lw_cloud_optics.F90 @@ -1,13 +1,17 @@ +!>\file rrtmg_lw_cloud_optics.F90 +!! + +!>This module contains the cloud optics property module for RRTMG-LW module mo_rrtmg_lw_cloud_optics use machine, only: kind_phys use mersenne_twister, only: random_setseed, random_number, random_stat implicit none - !< Parameter used for RRTMG cloud-optics + !> Parameter used for RRTMG cloud-optics integer,parameter :: & nBandsLW_RRTMG = 16 - !< ipat is bands index for ebert & curry ice cloud (for iflagice=1) + !> ipat is bands index for ebert & curry ice cloud (for iflagice=1) integer,dimension(nBandsLW_RRTMG),parameter :: & ipat = (/ 1, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5 /) real(kind_phys), parameter :: & @@ -15,7 +19,7 @@ module mo_rrtmg_lw_cloud_optics abssnow0 = 1.5, & !< Snow flake absorption coefficient (micron), fu coeff abssnow1 = 2.34e-3 !< Snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coef - !< Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50 + !> Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50 !! and 1.80) as a function of total column water vapor. the function !! has been defined to minimize flux and cooling rate errors in these bands !! over a wide range of precipitable water values. @@ -32,7 +36,7 @@ module mo_rrtmg_lw_cloud_optics diffusivityHigh = 1.80, & !< Maximum diffusivity angle for bands 2-3 and 5-9 diffusivityB1410 = 1.66 !< Diffusivity for bands 1, 4, and 10 - !< RRTMG LW cloud property coefficients + !> RRTMG LW cloud property coefficients real(kind_phys) , dimension(58,nBandsLW_RRTMG),parameter :: & absliq1 = reshape(source=(/ & 1.64047e-03, 6.90533e-02, 7.72017e-02, 7.78054e-02, 7.69523e-02, & !1 diff --git a/physics/Radiation/RRTMG/rrtmg_lw_post.F90 b/physics/Radiation/RRTMG/rrtmg_lw_post.F90 index d9d3aa520..36661973d 100644 --- a/physics/Radiation/RRTMG/rrtmg_lw_post.F90 +++ b/physics/Radiation/RRTMG/rrtmg_lw_post.F90 @@ -1,5 +1,6 @@ !>\file rrtmg_lw_post.F90 -!!This file contains GFS RRTMG scheme post. + +!> This module contains code executed after RRTMG-LW scheme module rrtmg_lw_post contains diff --git a/physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 b/physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 index 01cab76e2..ea38f85cd 100644 --- a/physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 +++ b/physics/Radiation/RRTMG/rrtmg_sw_cloud_optics.F90 @@ -1,3 +1,7 @@ +!>\file rrtmg_sw_cloud_optics.F90 +!! + +!> This module contains the cloud optics property module for RRTMG-SW module mo_rrtmg_sw_cloud_optics use machine, only: kind_phys use mersenne_twister, only: random_setseed, random_number, random_stat diff --git a/physics/Radiation/RRTMG/rrtmg_sw_post.F90 b/physics/Radiation/RRTMG/rrtmg_sw_post.F90 index 8fa9494b8..91c9ced16 100644 --- a/physics/Radiation/RRTMG/rrtmg_sw_post.F90 +++ b/physics/Radiation/RRTMG/rrtmg_sw_post.F90 @@ -1,5 +1,6 @@ !>\file rrtmg_sw_post.F90 -!! This file contains GFS RRTMG scheme post. + +!> This module contains RRTMG-SW scheme post module rrtmg_sw_post contains diff --git a/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90 index 9a92ea98a..4286e10d2 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_aerosol_optics.F90 @@ -1,6 +1,7 @@ !>\file rrtmgp_aerosol_optics.F90 !! +!> This module contains aerosol optics properties for RRTMGP module rrtmgp_aerosol_optics use machine, only: kind_phys use radiation_tools, only: check_error_msg @@ -15,13 +16,7 @@ module rrtmgp_aerosol_optics contains - ! ######################################################################################### - ! SUBROUTINE rrtmgp_aerosol_optics_run() - ! ######################################################################################### - -!>\defgroup rrtmgp_aerosol_optics_mod GFS RRTMGP Aerosol Optics Module -!> @{ -!! \section arg_table_rrtmgp_aerosol_optics_run +!> \section arg_table_rrtmgp_aerosol_optics_run Argument Table !! \htmlinclude rrtmgp_aerosol_optics_run.html !! subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nDay, idxday, p_lev, & @@ -53,7 +48,8 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nDay, idxday, real(kind_phys), dimension(:,:),intent(in) :: & p_lay, & ! Pressure @ layer-centers (Pa) tv_lay, & ! Virtual-temperature @ layer-centers (K) - relhum, & ! Relative-humidity @ layer-centers + relhum ! Relative-humidity @ layer-centers + real(kind_phys), dimension(:,:),intent(in) :: & p_lk ! Exner function @ layer-centers (1) real(kind_phys), dimension(:, :,:),intent(in) :: & tracer ! trace gas concentrations @@ -124,5 +120,4 @@ subroutine rrtmgp_aerosol_optics_run(doSWrad, doLWrad, nCol, nLev, nDay, idxday, endif end subroutine rrtmgp_aerosol_optics_run -!> @} end module rrtmgp_aerosol_optics diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 index 9915c0040..fd28b11b7 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 @@ -1,23 +1,18 @@ !> \file rrtmgp_lw_cloud_optics.F90 !! -!> \defgroup rrtmgp_lw_cloud_optics rrtmgp_lw_cloud_optics.F90 -!! -!! \brief This module contains two routines: The first initializes data and functions + +!> This module contains two routines: The first initializes data and functions !! needed to compute the longwave cloud radiative properteis in RRTMGP. The second routine !! is a ccpp scheme within the "radiation loop", where the shortwave optical prperties !! (optical-depth, single-scattering albedo, asymmetry parameter) are computed for ALL !! cloud types visible to RRTMGP. -!! module rrtmgp_lw_cloud_optics - use machine, only: kind_phys - use mo_rte_kind, only: wl - use mo_cloud_optics, only: ty_cloud_optics + use mo_rte_kind, only: wl, wp + use mo_cloud_optics_rrtmgp, only: ty_cloud_optics => ty_cloud_optics_rrtmgp use rrtmgp_lw_gas_optics, only: lw_gas_props use radiation_tools, only: check_error_msg use netcdf -#ifdef MPI - use mpi -#endif + use mpi_f08 implicit none @@ -25,80 +20,54 @@ module rrtmgp_lw_cloud_optics integer :: & nrghice_fromfileLW, nBandLW, nSize_liqLW, nSize_iceLW, nSizeRegLW, & nCoeff_extLW, nCoeff_ssa_gLW, nBoundLW, npairsLW - real(kind_phys) :: & - radliq_facLW, & ! Factor for calculating LUT interpolation indices for liquid - radice_facLW ! Factor for calculating LUT interpolation indices for ice - real(kind_phys), dimension(:,:), allocatable :: & - lut_extliqLW, & ! LUT shortwave liquid extinction coefficient - lut_ssaliqLW, & ! LUT shortwave liquid single scattering albedo - lut_asyliqLW, & ! LUT shortwave liquid asymmetry parameter - band_limsCLDLW ! Beginning and ending wavenumber [cm -1] for each band - real(kind_phys), dimension(:,:,:), allocatable :: & - lut_exticeLW, & ! LUT shortwave ice extinction coefficient - lut_ssaiceLW, & ! LUT shortwave ice single scattering albedo - lut_asyiceLW ! LUT shortwave ice asymmetry parameter - real(kind_phys), dimension(:), allocatable :: & - pade_sizereg_extliqLW, & ! Particle size regime boundaries for shortwave liquid extinction - ! coefficient for Pade interpolation - pade_sizereg_ssaliqLW, & ! Particle size regime boundaries for shortwave liquid single - ! scattering albedo for Pade interpolation - pade_sizereg_asyliqLW, & ! Particle size regime boundaries for shortwave liquid asymmetry - ! parameter for Pade interpolation - pade_sizereg_exticeLW, & ! Particle size regime boundaries for shortwave ice extinction - ! coefficient for Pade interpolation - pade_sizereg_ssaiceLW, & ! Particle size regime boundaries for shortwave ice single - ! scattering albedo for Pade interpolation - pade_sizereg_asyiceLW ! Particle size regime boundaries for shortwave ice asymmetry - ! parameter for Pade interpolation - real(kind_phys), dimension(:,:,:), allocatable :: & - pade_extliqLW, & ! PADE coefficients for shortwave liquid extinction - pade_ssaliqLW, & ! PADE coefficients for shortwave liquid single scattering albedo - pade_asyliqLW ! PADE coefficients for shortwave liquid asymmetry parameter - real(kind_phys), dimension(:,:,:,:), allocatable :: & - pade_exticeLW, & ! PADE coefficients for shortwave ice extinction - pade_ssaiceLW, & ! PADE coefficients for shortwave ice single scattering albedo - pade_asyiceLW ! PADE coefficients for shortwave ice asymmetry parameter + real(wp), dimension(:,:), allocatable :: & + lut_extliqLW, & !< LUT shortwave liquid extinction coefficient + lut_ssaliqLW, & !< LUT shortwave liquid single scattering albedo + lut_asyliqLW, & !< LUT shortwave liquid asymmetry parameter + band_limsCLDLW !< Beginning and ending wavenumber [cm -1] for each band + real(wp), dimension(:,:,:), allocatable :: & + lut_exticeLW, & !< LUT shortwave ice extinction coefficient + lut_ssaiceLW, & !< LUT shortwave ice single scattering albedo + lut_asyiceLW !< LUT shortwave ice asymmetry parameter ! Parameters used for rain and snow(+groupel) RRTMGP cloud-optics - real(kind_phys), parameter :: & - absrain = 0.33e-3, & ! Rain drop absorption coefficient \f$(m^{2}/g)\f$ . - abssnow0 = 1.5, & ! Snow flake absorption coefficient (micron), fu coeff - abssnow1 = 2.34e-3 ! Snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coef - real(kind_phys) :: & - radliq_lwrLW, & ! Liquid particle size lower bound for LUT interpolation - radliq_uprLW, & ! Liquid particle size upper bound for LUT interpolation - radice_lwrLW, & ! Ice particle size upper bound for LUT interpolation - radice_uprLW ! Ice particle size lower bound for LUT interpolation + real(wp), parameter :: & + absrain = 0.33e-3, & !< Rain drop absorption coefficient m2/g . + abssnow0 = 1.5, & !< Snow flake absorption coefficient (micron), fu coeff + abssnow1 = 2.34e-3 !< Snow flake absorption coefficient m2/g, ncar coef + real(wp) :: & + radliq_lwrLW, & !< Liquid particle size lower bound for LUT interpolation + radliq_uprLW, & !< Liquid particle size upper bound for LUT interpolation + radice_lwrLW, & !< Ice particle size upper bound for LUT interpolation + radice_uprLW !< Ice particle size lower bound for LUT interpolation contains ! ###################################################################################### ! SUBROUTINE rrtmgp_lw_cloud_optics_init() ! ###################################################################################### +!> subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot, & - errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & - rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_lw_file_clouds ! RRTMGP file containing clouds optics data + rrtmgp_root_dir, & !< RTE-RRTMGP root directory + rrtmgp_lw_file_clouds !< RRTMGP file containing clouds optics data - logical, intent(in) :: & - doGP_cldoptics_PADE,& ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(inout) :: & - nrghice ! Number of ice-roughness categories + nrghice !< Number of ice-roughness categories + type(MPI_Comm), intent(in) :: & + mpicomm !< MPI communicator integer, intent(in) :: & - mpicomm, & ! MPI communicator - mpirank, & ! Current MPI rank - mpiroot ! Master MPI rank + mpirank, & !< Current MPI rank + mpiroot !< Master MPI rank ! Outputs character(len=*), intent(out) :: & - errmsg ! Error message + errmsg !< Error message integer, intent(out) :: & - errflg ! Error code + errflg !< Error code ! Local variables integer :: dimID,varID,status,ncid,mpierr @@ -117,9 +86,7 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP longwave cloud-optics metadata ... ' ! Open file @@ -145,7 +112,6 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, status = nf90_inq_dimid(ncid, 'pair', dimid) status = nf90_inquire_dimension(ncid, dimid, len=npairsLW) -#ifdef MPI endif ! On master processor ! Other processors waiting... @@ -165,14 +131,11 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, call mpi_bcast(nCoeff_ssa_gLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nBoundLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nPairsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! Has the number of ice-roughnesses to use been provided from the namelist? ! If so, override nrghice from cloud-optics file if (nrghice .ne. 0) nrghice_fromfileLW = nrghice -#ifdef MPI call mpi_bcast(nrghice_fromfileLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! ####################################################################################### ! @@ -180,29 +143,13 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, ! (ALL processors) ! ! ####################################################################################### - if (doGP_cldoptics_LUT) then - allocate(lut_extliqLW(nSize_liqLW, nBandLW)) - allocate(lut_ssaliqLW(nSize_liqLW, nBandLW)) - allocate(lut_asyliqLW(nSize_liqLW, nBandLW)) - allocate(lut_exticeLW(nSize_iceLW, nBandLW, nrghice_fromfileLW)) - allocate(lut_ssaiceLW(nSize_iceLW, nBandLW, nrghice_fromfileLW)) - allocate(lut_asyiceLW(nSize_iceLW, nBandLW, nrghice_fromfileLW)) - endif - if (doGP_cldoptics_PADE) then - allocate(pade_extliqLW(nBandLW, nSizeRegLW, nCoeff_extLW )) - allocate(pade_ssaliqLW(nBandLW, nSizeRegLW, nCoeff_ssa_gLW)) - allocate(pade_asyliqLW(nBandLW, nSizeRegLW, nCoeff_ssa_gLW)) - allocate(pade_exticeLW(nBandLW, nSizeRegLW, nCoeff_extLW, nrghice_fromfileLW)) - allocate(pade_ssaiceLW(nBandLW, nSizeRegLW, nCoeff_ssa_gLW, nrghice_fromfileLW)) - allocate(pade_asyiceLW(nBandLW, nSizeRegLW, nCoeff_ssa_gLW, nrghice_fromfileLW)) - allocate(pade_sizereg_extliqLW(nBoundLW)) - allocate(pade_sizereg_ssaliqLW(nBoundLW)) - allocate(pade_sizereg_asyliqLW(nBoundLW)) - allocate(pade_sizereg_exticeLW(nBoundLW)) - allocate(pade_sizereg_ssaiceLW(nBoundLW)) - allocate(pade_sizereg_asyiceLW(nBoundLW)) - endif - allocate(band_limsCLDLW(2,nBandLW)) + if (.not. allocated(lut_extliqLW)) allocate(lut_extliqLW(nSize_liqLW, nBandLW)) + if (.not. allocated(lut_ssaliqLW)) allocate(lut_ssaliqLW(nSize_liqLW, nBandLW)) + if (.not. allocated(lut_asyliqLW)) allocate(lut_asyliqLW(nSize_liqLW, nBandLW)) + if (.not. allocated(lut_exticeLW)) allocate(lut_exticeLW(nSize_iceLW, nBandLW, nrghice_fromfileLW)) + if (.not. allocated(lut_ssaiceLW)) allocate(lut_ssaiceLW(nSize_iceLW, nBandLW, nrghice_fromfileLW)) + if (.not. allocated(lut_asyiceLW)) allocate(lut_asyiceLW(nSize_iceLW, nBandLW, nrghice_fromfileLW)) + if (.not. allocated(band_limsCLDLW)) allocate(band_limsCLDLW(2,nBandLW)) ! ####################################################################################### ! @@ -210,84 +157,34 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif ! Read in fields from file - if (doGP_cldoptics_LUT) then - write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... ' - status = nf90_inq_varid(ncid,'radliq_lwr',varID) - status = nf90_get_var(ncid,varID,radliq_lwrLW) - status = nf90_inq_varid(ncid,'radliq_upr',varID) - status = nf90_get_var(ncid,varID,radliq_uprLW) - status = nf90_inq_varid(ncid,'radliq_fac',varID) - status = nf90_get_var(ncid,varID,radliq_facLW) - status = nf90_inq_varid(ncid,'radice_lwr',varID) - status = nf90_get_var(ncid,varID,radice_lwrLW) - status = nf90_inq_varid(ncid,'radice_upr',varID) - status = nf90_get_var(ncid,varID,radice_uprLW) - status = nf90_inq_varid(ncid,'radice_fac',varID) - status = nf90_get_var(ncid,varID,radice_facLW) - status = nf90_inq_varid(ncid,'lut_extliq',varID) - status = nf90_get_var(ncid,varID,lut_extliqLW) - status = nf90_inq_varid(ncid,'lut_ssaliq',varID) - status = nf90_get_var(ncid,varID,lut_ssaliqLW) - status = nf90_inq_varid(ncid,'lut_asyliq',varID) - status = nf90_get_var(ncid,varID,lut_asyliqLW) - status = nf90_inq_varid(ncid,'lut_extice',varID) - status = nf90_get_var(ncid,varID,lut_exticeLW) - status = nf90_inq_varid(ncid,'lut_ssaice',varID) - status = nf90_get_var(ncid,varID,lut_ssaiceLW) - status = nf90_inq_varid(ncid,'lut_asyice',varID) - status = nf90_get_var(ncid,varID,lut_asyiceLW) - status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid,varID,band_limsCLDLW) - endif - if (doGP_cldoptics_PADE) then - write (*,*) 'Reading RRTMGP longwave cloud data (PADE) ... ' - status = nf90_inq_varid(ncid,'radliq_lwr',varID) - status = nf90_get_var(ncid,varID,radliq_lwrLW) - status = nf90_inq_varid(ncid,'radliq_upr',varID) - status = nf90_get_var(ncid,varID,radliq_uprLW) - status = nf90_inq_varid(ncid,'radliq_fac',varID) - status = nf90_get_var(ncid,varID,radliq_facLW) - status = nf90_inq_varid(ncid,'radice_lwr',varID) - status = nf90_get_var(ncid,varID,radice_lwrLW) - status = nf90_inq_varid(ncid,'radice_upr',varID) - status = nf90_get_var(ncid,varID,radice_uprLW) - status = nf90_inq_varid(ncid,'radice_fac',varID) - status = nf90_get_var(ncid,varID,radice_facLW) - status = nf90_inq_varid(ncid,'pade_extliq',varID) - status = nf90_get_var(ncid,varID,pade_extliqLW) - status = nf90_inq_varid(ncid,'pade_ssaliq',varID) - status = nf90_get_var(ncid,varID,pade_ssaliqLW) - status = nf90_inq_varid(ncid,'pade_asyliq',varID) - status = nf90_get_var(ncid,varID,pade_asyliqLW) - status = nf90_inq_varid(ncid,'pade_extice',varID) - status = nf90_get_var(ncid,varID,pade_exticeLW) - status = nf90_inq_varid(ncid,'pade_ssaice',varID) - status = nf90_get_var(ncid,varID,pade_ssaiceLW) - status = nf90_inq_varid(ncid,'pade_asyice',varID) - status = nf90_get_var(ncid,varID,pade_asyiceLW) - status = nf90_inq_varid(ncid,'pade_sizreg_extliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_extliqLW) - status = nf90_inq_varid(ncid,'pade_sizreg_ssaliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_ssaliqLW) - status = nf90_inq_varid(ncid,'pade_sizreg_asyliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_asyliqLW) - status = nf90_inq_varid(ncid,'pade_sizreg_extice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_exticeLW) - status = nf90_inq_varid(ncid,'pade_sizreg_ssaice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_ssaiceLW) - status = nf90_inq_varid(ncid,'pade_sizreg_asyice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_asyiceLW) - status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid,varID,band_limsCLDLW) - endif + write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... ' + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwrLW) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_uprLW) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwrLW) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_uprLW) + status = nf90_inq_varid(ncid,'lut_extliq',varID) + status = nf90_get_var(ncid,varID,lut_extliqLW) + status = nf90_inq_varid(ncid,'lut_ssaliq',varID) + status = nf90_get_var(ncid,varID,lut_ssaliqLW) + status = nf90_inq_varid(ncid,'lut_asyliq',varID) + status = nf90_get_var(ncid,varID,lut_asyliqLW) + status = nf90_inq_varid(ncid,'lut_extice',varID) + status = nf90_get_var(ncid,varID,lut_exticeLW) + status = nf90_inq_varid(ncid,'lut_ssaice',varID) + status = nf90_get_var(ncid,varID,lut_ssaiceLW) + status = nf90_inq_varid(ncid,'lut_asyice',varID) + status = nf90_get_var(ncid,varID,lut_asyiceLW) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_limsCLDLW) ! Close file status = nf90_close(ncid) -#ifdef MPI endif ! Master process ! Other processors waiting... @@ -301,56 +198,35 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, ! ####################################################################################### ! Real scalars - call mpi_bcast(radliq_facLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(radice_facLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) +#ifdef RTE_USE_SP + call mpi_bcast(radliq_lwrLW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(radliq_uprLW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(radice_lwrLW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(radice_uprLW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) +#else call mpi_bcast(radliq_lwrLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(radliq_uprLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(radice_lwrLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(radice_uprLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) +#endif ! Real arrays - call mpi_bcast(band_limsCLDLW, size(band_limsCLDLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - if (doGP_cldoptics_LUT) then - call mpi_bcast(lut_extliqLW, size(lut_extliqLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(lut_ssaliqLW, size(lut_ssaliqLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(lut_asyliqLW, size(lut_asyliqLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(lut_exticeLW, size(lut_exticeLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(lut_ssaiceLW, size(lut_ssaiceLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(lut_asyiceLW, size(lut_asyiceLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (doGP_cldoptics_PADE) then - call mpi_bcast(pade_extliqLW, size(pade_extliqLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_ssaliqLW, size(pade_ssaliqLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_asyliqLW, size(pade_asyliqLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_exticeLW, size(pade_exticeLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_ssaiceLW, size(pade_ssaiceLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_asyiceLW, size(pade_asyiceLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_extliqLW, size(pade_sizereg_extliqLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_ssaliqLW, size(pade_sizereg_ssaliqLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_asyliqLW, size(pade_sizereg_asyliqLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_exticeLW, size(pade_sizereg_exticeLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_ssaiceLW, size(pade_sizereg_ssaiceLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_asyiceLW, size(pade_sizereg_asyiceLW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif +#ifdef RTE_USE_SP + call mpi_bcast(band_limsCLDLW, size(band_limsCLDLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_extliqLW, size(lut_extliqLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaliqLW, size(lut_ssaliqLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyliqLW, size(lut_asyliqLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_exticeLW, size(lut_exticeLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaiceLW, size(lut_ssaiceLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyiceLW, size(lut_asyiceLW), MPI_REAL, mpiroot, mpicomm, mpierr) +#else + call mpi_bcast(band_limsCLDLW, size(band_limsCLDLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_extliqLW, size(lut_extliqLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaliqLW, size(lut_ssaliqLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyliqLW, size(lut_asyliqLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_exticeLW, size(lut_exticeLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaiceLW, size(lut_ssaiceLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyiceLW, size(lut_asyiceLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) #endif ! ####################################################################################### @@ -358,20 +234,10 @@ subroutine rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, ! Initialize RRTMGP DDT's... ! ! ####################################################################################### - if (doGP_cldoptics_LUT) then - call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_limsCLDLW, & - radliq_lwrLW, radliq_uprLW, radliq_facLW, radice_lwrLW, radice_uprLW, & - radice_facLW, lut_extliqLW, lut_ssaliqLW, lut_asyliqLW, lut_exticeLW, & - lut_ssaiceLW, lut_asyiceLW)) - endif - - if (doGP_cldoptics_PADE) then - call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_limsCLDLW, & - pade_extliqLW, pade_ssaliqLW, pade_asyliqLW, pade_exticeLW, pade_ssaiceLW, & - pade_asyiceLW, pade_sizereg_extliqLW, pade_sizereg_ssaliqLW, & - pade_sizereg_asyliqLW, pade_sizereg_exticeLW, pade_sizereg_ssaiceLW, & - pade_sizereg_asyiceLW)) - endif + call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_limsCLDLW, & + radliq_lwrLW, radliq_uprLW, radice_lwrLW, radice_uprLW, & + lut_extliqLW, lut_ssaliqLW, lut_asyliqLW, & + lut_exticeLW, lut_ssaiceLW, lut_asyiceLW)) call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 index 8cd38f210..f9de18830 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_gas_optics.F90 @@ -1,22 +1,17 @@ !> \file rrtmgp_lw_gas_optics.F90 !! -!> \defgroup rrtmgp_lw_gas_optics rrtmgp_lw_gas_optics.F90 -!! -!! \brief This module contains two routines: One to initialize the k-distribution data + +!> This module contains two routines: One to initialize the k-distribution data !! and functions needed to compute the longwave gaseous optical properties in RRTMGP. !! The second routine is a ccpp scheme within the "radiation loop", where the longwave !! optical prperties (optical-depth) are computed for clear-sky conditions (no aerosols). -!! module rrtmgp_lw_gas_optics - use machine, only: kind_phys - use mo_rte_kind, only: wl + use mo_rte_kind, only: wl,wp use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg use netcdf -#ifdef MPI - use mpi -#endif + use mpi_f08 implicit none @@ -27,76 +22,75 @@ module rrtmgp_lw_gas_optics nminor_absorber_intervals_lowerLW, nminor_absorber_intervals_upperLW, & ncontributors_lowerLW, ncontributors_upperLW, nfit_coeffsLW integer, dimension(:), allocatable :: & - kminor_start_lowerLW, & ! Starting index in the [1, nContributors] vector for a contributor - ! given by \"minor_gases_lower\" (lower atmosphere) - kminor_start_upperLW ! Starting index in the [1, nContributors] vector for a contributor - ! given by \"minor_gases_upper\" (upper atmosphere) + kminor_start_lowerLW, & !< Starting index in the [1, nContributors] vector for a contributor + !< given by \"minor_gases_lower\" (lower atmosphere) + kminor_start_upperLW !< Starting index in the [1, nContributors] vector for a contributor + !< given by \"minor_gases_upper\" (upper atmosphere) integer, dimension(:,:), allocatable :: & - band2gptLW, & ! Beginning and ending gpoint for each band - minor_limits_gpt_lowerLW, & ! Beginning and ending gpoint for each minor interval in lower atmosphere - minor_limits_gpt_upperLW ! Beginning and ending gpoint for each minor interval in upper atmosphere + band2gptLW, & !< Beginning and ending gpoint for each band + minor_limits_gpt_lowerLW, & !< Beginning and ending gpoint for each minor interval in lower atmosphere + minor_limits_gpt_upperLW !< Beginning and ending gpoint for each minor interval in upper atmosphere integer, dimension(:,:,:), allocatable :: & - key_speciesLW ! Key species pair for each band - real(kind_phys) :: & - press_ref_tropLW, & ! Reference pressure separating the lower and upper atmosphere [Pa] - temp_ref_pLW, & ! Standard spectroscopic reference pressure [Pa] - temp_ref_tLW ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:), allocatable :: & - press_refLW, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] - temp_refLW ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] - real(kind_phys), dimension(:,:), allocatable :: & - band_limsLW, & ! Beginning and ending wavenumber [cm -1] for each band - totplnkLW, & ! Integrated Planck function by band + key_speciesLW !< Key species pair for each band + real(wp) :: & + press_ref_tropLW, & !< Reference pressure separating the lower and upper atmosphere [Pa] + temp_ref_pLW, & !< Standard spectroscopic reference pressure [Pa] + temp_ref_tLW !< Standard spectroscopic reference temperature [K] + real(wp), dimension(:), allocatable :: & + press_refLW, & !< Pressures for reference atmosphere; press_ref(# reference layers) [Pa] + temp_refLW !< Temperatures for reference atmosphere; temp_ref(# reference layers) [K] + real(wp), dimension(:,:), allocatable :: & + band_limsLW, & !< Beginning and ending wavenumber [cm -1] for each band + totplnkLW, & !< Integrated Planck function by band optimal_angle_fitLW - real(kind_phys), dimension(:,:,:), allocatable :: & - vmr_refLW, & ! volume mixing ratios for reference atmospherer - kminor_lowerLW, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to - ! [nTemp x nEta x nContributors] array) - kminor_upperLW, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to - ! [nTemp x nEta x nContributors] array) - rayl_lowerLW, & ! Not used in LW, rather allocated(rayl_lower) is used - rayl_upperLW ! Not used in LW, rather allocated(rayl_upper) is used - real(kind_phys), dimension(:,:,:,:), allocatable :: & - kmajorLW, & ! Stored absorption coefficients due to major absorbing gases - planck_fracLW ! Planck fractions + real(wp), dimension(:,:,:), allocatable :: & + vmr_refLW, & !< volume mixing ratios for reference atmospherer + kminor_lowerLW, & !< (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + !< [nTemp x nEta x nContributors] array) + kminor_upperLW, & !< (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + !< [nTemp x nEta x nContributors] array) + rayl_lowerLW, & !< Not used in LW, rather allocated(rayl_lower) is used + rayl_upperLW !< Not used in LW, rather allocated(rayl_upper) is used + real(wp), dimension(:,:,:,:), allocatable :: & + kmajorLW, & !< Stored absorption coefficients due to major absorbing gases + planck_fracLW !< Planck fractions character(len=32), dimension(:), allocatable :: & - gas_namesLW, & ! Names of absorbing gases - gas_minorLW, & ! Name of absorbing minor gas - identifier_minorLW, & ! Unique string identifying minor gas - minor_gases_lowerLW, & ! Names of minor absorbing gases in lower atmosphere - minor_gases_upperLW, & ! Names of minor absorbing gases in upper atmosphere - scaling_gas_lowerLW, & ! Absorption also depends on the concentration of this gas - scaling_gas_upperLW ! Absorption also depends on the concentration of this gas + gas_namesLW, & !< Names of absorbing gases + gas_minorLW, & !< Name of absorbing minor gas + identifier_minorLW, & !< Unique string identifying minor gas + minor_gases_lowerLW, & !< Names of minor absorbing gases in lower atmosphere + minor_gases_upperLW, & !< Names of minor absorbing gases in upper atmosphere + scaling_gas_lowerLW, & !< Absorption also depends on the concentration of this gas + scaling_gas_upperLW !< Absorption also depends on the concentration of this gas logical(wl), dimension(:), allocatable :: & - minor_scales_with_density_lowerLW, & ! Density scaling is applied to minor absorption coefficients - minor_scales_with_density_upperLW, & ! Density scaling is applied to minor absorption coefficients - scale_by_complement_lowerLW, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) - scale_by_complement_upperLW ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + minor_scales_with_density_lowerLW, & !< Density scaling is applied to minor absorption coefficients + minor_scales_with_density_upperLW, & !< Density scaling is applied to minor absorption coefficients + scale_by_complement_lowerLW, & !< Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + scale_by_complement_upperLW !< Absorption is scaled by concentration of scaling_gas (F) or its complement (T) contains - ! ######################################################################################### - ! SUBROUTINE rrtmgp_lw_gas_optics_init - ! ######################################################################################### +!> subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, & active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & - rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_lw_file_gas ! RRTMGP file containing K-distribution data + rrtmgp_root_dir, & !< RTE-RRTMGP root directory + rrtmgp_lw_file_gas !< RRTMGP file containing K-distribution data character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array + active_gases_array !< List of active gases from namelist as array + type(MPI_Comm),intent(in) :: & + mpicomm !< MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator - mpirank, & ! Current MPI rank - mpiroot ! Master MPI rank + mpirank, & !< Current MPI rank + mpiroot !< Master MPI rank ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg !< CCPP error message integer, intent(out) :: & - errflg ! CCPP error code + errflg !< CCPP error code ! Local variables integer :: ncid, dimID, varID, status, ii, mpierr, iChar @@ -117,9 +111,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP longwave k-distribution metadata ... ' ! Open file @@ -158,7 +150,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_upperLW) status = nf90_inq_dimid(ncid, 'temperature_Planck', dimid) status = nf90_inquire_dimension(ncid, dimid, len = ninternalSourcetempsLW) -#ifdef MPI endif ! On master processor ! Other processors waiting... @@ -186,7 +177,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, call mpi_bcast(ncontributors_lowerLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(ncontributors_upperLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nfit_coeffsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! Allocate space for arrays if (.not. allocated(gas_namesLW)) & @@ -258,9 +248,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' status = nf90_inq_varid(ncid, 'gas_names', varID) status = nf90_get_var( ncid, varID, gas_namesLW) @@ -338,7 +326,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, if (temp4(ii) .eq. 0) scale_by_complement_upperLW(ii) = .false. if (temp4(ii) .eq. 1) scale_by_complement_upperLW(ii) = .true. enddo -#ifdef MPI endif ! Master process ! Other processors waiting... @@ -352,9 +339,15 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, ! ####################################################################################### ! Real scalars +#ifdef RTE_USE_SP + call mpi_bcast(press_ref_tropLW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_ref_pLW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_ref_tLW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) +#else call mpi_bcast(press_ref_tropLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(temp_ref_pLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(temp_ref_tLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) +#endif ! Integer arrays call mpi_bcast(kminor_start_lowerLW, & @@ -371,6 +364,28 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, size(key_speciesLW), MPI_INTEGER, mpiroot, mpicomm, mpierr) ! Real arrays +#ifdef RTE_USE_SP + call mpi_bcast(press_refLW, & + size(press_refLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_refLW, & + size(temp_refLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(band_limsLW, & + size(band_limsLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(totplnkLW, & + size(totplnkLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(optimal_angle_fitLW, & + size(optimal_angle_fitLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(vmr_refLW, & + size(vmr_refLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(kminor_lowerLW, & + size(kminor_lowerLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(kminor_upperLW, & + size(kminor_upperLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(kmajorLW, & + size(kmajorLW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(planck_fracLW, & + size(planck_fracLW), MPI_REAL, mpiroot, mpicomm, mpierr) +#else call mpi_bcast(press_refLW, & size(press_refLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(temp_refLW, & @@ -391,7 +406,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, size(kmajorLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(planck_fracLW, & size(planck_fracLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - +#endif ! Characters do iChar=1,nabsorbersLW @@ -428,7 +443,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, size(scale_by_complement_upperLW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) call mpi_barrier(mpicomm, mpierr) -#endif ! ####################################################################################### ! diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 index 01b25c925..7f86c6ca3 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.F90 @@ -1,15 +1,11 @@ -! ########################################################################################### !> \file rrtmgp_lw_main.F90 -!! -!> \defgroup rrtmgp_lw_main rrtmgp_lw_main.F90 -!! -!! \brief This module contains the longwave RRTMGP radiation scheme. -!! -! ########################################################################################### +!! This file contains the longwave RRTMGP radiation scheme. + +!> This module contains the RRTMGP-LW radiation scheme module rrtmgp_lw_main + use mpi_f08 use machine, only: kind_phys, kind_dbl_prec use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str - use mo_cloud_optics, only: ty_cloud_optics use mo_rte_lw, only: rte_lw use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs @@ -24,54 +20,43 @@ module rrtmgp_lw_main eps, oneminus, ftiny use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_sampling, only: sampled_mask, draw_samples + use mo_rte_kind, only: rte_wp => wp implicit none public rrtmgp_lw_main_init, rrtmgp_lw_main_run contains - ! ######################################################################################### -!! \section arg_table_rrtmgp_lw_main_init + +!> \section arg_table_rrtmgp_lw_main_init Argument Table !! \htmlinclude rrtmgp_lw_main_int.html !! -!> \ingroup rrtmgp_lw_main -!! -!! \brief -!! -!! \section rrtmgp_lw_main_init -!> @{ - ! ######################################################################################### subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_file_clouds,& - active_gases_array, doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_sgs_pbl, & - doGP_sgs_cnv, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, & + active_gases_array, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, & errmsg, errflg) ! Inputs character(len=128),intent(in) :: & - rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_lw_file_clouds, & ! RRTMGP file containing coefficients used to compute - ! clouds optical properties - rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute - ! gaseous optical properties - character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array) - logical, intent(in) :: & - doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs? - doGP_sgs_pbl, & ! Flag to include sgs PBL clouds - doGP_sgs_cnv ! Flag to include sgs convective clouds + rrtmgp_root_dir, & !< RTE-RRTMGP root directory + rrtmgp_lw_file_clouds, & !< RRTMGP file containing coefficients used to compute + !< clouds optical properties + rrtmgp_lw_file_gas !< RRTMGP file containing coefficients used to compute + !< gaseous optical properties + character(len=*), dimension(:), intent(in), optional :: & + active_gases_array !< List of active gases from namelist as array) integer, intent(inout) :: & - nrghice ! Number of ice-roughness categories + nrghice !< Number of ice-roughness categories + type(MPI_Comm),intent(in) :: & + mpicomm !< MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator - mpirank, & ! Current MPI rank - mpiroot, & ! Master MPI rank - rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. + mpirank, & !< Current MPI rank + mpiroot, & !< Master MPI rank + rrtmgp_phys_blksz, & !< Number of horizontal points to process at once. nLay ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg !< CCPP error message integer, intent(out) :: & - errflg ! CCPP error code + errflg !< CCPP error code ! Initialize CCPP error handling variables errmsg = '' @@ -83,24 +68,15 @@ subroutine rrtmgp_lw_main_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_lw_fi ! RRTMGP longwave cloud-optics initialization call rrtmgp_lw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_clouds, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot, & - errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, errmsg, errflg) end subroutine rrtmgp_lw_main_init -!> @} - ! ###################################################################################### -!! \section arg_table_rrtmgp_lw_main_run + +!> \section arg_table_rrtmgp_lw_main_run Argument Table !! \htmlinclude rrtmgp_lw_main_run.html !! -!> \ingroup rrtmgp_lw_main -!! -!! \brief -!! -!! \section rrtmgp_lw_main_run -!> @{ - ! ###################################################################################### subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, & - use_LW_jacobian, doGP_sgs_cnv, doGP_sgs_pbl, nCol, nLay, nGases,rrtmgp_phys_blksz,& + nCol, nLay, nGases,rrtmgp_phys_blksz, & nGauss_angles, icseed_lw, iovr, iovr_convcld, iovr_max, iovr_maxrand, iovr_rand, & iovr_dcorr, iovr_exp, iovr_exprand, isubc_lw, semis, tsfg, p_lay, p_lev, t_lay, & t_lev, vmr_o2, vmr_h2o, vmr_o3, vmr_ch4, vmr_n2o, vmr_co2, & @@ -109,16 +85,13 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, cld_cnv_reice, cld_pbl_lwp, cld_pbl_reliq, cld_pbl_iwp, cld_pbl_reice, & cloud_overlap_param, active_gases_array, aerlw_tau, aerlw_ssa, aerlw_g, & fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, & - fluxlwUP_jac, fluxlwUP_radtime, fluxlwDOWN_radtime, errmsg, errflg) + fluxlwUP_radtime, fluxlwDOWN_radtime, fluxlwUP_jac, errmsg, errflg) ! Inputs logical, intent(in) :: & doLWrad, & ! Flag to perform longwave calculation doLWclrsky, & ! Flag to compute clear-sky fluxes top_at_1, & ! Flag for vertical ordering convention - use_LW_jacobian, & ! Flag to compute Jacobian of longwave surface flux - doGP_sgs_pbl, & ! Flag to include sgs PBL clouds - doGP_sgs_cnv, & ! Flag to include sgs convective clouds doGP_lwscat ! Flag to include scattering in clouds integer,intent(in) :: & nCol, & ! Number of horizontal points @@ -150,7 +123,8 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, vmr_o3, & ! Molar-mixing ratio ozone vmr_ch4, & ! Molar-mixing ratio methane vmr_n2o, & ! Molar-mixing ratio nitrous oxide - vmr_co2, & ! Molar-mixing ratio carbon dioxide + vmr_co2 ! Molar-mixing ratio carbon dioxide + real(kind_phys), dimension(:,:), intent(in) :: & cld_frac, & ! Cloud-fraction for stratiform clouds cld_lwp, & ! Water path for stratiform liquid cloud-particles cld_reliq, & ! Effective radius for stratiform liquid cloud-particles @@ -161,6 +135,8 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, cld_rwp, & ! Water path for rain hydrometeors cld_rerain, & ! Effective radius for rain hydrometeors precip_frac, & ! Precipitation fraction (not active, currently precipitation optics uses cloud-fraction) + cloud_overlap_param ! Cloud overlap parameter + real(kind_phys), dimension(:,:), intent(in), optional :: & cld_cnv_lwp, & ! Water path for convective liquid cloud-particles cld_cnv_reliq, & ! Effective radius for convective liquid cloud-particles cld_cnv_iwp, & ! Water path for convective ice cloud-particles @@ -168,18 +144,18 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, cld_pbl_lwp, & ! Water path for PBL liquid cloud-particles cld_pbl_reliq, & ! Effective radius for PBL liquid cloud-particles cld_pbl_iwp, & ! Water path for PBL ice cloud-particles - cld_pbl_reice, & ! Effective radius for PBL ice cloud-particles - cloud_overlap_param ! Cloud overlap parameter + cld_pbl_reice ! Effective radius for PBL ice cloud-particles real(kind_phys), dimension(:,:,:), intent(in) :: & - aerlw_tau, & ! Aerosol optical depth - aerlw_ssa, & ! Aerosol single scattering albedo - aerlw_g ! Aerosol asymmetry paramter + aerlw_tau, & ! Aerosol optical depth + aerlw_ssa, & ! Aerosol single scattering albedo + aerlw_g ! Aerosol asymmetry paramter character(len=*), dimension(:), intent(in) :: & active_gases_array ! List of active gases from namelist as array ! Outputs + real(kind_phys), dimension(:,:), intent(inout), optional :: & + fluxlwUP_jac ! Jacobian of upwelling LW surface radiation (W/m2/K) real(kind_phys), dimension(:,:), intent(inout) :: & - fluxlwUP_jac, & ! Jacobian of upwelling LW surface radiation (W/m2/K) fluxlwUP_allsky, & ! All-sky flux (W/m2) fluxlwDOWN_allsky, & ! All-sky flux (W/m2) fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) @@ -200,13 +176,14 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, logical, dimension(rrtmgp_phys_blksz,nLay,lw_gas_props%get_ngpt()) :: maskMCICA real(kind_phys), dimension(rrtmgp_phys_blksz) :: tau_rain, tau_snow real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt()) :: rng1D - real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 + real(rte_wp), dimension(lw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt()*nLay) :: rng2D - real(kind_phys), dimension(rrtmgp_phys_blksz,nLay+1,lw_gas_props%get_nband()),target :: & + real(rte_wp), dimension(rrtmgp_phys_blksz,nLay+1,lw_gas_props%get_nband()),target :: & fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky - real(kind_phys), dimension(rrtmgp_phys_blksz,lw_gas_props%get_ngpt()) :: lw_Ds - real(kind_phys), dimension(lw_gas_props%get_nband(),rrtmgp_phys_blksz) :: sfc_emiss_byband - + real(rte_wp), dimension(rrtmgp_phys_blksz,lw_gas_props%get_ngpt()) :: lw_Ds + real(rte_wp), dimension(lw_gas_props%get_nband(),rrtmgp_phys_blksz) :: sfc_emiss_byband + real(rte_wp), dimension(rrtmgp_phys_blksz,nLay+1) :: fluxLW_up_jac + logical :: doGP_sgs_cnv, doGP_sgs_pbl ! Local RRTMGP DDTs. type(ty_gas_concs) :: gas_concs type(ty_optical_props_1scl) :: lw_optical_props_clrsky, lw_optical_props_aerosol_local @@ -221,6 +198,20 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, if (.not. doLWrad) return + ! Do we have convective cloud properties? + doGP_sgs_cnv = .false. + if (present(cld_cnv_lwp) .and. present(cld_cnv_reliq) .and. & + present(cld_cnv_iwp) .and. present(cld_cnv_reice)) then + doGP_sgs_cnv = .true. + endif + + ! Do we have pbl cloud prperties? + doGP_sgs_pbl = .false. + if (present(cld_pbl_lwp) .and. present(cld_pbl_reliq) .and. & + present(cld_pbl_iwp) .and. present(cld_pbl_reice)) then + doGP_sgs_pbl = .true. + endif + ! ! Initialize RRTMGP DDTs (local) ! @@ -273,21 +264,19 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, lw_optical_props_clouds%g = 0._kind_phys sources%sfc_source = 0._kind_phys sources%lay_source = 0._kind_phys - sources%lev_source_inc = 0._kind_phys - sources%lev_source_dec = 0._kind_phys sources%sfc_source_Jac = 0._kind_phys - fluxLW_up_allsky = 0._kind_phys - fluxLW_dn_allsky = 0._kind_phys - fluxLW_up_clrsky = 0._kind_phys - fluxLW_dn_clrsky = 0._kind_phys + fluxLW_up_allsky = 0._rte_wp + fluxLW_dn_allsky = 0._rte_wp + fluxLW_up_clrsky = 0._rte_wp + fluxLW_dn_clrsky = 0._rte_wp if (doGP_sgs_cnv) lw_optical_props_cnvcloudsByBand%tau = 0._kind_phys if (doGP_sgs_pbl) lw_optical_props_pblcloudsByBand%tau = 0._kind_phys ! ty_fluxes_byband - fluxLW_up_allsky = 0._kind_phys - fluxLW_dn_allsky = 0._kind_phys - fluxLW_up_clrsky = 0._kind_phys - fluxLW_dn_clrsky = 0._kind_phys + fluxLW_up_allsky = 0._rte_wp + fluxLW_dn_allsky = 0._rte_wp + fluxLW_up_clrsky = 0._rte_wp + fluxLW_dn_clrsky = 0._rte_wp flux_allsky%bnd_flux_up => fluxLW_up_allsky flux_allsky%bnd_flux_dn => fluxLW_dn_allsky flux_clrsky%bnd_flux_up => fluxLW_up_clrsky @@ -299,17 +288,17 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! ! ################################################################################### call check_error_msg('rrtmgp_lw_main_set_vmr_o2', & - gas_concs%set_vmr(trim(active_gases_array(istr_o2)), vmr_o2(iCol:iCol2,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_o2)), real(vmr_o2(iCol:iCol2,:),kind=rte_wp))) call check_error_msg('rrtmgp_lw_main_set_vmr_co2', & - gas_concs%set_vmr(trim(active_gases_array(istr_co2)),vmr_co2(iCol:iCol2,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_co2)),real(vmr_co2(iCol:iCol2,:),kind=rte_wp))) call check_error_msg('rrtmgp_lw_main_set_vmr_ch4', & - gas_concs%set_vmr(trim(active_gases_array(istr_ch4)),vmr_ch4(iCol:iCol2,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_ch4)),real(vmr_ch4(iCol:iCol2,:),kind=rte_wp))) call check_error_msg('rrtmgp_lw_main_set_vmr_n2o', & - gas_concs%set_vmr(trim(active_gases_array(istr_n2o)),vmr_n2o(iCol:iCol2,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_n2o)),real(vmr_n2o(iCol:iCol2,:),kind=rte_wp))) call check_error_msg('rrtmgp_lw_main_set_vmr_h2o', & - gas_concs%set_vmr(trim(active_gases_array(istr_h2o)),vmr_h2o(iCol:iCol2,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_h2o)),real(vmr_h2o(iCol:iCol2,:),kind=rte_wp))) call check_error_msg('rrtmgp_lw_main_set_vmr_o3', & - gas_concs%set_vmr(trim(active_gases_array(istr_o3)), vmr_o3(iCol:iCol2,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_o3)), real(vmr_o3(iCol:iCol2,:),kind=rte_wp))) ! ################################################################################### ! @@ -333,14 +322,14 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! ! ################################################################################### call check_error_msg('rrtmgp_lw_main_gas_optics',lw_gas_props%gas_optics(& - p_lay(iCol:iCol2,:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(iCol:iCol2,:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(iCol:iCol2,:), & ! IN - Temperature @ layer-centers (K) - tsfg(iCol:iCol2), & ! IN - Skin-temperature (K) + real(p_lay(iCol:iCol2,:),kind=rte_wp), & ! IN - Pressure @ layer-centers (Pa) + real(p_lev(iCol:iCol2,:),kind=rte_wp), & ! IN - Pressure @ layer-interfaces (Pa) + real(t_lay(iCol:iCol2,:),kind=rte_wp), & ! IN - Temperature @ layer-centers (K) + real(tsfg(iCol:iCol2),kind=rte_wp), & ! IN - Skin-temperature (K) gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios lw_optical_props_clrsky, & ! OUT - RRTMGP DDT: longwave optical properties sources, & ! OUT - RRTMGP DDT: source functions - tlev=t_lev(iCol:iCol2,:))) ! IN - Temperature @ layer-interfaces (K) (optional) + tlev=real(t_lev(iCol:iCol2,:),kind=rte_wp))) ! IN - Temperature @ layer-interfaces (K) (optional) ! ################################################################################### ! @@ -362,20 +351,20 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, if (any(zcf1 .gt. eps)) then ! Microphysical (gridmean) cloud optics call check_error_msg('rrtmgp_lw_main_cloud_optics',lw_cloud_props%cloud_optics(& - cld_lwp(iCol:iCol2,:), & ! IN - Cloud liquid water path (g/m2) - cld_iwp(iCol:iCol2,:), & ! IN - Cloud ice water path (g/m2) - cld_reliq(iCol:iCol2,:), & ! IN - Cloud liquid effective radius (microns) - cld_reice(iCol:iCol2,:), & ! IN - Cloud ice effective radius (microns) + real(cld_lwp(iCol:iCol2,:),kind=rte_wp), & ! IN - Cloud liquid water path (g/m2) + real(cld_iwp(iCol:iCol2,:),kind=rte_wp), & ! IN - Cloud ice water path (g/m2) + real(cld_reliq(iCol:iCol2,:),kind=rte_wp), & ! IN - Cloud liquid effective radius (microns) + real(cld_reice(iCol:iCol2,:),kind=rte_wp), & ! IN - Cloud ice effective radius (microns) lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties ! in each band ! Include convective (subgrid scale) clouds? if (doGP_sgs_cnv) then ! Compute call check_error_msg('rrtmgp_lw_main_cnv_cloud_optics',lw_cloud_props%cloud_optics(& - cld_cnv_lwp(iCol:iCol2,:), & ! IN - Convective cloud liquid water path (g/m2) - cld_cnv_iwp(iCol:iCol2,:), & ! IN - Convective cloud ice water path (g/m2) - cld_cnv_reliq(iCol:iCol2,:), & ! IN - Convective cloud liquid effective radius (microns) - cld_cnv_reice(iCol:iCol2,:), & ! IN - Convective cloud ice effective radius (microns) + real(cld_cnv_lwp(iCol:iCol2,:),kind=rte_wp), & ! IN - Convective cloud liquid water path (g/m2) + real(cld_cnv_iwp(iCol:iCol2,:),kind=rte_wp), & ! IN - Convective cloud ice water path (g/m2) + real(cld_cnv_reliq(iCol:iCol2,:),kind=rte_wp), & ! IN - Convective cloud liquid effective radius (microns) + real(cld_cnv_reice(iCol:iCol2,:),kind=rte_wp), & ! IN - Convective cloud ice effective radius (microns) lw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties ! in each band ! Increment @@ -387,10 +376,10 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, if (doGP_sgs_pbl) then ! Compute call check_error_msg('rrtmgp_lw_main_pbl_cloud_optics',lw_cloud_props%cloud_optics(& - cld_pbl_lwp(iCol:iCol2,:), & ! IN - PBL cloud liquid water path (g/m2) - cld_pbl_iwp(iCol:iCol2,:), & ! IN - PBL cloud ice water path (g/m2) - cld_pbl_reliq(iCol:iCol2,:), & ! IN - PBL cloud liquid effective radius (microns) - cld_pbl_reice(iCol:iCol2,:), & ! IN - PBL cloud ice effective radius (microns) + real(cld_pbl_lwp(iCol:iCol2,:),kind=rte_wp), & ! IN - PBL cloud liquid water path (g/m2) + real(cld_pbl_iwp(iCol:iCol2,:),kind=rte_wp), & ! IN - PBL cloud ice water path (g/m2) + real(cld_pbl_reliq(iCol:iCol2,:),kind=rte_wp), & ! IN - PBL cloud liquid effective radius (microns) + real(cld_pbl_reice(iCol:iCol2,:),kind=rte_wp), & ! IN - PBL cloud ice effective radius (microns) lw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing PBL cloud radiative properties ! in each band ! Increment @@ -440,7 +429,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, do ix=1,rrtmgp_phys_blksz ipseed_lw(ix) = lw_gas_props%get_ngpt() + iCol + ix - 1 enddo - elseif (isubc_lw == 2) then ! use input array of permutaion seeds + elseif (isubc_lw == 2) then ! use input array of permutation seeds do ix=1,rrtmgp_phys_blksz ipseed_lw(ix) = icseed_lw(iCol+ix-1) enddo @@ -466,7 +455,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Cloud-overlap. ! Maximum-random, random or maximum. if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then - call sampled_mask(real(rng3D,kind=kind_phys), cld_frac(iCol:iCol2,:), maskMCICA) + call sampled_mask(rng3D, real(cld_frac(iCol:iCol2,:),kind=rte_wp), maskMCICA) endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then @@ -477,13 +466,14 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, rng3D2(:,:,ix) = reshape(source = rng2D,shape=[lw_gas_props%get_ngpt(),nLay]) enddo ! - call sampled_mask(real(rng3D,kind=kind_phys), cld_frac(iCol:iCol2,:), maskMCICA, & - overlap_param = cloud_overlap_param(iCol:iCol2,1:nLay-1), randoms2 = real(rng3D2, kind=kind_phys)) + call sampled_mask(rng3D, real(cld_frac(iCol:iCol2,:),kind=rte_wp), & + maskMCICA, overlap_param = real(cloud_overlap_param(iCol:iCol2,1:nLay-1),kind=rte_wp), & + randoms2 = rng3D2) endif ! Exponential or Exponential-random if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(real(rng3D,kind=kind_phys), cld_frac(iCol:iCol2,:), maskMCICA, & - overlap_param = cloud_overlap_param(iCol:iCol2,1:nLay-1)) + call sampled_mask(rng3D, real(cld_frac(iCol:iCol2,:),kind=rte_wp), & + maskMCICA, overlap_param = real(cloud_overlap_param(iCol:iCol2,1:nLay-1),kind=rte_wp)) endif ! Sampling. Map band optical depth to each g-point using McICA call check_error_msg('rrtmgp_lw_main_cloud_sampling',& @@ -552,7 +542,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, call check_error_msg('rrtmgp_lw_main_increment_clrsky_to_clouds',& lw_optical_props_clrsky%increment(lw_optical_props_clouds)) - if (use_LW_jacobian) then + if (present(fluxlwUP_jac)) then ! Compute LW Jacobians call check_error_msg('rrtmgp_lw_main_lw_rte_allsky',rte_lw( & lw_optical_props_clouds, & ! IN - optical-properties @@ -561,7 +551,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, sfc_emiss_byband, & ! IN - surface emissivity in each LW band flux_allsky, & ! OUT - Flxues n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - flux_up_Jac = fluxlwUP_jac)) ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) + flux_up_Jac = fluxLW_up_jac)) ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) else call check_error_msg('rrtmgp_lw_main_lw_rte_allsky',rte_lw( & lw_optical_props_clouds, & ! IN - optical-properties @@ -577,7 +567,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, call check_error_msg('rrtmgp_lw_main_increment_clouds_to_clrsky', & lw_optical_props_clouds%increment(lw_optical_props_clrsky)) - if (use_LW_jacobian) then + if (present(fluxlwUP_jac)) then ! Compute LW Jacobians call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & lw_optical_props_clrsky, & ! IN - optical-properties @@ -586,7 +576,7 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, sfc_emiss_byband, & ! IN - surface emissivity in each LW band flux_allsky, & ! OUT - Flxues n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - flux_up_Jac = fluxlwUP_jac)) ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) + flux_up_Jac = fluxLW_up_jac)) ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) else call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & lw_optical_props_clrsky, & ! IN - optical-properties @@ -601,13 +591,15 @@ subroutine rrtmgp_lw_main_run(doLWrad, doLWclrsky, top_at_1, doGP_lwscat, ! Store fluxes fluxlwUP_allsky(iCol:iCol2,:) = sum(flux_allsky%bnd_flux_up, dim=3) fluxlwDOWN_allsky(iCol:iCol2,:) = sum(flux_allsky%bnd_flux_dn, dim=3) - + ! Save fluxes for coupling + if (present(fluxlwUP_jac)) then + fluxlwUP_jac(iCol:iCol2,:) = fluxLW_up_jac + endif fluxlwUP_radtime(iCol:iCol2,:) = fluxlwUP_allsky(iCol:iCol2,:) fluxlwDOWN_radtime(iCol:iCol2,:) = fluxlwDOWN_allsky(iCol:iCol2,:) enddo end subroutine rrtmgp_lw_main_run -!> @} end module rrtmgp_lw_main diff --git a/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta index 572e67d94..9c7807c59 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_lw_main.meta @@ -2,12 +2,13 @@ name = rrtmgp_lw_main type = scheme dependencies = ../../hooks/machine.F,../radiation_tools.F90,../mersenne_twister.f - dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 - dependencies = rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90 - dependencies = rte-rrtmgp/rte/mo_source_functions.F90,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90 - dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 + dependencies = rte-rrtmgp/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 + dependencies = rte-rrtmgp/rte-frontend/mo_rte_kind.F90,rte-rrtmgp/gas-optics/mo_gas_concentrations.F90,rte-rrtmgp/rte-frontend/mo_optical_props.F90 + dependencies = rte-rrtmgp/rte-frontend/mo_source_functions.F90,rte-rrtmgp/rte-frontend/mo_rte_lw.F90,rte-rrtmgp/rte-frontend/mo_fluxes.F90 + dependencies = rte-rrtmgp/rte-kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/rte-kernels/mo_rte_solver_kernels.F90 dependencies = rrtmgp_lw_gas_optics.F90, rrtmgp_lw_cloud_optics.F90,rrtmgp_sampling.F90 dependencies = ../../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 + dependencies = rte-rrtmgp/rte-frontend/mo_rte_kind.F90 ######################################################################## [ccpp-arg-table] @@ -37,34 +38,6 @@ type = character intent = in kind = len=128 -[doGP_cldoptics_PADE] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[doGP_cldoptics_LUT] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[doGP_sgs_cnv] - standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP - long_name = logical flag to control sgs convective cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in -[doGP_sgs_pbl] - standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP - long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in [nrghice] standard_name = number_of_ice_roughness_categories long_name = number of ice-roughness categories in RRTMGP calculation @@ -91,7 +64,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [rrtmgp_phys_blksz] standard_name = number_of_columns_per_RRTMGP_LW_block @@ -156,13 +129,6 @@ dimensions = () type = logical intent = in -[use_LW_jacobian] - standard_name = flag_to_calc_RRTMGP_LW_jacobian - long_name = logical flag to control RRTMGP LW calculation - units = flag - dimensions = () - type = logical - intent = in [doGP_lwscat] standard_name = flag_to_include_longwave_scattering_in_cloud_optics long_name = logical flag to control the addition of LW scattering in RRTMGP @@ -170,20 +136,6 @@ dimensions = () type = logical intent = in -[doGP_sgs_cnv] - standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP - long_name = logical flag to control sgs convective cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in -[doGP_sgs_pbl] - standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP - long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -473,6 +425,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_iwp] standard_name = convective_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -481,6 +434,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_reliq] standard_name = mean_effective_radius_for_liquid_convective_cloud long_name = mean effective radius for liquid convective cloud @@ -489,6 +443,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_reice] standard_name = mean_effective_radius_for_ice_convective_cloud long_name = mean effective radius for ice convective cloud @@ -497,6 +452,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_lwp] standard_name = MYNN_SGS_cloud_liquid_water_path long_name = layer convective cloud liquid water path @@ -505,6 +461,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_iwp] standard_name = MYNN_SGS_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -513,6 +470,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_reliq] standard_name = mean_effective_radius_for_liquid_MYNN_SGS_cloud long_name = mean effective radius for liquid MYNN_SGS cloud @@ -521,6 +479,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_reice] standard_name = mean_effective_radius_for_ice_MYNN_SGS_cloud long_name = mean effective radius for ice MYNN_SGS cloud @@ -529,6 +488,7 @@ type = real kind = kind_phys intent = in + optional = True [cloud_overlap_param] standard_name = cloud_overlap_param long_name = cloud overlap parameter @@ -625,6 +585,7 @@ type = real kind = kind_phys intent = inout + optional = True [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Radiation/RRTMGP/rrtmgp_sampling.F90 b/physics/Radiation/RRTMGP/rrtmgp_sampling.F90 index 9e2360083..a678d3163 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sampling.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sampling.F90 @@ -1,4 +1,5 @@ -! This code is part of RRTM for GCM Applications - Parallel (RRTMGP) +!>\file rrtmgp_sampling.F90 +!! This code is part of RRTM for GCM Applications - Parallel (RRTMGP) ! ! Contacts: Robert Pincus and Eli Mlawer ! email: rrtmgp@aer.com @@ -10,8 +11,8 @@ ! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause ! ------------------------------------------------------------------------------------------------- ! -! This module provides a simple implementation of sampling for the -! Monte Carlo Independent Pixel Approximation (McICA, doi:10.1029/2002jd003322) +!> This module provides a simple implementation of sampling for the +!! Monte Carlo Independent Pixel Approximation (McICA, doi:10.1029/2002jd003322) ! Cloud optical properties, defined by band and assumed homogenous within each cell (column/layer), ! are randomly sampled to preserve the mean cloud fraction and one of several possible overlap assumptions ! Users supply random numbers with order ngpt,nlay,ncol @@ -30,12 +31,8 @@ module rrtmgp_sampling private public :: draw_samples, sampled_mask contains - ! ------------------------------------------------------------------------------------------------- - ! - ! Apply a T/F sampled cloud mask to cloud optical properties defined by band to produce - ! McICA-sampled cloud optical properties - ! - ! ------------------------------------------------------------------------------------------------- +!> Apply a T/F sampled cloud mask to cloud optical properties defined by band to produce +!! McICA-sampled cloud optical properties function draw_samples(cloud_mask,do_twostream,clouds,clouds_sampled) result(error_msg) ! Inputs logical, dimension(:,:,:), intent(in ) :: cloud_mask ! Dimensions ncol,nlay,ngpt @@ -76,11 +73,8 @@ function draw_samples(cloud_mask,do_twostream,clouds,clouds_sampled) result(erro end select end select end function draw_samples - ! ------------------------------------------------------------------------------------------------- - ! - ! Generate a McICA-sampled cloud mask - ! - ! ------------------------------------------------------------------------------------------------- + +!> Generate a McICA-sampled cloud mask subroutine sampled_mask(randoms, cloud_frac, cloud_mask, overlap_param, randoms2) ! Inputs real(wp), dimension(:,:,:), intent(in ) :: randoms ! ngpt,nlay,ncol @@ -180,12 +174,9 @@ subroutine sampled_mask(randoms, cloud_frac, cloud_mask, overlap_param, randoms2 end do ! END LOOP: Columns end subroutine sampled_mask - ! ------------------------------------------------------------------------------------------------- - ! - ! Apply a true/false cloud mask to a homogeneous field - ! This could be a kernel - ! - ! ------------------------------------------------------------------------------------------------- + +!> Apply a true/false cloud mask to a homogeneous field +!! This could be a kernel subroutine apply_cloud_mask(ncol,nlay,nbnd,ngpt,band_lims_gpt,cloud_mask,input_field,sampled_field) integer, intent(in ) :: ncol,nlay,nbnd,ngpt integer, dimension(2,nbnd), intent(in ) :: band_lims_gpt diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 index 4293a7be6..402631b88 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_cloud_optics.F90 @@ -1,13 +1,14 @@ +!>\file rrtmgp_sw_cloud_optics.F90 +!! + +!> This module contains the cloud optics properties calculation for RRTMGP-SW module rrtmgp_sw_cloud_optics - use machine, only: kind_phys - use mo_rte_kind, only: wl - use mo_cloud_optics, only: ty_cloud_optics + use mo_rte_kind, only: wl, wp + use mo_cloud_optics_rrtmgp, only: ty_cloud_optics => ty_cloud_optics_rrtmgp use rrtmgp_sw_gas_optics, only: sw_gas_props use radiation_tools, only: check_error_msg use netcdf -#ifdef MPI - use mpi -#endif + use mpi_f08 implicit none @@ -15,80 +16,54 @@ module rrtmgp_sw_cloud_optics integer :: & nrghice_fromfileSW, nBandSW, nSize_liqSW, nSize_iceSW, nSizeregSW, & nCoeff_extSW, nCoeff_ssa_gSW, nBoundSW, nPairsSW - real(kind_phys) :: & - radliq_facSW, & ! Factor for calculating LUT interpolation indices for liquid - radice_facSW ! Factor for calculating LUT interpolation indices for ice - real(kind_phys), dimension(:,:), allocatable :: & - lut_extliqSW, & ! LUT shortwave liquid extinction coefficient - lut_ssaliqSW, & ! LUT shortwave liquid single scattering albedo - lut_asyliqSW, & ! LUT shortwave liquid asymmetry parameter - band_limsCLDSW ! Beginning and ending wavenumber [cm -1] for each band - real(kind_phys), dimension(:,:,:), allocatable :: & - lut_exticeSW, & ! LUT shortwave ice extinction coefficient - lut_ssaiceSW, & ! LUT shortwave ice single scattering albedo - lut_asyiceSW ! LUT shortwave ice asymmetry parameter - real(kind_phys), dimension(:), allocatable :: & - pade_sizereg_extliqSW, & ! Particle size regime boundaries for shortwave liquid extinction - ! coefficient for Pade interpolation - pade_sizereg_ssaliqSW, & ! Particle size regime boundaries for shortwave liquid single - ! scattering albedo for Pade interpolation - pade_sizereg_asyliqSW, & ! Particle size regime boundaries for shortwave liquid asymmetry - ! parameter for Pade interpolation - pade_sizereg_exticeSW, & ! Particle size regime boundaries for shortwave ice extinction - ! coefficient for Pade interpolation - pade_sizereg_ssaiceSW, & ! Particle size regime boundaries for shortwave ice single - ! scattering albedo for Pade interpolation - pade_sizereg_asyiceSW ! Particle size regime boundaries for shortwave ice asymmetry - ! parameter for Pade interpolation - real(kind_phys), dimension(:,:,:), allocatable :: & - pade_extliqSW, & ! PADE coefficients for shortwave liquid extinction - pade_ssaliqSW, & ! PADE coefficients for shortwave liquid single scattering albedo - pade_asyliqSW ! PADE coefficients for shortwave liquid asymmetry parameter - real(kind_phys), dimension(:,:,:,:), allocatable :: & - pade_exticeSW, & ! PADE coefficients for shortwave ice extinction - pade_ssaiceSW, & ! PADE coefficients for shortwave ice single scattering albedo - pade_asyiceSW ! PADE coefficients for shortwave ice asymmetry parameter - real(kind_phys) :: & - radliq_lwrSW, & ! Liquid particle size lower bound for LUT interpolation - radliq_uprSW, & ! Liquid particle size upper bound for LUT interpolation - radice_lwrSW, & ! Ice particle size upper bound for LUT interpolation - radice_uprSW ! Ice particle size lower bound for LUT interpolation + real(wp), dimension(:,:), allocatable :: & + lut_extliqSW, & !< LUT shortwave liquid extinction coefficient + lut_ssaliqSW, & !< LUT shortwave liquid single scattering albedo + lut_asyliqSW, & !< LUT shortwave liquid asymmetry parameter + band_limsCLDSW !< Beginning and ending wavenumber [cm -1] for each band + real(wp), dimension(:,:,:), allocatable :: & + lut_exticeSW, & !< LUT shortwave ice extinction coefficient + lut_ssaiceSW, & !< LUT shortwave ice single scattering albedo + lut_asyiceSW !< LUT shortwave ice asymmetry parameter + real(wp) :: & + radliq_lwrSW, & !< Liquid particle size lower bound for LUT interpolation + radliq_uprSW, & !< Liquid particle size upper bound for LUT interpolation + radice_lwrSW, & !< Ice particle size upper bound for LUT interpolation + radice_uprSW !< Ice particle size lower bound for LUT interpolation ! Parameters used for rain and snow(+groupel) RRTMGP cloud-optics. *NOTE* Same as in RRTMG ! Need to document these magic numbers below. - real(kind_phys),parameter :: & + real(wp),parameter :: & a0r = 3.07e-3, & ! a0s = 0.0, & ! a1s = 1.5 ! - real(kind_phys),dimension(:),allocatable :: b0r,b0s,b1s,c0r,c0s + real(wp),dimension(:),allocatable :: b0r,b0s,b1s,c0r,c0s contains ! ###################################################################################### ! SUBROUTINE sw_cloud_optics_init ! ###################################################################################### +!> subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot, & - errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & - rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_sw_file_clouds ! RRTMGP file containing cloud-optic data - logical, intent(in) :: & - doGP_cldoptics_PADE,& ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? + rrtmgp_root_dir, & !< RTE-RRTMGP root directory + rrtmgp_sw_file_clouds !< RRTMGP file containing cloud-optic data integer, intent(inout) :: & - nrghice ! Number of ice-roughness categories + nrghice !< Number of ice-roughness categories + type(MPI_Comm), intent(in) :: & + mpicomm !< MPI communicator integer, intent(in) :: & - mpicomm, & ! MPI communicator - mpirank, & ! Current MPI rank - mpiroot ! Master MPI rank + mpirank, & !< Current MPI rank + mpiroot !< Master MPI rank ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg !< CCPP error message integer, intent(out) :: & - errflg ! CCPP error code + errflg !< CCPP error code ! Local variables integer :: status,ncid,dimid,varID,mpierr @@ -107,9 +82,7 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP shortwave cloud-optics metadata ... ' ! Open file @@ -134,7 +107,6 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, status = nf90_inquire_dimension(ncid, dimid, len=nBoundSW) status = nf90_inq_dimid(ncid, 'pair', dimid) status = nf90_inquire_dimension(ncid, dimid, len=nPairsSW) -#ifdef MPI endif ! On master processor ! Other processors waiting... @@ -154,14 +126,11 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, call mpi_bcast(nCoeff_ssa_gSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nBoundSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nPairsSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! Has the number of ice-roughnes categories been provided from the namelist? ! If so, override nrghice from cloud-optics file if (nrghice .ne. 0) nrghice_fromfileSW = nrghice -#ifdef MPI call mpi_bcast(nrghice_fromfileSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! ####################################################################################### ! @@ -169,28 +138,12 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, ! (ALL processors) ! ! ####################################################################################### - if (doGP_cldoptics_LUT) then - allocate(lut_extliqSW(nSize_liqSW, nBandSW)) - allocate(lut_ssaliqSW(nSize_liqSW, nBandSW)) - allocate(lut_asyliqSW(nSize_liqSW, nBandSW)) - allocate(lut_exticeSW(nSize_iceSW, nBandSW, nrghice_fromfileSW)) - allocate(lut_ssaiceSW(nSize_iceSW, nBandSW, nrghice_fromfileSW)) - allocate(lut_asyiceSW(nSize_iceSW, nBandSW, nrghice_fromfileSW)) - endif - if (doGP_cldoptics_PADE) then - allocate(pade_extliqSW(nBandSW, nSizeRegSW, nCoeff_extSW )) - allocate(pade_ssaliqSW(nBandSW, nSizeRegSW, nCoeff_ssa_gSW)) - allocate(pade_asyliqSW(nBandSW, nSizeRegSW, nCoeff_ssa_gSW)) - allocate(pade_exticeSW(nBandSW, nSizeRegSW, nCoeff_extSW, nrghice_fromfileSW)) - allocate(pade_ssaiceSW(nBandSW, nSizeRegSW, nCoeff_ssa_gSW, nrghice_fromfileSW)) - allocate(pade_asyiceSW(nBandSW, nSizeRegSW, nCoeff_ssa_gSW, nrghice_fromfileSW)) - allocate(pade_sizereg_extliqSW(nBoundSW)) - allocate(pade_sizereg_ssaliqSW(nBoundSW)) - allocate(pade_sizereg_asyliqSW(nBoundSW)) - allocate(pade_sizereg_exticeSW(nBoundSW)) - allocate(pade_sizereg_ssaiceSW(nBoundSW)) - allocate(pade_sizereg_asyiceSW(nBoundSW)) - endif + allocate(lut_extliqSW(nSize_liqSW, nBandSW)) + allocate(lut_ssaliqSW(nSize_liqSW, nBandSW)) + allocate(lut_asyliqSW(nSize_liqSW, nBandSW)) + allocate(lut_exticeSW(nSize_iceSW, nBandSW, nrghice_fromfileSW)) + allocate(lut_ssaiceSW(nSize_iceSW, nBandSW, nrghice_fromfileSW)) + allocate(lut_asyiceSW(nSize_iceSW, nBandSW, nrghice_fromfileSW)) allocate(band_limsCLDSW(2,nBandSW)) ! ####################################################################################### @@ -199,84 +152,34 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI - if (mpirank .eq. mpiroot) then -#endif - if (doGP_cldoptics_LUT) then - write (*,*) 'Reading RRTMGP shortwave cloud data (LUT) ... ' - status = nf90_inq_varid(ncid,'radliq_lwr',varID) - status = nf90_get_var(ncid,varID,radliq_lwrSW) - status = nf90_inq_varid(ncid,'radliq_upr',varID) - status = nf90_get_var(ncid,varID,radliq_uprSW) - status = nf90_inq_varid(ncid,'radliq_fac',varID) - status = nf90_get_var(ncid,varID,radliq_facSW) - status = nf90_inq_varid(ncid,'radice_lwr',varID) - status = nf90_get_var(ncid,varID,radice_lwrSW) - status = nf90_inq_varid(ncid,'radice_upr',varID) - status = nf90_get_var(ncid,varID,radice_uprSW) - status = nf90_inq_varid(ncid,'radice_fac',varID) - status = nf90_get_var(ncid,varID,radice_facSW) - status = nf90_inq_varid(ncid,'lut_extliq',varID) - status = nf90_get_var(ncid,varID,lut_extliqSW) - status = nf90_inq_varid(ncid,'lut_ssaliq',varID) - status = nf90_get_var(ncid,varID,lut_ssaliqSW) - status = nf90_inq_varid(ncid,'lut_asyliq',varID) - status = nf90_get_var(ncid,varID,lut_asyliqSW) - status = nf90_inq_varid(ncid,'lut_extice',varID) - status = nf90_get_var(ncid,varID,lut_exticeSW) - status = nf90_inq_varid(ncid,'lut_ssaice',varID) - status = nf90_get_var(ncid,varID,lut_ssaiceSW) - status = nf90_inq_varid(ncid,'lut_asyice',varID) - status = nf90_get_var(ncid,varID,lut_asyiceSW) - status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid,varID,band_limsCLDSW) - endif - if (doGP_cldoptics_PADE) then - write (*,*) 'Reading RRTMGP shortwave cloud data (PADE) ... ' - status = nf90_inq_varid(ncid,'radliq_lwr',varID) - status = nf90_get_var(ncid,varID,radliq_lwrSW) - status = nf90_inq_varid(ncid,'radliq_upr',varID) - status = nf90_get_var(ncid,varID,radliq_uprSW) - status = nf90_inq_varid(ncid,'radliq_fac',varID) - status = nf90_get_var(ncid,varID,radliq_facSW) - status = nf90_inq_varid(ncid,'radice_lwr',varID) - status = nf90_get_var(ncid,varID,radice_lwrSW) - status = nf90_inq_varid(ncid,'radice_upr',varID) - status = nf90_get_var(ncid,varID,radice_uprSW) - status = nf90_inq_varid(ncid,'radice_fac',varID) - status = nf90_get_var(ncid,varID,radice_facSW) - status = nf90_inq_varid(ncid,'pade_extliq',varID) - status = nf90_get_var(ncid,varID,pade_extliqSW) - status = nf90_inq_varid(ncid,'pade_ssaliq',varID) - status = nf90_get_var(ncid,varID,pade_ssaliqSW) - status = nf90_inq_varid(ncid,'pade_asyliq',varID) - status = nf90_get_var(ncid,varID,pade_asyliqSW) - status = nf90_inq_varid(ncid,'pade_extice',varID) - status = nf90_get_var(ncid,varID,pade_exticeSW) - status = nf90_inq_varid(ncid,'pade_ssaice',varID) - status = nf90_get_var(ncid,varID,pade_ssaiceSW) - status = nf90_inq_varid(ncid,'pade_asyice',varID) - status = nf90_get_var(ncid,varID,pade_asyiceSW) - status = nf90_inq_varid(ncid,'pade_sizreg_extliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_extliqSW) - status = nf90_inq_varid(ncid,'pade_sizreg_ssaliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_ssaliqSW) - status = nf90_inq_varid(ncid,'pade_sizreg_asyliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_asyliqSW) - status = nf90_inq_varid(ncid,'pade_sizreg_extice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_exticeSW) - status = nf90_inq_varid(ncid,'pade_sizreg_ssaice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_ssaiceSW) - status = nf90_inq_varid(ncid,'pade_sizreg_asyice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_asyiceSW) - status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid,varID,band_limsCLDSW) - endif + if (mpirank .eq. mpiroot) then + write (*,*) 'Reading RRTMGP shortwave cloud data (LUT) ... ' + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwrSW) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_uprSW) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwrSW) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_uprSW) + status = nf90_inq_varid(ncid,'lut_extliq',varID) + status = nf90_get_var(ncid,varID,lut_extliqSW) + status = nf90_inq_varid(ncid,'lut_ssaliq',varID) + status = nf90_get_var(ncid,varID,lut_ssaliqSW) + status = nf90_inq_varid(ncid,'lut_asyliq',varID) + status = nf90_get_var(ncid,varID,lut_asyliqSW) + status = nf90_inq_varid(ncid,'lut_extice',varID) + status = nf90_get_var(ncid,varID,lut_exticeSW) + status = nf90_inq_varid(ncid,'lut_ssaice',varID) + status = nf90_get_var(ncid,varID,lut_ssaiceSW) + status = nf90_inq_varid(ncid,'lut_asyice',varID) + status = nf90_get_var(ncid,varID,lut_asyiceSW) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_limsCLDSW) ! Close file status = nf90_close(ncid) -#ifdef MPI endif ! Master process ! Other processors waiting... @@ -290,56 +193,35 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, ! ####################################################################################### ! Real scalars - call mpi_bcast(radliq_facSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(radice_facSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) +#ifdef RTE_USE_SP + call mpi_bcast(radliq_lwrSW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(radliq_uprSW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(radice_lwrSW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(radice_uprSW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) +#else call mpi_bcast(radliq_lwrSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(radliq_uprSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(radice_lwrSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(radice_uprSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) +#endif ! Real arrays - call mpi_bcast(band_limsCLDSW, size(band_limsCLDSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - if (doGP_cldoptics_LUT) then - call mpi_bcast(lut_extliqSW, size(lut_extliqSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(lut_ssaliqSW, size(lut_ssaliqSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(lut_asyliqSW, size(lut_asyliqSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(lut_exticeSW, size(lut_exticeSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(lut_ssaiceSW, size(lut_ssaiceSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(lut_asyiceSW, size(lut_asyiceSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif - if (doGP_cldoptics_PADE) then - call mpi_bcast(pade_extliqSW, size(pade_extliqSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_ssaliqSW, size(pade_ssaliqSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_asyliqSW, size(pade_asyliqSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_exticeSW, size(pade_exticeSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_ssaiceSW, size(pade_ssaiceSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_asyiceSW, size(pade_asyiceSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_extliqSW, size(pade_sizereg_extliqSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_ssaliqSW, size(pade_sizereg_ssaliqSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_asyliqSW, size(pade_sizereg_asyliqSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_exticeSW, size(pade_sizereg_exticeSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_ssaiceSW, size(pade_sizereg_ssaiceSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(pade_sizereg_asyiceSW, size(pade_sizereg_asyiceSW), & - MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - endif +#ifdef RTE_USE_SP + call mpi_bcast(band_limsCLDSW, size(band_limsCLDSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_extliqSW, size(lut_extliqSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaliqSW, size(lut_ssaliqSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyliqSW, size(lut_asyliqSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_exticeSW, size(lut_exticeSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaiceSW, size(lut_ssaiceSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyiceSW, size(lut_asyiceSW), MPI_REAL, mpiroot, mpicomm, mpierr) +#else + call mpi_bcast(band_limsCLDSW, size(band_limsCLDSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_extliqSW, size(lut_extliqSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaliqSW, size(lut_ssaliqSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyliqSW, size(lut_asyliqSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_exticeSW, size(lut_exticeSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaiceSW, size(lut_ssaiceSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyiceSW, size(lut_asyiceSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) #endif ! ####################################################################################### @@ -347,20 +229,10 @@ subroutine rrtmgp_sw_cloud_optics_init( rrtmgp_root_dir, rrtmgp_sw_file_clouds, ! Initialize RRTMGP DDT's... ! ! ####################################################################################### - if (doGP_cldoptics_LUT) then - call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_limsCLDSW, & - radliq_lwrSW, radliq_uprSW, radliq_facSW, radice_lwrSW, radice_uprSW, & - radice_facSW, lut_extliqSW, lut_ssaliqSW, lut_asyliqSW, lut_exticeSW, & - lut_ssaiceSW, lut_asyiceSW)) - endif - - if (doGP_cldoptics_PADE) then - call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_limsCLDSW, & - pade_extliqSW, pade_ssaliqSW, pade_asyliqSW, pade_exticeSW, pade_ssaiceSW, & - pade_asyiceSW, pade_sizereg_extliqSW, pade_sizereg_ssaliqSW, & - pade_sizereg_asyliqSW, pade_sizereg_exticeSW, pade_sizereg_ssaiceSW, & - pade_sizereg_asyiceSW)) - endif + call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_limsCLDSW, & + radliq_lwrSW, radliq_uprSW, radice_lwrSW, radice_uprSW, & + lut_extliqSW, lut_ssaliqSW, lut_asyliqSW, & + lut_exticeSW, lut_ssaiceSW, lut_asyiceSW)) call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice_fromfileSW)) diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 index f62a75e4b..d5fb525f2 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_gas_optics.F90 @@ -1,23 +1,18 @@ !> \file rrtmgp_sw_gas_optics.F90 !! -!> \defgroup rrtmgp_sw_gas_optics rrtmgp_sw_gas_optics.F90 -!! -!! \brief This module contains a routine to initialize the k-distribution data used + +!> This module contains a routine to initialize the k-distribution data used !! by the RRTMGP shortwave radiation scheme. -!! module rrtmgp_sw_gas_optics - use machine, only: kind_phys - use mo_rte_kind, only: wl + use mo_rte_kind, only: wl, wp use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs use radiation_tools, only: check_error_msg use netcdf -#ifdef MPI - use mpi -#endif + use mpi_f08 implicit none - real(kind_phys),parameter :: & + real(wp),parameter :: & tsi_default = 1360.85767381726, & mg_default = 0.1567652, & sb_default = 902.7126 @@ -29,92 +24,84 @@ module rrtmgp_sw_gas_optics nmixingfracsSW, nlayersSW, nbndsSW, npairsSW, nminor_absorber_intervals_lowerSW,& nminor_absorber_intervals_upperSW, ncontributors_lowerSW, ncontributors_upperSW integer, dimension(:), allocatable :: & - kminor_start_lowerSW, & ! Starting index in the [1, nContributors] vector for a contributor - ! given by \"minor_gases_lower\" (lower atmosphere) - kminor_start_upperSW ! Starting index in the [1, nContributors] vector for a contributor - ! given by \"minor_gases_upper\" (upper atmosphere) + kminor_start_lowerSW, & !< Starting index in the [1, nContributors] vector for a contributor + !< given by \"minor_gases_lower\" (lower atmosphere) + kminor_start_upperSW !< Starting index in the [1, nContributors] vector for a contributor + !< given by \"minor_gases_upper\" (upper atmosphere) integer, dimension(:,:), allocatable :: & - band2gptSW, & ! Beginning and ending gpoint for each band - minor_limits_gpt_lowerSW, & ! Beginning and ending gpoint for each minor interval in lower atmosphere - minor_limits_gpt_upperSW ! Beginning and ending gpoint for each minor interval in upper atmosphere + band2gptSW, & !< Beginning and ending gpoint for each band + minor_limits_gpt_lowerSW, & !< Beginning and ending gpoint for each minor interval in lower atmosphere + minor_limits_gpt_upperSW !< Beginning and ending gpoint for each minor interval in upper atmosphere integer, dimension(:,:,:), allocatable :: & - key_speciesSW ! Key species pair for each band - real(kind_phys) :: & - press_ref_tropSW, & ! Reference pressure separating the lower and upper atmosphere [Pa] - temp_ref_pSW, & ! Standard spectroscopic reference pressure [Pa] - temp_ref_tSW, & ! Standard spectroscopic reference temperature [K] - tsi_defaultSW, & ! - mg_defaultSW, & ! Mean value of Mg2 index over the average solar cycle from the NRLSSI2 model of solar variability - sb_defaultSW ! Mean value of sunspot index over the average solar cycle from the NRLSSI2 model of solar variability - real(kind_phys), dimension(:), allocatable :: & - press_refSW, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] - temp_refSW, & ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] - solar_quietSW, & ! Spectrally-dependent quiet sun irradiance from the NRLSSI2 model of solar variability - solar_facularSW, & ! Spectrally-dependent facular term from the NRLSSI2 model of solar variability - solar_sunspotSW ! Spectrally-dependent sunspot term from the NRLSSI2 model of solar variability - real(kind_phys), dimension(:,:), allocatable :: & - band_limsSW ! Beginning and ending wavenumber [cm -1] for each band - real(kind_phys), dimension(:,:,:), allocatable :: & - vmr_refSW, & ! Volume mixing ratios for reference atmosphere - kminor_lowerSW, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to - ! [nTemp x nEta x nContributors] array) - kminor_upperSW, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to - ! [nTemp x nEta x nContributors] array) - rayl_lowerSW, & ! Stored coefficients due to rayleigh scattering contribution - rayl_upperSW ! Stored coefficients due to rayleigh scattering contribution - real(kind_phys), dimension(:,:,:,:), allocatable :: & - kmajorSW ! Stored absorption coefficients due to major absorbing gases + key_speciesSW !< Key species pair for each band + real(wp) :: & + press_ref_tropSW, & !< Reference pressure separating the lower and upper atmosphere [Pa] + temp_ref_pSW, & !< Standard spectroscopic reference pressure [Pa] + temp_ref_tSW, & !< Standard spectroscopic reference temperature [K] + tsi_defaultSW, & !< + mg_defaultSW, & !< Mean value of Mg2 index over the average solar cycle from the NRLSSI2 model of solar variability + sb_defaultSW !< Mean value of sunspot index over the average solar cycle from the NRLSSI2 model of solar variability + real(wp), dimension(:), allocatable :: & + press_refSW, & !< Pressures for reference atmosphere; press_ref(# reference layers) [Pa] + temp_refSW, & !< Temperatures for reference atmosphere; temp_ref(# reference layers) [K] + solar_quietSW, & !< Spectrally-dependent quiet sun irradiance from the NRLSSI2 model of solar variability + solar_facularSW, & !< Spectrally-dependent facular term from the NRLSSI2 model of solar variability + solar_sunspotSW !< Spectrally-dependent sunspot term from the NRLSSI2 model of solar variability + real(wp), dimension(:,:), allocatable :: & + band_limsSW !< Beginning and ending wavenumber [cm -1] for each band + real(wp), dimension(:,:,:), allocatable :: & + vmr_refSW, & !< Volume mixing ratios for reference atmosphere + kminor_lowerSW, & !< (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + !< [nTemp x nEta x nContributors] array) + kminor_upperSW, & !< (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + !< [nTemp x nEta x nContributors] array) + rayl_lowerSW, & !< Stored coefficients due to rayleigh scattering contribution + rayl_upperSW !< Stored coefficients due to rayleigh scattering contribution + real(wp), dimension(:,:,:,:), allocatable :: & + kmajorSW !< Stored absorption coefficients due to major absorbing gases character(len=32), dimension(:), allocatable :: & - gas_namesSW, & ! Names of absorbing gases - gas_minorSW, & ! Name of absorbing minor gas - identifier_minorSW, & ! Unique string identifying minor gas - minor_gases_lowerSW, & ! Names of minor absorbing gases in lower atmosphere - minor_gases_upperSW, & ! Names of minor absorbing gases in upper atmosphere - scaling_gas_lowerSW, & ! Absorption also depends on the concentration of this gas - scaling_gas_upperSW ! Absorption also depends on the concentration of this gas + gas_namesSW, & !< Names of absorbing gases + gas_minorSW, & !< Name of absorbing minor gas + identifier_minorSW, & !< Unique string identifying minor gas + minor_gases_lowerSW, & !< Names of minor absorbing gases in lower atmosphere + minor_gases_upperSW, & !< Names of minor absorbing gases in upper atmosphere + scaling_gas_lowerSW, & !< Absorption also depends on the concentration of this gas + scaling_gas_upperSW !< Absorption also depends on the concentration of this gas logical(wl), dimension(:), allocatable :: & - minor_scales_with_density_lowerSW, & ! Density scaling is applied to minor absorption coefficients - minor_scales_with_density_upperSW, & ! Density scaling is applied to minor absorption coefficients - scale_by_complement_lowerSW, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) - scale_by_complement_upperSW ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + minor_scales_with_density_lowerSW, & !< Density scaling is applied to minor absorption coefficients + minor_scales_with_density_upperSW, & !< Density scaling is applied to minor absorption coefficients + scale_by_complement_lowerSW, & !< Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + scale_by_complement_upperSW !< Absorption is scaled by concentration of scaling_gas (F) or its complement (T) contains - ! ###################################################################################### -!>\defgroup rrtmgp_sw_gas_optics_mod GFS RRTMGP-SW Gas Optics Module -!> @{ -!! \section arg_table_rrtmgp_sw_gas_optics_init +!> \section arg_table_rrtmgp_sw_gas_optics_init Argument Table !! \htmlinclude rrtmgp_sw_gas_optics.html !! -!> \ingroup rrtmgp_sw_gas_optics -!! !! RRTMGP relies heavility on derived-data-types, which contain type-bound procedures !! that are referenced frequently throughout the RRTMGP shortwave scheme. The data needed !! for the correlated k-distribution is also contained within this type. Within this module, !! the full k-distribution data is read in, reduced by the "active gases" provided, and !! loaded into the RRTMGP DDT, ty_gas_optics_rrtmgp. -!! -!! \section rrtmgp_sw_gas_optics_init -!> @{ - ! ###################################################################################### subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, & active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & - rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_sw_file_gas ! RRTMGP file containing K-distribution data + rrtmgp_root_dir, & !< RTE-RRTMGP root directory + rrtmgp_sw_file_gas !< RRTMGP file containing K-distribution data character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array + active_gases_array !< List of active gases from namelist as array + type(MPI_Comm),intent(in) :: & + mpicomm !< MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator - mpirank, & ! Current MPI rank - mpiroot ! Master MPI rank + mpirank, & !< Current MPI rank + mpiroot !< Master MPI rank ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg !< CCPP error message integer, intent(out) :: & - errflg ! CCPP error code + errflg !< CCPP error code ! Local variables integer :: status, ncid, dimid, varID, mpierr, iChar @@ -135,9 +122,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP shortwave k-distribution metadata ... ' ! Open file @@ -173,7 +158,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_upperSW) -#ifdef MPI endif ! On master processor ! Other processors waiting... @@ -199,7 +183,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, call mpi_bcast(ncontributors_lowerSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nminor_absorber_intervals_upperSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(nminor_absorber_intervals_lowerSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) -#endif ! ####################################################################################### ! @@ -280,9 +263,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, ! (ONLY master processor(0), if MPI enabled) ! ! ####################################################################################### -#ifdef MPI if (mpirank .eq. mpiroot) then -#endif write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' status = nf90_inq_varid(ncid, 'gas_names', varID) status = nf90_get_var( ncid, varID, gas_namesSW) @@ -379,7 +360,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, ! Close status = nf90_close(ncid) -#ifdef MPI endif ! Master process ! Other processors waiting... @@ -393,13 +373,22 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, ! ####################################################################################### ! Real scalars +#ifdef RTE_USE_SP + call mpi_bcast(press_ref_tropSW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_ref_pSW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_ref_tSW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(tsi_defaultSW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(mg_defaultSW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(sb_defaultSW, 1, MPI_REAL, mpiroot, mpicomm, mpierr) +#else call mpi_bcast(press_ref_tropSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(temp_ref_pSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(temp_ref_tSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(tsi_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(mg_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(sb_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - +#endif + ! Integer arrays call mpi_bcast(kminor_start_lowerSW, & size(kminor_start_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) @@ -415,6 +404,32 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, size(key_speciesSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) ! Real arrays +#ifdef RTE_USE_SP + call mpi_bcast(press_refSW, & + size(press_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_refSW, & + size(temp_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(solar_quietSW, & + size(solar_quietSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(solar_facularSW, & + size(solar_facularSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(solar_sunspotSW, & + size(solar_sunspotSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(band_limsSW, & + size(band_limsSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(vmr_refSW, & + size(vmr_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(kminor_lowerSW, & + size(kminor_lowerSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(kminor_upperSW, & + size(kminor_upperSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(rayl_lowerSW, & + size(rayl_lowerSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(rayl_upperSW, & + size(rayl_upperSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(kmajorSW, & + size(kmajorSW), MPI_REAL, mpiroot, mpicomm, mpierr) +#else call mpi_bcast(press_refSW, & size(press_refSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(temp_refSW, & @@ -439,7 +454,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, size(rayl_upperSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(kmajorSW, & size(kmajorSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - +#endif ! Characters do iChar=1,nabsorbersSW call mpi_bcast(gas_namesSW(iChar), & @@ -476,7 +491,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, size(scale_by_complement_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) call mpi_barrier(mpicomm, mpierr) -#endif ! ####################################################################################### ! @@ -496,6 +510,5 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, sb_defaultSW, rayl_lowerSW, rayl_upperSW)) end subroutine rrtmgp_sw_gas_optics_init -!> @} end module rrtmgp_sw_gas_optics diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 index 124532b03..4ce051fe1 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.F90 @@ -1,12 +1,13 @@ -! ########################################################################################### -! ########################################################################################### +!>\file rrtmgp_sw_main.F90 +!! + +!> This module contain the RRTMGP-SW radiation scheme module rrtmgp_sw_main + use mpi_f08 use machine, only: kind_phys, kind_dbl_prec use mo_optical_props, only: ty_optical_props_2str - use mo_cloud_optics, only: ty_cloud_optics use module_radsw_parameters, only: cmpfsw_type use mo_rte_sw, only: rte_sw - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs use mo_fluxes_byband, only: ty_fluxes_byband use radiation_tools, only: check_error_msg @@ -18,48 +19,41 @@ module rrtmgp_sw_main eps, oneminus, ftiny use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_sampling, only: sampled_mask, draw_samples + use mo_rte_kind, only: rte_wp => wp implicit none public rrtmgp_sw_main_init, rrtmgp_sw_main_run contains - ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_main_init - ! ######################################################################################### -!! \section arg_table_rrtmgp_sw_main_init +!> \section arg_table_rrtmgp_sw_main_init Argument Table !! \htmlinclude rrtmgp_sw_main_init.html !! subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_file_clouds,& - active_gases_array, doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_sgs_pbl, & - doGP_sgs_cnv, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, & + active_gases_array, nrghice, mpicomm, mpirank, mpiroot, nLay, rrtmgp_phys_blksz, & errmsg, errflg) ! Inputs character(len=128),intent(in) :: & - rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_sw_file_clouds, & ! RRTMGP file containing K-distribution data - rrtmgp_sw_file_gas ! RRTMGP file containing cloud-optics data - character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array) - logical, intent(in) :: & - doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs? - doGP_sgs_pbl, & ! Flag to include sgs PBL clouds - doGP_sgs_cnv ! Flag to include sgs convective clouds + rrtmgp_root_dir, & !< RTE-RRTMGP root directory + rrtmgp_sw_file_clouds, & !< RRTMGP file containing K-distribution data + rrtmgp_sw_file_gas !< RRTMGP file containing cloud-optics data + character(len=*), dimension(:), intent(in), optional :: & + active_gases_array !< List of active gases from namelist as array) integer, intent(inout) :: & - nrghice ! Number of ice-roughness categories + nrghice !< Number of ice-roughness categories + type(MPI_Comm),intent(in) :: & + mpicomm !< MPI communicator integer,intent(in) :: & - mpicomm, & ! MPI communicator - mpirank, & ! Current MPI rank - mpiroot, & ! Master MPI rank - rrtmgp_phys_blksz, & ! Number of horizontal points to process at once. + mpirank, & !< Current MPI rank + mpiroot, & !< Master MPI rank + rrtmgp_phys_blksz, & !< Number of horizontal points to process at once. nLay ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg !< CCPP error message integer, intent(out) :: & - errflg ! CCPP error code + errflg !< CCPP error code ! Initialize CCPP error handling variables errmsg = '' @@ -71,18 +65,14 @@ subroutine rrtmgp_sw_main_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_sw_fi ! RRTMGP shortwave cloud-optics initialization call rrtmgp_sw_cloud_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_clouds, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, mpicomm, mpirank, mpiroot, & - errmsg, errflg) + nrghice, mpicomm, mpirank, mpiroot, errmsg, errflg) end subroutine rrtmgp_sw_main_init - ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_main_run - ! ######################################################################################### -!! \section arg_table_rrtmgp_sw_main_run +!> \section arg_table_rrtmgp_sw_main_run Argument Table !! \htmlinclude rrtmgp_sw_main_run.html !! - subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_sgs_pbl, & + subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, & nCol, nDay, nLay, nGases, rrtmgp_phys_blksz, idx, icseed_sw, iovr, iovr_convcld, & iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, isubc_sw, & iSFC, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, coszen,& @@ -98,9 +88,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ logical, intent(in) :: & doSWrad, & ! Flag to perform shortwave calculation doSWclrsky, & ! Flag to compute clear-sky fluxes - top_at_1, & ! Flag for vertical ordering convention - doGP_sgs_pbl, & ! Flag to include sgs PBL clouds - doGP_sgs_cnv ! Flag to include sgs convective clouds + top_at_1 ! Flag for vertical ordering convention integer,intent(in) :: & nCol, & ! Number of horizontal points nDay, & ! Number of daytime points @@ -118,7 +106,8 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ isubc_sw, & ! iSFC integer,intent(in),dimension(:) :: & - idx, & ! Index array for daytime points + idx ! Index array for daytime points + integer,intent(in),dimension(:) :: & icseed_sw ! Seed for random number generation for shortwave radiation real(kind_phys), dimension(:), intent(in) :: & sfc_alb_nir_dir, & ! Surface albedo (direct) @@ -136,7 +125,8 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ vmr_o3, & ! Molar-mixing ratio ozone vmr_ch4, & ! Molar-mixing ratio methane vmr_n2o, & ! Molar-mixing ratio nitrous oxide - vmr_co2, & ! Molar-mixing ratio carbon dioxide + vmr_co2 ! Molar-mixing ratio carbon dioxide + real(kind_phys), dimension(:,:), intent(in) :: & cld_frac, & ! Cloud-fraction for stratiform clouds cld_lwp, & ! Water path for stratiform liquid cloud-particles cld_reliq, & ! Effective radius for stratiform liquid cloud-particles @@ -147,6 +137,8 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ cld_rwp, & ! Water path for rain hydrometeors cld_rerain, & ! Effective radius for rain hydrometeors precip_frac, & ! Precipitation fraction + cloud_overlap_param ! + real(kind_phys), dimension(:,:), intent(in), optional :: & cld_cnv_lwp, & ! Water path for convective liquid cloud-particles cld_cnv_reliq, & ! Effective radius for convective liquid cloud-particles cld_cnv_iwp, & ! Water path for convective ice cloud-particles @@ -154,12 +146,11 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ cld_pbl_lwp, & ! Water path for PBL liquid cloud-particles cld_pbl_reliq, & ! Effective radius for PBL liquid cloud-particles cld_pbl_iwp, & ! Water path for PBL ice cloud-particles - cld_pbl_reice, & ! Effective radius for PBL ice cloud-particles - cloud_overlap_param ! + cld_pbl_reice ! Effective radius for PBL ice cloud-particles real(kind_phys), dimension(:,:,:), intent(in) :: & - aersw_tau, & ! Aerosol optical depth - aersw_ssa, & ! Aerosol single scattering albedo - aersw_g ! Aerosol asymmetry paramter + aersw_tau, & ! Aerosol optical depth + aersw_ssa, & ! Aerosol single scattering albedo + aersw_g ! Aerosol asymmetry paramter character(len=*), dimension(:), intent(in) :: & active_gases_array ! List of active gases from namelist as array real(kind_phys), intent(in) :: & @@ -193,13 +184,13 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ tau_prec, asy_prec, ssa_prec, asyw, ssaw, za1, za2, flux_dir, flux_dif real(kind_phys), dimension(rrtmgp_phys_blksz) :: zcf0, zcf1 real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt()) :: rng1D - real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 + real(rte_wp), dimension(sw_gas_props%get_ngpt(),nLay,rrtmgp_phys_blksz) :: rng3D,rng3D2 real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt()*nLay) :: rng2D logical, dimension(rrtmgp_phys_blksz,nLay,sw_gas_props%get_ngpt()) :: maskMCICA - logical :: cloudy_column, clear_column - real(kind_phys), dimension(sw_gas_props%get_nband(),rrtmgp_phys_blksz) :: & + logical :: cloudy_column, clear_column, doGP_sgs_pbl, doGP_sgs_cnv + real(rte_wp), dimension(sw_gas_props%get_nband(),rrtmgp_phys_blksz) :: & sfc_alb_dir, sfc_alb_dif - real(kind_phys), dimension(rrtmgp_phys_blksz,nLay+1,sw_gas_props%get_nband()),target :: & + real(rte_wp), dimension(rrtmgp_phys_blksz,nLay+1,sw_gas_props%get_nband()),target :: & fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_dir_clrsky, fluxSW_dn_allsky, & fluxSW_dn_clrsky, fluxSW_dn_dir_allsky integer :: iBand, ibd, ibd_uv, iCol, iGas, iLay, ix, ix2, iblck @@ -209,7 +200,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ real(kind_phys), dimension(2), parameter :: & nIR_uvvis_bnd = (/12850,16000/), & uvb_bnd = (/29000,38000/) - real(kind_phys), dimension(rrtmgp_phys_blksz,sw_gas_props%get_ngpt()) :: toa_src_sw + real(rte_wp), dimension(rrtmgp_phys_blksz,sw_gas_props%get_ngpt()) :: toa_src_sw type(ty_gas_concs) :: gas_concs type(ty_optical_props_2str) :: sw_optical_props_accum, sw_optical_props_aerosol_local, & @@ -223,6 +214,19 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ if (.not. doSWrad) return + ! Do we have convective cloud properties? + doGP_sgs_cnv = .false. + if (present(cld_cnv_lwp) .and. present(cld_cnv_reliq) .and. & + present(cld_cnv_iwp) .and. present(cld_cnv_reice)) then + doGP_sgs_cnv = .true. + endif + ! Do we have pbl cloud prperties? + doGP_sgs_pbl = .false. + if (present(cld_pbl_lwp) .and. present(cld_pbl_reliq) .and. & + present(cld_pbl_iwp) .and. present(cld_pbl_reice)) then + doGP_sgs_pbl = .true. + endif + ! ty_gas_concs call check_error_msg('rrtmgp_sw_main_gas_concs_init',gas_concs%init(active_gases_array)) @@ -306,11 +310,11 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ cldtausw = 0._kind_phys ! ty_fluxes_byband - fluxSW_up_allsky = 0._kind_phys - fluxSW_dn_allsky = 0._kind_phys - fluxSW_dn_dir_allsky = 0._kind_phys - fluxSW_up_clrsky = 0._kind_phys - fluxSW_dn_clrsky = 0._kind_phys + fluxSW_up_allsky = 0._rte_wp + fluxSW_dn_allsky = 0._rte_wp + fluxSW_dn_dir_allsky = 0._rte_wp + fluxSW_up_clrsky = 0._rte_wp + fluxSW_dn_clrsky = 0._rte_wp flux_allsky%bnd_flux_up => fluxSW_up_allsky flux_allsky%bnd_flux_dn => fluxSW_dn_allsky flux_allsky%bnd_flux_dn_dir => fluxSW_dn_dir_allsky @@ -323,17 +327,17 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ! ################################################################################### call check_error_msg('rrtmgp_sw_main_set_vmr_o2', & - gas_concs%set_vmr(trim(active_gases_array(istr_o2)), vmr_o2(iCols,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_o2)), real(vmr_o2(iCols,:), kind=rte_wp))) call check_error_msg('rrtmgp_sw_main_set_vmr_co2', & - gas_concs%set_vmr(trim(active_gases_array(istr_co2)),vmr_co2(iCols,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_co2)),real(vmr_co2(iCols,:), kind=rte_wp))) call check_error_msg('rrtmgp_sw_main_set_vmr_ch4', & - gas_concs%set_vmr(trim(active_gases_array(istr_ch4)),vmr_ch4(iCols,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_ch4)),real(vmr_ch4(iCols,:), kind=rte_wp))) call check_error_msg('rrtmgp_sw_main_set_vmr_n2o', & - gas_concs%set_vmr(trim(active_gases_array(istr_n2o)),vmr_n2o(iCols,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_n2o)),real(vmr_n2o(iCols,:), kind=rte_wp))) call check_error_msg('rrtmgp_sw_main_set_vmr_h2o', & - gas_concs%set_vmr(trim(active_gases_array(istr_h2o)),vmr_h2o(iCols,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_h2o)),real(vmr_h2o(iCols,:), kind=rte_wp))) call check_error_msg('rrtmgp_sw_main_set_vmr_o3', & - gas_concs%set_vmr(trim(active_gases_array(istr_o3)), vmr_o3(iCols,:))) + gas_concs%set_vmr(trim(active_gases_array(istr_o3)), real(vmr_o3(iCols,:), kind=rte_wp))) ! ################################################################################### ! @@ -342,13 +346,13 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! ################################################################################### call check_error_msg('rrtmgp_sw_main_gas_optics',sw_gas_props%gas_optics(& - p_lay(iCols,:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(iCols,:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(iCols,:), & ! IN - Temperature @ layer-centers (K) - gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios - sw_optical_props_accum, & ! OUT - RRTMGP DDT: Shortwave optical properties, by - ! spectral point (tau,ssa,g) - toa_src_sw)) ! OUT - TOA incident shortwave radiation (spectral) + real(p_lay(iCols,:), kind=rte_wp), & ! IN - Pressure @ layer-centers (Pa) + real(p_lev(iCols,:), kind=rte_wp), & ! IN - Pressure @ layer-interfaces (Pa) + real(t_lay(iCols,:), kind=rte_wp), & ! IN - Temperature @ layer-centers (K) + gas_concs, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + sw_optical_props_accum, & ! OUT - RRTMGP DDT: Shortwave optical properties, by + ! spectral point (tau,ssa,g) + toa_src_sw)) ! OUT - TOA incident shortwave radiation (spectral) ! Scale incident flux do iblck = 1, rrtmgp_phys_blksz toa_src_sw(iblck,:) = toa_src_sw(iblck,:)*solcon / sum(toa_src_sw(iblck,:)) @@ -392,24 +396,24 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ if (cloudy_column) then ! Gridmean/mp-clouds call check_error_msg('rrtmgp_sw_main_cloud_optics',sw_cloud_props%cloud_optics(& - cld_lwp(iCols,:), & ! IN - Cloud liquid water path - cld_iwp(iCols,:), & ! IN - Cloud ice water path - cld_reliq(iCols,:), & ! IN - Cloud liquid effective radius - cld_reice(iCols,:), & ! IN - Cloud ice effective radius - sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, - ! in each band (tau,ssa,g) + real(cld_lwp(iCols,:), kind=rte_wp), & ! IN - Cloud liquid water path + real(cld_iwp(iCols,:), kind=rte_wp), & ! IN - Cloud ice water path + real(cld_reliq(iCols,:),kind=rte_wp), & ! IN - Cloud liquid effective radius + real(cld_reice(iCols,:),kind=rte_wp), & ! IN - Cloud ice effective radius + sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, + ! in each band (tau,ssa,g) cldtausw(iCols,:) = sw_optical_props_cloudsByBand%tau(:,:,11) ! Include convective clouds? if (doGP_sgs_cnv) then ! Compute call check_error_msg('rrtmgp_sw_main_cnv_cloud_optics',sw_cloud_props%cloud_optics(& - cld_cnv_lwp(iCols,:), & ! IN - Convective cloud liquid water path (g/m2) - cld_cnv_iwp(iCols,:), & ! IN - Convective cloud ice water path (g/m2) - cld_cnv_reliq(iCols,:), & ! IN - Convective cloud liquid effective radius (microns) - cld_cnv_reice(iCols,:), & ! IN - Convective cloud ice effective radius (microns) - sw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties - ! in each band + real(cld_cnv_lwp(iCols,:), kind=rte_wp), & ! IN - Convective cloud liquid water path (g/m2) + real(cld_cnv_iwp(iCols,:), kind=rte_wp), & ! IN - Convective cloud ice water path (g/m2) + real(cld_cnv_reliq(iCols,:),kind=rte_wp), & ! IN - Convective cloud liquid effective radius (microns) + real(cld_cnv_reice(iCols,:),kind=rte_wp), & ! IN - Convective cloud ice effective radius (microns) + sw_optical_props_cnvcloudsByBand)) ! OUT - RRTMGP DDT containing convective cloud radiative properties + ! in each band ! Increment call check_error_msg('rrtmgp_sw_main_increment_cnvclouds_to_clouds',& sw_optical_props_cnvcloudsByBand%increment(sw_optical_props_cloudsByBand)) @@ -419,12 +423,12 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ if (doGP_sgs_pbl) then ! Compute call check_error_msg('rrtmgp_sw_main_pbl_cloud_optics',sw_cloud_props%cloud_optics(& - cld_pbl_lwp(iCols,:), & ! IN - PBL cloud liquid water path (g/m2) - cld_pbl_iwp(iCols,:), & ! IN - PBL cloud ice water path (g/m2) - cld_pbl_reliq(iCols,:), & ! IN - PBL cloud liquid effective radius (microns) - cld_pbl_reice(iCols,:), & ! IN - PBL cloud ice effective radius (microns) - sw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing PBL cloud radiative properties - ! in each band + real(cld_pbl_lwp(iCols,:), kind=rte_wp), & ! IN - PBL cloud liquid water path (g/m2) + real(cld_pbl_iwp(iCols,:), kind=rte_wp), & ! IN - PBL cloud ice water path (g/m2) + real(cld_pbl_reliq(iCols,:), kind=rte_wp), & ! IN - PBL cloud liquid effective radius (microns) + real(cld_pbl_reice(iCols,:), kind=rte_wp), & ! IN - PBL cloud ice effective radius (microns) + sw_optical_props_pblcloudsByBand)) ! OUT - RRTMGP DDT containing PBL cloud radiative properties + ! in each band ! Increment call check_error_msg('rrtmgp_sw_main_increment_pblclouds_to_clouds',& sw_optical_props_pblcloudsByBand%increment(sw_optical_props_cloudsByBand)) @@ -478,7 +482,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ do iblck = 1, rrtmgp_phys_blksz ipseed_sw(iblck) = sw_gas_props%get_ngpt() + iCols(iblck) enddo - elseif (isubc_sw == 2) then ! use input array of permutaion seeds + elseif (isubc_sw == 2) then ! use input array of permutation seeds do iblck = 1, rrtmgp_phys_blksz ipseed_sw(iblck) = icseed_sw(iCols(iblck)) enddo @@ -504,7 +508,7 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Cloud-overlap. ! Maximum-random, random or maximum. if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then - call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(iCols,:), maskMCICA) + call sampled_mask(rng3D, real(cld_frac(iCols,:), kind=rte_wp), maskMCICA) endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then @@ -515,13 +519,14 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ rng3D2(:,:,iblck) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLay]) enddo ! - call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(iCols,:), maskMCICA, & - overlap_param = cloud_overlap_param(iCols,1:nLay-1), randoms2 = real(rng3D2, kind=kind_phys)) + call sampled_mask(rng3D, real(cld_frac(iCols,:), kind=rte_wp), & + maskMCICA, overlap_param = real(cloud_overlap_param(iCols,1:nLay-1), kind=rte_wp),& + randoms2 = rng3D2) endif ! Exponential or Exponential-random if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(iCols,:), maskMCICA, & - overlap_param = cloud_overlap_param(iCols,1:nLay-1)) + call sampled_mask(rng3D, real(cld_frac(iCols,:), kind=rte_wp), & + maskMCICA, overlap_param = real(cloud_overlap_param(iCols,1:nLay-1), kind=rte_wp)) endif ! Sampling. Map band optical depth to each g-point using McICA call check_error_msg('rrtmgp_sw_main_cloud_sampling',& @@ -544,13 +549,13 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Compute clear-sky fluxes (Yes for no-clouds. Optional for cloudy scenes) if (clear_column .or. doSWclrsky) then call check_error_msg('rrtmgp_sw_main_rte_sw_clrsky',rte_sw( & - sw_optical_props_accum, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - coszen(iCols), & ! IN - Cosine of solar zenith angle - toa_src_sw, & ! IN - incident solar flux at TOA - sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) - sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + sw_optical_props_accum, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + real(coszen(iCols), kind=rte_wp), & ! IN - Cosine of solar zenith angle + toa_src_sw, & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) ! Store fluxes fluxswUP_clrsky(iCols,:) = sum(flux_clrsky%bnd_flux_up, dim=3) @@ -603,13 +608,13 @@ subroutine rrtmgp_sw_main_run(doSWrad, doSWclrsky, top_at_1, doGP_sgs_cnv, doGP_ ! Compute fluxes call check_error_msg('rrtmgp_sw_main_rte_sw_allsky',rte_sw( & - sw_optical_props_accum, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - coszen(iCols), & ! IN - Cosine of solar zenith angle - toa_src_sw, & ! IN - incident solar flux at TOA - sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) - sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) - flux_allsky)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) + sw_optical_props_accum, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + real(coszen(iCols), kind=rte_wp), & ! IN - Cosine of solar zenith angle + toa_src_sw, & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_allsky)) ! OUT - Fluxes, clear-sky, 3D (1,nLay,nBand) ! Store fluxes fluxswUP_allsky(iCols,:) = sum(flux_allsky%bnd_flux_up, dim=3) diff --git a/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta index 711d01bc1..a0935d84c 100644 --- a/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta +++ b/physics/Radiation/RRTMGP/rrtmgp_sw_main.meta @@ -2,10 +2,10 @@ name = rrtmgp_sw_main type = scheme dependencies = ../../hooks/machine.F,../radiation_tools.F90,../mersenne_twister.f - dependencies = rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 - dependencies = rte-rrtmgp/rte/mo_rte_kind.F90,rte-rrtmgp/rrtmgp/mo_gas_concentrations.F90,rte-rrtmgp/rte/mo_optical_props.F90 - dependencies = rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/mo_fluxes.F90 - dependencies = rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90 + dependencies = rte-rrtmgp/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 + dependencies = rte-rrtmgp/rte-frontend/mo_rte_kind.F90,rte-rrtmgp/gas-optics/mo_gas_concentrations.F90,rte-rrtmgp/rte-frontend/mo_optical_props.F90 + dependencies = rte-rrtmgp/rte-frontend/mo_rte_sw.F90,rte-rrtmgp/rte-frontend/mo_fluxes.F90 + dependencies = rte-rrtmgp/rte-kernels/mo_fluxes_broadband_kernels.F90, rte-rrtmgp/rte-kernels/mo_rte_solver_kernels.F90 dependencies = rrtmgp_sw_gas_optics.F90, rrtmgp_sw_cloud_optics.F90,rrtmgp_sampling.F90 dependencies = ../../Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_pre.F90 @@ -37,20 +37,6 @@ type = character intent = in kind = len=128 -[doGP_cldoptics_PADE] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in -[doGP_cldoptics_LUT] - standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT - long_name = logical flag to control cloud optics scheme. - units = flag - dimensions = () - type = logical - intent = in [nrghice] standard_name = number_of_ice_roughness_categories long_name = number of ice-roughness categories in RRTMGP calculation @@ -58,20 +44,6 @@ dimensions = () type = integer intent = inout -[doGP_sgs_cnv] - standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP - long_name = logical flag to control sgs convective cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in -[doGP_sgs_pbl] - standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP - long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in [rrtmgp_phys_blksz] standard_name = number_of_columns_per_RRTMGP_SW_block long_name = number of columns to process at a time by RRTMGP SW scheme @@ -105,7 +77,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm intent = in [active_gases_array] standard_name = list_of_active_gases_used_by_RRTMGP @@ -163,20 +135,6 @@ dimensions = () type = integer intent = in -[doGP_sgs_cnv] - standard_name = flag_to_include_sgs_convective_cloud_in_RRTMGP - long_name = logical flag to control sgs convective cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in -[doGP_sgs_pbl] - standard_name = flag_to_include_sgs_MYNN_EDMF_cloud_in_RRTMGP - long_name = logical flag to control MYNN-EDMF PBL cloud in RRTMGP - units = flag - dimensions = () - type = logical - intent = in [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -465,6 +423,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_iwp] standard_name = convective_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -473,6 +432,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_reliq] standard_name = mean_effective_radius_for_liquid_convective_cloud long_name = mean effective radius for liquid convective cloud @@ -481,6 +441,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_cnv_reice] standard_name = mean_effective_radius_for_ice_convective_cloud long_name = mean effective radius for ice convective cloud @@ -489,6 +450,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_lwp] standard_name = MYNN_SGS_cloud_liquid_water_path long_name = layer convective cloud liquid water path @@ -497,6 +459,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_iwp] standard_name = MYNN_SGS_cloud_ice_water_path long_name = layer convective cloud ice water path @@ -505,6 +468,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_reliq] standard_name = mean_effective_radius_for_liquid_MYNN_SGS_cloud long_name = mean effective radius for liquid MYNN_SGS cloud @@ -513,6 +477,7 @@ type = real kind = kind_phys intent = in + optional = True [cld_pbl_reice] standard_name = mean_effective_radius_for_ice_MYNN_SGS_cloud long_name = mean effective radius for ice MYNN_SGS cloud @@ -521,6 +486,7 @@ type = real kind = kind_phys intent = in + optional = True [cloud_overlap_param] standard_name = cloud_overlap_param long_name = cloud overlap parameter diff --git a/physics/Radiation/RRTMGP/rte-rrtmgp b/physics/Radiation/RRTMGP/rte-rrtmgp index 74a0e098b..41c5fcd95 160000 --- a/physics/Radiation/RRTMGP/rte-rrtmgp +++ b/physics/Radiation/RRTMGP/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 74a0e098b2163425e4b5466c2dfcf8ae26d560a5 +Subproject commit 41c5fcd950fed09b8afe186dede266824eca7fd3 diff --git a/physics/Radiation/mersenne_twister.f b/physics/Radiation/mersenne_twister.f index 58bf43487..f9f9668f1 100644 --- a/physics/Radiation/mersenne_twister.f +++ b/physics/Radiation/mersenne_twister.f @@ -2,10 +2,10 @@ !! This file contains the module that calculates random numbers using the !! Mersenne twister -!> \defgroup mersenne_ge Mersenne Twister Module -!! Module: mersenne_twister Modern random number generator -!!\author Iredell Org: W/NX23 date: 2005-06-14 -!! Abstract: This module calculates random numbers using the Mersenne twister. +! Module: mersenne_twister Modern random number generator +!\author Iredell Org: W/NX23 date: 2005-06-14 +!> This module calculates random numbers using the Mersenne twister. +!! !! (It has been adapted to a Fortran 90 module from open source software. !! The comments from the original software are given below in the remarks.) !! The Mersenne twister (aka MT19937) is a state-of-the-art random number @@ -182,7 +182,7 @@ module mersenne_twister integer,parameter:: tmaskc=-272236544 !< tempering parameter integer,parameter:: mag01(0:1)=(/0,mata/) integer,parameter:: iseed=4357 - integer,parameter:: nrest=n+6 + integer,parameter:: nrest=n+4 ! Defined types type random_stat !< Generator state private diff --git a/physics/Radiation/radiation_aerosols.f b/physics/Radiation/radiation_aerosols.f index bbd2f25cb..ce5054c99 100644 --- a/physics/Radiation/radiation_aerosols.f +++ b/physics/Radiation/radiation_aerosols.f @@ -122,9 +122,9 @@ !!!!! ========================================================== !!!!! -!========================================! - module module_radiation_aerosols ! -!........................................! +!> This module contains climatological atmospheric aerosol schemes for +!! radiation computations. + module module_radiation_aerosols ! use machine, only : kind_phys, kind_io4, kind_io8 use module_iounitdef, only : NIAERCM @@ -574,6 +574,7 @@ subroutine aer_init & call wrt_aerlog(iaermdl, iaerflg, lalw1bd, errflg, errmsg) ! write aerosol param info to log file ! --- inputs: (in scope variables) ! --- outputs: (CCPP error handling) + if(errflg/=0) return endif @@ -627,6 +628,7 @@ subroutine aer_init & & errflg, errmsg) ! --- inputs: (module constants) ! --- outputs: (ccpp error handling) + if(errflg/=0) return !> -# Call clim_aerinit() to invoke tropospheric aerosol initialization. @@ -636,14 +638,16 @@ subroutine aer_init & & ( solfwv, eirfwv, me, aeros_file, & ! --- outputs: & errflg, errmsg) + if(errflg/=0) return - elseif ( iaermdl==1 .or. iaermdl==2 ) then ! gocart clim/prog scheme + elseif ( iaermdl==1 .or. iaermdl==2 .or. iaermdl==6) then ! gocart clim/prog scheme call gocart_aerinit & ! --- inputs: & ( solfwv, eirfwv, me, & ! --- outputs: & errflg, errmsg) + if(errflg/=0) return else if ( me == 0 ) then @@ -726,7 +730,10 @@ subroutine wrt_aerlog(iaermdl, iaerflg, lalw1bd, errflg, errmsg) print *,' - Using OPAC-seasonal climatology for tropospheric', & & ' aerosol effect' elseif ( iaermdl == 1 ) then - print *,' - Using GOCART-climatology for tropospheric', & + print *,' - Using MERRA2-climatology for tropospheric', & + & ' aerosol effect' + elseif ( iaermdl == 6 ) then + print *,' - Using MERRA2 3 hourly aerosol for tropospheric', & & ' aerosol effect' elseif ( iaermdl == 2 ) then print *,' - Using GOCART-prognostic aerosols for tropospheric', & @@ -776,7 +783,6 @@ subroutine wrt_aerlog(iaermdl, iaerflg, lalw1bd, errflg, errmsg) endif endif ! end if_iaerflg_block ! - return !................................ end subroutine wrt_aerlog !-------------------------------- @@ -887,7 +893,6 @@ subroutine set_spectrum(con_pi, con_t0c, con_c, con_boltz, & eirfwv(nw) = (tmp1 * tmp3**3) / (exp(tmp2*tmp3) - 1.0) enddo ! - return !................................ end subroutine set_spectrum !-------------------------------- @@ -935,7 +940,6 @@ subroutine set_volcaer(errflg, errmsg) allocate ( ivolae(12,4,10) ) ! for 12-mon,4-lat_zone,10-year endif ! - return !................................ end subroutine set_volcaer !-------------------------------- @@ -1155,9 +1159,6 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) & action='read',form='FORMATTED') rewind (NIAERCM) else - print *,' Requested aerosol data file "',aeros_file, & - & '" not found!' - print *,' *** Stopped in subroutine aero_init !!' errflg = 1 errmsg = 'ERROR(set_aercoef): Requested aerosol data file '// & & aeros_file//' not found' @@ -1189,6 +1190,15 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) allocate ( ssarhd (NRHLEV,NCM2,NSWLWBD) ) allocate ( asyrhd (NRHLEV,NCM2,NSWLWBD) ) allocate ( extstra( NSWLWBD) ) + extrhi = f_zero + scarhi = f_zero + ssarhi = f_zero + asyrhi = f_zero + extrhd = f_zero + scarhd = f_zero + ssarhd = f_zero + asyrhd = f_zero + extstra = f_zero endif !> - ending wave num for 61 aerosol spectral bands @@ -1284,7 +1294,9 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) endif enddo -!$omp parallel do private(ib,mb,ii,iw1,iw2,iw,sumsol,fac,tmp,ibs,ibe) +! Turn off OpenMP due to b4b differences with Intel LLVM 2025.2+ +! https://github.com/NCAR/ccpp-physics/issues/1170 +!!! !$omp parallel do private(ib,mb,ii,iw1,iw2,iw,sumsol,fac,tmp,ibs,ibe) do ib = 1, NSWBND mb = ib + NSWSTR - 1 ii = 1 @@ -1371,8 +1383,9 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) endif enddo endif - -!$omp parallel do private(ib,ii,iw1,iw2,iw,mb,sumir,fac,tmp,ibs,ibe) +! Turn off OpenMP due to b4b differences with Intel LLVM 2025.2+ +! https://github.com/NCAR/ccpp-physics/issues/1170 +!!! !$omp parallel do private(ib,ii,iw1,iw2,iw,mb,sumir,fac,tmp,ibs,ibe) do ib = 1, NLWBND ii = 1 if ( NLWBND == 1 ) then @@ -1485,7 +1498,6 @@ subroutine set_aercoef(aeros_file,errflg, errmsg) ! print *,' extstra:', extstra(ii) ! enddo ! - return !................................ end subroutine set_aercoef !-------------------------------- @@ -1743,7 +1755,6 @@ subroutine optavg enddo ! end do_nb_block for lw endif ! end if_lalwflg_block ! - return !................................ end subroutine optavg !-------------------------------- @@ -1809,7 +1820,6 @@ subroutine aer_update & if ( imon < 1 .or. imon > 12 ) then print *,' ***** ERROR in specifying requested month !!! ', & & 'imon=', imon - print *,' ***** STOPPED in subroutinte aer_update !!!' errflg = 1 errmsg = 'ERROR(aer_update): Requested month not valid' return @@ -1820,6 +1830,7 @@ subroutine aer_update & if ( iaermdl == 0 .or. iaermdl==5 ) then ! opac-climatology scheme call trop_update(aeros_file, errflg, errmsg) + if(errflg/=0) return endif endif @@ -1911,9 +1922,6 @@ subroutine trop_update(aeros_file, errflg, errmsg) print *,' Opened aerosol data file: ',aeros_file endif else - print *,' Requested aerosol data file "',aeros_file, & - & '" not found!' - print *,' *** Stopped in subroutine trop_update !!' errflg = 1 errmsg = 'ERROR(trop_update):Requested aerosol data file '// & & aeros_file // ' not found.' @@ -2000,7 +2008,6 @@ subroutine trop_update(aeros_file, errflg, errmsg) ! print 17,kprfg ! 17 format(8e16.9) ! - return !................................ end subroutine trop_update !-------------------------------- @@ -2120,9 +2127,6 @@ subroutine volc_update(errflg, errmsg) close (NIAERCM) else - print *,' Requested volcanic data file "', & - & volcano_file,'" not found!' - print *,' *** Stopped in subroutine VOLC_AERINIT !!' errflg = 1 errmsg = 'ERROR(volc_update): Requested volcanic data '// & & 'file '//volcano_file//' not found!' @@ -2140,7 +2144,6 @@ subroutine volc_update(errflg, errmsg) print *, ivolae(kmonsav,:,k) endif ! - return !................................ end subroutine volc_update !-------------------------------- @@ -2289,33 +2292,11 @@ subroutine setaer & errmsg = '' errflg = 0 - do m = 1, NF_AESW - do j = 1, NBDSW - do k = 1, NLAY - do i = 1, IMAX - aerosw(i,k,j,m) = f_zero - enddo - enddo - enddo - enddo - - do m = 1, NF_AELW - do j = 1, NBDLW - do k = 1, NLAY - do i = 1, IMAX - aerolw(i,k,j,m) = f_zero - enddo - enddo - enddo - enddo - + aerosw = f_zero + aerolw = f_zero ! sumodp = f_zero - do i = 1, IMAX - do k = 1, NSPC1 - aerodp(i,k) = f_zero - enddo - enddo - ext550(:,:) = f_zero + aerodp = f_zero + ext550 = f_zero if ( .not. (lsswr .or. lslwr) ) then return @@ -2392,7 +2373,7 @@ subroutine setaer & !! subroutine computes sw + lw aerosol optical properties for gocart !! aerosol species (merged from fcst and clim fields). - if ( iaermdl==0 .or. iaermdl==5 ) then ! use opac aerosol climatology + if ( iaermdl==0 .or. iaermdl==5 ) then ! use opac aerosol climatology call aer_property & ! --- inputs: @@ -2405,7 +2386,7 @@ subroutine setaer & & ) ! - elseif ( iaermdl==1 .or. iaermdl==2) then ! use gocart aerosols + elseif ( iaermdl==1 .or. iaermdl==2 .or. iaermdl==6) then ! use gocart aerosols call aer_property_gocart & ! --- inputs: @@ -2416,7 +2397,7 @@ subroutine setaer & & aerosw,aerolw,aerodp,ext550,errflg,errmsg & & ) endif ! end if_iaerflg_block - + if(errflg/=0) return ! --- check print ! do m = 1, NBDSW @@ -2739,7 +2720,6 @@ subroutine setaer & endif ! end if_lavoflg_block ! - return !................................... end subroutine setaer !----------------------------------- @@ -2901,7 +2881,7 @@ subroutine aer_property & ! --- map grid in longitude direction, lon from 0 to 355 deg resolution ! print *,' Seeking lon index for point i =',i - i3 = i1 + i3 = 1 lab_do_IMXAE : do while ( i3 <= IMXAE ) tmp1 = dltg * (i3 - 1) dtmp = alon(i) - tmp1 @@ -2913,7 +2893,7 @@ subroutine aer_property & print *,' ERROR! In setclimaer alon>360. ipt =',i, & & ', dltg,alon,tlon,dlon =',dltg,alon(i),tmp1,dtmp errflg = 1 - errmsg = 'ERROR(aer_property)' + errmsg = 'ERROR(aer_property) alon > 360' return endif elseif ( dtmp >= f_zero ) then @@ -2933,7 +2913,7 @@ subroutine aer_property & print *,' ERROR! In setclimaer alon< 0. ipt =',i, & & ', dltg,alon,tlon,dlon =',dltg,alon(i),tmp1,dtmp errflg = 1 - errmsg = 'ERROR(aer_property)' + errmsg = 'ERROR(aer_property) alon < 0' return endif endif @@ -2942,7 +2922,7 @@ subroutine aer_property & ! --- map grid in latitude direction, lat from 90n to 90s in 5 deg resolution ! print *,' Seeking lat index for point i =',i - j3 = j1 + j3 = 1 lab_do_JMXAE : do while ( j3 <= JMXAE ) tmp2 = 90.0 - dltg * (j3 - 1) dtmp = tmp2 - alat(i) @@ -2954,7 +2934,7 @@ subroutine aer_property & print *,' ERROR! In setclimaer alat<-90. ipt =',i, & & ', dltg,alat,tlat,dlat =',dltg,alat(i),tmp2,dtmp errflg = 1 - errmsg = 'ERROR(aer_property)' + errmsg = 'ERROR(aer_property) alat < -90' return endif elseif ( dtmp >= f_zero ) then @@ -2974,7 +2954,7 @@ subroutine aer_property & print *,' ERROR! In setclimaer alat>90. ipt =',i, & & ', dltg,alat,tlat,dlat =',dltg,alat(i),tmp2,dtmp errflg = 1 - errmsg = 'ERROR(aer_property)' + errmsg = 'ERROR(aer_property) alat > 90' return endif endif @@ -3509,7 +3489,6 @@ subroutine radclimaer(top_at_1) endif ! - return !................................ end subroutine radclimaer !-------------------------------- @@ -3871,6 +3850,8 @@ subroutine gocart_aerinit & ! ================= !----------------------------- +!> read GMAO pre-tabultaed aerosol optical data for dust, seasalt, ! +!! sulfate, black carbon, and organic carbon aerosols subroutine rd_gocart_luts !............................. ! --- inputs: (in scope variables, module variables) @@ -3935,10 +3916,9 @@ subroutine rd_gocart_luts open (unit=niaercm, file=fin, status='OLD') rewind(niaercm) else - print *,' Requested luts file ',trim(fin),' not found' - print *,' ** Stopped in rd_gocart_luts ** ' errflg = 1 - errmsg = 'Requested luts file '//trim(fin)//' not found' + errmsg = 'ERROR(rd_gocart_luts): Requested luts file '// & + & trim(fin)//' not found' return endif ! end if_file_exist_block @@ -4002,10 +3982,9 @@ subroutine rd_gocart_luts open (unit=niaercm, file=fin, status='OLD') rewind(niaercm) else - print *,' Requested luts file ',trim(fin),' not found' - print *,' ** Stopped in rd_gocart_luts ** ' errflg = 1 - errmsg = 'Requested luts file '//trim(fin)//' not found' + errmsg = 'ERROR(rd_gocart_luts): Requested luts file '// & + & trim(fin)//' not found' return endif ! end if_file_exist_block @@ -4067,12 +4046,15 @@ subroutine rd_gocart_luts enddo !! ib-loop - return !................................... end subroutine rd_gocart_luts !----------------------------------- !-------------------------------- +!> compute mean aerosol optical properties over each sw radiation +!! spectral band for each of the species components. This program +!! follows optavg routine (in turn follows gfdl's approach for thick +!! cloud opertical property in sw radiation scheme (2000). subroutine optavg_gocart !................................ ! --- inputs: (in-scope variables, module variables) @@ -4290,8 +4272,6 @@ subroutine optavg_gocart enddo ! end do_nb_block for lw endif ! end if_lalwflg_block ! - return - return !................................... end subroutine optavg_gocart !----------------------------------- @@ -4527,6 +4507,8 @@ subroutine aer_property_gocart & ! ================= !-------------------------------- +!> compute aerosols optical properties in NSWLWBD bands for gocart +!! aerosol species subroutine aeropt !................................ @@ -4682,7 +4664,6 @@ subroutine aeropt enddo ! end_do_ib_loop ! - return !................................ end subroutine aeropt !-------------------------------- diff --git a/physics/Radiation/radiation_astronomy.f b/physics/Radiation/radiation_astronomy.f index b25c89a8c..90ed7cd45 100644 --- a/physics/Radiation/radiation_astronomy.f +++ b/physics/Radiation/radiation_astronomy.f @@ -304,7 +304,6 @@ subroutine sol_init & endif endif ! end if_isolar_block ! - return !................................... end subroutine sol_init !----------------------------------- @@ -433,7 +432,6 @@ subroutine sol_update & inquire (file=solar_fname, exist=file_exist) if ( .not. file_exist ) then - print *,' !!! ERROR! Can not find solar constant file!!!' errflg = 1 errmsg = "ERROR(radiation_astronomy): solar constant file"//& & " not found" @@ -641,7 +639,6 @@ subroutine sol_update & ! if (me == 0) print*,'in sol_update completed sr solar' ! - return !................................... end subroutine sol_update !----------------------------------- @@ -805,7 +802,6 @@ subroutine solar & if (sun < 0.0) sun = sun + tpi sollag = sun - alp - 0.03255e0 ! - return !................................... end subroutine solar !----------------------------------- @@ -904,7 +900,6 @@ subroutine coszmn & endif enddo ! - return !................................... end subroutine coszmn !----------------------------------- @@ -1030,7 +1025,6 @@ subroutine prtime & & ' SOLAR CONSTANT',8X,F12.7,' (DISTANCE AJUSTED)'//) ! - return !................................... end subroutine prtime !----------------------------------- diff --git a/physics/Radiation/radiation_cloud_overlap.F90 b/physics/Radiation/radiation_cloud_overlap.F90 index 737b9be61..358db5cd0 100644 --- a/physics/Radiation/radiation_cloud_overlap.F90 +++ b/physics/Radiation/radiation_cloud_overlap.F90 @@ -1,8 +1,7 @@ !>\file radiation_cloud_overlap.F90 !! -!>\defgroup rad_cld_ovr_mod Radiation Cloud Overlap Module -!! This module contains the calculation of cloud overlap parameters for both RRTMG and RRTMGP. +!> This module contains the calculation of cloud overlap parameters for both RRTMG and RRTMGP. module module_radiation_cloud_overlap use machine, only : kind_phys implicit none @@ -15,9 +14,6 @@ module module_radiation_cloud_overlap contains -!>\defgroup rad_cld_ovr_mod Radiation Cloud Overlap Module -!! This module contains the calculation of cloud overlap parameters for both RRTMG and RRTMGP. -!>@{ ! ###################################################################################### ! Hogan et al. (2010) ! "Effect of improving representation of horizontal and vertical cloud structure on the @@ -92,9 +88,6 @@ subroutine cmp_dcorr_lgth_oreopoulos(nCol, lat, juldat, yearlength, dcorr_lgth) end subroutine cmp_dcorr_lgth_oreopoulos - ! ###################################################################################### - ! - ! ###################################################################################### !>This subroutine provides the alpha cloud overlap parameter for both RRTMG and RRTMGP subroutine get_alpha_exper(nCol, nLay, iovr, iovr_exprand, dzlay, & dcorr_lgth, cld_frac, alpha) @@ -143,5 +136,4 @@ subroutine get_alpha_exper(nCol, nLay, iovr, iovr_exprand, dzlay, & return end subroutine get_alpha_exper -!>@} end module module_radiation_cloud_overlap diff --git a/physics/Radiation/radiation_clouds.f b/physics/Radiation/radiation_clouds.f index 111be4019..d779d56c2 100644 --- a/physics/Radiation/radiation_clouds.f +++ b/physics/Radiation/radiation_clouds.f @@ -200,6 +200,7 @@ module module_radiation_clouds real (kind=kind_phys), parameter :: reice_def = 50.0 !< default ice radius to 50 micron real (kind=kind_phys), parameter :: rrain_def = 1000.0 !< default rain radius to 1000 micron real (kind=kind_phys), parameter :: rsnow_def = 250.0 !< default snow radius to 250 micron + real (kind=kind_phys), parameter :: creice_def = 25.0 !< default convective ice radius to 25 micron overland real (kind=kind_phys), parameter :: cldssa_def = 0.99 !< default cld single scat albedo real (kind=kind_phys), parameter :: cldasy_def = 0.84 !< default cld asymmetry factor @@ -309,6 +310,8 @@ subroutine cld_init & print *,' --- GFDL Lin cloud microphysics' elseif (imp_physics == 8) then print *,' --- Thompson cloud microphysics' + elseif (imp_physics == 88) then + print *,' --- TEMPO cloud microphysics' elseif (imp_physics == 6) then print *,' --- WSM6 cloud microphysics' elseif (imp_physics == 10) then @@ -327,7 +330,6 @@ subroutine cld_init & endif endif ! - return !................................... end subroutine cld_init !----------------------------------- @@ -343,18 +345,19 @@ subroutine radiation_clouds_prop & & ntrac, ntcw, ntiw, ntrw, ntsw, ntgl, ntclamt, & & imp_physics, imp_physics_nssl, imp_physics_fer_hires, & & imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & + & imp_physics_tempo, & & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & & imp_physics_mg, iovr, iovr_rand, iovr_maxrand, iovr_max, & & iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, & & idcor_hogan, idcor_oreopoulos, lcrick, lcnorm, & & imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, & - & do_mynnedmf, lgfdlmprad, & + & do_mynnedmf, lgfdlmprad, xr_cnvcld, & & uni_cld, lmfshal, lmfdeep2, cldcov, clouds1, & & effrl, effri, effrr, effrs, effr_in, & & effrl_inout, effri_inout, effrs_inout, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, latdeg, julian, yearlen, gridkm, top_at_1, si, & - & con_ttp, con_pi, con_g, con_rd, con_thgni, & + & xr_con, xr_exp, con_ttp, con_pi, con_g, con_rd, con_thgni, & & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, & ! --- outputs: & cld_rwp, cld_rerain, cld_swp, cld_resnow, & & clds, mtop, mbot, de_lgth, alpha & @@ -518,6 +521,7 @@ subroutine radiation_clouds_prop & & imp_physics_fer_hires, ! Flag for fer-hires scheme & imp_physics_gfdl, ! Flag for gfdl scheme & imp_physics_thompson, ! Flag for thompsonscheme + & imp_physics_tempo, ! Flag for TEMPO scheme & imp_physics_wsm6, ! Flag for wsm6 scheme & imp_physics_zhao_carr, ! Flag for zhao-carr scheme & imp_physics_zhao_carr_pdf, ! Flag for zhao-carr+PDF scheme @@ -538,7 +542,8 @@ subroutine radiation_clouds_prop & logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, effr_in, & - & do_mynnedmf, lgfdlmprad, top_at_1, lcrick, lcnorm + & do_mynnedmf, lgfdlmprad, top_at_1, lcrick, lcnorm, & + & xr_cnvcld real (kind=kind_phys), dimension(:,:,:), intent(in) :: ccnd, & & tracer1 @@ -547,7 +552,7 @@ subroutine radiation_clouds_prop & & delp, dz, effrl, effri, effrr, effrs, dzlay, clouds1 real (kind=kind_phys), intent(in) :: sup, dcorr_con, con_ttp, & - & con_pi, con_g, con_rd, con_thgni + & con_pi, con_g, con_rd, con_thgni, xr_con, xr_exp real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk, si @@ -584,10 +589,6 @@ subroutine radiation_clouds_prop & integer :: i, k, id, nf -! --- constant values -! real (kind=kind_phys), parameter :: xrc3 = 200. - real (kind=kind_phys), parameter :: xrc3 = 100. - ! !===> ... begin here ! @@ -635,7 +636,7 @@ subroutine radiation_clouds_prop & call progcld_zhao_carr (plyr ,plvl, tlyr, tvly, qlyr, & ! --- inputs & qstl, rhly, ccnd(1:IX,1:NLAY,1), xlat, xlon, & & slmsk, dz, delp, IX, NLAY, NLP1, uni_cld, & - & lmfshal, lmfdeep2, & + & lmfshal, lmfdeep2, xr_con, xr_exp, & & cldcov, effrl, effri, effrr, effrs, effr_in, & & dzlay, & & cldtot, cldcnv, lcrick, lcnorm, con_ttp, & ! inout @@ -689,7 +690,7 @@ subroutine radiation_clouds_prop & call progcld_fer_hires (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly, & ! --- inputs & tracer1,xlat,xlon,slmsk,dz,delp, & & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - & IX,NLAY,NLP1, icloud, uni_cld, & + & IX,NLAY,NLP1, icloud, xr_con, xr_exp, uni_cld,& & lmfshal, lmfdeep2, & & cldcov(:,1:NLAY),effrl_inout(:,:), & & effri_inout(:,:), effrs_inout(:,:), & @@ -727,8 +728,9 @@ subroutine radiation_clouds_prop & call progcld_thompson_wsm6 (plyr,plvl,tlyr,qlyr,qstl, & ! --- inputs & rhly,tracer1,xlat,xlon,slmsk,dz,delp, & & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - & ntsw-1,ntgl-1,con_ttp, & - & IX, NLAY, NLP1, uni_cld, lmfshal, lmfdeep2, & + & ntsw-1,ntgl-1,con_ttp,xr_cnvcld, & + & IX, NLAY, NLP1, xr_con, xr_exp, uni_cld, & + & lmfshal, lmfdeep2, & & cldcov(:,1:NLAY), cnvw, effrl_inout, & & effri_inout, effrs_inout, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & @@ -739,7 +741,8 @@ subroutine radiation_clouds_prop & & cld_resnow) endif ! MYNN PBL or GF - elseif(imp_physics == imp_physics_thompson) then ! Thompson MP + elseif(imp_physics == imp_physics_thompson & + & .or. imp_physics == imp_physics_tempo) then ! Thompson/TEMPO MP if(do_mynnedmf .or. imfdeepcnv == imfdeepcnv_gf & & .or. imfdeepcnv == imfdeepcnv_c3) then ! MYNN PBL or GF conv @@ -801,8 +804,9 @@ subroutine radiation_clouds_prop & call progcld_thompson_wsm6 (plyr,plvl,tlyr,qlyr,qstl, & ! --- inputs & rhly,tracer1,xlat,xlon,slmsk,dz,delp, & & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - & ntsw-1,ntgl-1,con_ttp, & - & IX, NLAY, NLP1, uni_cld, lmfshal, lmfdeep2, & + & ntsw-1,ntgl-1,con_ttp,xr_cnvcld, & + & IX, NLAY, NLP1, xr_con, xr_exp, uni_cld, & + & lmfshal, lmfdeep2, & & cldcov(:,1:NLAY), cnvw, effrl, effri, effrs, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & & dzlay, & @@ -872,7 +876,6 @@ subroutine radiation_clouds_prop & & clds, mtop, mbot & & ) - return !................................... end subroutine radiation_clouds_prop @@ -882,7 +885,7 @@ end subroutine radiation_clouds_prop subroutine progcld_zhao_carr & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, & - & uni_cld, lmfshal, lmfdeep2, cldcov, & + & uni_cld, lmfshal, lmfdeep2, xr_con, xr_exp, cldcov, & & effrl,effri,effrr,effrs,effr_in, & & dzlay, cldtot, cldcnv, lcrick, lcnorm, con_ttp, & & cld_frac, cld_lwp, cld_reliq, cld_iwp, & ! --- outputs @@ -974,7 +977,7 @@ subroutine progcld_zhao_carr & real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk - real (kind=kind_phys), intent(in) :: con_ttp + real (kind=kind_phys), intent(in) :: con_ttp, xr_con, xr_exp ! --- inputs/outputs @@ -991,10 +994,6 @@ subroutine progcld_zhao_carr & integer :: i, k, id, nf -! --- constant values -! real (kind=kind_phys), parameter :: xrc3 = 200. - real (kind=kind_phys), parameter :: xrc3 = 100. - ! !===> ... begin here ! @@ -1089,11 +1088,12 @@ subroutine progcld_zhao_carr & if (.not. lmfshal) then call cloud_fraction_XuRandall & - & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs else call cloud_fraction_mass_flx_1 & - & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, lmfdeep2, xr_con, xr_exp, plyr, clwf, rhly, & + & qstl, & ! --- inputs & cldtot ) endif @@ -1169,7 +1169,6 @@ subroutine progcld_zhao_carr & enddo enddo ! - return !................................... end subroutine progcld_zhao_carr !----------------------------------- @@ -1463,7 +1462,6 @@ subroutine progcld_zhao_carr_pdf & enddo enddo ! - return !................................... end subroutine progcld_zhao_carr_pdf !----------------------------------- @@ -1705,19 +1703,18 @@ subroutine progcld_gfdl_lin & enddo enddo ! - return !................................... end subroutine progcld_gfdl_lin !----------------------------------- !----------------------------------- -!! This subroutine computes cloud related quantities using +!> This subroutine computes cloud related quantities using !! Ferrier-Aligo cloud microphysics scheme. subroutine progcld_fer_hires & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, & & ntrac,ntcw,ntiw,ntrw, & - & IX, NLAY, NLP1, icloud, & + & IX, NLAY, NLP1, icloud, xr_con, xr_exp, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & & dzlay, cldtot, cldcnv, lcnorm, & @@ -1800,6 +1797,7 @@ subroutine progcld_fer_hires & logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, lcnorm + real (kind=kind_phys), intent(in) :: xr_con, xr_exp real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, tvly, qlyr, qstl, rhly, cldcov, delp, dz, dzlay @@ -1826,10 +1824,6 @@ subroutine progcld_fer_hires & integer :: i, k, id, nf -! --- constant values -! real (kind=kind_phys), parameter :: xrc3 = 200. - real (kind=kind_phys), parameter :: xrc3 = 100. - ! !===> ... begin here ! @@ -1900,12 +1894,13 @@ subroutine progcld_fer_hires & if (.not. lmfshal) then call cloud_fraction_XuRandall & - & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs else call cloud_fraction_mass_flx_1 & - & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs - & cldtot ) + & ( IX, NLAY, lmfdeep2, xr_con, xr_exp, plyr, clwf, rhly, & + & qstl, & ! --- inputs + & cldtot ) & ! --- outputs endif endif ! if (uni_cld) then @@ -1953,18 +1948,17 @@ subroutine progcld_fer_hires & enddo enddo ! - return !................................... end subroutine progcld_fer_hires !................................... -! This subroutine is used by Thompson/WSM6/NSSL cloud microphysics (EMC) +!> This subroutine is used by Thompson/WSM6/NSSL cloud microphysics (EMC) subroutine progcld_thompson_wsm6 & & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl,con_ttp, & - & IX, NLAY, NLP1, & + & xr_cnvcld, IX, NLAY, NLP1, xr_con, xr_exp, & & uni_cld, lmfshal, lmfdeep2, cldcov, cnvw, & & re_cloud,re_ice,re_snow, & & lwp_ex, iwp_ex, lwp_fc, iwp_fc, & @@ -2051,7 +2045,8 @@ subroutine progcld_thompson_wsm6 & integer, intent(in) :: IX, NLAY, NLP1 integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl - logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, lcnorm + logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, lcnorm, & + & xr_cnvcld real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, dzlay, & @@ -2063,7 +2058,7 @@ subroutine progcld_thompson_wsm6 & real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk - real (kind=kind_phys), intent(in) :: con_ttp + real (kind=kind_phys), intent(in) :: con_ttp, xr_con, xr_exp ! --- inputs/outputs real (kind=kind_phys), dimension(:,:), intent(inout) :: & @@ -2080,7 +2075,6 @@ subroutine progcld_thompson_wsm6 & integer :: i, k, id, nf ! --- constant values - real (kind=kind_phys), parameter :: xrc3 = 100. real (kind=kind_phys), parameter :: snow2ice = 0.25 real (kind=kind_phys), parameter :: coef_t = 0.025 ! @@ -2122,28 +2116,53 @@ subroutine progcld_thompson_wsm6 & ! enddo ! endif +!> - Include grid-mean suspended cloud condensate in Xu-Randall cloud fraction +!> if xr_cnvcld is true: + + if(xr_cnvcld)then do k = 1, NLAY do i = 1, IX clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) & + clw(i,k,ntrw) + cnvw(i,k) enddo enddo + else + do k = 1, NLAY + do i = 1, IX + clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) + & + clw(i,k,ntrw) + enddo + enddo + endif !> - Compute total-cloud liquid/ice condensate path in \f$ g/m^2 \f$. !> The total condensate includes convective condensate. do k = 1, NLAY-1 do i = 1, IX - tem1 = cnvw(i,k)*(1.-tem2d(i,k)) + if(xr_cnvcld)then + tem1 = cnvw(i,k)*(1.-tem2d(i,k)) + else + tem1 = 0. + endif cwp(i,k) = max(0.0, (clw(i,k,ntcw)+tem1) * & gfac * delp(i,k)) if(tem1 > 1.e-12 .and. clw(i,k,ntcw) < 1.e-12) & rew(i,k)=reliq_def - tem2 = cnvw(i,k)*tem2d(i,k) + if(xr_cnvcld)then + tem2 = cnvw(i,k)*tem2d(i,k) + else + tem2 = 0. + endif cip(i,k) = max(0.0, (clw(i,k,ntiw) + & snow2ice*clw(i,k,ntsw) + tem2) * & gfac * delp(i,k)) - if(tem2 > 1.e-12 .and. clw(i,k,ntiw) < 1.e-12) - & rei(i,k)=reice_def + if(tem2 > 1.e-12 .and. clw(i,k,ntiw) < 1.e-12) then + if(nint(slmsk(i))==1) then + rei(i,k)=creice_def + else + rei(i,k)=reice_def + endif + endif crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) csp(i,k) = max(0.0, (1.-snow2ice)*clw(i,k,ntsw) * & gfac * delp(i,k)) @@ -2178,11 +2197,12 @@ subroutine progcld_thompson_wsm6 & if (.not. lmfshal) then call cloud_fraction_XuRandall & - & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs else call cloud_fraction_mass_flx_2 & - & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, lmfdeep2, xr_con, xr_exp, plyr, clwf, rhly, & + & qstl, & ! --- inputs & cldtot ) endif @@ -2241,8 +2261,6 @@ subroutine progcld_thompson_wsm6 & enddo enddo - return - !............................................ end subroutine progcld_thompson_wsm6 !............................................ @@ -2527,8 +2545,6 @@ subroutine progcld_thompson & iwp_ex(i) = iwp_ex(i)*1.E-3 enddo ! - return - !............................................ end subroutine progcld_thompson !............................................ @@ -2814,7 +2830,6 @@ subroutine progclduni & enddo enddo ! - return !................................... end subroutine progclduni !----------------------------------- @@ -3273,7 +3288,6 @@ subroutine gethml & endif ! end_if_top_at_1 ! - return !................................... end subroutine gethml !----------------------------------- @@ -3718,11 +3732,12 @@ END SUBROUTINE adjust_cloudFinal !> This subroutine computes the Xu-Randall cloud fraction scheme. subroutine cloud_fraction_XuRandall & - & ( IX, NLAY, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, xr_con, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs ! --- inputs: integer, intent(in) :: IX, NLAY + real (kind=kind_phys), intent(in) :: xr_con, xr_exp real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & & rhly, qstl @@ -3747,11 +3762,11 @@ subroutine cloud_fraction_XuRandall & onemrh= max( 1.e-10, 1.0-rhly(i,k) ) clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) - tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) - tem1 = 2000.0 / tem1 + tem1 = min(max((onemrh*qstl(i,k))**xr_exp,0.0001),1.0) + tem1 = xr_con / tem1 value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) + tem2 = sqrt(sqrt(rhly(i,k))) cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) endif @@ -3762,12 +3777,12 @@ end subroutine cloud_fraction_XuRandall !> subroutine cloud_fraction_mass_flx_1 & - & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, lmfdeep2, xrc3, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs ! --- inputs: integer, intent(in) :: IX, NLAY - real (kind=kind_phys), intent(in) :: xrc3 + real (kind=kind_phys), intent(in) :: xrc3, xr_exp real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & & rhly, qstl logical, intent(in) :: lmfdeep2 @@ -3793,7 +3808,7 @@ subroutine cloud_fraction_mass_flx_1 & onemrh= max( 1.e-10, 1.0-rhly(i,k) ) clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) ! - tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan + tem1 = min(max((onemrh*qstl(i,k))**xr_exp,0.0001),1.0) !jhan if (lmfdeep2) then tem1 = xrc3 / tem1 else @@ -3812,12 +3827,12 @@ end subroutine cloud_fraction_mass_flx_1 !> subroutine cloud_fraction_mass_flx_2 & - & ( IX, NLAY, lmfdeep2, xrc3, plyr, clwf, rhly, qstl, & ! --- inputs + & ( IX, NLAY, lmfdeep2, xrc3, xr_exp, plyr, clwf, rhly, qstl, & ! --- inputs & cldtot ) & ! --- outputs ! --- inputs: integer, intent(in) :: IX, NLAY - real (kind=kind_phys), intent(in) :: xrc3 + real (kind=kind_phys), intent(in) :: xrc3, xr_exp real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, clwf, & & rhly, qstl logical, intent(in) :: lmfdeep2 @@ -3845,7 +3860,7 @@ subroutine cloud_fraction_mass_flx_2 & onemrh= max( 1.e-10, 1.0-rhly(i,k) ) clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) - tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan + tem1 = min(max((onemrh*qstl(i,k))**xr_exp,0.0001),1.0) if (lmfdeep2) then tem1 = xrc3 / tem1 else diff --git a/physics/Radiation/radiation_gases.f b/physics/Radiation/radiation_gases.f index 4c626b348..784e8917e 100644 --- a/physics/Radiation/radiation_gases.f +++ b/physics/Radiation/radiation_gases.f @@ -281,9 +281,9 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & inquire (file=co2usr_file, exist=file_exist) if ( .not. file_exist ) then - print *,' Can not find user CO2 data file: ',co2usr_file errflg = 1 - errmsg = 'ERROR(gas_init): Can not find user CO2 data file' + errmsg = 'ERROR(gas_init): Cannot find user CO2 data file'//& + & ': '//co2usr_file return else close (NICO2CN) @@ -327,7 +327,7 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & else print *,' ICO2=',ico2flg,' is not a valid selection' errflg = 1 - errmsg = 'ERROR(gas_init): ICO2 is not valid' + errmsg = 'ERROR(gas_init): ICO2 is not a valid selection' return endif ! endif_ico2flg_block @@ -349,20 +349,16 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & else print *,' ICO2=',ico2flg,' is not a valid selection' errflg = 1 - errmsg = 'ERROR(gas_init): ICO2 is not valid' + errmsg = 'ERROR(gas_init): ICO2 is not a valid selection' return endif if ( ictmflg == -2 ) then inquire (file=co2cyc_file, exist=file_exist) if ( .not. file_exist ) then - if ( me == 0 ) then - print *,' Can not find seasonal cycle CO2 data: ', & - & co2cyc_file - endif errflg = 1 - errmsg = 'ERROR(gas_init): Can not find seasonal cycle '//& - & 'CO2 data' + errmsg = 'ERROR(gas_init): Cannot find seasonal cycle '// & + & 'CO2 data file: '//co2cyc_file return else allocate( co2cyc_sav(IMXCO2,JMXCO2,12) ) @@ -404,8 +400,6 @@ subroutine gas_init( me, co2usr_file, co2cyc_file, ico2flg, & endif lab_ictm endif lab_ico2 - - return ! !................................... end subroutine gas_init @@ -550,11 +544,9 @@ subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & inquire (file=co2gbl_file, exist=file_exist) if ( .not. file_exist ) then - print *,' Requested co2 data file "',co2gbl_file, & - & '" not found' errflg = 1 errmsg = 'ERROR(gas_update): Requested co2 data file not '// & - & 'found' + & 'found: '//co2gbl_file return else close(NICO2CN) @@ -648,12 +640,9 @@ subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & enddo Lab_dowhile2 if ( .not. file_exist ) then - if ( me == 0 ) then - print *,' Can not find co2 data source file' - endif errflg = 1 - errmsg = 'ERROR(gas_update): Can not find co2 data '// & - & 'source file' + errmsg = 'ERROR(gas_update): Cannot find co2 data '// & + & 'source file: '//co2dat_file return endif endif Lab_if_ictm @@ -767,8 +756,6 @@ subroutine gas_update(iyear, imon, iday, ihour, ldoco2, & close ( NICO2CN ) endif Lab_if_idyr - - return ! !................................... end subroutine gas_update @@ -934,9 +921,7 @@ subroutine getgases( plvl, xlon, xlat, IMAX, LMAX, ico2flg, & endif enddo endif - ! - return !................................... end subroutine getgases !----------------------------------- diff --git a/physics/Radiation/radiation_surface.f b/physics/Radiation/radiation_surface.f index 7b7caf849..3f62b66fc 100644 --- a/physics/Radiation/radiation_surface.f +++ b/physics/Radiation/radiation_surface.f @@ -348,7 +348,7 @@ subroutine setalb & & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & & icealbdvis, icealbdnir, icealbivis, icealbinir, & - & IMAX, NF_ALBD, albPpert, pertalb, fracl, fraco, fraci, icy,& + & IMAX, albPpert, pertalb, fracl, fraco, fraci, icy, & & ialbflg, con_ttp, & & sfcalb & ! --- outputs: & ) @@ -413,7 +413,7 @@ subroutine setalb & implicit none ! --- inputs - integer, intent(in) :: IMAX, NF_ALBD, ialbflg + integer, intent(in) :: IMAX, ialbflg integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc logical, intent(in) :: use_cice_alb, frac_grid @@ -421,8 +421,9 @@ subroutine setalb & & lakefrac, & & slmsk, snodi, zorlf, coszf, tsknf, tairf, hprif, & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & - & icealbdvis, icealbdnir, icealbivis, icealbinir, & & sncovr, sncovr_ice, snoalb, albPpert ! sfc-perts, mgehne + real (kind=kind_phys), dimension(:), intent(in), optional :: & + & icealbdvis, icealbdnir, icealbivis, icealbinir real (kind=kind_phys), intent(in) :: pertalb, con_ttp! sfc-perts, mgehne real (kind=kind_phys), dimension(:), intent(in) :: & & fracl, fraco, fraci @@ -433,8 +434,7 @@ subroutine setalb & & icy ! --- outputs - real (kind=kind_phys), dimension(IMAX,NF_ALBD), intent(out) :: & - & sfcalb + real (kind=kind_phys), dimension(:,:), intent(out) :: sfcalb ! --- locals: real (kind=kind_phys) :: asnvb, asnnb, asnvd, asnnd, asevb & @@ -802,8 +802,6 @@ subroutine setemis & ! ! ! ==================== end of description ===================== ! ! - use set_soilveg_ruc_mod, only: set_soilveg_ruc - use namelist_soilveg_ruc implicit none diff --git a/physics/Radiation/radiation_tools.F90 b/physics/Radiation/radiation_tools.F90 index 28384f32a..e941a3461 100644 --- a/physics/Radiation/radiation_tools.F90 +++ b/physics/Radiation/radiation_tools.F90 @@ -1,6 +1,7 @@ !>\file radiation_tools.F90 !! +!> This module contains tools for radiation module radiation_tools use machine, only: & kind_phys ! Working type @@ -11,8 +12,7 @@ module radiation_tools rrtmgp_minT ! Minimum temperature allowed in RRTMGP contains - ! ######################################################################################### - ! ######################################################################################### +!> subroutine cmp_tlev(nCol,nLev,minP,p_lay,t_lay,p_lev,tsfc,t_lev) ! Inputs integer, intent(in) :: & @@ -83,9 +83,7 @@ subroutine cmp_tlev(nCol,nLev,minP,p_lay,t_lay,p_lev,tsfc,t_lev) end subroutine cmp_tlev - ! ######################################################################################### - ! SUBROUTINE check_error_msg - ! ######################################################################################### +!> subroutine check_error_msg(routine_name, error_msg) character(len=*), intent(in) :: & error_msg, routine_name diff --git a/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 index e235acc52..7b9945673 100644 --- a/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 +++ b/physics/SFC_Layer/GFDL/gfdl_sfc_layer.F90 @@ -1,4 +1,4 @@ -!> \file gfdl_sfc_layer.f +!> \file gfdl_sfc_layer.F90 !! This file contains ... !> This module contains the CCPP-compliant GFDL surface layer scheme. @@ -1149,6 +1149,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m zoc(i) = -100.*znotm zot(i) = -100* znott endif + if(errflg/=0) return endif !------------------------------------------------------------------------ ! where necessary modify zo values over ocean. @@ -1783,6 +1784,8 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m if ( iwavecpl .eq. 1 .and. zoc(i) .le. 0.0 ) then windmks = wind10(i) * 0.01 call znot_wind10m(windmks,znott,znotm,icoef_sf,errmsg,errflg) + if(errflg/=0) return + !Check if Charnock parameter ratio is received in a proper range. if ( alpha(i) .ge. 0.2 .and. alpha(i) .le. 5. ) then znotm = znotm*alpha(i) diff --git a/physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 b/physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 index 6ec9ed835..8ae67954d 100644 --- a/physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 +++ b/physics/SFC_Layer/GFDL/module_sf_exchcoef.f90 @@ -1,4 +1,5 @@ -! This MODULE holds the routines that calculate air-sea exchange coefficients +!>\file module_sf_exchcoef.f90 +!! This MODULE holds the routines that calculate air-sea exchange coefficients MODULE module_sf_exchcoef CONTAINS @@ -728,7 +729,6 @@ SUBROUTINE znot_wind10m(w10m,znott,znotm,icoef_sf,errmsg,errflg) call znot_m_v8(windmks,zm1) call znot_t_v8(windmks,zt1) else - write(0,*)'stop, icoef_sf must be one of 0,1,2,3,4,5,6,7,8' errflg = 1 errmsg = 'ERROR(znot_wind10m): icoef_sf must be one of 0,1,2,3,4,5,6,7,8' return diff --git a/physics/SFC_Layer/MYJ/module_SF_JSFC.F90 b/physics/SFC_Layer/MYJ/module_SF_JSFC.F90 index fdf188b96..674883e16 100644 --- a/physics/SFC_Layer/MYJ/module_SF_JSFC.F90 +++ b/physics/SFC_Layer/MYJ/module_SF_JSFC.F90 @@ -715,12 +715,11 @@ SUBROUTINE SFCDIF(NTSD,SEAMASK,THS,QS,PSFC & print*,'ZSLU,ZSLT,RLMO,ZU,ZT=',ZSLU,ZSLT,RLMO,ZU,ZT print*,'A,B,DTHV,DU2,RIB=',A,B,DTHV,DU2,RIB errflg = 1 - errmsg = 'ERROR(SFCDIF): ' + errmsg = 'ERROR(SFCDIF): in module_SF_JSFC.F90' return end if - AKMS=MAX(USTARK/SIMM,CXCHS) AKHS=MAX(USTARK/SIMH,CXCHS) ! @@ -872,9 +871,6 @@ SUBROUTINE SFCDIF(NTSD,SEAMASK,THS,QS,PSFC & ! stop ! end if - - - ! RZ=(ZETAT-ZTMIN2)/DZETA2 K=INT(RZ) diff --git a/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 b/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 index 50707bd7c..d8f6b543c 100644 --- a/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 +++ b/physics/SFC_Layer/MYJ/myjsfc_wrapper.F90 @@ -34,34 +34,34 @@ end subroutine myjsfc_wrapper_init !! !###=================================================================== SUBROUTINE myjsfc_wrapper_run( & - & restart, & - & im,levs, & - & kdt,ntrac,ntke, & - & ntcw,ntiw,ntrw,ntsw,ntgl, & - & iter,flag_iter, & - & ugrs, vgrs, tgrs, qgrs, & - & prsl, prsi, phii, & - & prsik_1, prslk_1, tsfc, qsfc, & - & phy_myj_qsfc, phy_myj_thz0, phy_myj_qz0, & - & phy_myj_uz0, phy_myj_vz0, phy_myj_z0base, & - & phy_myj_akhs, phy_myj_akms, & - & phy_myj_chkqlm, phy_myj_elflx, & - & phy_myj_a1u, phy_myj_a1t, phy_myj_a1q, & - & pblh, slmsk, zorl, ustar, rib, & - & cm,ch,stress,ffm,ffh,fm10,fh2, & - & landfrac, oceanfrac,fice, & - & z0rl_wat, z0rl_lnd, z0rl_ice, & ! intent(inout) - & ustar_wat, ustar_lnd, ustar_ice, & ! intent(inout) - & cm_wat, cm_lnd, cm_ice, & ! intent(inout) - & ch_wat, ch_lnd, ch_ice, & ! intent(inout) - & rb_wat, rb_lnd, rb_ice, & ! intent(inout) - & stress_wat,stress_lnd,stress_ice, & ! intent(inout) - & fm_wat, fm_lnd, fm_ice, & ! intent(inout) - & fh_wat, fh_lnd, fh_ice, & ! intent(inout) - & fm10_wat, fm10_lnd, fm10_ice, & ! intent(inout) - & fh2_wat, fh2_lnd, fh2_ice, & ! intent(inout) - & wind, con_cp, con_g, con_rd, & - & me, lprnt, errmsg, errflg ) ! intent(inout) + restart, & + im,levs, & + kdt,ntrac,ntke, & + ntcw,ntiw,ntrw,ntsw,ntgl, & + iter,flag_iter, & + ugrs, vgrs, tgrs, qgrs, & + prsl, prsi, phii, & + prsik_1, prslk_1, tsfc, qsfc, & + phy_myj_qsfc, phy_myj_thz0, phy_myj_qz0, & + phy_myj_uz0, phy_myj_vz0, phy_myj_z0base, & + phy_myj_akhs, phy_myj_akms, & + phy_myj_chkqlm, phy_myj_elflx, & + phy_myj_a1u, phy_myj_a1t, phy_myj_a1q, & + pblh, slmsk, zorl, ustar, rib, & + cm,ch,stress,ffm,ffh,fm10,fh2, & + landfrac, oceanfrac,fice, & + z0rl_wat, z0rl_lnd, z0rl_ice, & ! intent(inout) + ustar_wat, ustar_lnd, ustar_ice, & ! intent(inout) + cm_wat, cm_lnd, cm_ice, & ! intent(inout) + ch_wat, ch_lnd, ch_ice, & ! intent(inout) + rb_wat, rb_lnd, rb_ice, & ! intent(inout) + stress_wat,stress_lnd,stress_ice, & ! intent(inout) + fm_wat, fm_lnd, fm_ice, & ! intent(inout) + fh_wat, fh_lnd, fh_ice, & ! intent(inout) + fm10_wat, fm10_lnd, fm10_ice, & ! intent(inout) + fh2_wat, fh2_lnd, fh2_ice, & ! intent(inout) + wind, con_cp, con_g, con_rd, & + me, lprnt, errmsg, errflg ) ! intent(inout) ! use MODULE_SF_JSFC, only: JSFC_INIT,JSFC @@ -106,41 +106,41 @@ SUBROUTINE myjsfc_wrapper_run( & !MYJ-2D logical,dimension(:),intent(in) :: flag_iter real(kind=kind_phys),dimension(:),intent(in) :: & - & prsik_1, prslk_1, tsfc, qsfc, slmsk + prsik_1, prslk_1, tsfc, qsfc, slmsk + real(kind=kind_phys),dimension(:),intent(inout),optional :: & + phy_myj_thz0, phy_myj_z0base, phy_myj_chkqlm, & + phy_myj_akhs, phy_myj_akms, phy_myj_qz0, & + phy_myj_qsfc, phy_myj_elflx, phy_myj_a1u, & + phy_myj_a1t, phy_myj_a1q, phy_myj_uz0, & + phy_myj_vz0 real(kind=kind_phys),dimension(:),intent(inout) :: & - & phy_myj_qsfc, phy_myj_thz0, phy_myj_qz0, & - & phy_myj_uz0, phy_myj_vz0, phy_myj_z0base, & - & phy_myj_akhs, phy_myj_akms, & - & phy_myj_chkqlm, phy_myj_elflx, & - & phy_myj_a1u, phy_myj_a1t, phy_myj_a1q + pblh, zorl, ustar, rib real(kind=kind_phys),dimension(:),intent(inout) :: & - & pblh, zorl, ustar, rib - real(kind=kind_phys),dimension(:),intent(inout) :: & - & cm, ch, stress, ffm, ffh, fm10, fh2 + cm, ch, stress, ffm, ffh, fm10, fh2 real(kind=kind_phys), dimension(:), intent(inout) :: & - & landfrac, oceanfrac, fice + landfrac, oceanfrac, fice real(kind=kind_phys), dimension(:), intent(inout) :: & - & z0rl_wat, z0rl_lnd, z0rl_ice, & - & ustar_wat, ustar_lnd, ustar_ice, & - & cm_wat, cm_lnd, cm_ice, & - & ch_wat, ch_lnd, ch_ice, & - & rb_wat, rb_lnd, rb_ice, & - & stress_wat,stress_lnd,stress_ice, & - & fm_wat, fm_lnd, fm_ice, & - & fh_wat, fh_lnd, fh_ice, & - & fm10_wat, fm10_lnd, fm10_ice, & - & fh2_wat, fh2_lnd, fh2_ice, & - & wind + z0rl_wat, z0rl_lnd, z0rl_ice, & + ustar_wat, ustar_lnd, ustar_ice, & + cm_wat, cm_lnd, cm_ice, & + ch_wat, ch_lnd, ch_ice, & + rb_wat, rb_lnd, rb_ice, & + stress_wat,stress_lnd,stress_ice, & + fm_wat, fm_lnd, fm_ice, & + fh_wat, fh_lnd, fh_ice, & + fm10_wat, fm10_lnd, fm10_ice, & + fh2_wat, fh2_lnd, fh2_ice, & + wind !MYJ-3D real(kind=kind_phys),dimension(:,:),intent(in) :: & phii, prsi real(kind=kind_phys),dimension(:,:),intent(in) :: & - & ugrs, vgrs, tgrs, prsl + ugrs, vgrs, tgrs, prsl !MYJ-4D real(kind=kind_phys),dimension(:,:,:),intent(in) :: & - & qgrs + qgrs !LOCAL logical :: lprnt1, lprnt2 @@ -152,13 +152,13 @@ SUBROUTINE myjsfc_wrapper_run( & sfcz,tsk,xland,mavail,rmol, & ustar1,z0,rib1,sm,pblh_myj real(kind=kfpt),dimension(im,13) :: & - & phy_f2d_myj + phy_f2d_myj real(kind=kfpt), dimension(im,levs) :: & - & u_myj, v_myj, t_myj, q_myj, th_myj, & - & cw, dz_myj, pmid, q2, exner + u_myj, v_myj, t_myj, q_myj, th_myj, & + cw, dz_myj, pmid, q2, exner real(kind=kfpt), dimension(im,levs+1) :: pint real(kind=kfpt),dimension(im) :: & - & cm1,ch1,stress1,ffm1,ffh1,wind1,ffm10,ffh2 + cm1,ch1,stress1,ffm1,ffh1,wind1,ffm10,ffh2 ! real(kind=kind_phys), dimension(im,levs,ntrac) :: & ! & qgrs_myj @@ -313,28 +313,29 @@ SUBROUTINE myjsfc_wrapper_run( & if((ntsd==0.and.iter.eq.1).or.restart)then call JSFC_INIT(ustar1,restart & - & ,1,ide,1,jde,1,kde & - & ,1,im,1,1,1,levs & - & ,1,im,1,1,1,levs) + ,1,ide,1,jde,1,kde & + ,1,im,1,1,1,levs & + ,1,im,1,1,1,levs) end if call JSFC(flag_iter,iter,me & - & ,ntsd,epsq2,sfcz,dz_myj & - & ,pmid,pint,th_myj,t_myj,q_myj,cw & - & ,u_myj,v_myj,q2,tsk & - & ,phy_f2d_myj(1:im,1),phy_f2d_myj(1:im,2) & - & ,phy_f2d_myj(1:im,3),phy_f2d_myj(1:im,4) & - & ,phy_f2d_myj(1:im,5),xland & - & ,ustar1,z0,phy_f2d_myj(1:im,6) & - & ,pblh_myj,mavail,rmol & - & ,phy_f2d_myj(1:im,7),phy_f2d_myj(1:im,8) & - & ,phy_f2d_myj(1:im,9),phy_f2d_myj(1:im,10) & - & ,rib1,cm1,ch1,stress1,ffm1,ffh1,wind1,ffm10,ffh2 & - & ,phy_f2d_myj(1:im,11),phy_f2d_myj(1:im,12) & - & ,phy_f2d_myj(1:im,13) & - & ,1,im,1,1,1,levs & - & ,1,im,1,1,1,levs & - & ,1,im,1,1,1,levs, errmsg, errflg) + ,ntsd,epsq2,sfcz,dz_myj & + ,pmid,pint,th_myj,t_myj,q_myj,cw & + ,u_myj,v_myj,q2,tsk & + ,phy_f2d_myj(1:im,1),phy_f2d_myj(1:im,2) & + ,phy_f2d_myj(1:im,3),phy_f2d_myj(1:im,4) & + ,phy_f2d_myj(1:im,5),xland & + ,ustar1,z0,phy_f2d_myj(1:im,6) & + ,pblh_myj,mavail,rmol & + ,phy_f2d_myj(1:im,7),phy_f2d_myj(1:im,8) & + ,phy_f2d_myj(1:im,9),phy_f2d_myj(1:im,10) & + ,rib1,cm1,ch1,stress1,ffm1,ffh1,wind1,ffm10,ffh2 & + ,phy_f2d_myj(1:im,11),phy_f2d_myj(1:im,12) & + ,phy_f2d_myj(1:im,13) & + ,1,im,1,1,1,levs & + ,1,im,1,1,1,levs & + ,1,im,1,1,1,levs, errmsg, errflg) + if(errflg/=0) return do i = 1, im if(flag_iter(i))then diff --git a/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta index 0ae09985e..9ea6a0ad1 100644 --- a/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta +++ b/physics/SFC_Layer/MYJ/myjsfc_wrapper.meta @@ -221,6 +221,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_thz0] standard_name = air_potential_temperature_at_top_of_viscous_sublayer long_name = potential temperat at viscous sublayer top over water @@ -229,6 +230,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_qz0] standard_name = specific_humidity_at_top_of_viscous_sublayer long_name = specific humidity at_viscous sublayer top over water @@ -237,6 +239,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_uz0] standard_name = x_wind_at_top_of_viscous_sublayer long_name = u wind component at viscous sublayer top over water @@ -245,6 +248,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_vz0] standard_name = y_wind_at_top_of_viscous_sublayer long_name = v wind component at viscous sublayer top over water @@ -253,6 +257,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_z0base] standard_name = baseline_surface_roughness_length long_name = baseline surface roughness length for momentum in mete @@ -261,6 +266,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_akhs] standard_name = heat_exchange_coefficient_for_MYJ_schemes long_name = surface heat exchange_coefficient for MYJ schemes @@ -269,6 +275,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_akms] standard_name = momentum_exchange_coefficient_for_MYJ_schemes long_name = surface momentum exchange_coefficient for MYJ schemes @@ -277,6 +284,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_chkqlm] standard_name = control_for_surface_layer_evaporation long_name = surface layer evaporation switch @@ -285,6 +293,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_elflx] standard_name = surface_upward_specific_humidity_flux_for_mellor_yamada_janjic_surface_layer_scheme long_name = kinematic surface latent heat flux @@ -293,6 +302,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_a1u] standard_name = weight_for_momentum_at_top_of_viscous_sublayer long_name = Weight for momentum at viscous layer top @@ -301,6 +311,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_a1t] standard_name = weight_for_potental_temperature_at_top_of_viscous_sublayer long_name = Weight for potental temperature at viscous layer top @@ -309,6 +320,7 @@ type = real kind = kind_phys intent = inout + optional = True [phy_myj_a1q] standard_name = weight_for_specific_humidity_at_top_of_viscous_sublayer long_name = Weight for Specfic Humidity at viscous layer top @@ -317,6 +329,7 @@ type = real kind = kind_phys intent = inout + optional = True [pblh] standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness diff --git a/physics/SFC_Layer/MYNN/module_sf_mynn.F90 b/physics/SFC_Layer/MYNN/module_sf_mynn.F90 index 3d847348d..cb066dc31 100644 --- a/physics/SFC_Layer/MYNN/module_sf_mynn.F90 +++ b/physics/SFC_Layer/MYNN/module_sf_mynn.F90 @@ -3,6 +3,8 @@ !WRF:MODEL_LAYER:PHYSICS ! !>\ingroup mynn_sfc +!> This module contain routines to calculate stability parameters, kinematic siscosity +!! in MYNN surface layer scheme MODULE module_sf_mynn !------------------------------------------------------------------- @@ -284,7 +286,7 @@ SUBROUTINE SFCLAY_mynn( & th3d,pi3d !GJF: This array must be assumed-shape since it is conditionally-allocated - REAL(kind_phys), DIMENSION( :,: ), & + REAL(kind_phys), DIMENSION( :,: ), OPTIONAL, & INTENT(IN) :: pattern_spp_sfc !=================================== ! 2D VARIABLES @@ -304,22 +306,22 @@ SUBROUTINE SFCLAY_mynn( & REAL(kind_phys), DIMENSION( ims:ime ) , & INTENT(INOUT) :: HFLX,HFX, & QFLX,QFX, & - LH, & - MOL,RMOL, & + RMOL, & QSFC, & QGH, & ZNT, & - ZOL, & - USTM, & CPM, & - CHS2, & - CQS2, & CHS, & CH, & FLHC,FLQC, & GZ1OZ0,WSPD, & PSIM,PSIH, & - WSTAR + USTM,CHS2, & + CQS2, WSTAR + REAL(kind_phys), DIMENSION( ims:ime ), & + INTENT(INOUT) :: LH, & + ZOL, & + MOL LOGICAL, DIMENSION( ims:ime ), INTENT(IN) :: & & wet, dry, icy, flag_iter @@ -607,19 +609,21 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & RMOL REAL(kind_phys), DIMENSION( ims:ime ), & INTENT(INOUT) :: HFLX,QFLX, & - LH,MOL, & QGH,QSFC, & ZNT, & - ZOL, & CPM, & - CHS2,CQS2, & CHS,CH, & FLHC,FLQC, & GZ1OZ0, & WSPD, & PSIM, & PSIH, & - USTM + USTM, & + CHS2,CQS2 + REAL(kind_phys), DIMENSION( ims:ime ), & + INTENT(INOUT) :: MOL, & + ZOL, & + LH LOGICAL, DIMENSION( ims:ime ), INTENT(IN) :: & & wet, dry, icy, flag_iter @@ -656,8 +660,9 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & !-------------------------------------------- !JOE-additinal output REAL(kind_phys), DIMENSION( ims:ime ), & - & INTENT(OUT) :: wstar, & - & qstar + & INTENT(OUT) :: qstar, & + wstar + !JOE-end ! CCPP error handling @@ -1340,6 +1345,8 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, & ELSEIF ( ISFTCFLX .EQ. 4 ) THEN !GFS zt formulation CALL GFS_zt_wat(ZT_wat(i),ZNTstoch_wat(i),restar,WSPD(i),ZA(i),sfc_z0_type,device_errmsg,device_errflg) + if(errflg/=0) return + ZQ_wat(i)=ZT_wat(i) ENDIF ELSE @@ -2625,8 +2632,6 @@ SUBROUTINE zilitinkevich_1995(Z_0,Zt,Zq,restar,ustar,KARMAN,& ENDIF - return - END SUBROUTINE zilitinkevich_1995 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2658,8 +2663,6 @@ SUBROUTINE davis_etal_2008(Z_0,ustar) Z_0 = MAX( Z_0, 1.27e-7_kind_phys) !These max/mins were suggested by Z_0 = MIN( Z_0, 2.85e-3_kind_phys) !Davis et al. (2008) - return - END SUBROUTINE davis_etal_2008 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2684,8 +2687,6 @@ SUBROUTINE Taylor_Yelland_2001(Z_0,ustar,wsp10) Z_0 = MAX( Z_0, 1.27e-7_kind_phys) !These max/mins were suggested by Z_0 = MIN( Z_0, 2.85e-3_kind_phys) !Davis et al. (2008) - return - END SUBROUTINE Taylor_Yelland_2001 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2709,8 +2710,6 @@ SUBROUTINE charnock_1955(Z_0,ustar,wsp10,visc,zu) Z_0 = MAX( Z_0, 1.27e-7_kind_phys) !These max/mins were suggested by Z_0 = MIN( Z_0, 2.85e-3_kind_phys) !Davis et al. (2008) - return - END SUBROUTINE charnock_1955 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2736,8 +2735,6 @@ SUBROUTINE edson_etal_2013(Z_0,ustar,wsp10,visc,zu) Z_0 = MAX( Z_0, 1.27e-7_kind_phys) !These max/mins were suggested by Z_0 = MIN( Z_0, 2.85e-3_kind_phys) !Davis et al. (2008) - return - END SUBROUTINE edson_etal_2013 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2769,8 +2766,6 @@ SUBROUTINE garratt_1992(Zt,Zq,Z_0,Ren,landsea) Zt = Zq ENDIF - return - END SUBROUTINE garratt_1992 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2817,8 +2812,6 @@ SUBROUTINE fairall_etal_2003(Zt,Zq,Ren,ustar,visc,rstoch,spp_sfc) Zq = MIN(Zt,1.0e-4_kind_phys) Zq = MAX(Zt,2.0e-9_kind_phys) - return - END SUBROUTINE fairall_etal_2003 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2846,8 +2839,6 @@ SUBROUTINE fairall_etal_2014(Zt,Zq,Ren,ustar,visc,rstoch,spp_sfc) Zq = MAX(Zt,2.0e-9_kind_phys) ENDIF - return - END SUBROUTINE fairall_etal_2014 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -2904,8 +2895,6 @@ SUBROUTINE Yang_2008(Z_0,Zt,Zq,ustar,tstar,qst,Ren,visc) Zt = MIN(Zt, Z_0/2.0) Zq = MIN(Zq, Z_0/2.0) - return - END SUBROUTINE Yang_2008 !-------------------------------------------------------------------- ! Taken from the GFS (sfc_diff.f) for comparison @@ -3104,7 +3093,7 @@ SUBROUTINE GFS_zt_wat(ztmax,z0rl_wat,restar,WSPD,z1,sfc_z0_type,device_errmsg,de else if (sfc_z0_type == 7) then call znot_t_v7(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type > 0) then - write(0,*)'no option for sfc_z0_type=',sfc_z0_type + write(0,*)'not a valid option for sfc_z0_type=',sfc_z0_type ! errflg = 1 ! errmsg = 'ERROR(GFS_zt_wat): sfc_z0_type not valid.' device_errflg = 1 @@ -3167,19 +3156,18 @@ SUBROUTINE znot_m_v6(uref, znotm) END SUBROUTINE znot_m_v6 !-------------------------------------------------------------------- !>\ingroup mynn_sfc -!! - SUBROUTINE znot_t_v6(uref, znott) - - !$acc routine seq - IMPLICIT NONE -!> Calculate scalar roughness over water with input 10-m wind +!> Calculate scalar roughness over water with input 10-m wind !! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm !! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF !! !!\author Bin Liu, NOAA/NCEP/EMC 2017 -! +! ! uref(m/s) : wind speed at 10-m height ! znott(meter): scalar roughness scale over water + SUBROUTINE znot_t_v6(uref, znott) + + !$acc routine seq + IMPLICIT NONE ! REAL(kind_phys), INTENT(IN) :: uref REAL(kind_phys), INTENT(OUT):: znott @@ -3234,17 +3222,16 @@ END SUBROUTINE znot_t_v6 !------------------------------------------------------------------- !>\ingroup mynn_sfc -!! - SUBROUTINE znot_m_v7(uref, znotm) - - !$acc routine seq - IMPLICIT NONE !> Calculate areodynamical roughness over water with input 10-m wind !! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) !! For high winds, try to fit available observational data !! Comparing to znot_t_v6, slightly decrease Cd for higher wind speed -!! +!! !!\author Bin Liu, NOAA/NCEP/EMC 2018 + SUBROUTINE znot_m_v7(uref, znotm) + + !$acc routine seq + IMPLICIT NONE ! ! uref(m/s) : wind speed at 10-m height ! znotm(meter): areodynamical roughness scale over water @@ -3284,17 +3271,16 @@ SUBROUTINE znot_m_v7(uref, znotm) END SUBROUTINE znot_m_v7 !-------------------------------------------------------------------- !>\ingroup mynn_sfc -!! - SUBROUTINE znot_t_v7(uref, znott) - - !$acc routine seq - IMPLICIT NONE !> Calculate scalar roughness over water with input 10-m wind !! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm !! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF !! To be compatible with the slightly decreased Cd for higher wind speed -!! +!! !!\author Bin Liu, NOAA/NCEP/EMC 2018 + SUBROUTINE znot_t_v7(uref, znott) + + !$acc routine seq + IMPLICIT NONE ! ! uref(m/s) : wind speed at 10-m height ! znott(meter): scalar roughness scale over water @@ -3400,8 +3386,6 @@ SUBROUTINE Andreas_2002(Z_0,bvisc,ustar,Zt,Zq) ENDIF - return - END SUBROUTINE Andreas_2002 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3436,8 +3420,6 @@ SUBROUTINE PSI_Hogstrom_1996(psi_m, psi_h, zL, Zt, Z_0, Za) ENDIF - return - END SUBROUTINE PSI_Hogstrom_1996 !-------------------------------------------------------------------- !> \ingroup mynn_sfc @@ -3475,8 +3457,6 @@ SUBROUTINE PSI_DyerHicks(psi_m, psi_h, zL, Zt, Z_0, Za) ENDIF - return - END SUBROUTINE PSI_DyerHicks !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3506,8 +3486,6 @@ SUBROUTINE PSI_Beljaars_Holtslag_1991(psi_m, psi_h, zL) ENDIF - return - END SUBROUTINE PSI_Beljaars_Holtslag_1991 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3537,8 +3515,6 @@ SUBROUTINE PSI_Zilitinkevich_Esau_2007(psi_m, psi_h, zL) ENDIF - return - END SUBROUTINE PSI_Zilitinkevich_Esau_2007 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3569,8 +3545,6 @@ SUBROUTINE PSI_Businger_1971(psi_m, psi_h, zL) ENDIF - return - END SUBROUTINE PSI_Businger_1971 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3602,8 +3576,6 @@ SUBROUTINE PSI_Suselj_Sood_2010(psi_m, psi_h, zL) ENDIF - return - END SUBROUTINE PSI_Suselj_Sood_2010 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3621,8 +3593,6 @@ SUBROUTINE PSI_CB2005(psim1,psih1,zL,z0L) psih1 = -5.5*log(zL + (1.+ zL**1.1)**0.90909090909) & -5.5*log(z0L + (1.+ z0L**1.1)**0.90909090909) - return - END SUBROUTINE PSI_CB2005 !-------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3686,8 +3656,6 @@ SUBROUTINE Li_etal_2010(zL, Rib, zaz0, z0zt) zL = MAX(zL,1._kind_phys) ENDIF - return - END SUBROUTINE Li_etal_2010 !------------------------------------------------------------------- !>\ingroup mynn_sfc @@ -3743,7 +3711,6 @@ REAL(kind_phys) function zolri(ri,za,z0,zt,zol1,psi_opt) !print*,"SUCCESS,n=",n," Ri=",ri," z0=",z0 endif - return end function !------------------------------------------------------------------- REAL(kind_phys) function zolri2(zol2,ri2,za,z0,zt,psi_opt) @@ -3784,7 +3751,6 @@ REAL(kind_phys) function zolri2(zol2,ri2,za,z0,zt,psi_opt) zolri2=zol2*psit2/psix2**2 - ri2 !print*," target ri=",ri2," est ri=",zol2*psit2/psix2**2 - return end function !==================================================================== @@ -3861,7 +3827,6 @@ REAL(kind_phys) function zolrib(ri,za,z0,zt,logz0,logzt,zol1,psi_opt) !print*,"SUCCESS,n=",n," Ri=",ri," z0=",z0 endif - return end function !==================================================================== !>\ingroup mynn_sfc @@ -3921,7 +3886,6 @@ real(kind_phys) function psim_stable_full(zolf) !psim_stable_full=-6.1*log(zolf+(1+zolf**2.5)**(1./2.5)) psim_stable_full=-6.1*log(zolf+(1+zolf**2.5)**0.4) - return end function !>\ingroup mynn_sfc @@ -3932,7 +3896,6 @@ real(kind_phys) function psih_stable_full(zolf) !psih_stable_full=-5.3*log(zolf+(1+zolf**1.1)**(1./1.1)) psih_stable_full=-5.3*log(zolf+(1+zolf**1.1)**0.9090909090909090909) - return end function !>\ingroup mynn_sfc @@ -3951,7 +3914,6 @@ real(kind_phys) function psim_unstable_full(zolf) psim_unstable_full=(psimk+zolf**2*(psimc))/(1+zolf**2.) - return end function !>\ingroup mynn_sfc @@ -3969,7 +3931,6 @@ real(kind_phys) function psih_unstable_full(zolf) psih_unstable_full=(psihk+zolf**2*(psihc))/(1+zolf**2) - return end function ! ================================================================== @@ -3986,7 +3947,6 @@ REAL(kind_phys) function psim_stable_full_gfs(zolf) aa = sqrt(1. + alpha4 * zolf) psim_stable_full_gfs = -1.*aa + log(aa + 1.) - return end function !>\ingroup mynn_sfc @@ -4000,7 +3960,6 @@ real(kind_phys) function psih_stable_full_gfs(zolf) bb = sqrt(1. + alpha4 * zolf) psih_stable_full_gfs = -1.*bb + log(bb + 1.) - return end function !>\ingroup mynn_sfc @@ -4021,7 +3980,6 @@ real(kind_phys) function psim_unstable_full_gfs(zolf) psim_unstable_full_gfs = log(hl1) + 2. * sqrt(tem1) - .8776 end if - return end function !>\ingroup mynn_sfc @@ -4042,7 +4000,6 @@ real(kind_phys) function psih_unstable_full_gfs(zolf) psih_unstable_full_gfs = log(hl1) + .5 * tem1 + 1.386 end if - return end function !>\ingroup mynn_sfc @@ -4064,7 +4021,6 @@ real(kind_phys) function psim_stable(zolf,psi_opt) endif endif - return end function !>\ingroup mynn_sfc @@ -4085,7 +4041,6 @@ real(kind_phys) function psih_stable(zolf,psi_opt) endif endif - return end function !>\ingroup mynn_sfc @@ -4106,7 +4061,6 @@ real(kind_phys) function psim_unstable(zolf,psi_opt) endif endif - return end function !>\ingroup mynn_sfc @@ -4127,7 +4081,6 @@ real(kind_phys) function psih_unstable(zolf,psi_opt) endif endif - return end function !======================================================================== diff --git a/physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90 b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90 index 3c033e65e..9239dcf4e 100644 --- a/physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90 +++ b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.F90 @@ -1,6 +1,7 @@ !> \file mynnsfc_wrapper.F90 -!! Contains all of the code related to running the MYNN surface layer scheme +!! +!> This Model ontains all of the code related to running the MYNN surface layer scheme MODULE mynnsfc_wrapper USE module_sf_mynn @@ -135,7 +136,7 @@ SUBROUTINE mynnsfc_wrapper_run( & integer, dimension(:), intent(in) :: vegtype real(kind_phys), dimension(:), intent(in) :: & & sigmaf,shdmax,z0pert,ztpert - real(kind_phys), dimension(:,:), intent(in) :: & + real(kind_phys), dimension(:,:), intent(in), optional :: & & spp_wts_sfc real(kind_phys), dimension(:,:), & @@ -168,15 +169,16 @@ SUBROUTINE mynnsfc_wrapper_run( & !MYNN-2D real(kind_phys), dimension(:), intent(in) :: & - & dx, pblh, slmsk, ps, & + & dx, pblh, slmsk, ps + real(kind_phys), dimension(:), intent(in),optional :: & & qsfc_lnd_ruc, qsfc_ice_ruc real(kind_phys), dimension(:), intent(inout) :: & - & ustm, hflx, qflx, wspd, qsfc, & + & hflx, qflx, wspd, qsfc, & & FLHC, FLQC, U10, V10, TH2, T2, Q2, & - & CHS2, CQS2, rmol, zol, mol, ch, & - & lh, wstar - !LOCAL + & rmol, ch, ustm, wstar, CHS2, CQS2, & + & zol, mol, lh + !LOCAL real(kind_phys), dimension(im) :: & & hfx, znt, psim, psih, & & chs, ck, cd, mavail, xland, GZ1OZ0, & diff --git a/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta index 0e1c96c02..89bf1d840 100644 --- a/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta +++ b/physics/SFC_Layer/MYNN/mynnsfc_wrapper.meta @@ -702,6 +702,7 @@ type = real kind = kind_phys intent = in + optional = True [qsfc_ice_ruc] standard_name = water_vapor_mixing_ratio_at_surface_over_ice long_name = water vapor mixing ratio at surface over ice @@ -710,6 +711,7 @@ type = real kind = kind_phys intent = in + optional = True [ustm] standard_name = surface_friction_velocity_for_momentum long_name = friction velocity isolated for momentum only @@ -870,6 +872,7 @@ type = real kind = kind_phys intent = in + optional = True [spp_sfc] standard_name = control_for_surface_layer_spp_perturbations long_name = control for surface layer spp perturbations diff --git a/physics/SFC_Layer/UFS/date_def.f b/physics/SFC_Layer/UFS/date_def.f index fceb4334f..958d8b8b9 100644 --- a/physics/SFC_Layer/UFS/date_def.f +++ b/physics/SFC_Layer/UFS/date_def.f @@ -1,3 +1,5 @@ +!>\file date_def.f +!! module date_def use machine, ONLY: kind_phys implicit none diff --git a/physics/SFC_Layer/UFS/module_nst_parameters.f90 b/physics/SFC_Layer/UFS/module_nst_parameters.f90 index 5308345e2..984335cc8 100644 --- a/physics/SFC_Layer/UFS/module_nst_parameters.f90 +++ b/physics/SFC_Layer/UFS/module_nst_parameters.f90 @@ -4,11 +4,12 @@ !>\defgroup nst_parameters GFS NSST Parameter Module !! \ingroup gfs_nst_main_mod -!! This module contains constants and parameters used in GFS + +!> This module contains constants and parameters used in GFS !! near surface sea temperature scheme. -!! history: -!! 20210305: X.Li, reduce z_w_max from 30 m to 20 m module module_nst_parameters +! history: +! 20210305: X.Li, reduce z_w_max from 30 m to 20 m use machine, only : kind_phys ! diff --git a/physics/SFC_Layer/UFS/module_nst_water_prop.f90 b/physics/SFC_Layer/UFS/module_nst_water_prop.f90 index 858659e90..f71c35e8b 100644 --- a/physics/SFC_Layer/UFS/module_nst_water_prop.f90 +++ b/physics/SFC_Layer/UFS/module_nst_water_prop.f90 @@ -1,10 +1,10 @@ - !>\file module_nst_water_prop.f90 !! This file contains GFS NSST water property subroutines. !>\defgroup waterprop GFS NSST Water Property -!!This module contains GFS NSST water property subroutines. !!\ingroup gfs_nst_main_mod + +!> This module contains GFS NSST water property subroutines. module module_nst_water_prop use machine , only : kind_phys use module_nst_parameters , only : t0k, zero, one, half diff --git a/physics/SFC_Layer/UFS/sfc_diag.f b/physics/SFC_Layer/UFS/sfc_diag.f index 768814e8c..4c019f433 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.f +++ b/physics/SFC_Layer/UFS/sfc_diag.f @@ -1,22 +1,20 @@ !> \file sfc_diag.f !! This file contains the land surface diagnose calculation scheme. +!> This module contains the land surface diagnose calcualtion module sfc_diag contains !> \defgroup sfc_diag_mod GFS sfc_diag module -!! This module contains the land surface diagose calculation. -!> @{ !! \section arg_table_sfc_diag_run Argument Table !! \htmlinclude sfc_diag_run.html !! -!! \section general General Algorithm -!! \section detailed Detailed Algorithm -!! @{ +!> @{ subroutine sfc_diag_run (im,xlat_d,xlon_d, & & lsm,lsm_ruc,grav,cp,eps,epsm1,con_rocp, & & con_karman, & & shflx,cdq,wind, & + & usfco,vsfco,use_oceanuv, & & zf,ps,u1,v1,t1,q1,prslki,evap,fm,fh,fm10,fh2, & & ust,tskin,qsurf,thsfc_loc,diag_flux,diag_log, & & use_lake_model,iopt_lake,iopt_lake_clm, & @@ -31,6 +29,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & ! integer, intent(in) :: im, lsm, lsm_ruc, iopt_lake, iopt_lake_clm logical, intent(in) :: use_lake2m + logical, intent(in) :: use_oceanuv logical, intent(in) :: thsfc_loc ! Flag for reference pot. temp. logical, intent(in) :: diag_flux ! Flag for flux method in 2-m diagnostics logical, intent(in) :: diag_log ! Flag for 2-m log diagnostics under stable conditions @@ -38,12 +37,13 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & real(kind=kind_phys), intent(in) :: con_karman real(kind=kind_phys), dimension(:), intent( in) :: & & zf, ps, u1, v1, t1, q1, ust, tskin, & + & usfco, vsfco, & & qsurf, prslki, evap, fm, fh, fm10, fh2, & & shflx, cdq, wind, xlat_d, xlon_d real(kind=kind_phys), dimension(:), intent(out) :: & - & f10m, u10m, v10m, t2m, q2m, dpt2m - real(kind=kind_phys), dimension(:), intent(in) :: lake_t2m, & - & lake_q2m + & f10m, u10m, v10m, t2m, q2m, dpt2m + real(kind=kind_phys), dimension(:), intent(in), optional :: & + & lake_t2m, lake_q2m integer, dimension(:), intent(in) :: use_lake_model character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -73,7 +73,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & errflg = 0 !-- - testptlat = 35.3_kind_phys + testptlat = 35.3_kind_phys testptlon = 273.0_kind_phys !-- debug_print = .false. @@ -89,8 +89,14 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & do i = 1, im f10m(i) = fm10(i) / fm(i) - u10m(i) = f10m(i) * u1(i) - v10m(i) = f10m(i) * v1(i) + if (use_oceanuv) then + u10m(i) = usfco(i)+f10m(i) * (u1(i)-usfco(i)) + v10m(i) = vsfco(i)+f10m(i) * (v1(i)-vsfco(i)) + else + u10m(i) = f10m(i) * u1(i) + v10m(i) = f10m(i) * v1(i) + endif + have_2m = use_lake_model(i)>0 .and. use_lake2m .and. & & iopt_lake==iopt_lake_clm if(have_2m) then @@ -176,9 +182,9 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & !no alternatives (yet) for unstable conditions Q2_alt = q2m(i) ENDIF - !-- Note: use of alternative diagnostics will make + !-- Note: use of alternative diagnostics will make ! it cooler and drier with stable stratification - t2m(i) = T2_alt + t2m(i) = T2_alt q2m(i) = Q2_alt endif ! log method for stable regime @@ -211,7 +217,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & dpt2m(i) = 243.5_kind_dbl_prec/( ( 17.67_kind_dbl_prec / & & log(tem/611.2_kind_dbl_prec) ) - one) + con_t0c dpt2m(i) = min(dpt2m(i),t2m(i)) - + if (debug_print) then !-- diagnostics for a test point with known lat/lon diff --git a/physics/SFC_Layer/UFS/sfc_diag.meta b/physics/SFC_Layer/UFS/sfc_diag.meta index f4f83ab04..e556e03ba 100644 --- a/physics/SFC_Layer/UFS/sfc_diag.meta +++ b/physics/SFC_Layer/UFS/sfc_diag.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_diag type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = tools/funcphys.f90,hooks/machine.F,hooks/physcons.F90 ######################################################################## @@ -124,6 +124,29 @@ type = real kind = kind_phys intent = in +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[use_oceanuv] + standard_name = do_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = flag + dimensions = () + type = logical + intent = in [t1] standard_name = air_temperature_at_surface_adjacent_layer long_name = 1st model layer air temperature @@ -195,7 +218,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = in [tskin] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -248,6 +271,7 @@ type = real kind = kind_phys intent = in + optional = True [diag_flux] standard_name = flag_for_flux_method_in_2m_diagnostics long_name = flag for flux method in 2-m diagnostics @@ -278,6 +302,7 @@ type = real kind = kind_phys intent = in + optional = True [cdq] standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air long_name = surface exchange coeff heat & moisture @@ -291,7 +316,7 @@ long_name = model 2m diagnostics use the temperature and humidity calculated by the lake model units = flag dimensions = () - type = integer + type = logical intent = in [wind] standard_name = wind_speed_at_lowest_model_layer diff --git a/physics/SFC_Layer/UFS/sfc_diag_post.F90 b/physics/SFC_Layer/UFS/sfc_diag_post.F90 index 6945e48e9..72755c6f3 100644 --- a/physics/SFC_Layer/UFS/sfc_diag_post.F90 +++ b/physics/SFC_Layer/UFS/sfc_diag_post.F90 @@ -1,12 +1,12 @@ !> \file sfc_diag_post.F90 !! Contains code related to the surface diagnostic scheme. +!> This module contains code related to the surface diagnostic scheme. module sfc_diag_post contains !>\defgroup sfc_diag_post_mod GFS sfc_diag_post Module -!! This module contains code related to the surface diagnostic scheme. !> @{ #if 0 !> \section arg_table_sfc_diag_post_run Argument Table @@ -14,7 +14,7 @@ module sfc_diag_post !! #endif subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, opt_diag, dry, lssav, dtf, con_eps, con_epsm1, pgr,& - vegtype,t2mmp,q2mp, t2m, q2m, u10m, v10m, tmpmin, tmpmax, spfhmin, spfhmax, & + t2mmp,q2mp, t2m, q2m, u10m, v10m, tmpmin, tmpmax, spfhmin, spfhmax, & wind10mmax, u10mmax, v10mmax, dpt2m, errmsg, errflg) use machine, only: kind_phys, kind_dbl_prec @@ -22,13 +22,12 @@ subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, opt_diag, dry, lssav, dtf, co implicit none integer, intent(in) :: im, lsm, lsm_noahmp,opt_diag - integer, dimension(:), intent(in) :: vegtype ! vegetation type (integer index) logical, intent(in) :: lssav real(kind=kind_phys), intent(in) :: dtf, con_eps, con_epsm1 logical , dimension(:), intent(in) :: dry real(kind=kind_phys), dimension(:), intent(in) :: pgr, u10m, v10m real(kind=kind_phys), dimension(:), intent(inout) :: t2m, q2m, tmpmin, tmpmax, spfhmin, spfhmax - real(kind=kind_phys), dimension(:), intent(inout) :: t2mmp, q2mp + real(kind=kind_phys), dimension(:), intent(in), optional :: t2mmp, q2mp real(kind=kind_phys), dimension(:), intent(inout) :: wind10mmax, u10mmax, v10mmax, dpt2m character(len=*), intent(out) :: errmsg @@ -42,17 +41,6 @@ subroutine sfc_diag_post_run (im, lsm, lsm_noahmp, opt_diag, dry, lssav, dtf, co errflg = 0 if (lsm == lsm_noahmp) then -! over shrublands use opt_diag=2 - do i=1, im - if(dry(i)) then - if (vegtype(i) == 6 .or. vegtype(i) == 7 & - .or. vegtype(i) == 16) then - t2m(i) = t2mmp(i) - q2m(i) = q2mp(i) - endif - endif - enddo - if (opt_diag == 2 .or. opt_diag == 3) then do i=1,im if(dry(i)) then diff --git a/physics/SFC_Layer/UFS/sfc_diag_post.meta b/physics/SFC_Layer/UFS/sfc_diag_post.meta index 4abb3bac0..840b2113a 100644 --- a/physics/SFC_Layer/UFS/sfc_diag_post.meta +++ b/physics/SFC_Layer/UFS/sfc_diag_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_diag_post type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F ######################################################################## @@ -82,13 +82,6 @@ type = real kind = kind_phys intent = in -[vegtype] - standard_name = vegetation_type_classification - long_name = vegetation type at each grid cell - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent= in [t2mmp] standard_name = temperature_at_2m_from_noahmp long_name = 2 meter temperature from noahmp @@ -96,7 +89,8 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = in + optional = True [q2mp] standard_name = specific_humidity_at_2m_from_noahmp long_name = 2 meter specific humidity from noahmp @@ -104,7 +98,8 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = in + optional = True [t2m] standard_name = air_temperature_at_2m long_name = 2 meter temperature diff --git a/physics/SFC_Layer/UFS/sfc_diff.f b/physics/SFC_Layer/UFS/sfc_diff.f index 5dd6525f9..1087fa942 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.f +++ b/physics/SFC_Layer/UFS/sfc_diff.f @@ -60,8 +60,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) - & flag_lakefreeze, & !intent(in) + & flag_lakefreeze,lakefrac,fice, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) + & u1,v1,usfco,vsfco,use_oceanuv, & & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) @@ -86,22 +87,27 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) integer, parameter :: kp = kind_phys integer, intent(in) :: im, ivegsrc integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean + logical, intent(in) :: use_oceanuv ! option for including ocean current in the computation of flux integer, dimension(:), intent(in) :: vegtype logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy - logical, dimension(:), intent(in) :: flag_lakefreeze + logical, dimension(:), intent(in) :: flag_lakefreeze logical, dimension(:), intent(inout) :: wet logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation real(kind=kind_phys), dimension(:), intent(in) :: u10m,v10m + real(kind=kind_phys), dimension(:), intent(in) :: u1,v1 + real(kind=kind_phys), dimension(:), intent(in) :: usfco,vsfco real(kind=kind_phys), intent(in) :: rvrdm1, eps, epsm1, grav real(kind=kind_phys), dimension(:), intent(in) :: & & ps,t1,q1,z1,garea,prsl1,prslki,prsik1,prslk1, & & wind,sigmaf,shdmax, & & z0pert,ztpert ! mg, sfc-perts + real(kind=kind_phys), dimension(:), intent(in) :: lakefrac + real(kind=kind_phys), dimension(:), intent(in) :: fice real(kind=kind_phys), dimension(:), intent(in) :: & & tskin_wat, tskin_lnd, tskin_ice, & & tsurf_wat, tsurf_lnd, tsurf_ice @@ -127,6 +133,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! locals ! integer i + real(kind=kind_phys) :: windrel ! real(kind=kind_phys) :: rat, tv1, thv1, restar, wind10m, & czilc, tem1, tem2, virtfac @@ -291,7 +298,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) tvs = half * (tsurf_ice(i)+tskin_ice(i)) * virtfac else ! Use potential temperature referenced to 1000 hPa tvs = half * (tsurf_ice(i)+tskin_ice(i))/prsik1(i) - & * virtfac + & * virtfac endif z0max = max(zmin, min(0.01_kp * z0rl_ice(i), z1(i))) @@ -335,13 +342,13 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! --- outputs: & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) - endif ! Icy points + endif ! Icy points ! BWG: Everything from here to end of subroutine was after ! the stuff now put into "stability" if (wet(i)) then ! Some open ocean - + zvfun(i) = zero if(thsfc_loc) then ! Use local potential temperature @@ -350,23 +357,17 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) tvs = half * (tsurf_wat(i)+tskin_wat(i))/prsik1(i) & * virtfac endif -! - wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) -! - if (sfc_z0_type == -1) then ! using wave model derived momentum roughness - tem1 = 0.11 * vis / ustar_wat(i) - z0 = tem1 + 0.01_kp * z0rl_wav(i) - if (redrag) then - z0max = max(min(z0, z0s_max),1.0e-7_kp) - else - z0max = max(min(z0,0.1_kp), 1.0e-7_kp) - endif - z0rl_wat(i) = 100.0_kp * z0max ! cm + if (use_oceanuv) then + wind10m=sqrt((u10m(i)-usfco(i))**2+(v10m(i)-vsfco(i))**2) + windrel=sqrt((u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2) else - z0 = 0.01_kp * z0rl_wat(i) - z0max = max(zmin, min(z0,z1(i))) + wind10m=sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) + windrel=wind(i) endif + + z0 = 0.01_kp * z0rl_wat(i) + z0max = max(zmin, min(z0,z1(i))) ! !** test xubin's new z0 @@ -397,7 +398,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! call stability ! --- inputs: - & (z1(i), zvfun(i), gdx, tv1, thv1, wind(i), + & (z1(i), zvfun(i), gdx, tv1, thv1, windrel, & z0max, ztmax_wat(i), tvs, grav, thsfc_loc, ! --- outputs: & rb_wat(i), fm_wat(i), fh_wat(i), fm10_wat(i), fh2_wat(i), @@ -405,58 +406,56 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ! update z0 over ocean ! - if (sfc_z0_type >= 0) then - if (sfc_z0_type == 0) then -! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) - tem1 = 0.11 * vis / ustar_wat(i) - z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) + if ((sfc_z0_type == -1) .and. + & (lakefrac(i) == 0.0 .and. fice(i) == 0.0) .and. + & (z0rl_wav(i)>1.0e-7_kp .and. z0rl_wav(i)<0.1_kp)) then + ! using wave model derived momentum roughness + tem1 = 0.11 * vis / ustar_wat(i) + z0 = tem1 + 0.01_kp * z0rl_wav(i) + + if (redrag) then + z0rl_wat(i) = 100.0_kp * max(min(z0,z0s_max),1.0e-7_kp) + else + z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.e-7_kp) + endif + + elseif ((sfc_z0_type == 0) .or. + & ((sfc_z0_type == -1) .and. + & (z0rl_wav(i)<=1.0e-7_kp .or. z0rl_wav(i)>=0.1_kp))) then +! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) + tem1 = 0.11 * vis / ustar_wat(i) + z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) ! mbek -- toga-coare flux algorithm -! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) +! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) ! new implementation of z0 -! cc = ustar(i) * z0 / rnu -! pp = cc / (1. + cc) -! ff = grav * arnu / (charnock * ustar(i) ** 3) -! z0 = arnu / (ustar(i) * ff ** pp) - - if (redrag) then - z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max), & - & 1.0e-7_kp) - else - z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.e-7_kp) - endif - - elseif (sfc_z0_type == 6) then ! wang - call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m - z0rl_wat(i) = 100.0_kp * z0 ! cm - elseif (sfc_z0_type == 7) then ! wang - call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m - z0rl_wat(i) = 100.0_kp * z0 ! cm +! cc = ustar(i) * z0 / rnu +! pp = cc / (1. + cc) +! ff = grav * arnu / (charnock * ustar(i) ** 3) +! z0 = arnu / (ustar(i) * ff ** pp) + + if (redrag) then + z0rl_wat(i) = 100.0_kp * max(min(z0,z0s_max),1.0e-7_kp) else - z0rl_wat(i) = 1.0e-4_kp + z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.e-7_kp) endif - elseif (z0rl_wav(i) <= 1.0e-7_kp .or. - & z0rl_wav(i) > 1.0_kp) then -! z0 = (charnock / grav) * ustar_wat(i) * ustar_wat(i) - tem1 = 0.11 * vis / ustar_wat(i) - z0 = tem1 + (charnock/grav)*ustar_wat(i)*ustar_wat(i) - - if (redrag) then - z0rl_wat(i) = 100.0_kp * max(min(z0, z0s_max),1.0e-7_kp) - else - z0rl_wat(i) = 100.0_kp * max(min(z0,0.1_kp), 1.0e-7_kp) - endif - + elseif (sfc_z0_type == 6) then ! wang + call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m + z0rl_wat(i) = 100.0_kp * z0 ! cm + elseif (sfc_z0_type == 7) then ! wang + call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m + z0rl_wat(i) = 100.0_kp * z0 ! cm + else + z0rl_wat(i) = 1.0e-4_kp endif - +! endif ! end of if(open ocean) ! endif ! end of if(flagiter) loop enddo - return end subroutine sfc_diff_run !---------------------------------------- @@ -500,8 +499,8 @@ subroutine stability & z1i = one / z1 ! -! set background diffusivities with one for gdx >= xkgdx and -! as a function of horizontal grid size for gdx < xkgdx +! set background diffusivities with one for gdx >= xkgdx and +! as a function of horizontal grid size for gdx < xkgdx ! (i.e., gdx/xkgdx for gdx < xkgdx) ! if(gdx >= xkgdx) then @@ -631,15 +630,13 @@ subroutine stability & stress = cm * wind * wind ustar = sqrt(stress) - return !................................. end subroutine stability !--------------------------------- -!! add fitted z0,zt curves for hurricane application (used in HWRF/HMON) +!> add fitted z0,zt curves for hurricane application (used in HWRF/HMON) !! Weiguo Wang, 2019-0425 - SUBROUTINE znot_m_v6(uref, znotm) use machine , only : kind_phys IMPLICIT NONE @@ -648,7 +645,7 @@ SUBROUTINE znot_m_v6(uref, znotm) ! For high winds, try to fit available observational data ! ! Bin Liu, NOAA/NCEP/EMC 2017 -! +! ! uref(m/s) : wind speed at 10-m height ! znotm(meter): areodynamical roughness scale over water ! @@ -668,10 +665,10 @@ SUBROUTINE znot_m_v6(uref, znotm) & p31 = 1.255457892775006e+00, p30 = -1.663993561652530e+01, & p40 = 4.579369142033410e-04 - + if (uref >= 0.0 .and. uref <= 6.5 ) then - znotm = exp(p10 + uref * (p11 + uref * (p12 + uref*p13))) + znotm = exp(p10 + uref * (p11 + uref * (p12 + uref*p13))) elseif (uref > 6.5 .and. uref <= 15.7) then znotm = p20 + uref * (p21 + uref * (p22 + uref * (p23 & + uref * (p24 + uref * p25)))) @@ -686,18 +683,19 @@ SUBROUTINE znot_m_v6(uref, znotm) END SUBROUTINE znot_m_v6 +!> Calculate scalar roughness over water with input 10-m wind +!! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm +!! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF +!! +!! Bin Liu, NOAA/NCEP/EMC 2017 +! +!! uref(m/s) : wind speed at 10-m height +!! znott(meter): scalar roughness scale over water SUBROUTINE znot_t_v6(uref, znott) use machine , only : kind_phys IMPLICIT NONE -! Calculate scalar roughness over water with input 10-m wind -! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm -! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF -! -! Bin Liu, NOAA/NCEP/EMC 2017 -! -! uref(m/s) : wind speed at 10-m height -! znott(meter): scalar roughness scale over water -! + + REAL(kind=kind_phys), INTENT(IN) :: uref REAL(kind=kind_phys), INTENT(OUT):: znott @@ -731,16 +729,16 @@ SUBROUTINE znot_t_v6(uref, znott) znott = p10 + uref * (p11 + uref * (p12 + uref * (p13 & + uref * (p14 + uref * p15)))) elseif (uref > 15.4 .and. uref <= 21.6) then - znott = p20 + uref * (p21 + uref * (p22 + uref * (p23 + znott = p20 + uref * (p21 + uref * (p22 + uref * (p23 & + uref * (p24 + uref * p25)))) elseif (uref > 21.6 .and. uref <= 42.2) then - znott = p30 + uref * (p31 + uref * (p32 + uref * (p33 + znott = p30 + uref * (p31 + uref * (p32 + uref * (p33 & + uref * (p34 + uref * p35)))) elseif ( uref > 42.2 .and. uref <= 53.3) then - znott = p40 + uref * (p41 + uref * (p42 + uref * (p43 + znott = p40 + uref * (p41 + uref * (p42 + uref * (p43 & + uref * (p44 + uref * p45)))) elseif ( uref > 53.3 .and. uref <= 80.0) then - znott = p50 + uref * (p51 + uref * (p52 + uref * (p53 + znott = p50 + uref * (p51 + uref * (p52 + uref * (p53 & + uref * (p54 + uref * (p55 + uref * p56))))) elseif ( uref > 80.0) then znott = p60 @@ -751,19 +749,20 @@ SUBROUTINE znot_t_v6(uref, znott) END SUBROUTINE znot_t_v6 +!> Calculate areodynamical roughness over water with input 10-m wind +!! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) +!! For high winds, try to fit available observational data +!! Comparing to znot_t_v6, slightly decrease Cd for higher wind speed +! +!! Bin Liu, NOAA/NCEP/EMC 2018 +! +!! uref(m/s) : wind speed at 10-m height +!! znotm(meter): areodynamical roughness scale over water SUBROUTINE znot_m_v7(uref, znotm) use machine , only : kind_phys IMPLICIT NONE -! Calculate areodynamical roughness over water with input 10-m wind -! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) -! For high winds, try to fit available observational data -! Comparing to znot_t_v6, slightly decrease Cd for higher wind speed -! -! Bin Liu, NOAA/NCEP/EMC 2018 -! -! uref(m/s) : wind speed at 10-m height -! znotm(meter): areodynamical roughness scale over water -! + + REAL(kind=kind_phys), INTENT(IN) :: uref REAL(kind=kind_phys), INTENT(OUT):: znotm @@ -797,18 +796,20 @@ SUBROUTINE znot_m_v7(uref, znotm) endif END SUBROUTINE znot_m_v7 + +!> Calculate scalar roughness over water with input 10-m wind +!! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm +!! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF +!! To be compatible with the slightly decreased Cd for higher wind speed +!! +!! Bin Liu, NOAA/NCEP/EMC 2018 +!! +!! uref(m/s) : wind speed at 10-m height +!! znott(meter): scalar roughness scale over water SUBROUTINE znot_t_v7(uref, znott) use machine , only : kind_phys IMPLICIT NONE -! Calculate scalar roughness over water with input 10-m wind -! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm -! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF -! To be compatible with the slightly decreased Cd for higher wind speed -! -! Bin Liu, NOAA/NCEP/EMC 2018 -! -! uref(m/s) : wind speed at 10-m height -! znott(meter): scalar roughness scale over water + ! REAL(kind=kind_phys), INTENT(IN) :: uref diff --git a/physics/SFC_Layer/UFS/sfc_diff.meta b/physics/SFC_Layer/UFS/sfc_diff.meta index 8ca5b24e1..470b01a90 100644 --- a/physics/SFC_Layer/UFS/sfc_diff.meta +++ b/physics/SFC_Layer/UFS/sfc_diff.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_diff type = scheme - relative_path = ../../ + dependencies_path = ../../ dependencies = hooks/machine.F ######################################################################## @@ -143,6 +143,22 @@ type = real kind = kind_phys intent = in +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[fice] + standard_name = sea_ice_area_fraction_of_sea_area_fraction + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [vegtype] standard_name = vegetation_type_classification long_name = vegetation type at each grid cell @@ -218,6 +234,38 @@ type = real kind = kind_phys intent = in +[u1] + standard_name = x_wind_at_surface_adjacent_layer + long_name = x component of surface layer wind + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[v1] + standard_name = y_wind_at_surface_adjacent_layer + long_name = y component of surface layer wind + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [sfc_z0_type] standard_name = flag_for_surface_roughness_option_over_water long_name = surface roughness options over water @@ -225,6 +273,13 @@ dimensions = () type = integer intent = in +[use_oceanuv] + standard_name = do_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = flag + dimensions = () + type = logical + intent = in [wet] standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction diff --git a/physics/SFC_Layer/UFS/sfc_nst.f90 b/physics/SFC_Layer/UFS/sfc_nst.f90 index 08b1b48e4..eb84aa352 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.f90 +++ b/physics/SFC_Layer/UFS/sfc_nst.f90 @@ -26,8 +26,8 @@ module sfc_nst !> \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm subroutine sfc_nst_run & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: - pi, tgice, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & - lseaspray, fm, fm10, & + pi, tgice, sbc, ps, u1, v1, usfco, vsfco, use_oceanuv, t1, & + q1, tref, cm, ch, lseaspray, fm, fm10, & prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, & sinlat, stress, & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & @@ -84,6 +84,9 @@ subroutine sfc_nst_run & ! im - integer, horiz dimension 1 ! ! ps - real, surface pressure (pa) im ! ! u1, v1 - real, u/v component of surface layer wind (m/s) im ! + ! usfco, vsfco - real, u/v component of surface current (m/s) im ! + ! use_oceanuv - logical, option to include ocean surface 1 ! + ! current in the computation of flux ! ! t1 - real, surface layer mean temperature ( k ) im ! ! q1 - real, surface layer mean specific humidity im ! ! tref - real, reference/foundation temperature ( k ) im ! @@ -167,12 +170,15 @@ subroutine sfc_nst_run & ! --- inputs: integer, intent(in) :: im, kdt, ipr, nstf_name1, nstf_name4, nstf_name5 + logical, intent(in) :: use_oceanuv + real (kind=kind_phys), intent(in) :: hvap, cp, hfus, jcal, eps, & epsm1, rvrdm1, rd, rhw0, sbc, pi, tgice real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, & - t1, q1, tref, cm, ch, fm, fm10, & + usfco, vsfco, t1, q1, cm, ch, fm, fm10, & prsl1, prslki, prsik1, prslk1, xlon, xcosz, & sinlat, stress, sfcemis, dlwflx, sfcnsw, rain, wind + real (kind=kind_phys), dimension(:), intent(in) :: tref real (kind=kind_phys), intent(in) :: timestep real (kind=kind_phys), intent(in) :: solhr @@ -187,7 +193,9 @@ subroutine sfc_nst_run & ! --- input/outputs: ! control variables of dtl system (5+2) and sl (2) and coefficients for d(tz)/d(ts) calculation real (kind=kind_phys), dimension(:), intent(inout) :: tskin, & - tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & + tsurf + real (kind=kind_phys), dimension(:), intent(inout) :: & + xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain ! --- outputs: @@ -235,6 +243,7 @@ subroutine sfc_nst_run & ! real (kind=kind_phys), parameter :: alps=1.0, bets=1.0, gams=0.2, real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15, & ws10cr=30., conlf=7.2e-9, consf=6.4e-8 + real (kind=kind_phys) :: windrel ! !====================================================================================================== ! Initialize CCPP error handling variables @@ -311,9 +320,16 @@ subroutine sfc_nst_run & ! --- ... rcp = rho cp ch v - rch(i) = rho_a(i) * cp * ch(i) * wind(i) - cmm(i) = cm (i) * wind(i) - chh(i) = rho_a(i) * ch(i) * wind(i) + if (use_oceanuv) then + windrel= sqrt( (u1(i)-usfco(i))**2 + (v1(i)-vsfco(i))**2 ) + rch(i) = rho_a(i) * cp * ch(i) * windrel + cmm(i) = cm (i) * windrel + chh(i) = rho_a(i) * ch(i) * windrel + else + rch(i) = rho_a(i) * cp * ch(i) * wind(i) + cmm(i) = cm (i) * wind(i) + chh(i) = rho_a(i) * ch(i) * wind(i) + endif !> - Calculate latent and sensible heat flux over open water with tskin. ! at previous time step diff --git a/physics/SFC_Layer/UFS/sfc_nst.meta b/physics/SFC_Layer/UFS/sfc_nst.meta index 131daaab0..04c26399f 100644 --- a/physics/SFC_Layer/UFS/sfc_nst.meta +++ b/physics/SFC_Layer/UFS/sfc_nst.meta @@ -134,6 +134,29 @@ type = real kind = kind_phys intent = in +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[use_oceanuv] + standard_name = do_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = flag + dimensions = () + type = logical + intent = in [t1] standard_name = air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature diff --git a/physics/SFC_Layer/UFS/sfc_nst_post.f90 b/physics/SFC_Layer/UFS/sfc_nst_post.f90 index 174d5df76..40529438e 100644 --- a/physics/SFC_Layer/UFS/sfc_nst_post.f90 +++ b/physics/SFC_Layer/UFS/sfc_nst_post.f90 @@ -1,6 +1,7 @@ !> \file sfc_nst_post.f90 -!! This file contains code to be executed after the GFS NSST model. +!! This file contains code to be executed after the near-surface sea temperature scheme. +!> This module contains code to be executed after the near-surface sea temperature scheme module sfc_nst_post use machine , only : kind_phys, kp => kind_phys diff --git a/physics/SFC_Layer/UFS/sfc_nst_pre.f90 b/physics/SFC_Layer/UFS/sfc_nst_pre.f90 index 3e77f2d6b..83cb135cf 100644 --- a/physics/SFC_Layer/UFS/sfc_nst_pre.f90 +++ b/physics/SFC_Layer/UFS/sfc_nst_pre.f90 @@ -1,6 +1,7 @@ !> \file sfc_nst_pre.f90 -!! This file contains preparation for the GFS NSST model. +!! This file contains preparation for the near-surface sea temperature scheme. +!> This module contain preparation for the near-surface sea temperature scheme module sfc_nst_pre use machine , only : kind_phys @@ -11,7 +12,7 @@ module sfc_nst_pre contains - !> \defgroup GFS_NSST_PRE GFS Near-Surface Sea Temperature Pre + !> \defgroup GFS_NSST_PRE Near-Surface Sea Temperature Pre !! !! The NSST scheme is one of the three schemes used to represent the !! surface in the GFS physics suite. The other two are the Noah land @@ -30,11 +31,13 @@ subroutine sfc_nst_pre_run & integer, intent(in) :: im, nthreads logical, dimension(:), intent(in) :: wet real (kind=kind_phys), intent(in) :: tgice - real (kind=kind_phys), dimension(:), intent(in) :: tsfco, xt, xz, dt_cool, z_c, oceanfrac + real (kind=kind_phys), dimension(:), intent(in) :: tsfco, oceanfrac + real (kind=kind_phys), dimension(:), intent(in) :: xt, xz, dt_cool, z_c logical, intent(in) :: cplflx ! --- input/outputs: - real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, tseal, tref + real (kind=kind_phys), dimension(:), intent(inout) :: tsurf_wat, tseal + real (kind=kind_phys), dimension(:), intent(inout) :: tref ! --- outputs: character(len=*), intent(out) :: errmsg diff --git a/physics/SFC_Models/Lake/CLM/clm_lake.f90 b/physics/SFC_Models/Lake/CLM/clm_lake.f90 index 91e8c71b7..2feb6ad38 100644 --- a/physics/SFC_Models/Lake/CLM/clm_lake.f90 +++ b/physics/SFC_Models/Lake/CLM/clm_lake.f90 @@ -1,5 +1,7 @@ !> \file clm_lake.f90 !! Contains code related to the CLM lake model + +!> This module contains the CLM Lake model. !! !! This lake scheme was taken from module_sf_lake in WRF 4.3.1, and !! modified for CCPP by Sam Trahan in June 2022. @@ -17,7 +19,6 @@ !! can be used with any land surface scheme embedded in WRF. The lake scheme !! developments and evaluations were included in Subin et al. (2012) \cite Subin_2012 !! and Gu et al. (2015) \cite Gu2015 . - MODULE clm_lake use machine, only: kind_phys, kind_dbl_prec @@ -267,6 +268,7 @@ SUBROUTINE clm_lake_run( & ! Configuration and initialization: iopt_lake, iopt_lake_clm, min_lakeice, lakedepth_default, use_lakedepth, & dtp, use_lake_model, clm_lake_initialized, frac_grid, frac_ice, lkm, & + use_cdeps_data, mask_dat, & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & @@ -317,7 +319,9 @@ SUBROUTINE clm_lake_run( & LOGICAL, INTENT(IN) :: use_lakedepth INTEGER, DIMENSION(:), INTENT(IN) :: use_lake_model REAL(KIND_PHYS), INTENT(INOUT) :: clm_lake_initialized(:) - LOGICAL, INTENT(IN) :: frac_grid, frac_ice + LOGICAL, INTENT(IN) :: frac_grid, frac_ice, use_cdeps_data + REAL(KIND_PHYS), INTENT(IN), OPTIONAL :: mask_dat(:) + ! ! Atmospheric model state inputs: @@ -325,7 +329,9 @@ SUBROUTINE clm_lake_run( & REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: & tg3, pgr, zlvl, qvcurr, xlat_d, xlon_d, ch, cm, & dlwsfci, dswsfci, oro_lakedepth, wind, & - rainncprv, raincprv, t1, qv1, prsl1 + t1, qv1, prsl1 + REAL(KIND_PHYS), DIMENSION(:), INTENT(IN) :: & + rainncprv, raincprv REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter LOGICAL, DIMENSION(:), INTENT(INOUT) :: flag_lakefreeze @@ -340,25 +346,26 @@ SUBROUTINE clm_lake_run( & ep1d_water, ep1d_ice, tsurf_water, tsurf_ice, tsfc_wat, tisfc, tsfc, & weasdi, snodi, hice, qss_water, qss_ice, & cmm_water, cmm_ice, chh_water, chh_ice, & - uustar_water, uustar_ice, lake_t_snow, albedo, zorlw, & - zorli, lake_t2m, lake_q2m, weasd, snowd, fice + uustar_water, uustar_ice, zorlw, zorli, weasd, snowd, fice + REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT) :: & + lake_t_snow, albedo, lake_t2m, lake_q2m LOGICAL, INTENT(INOUT) :: icy(:) ! ! Lake model internal state stored by caller: ! - INTEGER, DIMENSION( : ), INTENT(INOUT) :: salty - INTEGER, DIMENSION( : ), INTENT(INOUT) :: cannot_freeze + INTEGER, DIMENSION( : ), INTENT(INOUT) :: salty + INTEGER, DIMENSION( : ), INTENT(INOUT) :: cannot_freeze - real(kind_phys), dimension(: ) ,intent(inout) :: savedtke12d, & + real(kind_phys), dimension(: ) ,intent(inout) :: savedtke12d, & snowdp2d, & h2osno2d, & snl2d, & t_grnd2d - real(kind_phys), dimension( :,: ) ,INTENT(inout) :: t_lake3d, & + real(kind_phys), dimension( :,: ), INTENT(inout) :: t_lake3d, & lake_icefrac3d - real(kind_phys), dimension( :,-nlevsnow+1: ) ,INTENT(inout) :: t_soisno3d, & + real(kind_phys), dimension( :,-nlevsnow+1: ) ,INTENT(inout) :: t_soisno3d, & h2osoi_ice3d, & h2osoi_liq3d, & h2osoi_vol3d, & @@ -366,8 +373,8 @@ SUBROUTINE clm_lake_run( & dz3d real(kind_phys), dimension( :,-nlevsnow+0: ) ,INTENT(inout) :: zi3d - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: clm_lakedepth - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: input_lakedepth + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: clm_lakedepth + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: input_lakedepth ! ! Error reporting: @@ -603,7 +610,7 @@ SUBROUTINE clm_lake_run( & enddo do k = -nlevsnow+1,nlevsoil t_soisno(c,k) = t_soisno3d(i,k) - h2osoi_ice(c,k) = h2osoi_ice3d(i,k) + h2osoi_ice(c,k) = h2osoi_ice3d(i,k) h2osoi_liq(c,k) = h2osoi_liq3d(i,k) h2osoi_vol(c,k) = h2osoi_vol3d(i,k) z(c,k) = z3d(i,k) @@ -674,20 +681,20 @@ SUBROUTINE clm_lake_run( & savedtke12d(i) = savedtke1(c) snowdp2d(i) = snowdp(c) h2osno2d(i) = h2osno(c) - snl2d(i) = snl(c) + snl2d(i) = snl(c) t_grnd2d(i) = t_grnd(c) do k = 1,nlevlake t_lake3d(i,k) = t_lake(c,k) - lake_icefrac3d(i,k) = lake_icefrac(c,k) + lake_icefrac3d(i,k) = lake_icefrac(c,k) enddo - do k = -nlevsnow+1,nlevsoil - z3d(i,k) = z(c,k) - dz3d(i,k) = dz(c,k) - t_soisno3d(i,k) = t_soisno(c,k) - h2osoi_liq3d(i,k) = h2osoi_liq(c,k) - h2osoi_ice3d(i,k) = h2osoi_ice(c,k) + do k = -nlevsnow+1,nlevsoil + z3d(i,k) = z(c,k) + dz3d(i,k) = dz(c,k) + t_soisno3d(i,k) = t_soisno(c,k) + h2osoi_liq3d(i,k) = h2osoi_liq(c,k) + h2osoi_ice3d(i,k) = h2osoi_ice(c,k) h2osoi_vol3d(i,k) = h2osoi_vol(c,k) - enddo + enddo do k = -nlevsnow+0,nlevsoil zi3d(i,k) = zi(c,k) enddo @@ -708,16 +715,27 @@ SUBROUTINE clm_lake_run( & hflx_wat(i) = eflx_sh_tot(c)/(rho0*cpair) ! kinematic_surface_upward_sensible_heat_flux_over_water gflx_wat(I) = eflx_gnet(c) ![W/m/m] upward_heat_flux_in_soil_over_water ep1d_water(i) = eflx_lh_tot(c) ![W/m/m] surface_upward_potential_latent_heat_flux_over_water - tsurf_water(I) = t_grnd(c) ![K] surface skin temperature after iteration over water - tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice - tsfc_wat(i) = t_grnd(c) ![K] surface skin temperature over water - tisfc(i) = t_grnd(c) + !don't overwrite surface skin temperature over ice, sea ice area fraction, skin temperature over water when using CDEPS inline over the mask + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + tsfc_wat(i) = t_grnd(c) ![K] surface skin temperature over water + tisfc(i) = t_grnd(c) + fice(i) = lake_icefrac3d(i,1) ! sea_ice_area_fraction_of_sea_area_fraction + tsurf_water(I) = t_grnd(c) ![K] surface skin temperature after iteration over water + tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice + endif + else + tsfc_wat(i) = t_grnd(c) ![K] surface skin temperature over water + tisfc(i) = t_grnd(c) + fice(i) = lake_icefrac3d(i,1) ! sea_ice_area_fraction_of_sea_area_fraction + tsurf_water(I) = t_grnd(c) ![K] surface skin temperature after iteration over water + tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice + endif tsfc(i) = t_grnd(c) lake_t2m(I) = t_ref2m(c) ![K] temperature_at_2m_from_clm_lake lake_q2m(I) = q_ref2m(c) ! [frac] specific_humidity_at_2m_from_clm_lake albedo(i) = ( 0.6 * lake_icefrac3d(i,1) ) + & ! mid_day_surface_albedo_over_lake ( (1.0-lake_icefrac3d(i,1)) * 0.08) - fice(i) = lake_icefrac3d(i,1) ! sea_ice_area_fraction_of_sea_area_fraction !uustar_water(i) = ustar_out(c) ! surface_friction_velocity_over_water zorlw(i) = z0mg(c) ! surface_roughness_length_over_water @@ -753,8 +771,16 @@ SUBROUTINE clm_lake_run( & ! uustar_ice(i) = uustar_water(i) ! surface_friction_velocity_over_ice endif - tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice - tisfc(i) = t_grnd(c) ! surface_skin_temperature_over_ice + !don't overwrite surface skin temperature over ice when using CDEPS inline over the mask + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + tisfc(i) = t_grnd(c) + tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice + endif + else + tisfc(i) = t_grnd(c) + tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice + endif tsfc(i) = t_grnd(c) ! surface_skin_temperature_over_ice weasdi(i) = h2osno(c) ! water_equivalent_accumulated_snow_depth_over_ice snodi(i) = snowdp(c)*1.e3 ! surface_snow_thickness_water_equivalent_over_ice @@ -773,12 +799,25 @@ SUBROUTINE clm_lake_run( & zorli(i) = z0mg(c) ! surface_roughness_length_over_ice ! Assume that, if a layer has ice, the entire layer thickness is ice. - hice(I) = 0 ! sea_ice_thickness - do k=1,nlevlake - if(lake_icefrac3d(i,k)>0) then - hice(i) = hice(i) + dz_lake(c,k) + !don't overwrite sea ice thickness when using CDEPS inline over the mask + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + hice(I) = 0 ! sea_ice_thickness + do k=1,nlevlake + if(lake_icefrac3d(i,k)>0) then + hice(i) = hice(i) + dz_lake(c,k) + endif + end do endif - end do + else + hice(I) = 0 ! sea_ice_thickness + do k=1,nlevlake + if(lake_icefrac3d(i,k)>0) then + hice(i) = hice(i) + dz_lake(c,k) + endif + end do + endif + else ! Not an ice point ! On non-icy lake points, set variables relevant to ! lake ice to reasonable defaults. Let LSM fill in @@ -788,17 +827,40 @@ SUBROUTINE clm_lake_run( & snodi(i) = 0 weasd(i) = 0 snowd(i) = 0 - tisfc(i) = t_grnd(c) - tsurf_ice(i) = tisfc(i) + !don't overwrite surface skin temperature over ice when using CDEPS inline over the mask + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + tisfc(i) = t_grnd(c) + tsurf_ice(i) = tisfc(i) + endif + else + tisfc(i) = t_grnd(c) + tsurf_ice(i) = tisfc(i) + endif tsfc(i) = t_grnd(c) - hice(i) = 0 - fice(i) = 0 + !don't overwrite sea ice thickness when using CDEPS inline over the mask + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + hice(i) = 0 + fice(i) = 0 + endif + else + hice(i) = 0 + fice(i) = 0 + endif endif ice_point if(snl2d(i)<0) then ! If there is snow, ice surface temperature should be snow temperature. lake_t_snow(i) = t_grnd(c) ! surface_skin_temperature_over_ice - tisfc(i) = lake_t_snow(i) ! temperature_of_snow_on_lake + !don't overwrite surface skin temperature over ice when using CDEPS inline over the mask + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + tisfc(i) = lake_t_snow(i) ! temperature_of_snow_on_lake + endif + else + tisfc(i) = lake_t_snow(i) ! temperature_of_snow_on_lake + endif snow_points = snow_points+1 else lake_t_snow(i) = -9999 @@ -2301,7 +2363,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! unlike eflx_gnet if(abs(errsoi(c)) > .001_kind_lake) then ! 1.e-5_kind_lake) then WRITE( message,* )'Primary soil energy conservation error in shlake & - column during Tridiagonal Solution,', 'error (W/m^2):', c, errsoi(c) + &column during Tridiagonal Solution,', 'error (W/m^2):', c, errsoi(c) errmsg=trim(message) errflg=1 return @@ -5374,42 +5436,39 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, INTEGER , INTENT (IN) :: im, me, master, km, kdt REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, fhour - REAL(KIND_PHYS), DIMENSION(IM), INTENT(INOUT):: FICE, hice - REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: TG3, xlat_d, xlon_d - REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: tsfc - REAL(KIND_PHYS), DIMENSION(IM) ,INTENT(INOUT) :: clm_lake_initialized - integer, dimension(IM), intent(in) :: use_lake_model - !INTEGER , INTENT (IN) :: lakeflag - !INTEGER , INTENT (INOUT) :: lake_depth_flag + REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT):: FICE, hice + REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: TG3, xlat_d, xlon_d + REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: tsfc + REAL(KIND_PHYS), DIMENSION(:) ,INTENT(INOUT) :: clm_lake_initialized + integer, dimension(:), intent(in) :: use_lake_model LOGICAL, INTENT (IN) :: use_lakedepth - INTEGER, DIMENSION(IM), INTENT(IN) :: ISLTYP - REAL(KIND_PHYS), DIMENSION(IM), INTENT(INOUT) :: snowd,weasd - REAL(kind_phys), DIMENSION(IM,KM), INTENT(IN) :: gt0, prsi + INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP + REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT) :: snowd,weasd + REAL(kind_phys), DIMENSION(:,:), INTENT(IN) :: gt0 + REAL(kind_phys), DIMENSION(:,:), INTENT(IN) :: prsi real(kind_phys), intent(in) :: lakedepth_default - real(kind_phys), dimension(IM),intent(inout) :: clm_lakedepth - real(kind_phys), dimension(IM),intent(inout) :: input_lakedepth - real(kind_phys), dimension(IM),intent(in) :: oro_lakedepth - real(kind_phys), dimension(IM),intent(out) :: savedtke12d - real(kind_phys), dimension(IM),intent(out) :: snowdp2d, & + real(kind_phys), dimension(:),intent(inout) :: clm_lakedepth + real(kind_phys), dimension(:),intent(inout) :: input_lakedepth + real(kind_phys), dimension(:),intent(in) :: oro_lakedepth + real(kind_phys), dimension(:),intent(out) :: savedtke12d + real(kind_phys), dimension(:),intent(out) :: snowdp2d, & h2osno2d, & snl2d, & t_grnd2d - real(kind_phys), dimension(IM,nlevlake),INTENT(out) :: t_lake3d, & + real(kind_phys), dimension(:,:),INTENT(out) :: t_lake3d, & lake_icefrac3d - real(kind_phys), dimension(IM,-nlevsnow+1:nlevsoil ),INTENT(out) :: t_soisno3d, & + real(kind_phys), dimension(:,-nlevsnow+1:),INTENT(out) :: t_soisno3d, & h2osoi_ice3d, & h2osoi_liq3d, & h2osoi_vol3d, & z3d, & dz3d - real(kind_phys), dimension( IM,-nlevsnow+0:nlevsoil ),INTENT(out) :: zi3d + real(kind_phys), dimension(:,-nlevsnow+0:),INTENT(out) :: zi3d - !LOGICAL, DIMENSION( : ),intent(out) :: lake - !REAL(KIND_PHYS), OPTIONAL, DIMENSION( : ), INTENT(IN) :: lake_depth ! no separate variable for this in CCPP integer :: n,i,j,k,ib,lev,bottom ! indices real(kind_lake),dimension(1:im ) :: bd2d ! bulk density of dry soil material [kg/m^3] @@ -5625,7 +5684,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, ! initial t_soisno3d ! in snow if(snowdp2d(i) > 0.) then - do k = snl2d(i)+1, 0 + do k = nint(snl2d(i))+1, 0 t_soisno3d(i,k) =min(tfrz,tsfc(i)) enddo endif diff --git a/physics/SFC_Models/Lake/CLM/clm_lake.meta b/physics/SFC_Models/Lake/CLM/clm_lake.meta index 99c7970d3..f2f9fb96d 100644 --- a/physics/SFC_Models/Lake/CLM/clm_lake.meta +++ b/physics/SFC_Models/Lake/CLM/clm_lake.meta @@ -101,6 +101,22 @@ dimensions = () type = logical intent = in +[use_cdeps_data] + standard_name = do_cdeps_inline + long_name = flag for using data provided by CDEPS inline (default false) + units = flag + dimensions = () + type = logical + intent = in +[mask_dat] + standard_name = land_sea_mask_from_data + long_name = landmask + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True [dtp] standard_name = timestep_for_physics long_name = physics timestep @@ -901,7 +917,6 @@ units = flag dimensions = () type = logical - active = (control_for_lake_model_selection == 3) intent = in [clm_debug_print] standard_name = flag_for_printing_in_clm_lake_model diff --git a/physics/SFC_Models/Lake/Flake/flake_driver.F90 b/physics/SFC_Models/Lake/Flake/flake_driver.F90 index 3b5988254..b5d54009a 100644 --- a/physics/SFC_Models/Lake/Flake/flake_driver.F90 +++ b/physics/SFC_Models/Lake/Flake/flake_driver.F90 @@ -65,9 +65,9 @@ SUBROUTINE flake_driver_run ( & real (kind=kind_phys),dimension(:),intent(inout) :: & & snwdph, hice, tsurf, t_sfc, hflx, evap, fice, ustar, qsfc, & - & ch, cm, chh, cmm, h_ML, t_wML, t_mnw, H_B, T_B, & - & t_bot1, t_bot2, c_t, T_snow, T_ice, tsurf_ice, lflx, gflx - + & ch, cm, chh, cmm, T_ice, tsurf_ice, lflx, gflx + real (kind=kind_phys),dimension(:),intent(inout) :: & + & h_ML, t_wML, t_mnw, H_B, T_B, t_bot1, t_bot2, c_t, T_snow real (kind=kind_phys), intent(in) :: julian logical, dimension(:), intent(in) :: flag_iter, wet @@ -442,10 +442,13 @@ subroutine flake_driver_post_run (im, use_lake_model, h_ML, T_wML, & ! integer, dimension(im), intent(in) :: islmsk real (kind=kind_phys), dimension(:), intent(in) :: & - & lakedepth, tsurf, h_ML, t_wML + & lakedepth, tsurf + real (kind=kind_phys), dimension(:), intent(in) :: & + & h_ML, t_wML - real (kind=kind_phys),dimension(:),intent(inout) :: & - & xz, zm, tref, tsfco + real (kind=kind_phys),dimension(:),intent(inout) :: & + & xz, zm, tref + real (kind=kind_phys),dimension(:),intent(inout) :: tsfco integer, dimension(:), intent(in) :: use_lake_model diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.f b/physics/SFC_Models/Land/Noah/lsm_noah.f index 836fc3b72..9f41b83d0 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.f +++ b/physics/SFC_Models/Land/Noah/lsm_noah.f @@ -284,9 +284,11 @@ subroutine lsm_noah_run & ! --- output: real (kind=kind_phys), dimension(:), intent(inout) :: sncovr1, & & qsurf, gflux, drain, evap, hflx, ep, runoff, cmm, chh, & - & evbs, evcw, sbsno, snowc, stm, snohf, smcwlt2, smcref2, & - & wet1, lai, rca - + & evbs, evcw, sbsno, snowc, stm, snohf, smcwlt2, smcref2 + real (kind=kind_phys), dimension(:), intent(inout) :: lai, rca + real (kind=kind_phys), dimension(:), intent(inout), optional :: & + & wet1 + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -544,6 +546,7 @@ subroutine lsm_noah_run & & snomlt, sncovr, rc, pc, rsmin, xlai, rcs, rct, rcq, & & rcsoil, soilw, soilm, smcwlt, smcdry, smcref, smcmax, & & errmsg, errflg ) + if(errflg/=0) return !> - Noah LSM: prepare variables for return to parent model and unit conversion. ! - 6. output (o): @@ -675,7 +678,6 @@ subroutine lsm_noah_run & endif ! land enddo ! - return !................................... end subroutine lsm_noah_run !----------------------------- diff --git a/physics/SFC_Models/Land/Noah/lsm_noah.meta b/physics/SFC_Models/Land/Noah/lsm_noah.meta index f3ce1d19b..3270c9de6 100644 --- a/physics/SFC_Models/Land/Noah/lsm_noah.meta +++ b/physics/SFC_Models/Land/Noah/lsm_noah.meta @@ -750,6 +750,7 @@ type = real kind = kind_phys intent = inout + optional = True [lai] standard_name = leaf_area_index long_name = leaf area index diff --git a/physics/SFC_Models/Land/Noah/namelist_soilveg.f b/physics/SFC_Models/Land/Noah/namelist_soilveg.f index c0517000e..7b3c41a72 100644 --- a/physics/SFC_Models/Land/Noah/namelist_soilveg.f +++ b/physics/SFC_Models/Land/Noah/namelist_soilveg.f @@ -1,6 +1,8 @@ !>\file namelist_soilveg.f !>\ingroup Noah_LSM + +!> This module contains namelist options for Noah LSM module namelist_soilveg implicit none save diff --git a/physics/SFC_Models/Land/Noah/set_soilveg.f b/physics/SFC_Models/Land/Noah/set_soilveg.f index 35f4ace37..b772c91f2 100644 --- a/physics/SFC_Models/Land/Noah/set_soilveg.f +++ b/physics/SFC_Models/Land/Noah/set_soilveg.f @@ -52,35 +52,35 @@ subroutine set_soilveg(me,isot,ivet,nlunit,errmsg,errflg) !using umd veg table slope_data =(/0.1, 0.6, 1.0, 0.35, 0.55, 0.8, - & 0.63, 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0/) + & 0.63, 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0/) rsmtbl =(/300.0, 175.0, 175.0, 300.0, 300.0, 70.0, - & 20.0, 225.0, 225.0, 225.0, 400.0, 20.0, - & 150.0, 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) + & 20.0, 225.0, 225.0, 225.0, 400.0, 20.0, + & 150.0, 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) c----------------------------- rgltbl =(/30.0, 30.0, 30.0, 30.0, 30.0, 65.0, - & 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, - & 100.0, 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) + & 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, + & 100.0, 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) hstbl =(/41.69, 54.53, 51.93, 47.35, 47.35, 54.53, - & 36.35, 42.00, 42.00, 42.00, 42.00, 36.35, - & 42.00, 0.00, 0.00, 0.00, 0.00, 0.00, - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/) + & 36.35, 42.00, 42.00, 42.00, 42.00, 36.35, + & 42.00, 0.00, 0.00, 0.00, 0.00, 0.00, + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/) ! changed for version 2.6 on june 2nd 2003 ! data snupx /0.080, 0.080, 0.080, 0.080, 0.080, 0.080, ! & 0.040, 0.040, 0.040, 0.040, 0.025, 0.040, ! & 0.025, 0.000, 0.000, 0.000, 0.000, 0.000, snupx =(/0.040, 0.040, 0.040, 0.040, 0.040, 0.040, - * 0.020, 0.020, 0.020, 0.020, 0.013, 0.020, - * 0.013, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) + * 0.020, 0.020, 0.020, 0.020, 0.013, 0.020, + * 0.013, 0.000, 0.000, 0.000, 0.000, 0.000, + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) bare =11 @@ -430,7 +430,6 @@ subroutine set_soilveg(me,isot,ivet,nlunit,errmsg,errflg) END DO ! if (me == 0) write(6,soil_veg) - return end subroutine set_soilveg end module set_soilveg_mod diff --git a/physics/SFC_Models/Land/Noah/sflx.f b/physics/SFC_Models/Land/Noah/sflx.f index b2fb38ae1..efb2cb91a 100644 --- a/physics/SFC_Models/Land/Noah/sflx.f +++ b/physics/SFC_Models/Land/Noah/sflx.f @@ -1,5 +1,7 @@ !>\file sflx.f -!! This file is the entity of GFS Noah LSM Model(Version 2.7). +!! + +!> This module contains the entity of GFS Noah LSM Model(Version 2.7). module sflx contains !>\ingroup Noah_LSM @@ -420,6 +422,8 @@ subroutine gfssflx &! --- input !> - Call redprm() to set the land-surface paramters, !! including soil-type and veg-type dependent parameters. call redprm(errmsg, errflg) + if(errflg/=0) return + if(ivegsrc == 1) then !only igbp type has urban !urban @@ -1056,7 +1060,6 @@ subroutine alcalc ! endif ! - return !................................... end subroutine alcalc !----------------------------------- @@ -1214,7 +1217,6 @@ subroutine canres pc = (rr + delta) / (rr*(1.0 + rc*ch) + delta) ! - return !................................... end subroutine canres !----------------------------------- @@ -1277,7 +1279,6 @@ subroutine csnow ! sncond = 0.021 + 2.51 * sndens**2 ! - return !................................... end subroutine csnow !----------------------------------- @@ -1557,7 +1558,6 @@ subroutine nopac flx1 = 0.0 flx3 = 0.0 ! - return !................................... end subroutine nopac !----------------------------------- @@ -1669,7 +1669,6 @@ subroutine penman epsca = (a*rr + rad*delta) / (delta + rr) etp = epsca * rch / lsubc ! - return !................................... end subroutine penman !----------------------------------- @@ -1958,7 +1957,6 @@ subroutine redprm(errmsg, errflg) if (vegtyp == bare) shdfac = 0.0 if (nroot > nsoil) then - write(*,*) 'warning: too many root layers' errflg = 1 errmsg = 'ERROR(sflx.f): too many root layers' return @@ -1975,7 +1973,6 @@ subroutine redprm(errmsg, errflg) slope = slope_data(slopetyp) ! - return !................................... end subroutine redprm !----------------------------------- @@ -2263,7 +2260,6 @@ subroutine sfcdif ! print*,'ch=',ch ! print*,'----------------------------' ! - return !................................... end subroutine sfcdif !----------------------------------- @@ -2334,7 +2330,6 @@ subroutine snfrac ! sncovr = sneqv / (sneqv + 2.0*z0n) ! - return !................................... end subroutine snfrac !----------------------------------- @@ -2660,7 +2655,7 @@ subroutine snopac ! t1 = tfreez * sncovr**snoexp + t12 * (1.0 - sncovr**snoexp) t1 = tfreez * max(0.01,sncovr**snoexp) + & - & t12 * (1.0 - max(0.01,sncovr**snoexp)) + & t12 * (1.0 - max(0.01,sncovr**snoexp)) beta = 1.0 ssoil = df1 * (t1 - stc(1)) / dtot @@ -2863,7 +2858,6 @@ subroutine snopac endif ! end if_ice_block ! - return !................................... end subroutine snopac !----------------------------------- @@ -2942,7 +2936,6 @@ subroutine snow_new snowhc = snowhc + hnewc snowh = snowhc * 0.01 ! - return !................................... end subroutine snow_new !----------------------------------- @@ -2994,7 +2987,6 @@ subroutine snowz0 z0 = (1.0 - sncovr)*z0 + sncovr*z0s ! - return !................................... end subroutine snowz0 !----------------------------------- @@ -3133,7 +3125,6 @@ subroutine tdfcnd & df = ake * (thksat - thkdry) + thkdry ! - return !................................... end subroutine tdfcnd !----------------------------------- @@ -3289,7 +3280,6 @@ subroutine evapo & eta1 = edir1 + ett1 + ec1 ! - return !................................... end subroutine evapo !----------------------------------- @@ -3460,7 +3450,6 @@ subroutine shflx & ssoil = df1*(stc(1) - t1) / (0.5*zsoil(1)) ! - return !................................... end subroutine shflx !----------------------------------- @@ -3673,7 +3662,6 @@ subroutine smflx & ! runof = runoff ! - return !................................... end subroutine smflx !----------------------------------- @@ -3835,7 +3823,6 @@ subroutine snowpack & snowh = snowhc * 0.01 ! - return !................................... end subroutine snowpack !----------------------------------- @@ -3910,7 +3897,6 @@ subroutine devap & edir1 = fx * ( 1.0 - shdfac ) * etp1 ! - return !................................... end subroutine devap !----------------------------------- @@ -4072,7 +4058,6 @@ subroutine frh2o & endif ! end if_tkelv_block ! - return !................................... end subroutine frh2o !----------------------------------- @@ -4446,7 +4431,6 @@ subroutine hrt & enddo ! end do_k_loop ! - return !................................... end subroutine hrt !----------------------------------- @@ -4621,7 +4605,6 @@ subroutine hrtice & enddo ! end do_k_loop ! - return !................................... end subroutine hrtice !----------------------------------- @@ -4721,7 +4704,6 @@ subroutine hstep & stcout(k) = stcin(k) + ci(k) enddo ! - return !................................... end subroutine hstep !----------------------------------- @@ -4824,7 +4806,6 @@ subroutine rosr12 & p(kk) = p(kk)*p(kk+1) + delta(kk) enddo ! - return !................................... end subroutine rosr12 !----------------------------------- @@ -4961,7 +4942,6 @@ subroutine snksrc & tsrc = -dh2o * lsubf * dz * (xh2o - sh2o) / dt sh2o = xh2o ! - return !................................... end subroutine snksrc !----------------------------------- @@ -5275,7 +5255,6 @@ subroutine srt & endif enddo ! end do_k_loop ! - return !................................... end subroutine srt !----------------------------------- @@ -5423,7 +5402,6 @@ subroutine sstep & if (cmc < 1.e-20) cmc = 0.0 cmc = min( cmc, cmcmax ) ! - return !................................... end subroutine sstep !----------------------------------- @@ -5495,7 +5473,6 @@ subroutine tbnd & tbnd1 = tu + (tb-tu)*(zup-zsoil(k))/(zup-zb) ! - return !................................... end subroutine tbnd !----------------------------------- @@ -5604,7 +5581,6 @@ subroutine tmpavg & endif ! end if_tup_block ! - return !................................... end subroutine tmpavg !----------------------------------- @@ -5737,7 +5713,6 @@ subroutine transp & ! enddo ! - return !................................... end subroutine transp !----------------------------------- @@ -5821,7 +5796,6 @@ subroutine wdfcnd & expon = (2.0 * bexp) + 3.0 wcnd = dksat * factr2 ** expon ! - return !................................... end subroutine wdfcnd !----------------------------------- diff --git a/physics/SFC_Models/Land/Noah/surface_perturbation.F90 b/physics/SFC_Models/Land/Noah/surface_perturbation.F90 index e0429a5fc..acf722754 100644 --- a/physics/SFC_Models/Land/Noah/surface_perturbation.F90 +++ b/physics/SFC_Models/Land/Noah/surface_perturbation.F90 @@ -3,6 +3,7 @@ !! albedo and vegetation fraction perturbations. !>\defgroup gfs_sfcpert GFS Surface Perturbation Module + !> This module contains routines used in the percentile matching algorithm for the !! albedo and vegetation fraction perturbations. module surface_perturbation diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 new file mode 100644 index 000000000..f82669a5d --- /dev/null +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.F90 @@ -0,0 +1,786 @@ +!*********************************************************************** +!> TODO: replace with appropriate licence for CCPP +!* GNU Lesser General Public License +!* . +!*********************************************************************** + +!> @brief Land IAU (Incremental Analysis Update) module, +!> for the NoahMP soil/snow temperature (can be extended to include soil moisture) + +!! \section land_iau_mod +!> - reads settings from namelist file (which indicates if IAU increments are available or not) +!> - reads in DA increments from GSI/JEDI DA at the start of (the DA) cycle +!> - maps increments to FV3 grid points belonging to mpi process +!> - interpolates temporally (with filter-weights if required by configuration) +!> - updates states with the interpolated increments + +!> March, 2024: Tseganeh Z. Gichamo, (EMC) based on the FV3 IAU mod +!> by Xi.Chen and Philip Pegion, PSL +!------------------------------------------------------------------------------- + +!> \section arg_table_land_iau_mod Argument table +!! \htmlinclude land_iau_mod.html +!! +module land_iau_mod + + use machine, only: kind_phys, kind_dyn + use netcdf + + implicit none + + private + +!> \section arg_table_land_iau_external_data_type Argument Table +!! \htmlinclude land_iau_external_data_type.html +!! + type land_iau_external_data_type + real(kind=kind_phys),allocatable :: stc_inc(:,:,:) + real(kind=kind_phys),allocatable :: slc_inc(:,:,:) + logical :: in_interval = .false. + real(kind=kind_phys) :: hr1 + real(kind=kind_phys) :: hr2 + real(kind=kind_phys) :: wt + real(kind=kind_phys) :: wt_normfact + real(kind=kind_phys) :: rdt + integer :: itnext ! track the increment steps here + end type land_iau_external_data_type + +!!> \section arg_table_land_iau_state_type Argument Table +!! \htmlinclude land_iau_state_type.html +!! + ! land_iau_state_type holds 'raw' (not interpolated) inrements, + ! read during land_iau_mod_init + type land_iau_state_type + real(kind=kind_phys),allocatable :: stc_inc(:,:,:,:) + real(kind=kind_phys),allocatable :: slc_inc(:,:,:,:) + end type land_iau_state_type + + +!!!> \section arg_table_land_iau_control_type Argument Table +!! \htmlinclude land_iau_control_type.html +!! + type land_iau_control_type + integer :: isc + integer :: jsc + integer :: nx + integer :: ny + integer :: tile_num + integer :: nblks + integer, allocatable :: blksz(:) ! this could vary for the last block + integer, allocatable :: blk_strt_indx(:) + + integer :: lsoil !< number of soil layers + integer :: lsnow_lsm !< maximum number of snow layers internal to land surface model + logical :: do_land_iau + real(kind=kind_phys) :: iau_delthrs ! iau time interval (to scale increments) in hours + character(len=240) :: iau_inc_files(7) ! list of increment files + real(kind=kind_phys) :: iaufhrs(7) ! forecast hours associated with increment files + logical :: iau_filter_increments + integer :: lsoil_incr ! soil layers (from top) updated by DA + logical :: upd_stc + logical :: upd_slc + logical :: do_stcsmc_adjustment !do moisture/temperature adjustment for consistency after increment add + real(kind=kind_phys) :: min_T_increment + real(kind=kind_phys) :: min_SLC_increment + + integer :: me !< MPI rank designator + integer :: mpi_root !< MPI rank of master atmosphere processor + character(len=64) :: fn_nml !< namelist filename for surface data cycling + real(kind=kind_phys) :: dtp !< physics timestep in seconds + real(kind=kind_phys) :: fhour !< current forecast hour + + integer :: ntimes + + end type land_iau_control_type + + public land_iau_control_type, land_iau_external_data_type, land_iau_state_type, land_iau_mod_set_control, & + land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, calculate_landinc_mask + +contains + +subroutine land_iau_mod_set_control(Land_IAU_Control,fn_nml,input_nml_file, me, mpi_root, & + isc, jsc, nx, ny, tile_num, nblks, blksz, & + lsoil, lsnow_lsm, dtp, fhour, errmsg, errflg) + + type (land_iau_control_type), intent(inout) :: Land_IAU_Control + character(*), intent(in) :: fn_nml !< namelist filename for surface data cycling + character(len=:), intent(in), dimension(:), pointer :: input_nml_file + integer, intent(in) :: me, mpi_root !< MPI rank of master atmosphere processor + integer, intent(in) :: isc, jsc, nx, ny, tile_num, nblks, lsoil, lsnow_lsm + integer, dimension(:), intent(in) :: blksz !(one:) !GFS_Control%blksz + real(kind=kind_phys), intent(in) :: dtp !< physics timestep in seconds + real(kind=kind_phys), intent(in) :: fhour !< current forecast hour + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: nb, ix + integer :: nlunit = 360 ! unit for namelist !, intent(in) + integer :: ios + logical :: exists + character(len=512) :: ioerrmsg + + character(len=4) :: iosstr + + !> land iau setting read from namelist + logical :: do_land_iau = .false. + real(kind=kind_phys) :: land_iau_delthrs = 0 !< iau time interval (to scale increments) + character(len=240) :: land_iau_inc_files(7) = '' !< list of increment files + real(kind=kind_phys) :: land_iau_fhrs(7) = -1 !< forecast hours associated with increment files + logical :: land_iau_filter_increments = .false. !< filter IAU increments + + integer :: lsoil_incr = 4 + logical :: land_iau_upd_stc = .false. + logical :: land_iau_upd_slc = .false. + logical :: land_iau_do_stcsmc_adjustment = .false. + real(kind=kind_phys) :: land_iau_min_T_increment = 0.0001 + real(kind=kind_phys) :: land_iau_min_SLC_increment = 0.000001 + + NAMELIST /land_iau_nml/ do_land_iau, land_iau_delthrs, land_iau_inc_files, land_iau_fhrs, & + land_iau_filter_increments, lsoil_incr, land_iau_upd_stc, land_iau_upd_slc, & + land_iau_do_stcsmc_adjustment, land_iau_min_T_increment, land_iau_min_SLC_increment + !Errors messages handled through CCPP error handling variables + errmsg = '' + errflg = 0 + +!3.11.24: copied from GFS_typedefs.F90 +#ifdef INTERNAL_FILE_NML + read(input_nml_file, nml=land_iau_nml, ERR=888, END=999, iostat=ios) +#else + inquire (file=trim(fn_nml), exist=exists) ! TODO: this maybe be replaced by nlunit passed from ccpp + if (.not. exists) then + errmsg = 'lnd_iau_mod_set_control: namelist file '//trim(fn_nml)//' does not exist' + errflg = 1 + return + else + Land_IAU_Control%fn_nml = trim(fn_nml) + open (unit=nlunit, file=trim(fn_nml), action='READ', status='OLD', iostat=ios, iomsg=ioerrmsg) + rewind(nlunit) + read (nlunit, nml=land_iau_nml, ERR=888, END=999, iostat=ios) + close (nlunit) + if (ios /= 0) then + errmsg = 'lnd_iau_mod_set_control: error reading namelist file '//trim(fn_nml) & + // 'the error message from file handler:' //trim(ioerrmsg) + errflg = 1 + return + end if + endif +#endif + +888 if (ios /= 0) then + write(iosstr, '(I0)') ios + errmsg = 'lnd_iau_mod_set_control: I/O error code '//trim(iosstr)//' at land_iau namelist read' + errflg = 1 + return + end if + +999 if (ios /= 0) then + write(iosstr, '(I0)') ios + if (me == mpi_root) then + WRITE(6, * ) 'lnd_iau_mod_set_control: Warning! EoF ('//trim(iosstr)//') while reading land_iau namelist,' & + // ' likely because land_iau_nml was not found in input.nml. It will be set to default.' + endif + endif + + if (me == mpi_root) then + write(6,*) "land_iau_nml" + write(6, land_iau_nml) + endif + + Land_IAU_Control%do_land_iau = do_land_iau + Land_IAU_Control%iau_delthrs = land_iau_delthrs + Land_IAU_Control%iau_inc_files = land_iau_inc_files + Land_IAU_Control%iaufhrs = land_iau_fhrs + Land_IAU_Control%iau_filter_increments = land_iau_filter_increments + Land_IAU_Control%lsoil_incr = lsoil_incr + + Land_IAU_Control%me = me + Land_IAU_Control%mpi_root = mpi_root + Land_IAU_Control%isc = isc + Land_IAU_Control%jsc = jsc + Land_IAU_Control%nx = nx + Land_IAU_Control%ny = ny + Land_IAU_Control%tile_num = tile_num + Land_IAU_Control%nblks = nblks + Land_IAU_Control%lsoil = lsoil + Land_IAU_Control%lsnow_lsm = lsnow_lsm + Land_IAU_Control%dtp = dtp + Land_IAU_Control%fhour = fhour + + Land_IAU_Control%upd_stc = land_iau_upd_stc + Land_IAU_Control%upd_slc = land_iau_upd_slc + Land_IAU_Control%do_stcsmc_adjustment = land_iau_do_stcsmc_adjustment + Land_IAU_Control%min_T_increment = land_iau_min_T_increment + Land_IAU_Control%min_SLC_increment = land_iau_min_SLC_increment + + allocate(Land_IAU_Control%blksz(nblks)) + allocate(Land_IAU_Control%blk_strt_indx(nblks)) + + ! Land_IAU_Control%blk_strt_indx = start index of each block, for flattened (ncol=nx*ny) arrays + ! It's required in noahmpdriv_run to get subsection of the stc array for each proces/thread + ix = 1 + do nb=1, nblks + Land_IAU_Control%blksz(nb) = blksz(nb) + Land_IAU_Control%blk_strt_indx(nb) = ix + ix = ix + blksz(nb) + enddo + +end subroutine land_iau_mod_set_control + +subroutine land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) + type (land_iau_control_type), intent(inout) :: Land_IAU_Control + type (land_iau_external_data_type), intent(inout) :: Land_IAU_Data + type(land_iau_state_type), intent(inout) :: Land_IAU_state + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! local + character(len=128) :: fname + real(kind=kind_phys) :: sx, wx, wt, normfact, dtp + integer :: k, nstep, kstep + integer :: nfilesall, ntimesall + integer, allocatable :: idt(:) + integer :: nlon, nlat + logical :: exists + integer :: ncid, dimid, varid, status, IDIM + + real(kind=kind_phys) :: dt !, rdt + integer :: im, jm, km, nfiles, ntimes + + integer :: is, ie, js, je + integer :: npz + integer :: i, j + + !Errors messages handled through CCPP error handling variables + errmsg = '' + errflg = 0 + + npz = Land_IAU_Control%lsoil + km = Land_IAU_Control%lsoil + + is = Land_IAU_Control%isc + ie = is + Land_IAU_Control%nx-1 + js = Land_IAU_Control%jsc + je = js + Land_IAU_Control%ny-1 + nlon = Land_IAU_Control%nx + nlat = Land_IAU_Control%ny + + ! allocate arrays that will hold iau state + allocate(Land_IAU_Data%stc_inc(nlon, nlat, km)) + allocate(Land_IAU_Data%slc_inc(nlon, nlat, km)) + + Land_IAU_Data%hr1=Land_IAU_Control%iaufhrs(1) + Land_IAU_Data%wt = 1.0 ! IAU increment filter weights (default 1.0) + Land_IAU_Data%wt_normfact = 1.0 + if (Land_IAU_Control%iau_filter_increments) then + ! compute increment filter weights, sum to obtain normalization factor + dtp=Land_IAU_Control%dtp + nstep = 0.5*Land_IAU_Control%iau_delthrs*3600/dtp + ! compute normalization factor for filter weights + normfact = 0. + do k=1,2*nstep+1 + kstep = k-1-nstep + sx = acos(-1.)*kstep/nstep + wx = acos(-1.)*kstep/(nstep+1) + if (kstep .ne. 0) then + wt = sin(wx)/wx*sin(sx)/sx + else + wt = 1.0 + endif + normfact = normfact + wt + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,'Land IAU init: IAU filter weights params k, kstep, wt ',k, kstep, wt + endif + enddo + Land_IAU_Data%wt_normfact = (2*nstep+1)/normfact + endif + + ! increment files are in fv3 tiles + if (trim(Land_IAU_Control%iau_inc_files(1)) .eq. '' .or. Land_IAU_Control%iaufhrs(1) .lt. 0) then ! only 1 file expected + errmsg = "Error! in Land IAU init: increment file name is empty or iaufhrs(1) is negative" + errflg = 1 + return + endif + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*,"Land_iau_init: Increment file name: ", trim(adjustl(Land_IAU_Control%iau_inc_files(1))) + endif + + ! determine number of valid forecast hours; read from the increment file ("Time" dim) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *, "Land_iau_init: timesetps and forecast times (in hours) with valid increment values" + endif + ntimesall = size(Land_IAU_Control%iaufhrs) + ntimes = 0 + do k=1,ntimesall + if (Land_IAU_Control%iaufhrs(k) .lt. 0) exit + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,k, " fhour ", Land_IAU_Control%iaufhrs(k) + endif + ntimes = ntimes + 1 + enddo + + Land_IAU_Control%ntimes = ntimes + if (ntimes < 1) then + errmsg = "Error! in Land IAU init: ntimes < 1 (no valid hour with increments); do_land_iau should not be .true." + errflg = 1 + return + endif + if (ntimes > 1) then + allocate(idt(ntimes-1)) + idt = Land_IAU_Control%iaufhrs(2:ntimes)-Land_IAU_Control%iaufhrs(1:ntimes-1) + do k=1,ntimes-1 + if (idt(k) .ne. Land_IAU_Control%iaufhrs(2)-Land_IAU_Control%iaufhrs(1)) then + errmsg = 'Fatal error in land_iau_init. forecast intervals in iaufhrs must be constant' + errflg = 1 + return + endif + enddo + deallocate(idt) + endif + dt = (Land_IAU_Control%iau_delthrs*3600.) + Land_IAU_Data%rdt = 1.0/dt !rdt + + ! Read all increment files at iau init time (at beginning of cycle) + ! increments are already in the fv3 grid--no need for interpolation + call read_iau_forcing_fv3(Land_IAU_Control, Land_IAU_state%stc_inc, Land_IAU_state%slc_inc, errmsg, errflg) + if (errflg .ne. 0) return + + if (ntimes.EQ.1) then ! only need to get incrments once since constant forcing over window + call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) + Land_IAU_Data%itnext = 0 + endif + if (ntimes.GT.1) then !have increments at multiple forecast hours, + ! but only need 2 at a time and interpoalte for timesteps between them + ! interpolation is done in land_iau_mod_getiauforcing + Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(2) + Land_IAU_Data%itnext = 2 + endif + +end subroutine land_iau_mod_init + +subroutine land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_state, errmsg, errflg) + + implicit none + + type(land_iau_control_type), intent(in) :: Land_IAU_Control + type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data + type(land_iau_state_type), intent(inout) :: Land_IAU_state + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (allocated(Land_IAU_Data%stc_inc)) deallocate (Land_IAU_Data%stc_inc) + if (allocated(Land_IAU_Data%slc_inc)) deallocate (Land_IAU_Data%slc_inc) + + if (allocated(Land_IAU_state%stc_inc)) deallocate(Land_IAU_state%stc_inc) + if (allocated(Land_IAU_state%slc_inc)) deallocate(Land_IAU_state%slc_inc) + +end subroutine land_iau_mod_finalize + + subroutine land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) + + implicit none + type(land_iau_control_type), intent(inout) :: Land_IAU_Control + type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data + type(land_iau_state_type), intent(in) :: Land_IAU_State + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + real(kind=kind_phys) t1,t2,sx,wx,wt,dtp + integer n,i,j,k,kstep,nstep + integer :: ntimes + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ntimes = Land_IAU_Control%ntimes + + Land_IAU_Data%in_interval=.false. + if (ntimes.LE.0) then + errmsg = 'called land_iau_mod_getiauforcing, but ntimes <=0, probably there is no increment file. Exiting.' + errflg = 1 + return + endif + + if (ntimes .eq. 1) then + t1 = Land_IAU_Control%iaufhrs(1)-0.5*Land_IAU_Control%iau_delthrs + t2 = Land_IAU_Control%iaufhrs(1)+0.5*Land_IAU_Control%iau_delthrs + else + t1 = Land_IAU_Control%iaufhrs(1) + t2 = Land_IAU_Control%iaufhrs(ntimes) + endif + if (Land_IAU_Control%iau_filter_increments) then + ! compute increment filter weight + ! t1 is beginning of window, t2 end of window, and Land_IAU_Control%fhour is current time + ! in window kstep=-nstep,nstep (2*nstep+1 total) with time step of Land_IAU_Control%dtp + dtp=Land_IAU_Control%dtp + nstep = 0.5*Land_IAU_Control%iau_delthrs*3600/dtp + ! compute normalized filter weight + kstep = ((Land_IAU_Control%fhour-t1) - 0.5*Land_IAU_Control%iau_delthrs)*3600./dtp + if (Land_IAU_Control%fhour >= t1 .and. Land_IAU_Control%fhour < t2) then + sx = acos(-1.)*kstep/nstep + wx = acos(-1.)*kstep/(nstep+1) + if (kstep .ne. 0) then + wt = (sin(wx)/wx*sin(sx)/sx) + else + wt = 1. + endif + Land_IAU_Data%wt = Land_IAU_Data%wt_normfact*wt + else + Land_IAU_Data%wt = 0. + endif + endif + + if (ntimes.EQ.1) then + ! check to see if we are in the IAU window, no need to update the states since they are fixed over the window + if ( Land_IAU_Control%fhour <= t1 .or. Land_IAU_Control%fhour > t2 ) then + Land_IAU_Data%in_interval=.false. + else + Land_IAU_Data%in_interval=.true. + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,'land_iau_mod_getiauforcing: applying forcing at t for t1,t,t2,filter wt rdt ', & + t1,Land_IAU_Control%fhour,t2,Land_IAU_Data%wt/Land_IAU_Data%wt_normfact,Land_IAU_Data%rdt + endif + if (Land_IAU_Control%iau_filter_increments) call setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state) + endif + return + endif + + if (ntimes > 1) then + if ( Land_IAU_Control%fhour <= t1 .or. Land_IAU_Control%fhour > t2 ) then + Land_IAU_Data%in_interval=.false. + else + Land_IAU_Data%in_interval=.true. + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *,'land_iau_mod_getiauforcing: applying forcing at t for t1,t,t2,filter wt rdt ', & + t1,Land_IAU_Control%fhour,t2,Land_IAU_Data%wt/Land_IAU_Data%wt_normfact,Land_IAU_Data%rdt + endif + if (Land_IAU_Control%fhour > Land_IAU_Data%hr2) then ! need to read in next increment file + Land_IAU_Data%itnext = Land_IAU_Data%itnext + 1 + Land_IAU_Data%hr1=Land_IAU_Data%hr2 + Land_IAU_Data%hr2=Land_IAU_Control%iaufhrs(Land_IAU_Data%itnext) + endif + + call updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) + endif + endif + + end subroutine land_iau_mod_getiauforcing + +subroutine updateiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) + + implicit none + + type (land_iau_control_type), intent(in) :: Land_IAU_Control + type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data + type(land_iau_state_type), intent(in) :: Land_IAU_State + real(kind=kind_phys) delt_t + integer i,j,k + integer :: is, ie, js, je, npz, t1, t2 + + t2 = Land_IAU_Data%itnext + t1 = t2 - 1 + is = 1 ! Land_IAU_Control%isc + ie = is + Land_IAU_Control%nx-1 + js = 1 ! Land_IAU_Control%jsc + je = js + Land_IAU_Control%ny-1 + npz = Land_IAU_Control%lsoil + + delt_t = (Land_IAU_Data%hr2-(Land_IAU_Control%fhour))/(Land_IAU_Data%hr2-Land_IAU_Data%hr1) + + do j = js,je + do i = is,ie + do k = 1,npz ! do k = 1,n_soill ! + Land_IAU_Data%stc_inc(i,j,k) =(delt_t*Land_IAU_State%stc_inc(t1,i,j,k) + (1.-delt_t)* Land_IAU_State%stc_inc(t2,i,j,k))*Land_IAU_Data%rdt*Land_IAU_Data%wt + Land_IAU_Data%slc_inc(i,j,k) =(delt_t*Land_IAU_State%slc_inc(t1,i,j,k) + (1.-delt_t)* Land_IAU_State%slc_inc(t2,i,j,k))*Land_IAU_Data%rdt*Land_IAU_Data%wt + end do + enddo + enddo + end subroutine updateiauforcing + + subroutine setiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_State) + + implicit none + type(land_iau_control_type), intent(in ) :: Land_IAU_Control + type(land_iau_external_data_type), intent(inout) :: Land_IAU_Data + type(land_iau_state_type), intent(in ) :: Land_IAU_State + real(kind=kind_phys) delt + integer i, j, k + integer :: is, ie, js, je, npz + + is = 1 + ie = is + Land_IAU_Control%nx-1 + js = 1 + je = js + Land_IAU_Control%ny-1 + npz = Land_IAU_Control%lsoil + + do j = js, je + do i = is, ie + do k = 1, npz + Land_IAU_Data%stc_inc(i,j,k) = Land_IAU_Data%wt*Land_IAU_State%stc_inc(1,i,j,k)*Land_IAU_Data%rdt + Land_IAU_Data%slc_inc(i,j,k) = Land_IAU_Data%wt*Land_IAU_State%slc_inc(1,i,j,k)*Land_IAU_Data%rdt + end do + enddo + enddo + + end subroutine setiauforcing + +subroutine read_iau_forcing_fv3(Land_IAU_Control, wk3_stc, wk3_slc, errmsg, errflg) + + type (land_iau_control_type), intent(in) :: Land_IAU_Control + real(kind=kind_phys), allocatable, intent(out) :: wk3_stc(:, :, :, :), wk3_slc(:, :, :, :) + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg + + integer :: i, it, km + logical :: exists + integer :: ncid, status, varid + integer :: ierr + character(len=500) :: fname + character(len=2) :: tile_str + integer :: n_t, n_y, n_x + + character(len=32), dimension(4) :: stc_vars = [character(len=32) :: 'soilt1_inc', 'soilt2_inc', 'soilt3_inc', 'soilt4_inc'] + character(len=32), dimension(4) :: slc_vars = [character(len=32) :: 'slc1_inc', 'slc2_inc', 'slc3_inc', 'slc4_inc'] + character(len=32) :: slsn_mask = "soilsnow_mask" + + !Errors messages handled through CCPP error handling variables + errmsg = '' + errflg = 0 + + km = Land_IAU_Control%lsoil + + write(tile_str, '(I0)') Land_IAU_Control%tile_num + + fname = 'INPUT/'//trim(Land_IAU_Control%iau_inc_files(1))//".tile"//trim(tile_str)//".nc" + + inquire (file=trim(fname), exist=exists) + if (exists) then + status = nf90_open(trim(fname), NF90_NOWRITE, ncid) ! open the file + call netcdf_err(status, ' opening file '//trim(fname), errflg, errmsg) + if (errflg .ne. 0) return + else + errmsg = 'FATAL Error in land iau read_iau_forcing_fv3: Expected file '//trim(fname)//' for DA increment does not exist' + errflg = 1 + return + endif + ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) + call get_nc_dimlen(ncid, "Time", n_t, errflg, errmsg) + if (errflg .ne. 0) return + call get_nc_dimlen(ncid, "yaxis_1", n_y, errflg, errmsg) + if (errflg .ne. 0) return + call get_nc_dimlen(ncid, "xaxis_1", n_x, errflg, errmsg) + if (errflg .ne. 0) return + + if (n_x .lt. Land_IAU_Control%nx) then + errmsg = 'Error in land iau read_iau_forcing_fv3: Land_IAU_Control%nx bigger than dim xaxis_1 in file '//trim(fname) + errflg = 1 + return + endif + if (n_y .lt. Land_IAU_Control%ny) then + errmsg = 'Error in land iau read_iau_forcing_fv3: Land_IAU_Control%ny bigger than dim yaxis_1 in file '//trim(fname) + errflg = 1 + return + endif + + allocate(wk3_stc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) + allocate(wk3_slc(n_t, Land_IAU_Control%nx, Land_IAU_Control%ny, km)) + + do i = 1, size(stc_vars) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(stc_vars(i)) + status = nf90_inq_varid(ncid, trim(stc_vars(i)), varid) + if (status == nf90_noerr) then + do it = 1, n_t + ! var stored as soilt1_inc(Time, yaxis_1, xaxis_1) + call get_var3d_values(ncid, varid, trim(stc_vars(i)), Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & + it, 1, wk3_stc(it,:, :, i), status, errflg, errmsg) + if (errflg .ne. 0) return + enddo + else + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *, 'warning! No increment for ',trim(stc_vars(i)),' found, assuming zero' + endif + wk3_stc(:, :, :, i) = 0. + endif + enddo + do i = 1, size(slc_vars) + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) print *, trim(slc_vars(i)) + status = nf90_inq_varid(ncid, trim(slc_vars(i)), varid) + if (status == nf90_noerr) then + do it = 1, n_t + call get_var3d_values(ncid, varid, trim(slc_vars(i)), Land_IAU_Control%isc, Land_IAU_Control%nx, Land_IAU_Control%jsc, Land_IAU_Control%ny, & + it, 1, wk3_slc(it, :, :, i), status, errflg, errmsg) + if (errflg .ne. 0) return + end do + else + if (Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print *, 'warning! No increment for ',trim(slc_vars(i)),' found, assuming zero' + endif + wk3_slc(:, :, :, i) = 0. + endif + enddo + + !set too small increments to zero + where(abs(wk3_stc) < Land_IAU_Control%min_T_increment) wk3_stc = 0.0 + where(abs(wk3_slc) < Land_IAU_Control%min_SLC_increment) wk3_slc = 0.0 + + status =nf90_close(ncid) + call netcdf_err(status, 'closing file '//trim(fname), errflg, errmsg) + +end subroutine read_iau_forcing_fv3 + + !> Calculate soil mask for land on model grid. + !! Output is 1 - soil, 2 - snow-covered, 0 - land ice, -1 not land. + !! + !! @param[in] lensfc Number of land points for this tile + !! @param[in] veg_type_landice Value of vegetion class that indicates land-ice + !! @param[in] stype Soil type + !! @param[in] swe Model snow water equivalent + !! @param[in] vtype Model vegetation type + !! @param[out] mask Land mask for increments + !! @author Clara Draper @date March 2021 + !! @author Yuan Xue: introduce stype to make the mask calculation more generic + subroutine calculate_landinc_mask(swe,vtype,stype,lensfc,veg_type_landice, mask) + + implicit none + + integer, intent(in) :: lensfc, veg_type_landice + real(kind=kind_phys), intent(in) :: swe(lensfc) + integer, intent(in) :: vtype(lensfc),stype(lensfc) + integer, intent(out) :: mask(lensfc) + + integer :: i + + mask = -1 ! not land + + ! land (but not land-ice) + do i=1,lensfc + if (stype(i) .GT. 0) then + if (swe(i) .GT. 0.001) then ! snow covered land + mask(i) = 2 + else ! non-snow covered land + mask(i) = 1 + endif + end if ! else should work here too + if ( vtype(i) == veg_type_landice ) then ! land-ice + mask(i) = 0 + endif + end do + + end subroutine calculate_landinc_mask + + subroutine netcdf_err(ERR, STRING, errflg, errmsg_out) + + !-------------------------------------------------------------- + ! Process the error flag from a NETCDF call and return it as (human readable) MESSAGE + !-------------------------------------------------------------- + IMPLICIT NONE + + include 'mpif.h' + + INTEGER, INTENT(IN) :: ERR + CHARACTER(LEN=*), INTENT(IN) :: STRING + CHARACTER(LEN=80) :: ERRMSG + integer :: errflg + character(len=*) :: errmsg_out + + !Errors messages handled through CCPP error handling variables + errmsg_out = '' + errflg = 0 + + IF (ERR == NF90_NOERR) RETURN + ERRMSG = NF90_STRERROR(ERR) + errmsg_out = 'FATAL ERROR in Land IAU '//TRIM(STRING)//': '//TRIM(ERRMSG) + errflg = 1 + return + + end subroutine netcdf_err + + subroutine get_nc_dimlen(ncid, dim_name, dim_len, errflg, errmsg_out ) + integer, intent(in):: ncid + character(len=*), intent(in):: dim_name + integer, intent(out):: dim_len + integer :: dimid + integer :: errflg + character(len=*) :: errmsg_out + integer :: status + + !Errors messages handled through CCPP error handling variables + errmsg_out = '' + errflg = 0 + + status = nf90_inq_dimid(ncid, dim_name, dimid) + CALL netcdf_err(status, 'reading dim id '//trim(dim_name), errflg, errmsg_out) + if (errflg .ne. 0) return + status = nf90_inquire_dimension(ncid, dimid, len = dim_len) + CALL netcdf_err(status, 'reading dim length '//trim(dim_name), errflg, errmsg_out) + + end subroutine get_nc_dimlen + + subroutine get_var1d(ncid, dim_len, var_name, var_arr, errflg, errmsg_out) + integer, intent(in):: ncid, dim_len + character(len=*), intent(in):: var_name + real(kind=kind_phys), intent(out):: var_arr(dim_len) + integer :: errflg + character(len=*) :: errmsg_out + integer :: varid, status + + !Errors messages handled through CCPP error handling variables + errmsg_out = '' + errflg = 0 + + status = nf90_inq_varid(ncid, trim(var_name), varid) + call netcdf_err(status, 'getting varid: '//trim(var_name), errflg, errmsg_out) + if (errflg .ne. 0) return + + status = nf90_get_var(ncid, varid, var_arr) + call netcdf_err(status, 'reading var: '//trim(var_name), errflg, errmsg_out) + + end subroutine get_var1d + + subroutine get_var3d_values(ncid, varid, var_name, is,ix, js,jy, ks,kz, var3d, status, errflg, errmsg_out) + integer, intent(in):: ncid, varid + integer, intent(in):: is, ix, js, jy, ks,kz + character(len=*), intent(in):: var_name + real(kind=kind_phys), intent(out):: var3d(ix, jy, kz) + integer, intent(out):: status + integer :: errflg + character(len=*) :: errmsg_out + + !Errors messages handled through CCPP error handling variables + errmsg_out = '' + errflg = 0 + + status = nf90_get_var(ncid, varid, var3d, & + start = (/is, js, ks/), count = (/ix, jy, kz/)) + + call netcdf_err(status, 'get_var3d_values '//trim(var_name), errflg, errmsg_out) + + + end subroutine get_var3d_values + + subroutine get_var3d_values_int(ncid, varid, var_name, is,ix, js,jy, ks,kz, var3d, status, errflg, errmsg_out) + integer, intent(in):: ncid, varid + integer, intent(in):: is, ix, js, jy, ks,kz + character(len=*), intent(in):: var_name + integer, intent(out):: var3d(ix, jy, kz) + integer, intent(out):: status + integer :: errflg + character(len=*) :: errmsg_out + + !Errors messages handled through CCPP error handling variables + errmsg_out = '' + errflg = 0 + + status = nf90_get_var(ncid, varid, var3d, & !start = start, count = nreco) + start = (/is, js, ks/), count = (/ix, jy, kz/)) + + call netcdf_err(status, 'get_var3d_values_int '//trim(var_name), errflg, errmsg_out) + + end subroutine get_var3d_values_int + +end module land_iau_mod + + diff --git a/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.meta b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.meta new file mode 100644 index 000000000..8541af659 --- /dev/null +++ b/physics/SFC_Models/Land/Noahmp/lnd_iau_mod.meta @@ -0,0 +1,58 @@ +[ccpp-table-properties] + name = land_iau_external_data_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = land_iau_external_data_type + type = ddt + +######################################################################## + +[ccpp-table-properties] + name = land_iau_state_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = land_iau_state_type + type = ddt + +######################################################################## + +[ccpp-table-properties] + name = land_iau_control_type + type = ddt + dependencies = + +[ccpp-arg-table] + name = land_iau_control_type + type = ddt + +######################################################################## +[ccpp-table-properties] + name = land_iau_mod + type = module + dependencies = machine.F + +[ccpp-arg-table] + name = land_iau_mod + type = module +[land_iau_external_data_type] + standard_name = land_iau_external_data_type + long_name = definition of type land_iau_external_data_type + units = DDT + dimensions = () + type = land_iau_external_data_type +[land_iau_state_type] + standard_name = land_iau_state_type + long_name = definition of type land_iau_state_type + units = DDT + dimensions = () + type = land_iau_state_type +[land_iau_control_type] + standard_name = land_iau_control_type + long_name = definition of type land_iau_control_type + units = DDT + dimensions = () + type = land_iau_control_type diff --git a/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 index fcbe40a70..3b799002b 100644 --- a/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 +++ b/physics/SFC_Models/Land/Noahmp/module_sf_noahmp_glacier.F90 @@ -1,8 +1,12 @@ +#ifndef CCPP #define CCPP +#endif !> \file module_sf_noahmp_glacier.F90 !! This file contains the NoahMP Glacier scheme. !>\ingroup NoahMP_LSM + +!> This module contains the NoahMP Glacier scheme module noahmp_glacier_globals use machine , only : kind_phys @@ -77,6 +81,8 @@ end module noahmp_glacier_globals !------------------------------------------------------------------------------------------! !>\ingroup NoahMP_LSM + +!> This module contains NoahMP glacier routines module noahmp_glacier_routines use noahmp_glacier_globals #ifndef CCPP @@ -322,7 +328,7 @@ subroutine noahmp_glacier (& isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout dzsnso ,sh2o ,sice ,ponding ,zsnso ,fsh , & !inout runsrf ,runsub ,qsnow ,ponding1 ,ponding2 ,qsnbot , & !out - fpice ,esnow) !out + fpice ,esnow) !out if(opt_gla == 2) then edir = qvap - qdew @@ -634,7 +640,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair call tsnosoi_glacier (nsoil ,nsnow ,isnow ,dt ,tbot , & !in ssoil ,snowh ,zbot ,zsnso ,df , & !in - hcpct , & !in + hcpct , & !in stc ) !inout ! adjusting snow surface temperature @@ -779,8 +785,8 @@ subroutine csnow_glacier (isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso , do iz = isnow+1, 0 ! tksno(iz) = 3.2217e-6*bdsnoi(iz)**2. ! stieglitz(yen,1965) ! tksno(iz) = 2e-2+2.5e-6*bdsnoi(iz)*bdsnoi(iz) ! anderson, 1976 -! tksno(iz) = 0.35 ! constant - tksno(iz) = 2.576e-6*bdsnoi(iz)**2. + 0.074 ! verseghy (1991) + tksno(iz) = 0.35 ! constant +! tksno(iz) = 2.576e-6*bdsnoi(iz)**2. + 0.074 ! verseghy (1991) ! tksno(iz) = 2.22*(bdsnoi(iz)/1000.)**1.88 ! douvill(yen, 1981) enddo @@ -842,12 +848,14 @@ subroutine radiation_glacier (dt ,tg ,sneqvo ,sneqv ,cosz , & !in ! snow albedos: age even when sun is not present + if(cosz > 0) then if(opt_alb == 1) & call snowalb_bats_glacier (nband,cosz,fage,albsnd,albsni) if(opt_alb == 2) then call snowalb_class_glacier(nband,qsnow,dt,alb,albold,albsnd,albsni) albold = alb end if + end if ! zero summed solar fluxes @@ -974,8 +982,8 @@ subroutine snowalb_bats_glacier (nband,cosz,fage,albsnd,albsni) cf1=((1.+sl1)/(1.+sl2*cosz)-sl1) fzen=amax1(cf1,0.) - albsni(1)=0.95*(1.-c1*fage) - albsni(2)=0.65*(1.-c2*fage) + albsni(1)=0.95 !*(1.-c1*fage) ! remove aging over glaciers + albsni(2)=0.65 !*(1.-c2*fage) ! remove aging over glaciers albsnd(1)=albsni(1)+0.4*fzen*(1.-albsni(1)) ! vis direct albsnd(2)=albsni(2)+0.4*fzen*(1.-albsni(2)) ! nir direct @@ -1334,11 +1342,11 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso end if csh = rhoair*cpair/rahb - if(snowh > 0.0 .or. opt_gla == 1) then + if(snowh > 0.0 .or. opt_gla == 1) then cev = rhoair*cpair/gamma/(rsurf+rawb) - else - cev = 0.0 ! don't allow any sublimation of glacier in opt_gla=2 - end if + else + cev = 0.0 ! don't allow any sublimation of glacier in opt_gla=2 + end if ! surface fluxes and dtg @@ -1724,7 +1732,7 @@ end subroutine sfcdif1_glacier !>\ingroup NoahMP_LSM subroutine tsnosoi_glacier (nsoil ,nsnow ,isnow ,dt ,tbot , & !in ssoil ,snowh ,zbot ,zsnso ,df , & !in - hcpct , & !in + hcpct , & !in stc ) !inout ! -------------------------------------------------------------------------------------------------- !> compute snow (up to 3l) and soil (4l) temperature. note that snow temperatures @@ -2216,11 +2224,11 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & if (heatr(1) > 0.) then xm(1) = heatr(1)*dt/hfus hm(1) = heatr(1) - imelt(1) = 1 + imelt(1) = 1 else xm(1) = 0. hm(1) = 0. - imelt(1) = 0 + imelt(1) = 0 endif qmelt = max(0.,(temp1-sneqv))/dt xmf = hfus*qmelt @@ -2267,21 +2275,21 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & if (any(stc(1:4) > tfrz) .and. any(stc(1:4) < tfrz)) then do j = 1,nsoil if ( stc(j) > tfrz ) then - heatr(j) = (stc(j)-tfrz)/fact(j) + heatr(j) = (stc(j)-tfrz)/fact(j) do k = 1,nsoil - if (j .ne. k .and. stc(k) < tfrz .and. heatr(j) > 0.1) then - heatr(k) = (stc(k)-tfrz)/fact(k) - if (abs(heatr(k)) > heatr(j)) then ! layer absorbs all - heatr(k) = heatr(k) + heatr(j) - stc(k) = tfrz + heatr(k)*fact(k) - heatr(j) = 0.0 + if (j .ne. k .and. stc(k) < tfrz .and. heatr(j) > 0.1) then + heatr(k) = (stc(k)-tfrz)/fact(k) + if (abs(heatr(k)) > heatr(j)) then ! layer absorbs all + heatr(k) = heatr(k) + heatr(j) + stc(k) = tfrz + heatr(k)*fact(k) + heatr(j) = 0.0 else - heatr(j) = heatr(j) + heatr(k) - heatr(k) = 0.0 - stc(k) = tfrz + heatr(j) = heatr(j) + heatr(k) + heatr(k) = 0.0 + stc(k) = tfrz end if - end if - end do + end if + end do stc(j) = tfrz + heatr(j)*fact(j) end if end do @@ -2292,21 +2300,21 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & if (any(stc(1:4) > tfrz) .and. any(stc(1:4) < tfrz)) then do j = 1,nsoil if ( stc(j) < tfrz ) then - heatr(j) = (stc(j)-tfrz)/fact(j) + heatr(j) = (stc(j)-tfrz)/fact(j) do k = 1,nsoil - if (j .ne. k .and. stc(k) > tfrz .and. heatr(j) < -0.1) then - heatr(k) = (stc(k)-tfrz)/fact(k) - if (heatr(k) > abs(heatr(j))) then ! layer absorbs all - heatr(k) = heatr(k) + heatr(j) - stc(k) = tfrz + heatr(k)*fact(k) - heatr(j) = 0.0 + if (j .ne. k .and. stc(k) > tfrz .and. heatr(j) < -0.1) then + heatr(k) = (stc(k)-tfrz)/fact(k) + if (heatr(k) > abs(heatr(j))) then ! layer absorbs all + heatr(k) = heatr(k) + heatr(j) + stc(k) = tfrz + heatr(k)*fact(k) + heatr(j) = 0.0 else - heatr(j) = heatr(j) + heatr(k) - heatr(k) = 0.0 - stc(k) = tfrz + heatr(j) = heatr(j) + heatr(k) + heatr(k) = 0.0 + stc(k) = tfrz end if - end if - end do + end if + end do stc(j) = tfrz + heatr(j)*fact(j) end if end do @@ -2317,25 +2325,25 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & if (any(stc(1:4) > tfrz) .and. any(mice(1:4) > 0.)) then do j = 1,nsoil if ( stc(j) > tfrz ) then - heatr(j) = (stc(j)-tfrz)/fact(j) + heatr(j) = (stc(j)-tfrz)/fact(j) xm(j) = heatr(j)*dt/hfus do k = 1,nsoil - if (j .ne. k .and. mice(k) > 0. .and. xm(j) > 0.1) then - if (mice(k) > xm(j)) then ! layer absorbs all - mice(k) = mice(k) - xm(j) - xmf = xmf + hfus * xm(j)/dt - stc(k) = tfrz - xm(j) = 0.0 + if (j .ne. k .and. mice(k) > 0. .and. xm(j) > 0.1) then + if (mice(k) > xm(j)) then ! layer absorbs all + mice(k) = mice(k) - xm(j) + xmf = xmf + hfus * xm(j)/dt + stc(k) = tfrz + xm(j) = 0.0 else - xm(j) = xm(j) - mice(k) - xmf = xmf + hfus * mice(k)/dt - mice(k) = 0.0 - stc(k) = tfrz + xm(j) = xm(j) - mice(k) + xmf = xmf + hfus * mice(k)/dt + mice(k) = 0.0 + stc(k) = tfrz end if mliq(k) = max(0.,wmass0(k)-mice(k)) - end if - end do - heatr(j) = xm(j)*hfus/dt + end if + end do + heatr(j) = xm(j)*hfus/dt stc(j) = tfrz + heatr(j)*fact(j) end if end do @@ -2346,25 +2354,25 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & if (any(stc(1:4) < tfrz) .and. any(mliq(1:4) > 0.)) then do j = 1,nsoil if ( stc(j) < tfrz ) then - heatr(j) = (stc(j)-tfrz)/fact(j) + heatr(j) = (stc(j)-tfrz)/fact(j) xm(j) = heatr(j)*dt/hfus do k = 1,nsoil - if (j .ne. k .and. mliq(k) > 0. .and. xm(j) < -0.1) then - if (mliq(k) > abs(xm(j))) then ! layer absorbs all - mice(k) = mice(k) - xm(j) - xmf = xmf + hfus * xm(j)/dt - stc(k) = tfrz - xm(j) = 0.0 + if (j .ne. k .and. mliq(k) > 0. .and. xm(j) < -0.1) then + if (mliq(k) > abs(xm(j))) then ! layer absorbs all + mice(k) = mice(k) - xm(j) + xmf = xmf + hfus * xm(j)/dt + stc(k) = tfrz + xm(j) = 0.0 else - xm(j) = xm(j) + mliq(k) - xmf = xmf - hfus * mliq(k)/dt - mice(k) = wmass0(k) - stc(k) = tfrz + xm(j) = xm(j) + mliq(k) + xmf = xmf - hfus * mliq(k)/dt + mice(k) = wmass0(k) + stc(k) = tfrz end if mliq(k) = max(0.,wmass0(k)-mice(k)) - end if - end do - heatr(j) = xm(j)*hfus/dt + end if + end do + heatr(j) = xm(j)*hfus/dt stc(j) = tfrz + heatr(j)*fact(j) end if end do @@ -2396,7 +2404,7 @@ subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout dzsnso ,sh2o ,sice ,ponding ,zsnso ,fsh , & !inout runsrf ,runsub ,qsnow ,ponding1 ,ponding2 ,qsnbot , & !out - fpice ,esnow) !out + fpice ,esnow) !out ! ---------------------------------------------------------------------- ! code history: ! initial code: guo-yue niu, oct. 2007 @@ -2567,7 +2575,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in ficeold ,zsoil , & !in isnow ,snowh ,sneqv ,snice ,snliq , & !inout sh2o ,sice ,stc ,dzsnso ,zsnso , & !inout - fsh , & !inout + fsh , & !inout qsnbot ,snoflow ,ponding1 ,ponding2) !out ! ---------------------------------------------------------------------- implicit none @@ -2608,7 +2616,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in ! local integer :: iz real (kind=kind_phys) :: bdsnow !< bulk density of snow (kg/m3) - real (kind=kind_phys),parameter :: mwd = 100. !< maximum water depth (mm) + real (kind=kind_phys),parameter :: mwd = 600. !< maximum water depth (mm) ! ---------------------------------------------------------------------- snoflow = 0.0 ponding1 = 0.0 @@ -2624,15 +2632,41 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in snliq ,imelt ,ficeold, & !in isnow ,dzsnso ) !inout + if(isnow < 0) & !when multi-layer call combine_glacier (nsnow ,nsoil , & !in isnow ,sh2o ,stc ,snice ,snliq , & !inout dzsnso ,sice ,snowh ,sneqv , & !inout ponding1 ,ponding2) !out + if(isnow < 0) & !when multi-layer call divide_glacier (nsnow ,nsoil , & !in isnow ,stc ,snice ,snliq ,dzsnso ) !inout end if + call snowh2o_glacier (nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in + qrain , & !in + isnow ,dzsnso ,snowh ,sneqv ,snice , & !inout + snliq ,sh2o ,sice ,stc , & !inout + ponding1 ,ponding2 ,fsh , & !inout + qsnbot ) !out + +!reset the glacier to 2m depth with 600mm SWE + + isnow = -3 + snice(-2) = 15.0 + snice(-1) = 60.0 + snice( 0) = 525.0 + snliq(-2) = 0.0 + snliq(-1) = 0.0 + snliq( 0) = 0.0 + if(stc( 0) < 100.0) stc( 0) = stc( 1) ! if the temperature is missing, + if(stc(-1) < 100.0) stc(-1) = stc( 0) ! set to layer below + if(stc(-2) < 100.0) stc(-2) = stc(-1) ! should not be necessary + dzsnso(-2)= 0.05 + dzsnso(-1)= 0.20 + dzsnso( 0)= 1.75 + sneqv = 600.0 + !set empty snow layers to zero do iz = -nsnow+1, isnow @@ -2643,16 +2677,9 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in zsnso(iz) = 0. enddo - call snowh2o_glacier (nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in - qrain , & !in - isnow ,dzsnso ,snowh ,sneqv ,snice , & !inout - snliq ,sh2o ,sice ,stc , & !inout - ponding1 ,ponding2 ,fsh , & !inout - qsnbot ) !out - !to obtain equilibrium state of snow in glacier region - if(sneqv > mwd .and. isnow /= 0) then ! 100 mm -> maximum water depth + if(sneqv > mwd) then ! 600 mm -> maximum water depth bdsnow = snice(0) / dzsnso(0) snoflow = (sneqv - mwd) snice(0) = snice(0) - snoflow @@ -2662,7 +2689,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in ! sum up snow mass for layered snow - if(isnow /= 0) then + if(isnow < 0) then sneqv = 0. snowh = 0. do iz = isnow+1,0 @@ -2738,7 +2765,7 @@ subroutine snowfall_glacier (nsoil ,nsnow ,dt ,qsnow ,snowhin , & !in ! creating a new layer - if(isnow == 0 .and. qsnow>0. .and. snowh >= 0.05) then + if(isnow == 0 .and. qsnow>0. .and. snowh >= 0.025) then isnow = -1 newnode = 1 dzsnso(0)= snowh @@ -2896,8 +2923,8 @@ subroutine combine_glacier (nsnow ,nsoil , & !in real (kind=kind_phys) :: zwice !< total ice mass in snow real (kind=kind_phys) :: zwliq !< total liquid water in snow real (kind=kind_phys) :: dzmin(3) !< minimum of top snow layer - data dzmin /0.045, 0.05, 0.2/ -! data dzmin /0.025, 0.025, 0.1/ ! mb: change limit +! data dzmin /0.045, 0.05, 0.2/ + data dzmin /0.025, 0.025, 0.1/ ! mb: change limit !----------------------------------------------------------------------- isnow_old = isnow @@ -2907,17 +2934,29 @@ subroutine combine_glacier (nsnow ,nsoil , & !in if(j /= 0) then snliq(j+1) = snliq(j+1) + snliq(j) snice(j+1) = snice(j+1) + snice(j) + dzsnso(j+1) = dzsnso(j+1) + dzsnso(j) else if (isnow_old < -1) then snliq(j-1) = snliq(j-1) + snliq(j) snice(j-1) = snice(j-1) + snice(j) + dzsnso(j-1) = dzsnso(j-1) + dzsnso(j) else - ponding1 = ponding1 + snliq(j) ! isnow will get set to zero below - sneqv = snice(j) ! ponding will get added to ponding from - snowh = dzsnso(j) ! phasechange which should be zero here - snliq(j) = 0.0 ! because there it was only calculated - snice(j) = 0.0 ! for thin snow - dzsnso(j) = 0.0 + if(snice(j) >= 0.) then + ponding1 = snliq(j) ! isnow will get set to zero below; ponding1 will get + sneqv = snice(j) ! added to ponding from phasechange ponding should be + snowh = dzsnso(j) ! zero here because it was calculated for thin snow + else ! snice over-sublimated earlier + ponding1 = snliq(j) + snice(j) + if(ponding1 < 0.) then ! if snice and snliq sublimates remove from soil + sice(1) = max(0.0,sice(1)+ponding1/(dzsnso(1)*1000.)) + ponding1 = 0.0 + end if + sneqv = 0.0 + snowh = 0.0 + end if + snliq(j) = 0.0 + snice(j) = 0.0 + dzsnso(j) = 0.0 endif ! sh2o(1) = sh2o(1)+snliq(j)/(dzsnso(1)*1000.) ! sice(1) = sice(1)+snice(j)/(dzsnso(1)*1000.) @@ -2960,8 +2999,8 @@ subroutine combine_glacier (nsnow ,nsoil , & !in ! check the snow depth - all snow gone ! the liquid water assumes ponding on soil surface. -! if (snowh < 0.025 .and. isnow < 0 ) then ! mb: change limit - if (snowh < 0.05 .and. isnow < 0 ) then + if (snowh < 0.025 .and. isnow < 0 ) then ! mb: change limit +! if (snowh < 0.05 .and. isnow < 0 ) then isnow = 0 sneqv = zwice ponding2 = ponding2 + zwliq ! limit of isnow < 0 means input ponding @@ -3159,8 +3198,8 @@ subroutine divide_glacier (nsnow ,nsoil , & !in zwliq, zwice, tsno(1)) ! subdivide a new layer -! if (msno <= 2 .and. dz(2) > 0.20) then ! mb: change limit - if (msno <= 2 .and. dz(2) > 0.10) then + if (msno <= 2 .and. dz(2) > 0.20) then ! mb: change limit +! if (msno <= 2 .and. dz(2) > 0.10) then msno = 3 dtdz = (tsno(1) - tsno(2))/((dz(1)+dz(2))/2.) dz(2) = dz(2)/2. @@ -3287,6 +3326,7 @@ subroutine snowh2o_glacier (nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in sneqv = sneqv - qsnsub*dt + qsnfro*dt propor = sneqv/temp snowh = max(0.,propor * snowh) + snowh = min(max(snowh,sneqv/500.0),sneqv/50.0) ! limit adjustment to a reasonable density elseif(opt_gla == 2) then fsh = fsh - (qsnfro-qsnsub)*hsub qsnfro = 0.0 @@ -3489,6 +3529,7 @@ end subroutine noahmp_options_glacier end module noahmp_glacier_routines ! ================================================================================================== +!> This module contains the interface of noahmp_glacier_routines and noahmp_glacier_globals module module_sf_noahmp_glacier use noahmp_glacier_routines diff --git a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 index 6abd59f69..13decd0be 100644 --- a/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 +++ b/physics/SFC_Models/Land/Noahmp/module_sf_noahmplsm.F90 @@ -1,4 +1,6 @@ +#ifndef CCPP #define CCPP +#endif !> \file module_sf_noahmplsm.F90 !! This file contains the NoahMP land surface model. @@ -424,7 +426,7 @@ subroutine noahmp_sflx (parameters, & sfctmp , sfcprs , psfc , uu , vv , q2, garea1 , & ! in : forcing qc , soldn , lwdn,thsfc_loc, prslkix,prsik1x,prslk1x,& ! in : forcing pblhx , iz0tlnd , itime ,psi_opt ,& - prcpconv, prcpnonc, prcpshcv, prcpsnow, prcpgrpl, prcphail, & ! in : forcing + prcpconv, prcpnonc, prcpshcv, prcpsnow, prcpgrpl, prcphail, & ! in : forcing tbot , co2air , o2air , foln , ficeold , zlvl , & ! in : forcing ep_1 , ep_2 , epsm1 , cp , & ! in : constants albold , sneqvo , & ! in/out : @@ -436,7 +438,7 @@ subroutine noahmp_sflx (parameters, & cm , ch , tauss , & ! in/out : grain , gdd , pgs , & ! in/out smcwtd ,deeprech , rech , ustarx , & ! in/out : - z0wrf , z0hwrf , ts , & ! out : + z0wrf , z0hwrf , ts , & ! out : fsa , fsr , fira , fsh , ssoil , fcev , & ! out : fgev , fctr , ecan , etran , edir , trad , & ! out : tgb , tgv , t2mv , t2mb , q2v , q2b , & ! out : @@ -445,9 +447,9 @@ subroutine noahmp_sflx (parameters, & qsnbot , ponding , ponding1, ponding2, rssun , rssha , & ! out : albd , albi , albsnd , albsni , & ! out : bgap , wgap , chv , chb , emissi , & ! out : - shg , shc , shb , evg , evb , ghv , & ! out : - ghb , irg , irc , irb , tr , evc , & ! out : - chleaf , chuc , chv2 , chb2 , fpice , pahv , & + shg , shc , shb , evg , evb , ghv , & ! out : + ghb , irg , irc , irb , tr , evc , & ! out : + chleaf , chuc , chv2 , chb2 , fpice , pahv , & pahg , pahb , pah , esnow , canhs , laisun , & laisha , rb , qsfcveg , qsfcbare & #ifdef CCPP @@ -819,7 +821,7 @@ subroutine noahmp_sflx (parameters, & canliq ,canice ,tv ,sfctmp ,tg , & !in qintr ,qdripr ,qthror ,qints ,qdrips ,qthros , & !out pahv ,pahg ,pahb ,qrain ,qsnow ,snowhin, & !out - fwet ,cmc ) !out + fwet ,cmc ) !out ! compute energy budget (momentum & energy fluxes and phase changes) @@ -833,7 +835,7 @@ subroutine noahmp_sflx (parameters, & qsnow ,dzsnso ,lat ,canliq ,canice ,iloc, jloc , & !in thsfc_loc, prslkix,prsik1x,prslk1x,garea1, & !in pblhx ,iz0tlnd, itime ,psi_opt, ep_1, ep_2, epsm1,cp, & - z0wrf ,z0hwrf , & !out + z0wrf ,z0hwrf , & !out imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out @@ -854,7 +856,7 @@ subroutine noahmp_sflx (parameters, & fsrg ,rssun ,rssha ,albd ,albi ,albsnd,albsni, bgap ,wgap, tgv,tgb,& q1 ,q2v ,q2b ,q2e ,chv ,chb , & !out emissi ,pah ,canhs, & - shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out + shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out qsfcveg = eah*ep_2/(sfcprs + epsm1*eah) qsfcbare = qsfc @@ -877,7 +879,7 @@ subroutine noahmp_sflx (parameters, & esai ,sfctmp ,qvap ,qdew ,zsoil ,btrani , & !in ficeold,ponding,tg ,ist ,fveg ,iloc,jloc , smceq , & !in bdfall ,fp ,rain ,snow , & !in mb/an: v3.7 - qsnow ,qrain ,snowhin,latheav,latheag,frozen_canopy,frozen_ground, & !in mb + qsnow ,qrain ,snowhin,latheav,latheag,frozen_canopy,frozen_ground, & !in mb isnow ,canliq ,canice ,tv ,snowh ,sneqv , & !inout snice ,snliq ,stc ,zsnso ,sh2o ,smc , & !inout sice ,zwt ,wa ,wt ,dzsnso ,wslake , & !inout @@ -911,9 +913,9 @@ subroutine noahmp_sflx (parameters, & if (opt_crop == 1 .and. crop_active) then call carbon_crop (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil ,julian , & !in dzsnso ,stc ,smc ,tv ,psn ,foln ,btran , & !in - soldn ,t2m , & !in + soldn ,t2m , & !in lfmass ,rtmass ,stmass ,wood ,stblcp ,fastcp ,grain , & !inout - lai ,sai ,gdd , & !inout + lai ,sai ,gdd , & !inout gpp ,npp ,nee ,autors ,heters ,totsc ,totlb, pgs ) !out end if @@ -964,7 +966,7 @@ subroutine atm (parameters,ep_2,epsm1,sfcprs ,sfctmp ,q2 , & prcpconv,prcpnonc ,prcpshcv,prcpsnow,prcpgrpl,prcphail , & soldn ,cosz ,thair ,qair , & eair ,rhoair ,qprecc ,qprecl ,solad , solai , & - swdown ,bdfall ,rain ,snow ,fp , fpice ,prcp ) + swdown ,bdfall ,rain ,snow ,fp , fpice ,prcp ) ! -------------------------------------------------------------------------------------------------- ! re-process atmospheric forcing ! ---------------------------------------------------------------------- @@ -1037,7 +1039,7 @@ subroutine atm (parameters,ep_2,epsm1,sfcprs ,sfctmp ,q2 , & if(opt_snf == 4) then qprecc = prcpconv + prcpshcv - qprecl = prcpnonc + qprecl = prcpnonc else qprecc = 0.10 * prcp ! should be from the atmospheric model qprecl = 0.90 * prcp ! should be from the atmospheric model @@ -1090,13 +1092,13 @@ subroutine atm (parameters,ep_2,epsm1,sfcprs ,sfctmp ,q2 , & if(opt_snf == 4 .or. opt_snf == 5) then prcp_frozen = prcpsnow + prcpgrpl + prcphail if(prcpnonc > 0. .and. prcp_frozen > 0.) then - fpice = min(1.0,prcp_frozen/prcpnonc) - fpice = max(0.0,fpice) + fpice = min(1.0,prcp_frozen/prcpnonc) + fpice = max(0.0,fpice) if(opt_snf==4) bdfall = bdfall*(prcpsnow/prcp_frozen) + rho_grpl*(prcpgrpl/prcp_frozen) + & rho_hail*(prcphail/prcp_frozen) if(opt_snf==5) bdfall = parameters%prcpiceden - else - fpice = 0.0 + else + fpice = 0.0 endif endif @@ -1233,8 +1235,8 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv bdfall ,rain ,snow ,fp , & !in canliq ,canice ,tv ,sfctmp ,tg , & !in qintr ,qdripr ,qthror ,qints ,qdrips ,qthros , & !out - pahv ,pahg ,pahb ,qrain ,qsnow ,snowhin, & !out - fwet ,cmc ) !out + pahv ,pahg ,pahb ,qrain ,qsnow ,snowhin, & !out + fwet ,cmc ) !out ! ------------------------ code history ------------------------------ ! michael barlage: oct 2013 - split canwater to calculate precip movement for @@ -1336,10 +1338,10 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv qintr = 0. qdripr = 0. qthror = rain - if(canliq > 0.) then ! for case of canopy getting buried - qdripr = qdripr + canliq/dt - canliq = 0.0 - end if + if(canliq > 0.) then ! for case of canopy getting buried + qdripr = qdripr + canliq/dt + canliq = 0.0 + end if end if ! heat transported by liquid water @@ -1363,7 +1365,7 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv ft = max(0.0,(tv - 270.15) / 1.87e5) fv = sqrt(uu*uu + vv*vv) / 1.56e5 ! mb: changed below to reflect the rain assumption that all precip gets intercepted - icedrip = max(0.,canice) * (fv+ft) !mb: removed /dt + icedrip = max(0.,canice) * (fv+ft) !mb: removed /dt qdrips = (fveg * snow - qints) + icedrip qthros = (1.0-fveg) * snow canice= max(0.,canice + (qints - icedrip)*dt) @@ -1371,10 +1373,10 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv qints = 0. qdrips = 0. qthros = snow - if(canice > 0.) then ! for case of canopy getting buried - qdrips = qdrips + canice/dt - canice = 0.0 - end if + if(canice > 0.) then ! for case of canopy getting buried + qdrips = qdrips + canice/dt + canice = 0.0 + end if endif ! print*, "precip_heat canopy through:",3600.0*(fveg * snow - qints) ! print*, "precip_heat canopy drip:",3600.0*max(0.,canice) * (fv+ft) @@ -1404,13 +1406,13 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv if (fveg > 0.0 .and. fveg < 1.0) then pahg = pahg / fveg ! these will be multiplied by fraction later - pahb = pahb / (1.0-fveg) + pahb = pahb / (1.0-fveg) elseif (fveg <= 0.0) then pahb = pahg + pahb ! for case of canopy getting buried pahg = 0.0 - pahv = 0.0 + pahv = 0.0 elseif (fveg >= 1.0) then - pahb = 0.0 + pahb = 0.0 end if pahv = max(pahv,-20.0) ! put some artificial limits here for stability @@ -1677,7 +1679,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in qsnow ,dzsnso ,lat ,canliq ,canice ,iloc , jloc, & !in thsfc_loc, prslkix,prsik1x,prslk1x,garea1, & !in pblhx , iz0tlnd, itime,psi_opt,ep_1, ep_2, epsm1, cp, & - z0wrf ,z0hwrf , & !out + z0wrf ,z0hwrf , & !out imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out @@ -1697,7 +1699,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in t2mv ,t2mb ,fsrv , & fsrg ,rssun ,rssha ,albd ,albi,albsnd ,albsni,bgap ,wgap,tgv,tgb,& q1 ,q2v ,q2b ,q2e ,chv ,chb, emissi,pah,canhs,& - shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out + shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out !jref:end ! -------------------------------------------------------------------------------------------------- @@ -1989,7 +1991,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real (kind=kind_phys), parameter :: mpe = 1.e-6 real (kind=kind_phys), parameter :: psiwlt = -150. !metric potential for wilting point (m) - real (kind=kind_phys), parameter :: z0 = 0.002 ! bare-soil roughness length (m) (i.e., under the canopy) + real (kind=kind_phys), parameter :: z0 = 0.015 ! bare-soil roughness length (m) (i.e., under the canopy) ! --------------------------------------------------------------------------------------------------- ! initialize fluxes from veg. fraction @@ -2013,6 +2015,8 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in chuc = 0. chv2 = 0. rb = 0. + laisun = 0. + laisha = 0. cdmnv = 0.0 ezpdv = 0.0 @@ -2209,19 +2213,19 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in if (tv .gt. tfrz) then ! barlage: add distinction between ground and latheav = hvap ! vegetation in v3.6 - frozen_canopy = .false. + frozen_canopy = .false. else latheav = hsub - frozen_canopy = .true. + frozen_canopy = .true. end if gammav = cpair*sfcprs/(ep_2*latheav) if (tg .gt. tfrz) then latheag = hvap - frozen_ground = .false. + frozen_ground = .false. else latheag = hsub - frozen_ground = .true. + frozen_ground = .true. end if gammag = cpair*sfcprs/(ep_2*latheag) @@ -2263,7 +2267,8 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in csigmaf1, & !out !jref:start qc ,qsfc ,psfc , & !in - q2v ,chv2, chleaf, chuc) !inout + q2v ,chv2 ,chleaf ,chuc , & + rb) !out ! new coupling code @@ -2331,7 +2336,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in ssoil = fveg * ghv + (1.0 - fveg) * ghb fcev = evc fctr = tr - pah = fveg * pahg + (1.0 - fveg) * pahb + pahv + pah = fveg * pahg + (1.0 - fveg) * pahb + pahv tg = fveg * tgv + (1.0 - fveg) * tgb t2m = fveg * t2mv + (1.0 - fveg) * t2mb ts = fveg * tah + (1.0 - fveg) * tgb @@ -2361,7 +2366,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in t2m = t2mb fcev = 0. fctr = 0. - pah = pahb + pah = pahb ts = tg cm = cmb ch = chb @@ -2508,7 +2513,19 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , real (kind=kind_phys), dimension(-nsnow+1: 0) :: tksno !snow thermal conductivity (j/m3/k) real (kind=kind_phys), dimension( 1:nsoil) :: sice !soil ice content real (kind=kind_phys), parameter :: sbeta = -2.0 + real (kind=kind_phys), dimension(4,20) :: soil_carbon ! soil carbon content [kg/m3] + real (kind=kind_phys), parameter :: soil_carbon_df = 0.25 ! soil carbon therm cond (Lawrence and Slater) + real (kind=kind_phys), parameter :: soil_carbon_hcpct = 2.5e6 ! soil carbon heat capacity (Lawrence and Slater) ! -------------------------------------------------------------------------------------------------- +! soil carbon [kg/m3] by vegetation type estimated from global PNNL soil carbon dataset +! and VIIRS surface type + + soil_carbon(1,:) = (/90,65,90,65,90,40,50,50,40,50,90,60,60,60,0,20,0,90,90,60/) + soil_carbon(2,:) = (/40,30,40,30,40,25,30,30,25,30,40,30,30,30,0,15,0,60,60,40/) + soil_carbon(3,:) = (/20,15,20,15,20,15,20,15,15,15,25,20,20,20,0,10,0,40,40,30/) + soil_carbon(4,:) = (/15,10,15,10,15,10,15,10,10,10,20,10,10,10,0,10,0,40,30,20/) + + soil_carbon = soil_carbon / 130.0 ! convert to soil carbon relative to peat ! compute snow thermal conductivity and heat capacity @@ -2527,6 +2544,11 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , hcpct(iz) = sh2o(iz)*cwat + (1.0-parameters%smcmax(iz))*parameters%csoil & + (parameters%smcmax(iz)-smc(iz))*cpair + sice(iz)*cice call tdfcnd (parameters,iz,df(iz), smc(iz), sh2o(iz)) + +! adjust for soil carbon organic content + +! hcpct(iz) = (1.0 - soil_carbon(iz,vegtyp)) * hcpct(iz) + soil_carbon(iz,vegtyp) * soil_carbon_hcpct + df(iz) = (1.0 - soil_carbon(iz,vegtyp)) * df(iz) + soil_carbon(iz,vegtyp) * soil_carbon_df end do if ( parameters%urban_flag ) then @@ -2626,10 +2648,10 @@ subroutine csnow (parameters,isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso ! thermal conductivity of snow do iz = isnow+1, 0 -! tksno(iz) = 3.2217e-6*bdsnoi(iz)**2. ! stieglitz(yen,1965) +! tksno(iz) = 3.2217e-6*bdsnoi(iz)**2. ! stieglitz(yen,1965) ! tksno(iz) = 2e-2+2.5e-6*bdsnoi(iz)*bdsnoi(iz) ! anderson, 1976 -! tksno(iz) = 0.35 ! constant - tksno(iz) = 2.576e-6*bdsnoi(iz)**2. + 0.074 ! verseghy (1991) + tksno(iz) = 0.35 ! constant +! tksno(iz) = 2.576e-6*bdsnoi(iz)**2. + 0.074 ! verseghy (1991) ! tksno(iz) = 2.22*(bdsnoi(iz)/1000.)**1.88 ! douvill(yen, 1981) enddo @@ -3000,7 +3022,11 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in if (ib.eq.1) fsun = 0. end do - if(cosz <= 0) goto 100 +! snow age + + call snow_age (parameters,dt,tg,sneqvo,sneqv,tauss,fage) + + if(cosz > 0) then ! weight reflectance/transmittance by lai and sai @@ -3012,10 +3038,6 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in tau(ib) = max(parameters%taul(ib)*wl+parameters%taus(ib)*ws, mpe) end do -! snow age - - call snow_age (parameters,dt,tg,sneqvo,sneqv,tauss,fage) - ! snow albedos: only if cosz > 0 and fsno > 0 if(opt_alb == 1) & @@ -3064,8 +3086,7 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in wl = ext end if fsun = wl - -100 continue + end if end subroutine albedo @@ -3532,7 +3553,7 @@ subroutine twostream (parameters,ib ,ic ,vegtyp ,cosz ,vai , & ! kopen = 1.0 else if(opt_rad == 1) then - denfveg = -log(max(1.0-fveg,0.01))/(pai*parameters%rc**2) + denfveg = -log(max(1.0-fveg,0.01))/(pai*parameters%rc**2) hd = parameters%hvt - parameters%hvb bb = 0.5 * hd thetap = atan(bb/parameters%rc * tan(acos(max(0.01,cosz))) ) @@ -3712,7 +3733,8 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & t2mv ,psnsun ,psnsha ,canhs , & !out csigmaf1, & !out qc ,qsfc ,psfc , & !in - q2v ,cah2 ,chleaf ,chuc ) !inout + q2v ,cah2 ,chleaf ,chuc , & !inout + rb) !out ! -------------------------------------------------------------------------------------------------- ! use newton-raphson iteration to solve for vegetation (tv) and @@ -3836,6 +3858,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & real (kind=kind_phys), intent(out) :: chuc !< under canopy exchange coefficient real (kind=kind_phys), intent(out) :: canhs !< canopy heat storage change (w/m2) real (kind=kind_phys), intent(out) :: q2v !< + real (kind=kind_phys), intent(out) :: rb !< bulk leaf boundary layer resistance (s/m) real (kind=kind_phys) :: cah !< sensible heat conductance, canopy air to zlvl air (m/s) real (kind=kind_phys) :: u10v !< 10 m wind speed in eastward dir (m/s) real (kind=kind_phys) :: v10v !< 10 m wind speed in eastward dir (m/s) @@ -3852,7 +3875,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & real (kind=kind_phys) :: z0mo !roughness length for intermediate output only (m) real (kind=kind_phys) :: z0h !roughness length, sensible heat (m) real (kind=kind_phys) :: z0hg !roughness length, sensible heat (m) - real (kind=kind_phys) :: rb !bulk leaf boundary layer resistance (s/m) real (kind=kind_phys) :: ramc !aerodynamic resistance for momentum (s/m) real (kind=kind_phys) :: rahc !aerodynamic resistance for sensible heat (s/m) real (kind=kind_phys) :: rawc !aerodynamic resistance for water vapor (s/m) @@ -4052,11 +4074,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & end if -! prepare for longwave rad. - - air = -emv*(1.+(1.-emv)*(1.-emg))*lwdn - emv*emg*sb*tg**4 - cir = (2.-emv*(1.-emg))*emv*sb -! if(opt_sfc == 4) then gdx = sqrt(garea1) @@ -4203,6 +4220,11 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & end if end if +! prepare for longwave rad. + + air = -emv*(1.+(1.-emv)*(1.-emg))*lwdn - emv*emg*sb*tg**4 + cir = (2.-emv*(1.-emg))*emv*sb + ! prepare for sensible heat flux above veg. cah = 1./rahc @@ -4243,11 +4265,11 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & shc = fveg*rhoair*cpair*cvh * ( tv-tah) evc = fveg*rhoair*cpair*cew * (estv-eah) / gammav ! barlage: change to v in v3.6 tr = fveg*rhoair*cpair*ctw * (estv-eah) / gammav - if (tv > tfrz) then + if (tv > tfrz) then evc = min(canliq*latheav/dt,evc) ! barlage: add if block for canice in v3.6 - else + else evc = min(canice*latheav/dt,evc) - end if + end if ! canopy heat capacity hcv = fveg*(parameters%cbiom*vaie*cwat + canliq*cwat/denh2o + canice*cice/denice) !j/m2/k @@ -4265,7 +4287,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & ! update vegetation surface temperature tv = tv + dtv -! tah = ata + bta*tv ! canopy air t; update here for consistency + tah = ata + bta*tv ! canopy air t; update here for consistency ! for computing m-o length in the next iteration h = rhoair*cpair*(tah - sfctmp) /rahc @@ -4278,15 +4300,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & qfx = (qsfc-qair)*rhoair*caw endif - - if (liter == 1) then - exit loop1 - endif - if (iter >= 5 .and. abs(dtv) <= 0.01 .and. liter == 0) then - liter = 1 - endif - - end do loop1 ! end stability iteration +! after canopy balance, do the under-canopy ground balance ! under-canopy fluxes and tg @@ -4296,8 +4310,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & cev = rhoair*cpair / (gammag*(rawg+rsurf)) ! barlage: change to ground v3.6 cgh = 2.*df(isnow+1)/dzsnso(isnow+1) - loop2: do iter = 1, niterg - t = tdc(tg) call esat(t, esatw, esati, dsatw, dsati) if (t .gt. 0.) then @@ -4323,7 +4335,14 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & gh = gh + cgh*dtg tg = tg + dtg - end do loop2 + if (liter == 1) then + exit loop1 + endif + if (iter >= 5 .and. abs(dtv) <= 0.01 .and. abs(dtg) <= 0.01 .and. liter == 0) then + liter = 1 ! if conditions are met, then do one final loop + endif + + end do loop1 ! tah = (cah*sfctmp + cvh*tv + cgh*tg)/(cah + cvh + cgh) @@ -5820,7 +5839,8 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, if (opt_trs == z0heqz0m) then - z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) +! z0m_out = exp(fveg * log(z0m) + (1.0 - fveg) * log(z0mg)) + z0m_out = fveg * z0m + (1.0 - fveg) * z0mg z0h_out = z0m_out elseif (opt_trs == chen09) then @@ -5837,7 +5857,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, endif z0h_out = exp( fveg * log(z0m * exp(-czil*0.4*258.2*sqrt(ustarx*z0m))) + & - (1.0 - fveg) * log(max(z0m/exp(kb_sigma_f0),1.0e-6)) ) + (1.0 - fveg) * log(max(z0mg/exp(kb_sigma_f0),1.0e-6)) ) elseif (opt_trs == tessel) then @@ -5876,7 +5896,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, z0h_out = z0m_out - elseif (opt_trs == chen09 .or. opt_trs == tessel) then + elseif (opt_trs == tessel) then if (vegtyp <= 5) then z0h_out = z0m_out @@ -5884,7 +5904,7 @@ subroutine thermalz0(parameters, fveg, z0m, z0mg, zlvl, z0h_out = z0m_out * 0.01 endif - elseif (opt_trs == blumel99) then + elseif (opt_trs == chen09 .or. opt_trs == blumel99) then reyn = ustarx*z0m_out/viscosity ! Blumel99 eqn 36c if (reyn > 2.0) then @@ -7016,7 +7036,7 @@ subroutine water (parameters,vegtyp ,nsnow ,nsoil ,imelt ,dt ,uu , & esai ,sfctmp ,qvap ,qdew ,zsoil ,btrani , & !in ficeold,ponding,tg ,ist ,fveg ,iloc ,jloc ,smceq , & !in bdfall ,fp ,rain ,snow, & !in mb/an: v3.7 - qsnow ,qrain ,snowhin,latheav,latheag,frozen_canopy,frozen_ground, & !in mb + qsnow ,qrain ,snowhin,latheav,latheag,frozen_canopy,frozen_ground, & !in mb isnow ,canliq ,canice ,tv ,snowh ,sneqv , & !inout snice ,snliq ,stc ,zsnso ,sh2o ,smc , & !inout sice ,zwt ,wa ,wt ,dzsnso ,wslake , & !inout @@ -7645,19 +7665,19 @@ subroutine combine (parameters,nsnow ,nsoil ,iloc ,jloc , & !in snice(j-1) = snice(j-1) + snice(j) dzsnso(j-1) = dzsnso(j-1) + dzsnso(j) else - if(snice(j) >= 0.) then + if(snice(j) >= 0.) then ponding1 = snliq(j) ! isnow will get set to zero below; ponding1 will get sneqv = snice(j) ! added to ponding from phasechange ponding should be snowh = dzsnso(j) ! zero here because it was calculated for thin snow - else ! snice over-sublimated earlier - ponding1 = snliq(j) + snice(j) - if(ponding1 < 0.) then ! if snice and snliq sublimates remove from soil - sice(1) = max(0.0,sice(1)+ponding1/(dzsnso(1)*1000.)) + else ! snice over-sublimated earlier + ponding1 = snliq(j) + snice(j) + if(ponding1 < 0.) then ! if snice and snliq sublimates remove from soil + sice(1) = max(0.0,sice(1)+ponding1/(dzsnso(1)*1000.)) ponding1 = 0.0 - end if + end if sneqv = 0.0 snowh = 0.0 - end if + end if snliq(j) = 0.0 snice(j) = 0.0 dzsnso(j) = 0.0 @@ -9124,9 +9144,7 @@ subroutine groundwater(parameters,nsnow ,nsoil ,dt ,sice ,zsoil , & !in ! recharge rate qin to groundwater -! ka = hk(iwt) -! harmonic average, c.he changed based on gy niu's update - ka = 2.0*(hk(iwt)*parameters%dksat(iwt)*1.0e3) / (hk(iwt)+parameters%dksat(iwt)*1.0e3) + ka = 0.5*(hk(iwt)+parameters%dksat(iwt)*1.0e3) wh_zwt = - zwt * 1.e3 !(mm) wh = smpfz - znode(iwt)*1.e3 !(mm) @@ -9746,7 +9764,7 @@ subroutine carbon_crop (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil ,julia dzsnso ,stc ,smc ,tv ,psn ,foln ,btran , & !in soldn ,t2m , & !in lfmass ,rtmass ,stmass ,wood ,stblcp ,fastcp ,grain , & !inout - xlai ,xsai ,gdd , & !inout + xlai ,xsai ,gdd , & !inout gpp ,npp ,nee ,autors ,heters ,totsc ,totlb, pgs ) !out ! ------------------------------------------------------------------------------------------ ! initial crop version created by xing liu @@ -10425,7 +10443,7 @@ end subroutine psn_crop !! subroutine noahmp_options(idveg , iopt_crs , iopt_btr , iopt_run , iopt_sfc , iopt_frz , & iopt_inf, iopt_rad , iopt_alb , iopt_snf , iopt_tbot, iopt_stc , & - iopt_rsf, iopt_soil, iopt_pedo, iopt_crop, iopt_trs , iopt_diag, & + iopt_rsf, iopt_soil, iopt_pedo, iopt_crop, iopt_trs , iopt_diag, & iopt_z0m ) implicit none diff --git a/physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 b/physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 index 753c8ff24..d6e9963da 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 +++ b/physics/SFC_Models/Land/Noahmp/noahmp_tables.f90 @@ -2,7 +2,8 @@ !! This file contains Fortran versions of the data tables included with NoahMP in mptable.tbl, soilparm.tbl, and genparm.tbl. !> \ingroup NoahMP_LSM -!! \brief Data from MPTABLE.TBL, SOILPARM.TBL, GENPARM.TBL for NoahMP + +!> brief Data from MPTABLE.TBL, SOILPARM.TBL, GENPARM.TBL for NoahMP !! !! Note that a subset of the data in the *.TBL files is represented in this file. For example, !! only the data in the noah_mp_modis_parameters section of MPTABLE.TBL and the STAS section of diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 index 6aff50666..a5f855f11 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.F90 @@ -1,4 +1,6 @@ +#ifndef CCPP #define CCPP +#endif !> \file noahmpdrv.F90 !! This file contains the NoahMP land surface scheme driver. @@ -13,13 +15,19 @@ module noahmpdrv use module_sf_noahmplsm +! These hold and apply Land IAU increments for soil temperature +! (possibly will extend to soil moisture increments) + use land_iau_mod, only: land_iau_control_type, land_iau_external_data_type, land_iau_state_type, & + land_iau_mod_init, land_iau_mod_getiauforcing, land_iau_mod_finalize, calculate_landinc_mask + implicit none integer, parameter :: psi_opt = 0 ! 0: MYNN or 1:GFS private - public :: noahmpdrv_init, noahmpdrv_run + public :: noahmpdrv_init, noahmpdrv_run, & + noahmpdrv_timestep_init, noahmpdrv_finalize contains @@ -32,7 +40,8 @@ module noahmpdrv subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & nlunit, pores, resid, & do_mynnsfclay,do_mynnedmf, & - errmsg, errflg) + errmsg, errflg, & + Land_IAU_Control, Land_IAU_Data, Land_IAU_state) use machine, only: kind_phys use set_soilveg_mod, only: set_soilveg @@ -53,6 +62,19 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + ! Land iau mod DDTs ! made optional to allow NoahMP Component model call this function without having to deal with IAU + + ! Land IAU Control holds settings' information, maily read from namelist + ! (e.g., block of global domain that belongs to current process, + ! whether to do IAU increment at this time step, time step informatoin, etc) + type(land_iau_control_type), intent(inout), optional :: Land_IAU_Control + + ! land iau state holds increment data read from file (before interpolation) + type(land_iau_state_type), intent(inout), optional :: Land_IAU_state + + ! Land IAU Data holds spatially and temporally interpolated increments per time step + type(land_iau_external_data_type), intent(inout), optional :: Land_IAU_Data ! arry of (number of blocks):each proc holds nblks + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -88,21 +110,299 @@ subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & !--- initialize soil vegetation call set_soilveg(me, isot, ivegsrc, nlunit, errmsg, errflg) + if(errflg/=0) return !--- read in noahmp table call read_mp_table_parameters(errmsg, errflg) + if(errflg/=0) return ! initialize psih and psim - if ( do_mynnsfclay ) then - call psi_init(psi_opt,errmsg,errflg) + call psi_init(psi_opt,errmsg,errflg) + if(errflg/=0) return endif pores (:) = maxsmc (:) resid (:) = drysmc (:) + + if (present(Land_IAU_Control) .and. present(Land_IAU_Data) .and. present(Land_IAU_State)) then + + ! Initialize IAU for land--land_iau_control was set by host model + if (.not. Land_IAU_Control%do_land_iau) return + call land_iau_mod_init (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) + + endif end subroutine noahmpdrv_init +!> \ingroup NoahMP_LSM +!! \brief This subroutine is called before noahmpdrv_run +!! to update states with iau increments, if available +!! \section arg_table_noahmpdrv_timestep_init Argument Table +!! \htmlinclude noahmpdrv_timestep_init.html +!! +subroutine noahmpdrv_timestep_init (itime, fhour, delt, km, ncols, & + isot, ivegsrc, soiltyp, vegtype, weasd, & + land_iau_control, land_iau_data, land_iau_state, & + stc, slc, smc, errmsg, errflg, & + con_g, con_t0c, con_hfus) + + use machine, only: kind_phys + use namelist_soilveg + ! use set_soilveg_snippet_mod, only: set_soilveg_noahmp + use noahmp_tables + + implicit none + + integer , intent(in) :: itime !current forecast iteration + real(kind=kind_phys) , intent(in) :: fhour !current forecast time (hr) + real(kind=kind_phys) , intent(in) :: delt ! time interval [s] + integer , intent(in) :: km !vertical soil layer dimension + integer, intent(in) :: ncols + integer, intent(in) :: isot + integer, intent(in) :: ivegsrc + + integer , dimension(:) , intent(in) :: soiltyp ! soil type (integer index) + integer , dimension(:) , intent(in) :: vegtype ! vegetation type (integer index) + real(kind=kind_phys), dimension(:) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] + + type(land_iau_control_type) , intent(inout) :: Land_IAU_Control + type(land_iau_external_data_type) , intent(inout) :: Land_IAU_Data + type(land_iau_state_type) , intent(inout) :: Land_IAU_State + real(kind=kind_phys), dimension(:,:) , intent(inout) :: stc ! soiltemp [K] + real(kind=kind_phys), dimension(:,:) , intent(inout) :: slc !liquid soil moisture [m3/m3]' + real(kind=kind_phys), dimension(:,:) , intent(inout) :: smc ! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + real(kind=kind_phys), intent(in) :: con_g ! grav + real(kind=kind_phys), intent(in) :: con_t0c ! tfreez + real(kind=kind_phys), intent(in) :: con_hfus ! hfus + + ! IAU update + real(kind=kind_phys),allocatable, dimension(:,:) :: stc_inc_flat, slc_inc_flat + real(kind=kind_phys), dimension(km) :: dz ! layer thickness + +!TODO: This is hard-coded in noahmpdrv + real(kind=kind_phys) :: zsoil(4) = (/ -0.1, -0.4, -1.0, -2.0 /) !zsoil(km) + + integer :: lsoil_incr + integer, allocatable :: mask_tile(:) + integer,allocatable :: stc_updated(:), slc_updated(:) + logical :: soil_freeze, soil_ice + integer :: soiltype, n_stc, n_slc + real(kind=kind_phys) :: slc_new + + integer :: i, j, ij, l, k, ib + integer :: lensfc + + real(kind=kind_phys) :: smp !< for computing supercooled water + real(kind=kind_phys) :: hc_incr + + integer :: nother, nsnowupd + integer :: nstcupd, nslcupd, nfrozen, nfrozen_upd + logical :: print_update_stats = .False. + + ! --- Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. Land_IAU_Control%do_land_iau) return + + !> update current forecast hour + Land_IAU_Control%fhour=fhour + + !> read iau increments + call land_iau_mod_getiauforcing(Land_IAU_Control, Land_IAU_Data, Land_IAU_state, errmsg, errflg) + if (errflg .ne. 0) then + return + endif + + !> If no increment at the current timestep simply proceed forward + if (.not. Land_IAU_Data%in_interval) then + return + endif + + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "adding land iau increments " + endif + + if (Land_IAU_Control%lsoil .ne. km) then + write(errmsg,*) 'noahmpdrv_timestep_init: Land_IAU_Data%lsoil ',Land_IAU_Control%lsoil,' not equal to km ',km + errflg = 1 + return + endif + + ! local variable to copy blocked data Land_IAU_Data%stc_inc + allocate(stc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols + allocate(slc_inc_flat(Land_IAU_Control%nx * Land_IAU_Control%ny, km)) !GFS_Control%ncols + allocate(stc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) + allocate(slc_updated(Land_IAU_Control%nx * Land_IAU_Control%ny)) + + !copy background stc + stc_updated = 0 + slc_updated = 0 + ib = 1 + do j = 1, Land_IAU_Control%ny + do k = 1, km + stc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%stc_inc(:,j, k) + slc_inc_flat(ib:ib+Land_IAU_Control%nx-1, k) = Land_IAU_Data%slc_inc(:,j, k) + enddo + ib = ib + Land_IAU_Control%nx + enddo + + if ((Land_IAU_Control%dtp - delt) > 0.0001) then + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) then + print*, "Warning! noahmpdrv_timestep_init delt ",delt," different from Land_IAU_Control%dtp ",Land_IAU_Control%dtp + endif + endif + + lsoil_incr = Land_IAU_Control%lsoil_incr + lensfc = Land_IAU_Control%nx * Land_IAU_Control%ny + + if(Land_IAU_Control%me == Land_IAU_Control%mpi_root) print*,' adjusting first ', lsoil_incr, ' surface layers only, delt ', delt + ! initialize variables for counts statitics to be zeros + nother = 0 ! grid cells not land + nsnowupd = 0 ! grid cells with snow (temperature not yet updated) + nstcupd = 0 ! grid cells that are updated stc + nslcupd = 0 ! grid cells that are updated slc + nfrozen = 0 ! not update as frozen soil + nfrozen_upd = 0 ! not update as frozen soil + +!TODO---if only fv3 increment files are used, this can be read from file + allocate(mask_tile(lensfc)) + call calculate_landinc_mask(weasd, vegtype, soiltyp, lensfc, isice_table, mask_tile) + + !IAU increments are in units of 1/sec !Land_IAU_Control%dtp + !* only updating soil temp for now + ij_loop : do ij = 1, lensfc + ! mask: 1 - soil, 2 - snow, 0 - land-ice, -1 - not land + if (mask_tile(ij) == 1) then + + soil_freeze=.false. + soil_ice=.false. + do k = 1, lsoil_incr ! k = 1, km + if ( stc(ij,k) < con_t0c) soil_freeze=.true. + if ( smc(ij,k) - slc(ij,k) > 0.001 ) soil_ice=.true. + + if (Land_IAU_Control%upd_stc) then + stc(ij,k) = stc(ij,k) + stc_inc_flat(ij,k)*delt !Land_IAU_Control%dtp + if (k==1) then + stc_updated(ij) = 1 + nstcupd = nstcupd + 1 + endif + endif + + if ( (stc(ij,k) < con_t0c) .and. (.not. soil_freeze) .and. (k==1) ) nfrozen_upd = nfrozen_upd + 1 + + ! do not do updates if this layer or any above is frozen + if ( (.not. soil_freeze ) .and. (.not. soil_ice ) ) then + if (Land_IAU_Control%upd_slc) then + if (k==1) then + nslcupd = nslcupd + 1 + slc_updated(ij) = 1 + endif + ! apply zero limit here (higher, model-specific limits are later) + slc(ij,k) = max(slc(ij,k) + slc_inc_flat(ij,k)*delt, 0.0) + smc(ij,k) = max(smc(ij,k) + slc_inc_flat(ij,k)*delt, 0.0) + endif + else + if (k==1) nfrozen = nfrozen+1 + endif + enddo + endif ! if soil/snow point + enddo ij_loop + + !!do moisture/temperature adjustment for consistency after increment add + call read_mp_table_parameters(errmsg, errflg) + if (errflg .ne. 0) then + errmsg = 'FATAL ERROR in noahmpdrv_timestep_init: problem in set_soilveg_noahmp' + return + endif + n_stc = 0 + n_slc = 0 + if (Land_IAU_Control%do_stcsmc_adjustment) then + if (Land_IAU_Control%upd_stc) then + do i=1,lensfc + if (stc_updated(i) == 1 ) then ! soil-only location + n_stc = n_stc+1 + soiltype = soiltyp(i) + do l = 1, lsoil_incr + if (abs(stc_inc_flat(i,l)) > Land_IAU_Control%min_T_increment) then + !the following if case applies when updated stc > melting point, it handles both + !case 1: frz ==> frz, recalculate slc, smc remains + !case 2: unfrz ==> frz, recalculate slc, smc remains + if (stc(i,l) .LT. con_t0c )then + !recompute supercool liquid water,smc_anl remain unchanged + smp = con_hfus*(con_t0c-stc(i,l))/(con_g*stc(i,l)) !(m) + slc_new=maxsmc(soiltype)*(smp/satpsi(soiltype))**(-1./bb(soiltype)) + slc(i,l) = max( min( slc_new, smc(i,l)), 0.0 ) + endif + !case 3: frz ==> unfrz (or unfrz ==> unfrz), melt all soil ice (if any) + if (stc(i,l) .GT. con_t0c )then !do not rely on stc_bck + slc(i,l)=smc(i,l) + endif + endif + enddo + endif + enddo + endif + + if (Land_IAU_Control%upd_slc) then + dz(1) = -zsoil(1) + do l = 2, km + dz(l) = -zsoil(l) + zsoil(l-1) + enddo + do i=1,lensfc + if (slc_updated(i) == 1 ) then + n_slc = n_slc+1 + ! apply SM bounds (later: add upper SMC limit) + do l = 1, lsoil_incr + if (abs(slc_inc_flat(i, l)) > Land_IAU_Control%min_SLC_increment) then + ! noah-mp minimum is 1 mm per layer (in SMC) + ! no need to maintain frozen amount, would be v. small. + slc(i,l) = max( 0.001/dz(l), slc(i,l) ) + smc(i,l) = max( 0.001/dz(l), smc(i,l) ) + endif + enddo + endif + enddo + endif + endif + + deallocate(stc_inc_flat, slc_inc_flat, stc_updated, slc_updated) + deallocate(mask_tile) + + !Remove non-warning, non-error log write + !write(*,'(a,i4,a,i8)') 'noahmpdrv_timestep_init rank ', Land_IAU_Control%me, ' # of cells with stc update ', nstcupd + + +end subroutine noahmpdrv_timestep_init + + !> \ingroup NoahMP_LSM +!! \brief This subroutine mirrors noahmpdrv_init +!! it calls land_iau_finalize which frees up allocated memory by IAU_init (in noahmdrv_init) +!! \section arg_table_noahmpdrv_finalize Argument Table +!! \htmlinclude noahmpdrv_finalize.html +!! + subroutine noahmpdrv_finalize (Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) + + use machine, only: kind_phys + implicit none + type(land_iau_control_type) , intent(in ) :: Land_IAU_Control + type(land_iau_external_data_type) , intent(inout) :: Land_IAU_Data + type(land_iau_state_type) , intent(inout) :: Land_IAU_State + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + integer :: j, k, ib + ! --- Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. Land_IAU_Control%do_land_iau) return + call land_iau_mod_finalize(Land_IAU_Control, Land_IAU_Data, Land_IAU_State, errmsg, errflg) + + end subroutine noahmpdrv_finalize + !> \ingroup NoahMP_LSM !! \brief This subroutine is the main CCPP entry point for the NoahMP LSM. !! \section arg_table_noahmpdrv_run Argument Table @@ -157,7 +457,7 @@ subroutine noahmpdrv_run & sncovr1, qsurf, gflux, drain, evap, hflx, ep, runoff, & cmm, chh, evbs, evcw, sbsno, pah, ecan, etran, edir, snowc,& stm, snohf,smcwlt2, smcref2, wet1, t2mmp, q2mp,zvfun, & - ztmax, errmsg, errflg, & + ztmax, rca, errmsg, errflg, & canopy_heat_storage_ccpp, & rainfall_ccpp, & sw_absorbed_total_ccpp, & @@ -400,6 +700,8 @@ subroutine noahmpdrv_run & real(kind=kind_phys), dimension(:) , intent(out) :: q2mp ! combined q2m from tiles real(kind=kind_phys), dimension(:) , intent(out) :: zvfun ! real(kind=kind_phys), dimension(:) , intent(out) :: ztmax ! thermal roughness length + real(kind=kind_phys), dimension(:) , intent(out) :: rca ! total canopy/stomatal resistance (s/m) + character(len=*) , intent(out) :: errmsg integer , intent(out) :: errflg @@ -623,7 +925,7 @@ subroutine noahmpdrv_run & real (kind=kind_phys) :: canopy_heat_storage ! out | within-canopy heat [W/m2] real (kind=kind_phys) :: spec_humid_sfc_veg ! out | surface specific humidty over vegetation [kg/kg] real (kind=kind_phys) :: spec_humid_sfc_bare ! out | surface specific humidty over bare soil [kg/kg] - + real (kind=kind_phys) :: ustarx ! inout |surface friction velocity real (kind=kind_phys) :: prslkix ! in exner function real (kind=kind_phys) :: prsik1x ! in exner function @@ -661,6 +963,7 @@ subroutine noahmpdrv_run & real (kind=kind_phys) :: precip_freeze_frac_in ! used for penman calculation real (kind=kind_phys) :: virtfac1 ! virtual factor + real (kind=kind_phys) :: tflux ! surface flux temp real (kind=kind_phys) :: tvs1 ! surface virtual temp real (kind=kind_phys) :: vptemp ! virtual potential temp @@ -856,7 +1159,7 @@ subroutine noahmpdrv_run & call noahmp_options(idveg ,iopt_crs, iopt_btr , iopt_run, iopt_sfc, & iopt_frz, iopt_inf , iopt_rad, iopt_alb, & iopt_snf, iopt_tbot, iopt_stc, iopt_rsf, & - iopt_soil,iopt_pedo, iopt_crop,iopt_trs, & + iopt_soil,iopt_pedo, iopt_crop,iopt_trs, & iopt_diag,iopt_z0m) if ( vegetation_category == isice_table ) then @@ -881,7 +1184,7 @@ subroutine noahmpdrv_run & temperature_soil_bot ,forcing_height ,snow_ice_frac_old ,zsoil , & thsfc_loc ,prslkix ,prsik1x ,prslk1x , & air_pressure_surface ,pblhx ,iz0tlnd ,itime , & - vegetation_frac ,area_grid ,psi_opt , & + vegetation_frac ,area_grid ,psi_opt , & con_fvirt ,con_eps ,con_epsm1 ,con_cp , & snowfall ,snow_water_equiv_old ,snow_albedo_old , & cm_noahmp ,ch_noahmp ,snow_levels ,snow_water_equiv , & @@ -909,45 +1212,50 @@ subroutine noahmpdrv_run & ! snow_cover_fraction = 1.0 - temperature_leaf = undefined - canopy_ice = undefined - canopy_liquid = undefined - vapor_pres_canopy_air = undefined - temperature_canopy_air = undefined - canopy_wet_fraction = undefined - lake_water = undefined - depth_water_table = undefined - aquifer_water = undefined - saturated_water = undefined - leaf_carbon = undefined - root_carbon = undefined - stem_carbon = undefined - wood_carbon = undefined - soil_carbon_stable = undefined - soil_carbon_fast = undefined - leaf_area_index = undefined - stem_area_index = undefined - evaporation_canopy = undefined - transpiration = undefined - aquifer_water = undefined - precip_adv_heat_total = undefined + temperature_leaf = temperature_radiative + canopy_ice = 0.0 + canopy_liquid = 0.0 + vapor_pres_canopy_air = 2000.0 + temperature_canopy_air = temperature_radiative + canopy_wet_fraction = 0.0 + lake_water = 0.0 + depth_water_table = 0.0 + aquifer_water = 0.0 + saturated_water = 0.0 + leaf_carbon = 0.0 + root_carbon = 0.0 + stem_carbon = 0.0 + wood_carbon = 0.0 + soil_carbon_stable = 0.0 + soil_carbon_fast = 0.0 + leaf_area_index = 0.0 + stem_area_index = 0.0 + evaporation_canopy = 0.0 + transpiration = 0.0 + aquifer_water = 0.0 + precip_adv_heat_total = 0.0 soil_moisture_wtd = 0.0 recharge = 0.0 deep_recharge = 0.0 eq_soil_water_vol = soil_moisture_vol - transpiration_heat = undefined - latent_heat_canopy = undefined + transpiration_heat = 0.0 + latent_heat_canopy = 0.0 z0_total = 0.002 latent_heat_total = latent_heat_ground t2mmp(i) = temperature_bare_2m q2mp(i) = spec_humidity_bare_2m - tskin(i) = temperature_ground + tskin(i) = temperature_radiative + tflux = temperature_ground surface_temperature = temperature_ground vegetation_fraction = vegetation_frac ch_vegetated = 0.0 ch_bare_ground = ch_noahmp canopy_heat_storage = 0.0 + lai_sunlit = 0.0 + lai_shaded = 0.0 + rs_sunlit = 0.0 + rs_shaded = 0.0 else ! not glacier @@ -1032,7 +1340,8 @@ subroutine noahmpdrv_run & q2mp(i) = spec_humidity_veg_2m * vegetation_fraction + & spec_humidity_bare_2m * (1-vegetation_fraction) - tskin(i) = surface_temperature + tskin(i) = temperature_radiative + tflux = surface_temperature endif ! glacial split ends @@ -1056,7 +1365,17 @@ subroutine noahmpdrv_run & chxy (i) = ch_noahmp zorl (i) = z0_total * 100.0 ! convert to cm ztmax (i) = z0h_total - + + !LAI-scale canopy resistance based on weighted sunlit shaded fraction + if(rs_sunlit .le. 0.0 .or. rs_shaded .le. 0.0 .or. & + lai_sunlit .eq. 0.0 .or. lai_shaded .eq. 0.0) then + rca(i) = parameters%rsmax + else !calculate LAI-scale canopy conductance (1/Rs) + rca(i) = ((1.0/(rs_sunlit+leaf_air_resistance)*lai_sunlit) + & + ((1.0/(rs_shaded+leaf_air_resistance))*lai_shaded)) + rca(i) = max((1.0/rca(i)),parameters%rsmin) !resistance + end if + smc (i,:) = soil_moisture_vol slc (i,:) = soil_liquid_vol snowxy (i) = float(snow_levels) @@ -1178,9 +1497,9 @@ subroutine noahmpdrv_run & endif if(thsfc_loc) then ! Use local potential temperature - tvs1 = tskin(i) * virtfac1 + tvs1 = tflux * virtfac1 else ! Use potential temperature referenced to 1000 hPa - tvs1 = tskin(i)/prsik1(i) * virtfac1 + tvs1 = tflux/prsik1(i) * virtfac1 endif z0_total = max(min(z0_total,forcing_height),1.0e-6) @@ -1347,7 +1666,7 @@ subroutine transfer_mp_parameters (vegtype,soiltype,slopetype, & parameters%den = den_table(vegtype) !tree density (no. of trunks per m2) parameters%rc = rc_table(vegtype) !tree crown radius (m) parameters%mfsno = mfsno_table(vegtype) !snowmelt m parameter () - parameters%scffac = scffac_table(vegtype) !snow cover factor + parameters%scffac = scffac_table(vegtype) !snow cover factor parameters%cbiom = cbiom_table(vegtype) !canopy biomass heat capacity parameter (m) parameters%saim = saim_table(vegtype,:) !monthly stem area index, one-sided parameters%laim = laim_table(vegtype,:) !monthly leaf area index, one-sided diff --git a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta index 39eed1493..ff5d19f5a 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta +++ b/physics/SFC_Models/Land/Noahmp/noahmpdrv.meta @@ -96,6 +96,233 @@ dimensions = () type = integer intent = out +[land_iau_control] + standard_name = land_data_assimilation_control + long_name = land data assimilation control + units = mixed + dimensions = () + type = land_iau_control_type + intent = inout + optional = True +[land_iau_data] + standard_name = land_data_assimilation_data + long_name = land data assimilation data + units = mixed + dimensions = () + type = land_iau_external_data_type + intent = inout + optional = True +[land_iau_state] + standard_name = land_data_assimilation_interpolated_data + long_name = land data assimilation space- and time-interpolated + units = mixed + dimensions = () + type = land_iau_state_type + intent = inout + optional = True + +######################################################################## +[ccpp-arg-table] + name = noahmpdrv_timestep_init + type = scheme +[itime] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[delt] + standard_name = timestep_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[km] + standard_name = vertical_dimension_of_soil + long_name = vertical dimension of soil layers + units = count + dimensions = () + type = integer + intent = in +[ncols] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in +[isot] + standard_name = control_for_soil_type_dataset + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in +[ivegsrc] + standard_name = control_for_vegetation_dataset + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent= in +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_dimension) + type = integer + intent= in +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equivalent of accumulated snow depth over land + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout +[land_iau_control] + standard_name = land_data_assimilation_control + long_name = land data assimilation control + units = mixed + dimensions = () + type = land_iau_control_type + intent = inout +[land_iau_data] + standard_name = land_data_assimilation_data + long_name = land data assimilation data + units = mixed + dimensions = () + type = land_iau_external_data_type + intent = inout +[land_iau_state] + standard_name = land_data_assimilation_interpolated_data + long_name = land data assimilation space- and time-interpolated + units = mixed + dimensions = () + type = land_iau_state_type + intent = inout +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[slc] + standard_name = volume_fraction_of_unfrozen_water_in_soil + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[smc] + standard_name = volume_fraction_of_condensed_water_in_soil + long_name = total soil moisture + units = frac + dimensions = (horizontal_dimension,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degree Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + +####################################################################### +[ccpp-arg-table] + name = noahmpdrv_finalize + type = scheme +[land_iau_control] + standard_name = land_data_assimilation_control + long_name = land data assimilation control + units = mixed + dimensions = () + type = land_iau_control_type + intent = in +[land_iau_data] + standard_name = land_data_assimilation_data + long_name = land data assimilation data + units = mixed + dimensions = () + type = land_iau_external_data_type + intent = inout +[land_iau_state] + standard_name = land_data_assimilation_interpolated_data + long_name = land data assimilation space- and time-interpolated + units = mixed + dimensions = () + type = land_iau_state_type + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out ######################################################################## [ccpp-arg-table] @@ -1360,6 +1587,14 @@ type = real kind = kind_phys intent = out +[rca] + standard_name = aerodynamic_resistance_in_canopy + long_name = canopy resistance + units = s m-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/SFC_Models/Land/Noahmp/noahmptable.tbl b/physics/SFC_Models/Land/Noahmp/noahmptable.tbl index 3ffd5b532..44531919e 100644 --- a/physics/SFC_Models/Land/Noahmp/noahmptable.tbl +++ b/physics/SFC_Models/Land/Noahmp/noahmptable.tbl @@ -217,7 +217,7 @@ !--------------------------------------------------------------------------------------------------------------------------------------------------------------------- ch2op = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, dleaf = 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, - z0mvt = 1.09, 1.10, 0.85, 0.80, 0.80, 0.20, 0.06, 0.60, 0.50, 0.12, 0.30, 0.15, 1.00, 0.14, 0.00, 0.00, 0.00, 0.30, 0.20, 0.03, + z0mvt = 1.00, 1.50, 0.75, 0.90, 0.85, 0.20, 0.10, 0.90, 0.60, 0.20, 0.30, 0.25, 1.00, 0.25, 0.00, 0.015, 0.00, 0.30, 0.10, 0.05, hvt = 20.0, 20.0, 18.0, 16.0, 16.0, 1.10, 1.10, 13.0, 10.0, 1.00, 5.00, 2.00, 15.0, 1.50, 0.00, 0.00, 0.00, 4.00, 2.00, 0.50, hvb = 8.50, 8.00, 7.00, 11.5, 10.0, 0.10, 0.10, 0.10, 0.10, 0.05, 0.10, 0.10, 1.00, 0.10, 0.00, 0.00, 0.00, 0.30, 0.20, 0.10, z0mhvt= 0.0545, 0.055, 0.047, 0.050, 0.050, 0.182, 0.0545, 0.046, 0.050, 0.120, 0.060, 0.075, 0.067, 0.093, 0.000, 0.000, 0.000, 0.075, 0.100, 0.060, @@ -226,32 +226,34 @@ !mfsno = 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, ! c. he 12/17/2020: optimized mfsno values dependent on land type based on evaluation with snotel swe and modis scf, surface albedo mfsno = 1.00, 1.00, 1.00, 1.00, 1.00, 2.00, 2.00, 2.00, 2.00, 2.00, 3.00, 3.00, 4.00, 4.00, 2.50, 3.00, 3.00, 3.50, 3.50, 3.50, +!mfsno = 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, 1.97, ! c. he 12/17/2020: optimized snow cover factor (m) in scf formulation to replace original constant 2.5*z0,z0=0.002m, based on evaluation with snotel swe and modis scf, surface albedo ! scffac = 0.008, 0.008, 0.008, 0.008, 0.008, 0.016, 0.016, 0.020, 0.020, 0.020, 0.020, 0.014, 0.042, 0.026, 0.030, 0.016, 0.030, 0.030, 0.030, 0.030, - scffac = 0.005, 0.005, 0.005, 0.005, 0.005, 0.008, 0.008, 0.010, 0.010, 0.010, 0.010, 0.007, 0.021, 0.013, 0.015, 0.008, 0.015, 0.015, 0.015, 0.015, + scffac = 0.005, 0.005, 0.005, 0.005, 0.005, 0.008, 0.008, 0.010, 0.010, 0.010, 0.010, 0.007, 0.021, 0.013, 0.015, 0.008, 0.015, 0.015, 0.015, 0.015, +! scffac = 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, 0.059, cbiom = 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, ! row 1: vis ! row 2: near ir rhol_vis=0.07, 0.10, 0.07, 0.10, 0.10, 0.07, 0.07, 0.07, 0.10, 0.11, 0.105, 0.11, 0.00, 0.11, 0.00, 0.00, 0.00, 0.10, 0.10, 0.10, - rhol_nir=0.35, 0.45, 0.35, 0.45, 0.45, 0.35, 0.35, 0.35, 0.45, 0.58, 0.515, 0.58, 0.00, 0.58, 0.00, 0.00, 0.00, 0.45, 0.45, 0.45, + rhol_nir=0.35, 0.45, 0.35, 0.45, 0.45, 0.35, 0.35, 0.35, 0.45, 0.35, 0.515, 0.35, 0.00, 0.35, 0.00, 0.00, 0.00, 0.45, 0.45, 0.45, ! row 1: vis ! row 2: near ir - rhos_vis=0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.36, 0.26, 0.36, 0.00, 0.36, 0.00, 0.00, 0.00, 0.16, 0.16, 0.16, - rhos_nir=0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.58, 0.485, 0.58, 0.00, 0.58, 0.00, 0.00, 0.00, 0.39, 0.39, 0.39, + rhos_vis=0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.31, 0.26, 0.31, 0.00, 0.31, 0.00, 0.00, 0.00, 0.16, 0.16, 0.16, + rhos_nir=0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.53, 0.485, 0.53, 0.00, 0.53, 0.00, 0.00, 0.00, 0.39, 0.39, 0.39, ! row 1: vis ! row 2: near ir - taul_vis=0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.07, 0.06, 0.07, 0.00, 0.07, 0.00, 0.00, 0.00, 0.05, 0.05, 0.05, - taul_nir=0.10, 0.25, 0.10, 0.25, 0.25, 0.10, 0.10, 0.10, 0.25, 0.25, 0.25, 0.25, 0.00, 0.25, 0.00, 0.00, 0.00, 0.25, 0.25, 0.25, + taul_vis=0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.06, 0.05, 0.00, 0.05, 0.00, 0.00, 0.00, 0.05, 0.05, 0.05, + taul_nir=0.10, 0.25, 0.10, 0.25, 0.25, 0.10, 0.10, 0.10, 0.25, 0.34, 0.25, 0.34, 0.00, 0.34, 0.00, 0.00, 0.00, 0.25, 0.25, 0.25, ! row 1: vis ! row 2: near ir - taus_vis=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.220, 0.1105, 0.220, 0.000, 0.220, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, - taus_nir=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.380, 0.1905, 0.380, 0.000, 0.380, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, + taus_vis=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.120, 0.1105, 0.120, 0.000, 0.120, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, + taus_nir=0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.250, 0.1905, 0.250, 0.000, 0.250, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, - xl = 0.010, 0.010, 0.010, 0.250, 0.250, 0.010, 0.010, 0.010, 0.010, -0.30, -0.025, -0.30, 0.000, -0.30, 0.000, 0.000, 0.000, 0.250, 0.250, 0.250, + xl = 0.010, 0.10, 0.010, 0.250, 0.250, 0.010, 0.010, 0.010, 0.010, -0.30, -0.025, -0.30, 0.000, -0.30, 0.000, 0.000, 0.000, 0.250, 0.250, 0.250, ! make cwpvt vegetation dependent according to j. goudriaan, crop micrometeorology: a simulation study (simulation monographs), 1977). c. he, 12/17/2020 ! cwpvt = 0.18, 0.67, 0.18, 0.67, 0.29, 1.0, 2.0, 1.3, 1.0, 5.0, 1.17, 1.67, 1.67, 1.67, 0.18, 0.18, 0.18, 0.67, 1.0, 0.18, cwpvt = 0.09, 0.335, 0.09, 0.335, 0.145, 0.5, 1.0, 0.65, 0.5, 2.5, 0.585, 0.835, 0.835, 0.835, 0.09, 0.09, 0.09, 0.335, 0.5, 0.09, @@ -335,10 +337,10 @@ !-------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 soil color index for soil albedo !-------------------------------------------------------------------------------------------------------------------------------------------------------------------------- - albsat_vis = 0.25, 0.23, 0.21, 0.20, 0.19, 0.18, 0.17, 0.16, 0.15, 0.14, 0.13, 0.12, 0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05, 0.04 ! saturated soil albedos - albsat_nir = 0.50, 0.46, 0.42, 0.40, 0.38, 0.36, 0.34, 0.32, 0.30, 0.28, 0.26, 0.24, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.08 ! saturated soil albedos - albdry_vis = 0.36, 0.34, 0.32, 0.31, 0.30, 0.29, 0.28, 0.27, 0.26, 0.25, 0.24, 0.23, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10, 0.08 ! dry soil albedos - albdry_nir = 0.61, 0.57, 0.53, 0.51, 0.49, 0.48, 0.45, 0.43, 0.41, 0.39, 0.37, 0.35, 0.33, 0.31, 0.29, 0.27, 0.25, 0.23, 0.21, 0.16 ! dry soil albedos + albsat_vis = 0.21, 0.20, 0.18, 0.17, 0.16, 0.15, 0.14, 0.13, 0.13, 0.12, 0.11, 0.10, 0.10, 0.09, 0.08, 0.08, 0.08, 0.07, 0.07, 0.06 ! saturated soil albedos + albsat_nir = 0.42, 0.40, 0.36, 0.34, 0.32, 0.30, 0.28, 0.26, 0.26, 0.24, 0.22, 0.20, 0.20, 0.18, 0.16, 0.16, 0.16, 0.14, 0.14, 0.13 ! saturated soil albedos + albdry_vis = 0.31, 0.30, 0.28, 0.27, 0.26, 0.24, 0.23, 0.22, 0.22, 0.22, 0.20, 0.19, 0.20, 0.18, 0.16, 0.16, 0.16, 0.14, 0.14, 0.13 ! dry soil albedos + albdry_nir = 0.52, 0.50, 0.46, 0.44, 0.42, 0.40, 0.38, 0.37, 0.36, 0.34, 0.32, 0.30, 0.30, 0.28, 0.27, 0.27, 0.27, 0.26, 0.25, 0.25 ! dry soil albedos albice = 0.80, 0.55 ! albedo land ice: 1=vis, 2=nir alblak = 0.60, 0.40 ! albedo frozen lakes: 1=vis, 2=nir omegas = 0.8 , 0.4 ! two-stream parameter omega for snow @@ -397,7 +399,7 @@ class_sno_age = 3600.0 ! snow aging e-folding time (s) in class albedo scheme class_alb_new = 0.84 ! fresh snow albedo in class scheme psiwlt = -150.0 !metric potential for wilting point (m) - z0soil = 0.002 ! bare-soil roughness length (m) (i.e., under the canopy) + z0soil = 0.015 ! bare-soil roughness length (m) (i.e., under the canopy) z0lake = 0.01 ! lake surface roughness length (m) / diff --git a/physics/SFC_Models/Land/RUC/lsm_ruc.F90 b/physics/SFC_Models/Land/RUC/lsm_ruc.F90 index fb60d4b53..a17e967fc 100644 --- a/physics/SFC_Models/Land/RUC/lsm_ruc.F90 +++ b/physics/SFC_Models/Land/RUC/lsm_ruc.F90 @@ -1,6 +1,7 @@ !>\file lsm_ruc.F90 !! This file contains the RUC land surface scheme driver. +!> This module contain the RUC land surface model driver module lsm_ruc use machine, only: kind_phys, kind_dbl_prec @@ -94,8 +95,9 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & real (kind_phys), dimension(:,:), intent(inout) :: tslb, smois real (kind_phys), dimension(:), intent(inout) :: semis_lnd real (kind_phys), dimension(:), intent(inout) :: semis_ice - real (kind_phys), dimension(:), intent(inout) :: & - albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + real (kind_phys), dimension(:), intent(inout) :: & + albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd + real (kind_phys), dimension(:), intent(inout) :: & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & sfcqv_lnd, sfcqv_ice @@ -162,6 +164,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & !--- initialize soil vegetation call set_soilveg_ruc(me, isot, ivegsrc, nlunit, errmsg, errflg) + if(errflg/=0) return pores (:) = maxsmc (:) resid (:) = drysmc (:) @@ -211,6 +214,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & zs, dzs, smc, slc, stc, & ! in sh2o, smfrkeep, tslb, smois, & ! out wetness, errmsg, errflg) + if(errflg/=0) return if (lsm_cold_start) then do i = 1, im ! i - horizontal loop @@ -321,11 +325,11 @@ end subroutine lsm_ruc_finalize !> \section arg_table_lsm_ruc_run Argument Table !! \htmlinclude lsm_ruc_run.html !! -!>\section gen_lsmruc RUC LSM General Algorithm +!>\section gen_lsm_ruc_run RUC LSM General Algorithm subroutine lsm_ruc_run & ! inputs & ( iter, me, master, delt, kdt, im, nlev, lsm_ruc, lsm, & & imp_physics, imp_physics_gfdl, imp_physics_thompson, & - & imp_physics_nssl, do_mynnsfclay, & + & imp_physics_nssl, do_mynnsfclay, use_cdeps_data, mask_dat, & & exticeden, lsoil_ruc, lsoil, mosaic_lu, mosaic_soil, & & isncond_opt, isncovr_opt, nlcat, nscat, & & rdlai, xlat_d, xlon_d, & @@ -381,11 +385,11 @@ subroutine lsm_ruc_run & ! inputs imp_physics_nssl real (kind_phys), dimension(:), intent(in) :: xlat_d, xlon_d real (kind_phys), dimension(:), intent(in) :: oro, sigma - + real (kind_phys), dimension(:), intent(in) :: sfalb_lnd_bck real (kind_phys), dimension(:), intent(in) :: & & t1, sigmaf, dlwflx, dswsfc, tg3, & & coszen, prsl1, wind, shdmin, shdmax, & - & sfalb_lnd_bck, snoalb, zf, qc, q1, & + & snoalb, zf, qc, q1, & ! for land & cm_lnd, ch_lnd, & ! for water @@ -405,6 +409,7 @@ subroutine lsm_ruc_run & ! inputs logical, dimension(:), intent(in) :: flag_cice logical, intent(in) :: frac_grid logical, intent(in) :: do_mynnsfclay + logical, intent(in) :: use_cdeps_data logical, intent(in) :: exticeden logical, intent(in) :: rdlai @@ -418,44 +423,53 @@ subroutine lsm_ruc_run & ! inputs real (kind_phys), dimension(:), intent(in) :: zs real (kind_phys), dimension(:), intent(in) :: srflag + real (kind_phys), dimension(:), intent(in), optional :: mask_dat real (kind_phys), dimension(:), intent(inout) :: & - & canopy, trans, smcwlt2, smcref2, laixy, & + & laixy, tsnow_lnd, sfcqv_lnd, sfcqc_lnd, sfcqc_ice, sfcqv_ice,& + & tsnow_ice + real (kind_phys), dimension(:), intent(inout) :: & + & canopy, trans, smcwlt2, smcref2, & ! for land & weasd_lnd, snwdph_lnd, tskin_lnd, & - & tsurf_lnd, z0rl_lnd, tsnow_lnd, & - & sfcqc_lnd, sfcqv_lnd, & + & tsurf_lnd, z0rl_lnd, & ! for ice & weasd_ice, snwdph_ice, tskin_ice, & - & tsurf_ice, z0rl_ice, tsnow_ice, & - & sfcqc_ice, sfcqv_ice, fice + & tsurf_ice, z0rl_ice, fice ! --- in - real (kind_phys), dimension(:), intent(in) :: & - & rainnc, rainc, ice, snow, graupel, rhonewsn1 - real (kind_phys), dimension(:), intent(in) :: fire_heat_flux_out, & - frac_grid_burned_out + real (kind_phys), dimension(:), intent(in) :: & + & rainnc, rainc, ice, snow, graupel + real (kind_phys), dimension(:), intent(in) :: rhonewsn1 + real (kind_phys), dimension(:), intent(in) :: & + fire_heat_flux_out, frac_grid_burned_out logical, intent(in) :: add_fire_heat_flux ! --- in/out: ! --- on RUC levels + real (kind_phys), dimension(:,:), intent(inout) :: & + & smois, tslb, sh2o, keepfr, smfrkeep real (kind_phys), dimension(:,:), intent(inout) :: & - & smois, tsice, tslb, sh2o, keepfr, smfrkeep + & tsice ! --- output: real (kind_phys), dimension(:), intent(inout) :: & - & rhosnf, runof, drain, runoff, srunoff, evbs, evcw, & - & stm, wetness, semisbase, semis_lnd, semis_ice, & - & sfalb_lnd, sfalb_ice, & + & sfalb_lnd, sfalb_ice, wetness, snowfallac_lnd, & + & snowfallac_ice, rhosnf + real (kind_phys), dimension(:), intent(inout) :: & + & runof, drain, runoff, srunoff, evbs, evcw, & + & stm, semisbase, semis_lnd, semis_ice, & ! for land & sncovr1_lnd, qsurf_lnd, gflux_lnd, evap_lnd, & & cmm_lnd, chh_lnd, hflx_lnd, sbsno, & - & snowfallac_lnd, acsnow_lnd, snowmt_lnd, snohf, & + & snowmt_lnd, snohf, & ! for ice & sncovr1_ice, qsurf_ice, gflux_ice, evap_ice, ep1d_ice, & & cmm_ice, chh_ice, hflx_ice, & - & snowfallac_ice, acsnow_ice, snowmt_ice - + & snowmt_ice + real (kind_phys), dimension(:), intent(inout) :: & + acsnow_lnd, acsnow_ice + real (kind_phys), dimension(:), intent( out) :: & + & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd real (kind_phys), dimension(:), intent( out) :: & - & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice logical, intent(in) :: flag_init, lsm_cold_start @@ -1606,13 +1620,19 @@ subroutine lsm_ruc_run & ! inputs else ! flag_guess if(debug_print) write (0,*)'iter run', i,j, tskin_ice(i),tsurf_ice(i) tskin_lnd(i) = tsurf_lnd(i) - tskin_ice(i) = tsurf_ice(i) + !don't overwrite surface skin temperature over ice when using CDEPS inline over the mask + if (use_cdeps_data) then + if (mask_dat(i) <= 0.0) then + tskin_ice(i) = tsurf_ice(i) + endif + else + tskin_ice(i) = tsurf_ice(i) + endif endif ! flag_guess endif ! flag enddo ! i enddo ! j ! - return !................................... end subroutine lsm_ruc_run !----------------------------------- @@ -1697,6 +1717,8 @@ subroutine rucinit (lsm_cold_start, im, lsoil_ruc, lsoil, & ! in integer, dimension(1:lsoil) :: sm_levels_input ! 4 - for Noah lsm integer :: ii,jj + real (kind_phys) :: cq,r61,r273,arp,brp,x,evs,eis + ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 @@ -1772,6 +1794,25 @@ subroutine rucinit (lsm_cold_start, im, lsoil_ruc, lsoil, & ! in else +!> - Table TBQ is for resolution of balance equation in vilka() + CQ=173.15_kind_dbl_prec-.05_kind_dbl_prec + R273=1._kind_dbl_prec/con_t0c + R61=6.1153_kind_dbl_prec*0.62198_kind_dbl_prec + ARP=77455._kind_dbl_prec*41.9_kind_dbl_prec/461.525_kind_dbl_prec + BRP=64._kind_dbl_prec*41.9_kind_dbl_prec/461.525_kind_dbl_prec + + DO K=1,5001 + CQ=CQ+.05_kind_dbl_prec + EVS=EXP(17.67_kind_dbl_prec*(CQ-con_t0c)/(CQ-29.65_kind_dbl_prec)) + EIS=EXP(22.514_kind_dbl_prec-6.15E3_kind_dbl_prec/CQ) + if(CQ.ge.con_t0c) then + ! tbq is in mb + tbq(k) = R61*evs + else + tbq(k) = R61*eis + endif + END DO + ! For RUC restart data, return here return @@ -2012,5 +2053,4 @@ subroutine rucinit (lsm_cold_start, im, lsoil_ruc, lsoil, & ! in end subroutine rucinit - end module lsm_ruc diff --git a/physics/SFC_Models/Land/RUC/lsm_ruc.meta b/physics/SFC_Models/Land/RUC/lsm_ruc.meta index bc4d358e3..e40cecc63 100644 --- a/physics/SFC_Models/Land/RUC/lsm_ruc.meta +++ b/physics/SFC_Models/Land/RUC/lsm_ruc.meta @@ -635,6 +635,22 @@ dimensions = () type = logical intent = in +[use_cdeps_data] + standard_name = do_cdeps_inline + long_name = flag for using data provided by CDEPS inline (default false) + units = flag + dimensions = () + type = logical + intent = in +[mask_dat] + standard_name = land_sea_mask_from_data + long_name = landmask + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True [exticeden] standard_name = do_external_surface_frozen_precipitation_density long_name = flag for calculating frozen precip ice density outside of the LSM diff --git a/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 index 9677e7bf1..27e791385 100644 --- a/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 +++ b/physics/SFC_Models/Land/RUC/module_sf_ruclsm.F90 @@ -18,7 +18,7 @@ MODULE module_sf_ruclsm private !private qsn - public :: lsmruc, ruclsminit, rslf + public :: lsmruc, ruclsminit, rslf, tbq !> CONSTANT PARAMETERS !! @{ @@ -75,6 +75,7 @@ MODULE module_sf_ruclsm REFKDT_DATA,FRZK_DATA,ZBOT_DATA, SMLOW_DATA,SMHIGH_DATA, & CZIL_DATA !! @} + real (kind_phys), DIMENSION(1:5001) :: tbq CONTAINS @@ -83,7 +84,7 @@ MODULE module_sf_ruclsm !>\ingroup lsm_ruc_group !> The RUN LSM model is described in Smirnova et al.(1997) !! \cite Smirnova_1997 and Smirnova et al.(2000) \cite Smirnova_2000 -!>\section gen_lsmruc GSD RUC LSM General Algorithm +!>\section gen_lsmruc RUC LSM General Algorithm !! @{ SUBROUTINE LSMRUC(xlat,xlon, & DT,init,lsm_cold_start,KTAU,iter,NSL, & @@ -381,9 +382,6 @@ SUBROUTINE LSMRUC(xlat,xlon, & real (kind_phys), DIMENSION(1:2*(nsl-2)) :: DTDZS - real (kind_phys), DIMENSION(1:5001) :: TBQ - - real (kind_phys), DIMENSION( 1:nsl ) :: SOILM1D, & TSO1D, & SOILICE, & @@ -436,6 +434,7 @@ SUBROUTINE LSMRUC(xlat,xlon, & character(len=*),intent(out) :: errmsg integer, intent(out) :: errflg + real (kind=8) :: walltime, tb, te !----------------------------------------------------------------- ! @@ -455,26 +454,6 @@ SUBROUTINE LSMRUC(xlat,xlon, & testptlon = 278.66 !289.03_kind_phys !271.622 !286.75 !280.6 !164.0 !283.0 !-- - -!> - Table TBQ is for resolution of balance equation in vilka() - CQ=173.15_kind_dbl_prec-.05_kind_dbl_prec - R273=1._kind_dbl_prec/tfrz - R61=6.1153_kind_dbl_prec*0.62198_kind_dbl_prec - ARP=77455._kind_dbl_prec*41.9_kind_dbl_prec/461.525_kind_dbl_prec - BRP=64._kind_dbl_prec*41.9_kind_dbl_prec/461.525_kind_dbl_prec - - DO K=1,5001 - CQ=CQ+.05_kind_dbl_prec - EVS=EXP(17.67_kind_dbl_prec*(CQ-tfrz)/(CQ-29.65_kind_dbl_prec)) - EIS=EXP(22.514_kind_dbl_prec-6.15E3_kind_dbl_prec/CQ) - if(CQ.ge.tfrz) then - ! tbq is in mb - tbq(k) = R61*evs - else - tbq(k) = R61*eis - endif - END DO - !> - Initialize soil/vegetation parameters !--- This is temporary until SI is added to mass coordinate ---!!!!! @@ -7261,8 +7240,9 @@ SUBROUTINE RUCLSMINIT( debug_print, landfrac, fice, min_seaice, & !-- local real (kind_phys), DIMENSION ( 1:nzs ) :: SOILIQW - INTEGER :: I,J,L,itf,jtf + INTEGER :: I,J,L,K,itf,jtf real (kind_phys) :: RIW,XLMELT,TLN,DQM,REF,PSIS,QMIN,BCLH + real (kind_phys) :: cq,r61,r273,arp,brp,x,evs,eis INTEGER :: errflag @@ -7350,6 +7330,26 @@ SUBROUTINE RUCLSMINIT( debug_print, landfrac, fice, min_seaice, & ENDDO ENDDO +!> - Table TBQ is for resolution of balance equation in vilka() + CQ=173.15_kind_dbl_prec-.05_kind_dbl_prec + R273=1._kind_dbl_prec/tfrz + R61=6.1153_kind_dbl_prec*0.62198_kind_dbl_prec + ARP=77455._kind_dbl_prec*41.9_kind_dbl_prec/461.525_kind_dbl_prec + BRP=64._kind_dbl_prec*41.9_kind_dbl_prec/461.525_kind_dbl_prec + + DO K=1,5001 + CQ=CQ+.05_kind_dbl_prec + EVS=EXP(17.67_kind_dbl_prec*(CQ-tfrz)/(CQ-29.65_kind_dbl_prec)) + EIS=EXP(22.514_kind_dbl_prec-6.15E3_kind_dbl_prec/CQ) + if(CQ.ge.tfrz) then + ! tbq is in mb + tbq(k) = R61*evs + else + tbq(k) = R61*eis + endif + END DO + write(6,'("ruclsminit: Done initializing tbq")') + END SUBROUTINE ruclsminit ! diff --git a/physics/SFC_Models/Land/RUC/module_soil_pre.F90 b/physics/SFC_Models/Land/RUC/module_soil_pre.F90 index 8eb5a5775..d8cdf5b82 100644 --- a/physics/SFC_Models/Land/RUC/module_soil_pre.F90 +++ b/physics/SFC_Models/Land/RUC/module_soil_pre.F90 @@ -1,5 +1,6 @@ !>\file module_soil_pre.F90 -!! This file contains subroutines that initialize RUC LSM levels, soil + +!> This module contains subroutines that initialize RUC LSM levels, soil !! temperature/moisture. module module_soil_pre diff --git a/physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 b/physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 index d93dc5c64..a747a5559 100644 --- a/physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 +++ b/physics/SFC_Models/Land/RUC/namelist_soilveg_ruc.F90 @@ -1,6 +1,6 @@ !>\file namelist_soilveg_ruc.F90 -!>\ingroup RUC_lsm +!> This module contains the namelist options of soil/vegetation in RUC module namelist_soilveg_ruc use machine , only : kind_phys diff --git a/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 b/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 index 8ce6023ff..cf0780cb3 100644 --- a/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 +++ b/physics/SFC_Models/Land/RUC/set_soilveg_ruc.F90 @@ -1,7 +1,7 @@ !>\file set_soilveg_ruc.F90 -!! This file contains subroutine to specify vegetation and soil -!! parameters for a given soild and land-use classification. +!> This module contains subroutine to specify vegetation and soil +!! parameters for a given soild and land-use classification. module set_soilveg_ruc_mod use machine , only : kind_phys @@ -45,36 +45,36 @@ subroutine set_soilveg_ruc(me,isot,ivet,nlunit,errmsg,errflg) if(ivet.eq.2) then ! Using umd veg classification slope_data =(/0.1, 0.6, 1.0, 0.35, 0.55, 0.8, & - & 0.63, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0/) + & 0.63, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0 , 0.0, 0.0, 0.0, 0.0, 0.0/) ! ---------------------------------------------------------------------- ! vegetation class-related arrays ! ---------------------------------------------------------------------- rstbl =(/300.0, 175.0, 175.0, 300.0, 300.0, 70.0, & - & 20.0, 225.0, 225.0, 225.0, 400.0, 20.0, & - & 150.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) + & 20.0, 225.0, 225.0, 225.0, 400.0, 20.0, & + & 150.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) rgltbl =(/30.0, 30.0, 30.0, 30.0, 30.0, 65.0, & - & 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, & - & 100.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & - & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) + & 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, & + & 100.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, & + & 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) hstbl =(/41.69, 54.53, 51.93, 47.35, 47.35, 54.53, & - & 36.35, 42.00, 42.00, 42.00, 42.00, 36.35, & - & 42.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/) + & 36.35, 42.00, 42.00, 42.00, 42.00, 36.35, & + & 42.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00/) snuptbl =(/0.040, 0.040, 0.040, 0.040, 0.040, 0.040, & & 0.020, 0.020, 0.020, 0.020, 0.013, 0.020, & & 0.013, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & - & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & + & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/) bare =11 @@ -441,25 +441,21 @@ subroutine set_soilveg_ruc(me,isot,ivet,nlunit,errmsg,errflg) LPARAM =.FALSE. IF (DEFINED_SOIL .GT. MAX_SOILTYP) THEN - WRITE(0,*) 'Warning: DEFINED_SOIL too large in namelist' errflg = 1 errmsg = 'ERROR(set_soilveg_ruc): DEFINED_SOIL too large in namelist' return ENDIF IF (DEFINED_VEG .GT. MAX_VEGTYP) THEN - WRITE(0,*) 'Warning: DEFINED_VEG too large in namelist' errflg = 1 errmsg = 'ERROR(set_soilveg_ruc): DEFINED_VEG too large in namelist' return ENDIF IF (DEFINED_SLOPE .GT. MAX_SLOPETYP) THEN - WRITE(0,*) 'Warning: DEFINED_SLOPE too large in namelist' errflg = 1 errmsg = 'ERROR(set_soilveg_ruc): DEFINED_SLOPE too large in namelist' return ENDIF ! if (me == 0) write(6,soil_veg_ruc) - return end subroutine set_soilveg_ruc end module set_soilveg_ruc_mod diff --git a/physics/SFC_Models/Land/sfc_land.F90 b/physics/SFC_Models/Land/sfc_land.F90 index 2b0696ed8..56aa06dda 100644 --- a/physics/SFC_Models/Land/sfc_land.F90 +++ b/physics/SFC_Models/Land/sfc_land.F90 @@ -10,16 +10,11 @@ module sfc_land use machine, only : kind_phys + use funcphys, only : fpvs contains -!> \defgroup sfc_land for coupling to land -!! @{ -!! \section diagram Calling Hierarchy Diagram -!! \section intraphysics Intraphysics Communication -!! !> \brief Brief description of the subroutine -!! !! \section arg_table_sfc_land_run Arguments !! \htmlinclude sfc_land_run.html !! @@ -28,10 +23,14 @@ module sfc_land !! \section general General Algorithm !! \section detailed Detailed Algorithm !! @{ - subroutine sfc_land_run(im, cpllnd, cpllnd2atm, flag_iter, dry, & - sncovr1_lnd, qsurf_lnd, evap_lnd, hflx_lnd, & - ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & - runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, zvfun_lnd, & + subroutine sfc_land_run(im, flag_init, flag_restart, & + cpllnd, cpllnd2atm, flag_iter, dry, & + t1, q1, prsl1, prslki, ps, tskin, wind, cm, ch, & + dlwflx, dswsfc, sfalb, sfcemis, & + rd, eps, epsm1, rvrdm1, hvap, cp, con_sbc, & + sncovr1_lnd, qsurf_lnd, & + evap_lnd, hflx_lnd, ep_lnd, t2mmp_lnd, q2mp_lnd, gflux_lnd, & + runoff_lnd, drain_lnd, cmm_lnd, chh_lnd, zvfun_lnd, slc, & sncovr1, qsurf, evap, hflx, ep, t2mmp, q2mp, & gflux, runoff, drain, cmm, chh, zvfun, & errmsg, errflg) @@ -39,32 +38,55 @@ subroutine sfc_land_run(im, cpllnd, cpllnd2atm, flag_iter, dry, & implicit none ! Inputs - integer , intent(in) :: im - logical , intent(in) :: cpllnd - logical , intent(in) :: cpllnd2atm - logical , intent(in) :: flag_iter(:) - logical , intent(in) :: dry(:) - real(kind=kind_phys), intent(in) :: sncovr1_lnd(:) - real(kind=kind_phys), intent(in) :: qsurf_lnd(:) - real(kind=kind_phys), intent(in) :: evap_lnd(:) - real(kind=kind_phys), intent(in) :: hflx_lnd(:) - real(kind=kind_phys), intent(in) :: ep_lnd(:) - real(kind=kind_phys), intent(in) :: t2mmp_lnd(:) - real(kind=kind_phys), intent(in) :: q2mp_lnd(:) - real(kind=kind_phys), intent(in) :: gflux_lnd(:) - real(kind=kind_phys), intent(in) :: runoff_lnd(:) - real(kind=kind_phys), intent(in) :: drain_lnd(:) - real(kind=kind_phys), intent(in) :: cmm_lnd(:) - real(kind=kind_phys), intent(in) :: chh_lnd(:) - real(kind=kind_phys), intent(in) :: zvfun_lnd(:) + integer , intent(in) :: im + logical , intent(in) :: flag_init + logical , intent(in) :: flag_restart + logical , intent(in) :: cpllnd + logical , intent(in) :: cpllnd2atm + logical , intent(in) :: flag_iter(:) + logical , intent(in) :: dry(:) + real(kind=kind_phys), intent(in) :: t1(:) + real(kind=kind_phys), intent(in) :: q1(:) + real(kind=kind_phys), intent(in) :: prsl1(:) + real(kind=kind_phys), intent(in) :: prslki(:) + real(kind=kind_phys), intent(in) :: ps(:) + real(kind=kind_phys), intent(in) :: tskin(:) + real(kind=kind_phys), intent(in) :: wind(:) + real(kind=kind_phys), intent(in) :: cm(:) + real(kind=kind_phys), intent(in) :: ch(:) + real(kind=kind_phys), intent(in) :: dlwflx(:) + real(kind=kind_phys), intent(in) :: dswsfc(:) + real(kind=kind_phys), intent(in) :: sfalb(:) + real(kind=kind_phys), intent(in) :: sfcemis(:) + real(kind=kind_phys), intent(in) :: rd + real(kind=kind_phys), intent(in) :: eps + real(kind=kind_phys), intent(in) :: epsm1 + real(kind=kind_phys), intent(in) :: rvrdm1 + real(kind=kind_phys), intent(in) :: hvap + real(kind=kind_phys), intent(in) :: cp + real(kind=kind_phys), intent(in) :: con_sbc + real(kind=kind_phys), intent(in), optional :: sncovr1_lnd(:) + real(kind=kind_phys), intent(in), optional :: qsurf_lnd(:) + real(kind=kind_phys), intent(in), optional :: evap_lnd(:) + real(kind=kind_phys), intent(in), optional :: hflx_lnd(:) + real(kind=kind_phys), intent(in), optional :: ep_lnd(:) + real(kind=kind_phys), intent(in), optional :: t2mmp_lnd(:) + real(kind=kind_phys), intent(in), optional :: q2mp_lnd(:) + real(kind=kind_phys), intent(in), optional :: gflux_lnd(:) + real(kind=kind_phys), intent(in), optional :: runoff_lnd(:) + real(kind=kind_phys), intent(in), optional :: drain_lnd(:) + real(kind=kind_phys), intent(in), optional :: cmm_lnd(:) + real(kind=kind_phys), intent(in), optional :: chh_lnd(:) + real(kind=kind_phys), intent(in), optional :: zvfun_lnd(:) + real(kind=kind_phys), intent(in), optional :: slc(:,:) ! Inputs/Outputs real(kind=kind_phys), intent(inout) :: sncovr1(:) real(kind=kind_phys), intent(inout) :: qsurf(:) real(kind=kind_phys), intent(inout) :: evap(:) real(kind=kind_phys), intent(inout) :: hflx(:) real(kind=kind_phys), intent(inout) :: ep(:) - real(kind=kind_phys), intent(inout) :: t2mmp(:) - real(kind=kind_phys), intent(inout) :: q2mp(:) + real(kind=kind_phys), intent(inout), optional :: t2mmp(:) + real(kind=kind_phys), intent(inout), optional :: q2mp(:) real(kind=kind_phys), intent(inout) :: gflux(:) real(kind=kind_phys), intent(inout) :: runoff(:) real(kind=kind_phys), intent(inout) :: drain(:) @@ -75,34 +97,97 @@ subroutine sfc_land_run(im, cpllnd, cpllnd2atm, flag_iter, dry, & character(len=*) , intent(out) :: errmsg integer , intent(out) :: errflg + ! Constant parameters + real(kind=kind_phys), parameter :: & + & one = 1.0_kind_phys, & + & zero = 0.0_kind_phys, & + & qmin = 1.0e-8_kind_phys, & + & slc_min = 0.05_kind_phys, & ! estimate dry limit for soil moisture + & slc_max = 0.50_kind_phys ! estimate saturated limit for soil moisture + ! Locals integer :: i + real(kind=kind_phys) :: qss, rch, tem, cpinv, hvapi, elocp + real(kind=kind_phys) :: available_energy, soil_stress_factor + real(kind=kind_phys), dimension(im) :: rho, q0 ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + cpinv = one/cp + hvapi = one/hvap + elocp = hvap/cp + ! Check coupling from component land to atmosphere if (.not. cpllnd2atm) return - ! Fill variables - do i = 1, im - sncovr1(i) = sncovr1_lnd(i) - qsurf(i) = qsurf_lnd(i) - hflx(i) = hflx_lnd(i) - evap(i) = evap_lnd(i) - ep(i) = ep_lnd(i) - t2mmp(i) = t2mmp_lnd(i) - q2mp(i) = q2mp_lnd(i) - gflux(i) = gflux_lnd(i) - drain(i) = drain_lnd(i) - runoff(i) = runoff_lnd(i) - cmm(i) = cmm_lnd(i) - chh(i) = chh_lnd(i) - zvfun(i) = zvfun_lnd(i) - enddo + ! Check if it is cold or warm run + if (flag_init .and. .not. flag_restart) then + ! Calculate fluxes internally + do i = 1, im + if (dry(i)) then + soil_stress_factor = (slc(i,1)-slc_min)/(slc_max-slc_min) + soil_stress_factor = min(max(zero,soil_stress_factor),one) + available_energy = dswsfc(i)*(one-sfalb(i))+dlwflx(i)*sfcemis(i) - & + sfcemis(i)*con_sbc*tskin(i)**4 + available_energy = min(max(-200.0,available_energy),1000.0) ! set some arbitrary limits + q0(i) = max(q1(i), qmin) + rho(i) = prsl1(i)/(rd*t1(i)*(one+rvrdm1*q0(i))) + qss = fpvs(tskin(i)) + qss = eps*qss/(ps(i)+epsm1*qss) + rch = rho(i)*cp*ch(i)*wind(i) + tem = ch(i)*wind(i) + sncovr1(i) = zero + qsurf(i) = qss + hflx(i) = rch*(tskin(i)-t1(i)*prslki(i)) ! first guess hflx [W/m2] + evap(i) = elocp*rch*(qss-q0(i)) ! first guess evap [W/m2] + evap(i) = evap(i)*soil_stress_factor ! reduce evap for soil moisture stress + hflx(i) = min(max(-100.0,hflx(i)),500.0) ! set some arbitrary limits + evap(i) = min(max(-100.0,evap(i)),500.0) ! set some arbitrary limits + if(evap(i) + hflx(i) /= zero) then + hflx(i) = available_energy * hflx(i) / (abs(evap(i)) + abs(hflx(i))) + evap(i) = available_energy * evap(i) / (abs(evap(i)) + abs(hflx(i))) + else + hflx(i) = zero + evap(i) = zero + end if + hflx(i) = min(max(-100.0,hflx(i)),500.0) ! set some arbitrary limits + evap(i) = min(max(-100.0,evap(i)),500.0) ! set some arbitrary limits + hflx(i) = hflx(i)*(1.0/rho(i))*cpinv ! convert to expected units + ep(i) = evap(i) + evap(i) = evap(i)*(1.0/rho(i))*hvapi ! convert to expected units + t2mmp(i) = tskin(i) + q2mp(i) = qsurf(i) + gflux(i) = zero + drain(i) = zero + runoff(i) = zero + cmm(i) = cm(i)*wind(i) + chh(i) = rho(i)*tem + zvfun(i) = one + end if + enddo + else + ! Use fluxes from land component model + do i = 1, im + if (dry(i)) then + sncovr1(i) = sncovr1_lnd(i) + qsurf(i) = qsurf_lnd(i) + hflx(i) = hflx_lnd(i) + evap(i) = evap_lnd(i) + ep(i) = ep_lnd(i) + t2mmp(i) = t2mmp_lnd(i) + q2mp(i) = q2mp_lnd(i) + gflux(i) = gflux_lnd(i) + drain(i) = drain_lnd(i) + runoff(i) = runoff_lnd(i) + cmm(i) = cmm_lnd(i) + chh(i) = chh_lnd(i) + zvfun(i) = zvfun_lnd(i) + end if + enddo + endif end subroutine sfc_land_run -!> @} end module sfc_land diff --git a/physics/SFC_Models/Land/sfc_land.meta b/physics/SFC_Models/Land/sfc_land.meta index 6a4bd8fbe..b443c7efb 100644 --- a/physics/SFC_Models/Land/sfc_land.meta +++ b/physics/SFC_Models/Land/sfc_land.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_land type = scheme - dependencies = ../../hooks/machine.F + dependencies = ../../tools/funcphys.f90,../../hooks/machine.F ######################################################################## [ccpp-arg-table] @@ -14,6 +14,20 @@ dimensions = () type = integer intent = in +[flag_init] + standard_name = flag_for_first_timestep + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in [cpllnd] standard_name = flag_for_land_coupling long_name = flag controlling cpllnd collection (default off) @@ -42,6 +56,166 @@ dimensions = (horizontal_loop_extent) type = logical intent = in +[t1] + standard_name = air_temperature_at_surface_adjacent_layer + long_name = surface layer mean temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[q1] + standard_name = specific_humidity_at_surface_adjacent_layer + long_name = surface layer mean specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ps] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[prsl1] + standard_name = air_pressure_at_surface_adjacent_layer + long_name = surface layer mean pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[tskin] + standard_name = surface_skin_temperature_over_land + long_name = surface skin temperature over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[dlwflx] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land + long_name = total sky surface downward longwave flux absorbed by the ground over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[dswsfc] + standard_name = surface_downwelling_shortwave_flux + long_name = total sky surface downward shortwave flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[sfalb] + standard_name = surface_albedo_for_diffused_shortwave_on_radiation_timestep + long_name = mean surface diffused shortwave albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[sfcemis] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_sbc] + standard_name = stefan_boltzmann_constant + long_name = Stefan-Boltzmann constant + units = W m-2 K-4 + dimensions = () + type = real + kind = kind_phys + intent = in [sncovr1_lnd] standard_name = surface_snow_area_fraction_over_land_from_land long_name = surface snow area fraction over land for coupling @@ -50,6 +224,7 @@ type = real kind = kind_phys intent = in + optional = True [qsurf_lnd] standard_name = surface_specific_humidity_over_land_from_land long_name = surface air saturation specific humidity over land @@ -58,6 +233,7 @@ type = real kind = kind_phys intent = in + optional = True [evap_lnd] standard_name = surface_upward_latent_heat_flux_over_land_from_land long_name = sfc latent heat flux input over land for coupling @@ -66,6 +242,7 @@ type = real kind = kind_phys intent = in + optional = True [hflx_lnd] standard_name = surface_upward_sensible_heat_flux_over_land_from_land long_name = sfc sensible heat flux input over land for coupling @@ -74,6 +251,7 @@ type = real kind = kind_phys intent = in + optional = True [ep_lnd] standard_name = surface_upward_potential_latent_heat_flux_over_land_from_land long_name = surface upward potential latent heat flux over land for coupling @@ -82,6 +260,7 @@ type = real kind = kind_phys intent = in + optional = True [t2mmp_lnd] standard_name = temperature_at_2m_over_land_from_land long_name = 2 meter temperature over land for coupling @@ -89,7 +268,8 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = in + optional = True [q2mp_lnd] standard_name = specific_humidity_at_2m_over_land_from_land long_name = 2 meter specific humidity over land for coupling @@ -98,6 +278,7 @@ type = real kind = kind_phys intent = in + optional = True [gflux_lnd] standard_name = upward_heat_flux_in_soil_over_land_from_land long_name = soil heat flux over land for coupling @@ -106,6 +287,7 @@ type = real kind = kind_phys intent = in + optional = True [runoff_lnd] standard_name = surface_runoff_flux_from_land long_name = surface runoff flux over land for coupling @@ -114,6 +296,7 @@ type = real kind = kind_phys intent = in + optional = True [drain_lnd] standard_name = subsurface_runoff_flux_from_land long_name = subsurface runoff flux over land for coupling @@ -122,6 +305,7 @@ type = real kind = kind_phys intent = in + optional = True [cmm_lnd] standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land_from_land long_name = momentum exchange coefficient over land for coupling @@ -129,7 +313,8 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = in + optional = True [chh_lnd] standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land_from_land long_name = thermal exchange coefficient over land for coupling @@ -138,6 +323,7 @@ type = real kind = kind_phys intent = in + optional = True [zvfun_lnd] standard_name = function_of_surface_roughness_length_and_green_vegetation_fraction_from_land long_name = function of surface roughness length and green vegetation fraction @@ -146,6 +332,15 @@ type = real kind = kind_phys intent = in + optional = True +[slc] + standard_name = volume_fraction_of_unfrozen_water_in_soil + long_name = volume fraction of unfrozen soil moisture + units = frac + dimensions = (horizontal_loop_extent,vertical_dimension_of_soil) + type = real + kind = kind_phys + intent = in [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction @@ -194,6 +389,7 @@ type = real kind = kind_phys intent = inout + optional = True [q2mp] standard_name = specific_humidity_at_2m_from_noahmp long_name = 2 meter specific humidity from noahmp @@ -202,6 +398,7 @@ type = real kind = kind_phys intent = inout + optional = True [gflux] standard_name = upward_heat_flux_in_soil_over_land long_name = soil heat flux over land diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.F b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F index 78d58d8f0..1721f248e 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.F +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.F @@ -25,6 +25,7 @@ subroutine sfc_ocean_run & ! --- inputs: & ( im, hvap, cp, rd, eps, epsm1, rvrdm1, ps, u1, v1, t1, q1, & & tskin, cm, ch, lseaspray, fm, fm10, & + & usfco, vsfco, use_oceanuv, & & prsl1, prslki, wet, use_lake_model, wind, &, ! --- inputs & flag_iter, use_med_flux, dqsfc_med, dtsfc_med, & & qsurf, cmm, chh, gflux, evap, hflx, ep, & ! --- outputs @@ -39,6 +40,7 @@ subroutine sfc_ocean_run & ! call sfc_ocean ! ! inputs: ! ! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, lseaspray, fm, fm10, ! +! usfco, vsfco, use_oceanuv, ! ! prsl1, prslki, wet, use_lake_model, wind, flag_iter, ! ! use_med_flux, ! ! outputs: ! @@ -66,6 +68,10 @@ subroutine sfc_ocean_run & ! im - integer, horizontal dimension 1 ! ! ps - real, surface pressure im ! ! u1, v1 - real, u/v component of surface layer wind (m/s) im ! +! usfco - real, u component of surface ocean current (m/s) im ! +! vsfco - real, v component of surface ocean current (m/s) im ! +! use_oceanuv - logical, .t. if usfco and vsfco are used in the 1 ! +! computation of air-sea fluxes ! ! t1 - real, surface layer mean temperature ( k ) im ! ! q1 - real, surface layer mean specific humidity im ! ! tskin - real, ground surface skin temperature ( k ) im ! @@ -109,18 +115,20 @@ subroutine sfc_ocean_run & & eps, epsm1, rvrdm1 real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1, & - & t1, q1, tskin, cm, ch, fm, fm10, prsl1, prslki, wind + & t1, q1, tskin, cm, ch, fm, fm10, prsl1, prslki, wind, & + & usfco, vsfco ! For sea spray effect logical, intent(in) :: lseaspray ! logical, dimension(:), intent(in) :: flag_iter, wet integer, dimension(:), intent(in) :: use_lake_model + logical, intent(in) :: use_oceanuv ! logical, intent(in) :: use_med_flux ! To receive fluxes from mediator - real (kind=kind_phys), dimension(:), intent(in) :: & + real (kind=kind_phys), dimension(:), intent(in), optional :: & & dqsfc_med, dtsfc_med ! --- outputs: @@ -135,6 +143,7 @@ subroutine sfc_ocean_run & real (kind=kind_phys) :: qss, rch, tem, & elocp, cpinv, hvapi real (kind=kind_phys), dimension(im) :: rho, q0 + real (kind=kind_phys), dimension(im) :: windrel integer :: i @@ -174,8 +183,15 @@ subroutine sfc_ocean_run & q0(i) = max( q1(i), qmin ) rho(i) = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0(i))) - tem = ch(i) * wind(i) - cmm(i) = cm(i) * wind(i) + if (use_oceanuv) then + windrel(i)=sqrt( (u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2 ) + tem = ch(i) * windrel(i) + cmm(i) = cm(i) * windrel(i) + else + tem = ch(i) * wind(i) + cmm(i) = cm(i) * wind(i) + endif + chh(i) = rho(i) * tem hflx(i) = dtsfc_med(i) @@ -192,9 +208,17 @@ subroutine sfc_ocean_run & ! --- ... rcp = rho cp ch v - rch = rho(i) * cp * ch(i) * wind(i) - tem = ch(i) * wind(i) - cmm(i) = cm(i) * wind(i) + if (use_oceanuv) then + windrel(i)=sqrt( (u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2 ) + rch = rho(i) * cp * ch(i) * windrel(i) + tem = ch(i) * windrel(i) + cmm(i) = cm(i) * windrel(i) + else + rch = rho(i) * cp * ch(i) * wind(i) + tem = ch(i) * wind(i) + cmm(i) = cm(i) * wind(i) + endif + chh(i) = rho(i) * tem !> - Calcualte sensible and latent heat flux over open water diff --git a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta index 848c2e3ed..69268ee19 100644 --- a/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta +++ b/physics/SFC_Models/Ocean/UFS/sfc_ocean.meta @@ -86,6 +86,29 @@ type = real kind = kind_phys intent = in +[usfco] + standard_name = x_ocean_current + long_name = zonal current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[vsfco] + standard_name = y_ocean_current + long_name = meridional current at ocean surface + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[use_oceanuv] + standard_name = do_air_sea_flux_computation_over_water + long_name = air-sea flux option + units = flag + dimensions = () + type = logical + intent = in [t1] standard_name = air_temperature_at_surface_adjacent_layer long_name = surface layer mean temperature @@ -209,6 +232,7 @@ type = real kind = kind_phys intent = in + optional = True [dtsfc_med] standard_name = surface_upward_sensible_heat_flux_over_ocean_from_mediator long_name = sfc sensible heat flux input over ocean for coupling @@ -217,6 +241,7 @@ type = real kind = kind_phys intent = in + optional = True [qsurf] standard_name = surface_specific_humidity_over_water long_name = surface air saturation specific humidity over water diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_cice.f b/physics/SFC_Models/SeaIce/CICE/sfc_cice.f index 36f2bccbf..3147c0aa1 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_cice.f +++ b/physics/SFC_Models/SeaIce/CICE/sfc_cice.f @@ -11,23 +11,11 @@ module sfc_cice contains -!> \defgroup sfc_sice for coupling to CICE -!! @{ -!! \section diagram Calling Hierarchy Diagram -!! \section intraphysics Intraphysics Communication -!! !> \brief Brief description of the subroutine -!! !! \section arg_table_sfc_cice_run Arguments !! \htmlinclude sfc_cice_run.html !! -!! -!! \section general General Algorithm -!! \section detailed Detailed Algorithm -!! @{ - - !! use physcons, only : hvap => con_hvap, cp => con_cp, & !! & rvrdm1 => con_fvirt, rd => con_rd ! @@ -101,9 +89,12 @@ subroutine sfc_cice_run & ! real (kind=kind_phys), dimension(im), intent(in) :: u1, v1, & real (kind=kind_phys), dimension(:), intent(in) :: & - & t1, q1, cm, ch, prsl1, wind, dqsfc, dtsfc, dusfc, dvsfc - &, snowd - + & t1, q1, cm, ch, prsl1, wind + real (kind=kind_phys), dimension(:), intent(in) :: & + & snowd + + real (kind=kind_phys), dimension(:), intent(in) :: & + & dqsfc, dtsfc, dusfc, dvsfc logical, dimension(:), intent(in) :: flag_cice, flag_iter ! --- outputs: @@ -162,5 +153,4 @@ subroutine sfc_cice_run & end subroutine sfc_cice_run !----------------------------------- -!> @} end module sfc_cice diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta index c44f9d6b5..3920e3820 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta +++ b/physics/SFC_Models/SeaIce/CICE/sfc_cice.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_cice type = scheme - relative_path = ../../../ + dependencies_path = ../../../ dependencies = hooks/machine.F ######################################################################## diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_sice.f b/physics/SFC_Models/SeaIce/CICE/sfc_sice.f index a5904d67c..e5f2deae9 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_sice.f +++ b/physics/SFC_Models/SeaIce/CICE/sfc_sice.f @@ -137,7 +137,8 @@ subroutine sfc_sice_run & ! ! - Define constant parameters integer, parameter :: kmi = 2 !< 2-layer of ice - real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: one = 1.0_kind_phys real(kind=kind_phys), parameter :: himax = 8.0_kind_phys !< maximum ice thickness allowed real(kind=kind_phys), parameter :: himin = 0.1_kind_phys !< minimum ice thickness required real(kind=kind_phys), parameter :: hsmax = 2.0_kind_phys !< maximum snow depth allowed @@ -541,8 +542,8 @@ subroutine ice3lay real (kind=kind_phys), parameter :: dili = di*li real (kind=kind_phys), parameter :: dsli = ds*li real (kind=kind_phys), parameter :: ki4 = ki*4.0_kind_phys - real (kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys - + real (kind=kind_phys), parameter :: zero = 0.0_kind_phys + real (kind=kind_phys), parameter :: one = 1.0_kind_phys ! --- inputs: integer, intent(in) :: im, kmi, ipr logical :: lprnt diff --git a/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta index 828a83939..8436cdd1e 100644 --- a/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta +++ b/physics/SFC_Models/SeaIce/CICE/sfc_sice.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sfc_sice type = scheme - relative_path = ../../../ + dependencies_path = ../../../ dependencies = tools/funcphys.f90,hooks/machine.F ######################################################################## diff --git a/physics/docs/_doxygen/custom.css b/physics/docs/_doxygen/custom.css new file mode 100644 index 000000000..ad6f35a52 --- /dev/null +++ b/physics/docs/_doxygen/custom.css @@ -0,0 +1,57 @@ +.github-corner svg { + fill: var(--primary-light-color); + color: var(--page-background-color); + width: 72px; + height: 72px; +} + +@media screen and (max-width: 767px) { + .github-corner svg { + width: 50px; + height: 50px; + } + #projectnumber { + margin-right: 22px; + } +} + +.alter-theme-button { + display: inline-block; + cursor: pointer; + background: var(--primary-color); + color: var(--page-background-color) !important; + border-radius: var(--border-radius-medium); + padding: var(--spacing-small) var(--spacing-medium); + text-decoration: none; +} + +.alter-theme-button:hover { + background: var(--primary-dark-color); +} + +html.dark-mode .darkmode_inverted_image img, /* < doxygen 1.9.3 */ +html.dark-mode .darkmode_inverted_image object[type="image/svg+xml"] /* doxygen 1.9.3 */ { + filter: brightness(89%) hue-rotate(180deg) invert(); +} + +.bordered_image { + border-radius: var(--border-radius-small); + border: 1px solid var(--separator-color); + display: inline-block; + overflow: hidden; +} + +html.dark-mode .bordered_image img, /* < doxygen 1.9.3 */ +html.dark-mode .bordered_image object[type="image/svg+xml"] /* doxygen 1.9.3 */ { + border-radius: var(--border-radius-small); +} + +.title_screenshot { + filter: drop-shadow(0px 3px 10px rgba(0,0,0,0.22)); + max-width: 500px; + margin: var(--spacing-large) 0; +} + +.title_screenshot .caption { + display: none; +} diff --git a/physics/docs/_doxygen/doxygen-awesome.css b/physics/docs/_doxygen/doxygen-awesome.css index 217fdedfc..5643749c2 100644 --- a/physics/docs/_doxygen/doxygen-awesome.css +++ b/physics/docs/_doxygen/doxygen-awesome.css @@ -894,7 +894,7 @@ div.contents p, div.contents li { } div.contents div.dyncontent { - margin: var(--spacing-medium) 0; + margin: var(--spacing-medium) 0; overflow-x: scroll; } @media (prefers-color-scheme: dark) { diff --git a/physics/docs/_doxygen/header.html b/physics/docs/_doxygen/header.html index 2e72051ea..ac2492e1f 100644 --- a/physics/docs/_doxygen/header.html +++ b/physics/docs/_doxygen/header.html @@ -1,22 +1,38 @@ - - + + + + + + + + + + $projectname: $title $title + + + + + + - $treeview $search $mathjax @@ -24,6 +40,13 @@ $extrastylesheet + + + + + +
diff --git a/physics/docs/ccpp_dox_layout.xml b/physics/docs/ccpp_dox_layout.xml index 6242933b7..b844b5c1b 100644 --- a/physics/docs/ccpp_dox_layout.xml +++ b/physics/docs/ccpp_dox_layout.xml @@ -1,16 +1,16 @@ + - + - - + + - - - - + + + diff --git a/physics/docs/ccpp_doxyfile b/physics/docs/ccpp_doxyfile index 9beb66ece..4f62402e6 100644 --- a/physics/docs/ccpp_doxyfile +++ b/physics/docs/ccpp_doxyfile @@ -1,557 +1,2918 @@ -# Doxyfile 1.9.3 +# Doxyfile 1.12.0 + +# This file describes the settings to be used by the documentation system +# Doxygen (www.doxygen.org) for a project. +# +# All text after a double hash (##) is considered a comment and is placed in +# front of the TAG it is preceding. +# +# All text after a single hash (#) is considered a comment and will be ignored. +# The format is: +# TAG = value [value, ...] +# For lists, items can also be appended using: +# TAG += value [value, ...] +# Values that contain spaces should be placed between quotes (\" \"). +# +# Note: +# +# Use Doxygen to compare the used configuration file with the template +# configuration file: +# doxygen -x [configFile] +# Use Doxygen to compare the used configuration file with the template +# configuration file without replacing the environment variables or CMake type +# replacement variables: +# doxygen -x_noenv [configFile] + +#--------------------------------------------------------------------------- +# Project related configuration options +#--------------------------------------------------------------------------- + +# This tag specifies the encoding used for all characters in the configuration +# file that follow. The default is UTF-8 which is also the encoding used for all +# text before the first occurrence of this tag. Doxygen uses libiconv (or the +# iconv built into libc) for the transcoding. See +# https://www.gnu.org/software/libiconv/ for the list of possible encodings. +# The default value is: UTF-8. DOXYFILE_ENCODING = UTF-8 -PROJECT_NAME = "CCPP SciDoc" -PROJECT_NUMBER = "v6.0.0" + +# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by +# double-quotes, unless you are using Doxywizard) that should identify the +# project for which the documentation is generated. This name is used in the +# title of most generated pages and in a few other places. +# The default value is: My Project. + +PROJECT_NAME = "CCPP SciDoc v7.0.0" + +# The PROJECT_NUMBER tag can be used to enter a project or revision number. This +# could be handy for archiving the generated documentation or if some version +# control system is used. + +PROJECT_NUMBER = v7.0.0 + +# Using the PROJECT_BRIEF tag one can provide an optional one line description +# for a project that appears at the top of each page and should give viewer a +# quick idea about the purpose of the project. Keep the description short. + PROJECT_BRIEF = "Common Community Physics Package Developed at DTC" + +# With the PROJECT_LOGO tag one can specify a logo or an icon that is included +# in the documentation. The maximum height of the logo should not exceed 55 +# pixels and the maximum width should not exceed 200 pixels. Doxygen will copy +# the logo to the output directory. + PROJECT_LOGO = img/dtc_logo.png + +# With the PROJECT_ICON tag one can specify an icon that is included in the tabs +# when the HTML document is shown. Doxygen will copy the logo to the output +# directory. + +PROJECT_ICON = + +# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path +# into which the generated documentation will be written. If a relative path is +# entered, it will be relative to the location where Doxygen was started. If +# left blank the current directory will be used. + OUTPUT_DIRECTORY = doc + +# If the CREATE_SUBDIRS tag is set to YES then Doxygen will create up to 4096 +# sub-directories (in 2 levels) under the output directory of each output format +# and will distribute the generated files over these directories. Enabling this +# option can be useful when feeding Doxygen a huge amount of source files, where +# putting all generated files in the same directory would otherwise causes +# performance problems for the file system. Adapt CREATE_SUBDIRS_LEVEL to +# control the number of sub-directories. +# The default value is: NO. + CREATE_SUBDIRS = NO + +# Controls the number of sub-directories that will be created when +# CREATE_SUBDIRS tag is set to YES. Level 0 represents 16 directories, and every +# level increment doubles the number of directories, resulting in 4096 +# directories at level 8 which is the default and also the maximum value. The +# sub-directories are organized in 2 levels, the first level always has a fixed +# number of 16 directories. +# Minimum value: 0, maximum value: 8, default value: 8. +# This tag requires that the tag CREATE_SUBDIRS is set to YES. + +CREATE_SUBDIRS_LEVEL = 8 + +# If the ALLOW_UNICODE_NAMES tag is set to YES, Doxygen will allow non-ASCII +# characters to appear in the names of generated files. If set to NO, non-ASCII +# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode +# U+3044. +# The default value is: NO. + ALLOW_UNICODE_NAMES = NO + +# The OUTPUT_LANGUAGE tag is used to specify the language in which all +# documentation generated by Doxygen is written. Doxygen will use this +# information to generate all constant output in the proper language. +# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Bulgarian, +# Catalan, Chinese, Chinese-Traditional, Croatian, Czech, Danish, Dutch, English +# (United States), Esperanto, Farsi (Persian), Finnish, French, German, Greek, +# Hindi, Hungarian, Indonesian, Italian, Japanese, Japanese-en (Japanese with +# English messages), Korean, Korean-en (Korean with English messages), Latvian, +# Lithuanian, Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, +# Romanian, Russian, Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, +# Swedish, Turkish, Ukrainian and Vietnamese. +# The default value is: English. + OUTPUT_LANGUAGE = English + +# If the BRIEF_MEMBER_DESC tag is set to YES, Doxygen will include brief member +# descriptions after the members that are listed in the file and class +# documentation (similar to Javadoc). Set to NO to disable this. +# The default value is: YES. + BRIEF_MEMBER_DESC = YES + +# If the REPEAT_BRIEF tag is set to YES, Doxygen will prepend the brief +# description of a member or function before the detailed description +# +# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the +# brief descriptions will be completely suppressed. +# The default value is: YES. + REPEAT_BRIEF = NO + +# This tag implements a quasi-intelligent brief description abbreviator that is +# used to form the text in various listings. Each string in this list, if found +# as the leading text of the brief description, will be stripped from the text +# and the result, after processing the whole list, is used as the annotated +# text. Otherwise, the brief description is used as-is. If left blank, the +# following values are used ($name is automatically replaced with the name of +# the entity):The $name class, The $name widget, The $name file, is, provides, +# specifies, contains, represents, a, an and the. + ABBREVIATE_BRIEF = + +# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then +# Doxygen will generate a detailed section even if there is only a brief +# description. +# The default value is: NO. + ALWAYS_DETAILED_SEC = NO + +# If the INLINE_INHERITED_MEMB tag is set to YES, Doxygen will show all +# inherited members of a class in the documentation of that class as if those +# members were ordinary class members. Constructors, destructors and assignment +# operators of the base classes will not be shown. +# The default value is: NO. + INLINE_INHERITED_MEMB = NO -FULL_PATH_NAMES = NO + +# If the FULL_PATH_NAMES tag is set to YES, Doxygen will prepend the full path +# before files name in the file list and in the header files. If set to NO the +# shortest path that makes the file name unique will be used +# The default value is: YES. + +FULL_PATH_NAMES = YES + +# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. +# Stripping is only done if one of the specified strings matches the left-hand +# part of the path. The tag can be used to show relative paths in the file list. +# If left blank the directory from which Doxygen is run is used as the path to +# strip. +# +# Note that you can specify absolute paths here, but also relative paths, which +# will be relative from the directory where Doxygen is started. +# This tag requires that the tag FULL_PATH_NAMES is set to YES. + STRIP_FROM_PATH = + +# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the +# path mentioned in the documentation of a class, which tells the reader which +# header file to include in order to use a class. If left blank only the name of +# the header file containing the class definition is used. Otherwise one should +# specify the list of include paths that are normally passed to the compiler +# using the -I flag. + STRIP_FROM_INC_PATH = + +# If the SHORT_NAMES tag is set to YES, Doxygen will generate much shorter (but +# less readable) file names. This can be useful is your file systems doesn't +# support long names like on DOS, Mac, or CD-ROM. +# The default value is: NO. + SHORT_NAMES = NO + +# If the JAVADOC_AUTOBRIEF tag is set to YES then Doxygen will interpret the +# first line (until the first dot) of a Javadoc-style comment as the brief +# description. If set to NO, the Javadoc-style will behave just like regular Qt- +# style comments (thus requiring an explicit @brief command for a brief +# description.) +# The default value is: NO. + JAVADOC_AUTOBRIEF = NO + +# If the JAVADOC_BANNER tag is set to YES then Doxygen will interpret a line +# such as +# /*************** +# as being the beginning of a Javadoc-style comment "banner". If set to NO, the +# Javadoc-style will behave just like regular comments and it will not be +# interpreted by Doxygen. +# The default value is: NO. + JAVADOC_BANNER = NO + +# If the QT_AUTOBRIEF tag is set to YES then Doxygen will interpret the first +# line (until the first dot) of a Qt-style comment as the brief description. If +# set to NO, the Qt-style will behave just like regular Qt-style comments (thus +# requiring an explicit \brief command for a brief description.) +# The default value is: NO. + QT_AUTOBRIEF = NO + +# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make Doxygen treat a +# multi-line C++ special comment block (i.e. a block of //! or /// comments) as +# a brief description. This used to be the default behavior. The new default is +# to treat a multi-line C++ comment block as a detailed description. Set this +# tag to YES if you prefer the old behavior instead. +# +# Note that setting this tag to YES also means that rational rose comments are +# not recognized any more. +# The default value is: NO. + MULTILINE_CPP_IS_BRIEF = NO + +# By default Python docstrings are displayed as preformatted text and Doxygen's +# special commands cannot be used. By setting PYTHON_DOCSTRING to NO the +# Doxygen's special commands can be used and the contents of the docstring +# documentation blocks is shown as Doxygen documentation. +# The default value is: YES. + PYTHON_DOCSTRING = YES + +# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the +# documentation from any documented member that it re-implements. +# The default value is: YES. + INHERIT_DOCS = YES + +# If the SEPARATE_MEMBER_PAGES tag is set to YES then Doxygen will produce a new +# page for each member. If set to NO, the documentation of a member will be part +# of the file/class/namespace that contains it. +# The default value is: NO. + SEPARATE_MEMBER_PAGES = YES + +# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen +# uses this value to replace tabs by spaces in code fragments. +# Minimum value: 1, maximum value: 16, default value: 4. + TAB_SIZE = 4 + +# This tag can be used to specify a number of aliases that act as commands in +# the documentation. An alias has the form: +# name=value +# For example adding +# "sideeffect=@par Side Effects:^^" +# will allow you to put the command \sideeffect (or @sideeffect) in the +# documentation, which will result in a user-defined paragraph with heading +# "Side Effects:". Note that you cannot put \n's in the value part of an alias +# to insert newlines (in the resulting output). You can put ^^ in the value part +# of an alias to insert a newline as if a physical newline was in the original +# file. When you need a literal { or } or , in the value part of an alias you +# have to escape them by means of a backslash (\), this can lead to conflicts +# with the commands \{ and \} for these it is advised to use the version @{ and +# @} or use a double escape (\\{ and \\}) + ALIASES = + +# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources +# only. Doxygen will then generate output that is more tailored for C. For +# instance, some of the names that are used will be different. The list of all +# members will be omitted, etc. +# The default value is: NO. + OPTIMIZE_OUTPUT_FOR_C = NO + +# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or +# Python sources only. Doxygen will then generate output that is more tailored +# for that language. For instance, namespaces will be presented as packages, +# qualified scopes will look different, etc. +# The default value is: NO. + OPTIMIZE_OUTPUT_JAVA = NO + +# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran +# sources. Doxygen will then generate output that is tailored for Fortran. +# The default value is: NO. + OPTIMIZE_FOR_FORTRAN = YES + +# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL +# sources. Doxygen will then generate output that is tailored for VHDL. +# The default value is: NO. + OPTIMIZE_OUTPUT_VHDL = NO + +# Set the OPTIMIZE_OUTPUT_SLICE tag to YES if your project consists of Slice +# sources only. Doxygen will then generate output that is more tailored for that +# language. For instance, namespaces will be presented as modules, types will be +# separated into more groups, etc. +# The default value is: NO. + OPTIMIZE_OUTPUT_SLICE = NO + +# Doxygen selects the parser to use depending on the extension of the files it +# parses. With this tag you can assign which parser to use for a given +# extension. Doxygen has a built-in mapping, but you can override or extend it +# using this tag. The format is ext=language, where ext is a file extension, and +# language is one of the parsers supported by Doxygen: IDL, Java, JavaScript, +# Csharp (C#), C, C++, Lex, D, PHP, md (Markdown), Objective-C, Python, Slice, +# VHDL, Fortran (fixed format Fortran: FortranFixed, free formatted Fortran: +# FortranFree, unknown formatted Fortran: Fortran. In the later case the parser +# tries to guess whether the code is fixed or free formatted code, this is the +# default for Fortran type files). For instance to make Doxygen treat .inc files +# as Fortran files (default is PHP), and .f files as C (default is Fortran), +# use: inc=Fortran f=C. +# +# Note: For files without extension you can use no_extension as a placeholder. +# +# Note that for custom extensions you also need to set FILE_PATTERNS otherwise +# the files are not read by Doxygen. When specifying no_extension you should add +# * to the FILE_PATTERNS. +# +# Note see also the list of default file extension mappings. + EXTENSION_MAPPING = .f=FortranFree \ .F=FortranFree \ .F90=FortranFree \ .f90=FortranFree + +# If the MARKDOWN_SUPPORT tag is enabled then Doxygen pre-processes all comments +# according to the Markdown format, which allows for more readable +# documentation. See https://daringfireball.net/projects/markdown/ for details. +# The output of markdown processing is further processed by Doxygen, so you can +# mix Doxygen, HTML, and XML commands with Markdown formatting. Disable only in +# case of backward compatibilities issues. +# The default value is: YES. + MARKDOWN_SUPPORT = YES + +# When the TOC_INCLUDE_HEADINGS tag is set to a non-zero value, all headings up +# to that level are automatically included in the table of contents, even if +# they do not have an id attribute. +# Note: This feature currently applies only to Markdown headings. +# Minimum value: 0, maximum value: 99, default value: 6. +# This tag requires that the tag MARKDOWN_SUPPORT is set to YES. + TOC_INCLUDE_HEADINGS = 5 + +# The MARKDOWN_ID_STYLE tag can be used to specify the algorithm used to +# generate identifiers for the Markdown headings. Note: Every identifier is +# unique. +# Possible values are: DOXYGEN use a fixed 'autotoc_md' string followed by a +# sequence number starting at 0 and GITHUB use the lower case version of title +# with any whitespace replaced by '-' and punctuation characters removed. +# The default value is: DOXYGEN. +# This tag requires that the tag MARKDOWN_SUPPORT is set to YES. + +MARKDOWN_ID_STYLE = DOXYGEN + +# When enabled Doxygen tries to link words that correspond to documented +# classes, or namespaces to their corresponding documentation. Such a link can +# be prevented in individual cases by putting a % sign in front of the word or +# globally by setting AUTOLINK_SUPPORT to NO. +# The default value is: YES. + AUTOLINK_SUPPORT = YES + +# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want +# to include (a tag file for) the STL sources as input, then you should set this +# tag to YES in order to let Doxygen match functions declarations and +# definitions whose arguments contain STL classes (e.g. func(std::string); +# versus func(std::string) {}). This also makes the inheritance and +# collaboration diagrams that involve STL classes more complete and accurate. +# The default value is: NO. + BUILTIN_STL_SUPPORT = NO + +# If you use Microsoft's C++/CLI language, you should set this option to YES to +# enable parsing support. +# The default value is: NO. + CPP_CLI_SUPPORT = NO + +# Set the SIP_SUPPORT tag to YES if your project consists of sip (see: +# https://www.riverbankcomputing.com/software) sources only. Doxygen will parse +# them like normal C++ but will assume all classes use public instead of private +# inheritance when no explicit protection keyword is present. +# The default value is: NO. + SIP_SUPPORT = NO + +# For Microsoft's IDL there are propget and propput attributes to indicate +# getter and setter methods for a property. Setting this option to YES will make +# Doxygen to replace the get and set methods by a property in the documentation. +# This will only work if the methods are indeed getting or setting a simple +# type. If this is not the case, or you want to show the methods anyway, you +# should set this option to NO. +# The default value is: YES. + IDL_PROPERTY_SUPPORT = YES + +# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC +# tag is set to YES then Doxygen will reuse the documentation of the first +# member in the group (if any) for the other members of the group. By default +# all members of a group must be documented explicitly. +# The default value is: NO. + DISTRIBUTE_GROUP_DOC = YES + +# If one adds a struct or class to a group and this option is enabled, then also +# any nested class or struct is added to the same group. By default this option +# is disabled and one has to add nested compounds explicitly via \ingroup. +# The default value is: NO. + GROUP_NESTED_COMPOUNDS = NO + +# Set the SUBGROUPING tag to YES to allow class member groups of the same type +# (for instance a group of public functions) to be put as a subgroup of that +# type (e.g. under the Public Functions section). Set it to NO to prevent +# subgrouping. Alternatively, this can be done per class using the +# \nosubgrouping command. +# The default value is: YES. + SUBGROUPING = YES + +# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions +# are shown inside the group in which they are included (e.g. using \ingroup) +# instead of on a separate page (for HTML and Man pages) or section (for LaTeX +# and RTF). +# +# Note that this feature does not work in combination with +# SEPARATE_MEMBER_PAGES. +# The default value is: NO. + INLINE_GROUPED_CLASSES = NO + +# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions +# with only public data fields or simple typedef fields will be shown inline in +# the documentation of the scope in which they are defined (i.e. file, +# namespace, or group documentation), provided this scope is documented. If set +# to NO, structs, classes, and unions are shown on a separate page (for HTML and +# Man pages) or section (for LaTeX and RTF). +# The default value is: NO. + INLINE_SIMPLE_STRUCTS = NO + +# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or +# enum is documented as struct, union, or enum with the name of the typedef. So +# typedef struct TypeS {} TypeT, will appear in the documentation as a struct +# with name TypeT. When disabled the typedef will appear as a member of a file, +# namespace, or class. And the struct will be named TypeS. This can typically be +# useful for C code in case the coding convention dictates that all compound +# types are typedef'ed and only the typedef is referenced, never the tag name. +# The default value is: NO. + TYPEDEF_HIDES_STRUCT = YES + +# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This +# cache is used to resolve symbols given their name and scope. Since this can be +# an expensive process and often the same symbol appears multiple times in the +# code, Doxygen keeps a cache of pre-resolved symbols. If the cache is too small +# Doxygen will become slower. If the cache is too large, memory is wasted. The +# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range +# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 +# symbols. At the end of a run Doxygen will report the cache usage and suggest +# the optimal cache size from a speed point of view. +# Minimum value: 0, maximum value: 9, default value: 0. + LOOKUP_CACHE_SIZE = 0 + +# The NUM_PROC_THREADS specifies the number of threads Doxygen is allowed to use +# during processing. When set to 0 Doxygen will based this on the number of +# cores available in the system. You can set it explicitly to a value larger +# than 0 to get more control over the balance between CPU load and processing +# speed. At this moment only the input processing can be done using multiple +# threads. Since this is still an experimental feature the default is set to 1, +# which effectively disables parallel processing. Please report any issues you +# encounter. Generating dot graphs in parallel is controlled by the +# DOT_NUM_THREADS setting. +# Minimum value: 0, maximum value: 32, default value: 1. + NUM_PROC_THREADS = 1 +# If the TIMESTAMP tag is set different from NO then each generated page will +# contain the date or date and time when the page was generated. Setting this to +# NO can help when comparing the output of multiple runs. +# Possible values are: YES, NO, DATETIME and DATE. +# The default value is: NO. + +TIMESTAMP = NO + #--------------------------------------------------------------------------- # Build related configuration options #--------------------------------------------------------------------------- +# If the EXTRACT_ALL tag is set to YES, Doxygen will assume all entities in +# documentation are documented, even if no documentation was available. Private +# class members and static file members will be hidden unless the +# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES. +# Note: This will also disable the warnings about undocumented members that are +# normally produced when WARNINGS is set to YES. +# The default value is: NO. + EXTRACT_ALL = YES + +# If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will +# be included in the documentation. +# The default value is: NO. + EXTRACT_PRIVATE = YES + +# If the EXTRACT_PRIV_VIRTUAL tag is set to YES, documented private virtual +# methods of a class will be included in the documentation. +# The default value is: NO. + EXTRACT_PRIV_VIRTUAL = NO + +# If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal +# scope will be included in the documentation. +# The default value is: NO. + EXTRACT_PACKAGE = YES + +# If the EXTRACT_STATIC tag is set to YES, all static members of a file will be +# included in the documentation. +# The default value is: NO. + EXTRACT_STATIC = YES + +# If the EXTRACT_LOCAL_CLASSES tag is set to YES, classes (and structs) defined +# locally in source files will be included in the documentation. If set to NO, +# only classes defined in header files are included. Does not have any effect +# for Java sources. +# The default value is: YES. + EXTRACT_LOCAL_CLASSES = YES + +# This flag is only useful for Objective-C code. If set to YES, local methods, +# which are defined in the implementation section but not in the interface are +# included in the documentation. If set to NO, only methods in the interface are +# included. +# The default value is: NO. + EXTRACT_LOCAL_METHODS = YES + +# If this flag is set to YES, the members of anonymous namespaces will be +# extracted and appear in the documentation as a namespace called +# 'anonymous_namespace{file}', where file will be replaced with the base name of +# the file that contains the anonymous namespace. By default anonymous namespace +# are hidden. +# The default value is: NO. + EXTRACT_ANON_NSPACES = YES + +# If this flag is set to YES, the name of an unnamed parameter in a declaration +# will be determined by the corresponding definition. By default unnamed +# parameters remain unnamed in the output. +# The default value is: YES. + RESOLVE_UNNAMED_PARAMS = YES + +# If the HIDE_UNDOC_MEMBERS tag is set to YES, Doxygen will hide all +# undocumented members inside documented classes or files. If set to NO these +# members will be included in the various overviews, but no documentation +# section is generated. This option has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + HIDE_UNDOC_MEMBERS = NO + +# If the HIDE_UNDOC_CLASSES tag is set to YES, Doxygen will hide all +# undocumented classes that are normally visible in the class hierarchy. If set +# to NO, these classes will be included in the various overviews. This option +# will also hide undocumented C++ concepts if enabled. This option has no effect +# if EXTRACT_ALL is enabled. +# The default value is: NO. + HIDE_UNDOC_CLASSES = NO + +# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, Doxygen will hide all friend +# declarations. If set to NO, these declarations will be included in the +# documentation. +# The default value is: NO. + HIDE_FRIEND_COMPOUNDS = NO + +# If the HIDE_IN_BODY_DOCS tag is set to YES, Doxygen will hide any +# documentation blocks found inside the body of a function. If set to NO, these +# blocks will be appended to the function's detailed documentation block. +# The default value is: NO. + HIDE_IN_BODY_DOCS = NO + +# The INTERNAL_DOCS tag determines if documentation that is typed after a +# \internal command is included. If the tag is set to NO then the documentation +# will be excluded. Set it to YES to include the internal documentation. +# The default value is: NO. + INTERNAL_DOCS = YES + +# With the correct setting of option CASE_SENSE_NAMES Doxygen will better be +# able to match the capabilities of the underlying filesystem. In case the +# filesystem is case sensitive (i.e. it supports files in the same directory +# whose names only differ in casing), the option must be set to YES to properly +# deal with such files in case they appear in the input. For filesystems that +# are not case sensitive the option should be set to NO to properly deal with +# output files written for symbols that only differ in casing, such as for two +# classes, one named CLASS and the other named Class, and to also support +# references to files without having to specify the exact matching casing. On +# Windows (including Cygwin) and macOS, users should typically set this option +# to NO, whereas on Linux or other Unix flavors it should typically be set to +# YES. +# Possible values are: SYSTEM, NO and YES. +# The default value is: SYSTEM. + CASE_SENSE_NAMES = NO + +# If the HIDE_SCOPE_NAMES tag is set to NO then Doxygen will show members with +# their full class and namespace scopes in the documentation. If set to YES, the +# scope will be hidden. +# The default value is: NO. + HIDE_SCOPE_NAMES = NO + +# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then Doxygen will +# append additional text to a page's title, such as Class Reference. If set to +# YES the compound reference will be hidden. +# The default value is: NO. + HIDE_COMPOUND_REFERENCE= NO + +# If the SHOW_HEADERFILE tag is set to YES then the documentation for a class +# will show which file needs to be included to use the class. +# The default value is: YES. + SHOW_HEADERFILE = YES -SHOW_INCLUDE_FILES = NO + +# If the SHOW_INCLUDE_FILES tag is set to YES then Doxygen will put a list of +# the files that are included by a file in the documentation of that file. +# The default value is: YES. + +SHOW_INCLUDE_FILES = YES + +# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each +# grouped member an include statement to the documentation, telling the reader +# which file to include in order to use the member. +# The default value is: NO. + SHOW_GROUPED_MEMB_INC = NO + +# If the FORCE_LOCAL_INCLUDES tag is set to YES then Doxygen will list include +# files with double quotes in the documentation rather than with sharp brackets. +# The default value is: NO. + FORCE_LOCAL_INCLUDES = NO + +# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the +# documentation for inline members. +# The default value is: YES. + INLINE_INFO = YES + +# If the SORT_MEMBER_DOCS tag is set to YES then Doxygen will sort the +# (detailed) documentation of file and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. +# The default value is: YES. + SORT_MEMBER_DOCS = NO + +# If the SORT_BRIEF_DOCS tag is set to YES then Doxygen will sort the brief +# descriptions of file, namespace and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. Note that +# this will also influence the order of the classes in the class list. +# The default value is: NO. + SORT_BRIEF_DOCS = NO + +# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then Doxygen will sort the +# (brief and detailed) documentation of class members so that constructors and +# destructors are listed first. If set to NO the constructors will appear in the +# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS. +# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief +# member documentation. +# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting +# detailed member documentation. +# The default value is: NO. + SORT_MEMBERS_CTORS_1ST = NO + +# If the SORT_GROUP_NAMES tag is set to YES then Doxygen will sort the hierarchy +# of group names into alphabetical order. If set to NO the group names will +# appear in their defined order. +# The default value is: NO. + SORT_GROUP_NAMES = NO + +# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by +# fully-qualified names, including namespaces. If set to NO, the class list will +# be sorted only by class name, not including the namespace part. +# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. +# Note: This option applies only to the class list, not to the alphabetical +# list. +# The default value is: NO. + SORT_BY_SCOPE_NAME = NO + +# If the STRICT_PROTO_MATCHING option is enabled and Doxygen fails to do proper +# type resolution of all parameters of a function it will reject a match between +# the prototype and the implementation of a member function even if there is +# only one candidate or it is obvious which candidate to choose by doing a +# simple string match. By disabling STRICT_PROTO_MATCHING Doxygen will still +# accept a match between prototype and implementation in such cases. +# The default value is: NO. + STRICT_PROTO_MATCHING = NO + +# The GENERATE_TODOLIST tag can be used to enable (YES) or disable (NO) the todo +# list. This list is created by putting \todo commands in the documentation. +# The default value is: YES. + GENERATE_TODOLIST = YES + +# The GENERATE_TESTLIST tag can be used to enable (YES) or disable (NO) the test +# list. This list is created by putting \test commands in the documentation. +# The default value is: YES. + GENERATE_TESTLIST = YES + +# The GENERATE_BUGLIST tag can be used to enable (YES) or disable (NO) the bug +# list. This list is created by putting \bug commands in the documentation. +# The default value is: YES. + GENERATE_BUGLIST = YES + +# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or disable (NO) +# the deprecated list. This list is created by putting \deprecated commands in +# the documentation. +# The default value is: YES. + GENERATE_DEPRECATEDLIST= YES + +# The ENABLED_SECTIONS tag can be used to enable conditional documentation +# sections, marked by \if ... \endif and \cond +# ... \endcond blocks. + ENABLED_SECTIONS = YES + +# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the +# initial value of a variable or macro / define can have for it to appear in the +# documentation. If the initializer consists of more lines than specified here +# it will be hidden. Use a value of 0 to hide initializers completely. The +# appearance of the value of individual variables and macros / defines can be +# controlled using \showinitializer or \hideinitializer command in the +# documentation regardless of this setting. +# Minimum value: 0, maximum value: 10000, default value: 30. + MAX_INITIALIZER_LINES = 30 + +# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at +# the bottom of the documentation of classes and structs. If set to YES, the +# list will mention the files that were used to generate the documentation. +# The default value is: YES. + SHOW_USED_FILES = NO -SHOW_FILES = NO + +# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This +# will remove the Files entry from the Quick Index and from the Folder Tree View +# (if specified). +# The default value is: YES. + +SHOW_FILES = NO + +# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces +# page. This will remove the Namespaces entry from the Quick Index and from the +# Folder Tree View (if specified). +# The default value is: YES. + SHOW_NAMESPACES = YES + +# The FILE_VERSION_FILTER tag can be used to specify a program or script that +# Doxygen should invoke to get the current version for each file (typically from +# the version control system). Doxygen will invoke the program by executing (via +# popen()) the command command input-file, where command is the value of the +# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided +# by Doxygen. Whatever the program writes to standard output is used as the file +# version. For an example see the documentation. + FILE_VERSION_FILTER = + +# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed +# by Doxygen. The layout file controls the global structure of the generated +# output files in an output format independent way. To create the layout file +# that represents Doxygen's defaults, run Doxygen with the -l option. You can +# optionally specify a file name after the option, if omitted DoxygenLayout.xml +# will be used as the name of the layout file. See also section "Changing the +# layout of pages" for information. +# +# Note that if you run Doxygen from a directory containing a file called +# DoxygenLayout.xml, Doxygen will parse it automatically even if the LAYOUT_FILE +# tag is left empty. + LAYOUT_FILE = ccpp_dox_layout.xml + +# The CITE_BIB_FILES tag can be used to specify one or more bib files containing +# the reference definitions. This must be a list of .bib files. The .bib +# extension is automatically appended if omitted. This requires the bibtex tool +# to be installed. See also https://en.wikipedia.org/wiki/BibTeX for more info. +# For LaTeX the style of the bibliography can be controlled using +# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the +# search path. See also \cite for info how to create references. + CITE_BIB_FILES = library.bib +# The EXTERNAL_TOOL_PATH tag can be used to extend the search path (PATH +# environment variable) so that external tools such as latex and gs can be +# found. +# Note: Directories specified with EXTERNAL_TOOL_PATH are added in front of the +# path already specified by the PATH variable, and are added in the order +# specified. +# Note: This option is particularly useful for macOS version 14 (Sonoma) and +# higher, when running Doxygen from Doxywizard, because in this case any user- +# defined changes to the PATH are ignored. A typical example on macOS is to set +# EXTERNAL_TOOL_PATH = /Library/TeX/texbin /usr/local/bin +# together with the standard path, the full search path used by doxygen when +# launching external tools will then become +# PATH=/Library/TeX/texbin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin + +EXTERNAL_TOOL_PATH = + #--------------------------------------------------------------------------- # Configuration options related to warning and progress messages #--------------------------------------------------------------------------- + +# The QUIET tag can be used to turn on/off the messages that are generated to +# standard output by Doxygen. If QUIET is set to YES this implies that the +# messages are off. +# The default value is: NO. + QUIET = NO + +# The WARNINGS tag can be used to turn on/off the warning messages that are +# generated to standard error (stderr) by Doxygen. If WARNINGS is set to YES +# this implies that the warnings are on. +# +# Tip: Turn warnings on while writing the documentation. +# The default value is: YES. + WARNINGS = YES + +# If the WARN_IF_UNDOCUMENTED tag is set to YES then Doxygen will generate +# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag +# will automatically be disabled. +# The default value is: YES. + WARN_IF_UNDOCUMENTED = NO + +# If the WARN_IF_DOC_ERROR tag is set to YES, Doxygen will generate warnings for +# potential errors in the documentation, such as documenting some parameters in +# a documented function twice, or documenting parameters that don't exist or +# using markup commands wrongly. +# The default value is: YES. + WARN_IF_DOC_ERROR = YES + +# If WARN_IF_INCOMPLETE_DOC is set to YES, Doxygen will warn about incomplete +# function parameter documentation. If set to NO, Doxygen will accept that some +# parameters have no documentation without warning. +# The default value is: YES. + WARN_IF_INCOMPLETE_DOC = YES + +# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that +# are documented, but have no documentation for their parameters or return +# value. If set to NO, Doxygen will only warn about wrong parameter +# documentation, but not about the absence of documentation. If EXTRACT_ALL is +# set to YES then this flag will automatically be disabled. See also +# WARN_IF_INCOMPLETE_DOC +# The default value is: NO. + WARN_NO_PARAMDOC = NO + +# If WARN_IF_UNDOC_ENUM_VAL option is set to YES, Doxygen will warn about +# undocumented enumeration values. If set to NO, Doxygen will accept +# undocumented enumeration values. If EXTRACT_ALL is set to YES then this flag +# will automatically be disabled. +# The default value is: NO. + +WARN_IF_UNDOC_ENUM_VAL = NO + +# If the WARN_AS_ERROR tag is set to YES then Doxygen will immediately stop when +# a warning is encountered. If the WARN_AS_ERROR tag is set to FAIL_ON_WARNINGS +# then Doxygen will continue running as if WARN_AS_ERROR tag is set to NO, but +# at the end of the Doxygen process Doxygen will return with a non-zero status. +# If the WARN_AS_ERROR tag is set to FAIL_ON_WARNINGS_PRINT then Doxygen behaves +# like FAIL_ON_WARNINGS but in case no WARN_LOGFILE is defined Doxygen will not +# write the warning messages in between other messages but write them at the end +# of a run, in case a WARN_LOGFILE is defined the warning messages will be +# besides being in the defined file also be shown at the end of a run, unless +# the WARN_LOGFILE is defined as - i.e. standard output (stdout) in that case +# the behavior will remain as with the setting FAIL_ON_WARNINGS. +# Possible values are: NO, YES, FAIL_ON_WARNINGS and FAIL_ON_WARNINGS_PRINT. +# The default value is: NO. + WARN_AS_ERROR = NO + +# The WARN_FORMAT tag determines the format of the warning messages that Doxygen +# can produce. The string should contain the $file, $line, and $text tags, which +# will be replaced by the file and line number from which the warning originated +# and the warning text. Optionally the format may contain $version, which will +# be replaced by the version of the file (if it could be obtained via +# FILE_VERSION_FILTER) +# See also: WARN_LINE_FORMAT +# The default value is: $file:$line: $text. + WARN_FORMAT = -WARN_LOGFILE = + +# In the $text part of the WARN_FORMAT command it is possible that a reference +# to a more specific place is given. To make it easier to jump to this place +# (outside of Doxygen) the user can define a custom "cut" / "paste" string. +# Example: +# WARN_LINE_FORMAT = "'vi $file +$line'" +# See also: WARN_FORMAT +# The default value is: at line $line of file $file. + +WARN_LINE_FORMAT = "at line $line of file $file" + +# The WARN_LOGFILE tag can be used to specify a file to which warning and error +# messages should be written. If left blank the output is written to standard +# error (stderr). In case the file specified cannot be opened for writing the +# warning and error messages are written to standard error. When as file - is +# specified the warning and error messages are written to standard output +# (stdout). + +WARN_LOGFILE = #--------------------------------------------------------------------------- # Configuration options related to the input files #--------------------------------------------------------------------------- -INPUT = pdftxt/mainpage.txt \ - pdftxt/all_schemes_list.txt \ - pdftxt/GFS_v16_suite.txt \ - pdftxt/GFS_v17_p8_suite.txt \ - pdftxt/RAP_suite.txt \ - pdftxt/HRRR_suite.txt \ - pdftxt/RE6/FV3_HRRR_input.nml \ - pdftxt/RRFS_v1beta_suite.txt \ - pdftxt/WoFS_v0_suite.txt \ - pdftxt/RRFS_SGSCLOUD.txt \ - pdftxt/GFS_RRTMG.txt \ - pdftxt/GFS_SFCLYR.txt \ - pdftxt/MYNN_SFCLAYER.txt \ - pdftxt/GFS_NSST.txt \ - pdftxt/GFS_OCEAN.txt \ - pdftxt/GFS_NOAH.txt \ - pdftxt/GFS_SFCSICE.txt \ - pdftxt/GFS_SATMEDMFVDIFQ.txt \ - pdftxt/GFS_NOAHMP.txt \ - pdftxt/GFS_UGWPv0.txt \ - pdftxt/GFS_unified_ugwp.txt \ - pdftxt/GFS_drag_suite.txt \ - pdftxt/GFS_GWDPS.txt \ - pdftxt/GFS_OZPHYS.txt \ - pdftxt/GFS_H2OPHYS.txt \ - pdftxt/GFS_SAMFdeep.txt \ - pdftxt/GFS_SAMFshal.txt \ - pdftxt/GFDL_cloud.txt \ - pdftxt/NSSLMICRO.txt \ - pdftxt/MYNN_EDMF.txt \ - pdftxt/CU_GF_deep.txt \ - pdftxt/RUCLSM.txt \ - pdftxt/THOMPSON.txt \ - pdftxt/suite_input.nml.txt \ - pdftxt/GFS_SPP.txt \ - ../fv_sat_adj.F90 \ - ../GFS_time_vary_pre.fv3.F90 \ - ../GFS_rad_time_vary.fv3.F90 \ - ../GFS_phys_time_vary.fv3.F90 \ - ../get_prs_fv3.F90 \ - ../get_phi_fv3.F90 \ - ../ozne_def.f \ - ../ozinterp.f90 \ - ../h2o_def.f \ - ../h2ointerp.f90 \ - ../aerclm_def.F \ - ../aerinterp.F90 \ - ../iccn_def.F \ - ../iccninterp.F90 \ - ../sfcsub.F \ - ../gcycle.F90 \ - ../GFS_suite_interstitial_1.F90 \ - ../GFS_suite_interstitial_2.F90 \ - ../GFS_suite_interstitial_3.F90 \ - ../GFS_suite_interstitial_4.F90 \ - ../GFS_suite_interstitial_5.F90 \ - ../GFS_suite_interstitial_phys_reset.F90 \ - ../GFS_suite_interstitial_rad_reset.F90 \ - ../GFS_suite_stateout_reset.F90 \ - ../GFS_suite_stateout_update.F90 \ - ../GFS_surface_composites_inter.F90 \ - ../GFS_surface_composites_pre.F90 \ - ../GFS_surface_composites_post.F90 \ - ../GFS_surface_loop_control_part1.F90 \ - ../GFS_surface_loop_control_part2.F90 \ - ../GFS_radiation_surface.F90 \ - ../GFS_rrtmg_pre.F90 \ - ../GFS_rrtmg_post.F90 \ - ../GFS_rrtmg_setup.F90 \ - ../rad_sw_pre.F90 \ - ../sgscloud_radpre.F90 \ - ../sgscloud_radpost.F90 \ - ../radsw_main.F90 \ - ../rrtmg_sw_post.F90 \ - ../rrtmg_lw_pre.F90 \ - ../radlw_main.F90 \ - ../rrtmg_lw_post.F90 \ - ../radiation_aerosols.f \ - ../radiation_astronomy.f \ - ../radiation_clouds.f \ - ../radiation_cloud_overlap.F90 \ - ../radiation_gases.f \ - ../radiation_surface.f \ - ../radlw_param.f \ - ../radlw_datatb.f \ - ../radsw_param.f \ - ../radsw_datatb.f \ - ../GFS_cloud_diagnostics.F90 \ - ../dcyc2t3.f \ - ../sfc_diff.f \ - ../sfc_diag.f \ - ../sfc_diag_post.F90 \ - ../sfc_nst.f \ - ../sfc_nst_pre.f \ - ../sfc_nst_post.f \ - ../sfc_ocean.F \ - ../module_nst_model.f90 \ - ../module_nst_parameters.f90 \ - ../module_nst_water_prop.f90 \ - ../lsm_noah.f \ - ../sflx.f \ - ../namelist_soilveg.f \ - ../set_soilveg.f \ - ../noahmpdrv.F90 \ - ../module_sf_noahmplsm.f90 \ - ../module_sf_noahmp_glacier.f90 \ - ../noahmp_tables.f90 \ - ../GFS_surface_generic_pre.F90 \ - ../GFS_surface_generic_post.F90 \ - ../surface_perturbation.F90 \ - ../GFS_DCNV_generic_pre.F90 \ - ../GFS_DCNV_generic_post.F90 \ - ../GFS_SCNV_generic_pre.F90 \ - ../GFS_SCNV_generic_post.F90 \ - ../sfc_sice.f \ - ../satmedmfvdifq.F \ - ../mfpbltq.f \ - ../mfscuq.f \ - ../tridi.f \ - ../GFS_GWD_generic_pre.F90 \ - ../GFS_GWD_generic_post.F90 \ - ../unified_ugwp.F90 \ - ../drag_suite.F90 \ - ../cires_tauamf_data.F90 \ - ../cires_orowam2017.f \ - ../cires_ugwp.F90 \ - ../cires_ugwp_initialize.F90 \ - ../cires_ugwp_module.F90 \ - ../cires_ugwp_post.F90 \ - ../cires_ugwp_triggers.F90 \ - ../cires_ugwp_module.F90 \ - ../gwdps.f \ - ../ugwp_driver_v0.F \ - ../ozphys_2015.f \ - ../h2ophys.f \ - ../samfdeepcnv.f \ - ../samfshalcnv.f \ - ../cnvc90.f \ - ../module_bfmicrophysics.f \ - ../gfdl_cloud_microphys.F90 \ - ../module_gfdl_cloud_microphys.F90 \ - ../GFS_MP_generic_pre.F90 \ - ../GFS_MP_generic_post.F90 \ - ../GFS_PBL_generic_common.F90 \ - ../GFS_PBL_generic_pre.F90 \ - ../GFS_PBL_generic_post.F90 \ - ../calpreciptype.f90 \ - ../GFS_stochastics.F90 \ - ../cu_gf_driver.F90 \ - ../cu_gf_driver_pre.F90 \ - ../cu_gf_deep.F90 \ - ../cu_gf_sh.F90 \ - ../cu_gf_driver_post.F90 \ - ../mynnedmf_wrapper.F90 \ - ../module_bl_mynn.F90 \ - ../mynnsfc_wrapper.F90 \ - ../module_sf_mynn.F90 \ - ../lsm_ruc.F90 \ - ../module_sf_ruclsm.F90 \ - ../namelist_soilveg_ruc.F90 \ - ../set_soilveg_ruc.F90 \ - ../module_soil_pre.F90 \ - ../mp_thompson_pre.F90 \ - ../module_mp_thompson_make_number_concentrations.F90 \ - ../mp_thompson.F90 \ - ../module_mp_thompson.F90 \ - ../module_mp_radar.F90 \ - ../mp_thompson_post.F90 \ - ../mp_nssl.F90 \ - ../module_mp_nssl_2mom.F90 \ - ../funcphys.f90 \ - ../physparam.f \ - ../physcons.F90 \ - ../radcons.f90 \ - ../mersenne_twister.f \ - ../maximum_hourly_diagnostics.F90 \ - ../phys_tend.F90 +# The INPUT tag is used to specify the files and/or directories that contain +# documented source files. You may enter file names like myfile.cpp or +# directories like /usr/src/myproject. Separate the files or directories with +# spaces. See also FILE_PATTERNS and EXTENSION_MAPPING +# Note: If this tag is empty the current directory is searched. + +INPUT = pdftxt/mainpage.txt \ + pdftxt/ccppv7_phy_updates.txt \ + pdftxt/all_schemes_list.txt \ + pdftxt/GFS_v16_suite.txt \ + pdftxt/GFS_v16_RRTMGP_suite.txt \ + pdftxt/GFS_v17_p8_ugwpv1_suite.txt \ + pdftxt/HRRR_gf_suite.txt \ + pdftxt/WoFS_v0_suite.txt \ + pdftxt/RRFS_SGSCLOUD.txt \ + pdftxt/GFS_RRTMG.txt \ + pdftxt/GFS_RRTMGP.txt \ + pdftxt/GFS_SFCLYR.txt \ + pdftxt/MYNN_SFCLAYER.txt \ + pdftxt/GFS_NSST.txt \ + pdftxt/GFS_OCEAN.txt \ + pdftxt/NOAH_LSM.txt \ + pdftxt/GFS_SFCSICE.txt \ + pdftxt/GFS_SATMEDMFVDIFQ.txt \ + pdftxt/NOAHMP_LSM.txt \ + pdftxt/UGWPv0.txt \ + pdftxt/GFS_ugwpv1.txt \ + pdftxt/GFS_UGWPV1_ORO.txt \ + pdftxt/GFS_GWDPS.txt \ + pdftxt/GFS_OZPHYS.txt \ + pdftxt/GFS_H2OPHYS.txt \ + pdftxt/GFS_SAMFdeep.txt \ + pdftxt/GFS_SAMFshal.txt \ + pdftxt/GFDL_cloud.txt \ + pdftxt/NSSLMICRO.txt \ + pdftxt/MYNN_EDMF.txt \ + pdftxt/CU_GF_deep.txt \ + pdftxt/RUCLSM.txt \ + pdftxt/CLM_LAKE.txt \ + pdftxt/THOMPSON.txt \ + pdftxt/suite_input.nml.txt \ + pdftxt/acronyms.txt \ + ../MP \ + ../CONV \ + ../GWD \ + ../SFC_Layer \ + ../PBL \ + ../SFC_Models \ + ../photochem \ + ../Radiation + +# This tag can be used to specify the character encoding of the source files +# that Doxygen parses. Internally Doxygen uses the UTF-8 encoding. Doxygen uses +# libiconv (or the iconv built into libc) for the transcoding. See the libiconv +# documentation (see: +# https://www.gnu.org/software/libiconv/) for the list of possible encodings. +# See also: INPUT_FILE_ENCODING +# The default value is: UTF-8. INPUT_ENCODING = UTF-8 + +# This tag can be used to specify the character encoding of the source files +# that Doxygen parses The INPUT_FILE_ENCODING tag can be used to specify +# character encoding on a per file pattern basis. Doxygen will compare the file +# name with each pattern and apply the encoding instead of the default +# INPUT_ENCODING) if there is a match. The character encodings are a list of the +# form: pattern=encoding (like *.php=ISO-8859-1). +# See also: INPUT_ENCODING for further information on supported encodings. + +INPUT_FILE_ENCODING = + +# If the value of the INPUT tag contains directories, you can use the +# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and +# *.h) to filter out the source-files in the directories. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# read by Doxygen. +# +# Note the list of default checked file patterns might differ from the list of +# default file extension mappings. +# +# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cxxm, +# *.cpp, *.cppm, *.ccm, *.c++, *.c++m, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, +# *.idl, *.ddl, *.odl, *.h, *.hh, *.hxx, *.hpp, *.h++, *.ixx, *.l, *.cs, *.d, +# *.php, *.php4, *.php5, *.phtml, *.inc, *.m, *.markdown, *.md, *.mm, *.dox (to +# be provided as Doxygen C comment), *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, +# *.f18, *.f, *.for, *.vhd, *.vhdl, *.ucf, *.qsf and *.ice. + FILE_PATTERNS = *.f \ *.F \ *.F90 \ *.f90 \ *.nml \ *.txt + +# The RECURSIVE tag can be used to specify whether or not subdirectories should +# be searched for input files as well. +# The default value is: NO. + RECURSIVE = YES -EXCLUDE = + +# The EXCLUDE tag can be used to specify files and/or directories that should be +# excluded from the INPUT source files. This way you can easily exclude a +# subdirectory from a directory tree whose root is specified with the INPUT tag. +# +# Note that relative paths are relative to the directory from which Doxygen is +# run. + +EXCLUDE = ../Radiation/RRTMGP/rte-rrtmgp \ + ../MP/Morrison_Gettelman \ + ../MP/Ferrier_Aligo \ + ../MP/Zhao_Carr \ + ../PBL/MYJ \ + ../PBL/HEDMF \ + ../PBL/SHOC \ + ../PBL/saYSU \ + ../PBL/YSU \ + ../PBL/SATMEDMF/mfscu.f \ + ../PBL/SATMEDMF/satmedmfvdif.F \ + ../SFC_Models/Lake/Flake \ + ../smoke_dust \ + ../SFC_Layer/GFDL \ + ../SFC_Layer/MYJ \ + ../tools \ + ../CONV/C3 \ + ../CONV/Chikira_Sugiyama \ + ../CONV/nTiedtke \ + ../CONV/RAS \ + ../CONV/SAS \ + ../CONV/SAMF/samfaerosols.F \ + ../SFC_Layer/UFS/date_def.f \ + ../GWD/cires_ugwpv1_module.F90 \ + ../GWD/cires_ugwpv1_initialize.F90 \ + ../GWD/cires_ugwpv1_oro.F90 \ + ../GWD/cires_ugwpv1_solv2.F90 \ + ../GWD/cires_ugwpv1_sporo.F90 \ + ../GWD/cires_ugwpv1_triggers.F90 \ + ../GWD/cires_tauamf_data.F90 \ + ../GWD/unified_ugwp.F90 \ + ../GWD/unified_ugwp_post.F90 \ + ../GWD/gwdc.f \ + ../GWD/gwdc_post.f \ + ../GWD/gwdc_pre.f \ + ../GWD/rayleigh_damp.f + +# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or +# directories that are symbolic links (a Unix file system feature) are excluded +# from the input. +# The default value is: NO. + EXCLUDE_SYMLINKS = NO + +# If the value of the INPUT tag contains directories, you can use the +# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude +# certain files from those directories. +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories for example use the pattern */test/* + EXCLUDE_PATTERNS = + +# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names +# (namespaces, classes, functions, etc.) that should be excluded from the +# output. The symbol name can be a fully qualified name, a word, or if the +# wildcard * is used, a substring. Examples: ANamespace, AClass, +# ANamespace::AClass, ANamespace::*Test + EXCLUDE_SYMBOLS = -EXAMPLE_PATH = pdftxt/RE6 \ + +# The EXAMPLE_PATH tag can be used to specify one or more files or directories +# that contain example code fragments that are included (see the \include +# command). + +EXAMPLE_PATH = pdftxt/RE7 \ doc/html -EXAMPLE_PATTERNS = + +# If the value of the EXAMPLE_PATH tag contains directories, you can use the +# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and +# *.h) to filter out the source-files in the directories. If left blank all +# files are included. + +EXAMPLE_PATTERNS = + +# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be +# searched for input files to be used with the \include or \dontinclude commands +# irrespective of the value of the RECURSIVE tag. +# The default value is: NO. + EXAMPLE_RECURSIVE = NO + +# The IMAGE_PATH tag can be used to specify one or more files or directories +# that contain images that are to be included in the documentation (see the +# \image command). + IMAGE_PATH = img + +# The INPUT_FILTER tag can be used to specify a program that Doxygen should +# invoke to filter for each input file. Doxygen will invoke the filter program +# by executing (via popen()) the command: +# +# +# +# where is the value of the INPUT_FILTER tag, and is the +# name of an input file. Doxygen will then use the output that the filter +# program writes to standard output. If FILTER_PATTERNS is specified, this tag +# will be ignored. +# +# Note that the filter must not add or remove lines; it is applied before the +# code is scanned, but not when the output code is generated. If lines are added +# or removed, the anchors will not be placed correctly. +# +# Note that Doxygen will use the data processed and written to standard output +# for further processing, therefore nothing else, like debug statements or used +# commands (so in case of a Windows batch file always use @echo OFF), should be +# written to standard output. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by Doxygen. + INPUT_FILTER = + +# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern +# basis. Doxygen will compare the file name with each pattern and apply the +# filter if there is a match. The filters are a list of the form: pattern=filter +# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how +# filters are used. If the FILTER_PATTERNS tag is empty or if none of the +# patterns match the file name, INPUT_FILTER is applied. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by Doxygen. + FILTER_PATTERNS = + +# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using +# INPUT_FILTER) will also be used to filter the input files that are used for +# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES). +# The default value is: NO. + FILTER_SOURCE_FILES = NO + +# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file +# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and +# it is also possible to disable source filtering for a specific pattern using +# *.ext= (so without naming a filter). +# This tag requires that the tag FILTER_SOURCE_FILES is set to YES. + FILTER_SOURCE_PATTERNS = + +# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that +# is part of the input, its contents will be placed on the main page +# (index.html). This can be useful if you have a project on for instance GitHub +# and want to reuse the introduction page also for the Doxygen output. + USE_MDFILE_AS_MAINPAGE = +# The Fortran standard specifies that for fixed formatted Fortran code all +# characters from position 72 are to be considered as comment. A common +# extension is to allow longer lines before the automatic comment starts. The +# setting FORTRAN_COMMENT_AFTER will also make it possible that longer lines can +# be processed before the automatic comment starts. +# Minimum value: 7, maximum value: 10000, default value: 72. + +FORTRAN_COMMENT_AFTER = 72 + #--------------------------------------------------------------------------- # Configuration options related to source browsing #--------------------------------------------------------------------------- -SOURCE_BROWSER = NO +# If the SOURCE_BROWSER tag is set to YES then a list of source files will be +# generated. Documented entities will be cross-referenced with these sources. +# +# Note: To get rid of all source code in the generated output, make sure that +# also VERBATIM_HEADERS is set to NO. +# The default value is: NO. + +SOURCE_BROWSER = YES + +# Setting the INLINE_SOURCES tag to YES will include the body of functions, +# multi-line macros, enums or list initialized variables directly into the +# documentation. +# The default value is: NO. + INLINE_SOURCES = NO + +# Setting the STRIP_CODE_COMMENTS tag to YES will instruct Doxygen to hide any +# special comment blocks from generated source code fragments. Normal C, C++ and +# Fortran comments will always remain visible. +# The default value is: YES. + STRIP_CODE_COMMENTS = YES + +# If the REFERENCED_BY_RELATION tag is set to YES then for each documented +# entity all documented functions referencing it will be listed. +# The default value is: NO. + REFERENCED_BY_RELATION = YES + +# If the REFERENCES_RELATION tag is set to YES then for each documented function +# all documented entities called/used by that function will be listed. +# The default value is: NO. + REFERENCES_RELATION = YES + +# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set +# to YES then the hyperlinks from functions in REFERENCES_RELATION and +# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will +# link to the documentation. +# The default value is: YES. + REFERENCES_LINK_SOURCE = YES + +# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the +# source code will show a tooltip with additional information such as prototype, +# brief description and links to the definition and documentation. Since this +# will make the HTML file larger and loading of large files a bit slower, you +# can opt to disable this feature. +# The default value is: YES. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + SOURCE_TOOLTIPS = YES + +# If the USE_HTAGS tag is set to YES then the references to source code will +# point to the HTML generated by the htags(1) tool instead of Doxygen built-in +# source browser. The htags tool is part of GNU's global source tagging system +# (see https://www.gnu.org/software/global/global.html). You will need version +# 4.8.6 or higher. +# +# To use it do the following: +# - Install the latest version of global +# - Enable SOURCE_BROWSER and USE_HTAGS in the configuration file +# - Make sure the INPUT points to the root of the source tree +# - Run doxygen as normal +# +# Doxygen will invoke htags (and that will in turn invoke gtags), so these +# tools must be available from the command line (i.e. in the search path). +# +# The result: instead of the source browser generated by Doxygen, the links to +# source code will now point to the output of htags. +# The default value is: NO. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + USE_HTAGS = NO + +# If the VERBATIM_HEADERS tag is set the YES then Doxygen will generate a +# verbatim copy of the header file for each class for which an include is +# specified. Set to NO to disable this. +# See also: Section \class. +# The default value is: YES. + VERBATIM_HEADERS = YES -CLANG_ASSISTED_PARSING = NO -CLANG_ADD_INC_PATHS = YES -CLANG_OPTIONS = -CLANG_DATABASE_PATH = #--------------------------------------------------------------------------- # Configuration options related to the alphabetical class index #--------------------------------------------------------------------------- -ALPHABETICAL_INDEX = NO +# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all +# compounds will be generated. Enable this if the project contains a lot of +# classes, structs, unions or interfaces. +# The default value is: YES. + +ALPHABETICAL_INDEX = YES + +# The IGNORE_PREFIX tag can be used to specify a prefix (or a list of prefixes) +# that should be ignored while generating the index headers. The IGNORE_PREFIX +# tag works for classes, function and member names. The entity will be placed in +# the alphabetical list under the first letter of the entity name that remains +# after removing the prefix. +# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. + IGNORE_PREFIX = #--------------------------------------------------------------------------- # Configuration options related to the HTML output #--------------------------------------------------------------------------- +# If the GENERATE_HTML tag is set to YES, Doxygen will generate HTML output +# The default value is: YES. + GENERATE_HTML = YES + +# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a +# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of +# it. +# The default directory is: html. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_OUTPUT = html + +# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each +# generated HTML page (for example: .htm, .php, .asp). +# The default value is: .html. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_FILE_EXTENSION = .html + +# The HTML_HEADER tag can be used to specify a user-defined HTML header file for +# each generated HTML page. If the tag is left blank Doxygen will generate a +# standard header. +# +# To get valid HTML the header file that includes any scripts and style sheets +# that Doxygen needs, which is dependent on the configuration options used (e.g. +# the setting GENERATE_TREEVIEW). It is highly recommended to start with a +# default header using +# doxygen -w html new_header.html new_footer.html new_stylesheet.css +# YourConfigFile +# and then modify the file new_header.html. See also section "Doxygen usage" +# for information on how to generate the default header that Doxygen normally +# uses. +# Note: The header is subject to change so you typically have to regenerate the +# default header when upgrading to a newer version of Doxygen. For a description +# of the possible markers and block names see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_HEADER = _doxygen/header.html + +# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each +# generated HTML page. If the tag is left blank Doxygen will generate a standard +# footer. See HTML_HEADER for more information on how to generate a default +# footer and what special commands can be used inside the footer. See also +# section "Doxygen usage" for information on how to generate the default footer +# that Doxygen normally uses. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_FOOTER = _doxygen/footer.html -HTML_STYLESHEET = -HTML_EXTRA_STYLESHEET = _doxygen/doxygen-awesome.css \ + +# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style +# sheet that is used by each HTML page. It can be used to fine-tune the look of +# the HTML output. If left blank Doxygen will generate a default style sheet. +# See also section "Doxygen usage" for information on how to generate the style +# sheet that Doxygen normally uses. +# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as +# it is more robust and this tag (HTML_STYLESHEET) will in the future become +# obsolete. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_STYLESHEET = + +# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined +# cascading style sheets that are included after the standard style sheets +# created by Doxygen. Using this option one can overrule certain style aspects. +# This is preferred over using HTML_STYLESHEET since it does not replace the +# standard style sheet and is therefore more robust against future updates. +# Doxygen will copy the style sheet files to the output directory. +# Note: The order of the extra style sheet files is of importance (e.g. the last +# style sheet in the list overrules the setting of the previous ones in the +# list). +# Note: Since the styling of scrollbars can currently not be overruled in +# Webkit/Chromium, the styling will be left out of the default doxygen.css if +# one or more extra stylesheets have been specified. So if scrollbar +# customization is desired it has to be added explicitly. For an example see the +# documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_STYLESHEET = _doxygen/doxygen-awesome.css \ _doxygen/doxygen-awesome-sidebar-only.css \ - _doxygen/doxygen-awesome-sidebar-only-darkmode-toggle.css \ - _doxygen/doxygen-awesome-ccpp.css + _doxygen/doxygen-awesome-sidebar-only-darkmode-toggle.css \ + _doxygen/doxygen-awesome-ccpp.css \ + _doxygen/custom.css + +# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or +# other source files which should be copied to the HTML output directory. Note +# that these files will be copied to the base HTML output directory. Use the +# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these +# files. In the HTML_STYLESHEET file, use the file name only. Also note that the +# files will be copied as-is; there are no commands or markers available. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_EXTRA_FILES = _doxygen/doxygen-awesome-darkmode-toggle.js \ _doxygen/doxygen-awesome-ccpp.js + +# The HTML_COLORSTYLE tag can be used to specify if the generated HTML output +# should be rendered with a dark or light theme. +# Possible values are: LIGHT always generates light mode output, DARK always +# generates dark mode output, AUTO_LIGHT automatically sets the mode according +# to the user preference, uses light mode if no preference is set (the default), +# AUTO_DARK automatically sets the mode according to the user preference, uses +# dark mode if no preference is set and TOGGLE allows a user to switch between +# light and dark mode via a button. +# The default value is: AUTO_LIGHT. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE = LIGHT + +# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen +# will adjust the colors in the style sheet and background images according to +# this color. Hue is specified as an angle on a color-wheel, see +# https://en.wikipedia.org/wiki/Hue for more information. For instance the value +# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 +# purple, and 360 is red again. +# Minimum value: 0, maximum value: 359, default value: 220. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_COLORSTYLE_HUE = 209 + +# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors +# in the HTML output. For a value of 0 the output will use gray-scales only. A +# value of 255 will produce the most vivid colors. +# Minimum value: 0, maximum value: 255, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_COLORSTYLE_SAT = 255 + +# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the +# luminance component of the colors in the HTML output. Values below 100 +# gradually make the output lighter, whereas values above 100 make the output +# darker. The value divided by 100 is the actual gamma applied, so 80 represents +# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not +# change the gamma. +# Minimum value: 40, maximum value: 240, default value: 80. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_COLORSTYLE_GAMMA = 113 -HTML_TIMESTAMP = NO + +# If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML +# documentation will contain a main index with vertical navigation menus that +# are dynamically created via JavaScript. If disabled, the navigation index will +# consists of multiple levels of tabs that are statically embedded in every HTML +# page. Disable this option to support browsers that do not have JavaScript, +# like the Qt help browser. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_DYNAMIC_MENUS = YES + +# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML +# documentation will contain sections that can be hidden and shown after the +# page has loaded. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_DYNAMIC_SECTIONS = NO + +# If the HTML_CODE_FOLDING tag is set to YES then classes and functions can be +# dynamically folded and expanded in the generated HTML source code. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_CODE_FOLDING = YES + +# If the HTML_COPY_CLIPBOARD tag is set to YES then Doxygen will show an icon in +# the top right corner of code and text fragments that allows the user to copy +# its content to the clipboard. Note this only works if supported by the browser +# and the web page is served via a secure context (see: +# https://www.w3.org/TR/secure-contexts/), i.e. using the https: or file: +# protocol. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COPY_CLIPBOARD = YES + +# Doxygen stores a couple of settings persistently in the browser (via e.g. +# cookies). By default these settings apply to all HTML pages generated by +# Doxygen across all projects. The HTML_PROJECT_COOKIE tag can be used to store +# the settings under a project specific key, such that the user preferences will +# be stored separately. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_PROJECT_COOKIE = + +# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries +# shown in the various tree structured indices initially; the user can expand +# and collapse entries dynamically later on. Doxygen will expand the tree to +# such a level that at most the specified number of entries are visible (unless +# a fully collapsed tree already exceeds this amount). So setting the number of +# entries 1 will produce a full collapsed tree by default. 0 is a special value +# representing an infinite number of entries and will result in a full expanded +# tree by default. +# Minimum value: 0, maximum value: 9999, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_INDEX_NUM_ENTRIES = 100 + +# If the GENERATE_DOCSET tag is set to YES, additional index files will be +# generated that can be used as input for Apple's Xcode 3 integrated development +# environment (see: +# https://developer.apple.com/xcode/), introduced with OSX 10.5 (Leopard). To +# create a documentation set, Doxygen will generate a Makefile in the HTML +# output directory. Running make will produce the docset in that directory and +# running make install will install the docset in +# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at +# startup. See https://developer.apple.com/library/archive/featuredarticles/Doxy +# genXcode/_index.html for more information. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + GENERATE_DOCSET = NO + +# This tag determines the name of the docset feed. A documentation feed provides +# an umbrella under which multiple documentation sets from a single provider +# (such as a company or product suite) can be grouped. +# The default value is: Doxygen generated docs. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + DOCSET_FEEDNAME = "Doxygen generated docs" + +# This tag determines the URL of the docset feed. A documentation feed provides +# an umbrella under which multiple documentation sets from a single provider +# (such as a company or product suite) can be grouped. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + DOCSET_FEEDURL = + +# This tag specifies a string that should uniquely identify the documentation +# set bundle. This should be a reverse domain-name style string, e.g. +# com.mycompany.MyDocSet. Doxygen will append .docset to the name. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + DOCSET_BUNDLE_ID = org.doxygen.Project + +# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify +# the documentation publisher. This should be a reverse domain-name style +# string, e.g. com.mycompany.MyDocSet.documentation. +# The default value is: org.doxygen.Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + DOCSET_PUBLISHER_ID = org.doxygen.Publisher + +# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher. +# The default value is: Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + DOCSET_PUBLISHER_NAME = Publisher + +# If the GENERATE_HTMLHELP tag is set to YES then Doxygen generates three +# additional HTML index files: index.hhp, index.hhc, and index.hhk. The +# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop +# on Windows. In the beginning of 2021 Microsoft took the original page, with +# a.o. the download links, offline the HTML help workshop was already many years +# in maintenance mode). You can download the HTML help workshop from the web +# archives at Installation executable (see: +# http://web.archive.org/web/20160201063255/http://download.microsoft.com/downlo +# ad/0/A/9/0A939EF6-E31C-430F-A3DF-DFAE7960D564/htmlhelp.exe). +# +# The HTML Help Workshop contains a compiler that can convert all HTML output +# generated by Doxygen into a single compiled HTML file (.chm). Compiled HTML +# files are now used as the Windows 98 help format, and will replace the old +# Windows help format (.hlp) on all Windows platforms in the future. Compressed +# HTML files also contain an index, a table of contents, and you can search for +# words in the documentation. The HTML workshop also contains a viewer for +# compressed HTML files. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + GENERATE_HTMLHELP = NO + +# The CHM_FILE tag can be used to specify the file name of the resulting .chm +# file. You can add a path in front of the file if the result should not be +# written to the html output directory. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + CHM_FILE = + +# The HHC_LOCATION tag can be used to specify the location (absolute path +# including file name) of the HTML help compiler (hhc.exe). If non-empty, +# Doxygen will try to run the HTML help compiler on the generated index.hhp. +# The file has to be specified with full path. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + HHC_LOCATION = + +# The GENERATE_CHI flag controls if a separate .chi index file is generated +# (YES) or that it should be included in the main .chm file (NO). +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + GENERATE_CHI = NO + +# The CHM_INDEX_ENCODING is used to encode HtmlHelp index (hhk), content (hhc) +# and project file content. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + CHM_INDEX_ENCODING = + +# The BINARY_TOC flag controls whether a binary table of contents is generated +# (YES) or a normal table of contents (NO) in the .chm file. Furthermore it +# enables the Previous and Next buttons. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + BINARY_TOC = NO + +# The TOC_EXPAND flag can be set to YES to add extra items for group members to +# the table of contents of the HTML help documentation and to the tree view. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + TOC_EXPAND = NO + +# The SITEMAP_URL tag is used to specify the full URL of the place where the +# generated documentation will be placed on the server by the user during the +# deployment of the documentation. The generated sitemap is called sitemap.xml +# and placed on the directory specified by HTML_OUTPUT. In case no SITEMAP_URL +# is specified no sitemap is generated. For information about the sitemap +# protocol see https://www.sitemaps.org +# This tag requires that the tag GENERATE_HTML is set to YES. + +SITEMAP_URL = + +# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and +# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that +# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help +# (.qch) of the generated HTML documentation. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + GENERATE_QHP = NO + +# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify +# the file name of the resulting .qch file. The path specified is relative to +# the HTML output folder. +# This tag requires that the tag GENERATE_QHP is set to YES. + QCH_FILE = + +# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help +# Project output. For more information please see Qt Help Project / Namespace +# (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#namespace). +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_QHP is set to YES. + QHP_NAMESPACE = org.doxygen.Project + +# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt +# Help Project output. For more information please see Qt Help Project / Virtual +# Folders (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#virtual-folders). +# The default value is: doc. +# This tag requires that the tag GENERATE_QHP is set to YES. + QHP_VIRTUAL_FOLDER = doc + +# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom +# filter to add. For more information please see Qt Help Project / Custom +# Filters (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + QHP_CUST_FILTER_NAME = + +# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the +# custom filter to add. For more information please see Qt Help Project / Custom +# Filters (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + QHP_CUST_FILTER_ATTRS = + +# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this +# project's filter section matches. Qt Help Project / Filter Attributes (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#filter-attributes). +# This tag requires that the tag GENERATE_QHP is set to YES. + QHP_SECT_FILTER_ATTRS = + +# The QHG_LOCATION tag can be used to specify the location (absolute path +# including file name) of Qt's qhelpgenerator. If non-empty Doxygen will try to +# run qhelpgenerator on the generated .qhp file. +# This tag requires that the tag GENERATE_QHP is set to YES. + QHG_LOCATION = + +# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be +# generated, together with the HTML files, they form an Eclipse help plugin. To +# install this plugin and make it available under the help contents menu in +# Eclipse, the contents of the directory containing the HTML and XML files needs +# to be copied into the plugins directory of eclipse. The name of the directory +# within the plugins directory should be the same as the ECLIPSE_DOC_ID value. +# After copying Eclipse needs to be restarted before the help appears. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + GENERATE_ECLIPSEHELP = NO + +# A unique identifier for the Eclipse help plugin. When installing the plugin +# the directory name containing the HTML and XML files should also have this +# name. Each documentation set should have its own identifier. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES. + ECLIPSE_DOC_ID = org.doxygen.Project + +# If you want full control over the layout of the generated HTML pages it might +# be necessary to disable the index and replace it with your own. The +# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top +# of each HTML page. A value of NO enables the index and the value YES disables +# it. Since the tabs in the index contain the same information as the navigation +# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + DISABLE_INDEX = YES + +# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index +# structure should be generated to display hierarchical information. If the tag +# value is set to YES, a side panel will be generated containing a tree-like +# index structure (just like the one that is generated for HTML Help). For this +# to work a browser that supports JavaScript, DHTML, CSS and frames is required +# (i.e. any modern browser). Windows users are probably better off using the +# HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can +# further fine tune the look of the index (see "Fine-tuning the output"). As an +# example, the default style sheet generated by Doxygen has an example that +# shows how to put an image at the root of the tree instead of the PROJECT_NAME. +# Since the tree basically has the same information as the tab index, you could +# consider setting DISABLE_INDEX to YES when enabling this option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + GENERATE_TREEVIEW = YES + +# When both GENERATE_TREEVIEW and DISABLE_INDEX are set to YES, then the +# FULL_SIDEBAR option determines if the side bar is limited to only the treeview +# area (value NO) or if it should extend to the full height of the window (value +# YES). Setting this to YES gives a layout similar to +# https://docs.readthedocs.io with more room for contents, but less room for the +# project logo, title, and description. If either GENERATE_TREEVIEW or +# DISABLE_INDEX is set to NO, this option has no effect. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + FULL_SIDEBAR = NO + +# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that +# Doxygen will group on one line in the generated HTML documentation. +# +# Note that a value of 0 will completely suppress the enum values from appearing +# in the overview section. +# Minimum value: 0, maximum value: 20, default value: 4. +# This tag requires that the tag GENERATE_HTML is set to YES. + ENUM_VALUES_PER_LINE = 4 + +# When the SHOW_ENUM_VALUES tag is set doxygen will show the specified +# enumeration values besides the enumeration mnemonics. +# The default value is: NO. + +SHOW_ENUM_VALUES = NO + +# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used +# to set the initial width (in pixels) of the frame in which the tree is shown. +# Minimum value: 0, maximum value: 1500, default value: 250. +# This tag requires that the tag GENERATE_HTML is set to YES. + TREEVIEW_WIDTH = 335 + +# If the EXT_LINKS_IN_WINDOW option is set to YES, Doxygen will open links to +# external symbols imported via tag files in a separate window. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + EXT_LINKS_IN_WINDOW = NO + +# If the OBFUSCATE_EMAILS tag is set to YES, Doxygen will obfuscate email +# addresses. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + OBFUSCATE_EMAILS = YES + +# If the HTML_FORMULA_FORMAT option is set to svg, Doxygen will use the pdf2svg +# tool (see https://github.com/dawbarton/pdf2svg) or inkscape (see +# https://inkscape.org) to generate formulas as SVG images instead of PNGs for +# the HTML output. These images will generally look nicer at scaled resolutions. +# Possible values are: png (the default) and svg (looks nicer but requires the +# pdf2svg or inkscape tool). +# The default value is: png. +# This tag requires that the tag GENERATE_HTML is set to YES. + HTML_FORMULA_FORMAT = SVG + +# Use this tag to change the font size of LaTeX formulas included as images in +# the HTML documentation. When you change the font size after a successful +# Doxygen run you need to manually remove any form_*.png images from the HTML +# output directory to force them to be regenerated. +# Minimum value: 8, maximum value: 50, default value: 10. +# This tag requires that the tag GENERATE_HTML is set to YES. + FORMULA_FONTSIZE = 10 -FORMULA_TRANSPARENT = YES + +# The FORMULA_MACROFILE can contain LaTeX \newcommand and \renewcommand commands +# to create new LaTeX commands to be used in formulas as building blocks. See +# the section "Including formulas" for details. + FORMULA_MACROFILE = + +# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see +# https://www.mathjax.org) which uses client side JavaScript for the rendering +# instead of using pre-rendered bitmaps. Use this if you do not have LaTeX +# installed or if you want to formulas look prettier in the HTML output. When +# enabled you may also need to install MathJax separately and configure the path +# to it using the MATHJAX_RELPATH option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + USE_MATHJAX = YES + +# With MATHJAX_VERSION it is possible to specify the MathJax version to be used. +# Note that the different versions of MathJax have different requirements with +# regards to the different settings, so it is possible that also other MathJax +# settings have to be changed when switching between the different MathJax +# versions. +# Possible values are: MathJax_2 and MathJax_3. +# The default value is: MathJax_2. +# This tag requires that the tag USE_MATHJAX is set to YES. + MATHJAX_VERSION = MathJax_2 + +# When MathJax is enabled you can set the default output format to be used for +# the MathJax output. For more details about the output format see MathJax +# version 2 (see: +# http://docs.mathjax.org/en/v2.7-latest/output.html) and MathJax version 3 +# (see: +# http://docs.mathjax.org/en/latest/web/components/output.html). +# Possible values are: HTML-CSS (which is slower, but has the best +# compatibility. This is the name for Mathjax version 2, for MathJax version 3 +# this will be translated into chtml), NativeMML (i.e. MathML. Only supported +# for MathJax 2. For MathJax version 3 chtml will be used instead.), chtml (This +# is the name for Mathjax version 3, for MathJax version 2 this will be +# translated into HTML-CSS) and SVG. +# The default value is: HTML-CSS. +# This tag requires that the tag USE_MATHJAX is set to YES. + MATHJAX_FORMAT = HTML-CSS -#MATHJAX_RELPATH = https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2 + +# When MathJax is enabled you need to specify the location relative to the HTML +# output directory using the MATHJAX_RELPATH option. The destination directory +# should contain the MathJax.js script. For instance, if the mathjax directory +# is located at the same level as the HTML output directory, then +# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax +# Content Delivery Network so you can quickly see the result without installing +# MathJax. However, it is strongly recommended to install a local copy of +# MathJax from https://www.mathjax.org before deployment. The default value is: +# - in case of MathJax version 2: https://cdn.jsdelivr.net/npm/mathjax@2 +# - in case of MathJax version 3: https://cdn.jsdelivr.net/npm/mathjax@3 +# This tag requires that the tag USE_MATHJAX is set to YES. + MATHJAX_RELPATH = https://cdn.jsdelivr.net/npm/mathjax@2 + +# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax +# extension names that should be enabled during MathJax rendering. For example +# for MathJax version 2 (see +# https://docs.mathjax.org/en/v2.7-latest/tex.html#tex-and-latex-extensions): +# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols +# For example for MathJax version 3 (see +# http://docs.mathjax.org/en/latest/input/tex/extensions/index.html): +# MATHJAX_EXTENSIONS = ams +# This tag requires that the tag USE_MATHJAX is set to YES. + MATHJAX_EXTENSIONS = + +# The MATHJAX_CODEFILE tag can be used to specify a file with JavaScript pieces +# of code that will be used on startup of the MathJax code. See the MathJax site +# (see: +# http://docs.mathjax.org/en/v2.7-latest/output.html) for more details. For an +# example see the documentation. +# This tag requires that the tag USE_MATHJAX is set to YES. + MATHJAX_CODEFILE = + +# When the SEARCHENGINE tag is enabled Doxygen will generate a search box for +# the HTML output. The underlying search engine uses JavaScript and DHTML and +# should work on any modern browser. Note that when using HTML help +# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) +# there is already a search function so this one should typically be disabled. +# For large projects the JavaScript based search engine can be slow, then +# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to +# search using the keyboard; to jump to the search box use + S +# (what the is depends on the OS and browser, but it is typically +# , /